Author: particle
Date: Thu Feb 21 15:46:27 2008
New Revision: 25957
Added:
trunk/runtime/parrot/library/YAML/Dumper/
trunk/runtime/parrot/library/YAML/Dumper.pir
trunk/runtime/parrot/library/YAML/Dumper/Base.pir
trunk/runtime/parrot/library/YAML/Dumper/Default.pir
trunk/runtime/parrot/library/yaml_dumper.pir
trunk/t/library/yaml_dumper.t
Log:
[runtime] YAML/Dumper.pir library stolen and adapted from Data/Dumper.pir
Added: trunk/runtime/parrot/library/YAML/Dumper.pir
==============================================================================
--- (empty file)
+++ trunk/runtime/parrot/library/YAML/Dumper.pir Thu Feb 21 15:46:27 2008
@@ -0,0 +1,67 @@
+.sub __library_data_dumper_onload :load
+ .local pmc yd_class
+ yd_class = get_class "YAML::Dumper"
+ if null yd_class goto load_library
+
+ goto END
+
+ load_library:
+ load_bytecode "library/YAML/Dumper/Default.pir"
+ newclass $P0, "YAML::Dumper"
+END:
+ .return ()
+.end
+
+.namespace ["YAML::Dumper"]
+
+.sub yaml :method
+ .param pmc dump
+ .param string name :optional
+ .param int has_name :opt_flag
+ .param string indent :optional
+ .param int has_indent :opt_flag
+ .local pmc style
+
+ if has_indent goto no_def_indent
+ set indent, " "
+no_def_indent:
+ # use a default name
+ if has_name goto no_def_name
+ set name, "VAR1"
+no_def_name:
+ # XXX: support different output styles
+ .local pmc ydd_class
+
+ push_eh ERROR2
+ ydd_class = get_class "YAML::Dumper::Default"
+ style = ydd_class."new"()
+ pop_eh
+
+ style."prepare"( self, indent )
+
+ print "---\n{\n"
+
+ style."dumpWithName"( name, name, dump )
+
+ print ",\n}\n"
+
+ .return ( 1 )
+
+ERROR2:
+ print "can not find class YAML::Dumper::Default!\n"
+ end
+ .return ( 0 )
+ERROR:
+ print "Syntax:\n"
+ print "YAML::Dumper::yaml( pmc )\n"
+ print "YAML::Dumper::yaml( pmc, name )\n"
+ print "YAML::Dumper::yaml( pmc, name, indent )\n"
+ .return ( 0 )
+.end
+
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: trunk/runtime/parrot/library/YAML/Dumper/Base.pir
==============================================================================
--- (empty file)
+++ trunk/runtime/parrot/library/YAML/Dumper/Base.pir Thu Feb 21 15:46:27 2008
@@ -0,0 +1,277 @@
+=head1 TITLE
+
+YAML::Dumper::Base - style baseclass
+
+=head1 VERSION
+
+version 0.20
+
+=head1 SYNOPSIS
+
+TDB
+
+=head1 DESCRIPTION
+
+This is a baseclass that provides some essential functions necessary
+for dumping data structures. It is subclassed by C<YAML::Dumper::Default>,
+which implements the methods that are finally doing the output.
+
+=head1 METHODS
+
+A YAML::Dumper::Base object has the following methods:
+
+=over 4
+
+=cut
+
+.sub __library_data_dumper_base_onload :load
+ .local pmc ydb_class
+ ydb_class = get_class "YAML::Dumper::Base"
+ if null ydb_class goto create_ydb
+ goto END
+
+ create_ydb:
+ newclass $P0, "YAML::Dumper::Base"
+ addattribute $P0, "yaml"
+ addattribute $P0, "level"
+ addattribute $P0, "indention"
+ addattribute $P0, "cache"
+ addattribute $P0, "cachename"
+END:
+ .return ()
+.end
+
+.namespace ["YAML::Dumper::Base"]
+
+=item style."prepare"( yaml, indent )
+
+=cut
+
+.sub prepare :method
+ .param pmc yaml
+ .param string indent
+ .local string stemp
+ .local pmc temp
+
+ setattribute self, "yaml", yaml
+
+ new temp, "Integer"
+ set temp, 0
+ setattribute self, "level", temp
+
+ new temp, "String"
+ clone stemp, indent
+ set temp, stemp
+ setattribute self, "indention", temp
+
+ new temp, "AddrRegistry"
+ setattribute self, "cache", temp
+ new temp, "ResizableStringArray"
+ setattribute self, "cachename", temp
+
+ .return ()
+.end
+
+=item (pos, name) = style."cache"( find, defname ) B<(internal)>
+
+=cut
+
+.sub cache :method
+ .param string name
+ .param pmc find
+ .local pmc _cache
+ .local int i
+ .local pmc _names
+
+ getattribute _cache, self, "cache"
+ getattribute _names, self, "cachename"
+
+ i = _cache[find]
+ if i == 0 goto NOTFOUND
+ # found entry => get its name
+ name = _names[i]
+
+ .return ( i, name )
+
+NOTFOUND:
+ i = elements _cache
+ inc i
+ _cache[find] = i
+ _names[i] = name
+
+ .return ( -1, name )
+.end
+
+=item indent = style."createIndent"() B<(internal)>
+
+=cut
+
+.sub createIndent :method
+ .param int level
+ .local pmc temp
+ .local string indent
+
+ getattribute temp, self, "indention"
+ set indent, temp
+ clone indent, indent
+ repeat indent, indent, level
+
+ .return ( indent )
+.end
+
+=item indent = style."indent"()
+
+=cut
+
+.sub indent :method
+ .local pmc temp
+ .local string _indent
+ .local int level
+
+ getattribute temp, self, "level"
+ set level, temp
+
+ _indent = self."createIndent"( level )
+
+ .return ( _indent )
+.end
+
+=item (subindent,indent) = style."newIndent"()
+
+=cut
+
+.sub newIndent :method
+ .local pmc temp
+ .local string indent1
+ .local string indent2
+ .local int level
+
+ getattribute temp, self, "level"
+ set level, temp
+ inc temp
+
+ indent1 = self."createIndent"( level )
+ inc level
+ indent2 = self."createIndent"( level )
+
+ .return ( indent2, indent1 )
+.end
+
+=item indent = style."deleteIndent"()
+
+=cut
+
+.sub deleteIndent :method
+ .local pmc temp
+ .local string indent
+ .local int level
+
+ getattribute temp, self, "level"
+ dec temp
+ set level, temp
+
+ indent = self."createIndent"( level )
+
+ .return ( indent )
+.end
+
+=item style."yaml"( name, dump )
+
+=cut
+
+.sub yaml :method
+ .param string paramName
+ .param pmc _dump
+ .local int type
+ .local int ret
+ .local string temp
+ .local string func
+ .local string name
+
+ # Don't cache undef...
+ $I0 = defined _dump
+ unless $I0 goto NOT_IN_CACHE
+
+ (type, name) = self."cache"( paramName, _dump )
+
+ if type == -1 goto NOT_IN_CACHE
+ # name found in cache:
+ self."dumpCached"( name, _dump )
+ branch END
+
+NOT_IN_CACHE:
+ # is _dump null?
+ # lookup the type id otherwise
+ set func, "pmcNull"
+ if_null _dump, DUMP
+
+ # does a specific helper method exist?
+ # (in general, it will not, let it override the general ones below)
+ typeof temp, _dump
+ set func, "pmc"
+ concat func, temp
+ can ret, self, func
+ if ret goto DUMP
+
+ #is _dump undef?
+ func = "genericUndef"
+ $I0 = defined _dump
+ unless $I0 goto DUMP
+
+ func = "pmcDefault"
+ $I0 = isa _dump, "Object"
+ if $I0 goto DUMP
+
+ TEST_GENERIC:
+ # does a generic helper method exist?
+ func = "genericHash"
+ $I0 = does _dump, "hash"
+ if $I0 goto DUMP
+
+ func = "genericArray"
+ $I0 = does _dump, "array"
+ if $I0 goto DUMP
+
+ func = "genericString"
+ $I0 = does _dump, "string"
+ if $I0 goto DUMP
+
+ func = "genericNumber"
+ $I0 = does _dump, "boolean"
+ if $I0 goto DUMP
+ $I0 = does _dump, "integer"
+ if $I0 goto DUMP
+ $I0 = does _dump, "float"
+ if $I0 goto DUMP
+
+ # no, dump as a unknown PMC
+ set func, "pmcDefault"
+DUMP:
+ ret = self.func( name, _dump )
+ unless ret goto END
+
+ self."dumpProperties"( name, _dump )
+
+END:
+ .return ( 1 )
+.end
+
+=back
+
+=head1 AUTHOR
+
+Jens Rieks E<lt>parrot at jensbeimsurfen dot deE<gt> is the author
+and maintainer.
+Please send patches and suggestions to the Perl 6 Internals mailing list.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2004-2008, The Perl Foundation.
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: trunk/runtime/parrot/library/YAML/Dumper/Default.pir
==============================================================================
--- (empty file)
+++ trunk/runtime/parrot/library/YAML/Dumper/Default.pir Thu Feb 21
15:46:27 2008
@@ -0,0 +1,456 @@
+=head1 TITLE
+
+YAML::Dumper::Default - The default output module of YAML::Dumper.
+
+=head1 VERSION
+
+version 0.20
+
+=head1 SYNOPSIS
+
+TDB
+
+=head1 DESCRIPTION
+
+This module provides the default output style of C<YAML::Dumper>.
+
+=cut
+
+.sub __library_data_dumper_default_onload :load
+ .local pmc ydb_class
+ ydb_class = get_class "YAML::Dumper::Default"
+ if null ydb_class goto create_ydb
+ goto END
+
+ create_ydb:
+ load_bytecode "library/YAML/Dumper/Base.pir"
+ get_class $P0, "YAML::Dumper::Base"
+ subclass $P0, $P0, "YAML::Dumper::Default"
+END:
+ .return ()
+.end
+
+.namespace ["YAML::Dumper::Default"]
+
+=head1 METHODS
+
+A YAML::Dumper::Default object has the following methods:
+
+=over 4
+
+
+=item style."dumpWithName"( shortname, name, dump )
+
+=cut
+
+.sub dumpWithName :method
+ .param string shortname
+ .param string name
+ .param pmc dump
+ .local int ret
+ .local string indent
+ .local string subindent
+
+ (subindent, indent) = self."newIndent"()
+
+ print subindent
+
+ print "\""
+ print shortname
+ print "\" : "
+
+ ret = self."yaml"( name, dump )
+
+ self."deleteIndent"()
+
+ .return ( ret )
+.end
+
+
+=item style."dumpCached"( name, dump )
+
+=cut
+
+.sub dumpCached :method
+ .param string name
+ .param pmc dump
+
+ print "\\"
+ print name
+
+ .return ( 1 )
+.end
+
+
+
+=item style."dumpProperties"( name, dump )
+
+=cut
+
+.sub dumpProperties :method
+ .param string paramName
+ .param pmc dump
+ .local string name
+ .local pmc prop
+ .local int ret
+
+ ret = 1
+ if_null dump, END
+ prophash prop, dump
+ if_null prop, END
+
+ print " with-properties: "
+ clone name, paramName
+ concat name, ".properties()"
+ ret = self."yaml"( name, prop )
+
+END:
+ .return ( ret )
+.end
+
+
+=item style.genericHash( name, hash )
+
+Dumps a 'generic' Hash.
+
+=cut
+
+.sub genericHash :method
+ .param string name
+ .param pmc hash
+ .local pmc iter
+ .local string key
+ .local pmc val
+ .local pmc keys
+ .local string name2
+
+ $S0 = typeof hash
+ print "!"
+ print $S0
+
+ print " {"
+
+ new keys, "ResizablePMCArray"
+ new iter, "Iterator", hash
+ set iter, 0
+
+ iter_loop:
+ unless iter, iter_end
+
+ shift key, iter
+ push keys, key
+ branch iter_loop
+
+ iter_end:
+ keys."sort"()
+
+ dump_loop:
+ unless keys, dump_end
+
+ print "\n"
+
+ shift key, keys
+
+ new val, "ResizablePMCArray"
+ push val, name
+ push val, key
+ sprintf name2, "%s[\"%s\"]", val
+
+ set val, hash[key]
+
+ self."dumpWithName"( key, name2, val )
+
+ print ","
+ unless keys, dump_end
+
+ branch dump_loop
+
+ dump_end:
+ .local string indent
+ .local string subindent
+
+ (subindent, indent) = self."newIndent"()
+
+ print "\n"
+ print indent
+ print "}"
+
+ self."deleteIndent"()
+
+ .return ( 1 )
+.end
+
+
+=item style."dumpStringEscaped"( string, escapeChar )
+
+Escape any characters in a string so we can re-use it as a literal.
+
+=cut
+
+.sub dumpStringEscaped :method
+ .param pmc var
+ .param string char
+ .local string str
+
+ str = var
+ str = escape str
+ print str
+
+ .return ( 1 )
+.end
+
+
+=item style."pmcDefault"( name, dump )
+
+=cut
+
+.sub pmcDefault :method
+ .param string name
+ .param pmc dump
+ .local pmc class
+ .local string type
+
+ type = typeof dump
+
+ print "!"
+ print type
+ print " "
+
+ $I0 = can dump, "__yaml"
+ if $I0 goto CAN_DUMP
+ print "{ ... }"
+ branch END
+CAN_DUMP:
+ dump."__yaml"( self, name )
+END:
+ .return ( 1 )
+.end
+
+
+=item style."pmcIntList"( name, array )
+
+Dumps an IntList PMC.
+
+=cut
+
+.sub pmcIntList :method
+ .param string name
+ .param pmc array
+ .local string indent
+ .local string subindent
+ .local int size
+ .local int pos
+ .local pmc val
+ .local string name2
+ .local int tmp
+
+ (subindent, indent) = self."newIndent"()
+
+ typeof name2, array
+ print name2
+ print "["
+
+ set size, array
+ set pos, 0
+
+ unless size, iter_end
+
+iter_loop:
+ print "\n"
+
+ print subindent
+
+ new val, "ResizablePMCArray"
+ push val, name
+ push val, pos
+ sprintf name2, "%s[%d]", val
+
+ $I0 = array[pos]
+ print $I0
+
+ # next array member
+ inc pos
+
+ print ","
+
+ if pos >= size goto iter_end
+
+ # elements left?
+ branch iter_loop
+
+iter_end:
+ print "\n"
+ print indent
+ print "]"
+
+ self."deleteIndent"()
+
+ .return ( 1 )
+.end
+
+
+=item style."genericArray"( name, array )
+
+Dumps any pmc that implements an Array interface.
+
+=cut
+
+.sub genericArray :method
+ .param string name
+ .param pmc array
+
+ .local string indent
+ .local string subindent
+ .local int size
+ .local int pos
+ .local pmc val
+ .local string name2
+ .local int tmp
+
+ (subindent, indent) = self."newIndent"()
+
+ typeof name2, array
+ print '!'
+ print name2
+ print " ["
+
+ size = array
+ pos = 0
+
+ unless size, iter_end
+
+iter_loop:
+ print "\n"
+
+ print subindent
+
+ val = new 'ResizablePMCArray'
+ push val, name
+ push val, pos
+ sprintf name2, "%s[%d]", val
+
+ set val, array[pos]
+
+ self."yaml"( name2, val )
+
+ # next array member
+ inc pos
+
+ print ","
+
+ if pos >= size goto iter_end
+
+ # elements left?
+ branch iter_loop
+
+iter_end:
+ print "\n"
+ print indent
+ print "]"
+
+ self."deleteIndent"()
+
+ .return ( 1 )
+.end
+
+
+=item style."genericString"( name, str )
+
+Dumps any string-like PMC.
+
+=cut
+
+.sub genericString :method
+ .param string name
+ .param pmc str
+ .local string name2
+
+ typeof name2, str
+ print '!'
+ print name2
+ print ' [ "'
+ self."dumpStringEscaped"( str, "\"" )
+ print '" ]'
+
+ .return ( 1 )
+.end
+
+
+=item style."genericNumber"
+
+Dumps a generic numeric PMC.
+
+=cut
+
+.sub genericNumber :method
+ .param string name
+ .param pmc val
+ .local string name2
+
+ typeof name2, val
+ print '!'
+ print name2
+ print ' [ '
+ print val
+ print ' ]'
+
+ .return ( 1 )
+.end
+
+
+=item style."genericUndef"( name, val )
+
+Dumps any undef PMC.
+
+=cut
+
+.sub genericUndef :method
+ .param string name
+ .param pmc val
+ .local string name2
+
+ typeof name2, val
+ print '!'
+ print name2
+ print ' [ '
+ print ""
+ print ' ]'
+
+ .return ( 1 )
+.end
+
+
+=item style."pmcNull"( name, val )
+
+Dumps a Null PMC.
+
+=cut
+
+.sub pmcNull :method
+ .param string name
+ .param pmc val
+
+ print "null"
+
+ .return ( 1 )
+.end
+
+=back
+
+=head1 AUTHOR
+
+Jens Rieks E<lt>parrot at jensbeimsurfen dot deE<gt> is the author
+and maintainer.
+Please send patches and suggestions to the Perl 6 Internals mailing list.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2004-2008, The Perl Foundation.
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: trunk/runtime/parrot/library/yaml_dumper.pir
==============================================================================
--- (empty file)
+++ trunk/runtime/parrot/library/yaml_dumper.pir Thu Feb 21 15:46:27 2008
@@ -0,0 +1,195 @@
+# Copyright 2008, The Perl Foundation.
+# $Id$
+
+=head1 TITLE
+
+yaml_dumper.pir - PIR version of a YAML dumper, ala Data::Dumper
+
+=head1 VERSION
+
+version 0.1
+
+=head1 SYNOPSIS
+
+ ...
+ # dump the P0 register
+ yaml( P0 )
+
+ # dump the P0 register, with "name"
+ yaml( P0, "name" )
+ ...
+
+ END
+ .include "library/yaml_dumper.pir"
+
+
+=head1 DESCRIPTION
+
+ PIR implementation of Perl 5's Data::Dumper module to dump YAML format.
+
+=cut
+
+# first method prints usage information
+.sub __library_dumper_onload
+ print "usage:"
+ print "\tload_bytecode \"library/YAML/Dumper.pir\"\n"
+ print "\t...\n"
+ print "\tnew yaml, \"YAML::Dumper\"\n"
+ print "\tyaml.\"yaml\"( foo, \"foo\" )\n\n"
+ end
+.end
+
+.include "errors.pasm"
+
+=head1 FUNCTIONS
+
+This library provides the following functions:
+
+=over 4
+
+=item yaml( pmc, ?name, ?indent] )
+
+This is the public (non object) interface to the yaml dumper library.
+
+=over 4
+
+=item pmc
+
+Required. The PMC to dump.
+
+=item name
+
+Optional. The name of the PMC.
+
+=item indent
+
+Optional. The indent used at the start of each line printed.
+
+=back
+
+B<Note:> This function currently returns nothing. It should return
+the dumped data as a string, like Perl's Data::Dumper. Instead,
+everything is printed out using C<print>.
+
+B<Note: #2> Hash keys are now sorted using C<_sort()> (library/sort.pir)
+
+=cut
+
+.sub yaml
+ .param pmc p
+ .param string name :optional
+ .param int has_name :opt_flag
+ .param string ident :optional
+ .param int has_ident :opt_flag
+
+ $P2 = _global_dumper()
+ if has_ident goto w_ident
+ unless has_name goto wo_name # XXX argument order, opt 1st
+ $P2."yaml"(p, name)
+ goto ex
+wo_name:
+ $P2."yaml"(p)
+ goto ex
+w_ident:
+ $P2."yaml"(p, name, ident)
+ex:
+.end
+
+=item _register_dumper( id, sub )
+
+Registers a dumper for new PMC type. B<UNIMPLEMENTED>
+But see B<method __dump> below.
+
+=over 4
+
+=item id
+
+the PMC id, as returned by the C<typeof> op.
+
+=item sub
+
+a Sub pmc, that gets called in order to dump the content of the given PMC
+
+=back
+
+For example:
+
+ sub = find_name "_dump_PerlArray"
+ _register_dumper( .PerlArray, sub )
+
+This function returns nothing.
+
+=cut
+
+.sub _register_dumper
+ .param int id
+ .param pmc s
+ $P2 = _global_dumper()
+ $P2."registerDumper"(id, s)
+.end
+
+=item __dump(pmc yaml, str label) method
+
+If a method C<__dump> exists in the namespace of the class, it will be
+called with the current dumper object and the label of the PMC.
+
+=item yaml =_global_dumper() B<(internal)>
+
+Internal helper function.
+
+Returns the global dumper instance used by the non object interface.
+
+=cut
+
+.sub _global_dumper
+ .local pmc self
+ .local pmc yd_class
+ .local int is_defined
+
+ get_class yd_class, "YAML::Dumper"
+ if null yd_class goto load_yd_pir
+ goto TYPE_OK
+
+ load_yd_pir:
+ load_bytecode "library/YAML/Dumper.pir"
+ get_class yd_class, "YAML::Dumper"
+ if null yd_class goto no_class
+ goto TYPE_OK
+
+ no_class:
+ print "fatal error: failure while loading library/YAML/Dumper.pir\n"
+ end
+TYPE_OK:
+
+ errorsoff .PARROT_ERRORS_GLOBALS_FLAG
+ find_global self, "YAML::Dumper", "global"
+ errorson .PARROT_ERRORS_GLOBALS_FLAG
+ if null self goto create_type
+
+create_type:
+ new self, "YAML::Dumper"
+ store_global "YAML::Dumper", "global", self
+
+END:
+ .return( self )
+.end
+
+=back
+
+=head1 AUTHOR
+
+Jens Rieks E<lt>parrot at jensbeimsurfen dot deE<gt> is the author
+and maintainer.
+Please send patches and suggestions to the Perl 6 Internals mailing list.
+
+=head1 COPYRIGHT
+
+Copyright (C) 2004-2008, The Perl Foundation.
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Added: trunk/t/library/yaml_dumper.t
==============================================================================
--- (empty file)
+++ trunk/t/library/yaml_dumper.t Thu Feb 21 15:46:27 2008
@@ -0,0 +1,1063 @@
+#!perl
+# Copyright (C) 2008, The Perl Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use lib qw( lib );
+
+use Test::More;
+use Parrot::Test 'no_plan';#tests => 26;
+
+=head1 NAME
+
+t/library/yaml_dumper.t - test dumping of data in YAML format
+
+=head1 SYNOPSIS
+
+ % prove t/library/yaml_dumper.t
+
+=head1 DESCRIPTION
+
+Tests data dumping in YAML format.
+
+=cut
+
+
+pir_output_is( <<'CODE', <<'OUT', "dumping array of sorted numbers" );
+
+.include "library/yaml_dumper.pir"
+.sub test :main
+ .local pmc array
+
+ new array, 'ResizablePMCArray'
+ push array, 0
+ push array, 1
+ push array, 2
+ push array, 3
+ push array, 4
+ push array, 5
+ push array, 6
+ push array, 7
+ push array, 8
+ push array, 9
+
+ yaml( array, "array" )
+.end
+CODE
+---
+{
+ "array" : !ResizablePMCArray [
+ !Integer [ 0 ],
+ !Integer [ 1 ],
+ !Integer [ 2 ],
+ !Integer [ 3 ],
+ !Integer [ 4 ],
+ !Integer [ 5 ],
+ !Integer [ 6 ],
+ !Integer [ 7 ],
+ !Integer [ 8 ],
+ !Integer [ 9 ],
+ ],
+}
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUT', "dumping unsorted numbers" );
+.include "library/yaml_dumper.pir"
+.sub test :main
+ .local pmc array
+
+ new array, 'ResizablePMCArray'
+ push array, 6
+ push array, 1
+ push array, 8
+ push array, 3
+ push array, 2
+ push array, 9
+ push array, 7
+ push array, 4
+ push array, 0
+ push array, 5
+
+ yaml( array, "array" )
+.end
+CODE
+---
+{
+ "array" : !ResizablePMCArray [
+ !Integer [ 6 ],
+ !Integer [ 1 ],
+ !Integer [ 8 ],
+ !Integer [ 3 ],
+ !Integer [ 2 ],
+ !Integer [ 9 ],
+ !Integer [ 7 ],
+ !Integer [ 4 ],
+ !Integer [ 0 ],
+ !Integer [ 5 ],
+ ],
+}
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUT', "dumping sorted strings" );
+
+.include "library/yaml_dumper.pir"
+.sub test :main
+ .local pmc array
+
+ new array, 'ResizablePMCArray'
+ push array, "alpha"
+ push array, "bravo"
+ push array, "charlie"
+ push array, "delta"
+ push array, "echo"
+ push array, "foxtrot"
+ push array, "golf"
+ push array, "hotel"
+
+ yaml( array, "strings" )
+.end
+CODE
+---
+{
+ "strings" : !ResizablePMCArray [
+ !String [ "alpha" ],
+ !String [ "bravo" ],
+ !String [ "charlie" ],
+ !String [ "delta" ],
+ !String [ "echo" ],
+ !String [ "foxtrot" ],
+ !String [ "golf" ],
+ !String [ "hotel" ],
+ ],
+}
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUT', "sorting unsorted strings" );
+
+.sub test :main
+ .local pmc array
+
+ new array, 'ResizablePMCArray'
+ push array, "charlie"
+ push array, "hotel"
+ push array, "alpha"
+ push array, "delta"
+ push array, "foxtrot"
+ push array, "golf"
+ push array, "bravo"
+ push array, "echo"
+
+ yaml( array, "strings" )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "strings" : !ResizablePMCArray [
+ !String [ "charlie" ],
+ !String [ "hotel" ],
+ !String [ "alpha" ],
+ !String [ "delta" ],
+ !String [ "foxtrot" ],
+ !String [ "golf" ],
+ !String [ "bravo" ],
+ !String [ "echo" ],
+ ],
+}
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUT', "dumping different types" );
+
+.sub test :main
+ .local pmc array
+
+ new array, 'ResizablePMCArray'
+ push array, 0.1
+ push array, "charlie"
+ push array, 2
+ push array, "hotel"
+ push array, 5
+ push array, "alpha"
+ push array, 0.2
+ push array, "delta"
+ push array, 4
+ push array, "foxtrot"
+ push array, 0.5
+ push array, 0.4
+ push array, 1
+ push array, "golf"
+ push array, 0.3
+ push array, 3
+ push array, "bravo"
+ push array, 0.0
+ push array, 0
+ push array, "echo"
+
+ yaml( array, "array" )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "array" : !ResizablePMCArray [
+ !Float [ 0.1 ],
+ !String [ "charlie" ],
+ !Integer [ 2 ],
+ !String [ "hotel" ],
+ !Integer [ 5 ],
+ !String [ "alpha" ],
+ !Float [ 0.2 ],
+ !String [ "delta" ],
+ !Integer [ 4 ],
+ !String [ "foxtrot" ],
+ !Float [ 0.5 ],
+ !Float [ 0.4 ],
+ !Integer [ 1 ],
+ !String [ "golf" ],
+ !Float [ 0.3 ],
+ !Integer [ 3 ],
+ !String [ "bravo" ],
+ !Float [ 0 ],
+ !Integer [ 0 ],
+ !String [ "echo" ],
+ ],
+}
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUT', "dumping complex data" );
+
+.sub test :main
+ .local pmc hash1
+ .local pmc hash2
+ .local pmc hash3
+ .local pmc array1
+ .local pmc array2
+
+ new hash1, 'Hash'
+ new hash2, 'Hash'
+ new hash3, 'Hash'
+ new array1, 'ResizablePMCArray'
+ new array2, 'ResizablePMCArray'
+
+ yaml( hash1,"hash1" )
+
+ S0 = "hello"
+ S1 = "world"
+ set hash1[S0], S1
+
+ yaml( hash1,"hash1" )
+
+ S0 = "hello2"
+ S1 = "world2"
+ set hash1[S0], S1
+
+ yaml( hash1,"hash1" )
+
+ S0 = "hash2"
+ set hash1[S0], hash2
+
+ yaml( hash1,"hash1" )
+
+ S0 = "hello3"
+ S1 = "world3"
+ set hash2[S0], S1
+
+ yaml( hash1,"hash1" )
+
+ S0 = "name"
+ S1 = "parrot"
+ set hash3[S0], S1
+ S0 = "is"
+ S1 = "cool"
+ set hash3[S0], S1
+
+ push array1, "this"
+ push array1, "is"
+ push array1, "a"
+ push array1, "test"
+ push array1, hash3
+
+ S0 = "array1"
+ set hash2[S0], array1
+
+ yaml( hash1,"hash1" )
+
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "hash1" : !Hash {
+ },
+}
+---
+{
+ "hash1" : !Hash {
+ "hello" : !String [ "world" ],
+ },
+}
+---
+{
+ "hash1" : !Hash {
+ "hello" : !String [ "world" ],
+ "hello2" : !String [ "world2" ],
+ },
+}
+---
+{
+ "hash1" : !Hash {
+ "hash2" : !Hash {
+ },
+ "hello" : !String [ "world" ],
+ "hello2" : !String [ "world2" ],
+ },
+}
+---
+{
+ "hash1" : !Hash {
+ "hash2" : !Hash {
+ "hello3" : !String [ "world3" ],
+ },
+ "hello" : !String [ "world" ],
+ "hello2" : !String [ "world2" ],
+ },
+}
+---
+{
+ "hash1" : !Hash {
+ "hash2" : !Hash {
+ "array1" : !ResizablePMCArray [
+ !String [ "this" ],
+ !String [ "is" ],
+ !String [ "a" ],
+ !String [ "test" ],
+ !Hash {
+ "is" : !String [ "cool" ],
+ "name" : !String [ "parrot" ],
+ },
+ ],
+ "hello3" : !String [ "world3" ],
+ },
+ "hello" : !String [ "world" ],
+ "hello2" : !String [ "world2" ],
+ },
+}
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUT', "properties", todo => 'not yet implemented'
);
+
+.sub test :main
+ .local pmc str
+ .local pmc array
+
+ new array, 'ResizablePMCArray'
+ push array, "test1"
+ push array, "test2"
+
+ new str, 'String'
+ set str, "value1"
+ setprop array, "key1", str
+
+ new str, 'String'
+ set str, "value2"
+ setprop array, "key2", str
+
+ yaml( array )
+
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "VAR1" : !ResizablePMCArray [
+ !"key1" : !String [ "value1" ],
+ !"key2" : !String [ "value2" ],
+ "test1",
+ "test2",
+ ],
+}
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUT', "indent string", todo => 'not supported' );
+
+.sub test :main
+ .local pmc hash1
+ .local pmc hash2
+ .local pmc array1
+ .local pmc array2
+ .local string name
+ .local string indent
+
+ new hash1, 'Hash'
+ new hash2, 'Hash'
+ new array1, 'ResizablePMCArray'
+ new array2, 'ResizablePMCArray'
+
+ set hash1["hash2"], hash2
+ set hash2["array"], array1
+ set hash1["test1"], "test1"
+ set hash2["test2"], "test2"
+ push array1, 1
+ push array1, array2
+ push array2, "test"
+ setprop hash1, "array2", array2
+ name = "hash"
+ indent = "| "
+ yaml( hash1, name, indent )
+ yaml( hash1, name, indent )
+ print "name = '"
+ print name
+ print "'\nindent = '"
+ print indent
+ print "'\n"
+.end
+.include "library/yaml_dumper.pir"
+CODE
+"hash" : Hash {
+| "hash2" : Hash {
+| | "array" : ResizablePMCArray (size:2) [
+| | | 1,
+| | | ResizablePMCArray (size:1) [
+| | | | "test"
+| | | ]
+| | ],
+| | "test2" : "test2"
+| },
+| "test1" : "test1"
+} with-properties: Hash {
+| "array2" : \hash["hash2"]["array"][1]
+}
+"hash" : Hash {
+| "hash2" : Hash {
+| | "array" : ResizablePMCArray (size:2) [
+| | | 1,
+| | | ResizablePMCArray (size:1) [
+| | | | "test"
+| | | ]
+| | ],
+| | "test2" : "test2"
+| },
+| "test1" : "test1"
+} with-properties: Hash {
+| "array2" : \hash["hash2"]["array"][1]
+}
+name = 'hash'
+indent = '| '
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUT', "back-referencing properties", todo => 'not
yet implemented' );
+
+.sub test :main
+ .local pmc hash
+
+ new hash, 'Hash'
+
+ set hash["hello"], "world"
+ setprop hash, "backref", hash
+ yaml( hash )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+"VAR1" : Hash {
+ "hello" : "world"
+} with-properties: Hash {
+ "backref" : \VAR1
+}
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUT', "self-referential properties (1)", todo =>
'not yet implemented' );
+
+.sub test :main
+ .local pmc hash
+ .local pmc prop
+
+ new hash, 'Hash'
+
+ set hash["hello"], "world"
+ setprop hash, "self", hash
+ prophash prop, hash
+ setprop hash, "self", prop
+ yaml( hash )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+"VAR1" : Hash {
+ "hello" : "world"
+} with-properties: Hash {
+ "self" : \VAR1.properties()
+}
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUT', "self-referential properties (2)", todo =>
'not yet implemented' );
+
+.sub test :main
+ .local pmc array
+ .local pmc hash1
+ .local pmc hash2
+ .local pmc prop
+
+ new array, 'ResizablePMCArray'
+ new hash1, 'Hash'
+ new hash2, 'Hash'
+
+ set hash1["hello1"], "world1"
+ set hash2["hello2"], "world2"
+ setprop hash1, "das leben", hash2
+ prophash prop, hash1
+ set prop["das leben"], "ist schoen"
+ setprop hash2, "hash1prop", prop
+ push array, hash1
+ push array, hash2
+ push array, prop
+ prophash prop, hash2
+ push array, prop
+ yaml( array )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+"VAR1" : ResizablePMCArray (size:4) [
+ Hash {
+ "hello1" : "world1"
+ } with-properties: Hash {
+ "das leben" : "ist schoen"
+ },
+ Hash {
+ "hello2" : "world2"
+ } with-properties: Hash {
+ "hash1prop" : \VAR1[0].properties()
+ },
+ \VAR1[0].properties(),
+ \VAR1[1].properties()
+]
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUT', "dumping objects" );
+
+.sub test :main
+ .local pmc temp
+ .local pmc array
+
+ newclass temp, "TestClass"
+
+ new array, 'ResizablePMCArray'
+ temp = new "TestClass"
+ push array, temp
+ $P0 = get_class 'TestClass'
+ temp = new $P0
+ push array, temp
+
+ yaml( array )
+.end
+
+.namespace ["TestClass"]
+
+.sub __yaml :method
+ .param pmc dumper
+ .param string dname
+ .local string subindent
+ .local string indent
+ .local string name
+
+ (subindent, indent) = dumper."newIndent"()
+ print "{\n"
+
+ print subindent
+ print "this is\n"
+
+ print subindent
+ print "_"
+ typeof name, self
+ print name
+ print "::__yaml,\n"
+
+ print indent
+ print "}"
+
+ dumper."deleteIndent"()
+
+ .begin_return
+ .end_return
+.end
+.namespace
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "VAR1" : !ResizablePMCArray [
+ !TestClass {
+ this is
+ _TestClass::__yaml,
+ },
+ !TestClass {
+ this is
+ _TestClass::__yaml,
+ },
+ ],
+}
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUT', "dumping 'null'" );
+
+.sub test :main
+ .local pmc array
+ .local pmc temp
+
+ new array, 'ResizablePMCArray'
+
+ push array, 0
+ push array, "0"
+
+ null temp
+ push array, temp
+
+ new temp, 'Integer'
+ set temp, 0
+ push array, temp
+
+ new temp, 'String'
+ set temp, "0"
+ push array, temp
+
+ yaml( array, "array" )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "array" : !ResizablePMCArray [
+ !Integer [ 0 ],
+ !String [ "0" ],
+ null,
+ !Integer [ 0 ],
+ !String [ "0" ],
+ ],
+}
+OUT
+
+
+pir_output_is( << 'CODE', << 'OUT', "dumping strings" );
+
+.include "library/yaml_dumper.pir"
+.sub _test :main
+ .local pmc array
+ array = new 'ResizablePMCArray'
+
+ .local pmc pmc_string, pmc_perl_string
+ .local string string_1
+
+ pmc_string = new 'String'
+ pmc_string = "This is a String PMC"
+ push array, pmc_string
+
+ pmc_perl_string = new 'String'
+ pmc_perl_string = "This is a String PMC"
+ push array, pmc_perl_string
+
+ string_1 = "This is a String"
+ push array, string_1
+
+ yaml( array, "array of various strings" )
+.end
+CODE
+---
+{
+ "array of various strings" : !ResizablePMCArray [
+ !String [ "This is a String PMC" ],
+ !String [ "This is a String PMC" ],
+ !String [ "This is a String" ],
+ ],
+}
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUT', "dumping complex data in Hash" );
+
+.sub test :main
+ .local pmc hash1
+ .local pmc hash2
+ .local pmc hash3
+ .local pmc array1
+
+ new hash1, 'Hash'
+ new hash2, 'Hash'
+ new hash3, 'Hash'
+ new array1, 'ResizablePMCArray'
+
+ yaml( hash1,"hash1" )
+
+ S0 = "hello"
+ S1 = "world"
+ set hash1[S0], S1
+
+ yaml( hash1,"hash1" )
+
+ S0 = "hello2"
+ S1 = "world2"
+ set hash1[S0], S1
+
+ yaml( hash1,"hash1" )
+
+ S0 = "hash2"
+ set hash1[S0], hash2
+
+ yaml( hash1,"hash1" )
+
+ S0 = "hello3"
+ S1 = "world3"
+ set hash2[S0], S1
+
+ yaml( hash1,"hash1" )
+
+ S0 = "name"
+ S1 = "parrot"
+ set hash3[S0], S1
+ S0 = "is"
+ S1 = "cool"
+ set hash3[S0], S1
+
+ array1 = 5
+ array1[0] = "this"
+ array1[1] = "is"
+ array1[2] = "a"
+ array1[3] = "test"
+ array1[4] = hash3
+
+ S0 = "array1"
+ set hash2[S0], array1
+
+ yaml( hash1,"hash1" )
+
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "hash1" : !Hash {
+ },
+}
+---
+{
+ "hash1" : !Hash {
+ "hello" : !String [ "world" ],
+ },
+}
+---
+{
+ "hash1" : !Hash {
+ "hello" : !String [ "world" ],
+ "hello2" : !String [ "world2" ],
+ },
+}
+---
+{
+ "hash1" : !Hash {
+ "hash2" : !Hash {
+ },
+ "hello" : !String [ "world" ],
+ "hello2" : !String [ "world2" ],
+ },
+}
+---
+{
+ "hash1" : !Hash {
+ "hash2" : !Hash {
+ "hello3" : !String [ "world3" ],
+ },
+ "hello" : !String [ "world" ],
+ "hello2" : !String [ "world2" ],
+ },
+}
+---
+{
+ "hash1" : !Hash {
+ "hash2" : !Hash {
+ "array1" : !ResizablePMCArray [
+ !String [ "this" ],
+ !String [ "is" ],
+ !String [ "a" ],
+ !String [ "test" ],
+ !Hash {
+ "is" : !String [ "cool" ],
+ "name" : !String [ "parrot" ],
+ },
+ ],
+ "hello3" : !String [ "world3" ],
+ },
+ "hello" : !String [ "world" ],
+ "hello2" : !String [ "world2" ],
+ },
+}
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUTPUT', "dumping Integer PMC" );
+
+.sub test :main
+ .local pmc int1
+
+ new int1, 'Integer'
+ int1 = 12345
+ yaml( int1, "Int" )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "Int" : !Integer [ 12345 ],
+}
+OUTPUT
+
+
+pir_output_is( <<'CODE', <<'OUTPUT', "dumping Float PMC" );
+
+.sub test :main
+ .local pmc float1
+
+ new float1, 'Float'
+ float1 = 12345.678
+ yaml( float1, "Float" )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "Float" : !Float [ 12345.7 ],
+}
+OUTPUT
+
+
+
+pir_output_is( <<'CODE', <<'OUTPUT', "dumping ResizablePMCArray PMC" );
+.sub test :main
+ .local pmc array
+
+ new array, 'ResizablePMCArray'
+ push array, 12345
+ push array, "hello"
+ yaml( array, "array" )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "array" : !ResizablePMCArray [
+ !Integer [ 12345 ],
+ !String [ "hello" ],
+ ],
+}
+OUTPUT
+
+
+pir_output_is( <<'CODE', <<'OUTPUT', "dumping ResizableStringArray PMC" );
+.sub test :main
+ .local pmc array
+
+ new array, 'ResizableStringArray'
+ push array, "hello"
+ push array, "world"
+ yaml( array, "array:" )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "array:" : !ResizableStringArray [
+ !String [ "hello" ],
+ !String [ "world" ],
+ ],
+}
+OUTPUT
+
+
+pir_output_is( <<'CODE', <<'OUTPUT', "dumping ResizableIntegerArray PMC" );
+.sub test :main
+ .local pmc array
+
+ new array, 'ResizableIntegerArray'
+ push array, 12345
+ push array, 67890
+ yaml( array, "array:" )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "array:" : !ResizableIntegerArray [
+ !Integer [ 12345 ],
+ !Integer [ 67890 ],
+ ],
+}
+OUTPUT
+
+
+pir_output_is( <<'CODE', <<'OUTPUT', "dumping ResizableFloatArray PMC" );
+.sub test :main
+ .local pmc array
+
+ new array, 'ResizableFloatArray'
+ push array, 123.45
+ push array, 67.89
+ yaml( array, "array:" )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "array:" : !ResizableFloatArray [
+ !Float [ 123.45 ],
+ !Float [ 67.89 ],
+ ],
+}
+OUTPUT
+
+
+pir_output_is( <<'CODE', <<'OUTPUT', "dumping FixedPMCArray PMC" );
+.sub test :main
+ .local pmc array
+
+ new array, 'FixedPMCArray'
+ array = 2
+ array[0] = 12345
+ array[1] = "hello"
+ yaml( array, "array:" )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "array:" : !FixedPMCArray [
+ !Integer [ 12345 ],
+ !String [ "hello" ],
+ ],
+}
+OUTPUT
+
+
+pir_output_is( <<'CODE', <<'OUTPUT', "dumping FixedStringArray PMC" );
+.sub test :main
+ .local pmc array
+
+ new array, 'FixedStringArray'
+ array = 2
+ array[0] = "hello"
+ array[1] = "world"
+ yaml( array, "array:" )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "array:" : !FixedStringArray [
+ !String [ "hello" ],
+ !String [ "world" ],
+ ],
+}
+OUTPUT
+
+
+pir_output_is( <<'CODE', <<'OUTPUT', "dumping FixedIntegerArray PMC" );
+.sub test :main
+ .local pmc array
+
+ new array, 'FixedIntegerArray'
+ array = 2
+ array[0] = 12345
+ array[1] = 67890
+ yaml( array, "array:" )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "array:" : !FixedIntegerArray [
+ !Integer [ 12345 ],
+ !Integer [ 67890 ],
+ ],
+}
+OUTPUT
+
+
+pir_output_is( <<'CODE', <<'OUTPUT', "dumping FixedFloatArray PMC" );
+.sub test :main
+ .local pmc array
+
+ new array, 'FixedFloatArray'
+ array = 2
+ array[0] = 123.45
+ array[1] = 67.89
+ yaml( array, "array:" )
+.end
+.include "library/yaml_dumper.pir"
+CODE
+---
+{
+ "array:" : !FixedFloatArray [
+ !Float [ 123.45 ],
+ !Float [ 67.89 ],
+ ],
+}
+OUTPUT
+
+
+pir_output_is( <<'CODE', <<'OUTPUT', "custom dumper", todo => 'not yet
implemented');
+.sub main :main
+ .local pmc o, cl
+ cl = subclass 'ResizablePMCArray', 'bar'
+ o = new cl
+ yaml(o)
+.end
+
+.namespace ["bar"]
+.sub init :vtable :method
+ .local pmc ar
+ ar = getattribute self, ['ResizablePMCArray'], 'proxy'
+ push ar, 1
+ push ar, 2
+.end
+
+.sub __yaml :method
+ .param pmc dumper
+ .param string label
+ print " {\n"
+ .local pmc ar
+ ar = getattribute self, ['ResizablePMCArray'], 'proxy'
+ dumper.'yaml'('attr', ar)
+ print "\n}"
+.end
+.namespace
+.include 'library/yaml_dumper.pir'
+
+CODE
+---
+{
+ "VAR1" : !bar {
+ !ResizablePMCArray [
+ !Integer [ 1 ],
+ !Integer [ 2 ],
+ ],
+ },
+}
+OUTPUT
+
+# pir_output_is(<<'CODE', <<'OUTPUT', "dumping IntegerArray PMC");
+# pir_output_is(<<'CODE', <<'OUTPUT', "dumping FloatValArray PMC");
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4: