[svn:parrot] r39454 - in branches/io_rewiring: . config/auto/sizes docs/book docs/book/draft docs/dev docs/pdds examples/languages/abc examples/languages/squaak include/parrot ports/cpan ports/cygwin ports/debian ports/fedora ports/mandriva ports/suse runtime/parrot/library/Math src/call src/gc src/interp src/pmc src/runcore t/compilers/tge t/dynpmc t/library t/oo t/pmc t/src tools/dev tools/util
whiteknight at svn.parrot.org
whiteknight at svn.parrot.org
Mon Jun 8 21:20:16 UTC 2009
Author: whiteknight
Date: Mon Jun 8 21:20:11 2009
New Revision: 39454
URL: https://trac.parrot.org/parrot/changeset/39454
Log:
[io_rewiring] Merge from trunk r39444:39453
Modified:
branches/io_rewiring/ (props changed)
branches/io_rewiring/config/auto/sizes/intval_maxmin_c.in (props changed)
branches/io_rewiring/docs/book/appb_patch_submission.pod (props changed)
branches/io_rewiring/docs/book/ch01_introduction.pod (props changed)
branches/io_rewiring/docs/book/ch03_pir.pod (props changed)
branches/io_rewiring/docs/book/ch04_compiler_tools.pod (props changed)
branches/io_rewiring/docs/book/ch07_dynpmcs.pod (props changed)
branches/io_rewiring/docs/book/ch08_dynops.pod (props changed)
branches/io_rewiring/docs/book/ch10_opcode_reference.pod (props changed)
branches/io_rewiring/docs/book/draft/chXX_hlls.pod (props changed)
branches/io_rewiring/docs/book/draft/chXX_library.pod (props changed)
branches/io_rewiring/docs/book/draft/chXX_testing_and_debugging.pod (props changed)
branches/io_rewiring/docs/dev/c_functions.pod (props changed)
branches/io_rewiring/docs/pdds/pdd28_strings.pod
branches/io_rewiring/docs/pdds/pdd30_install.pod (props changed)
branches/io_rewiring/examples/languages/abc/ (props changed)
branches/io_rewiring/examples/languages/squaak/ (props changed)
branches/io_rewiring/include/parrot/call.h (props changed)
branches/io_rewiring/include/parrot/gc_api.h (props changed)
branches/io_rewiring/include/parrot/runcore_api.h (props changed)
branches/io_rewiring/include/parrot/runcore_trace.h (props changed)
branches/io_rewiring/ports/cpan/pause_guide.pod (props changed)
branches/io_rewiring/ports/cygwin/parrot-1.0.0-1.cygport (props changed)
branches/io_rewiring/ports/debian/libparrot-dev.install.in (props changed)
branches/io_rewiring/ports/debian/libparrot.install.in (props changed)
branches/io_rewiring/ports/debian/parrot-doc.install.in (props changed)
branches/io_rewiring/ports/debian/parrot.install.in (props changed)
branches/io_rewiring/ports/fedora/parrot.spec.fedora (props changed)
branches/io_rewiring/ports/mandriva/parrot.spec.mandriva (props changed)
branches/io_rewiring/ports/suse/parrot.spec.suse (props changed)
branches/io_rewiring/runtime/parrot/library/Math/Rand.pir (props changed)
branches/io_rewiring/src/call/ops.c (props changed)
branches/io_rewiring/src/call/pcc.c (props changed)
branches/io_rewiring/src/gc/alloc_memory.c (props changed)
branches/io_rewiring/src/gc/alloc_register.c (props changed)
branches/io_rewiring/src/gc/alloc_resources.c (props changed)
branches/io_rewiring/src/gc/api.c (props changed)
branches/io_rewiring/src/gc/generational_ms.c (props changed)
branches/io_rewiring/src/gc/incremental_ms.c (props changed)
branches/io_rewiring/src/gc/malloc.c (props changed)
branches/io_rewiring/src/gc/malloc_trace.c (props changed)
branches/io_rewiring/src/gc/mark_sweep.c (props changed)
branches/io_rewiring/src/gc/system.c (props changed)
branches/io_rewiring/src/interp/inter_cb.c (props changed)
branches/io_rewiring/src/interp/inter_create.c (props changed)
branches/io_rewiring/src/interp/inter_misc.c (props changed)
branches/io_rewiring/src/pmc/codestring.pmc
branches/io_rewiring/src/runcore/cores.c (props changed)
branches/io_rewiring/src/runcore/main.c (props changed)
branches/io_rewiring/src/runcore/trace.c (props changed)
branches/io_rewiring/t/compilers/tge/NoneGrammar.tg (props changed)
branches/io_rewiring/t/dynpmc/pair.t (props changed)
branches/io_rewiring/t/library/pcre.t
branches/io_rewiring/t/oo/root_new.t (props changed)
branches/io_rewiring/t/pmc/array.t
branches/io_rewiring/t/src/embed.t (props changed)
branches/io_rewiring/tools/dev/fetch_languages.pl (props changed)
branches/io_rewiring/tools/dev/mk_gitignore.pl (props changed)
branches/io_rewiring/tools/dev/mk_native_pbc
branches/io_rewiring/tools/util/perlcritic-cage.conf (props changed)
Modified: branches/io_rewiring/docs/pdds/pdd28_strings.pod
==============================================================================
--- branches/io_rewiring/docs/pdds/pdd28_strings.pod Mon Jun 8 16:55:48 2009 (r39453)
+++ branches/io_rewiring/docs/pdds/pdd28_strings.pod Mon Jun 8 21:20:11 2009 (r39454)
@@ -39,7 +39,7 @@
An encoding determines how a codepoint is represented inside a computer.
Simple encodings like ASCII define that the codepoints 0-127 simply
live as their numeric equivalents inside an eight-bit bytes. Other
-fixed-width encodings like UTF-16 use more bytes to encode more
+fixed-width encodings like UCS-2 use more bytes to encode more
codepoints. Variable-width encodings like UTF-8 use one byte for
codepoints 0-127, two bytes for codepoints 127-2047, and so on.
Modified: branches/io_rewiring/src/pmc/codestring.pmc
==============================================================================
--- branches/io_rewiring/src/pmc/codestring.pmc Mon Jun 8 16:55:48 2009 (r39453)
+++ branches/io_rewiring/src/pmc/codestring.pmc Mon Jun 8 21:20:11 2009 (r39454)
@@ -128,7 +128,8 @@
if ('\n' != Parrot_str_indexed(INTERP, fmt, Parrot_str_byte_length(interp, fmt) - 1))
fmt = Parrot_str_concat(INTERP, fmt, newline, 0);
- S1 = Parrot_str_concat(INTERP, SELF.get_string(), fmt, 0);
+ GET_ATTR_str_val(INTERP, SELF, S1);
+ S1 = Parrot_str_concat(INTERP, S1, fmt, 0);
VTABLE_set_string_native(INTERP, SELF, S1);
RETURN(PMC *SELF);
@@ -168,17 +169,22 @@
ipos = last_pos;
}
- str = SELF.get_string();
+ GET_ATTR_str_val(INTERP, SELF, str);
jpos = Parrot_str_find_cclass(INTERP, enum_cclass_newline, str, ipos, pos);
while (jpos < pos) {
- line++;
+
+ if (ipos
+ && jpos == ipos
+ && string_ord(INTERP, str, jpos) == 10
+ && string_ord(INTERP, str, ipos - 1) == 13) {
+ /* do not increment line; \r\n is a single line separator */
+ }
+ else
+ line++;
ipos = jpos + 1;
- /* treat \r\n as a single line separator */
- ipos += (string_ord(INTERP, str, jpos) == 13
- && string_ord(INTERP, str, jpos + 1) == 10);
jpos = Parrot_str_find_cclass(INTERP, enum_cclass_newline, str, ipos, pos);
}
Modified: branches/io_rewiring/t/library/pcre.t
==============================================================================
--- branches/io_rewiring/t/library/pcre.t Mon Jun 8 16:55:48 2009 (r39453)
+++ branches/io_rewiring/t/library/pcre.t Mon Jun 8 21:20:11 2009 (r39454)
@@ -57,10 +57,10 @@
.local pmc lib_paths
lib_paths = interp[.IGLOBALS_LIB_PATHS]
- # XXX - hard-coded magic constant (should be PARROT_LIB_PATH_DYNEXT)
- .local pmc include_paths
- include_paths = lib_paths[2]
- unshift include_paths, '$pcre_libpath'
+ # TT #747 - hard-coded magic constant (should be PARROT_LIB_PATH_DYNEXT)
+ .local pmc dynext_path
+ dynext_path = lib_paths[2]
+ unshift dynext_path, '$pcre_libpath'
load_bytecode 'pcre.pbc'
.local pmc func
Modified: branches/io_rewiring/t/pmc/array.t
==============================================================================
--- branches/io_rewiring/t/pmc/array.t Mon Jun 8 16:55:48 2009 (r39453)
+++ branches/io_rewiring/t/pmc/array.t Mon Jun 8 21:20:11 2009 (r39454)
@@ -1,13 +1,7 @@
-#! perl
-# Copyright (C) 2001-2007, Parrot Foundation.
+#! parrot
+# Copyright (C) 2001-2009, Parrot Foundation.
# $Id$
-use strict;
-use warnings;
-use lib qw( . lib ../lib ../../lib );
-use Test::More;
-use Parrot::Test tests => 16;
-
=head1 NAME
t/pmc/array.t - Array PMC
@@ -23,448 +17,396 @@
=cut
-pasm_output_is( <<'CODE', <<'OUTPUT', "Setting array size" );
- new P0, ['Array']
+.namespace []
+
+.include "except_types.pasm"
+.include 'fp_equality.pasm'
+
+.sub main :main
+ .include 'test_more.pir'
+
+ plan(64)
+
+ setting_array_size() # 4 tests
+ setting_first_element() # 3 tests
+ setting_second_element() # 3 tests
+ setting_out_of_bounds_element() # 2 tests
+ defined_sub() # 8 tests
+ exists_sub() # 6 tests
+ set_via_pmc_keys_access_via_ints() # 4 tests
+ set_via_ints_access_via_pmc_keys() # 4 tests
+ multikeyed_access_i_arg() # 5 tests
+ multikeyed_access_p_arg() # 5 tests
+ delete_sub() # 3 tests
+ check_whether_interface_is_done() # 3 tests
+ get_bool() # 4 tests
+ freeze_thaw() # 5 tests
+ array_comparison() # 5 tests
+.end
+
+
+.sub setting_array_size
+ .local pmc foo, ifoo
+ .local int size
+
+ foo = new ['Array']
+ size = foo
+ is(size, 0, 'array size initialised to 0 correctly')
+
+ foo = 1
+ size = foo
+ is(size, 1, 'array size set to 1 correctly')
+
+ foo = 2
+ size = foo
+ is(size, 2, 'array size set to 2 correctly')
+
+ ifoo = new ['Integer']
+ ifoo = 3
+ foo = ifoo
+ size = foo
+ is(size, 3, 'array size set to 3 correctly')
+.end
+
+.sub setting_first_element
+ .local pmc foo
+ .local int ival
+ .local num nval
+ .local string sval
+
+ foo = new ['Array']
+ foo = 1
+
+ foo[0] = -7
+ ival = foo[0]
+ is(ival, -7, 'array first element set to integer correctly')
+
+ foo[0] = 3.7
+ nval = foo[0]
+ is(nval, 3.7, 'array first element set to number correctly')
+
+ foo[0] = "Buckaroo"
+ sval = foo[0]
+ is(sval, "Buckaroo", 'array first element set to string correctly')
+.end
+
+.sub setting_second_element
+ .local pmc foo
+ .local int ival
+ .local num nval
+ .local string sval
+
+ foo = new ['Array']
+ foo = 2
+
+ foo[1] = -7
+ ival = foo[1]
+ is(ival, -7, 'array second element set to integer correctly')
+
+ foo[1] = 3.7
+ nval = foo[1]
+ is(nval, 3.7, 'array second element set to number correctly')
+
+ foo[1] = "Buckaroo"
+ sval = foo[1]
+ is(sval, "Buckaroo", 'array second element set to string correctly')
+.end
+
+.sub setting_out_of_bounds_element
+ .local pmc foo, eh
+ .local int ifoo
+
+ foo = new ['Array']
+ foo = 1
+
+ eh = new ['ExceptionHandler']
+ eh.'handle_types'(.EXCEPTION_OUT_OF_BOUNDS)
+ set_addr eh, eh_label
+
+ foo[0] = 42
+ ifoo = foo[0]
+ is(ifoo, 42, 'array in-bounds element set correctly')
+
+ push_eh eh
+ foo[1] = -7
+ pop_eh
+
+ ok(0, 'setting_out_of_bounds_element')
+ goto end
+
+eh_label:
+ .local string message
+ .get_results($P0)
+ message = $P0['message']
+ is(message, "Array index out of bounds!", 'setting_out_of_bounds_element')
+
+end:
+.end
+
+.sub defined_sub
+ .local pmc foo, bar, baz
+ .local int ival
+
+ foo = new ['Array']
+ defined ival, foo
+ is(ival, 1, 'newed array is defined')
+
+ defined ival, bar
+ is(ival, 0, 'unreferenced pmc is undefined')
+
+ foo = 5
+ foo[0] = 1
+ defined ival, foo[0]
+ is(ival, 1, 'assigned array element is defined')
+
+ defined ival, foo[1]
+ is(ival, 0, 'unassigned in-bounds array element is undefined')
+
+ defined ival, foo[100]
+ is(ival, 0, 'unassigned out-of-bounds array element is undefined')
+
+ bar = new ['Undef']
+ foo[2] = bar
+ defined ival, foo[2]
+ is(ival, 0, 'assigned undef pmc is undefined')
+
+ baz = new ['Key']
+ baz = 3
+ foo[3] = 4
+ defined ival, foo[baz]
+ is(ival, 1, 'defined keyed array element is defined')
+
+ baz = 4
+ defined ival, foo[baz]
+ is(ival, 0, 'undefined keyed array element is defined')
+.end
+
+.sub exists_sub
+ .local pmc foo, bar, baz
+ .local int ival
+
+ foo = new ['Array']
+ foo = 5
+ foo[0] = 1
+ exists ival, foo[0]
+ is(ival, 1, 'assigned array element exists')
+
+ exists ival, foo[1]
+ is(ival, 0, 'unassigned in-bounds array element does not exist')
+
+ exists ival, foo[100]
+ is(ival, 0, 'unassigned out-of-bounds array element does not exist')
+
+ bar = new ['Undef']
+ foo[2] = bar
+ exists ival, foo[2]
+ is(ival, 1, 'assigned undef array element exists')
+
+ baz = new ['Key']
+ baz = 3
+ foo[3] = 4
+ exists ival, foo[baz]
+ is(ival, 1, 'defined keyed array element exists')
+
+ baz = 4
+ exists ival, foo[baz]
+ is(ival, 0, 'undefined keyed array element does not exist')
+.end
+
+.sub set_via_pmc_keys_access_via_ints
+ .local pmc foo, bar, baz, faz
+ .local int ival
+ .local num nval
+ .local string sval, inner
+
+ foo = new ['Array']
+ foo = 4
+ bar = new ['Key']
+
+ bar = 0
+ foo[bar] = 25
+ ival = foo[0]
+ is(ival, 25, 'integer element can be retrieved from array')
+
+ bar = 1
+ foo[bar] = 2.5
+ nval = foo[1]
+ is(nval, 2.5, 'number element can be retrieved from array')
+
+ bar = 2
+ foo[bar] = "Squeek"
+ sval = foo[2]
+ is(sval, "Squeek", 'string element can be retrieved from array')
+
+ bar = 3
+ baz = new ['Hash']
+ baz["a"] = "apple"
+ foo[bar] = baz
+
+ faz = foo[3]
+ inner = faz["a"]
+ is(inner, "apple", 'inner string element can be retrieved from array')
+.end
+
+.sub set_via_ints_access_via_pmc_keys
+ .local pmc foo, bar, baz, faz
+ .local int ival, inner
+ .local num nval
+ .local string sval
+
+ foo = new ['Array']
+ foo = 1024
+
+ foo[25] = 125
+ foo[128] = -9.9
+ foo[513] = "qwertyuiopasdfghjklzxcvbnm"
+ bar = new ['Integer']
+ bar = 123456
+ foo[1023] = bar
+
+ baz = new ['Key']
+ baz = 25
+
+ ival = foo[baz]
+ is(ival, 125, 'integer element can be retrieved from array')
+
+ baz = 128
+ nval = foo[baz]
+ is(nval, -9.9, 'number element can be retrieved from array')
+
+ baz = 513
+ sval = foo[baz]
+ is(sval, "qwertyuiopasdfghjklzxcvbnm", 'string element can be retrieved from array')
+
+ baz = 1023
+ faz = foo[baz]
+ inner = faz
+ is(inner, 123456, 'indirect integer element can be retrieved from array')
+.end
+
+.sub multikeyed_access_i_arg
+ .local pmc foo, bar, baz
+ .local int ival, inum
+ .local string pmctype
+
+ foo = new ['Array']
+ foo = 1
+ bar = new ['Array']
+ bar = 1
+
+ foo[0] = bar
+ foo[0;0] = 20
+ baz = foo[0]
+ typeof pmctype, baz
+ is(pmctype, 'Array', 'pmc is an array')
+
+ ival = foo[0;0]
+ is(ival, 20, 'access to array via [int;int] works correctly')
+
+ inum = 0
+ ival = foo[inum;0]
+ is(ival, 20, 'access to array via [var;int] works correctly')
+
+ ival = foo[0;inum]
+ is(ival, 20, 'access to array via [int;var] works correctly')
+
+ ival = foo[inum;inum]
+ is(ival, 20, 'access to array via [var;var] works correctly')
+.end
+
+.sub multikeyed_access_p_arg
+ .local pmc foo, bar, baz, faz
+ .local int ival, inum
+ .local string pmctype
+
+ foo = new ['Array']
+ foo = 1
+ bar = new ['Array']
+ bar = 1
+
+ faz = new ['Integer']
+ faz = 20
+ foo[0] = bar
+ foo[0;0] = faz
+ baz = foo[0]
+ typeof pmctype, baz
+ is(pmctype, 'Array', 'pmc is an array')
+
+ ival = foo[0;0]
+ is(ival, 20, 'access to array via [int;int] works correctly')
+
+ inum = 0
+ ival = foo[inum;0]
+ is(ival, 20, 'access to array via [var;int] works correctly')
+
+ ival = foo[0;inum]
+ is(ival, 20, 'access to array via [int;var] works correctly')
+
+ ival = foo[inum;inum]
+ is(ival, 20, 'access to array via [var;var] works correctly')
+.end
+
+.sub delete_sub
+ .local pmc foo
+ .local int ival
+
+ foo = new ['Array']
+ foo = 3
+ foo[0] = 10
+ foo[1] = 20
+ foo[2] = 30
+
+ delete foo[1]
+ ival = foo
+ is(ival, 2, 'array with deleted element correctly sized')
- set I0,P0
- eq I0,0,OK_1
- print "not "
-OK_1: print "ok 1\n"
-
- set P0,1
- set I0,P0
- eq I0,1,OK_2
- print "not "
-OK_2: print "ok 2\n"
-
- set P0,2
- set I0,P0
- eq I0,2,OK_3
- print "not "
-OK_3: print "ok 3\n"
-
- new P1, ['Integer']
- set P1, 3
- set P0,P1
- set I0,P0
- eq I0,3,OK_4
- print "not "
-OK_4: print "ok 4\n"
-
-
- end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-OUTPUT
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "Setting first element" );
- new P0, ['Array']
- set P0, 1
-
- set P0[0],-7
- set I0,P0[0]
- eq I0,-7,OK_1
- print "not "
-OK_1: print "ok 1\n"
-
- set P0[0],3.7
- set N0,P0[0]
- eq N0,3.7,OK_2
- print "not "
-OK_2: print "ok 2\n"
-
- set P0[0],"Buckaroo"
- set S0,P0[0]
- eq S0,"Buckaroo",OK_3
- print "not "
-OK_3: print "ok 3\n"
-
- end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "Setting second element" );
- new P0, ['Array']
- set P0, 2
-
- set P0[1], -7
- set I0, P0[1]
- eq I0,-7,OK_1
- print "not "
-OK_1: print "ok 1\n"
-
- set P0[1], 3.7
- set N0, P0[1]
- eq N0,3.7,OK_2
- print "not "
-OK_2: print "ok 2\n"
-
- set P0[1],"Buckaroo"
- set S0, P0[1]
- eq S0,"Buckaroo",OK_3
- print "not "
-OK_3: print "ok 3\n"
-
- end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-
-pasm_error_output_like( <<'CODE', <<'OUTPUT', "Setting out-of-bounds elements" );
- new P0, ['Array']
- set P0, 1
-
- set P0[1], -7
-
- end
-CODE
-/^Array index out of bounds!
-current instr/
-OUTPUT
-
-pasm_error_output_like( <<'CODE', <<'OUTPUT', "Getting out-of-bounds elements" );
- new P0, ['Array']
- set P0, 1
-
- set I0, P0[1]
- end
-CODE
-/^Array index out of bounds!
-current instr/
-OUTPUT
-
-pasm_output_is( <<'CODE', <<OUTPUT, "defined" );
- new P0, ['Array']
- defined I0, P0
- print I0
- print "\n"
- defined I0, P1
- print I0
- print "\n"
- set P0, 5
- set P0[0], 1
- defined I0, P0[0]
- print I0
- print "\n"
- defined I0, P0[1]
- print I0
- print "\n"
- defined I0, P0[100]
- print I0
- print "\n"
- new P1, ['Undef']
- set P0[2], P1
- defined I0, P0[2]
- print I0
- print "\n"
- new P2, ['Key']
- set P2, 3
- set P0[3], 4
- defined I0, P0[P2]
- print I0
- print "\n"
- set P2, 4
- defined I0, P0[P2]
- print I0
- print "\n"
- end
-CODE
-1
-0
-1
-0
-0
-0
-1
-0
-OUTPUT
-
-pasm_output_is( <<'CODE', <<OUTPUT, "exists" );
- new P0, ['Array']
- set P0, 5
- set P0[0], 1
- exists I0, P0[0]
- print I0
- print "\n"
- exists I0, P0[1]
- print I0
- print "\n"
- exists I0, P0[100]
- print I0
- print "\n"
- new P1, ['Undef']
- set P0[2], P1
- exists I0, P0[2]
- print I0
- print "\n"
- new P2, ['Key']
- set P2, 3
- set P0[3], 4
- exists I0, P0[P2]
- print I0
- print "\n"
- set P2, 4
- exists I0, P0[P2]
- print I0
- print "\n"
- end
-CODE
-1
-0
-0
-1
-1
-0
-OUTPUT
-
-pasm_output_is( <<"CODE", <<'OUTPUT', "Set via PMC keys, access via INTs" );
- .include 'fp_equality.pasm'
- new P0, ['Array']
- set P0, 4
- new P1, ['Key']
-
- set P1, 0
- set P0[P1], 25
-
- set P1, 1
- set P0[P1], 2.5
-
- set P1, 2
- set P0[P1], "Squeek"
-
- set P1, 3
- new P2, ['Hash']
- set P2["a"], "apple"
- set P0[P1], P2
-
- set I0, P0[0]
- eq I0, 25, OK1
- print "not "
-OK1: print "ok 1\\n"
-
- set N0, P0[1]
- .fp_eq_pasm(N0, 2.5, OK2)
- print "not "
-OK2: print "ok 2\\n"
-
- set S0, P0[2]
- eq S0, "Squeek", OK3
- print "not "
-OK3: print "ok 3\\n"
-
- set P3, P0[3]
- set S1, P3["a"]
- eq S1, "apple", OK4
- print "not "
-OK4: print "ok 4\\n"
-
- end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-OUTPUT
-
-pasm_output_is( <<"CODE", <<'OUTPUT', "Set via INTs, access via PMC Keys" );
- .include 'fp_equality.pasm'
- new P0, ['Array']
- set P0, 1024
-
- set P0[25], 125
- set P0[128], -9.9
- set P0[513], "qwertyuiopasdfghjklzxcvbnm"
- new P1, ['Integer']
- set P1, 123456
- set P0[1023], P1
-
- new P2, ['Key']
- set P2, 25
- set I0, P0[P2]
- eq I0, 125, OK1
- print "not "
-OK1: print "ok 1\\n"
-
- set P2, 128
- set N0, P0[P2]
- .fp_eq_pasm(N0, -9.9, OK2)
- print "not "
-OK2: print "ok 2\\n"
-
- set P2, 513
- set S0, P0[P2]
- eq S0, "qwertyuiopasdfghjklzxcvbnm", OK3
- print "not "
-OK3: print "ok 3\\n"
-
- set P2, 1023
- set P3, P0[P2]
- set I1, P3
- eq I1, 123456, OK4
- print "not "
-OK4: print "ok 4\\n"
-
- end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-OUTPUT
-
-pasm_output_is( <<'CODE', <<OUT, "multikeyed access I arg" );
- new P0, ['Array']
- set P0, 1
- new P1, ['Array']
- set P1, 1
- set P0[0], P1
- set P0[0;0], 20
- set P2, P0[0]
- typeof S0, P2
- print S0
- print "\n"
- set I2, P0[0;0]
- print I2
- set I3, 0
- set I2, P0[I3;0]
- print I2
- set I2, P0[0;I3]
- print I2
- set I2, P0[I3;I3]
- print I2
- print "\n"
- end
-CODE
-Array
-20202020
-OUT
-
-pasm_output_is( <<'CODE', <<OUT, "multikeyed access P arg" );
- new P0, ['Array']
- set P0, 1
- new P1, ['Array']
- set P1, 1
- new P3, ['Integer']
- set P3, 20
- set P0[0], P1
- set P0[0;0], P3
- set P2, P0[0]
- typeof S0, P2
- print S0
- print "\n"
- set I2, P0[0;0]
- print I2
- set I3, 0
- set I2, P0[I3;0]
- print I2
- set I2, P0[0;I3]
- print I2
- set I2, P0[I3;I3]
- print I2
- print "\n"
- end
-CODE
-Array
-20202020
-OUT
-
-pasm_output_is( <<'CODE', <<OUT, "delete" );
- new P0, ['Array']
- set P0, 3
- set P0[0], 10
- set P0[1], 20
- set P0[2], 30
-
- delete P0[1]
- set I0, P0
- print I0
-
- set I0, P0[0]
- print I0
- set I0, P0[1]
- print I0
- print "\n"
- end
-CODE
-21030
-OUT
+ ival = foo[0]
+ is(ival, 10, 'array with deleted element has correct first element')
-pir_output_is( << 'CODE', << 'OUTPUT', "check whether interface is done" );
+ ival = foo[1]
+ is(ival, 30, 'array with deleted element has correct first element')
+.end
-.sub _main
+.sub check_whether_interface_is_done
.local pmc pmc1
pmc1 = new ['Array']
.local int bool1
does bool1, pmc1, "scalar"
- print bool1
- print "\n"
+ is(bool1, 0, 'pmc array does not do scalar correctly')
+
does bool1, pmc1, "array"
- print bool1
- print "\n"
+ is(bool1, 1, 'pmc array does array correctly')
+
does bool1, pmc1, "no_interface"
- print bool1
- print "\n"
- end
+ is(bool1, 0, 'pmc array does not do no_interface correctly')
.end
-CODE
-0
-1
-0
-OUTPUT
-
-pir_output_is( << 'CODE', << 'OUTPUT', "get_bool" );
-
-.sub _main
+.sub get_bool
.local pmc p
.local int i
- p = new ['Array']
-
- if p goto L1
- print "not "
-L1: say "true"
+ p = new ['Array']
+ is(p, 0, 'newed array is not true correctly')
+
p = 4
-
- if p goto L2
- print "is not "
-L2: say "true"
-
+ is(p, 4, 'resized array is true correctly')
p[0] = 2
- if p goto L3
- print "not "
-L3: say "true"
+ is(p, 4, 'assigned array is true correctly')
p = new ['Array']
p = 0
- if p goto L4
- print "not "
-L4: say "true"
-
-.end
-CODE
-not true
-true
-true
-not true
-OUTPUT
-
-TODO: {
- local $TODO = "freeze/thaw known to be broken";
-pir_output_is( << 'CODE', << 'OUTPUT', "freeze/thaw" );
-.sub main
+ is(p, 0, 'newed array set to zero length is not true correctly')
+.end
+
+
+.sub freeze_thaw
.local pmc p, it, val
.local string s
+ .local string reason
+ reason = "freeze/thaw known to be broken"
+
p = new ['Array']
unshift p, 2
@@ -478,70 +420,77 @@
it = iter p
-iter_loop:
- unless it goto iter_end
val = shift it
- print val
- print "\n"
- goto iter_loop
-
-iter_end:
-
-.end
-CODE
-p
--3
-9999
-foo
-2
-OUTPUT
-}
+ #is(val, '"p"', 'first thawed array element accessed correctly')
+ unless null val goto NOT_NULL_1
+ val = new 'String'
+ NOT_NULL_1:
+ $I0 = cmp val, '"p"'
+ $I0 = not $I0
+ todo($I0, 'first thawed array element accessed correctly', reason)
+
+ val = shift it
+ #is(val, '-3', 'second thawed array element accessed correctly')
+ unless null val goto NOT_NULL_2
+ val = new 'String'
+ NOT_NULL_2:
+ $I0 = cmp val, -3
+ $I0 = not $I0
+ todo($I0, 'second thawed array element accessed correctly', reason)
+
+ val = shift it
+ #is(val, '9999', 'third thawed array element accessed correctly')
+ unless null val goto NOT_NULL_3
+ val = new 'String'
+ NOT_NULL_3:
+ $I0 = cmp val, '9999'
+ $I0 = not $I0
+ todo($I0, 'third thawed array element accessed correctly', reason)
+
+ val = shift it
+ #is(val, 'foo', 'fourth thawed array element accessed correctly')
+ unless null val goto NOT_NULL_4
+ val = new 'String'
+ NOT_NULL_4:
+ $I0 = cmp val, 'foo'
+ $I0 = not $I0
+ todo($I0, 'fourth thawed array element accessed correctly', reason)
-pir_output_is( << 'CODE', << 'OUTPUT', "array comparison" );
-.sub main
+ val = shift it
+ #is(val, '2', 'fifth thawed array element accessed correctly')
+ unless null val goto NOT_NULL_5
+ val = new 'String'
+ NOT_NULL_5:
+ $I0 = cmp val, '2'
+ $I0 = not $I0
+ todo($I0, 'fifth thawed array element accessed correctly', reason)
+.end
+
+.sub array_comparison
.local pmc a1, a2
.local int i
a1 = new ['Array']
a2 = new ['Array']
- if a1 == a2 goto L1
- print "not "
-L1: say "equal"
+ is(a1, a2, 'two newed arrays are equal correctly')
a1 = 4
-
- if a1 == a2 goto L2
- print "not "
-L2: say "equal"
+ isnt(a1, a2, 'a sized array is not the same as a newed array correctly')
a2 = 4
+ is(a1, a2, 'two identically sized arrays are equal correctly')
a1[0] = "foo"
a2[0] = "foo"
-
- if a1 == a2 goto L3
- print "not "
-L3: say "equal"
+ is(a1, a2, 'two identically assigned arrays are equal correctly')
a1[1] = 234
a2[1] = 234
a1[3] = "bar"
a2[3] = "bar"
-
- if a1 == a2 goto L4
- print "not "
-L4: say "equal"
-
+ is(a1, a2, 'two identically assigned arrays are equal correctly')
.end
-CODE
-equal
-not equal
-equal
-equal
-OUTPUT
-
-1;
# Local Variables:
# mode: cperl
Modified: branches/io_rewiring/tools/dev/mk_native_pbc
==============================================================================
--- branches/io_rewiring/tools/dev/mk_native_pbc Mon Jun 8 16:55:48 2009 (r39453)
+++ branches/io_rewiring/tools/dev/mk_native_pbc Mon Jun 8 21:20:11 2009 (r39454)
@@ -139,6 +139,18 @@
perl t/harness t/native_pbc/number.t && \
perl t/harness t/native_pbc/string.t
+./parrot -o t/native_pbc/annotations.pbc - <<EOF
+.sub 'main'
+.annotate "file", "annotations.pir"
+.annotate "creator", "Parrot Foundation"
+.annotate "line", 1
+ say "Hi"
+ say "line"
+.annotate "line", 2
+ .return ()
+.end
+EOF
+
if [ "$enable_long_double" = "1" ]; then
if [ "$1" = "--noconf" ]; then
echo "Hmm. You have no long double, and we want to try --floatval=long double"
More information about the parrot-commits
mailing list