[svn:parrot] r41355 - in branches/kill_jit: . compilers/imcc docs/book/pir examples/pir include/parrot runtime/parrot/include runtime/parrot/library/PGE runtime/parrot/library/Tcl runtime/parrot/library/Test src src/interp src/pmc src/runcore t/compilers/imcc/syn t/library t/pmc t/src tools/dev

darbelo at svn.parrot.org darbelo at svn.parrot.org
Sat Sep 19 07:27:33 UTC 2009


Author: darbelo
Date: Sat Sep 19 07:27:32 2009
New Revision: 41355
URL: https://trac.parrot.org/parrot/changeset/41355

Log:
Sync with trunk.

Added:
   branches/kill_jit/examples/pir/make_hello_pbc.pir
      - copied unchanged from r41354, trunk/examples/pir/make_hello_pbc.pir
Modified:
   branches/kill_jit/   (props changed)
   branches/kill_jit/DEPRECATED.pod
   branches/kill_jit/compilers/imcc/optimizer.c
   branches/kill_jit/docs/book/pir/ch06_subroutines.pod
   branches/kill_jit/include/parrot/runcore_trace.h   (props changed)
   branches/kill_jit/runtime/parrot/include/hllmacros.pir
   branches/kill_jit/runtime/parrot/library/PGE/Glob.pir
   branches/kill_jit/runtime/parrot/library/Tcl/Glob.pir
   branches/kill_jit/runtime/parrot/library/Test/More.pir
   branches/kill_jit/src/interp/inter_create.c   (props changed)
   branches/kill_jit/src/packfile.c
   branches/kill_jit/src/pmc/env.pmc
   branches/kill_jit/src/pmc/sub.pmc
   branches/kill_jit/src/runcore/cores.c   (props changed)
   branches/kill_jit/src/runcore/trace.c   (props changed)
   branches/kill_jit/t/compilers/imcc/syn/regressions.t
   branches/kill_jit/t/library/test_more.t
   branches/kill_jit/t/pmc/sub.t
   branches/kill_jit/t/src/embed.t   (props changed)
   branches/kill_jit/tools/dev/mk_gitignore.pl   (props changed)

Modified: branches/kill_jit/DEPRECATED.pod
==============================================================================
--- branches/kill_jit/DEPRECATED.pod	Sat Sep 19 07:22:47 2009	(r41354)
+++ branches/kill_jit/DEPRECATED.pod	Sat Sep 19 07:27:32 2009	(r41355)
@@ -151,7 +151,7 @@
 
 =item mmd_cvt_to_types [eligible in 1.1]
 
-L<http://rt.perl.org/rt3/Ticket/Display.html?id=60626>
+L<https://trac.parrot.org/parrot/ticket/907>
 
 =item Subs marked with C<:vtable>/C<:method> aren't in namespace [eligible in 1.1]
 

Modified: branches/kill_jit/compilers/imcc/optimizer.c
==============================================================================
--- branches/kill_jit/compilers/imcc/optimizer.c	Sat Sep 19 07:22:47 2009	(r41354)
+++ branches/kill_jit/compilers/imcc/optimizer.c	Sat Sep 19 07:27:32 2009	(r41355)
@@ -209,7 +209,6 @@
 
     if (IMCC_INFO(interp)->optimizer_level & OPT_PRE) {
         IMCC_info(interp, 2, "pre_optimize\n");
-        /* RT #46281 integrate all in one pass */
         changed += strength_reduce(interp, unit);
         if (!IMCC_INFO(interp)->dont_optimize)
             changed += if_branch(interp, unit);

Modified: branches/kill_jit/docs/book/pir/ch06_subroutines.pod
==============================================================================
--- branches/kill_jit/docs/book/pir/ch06_subroutines.pod	Sat Sep 19 07:22:47 2009	(r41354)
+++ branches/kill_jit/docs/book/pir/ch06_subroutines.pod	Sat Sep 19 07:27:32 2009	(r41355)
@@ -541,7 +541,7 @@
 
 =begin PIR_FRAGMENT
 
-  $P0 = inspect $P0, "pos_required"
+  $P1 = inspect $P0, "pos_required"
 
 =end PIR_FRAGMENT
 

Copied: branches/kill_jit/examples/pir/make_hello_pbc.pir (from r41354, trunk/examples/pir/make_hello_pbc.pir)
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ branches/kill_jit/examples/pir/make_hello_pbc.pir	Sat Sep 19 07:27:32 2009	(r41355, copy of r41354, trunk/examples/pir/make_hello_pbc.pir)
@@ -0,0 +1,92 @@
+# Sample creating of "Hello World" program using Packfile PMCs.
+.sub 'main'
+    .local pmc pf, pfdir, pffixup, pfbc, pfconst
+
+    # Hello World is something like
+    # .sub 'hello'
+    #    say "Hello World"
+    # .end
+    # To generate PBC we need few bits
+
+    # First thing
+    # Packfile will be created with fresh directory
+    pf = new 'Packfile'
+    pfdir = pf.'get_directory'()
+
+    # We need some constants
+    # Interpreter.
+    pfconst = new 'PackfileConstantTable'
+    $P0 = getinterp
+    pfconst[0] = $P0
+
+    # Empty FIA for handling returns from "hello"
+    $P0 = new 'FixedIntegerArray'
+    pfconst[1] = $P0
+
+    # "Hello World" string
+    pfconst[2] = "Hello World"
+
+    # "hello" is function name
+    pfconst[3] = "hello"
+
+    # "hello.pir" is our pir file which we are "compiling"
+    pfconst[4] = "hello.pir"
+
+    # We will need Sub PMC as well but will deal with it later.
+    # Add PackfileConstantTable into directory.
+    pfdir["CONSTANTS_hello.pir"] = pfconst
+
+    # Generate bytecode
+    pfbc = new 'PackfileRawSegment'
+
+    # There is our function
+    pfbc[0] = 0x1d1 # say_sc
+    pfbc[1] = 0x002 # constant id.
+
+    pfbc[2] = 0x026 # set_return_pc
+    pfbc[3] = 0x001 # id of FIA
+
+    pfbc[4] = 0x020 # returncc
+
+    # Store bytecode
+    pfdir['BYTECODE_hello.pir'] = pfbc
+
+    # Now create Sub PMC using hash of values.
+    $P0 = new 'Hash'
+    $P0['start_offs']   = 0
+    $P0['end_offs']     = 5
+    $P0['name']         = 'hello'
+    $P0['subid']        = 'hello'
+    $P0['ns_entry_name']= 'hello'
+    $P0['method']       = ''
+    $P0['HLL_id']       = 0
+
+    $P1 = new 'Sub', $P0
+    # and store it in PackfileConstantTable
+    pfconst[5] = $P1
+
+    # Dark magik. Create Fixup for Sub.
+    pffixup = new 'PackfileFixupTable'
+    # Add it to Directory now because adding FixupEntries require Directory
+    pfdir["FIXUP_hello.pir"] = pffixup
+
+    $P1 = new 'PackfileFixupEntry'
+    $P1 = 'hello'
+    $P1.'set_type'(2)
+    $P1 = 5 # offset
+    pffixup[0] = $P1
+
+    # Now pack Packfile and save it
+    $S0 = pf
+    $P1 = open "generated_hello.pbc", "w"
+    $P1.'puts'($S0)
+    close $P1
+
+    # And check it!
+    load_bytecode 'generated_hello.pbc'
+    $P1 = find_sub_not_null 'hello'
+    $P1()
+
+.end
+
+# vim: ft=pir

Modified: branches/kill_jit/runtime/parrot/include/hllmacros.pir
==============================================================================
--- branches/kill_jit/runtime/parrot/include/hllmacros.pir	Sat Sep 19 07:22:47 2009	(r41354)
+++ branches/kill_jit/runtime/parrot/include/hllmacros.pir	Sat Sep 19 07:27:32 2009	(r41355)
@@ -149,7 +149,7 @@
 
 =cut
 
-# RT #55808 - the unlikely to conflict variable names here must be
+# TT #911 - the unlikely to conflict variable names here must be
 # replaced with the .macro_local syntax.
 .macro Foreach(name, array, code)
     .local int __Foreach__local__i

Modified: branches/kill_jit/runtime/parrot/library/PGE/Glob.pir
==============================================================================
--- branches/kill_jit/runtime/parrot/library/PGE/Glob.pir	Sat Sep 19 07:22:47 2009	(r41354)
+++ branches/kill_jit/runtime/parrot/library/PGE/Glob.pir	Sat Sep 19 07:27:32 2009	(r41355)
@@ -7,7 +7,8 @@
 
 =head1 DESCRIPTION
 
-A parser for shell-stype glob notation.
+A parser for shell-stype glob notation. See C<Tcl::Glob> for a
+slightly different glob syntax.
 
 =head2 Functions
 

Modified: branches/kill_jit/runtime/parrot/library/Tcl/Glob.pir
==============================================================================
--- branches/kill_jit/runtime/parrot/library/Tcl/Glob.pir	Sat Sep 19 07:22:47 2009	(r41354)
+++ branches/kill_jit/runtime/parrot/library/Tcl/Glob.pir	Sat Sep 19 07:27:32 2009	(r41355)
@@ -7,7 +7,33 @@
 
 =head1 DESCRIPTION
 
-A parser for Tcl-stype glob notation.
+A PGE-based parser for glob notation. See C<PGE::Glob> for a slightly
+different glob syntax.
+
+The following special characters are supported
+
+=over 4
+
+=item C<?>
+
+Matches any single character
+
+=item C<*>
+
+Matches any number of any characters, including no characters.
+
+=item C<[chars]>
+
+Matches any character in the given set. Sets are either a sequence of explicit
+characters, or a range specified with a dash, e.g. [aeiou] matches lower
+case ASCII vowels, while [a-z] matches any lowercase ASCII letter.
+
+=item C<\x>
+
+Match a literal character, e.g. \* matches the literal C<*>, avoiding its
+special meaning.
+
+=back
 
 =head2 Functions
 
@@ -376,6 +402,9 @@
 This is basically a cut and paste of PGE::Glob. There should probably be
 much less code duplication here.
 
+While originally implemented based on Tcl's C<[string match]> globbing
+syntax, this code is useful enough to be part of parrot's core.
+
 =head1 AUTHOR
 
 PGE::Glob was originally authored by Jonathan Scott Duff (duff at pobox.com),

Modified: branches/kill_jit/runtime/parrot/library/Test/More.pir
==============================================================================
--- branches/kill_jit/runtime/parrot/library/Test/More.pir	Sat Sep 19 07:22:47 2009	(r41354)
+++ branches/kill_jit/runtime/parrot/library/Test/More.pir	Sat Sep 19 07:27:32 2009	(r41355)
@@ -92,19 +92,20 @@
 
 =item C<ok( passed, description )>
 
-Records a test as pass or fail depending on the truth of the integer C<passed>,
+Records a test as pass or fail depending on the truth of the PMC C<passed>,
 recording it with the optional test description in C<description>.
 
 =cut
 
 .sub ok
-    .param int    passed
+    .param pmc    passed
     .param string description     :optional
 
     .local pmc test
     get_hll_global test, [ 'Test'; 'More' ], '_test'
 
-    test.'ok'( passed, description )
+    $I0 = istrue passed
+    test.'ok'( $I0, description )
 .end
 
 =item C<nok( passed, description )>
@@ -115,14 +116,14 @@
 =cut
 
 .sub nok
-    .param int passed
+    .param pmc passed
     .param string description :optional
 
     .local pmc test
     get_hll_global test, [ 'Test'; 'More' ], '_test'
 
     .local int reverse_passed
-    reverse_passed = not passed
+    reverse_passed = isfalse passed
 
     test.'ok'( reverse_passed, description )
 .end

Modified: branches/kill_jit/src/packfile.c
==============================================================================
--- branches/kill_jit/src/packfile.c	Sat Sep 19 07:22:47 2009	(r41354)
+++ branches/kill_jit/src/packfile.c	Sat Sep 19 07:27:32 2009	(r41355)
@@ -4788,9 +4788,13 @@
             wo_ext, path);
 
     /* Add the include and dynext paths to the global search */
+
+    /* Get the base path of the located module */
     parrot_split_path_ext(interp, path, &found_path, &found_ext);
     name_length = Parrot_str_length(interp, lang_name);
-    found_path = Parrot_str_substr(interp, found_path, -name_length, name_length, NULL, 0);
+    found_path = Parrot_str_substr(interp, found_path, 0,
+            Parrot_str_length(interp, found_path)-name_length, NULL, 0);
+
     Parrot_lib_add_path(interp, Parrot_str_append(interp, found_path, CONST_STRING(interp, "include/")),
             PARROT_LIB_PATH_INCLUDE);
     Parrot_lib_add_path(interp, Parrot_str_append(interp, found_path, CONST_STRING(interp, "dynext/")),

Modified: branches/kill_jit/src/pmc/env.pmc
==============================================================================
--- branches/kill_jit/src/pmc/env.pmc	Sat Sep 19 07:22:47 2009	(r41354)
+++ branches/kill_jit/src/pmc/env.pmc	Sat Sep 19 07:27:32 2009	(r41355)
@@ -99,6 +99,19 @@
 
 /*
 
+=item C<INTVAL get_bool()>
+
+Returns whether the environment has any elements.
+
+=cut
+
+*/
+    VTABLE INTVAL get_bool() {
+        return SELF.elements() ? 1 : 0;
+    }
+
+/*
+
 =item C<INTVAL get_integer()>
 
 Returns the size of the hash.

Modified: branches/kill_jit/src/pmc/sub.pmc
==============================================================================
--- branches/kill_jit/src/pmc/sub.pmc	Sat Sep 19 07:22:47 2009	(r41354)
+++ branches/kill_jit/src/pmc/sub.pmc	Sat Sep 19 07:27:32 2009	(r41355)
@@ -99,6 +99,114 @@
 
 /*
 
+=item C<void init_pmc()>
+
+Initializes the "detached" subroutine from passed Hash. "Detached" means that
+surboutine is fully constructed but not attached to interpreter.
+
+=cut
+
+*/
+
+    VTABLE void init_pmc(PMC* init) {
+        Parrot_Sub_attributes * const attrs =
+            (Parrot_Sub_attributes *) PMC_data(SELF);
+        STRING *field;
+
+        field = CONST_STRING(INTERP, "start_offs");
+        if (VTABLE_exists_keyed_str(INTERP, init, field))
+            attrs->start_offs = VTABLE_get_integer_keyed_str(INTERP, init, field);
+
+        field = CONST_STRING(INTERP, "end_offs");
+        if (VTABLE_exists_keyed_str(INTERP, init, field))
+            attrs->end_offs = VTABLE_get_integer_keyed_str(INTERP, init, field);
+
+        field = CONST_STRING(INTERP, "HLL_id");
+        if (VTABLE_exists_keyed_str(INTERP, init, field))
+            attrs->HLL_id = VTABLE_get_integer_keyed_str(INTERP, init, field);
+
+        field = CONST_STRING(INTERP, "namespace_name");
+        if (VTABLE_exists_keyed_str(INTERP, init, field))
+            attrs->namespace_name = VTABLE_get_pmc_keyed_str(INTERP, init, field);
+
+        field = CONST_STRING(INTERP, "namespace_stash");
+        if (VTABLE_exists_keyed_str(INTERP, init, field))
+            attrs->namespace_stash = VTABLE_get_pmc_keyed_str(INTERP, init, field);
+
+        field = CONST_STRING(INTERP, "name");
+        if (VTABLE_exists_keyed_str(INTERP, init, field))
+            attrs->name = VTABLE_get_string_keyed_str(INTERP, init, field);
+
+        field = CONST_STRING(INTERP, "method_name");
+        if (VTABLE_exists_keyed_str(INTERP, init, field))
+            attrs->method_name = VTABLE_get_string_keyed_str(INTERP, init, field);
+
+        field = CONST_STRING(INTERP, "ns_entry_name");
+        if (VTABLE_exists_keyed_str(INTERP, init, field))
+            attrs->ns_entry_name = VTABLE_get_string_keyed_str(INTERP, init, field);
+
+        field = CONST_STRING(INTERP, "subid");
+        if (VTABLE_exists_keyed_str(INTERP, init, field))
+            attrs->subid = VTABLE_get_string_keyed_str(INTERP, init, field);
+
+        field = CONST_STRING(INTERP, "vtable_index");
+        if (VTABLE_exists_keyed_str(INTERP, init, field))
+            attrs->vtable_index = VTABLE_get_integer_keyed_str(INTERP, init, field);
+
+        field = CONST_STRING(INTERP, "multi_signature");
+        if (VTABLE_exists_keyed_str(INTERP, init, field))
+            attrs->multi_signature = VTABLE_get_pmc_keyed_str(INTERP, init, field);
+
+        field = CONST_STRING(INTERP, "lex_info");
+        if (VTABLE_exists_keyed_str(INTERP, init, field))
+            attrs->lex_info = VTABLE_get_pmc_keyed_str(INTERP, init, field);
+
+        field = CONST_STRING(INTERP, "outer_sub");
+        if (VTABLE_exists_keyed_str(INTERP, init, field))
+            attrs->outer_sub = VTABLE_get_pmc_keyed_str(INTERP, init, field);
+
+        /* comp_flags is actually UINTVAL */
+        field = CONST_STRING(INTERP, "comp_flags");
+        if (VTABLE_exists_keyed_str(INTERP, init, field))
+            attrs->comp_flags = (UINTVAL)VTABLE_get_integer_keyed_str(INTERP, init, field);
+
+        field = CONST_STRING(INTERP, "n_regs_used");
+        if (VTABLE_exists_keyed_str(INTERP, init, field)) {
+            PMC   *tmp = VTABLE_get_pmc_keyed_str(INTERP, init, field);
+            INTVAL i;
+            for (i = 0; i < 4; ++i)
+                attrs->n_regs_used[i] = VTABLE_get_integer_keyed_int(INTERP, tmp, i);
+        }
+
+        field = CONST_STRING(INTERP, "arg_info");
+        if (VTABLE_exists_keyed_str(INTERP, init, field)) {
+            PMC   *tmp = VTABLE_get_pmc_keyed_str(INTERP, init, field);
+            /* Allocate structure to store argument information in. */
+            attrs->arg_info = mem_allocate_zeroed_typed(Parrot_sub_arginfo);
+            /*
+            Hash.get_integer_keyed_str return 0 if key doesn't exists.
+            So, don't check existence of key, just use it.
+            NB: Don't split line. CONST_STRING b0rked.
+            */
+            attrs->arg_info->pos_required = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "pos_required"));
+            attrs->arg_info->pos_optional = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "pos_optional"));
+            attrs->arg_info->pos_slurpy = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "pos_slurpy"));
+            attrs->arg_info->named_required = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "named_required"));
+            attrs->arg_info->named_optional = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "named_optional"));
+            attrs->arg_info->named_slurpy = VTABLE_get_integer_keyed_str(INTERP, tmp, CONST_STRING(INTERP, "named_slurpy"));
+        }
+
+
+        /*
+        C<eval_pmc> and C<ctx> are not handled here. And shouldn't be handled
+        here at all because of run-time nature.
+        */
+
+        PObj_custom_mark_destroy_SETALL(SELF);
+    }
+
+/*
+
 =item C<void destroy()>
 
 Destroys the subroutine.
@@ -826,6 +934,14 @@
 
 =over 4
 
+=item C<INTVAL start_offs()>
+
+Return the start offset of the Sub.
+
+=item C<INTVAL end_offs()>
+
+Return the end offset of the Sub.
+
 =item C<PMC *get_namespace()>
 
 Return the namespace PMC, where the Sub is defined.
@@ -860,6 +976,21 @@
 =cut
 
 */
+    METHOD start_offs() {
+        Parrot_Sub_attributes  *sub;
+        INTVAL                  start_offs;
+        PMC_get_sub(INTERP, SELF, sub);
+        start_offs = sub->start_offs;
+        RETURN(INTVAL start_offs);
+    }
+
+    METHOD end_offs() {
+        Parrot_Sub_attributes  *sub;
+        INTVAL                  end_offs;
+        PMC_get_sub(INTERP, SELF, sub);
+        end_offs = sub->end_offs;
+        RETURN(INTVAL end_offs);
+    }
 
     METHOD get_namespace() {
         PMC *_namespace;

Modified: branches/kill_jit/t/compilers/imcc/syn/regressions.t
==============================================================================
--- branches/kill_jit/t/compilers/imcc/syn/regressions.t	Sat Sep 19 07:22:47 2009	(r41354)
+++ branches/kill_jit/t/compilers/imcc/syn/regressions.t	Sat Sep 19 07:27:32 2009	(r41355)
@@ -93,7 +93,7 @@
 hello
 OUT
 
-pir_error_output_like( <<'CODE', <<'OUT', 'off by one error message (RT #40204)', todo=>'broken');
+pir_error_output_like( <<'CODE', <<'OUT', 'off by one error message (TT #1016)', todo=>'broken');
 .sub foo :main
   $P0 = new 'Hash'
   $P1 = $P0['x']

Modified: branches/kill_jit/t/library/test_more.t
==============================================================================
--- branches/kill_jit/t/library/test_more.t	Sat Sep 19 07:22:47 2009	(r41354)
+++ branches/kill_jit/t/library/test_more.t	Sat Sep 19 07:27:32 2009	(r41355)
@@ -15,18 +15,19 @@
     .local pmc exports, curr_namespace, test_namespace
     curr_namespace = get_namespace
     test_namespace = get_namespace [ 'Test'; 'More' ]
-    exports = split " ", "ok is diag like skip todo is_deeply isa_ok isnt throws_like"
+    exports = split " ", "ok nok is diag like skip todo is_deeply isa_ok isnt throws_like"
     test_namespace.'export_to'(curr_namespace, exports)
 
     test_namespace = get_namespace [ 'Test'; 'Builder'; 'Tester' ]
     exports = split " ", "plan test_out test_diag test_fail test_pass test_test"
     test_namespace.'export_to'(curr_namespace, exports)
 
-    plan( 81 )
+    plan( 89 )
 
     test_skip()
     test_todo()
     test_ok()
+    test_nok()
     test_is()
     test_isnt()
     test_like()
@@ -72,6 +73,36 @@
 
 .end
 
+.namespace ['MyFalseClass']
+
+.sub '' :anon :load :init
+    $P0 = newclass ['MyFalseClass']
+.end
+
+.sub 'get_bool' :vtable
+    .return(0)
+.end
+
+.sub 'get_integer' :vtable
+    .return(1)
+.end
+
+.namespace ['MyTrueClass']
+
+.sub '' :anon :load :init
+    $P0 = newclass ['MyTrueClass']
+.end
+
+.sub 'get_bool' :vtable
+    .return(1)
+.end
+
+.sub 'get_integer' :vtable
+    .return(0)
+.end
+
+.namespace []
+
 .sub test_ok
     test_pass()
     ok( 1 )
@@ -88,6 +119,44 @@
     test_fail( 'with description' )
     ok( 0, 'with description' )
     test_test( 'failing test ok() with description')
+
+    $P0 = new ['MyFalseClass']
+    test_fail()
+    ok( $P0 )
+    test_test( 'failing ok() calls get_bool')
+
+    $P0 = new ['MyTrueClass']
+    test_pass()
+    ok( $P0 )
+    test_test( 'passing ok() calls get_bool')
+.end
+
+.sub test_nok
+    test_fail()
+    nok( 1 )
+    test_test( 'failing test nok()')
+
+    test_pass()
+    nok( 0 )
+    test_test( 'passing test nok()')
+
+    test_fail( 'with description' )
+    nok( 1, 'with description' )
+    test_test( 'failing test nok() with description')
+
+    test_pass( 'with description' )
+    nok( 0, 'with description' )
+    test_test( 'passing test nok() with description')
+
+    $P0 = new ['MyFalseClass']
+    test_pass()
+    nok( $P0 )
+    test_test( 'passing nok() calls get_bool')
+
+    $P0 = new ['MyTrueClass']
+    test_fail()
+    nok( $P0 )
+    test_test( 'failing nok() calls get_bool')
 .end
 
 .sub test_is

Modified: branches/kill_jit/t/pmc/sub.t
==============================================================================
--- branches/kill_jit/t/pmc/sub.t	Sat Sep 19 07:22:47 2009	(r41354)
+++ branches/kill_jit/t/pmc/sub.t	Sat Sep 19 07:27:32 2009	(r41355)
@@ -9,7 +9,7 @@
 use Test::More;
 use Parrot::Test::Util 'create_tempfile';
 
-use Parrot::Test tests => 68;
+use Parrot::Test tests => 69;
 use Parrot::Config;
 
 =head1 NAME
@@ -1634,6 +1634,100 @@
 hi
 OUTPUT
 
+pir_output_is( <<'CODE', <<'OUTPUT', 'init_pmc' );
+.sub 'main'
+    .local pmc init, s, regs, arg_info
+    
+    init = new ['Hash']
+    init['start_offs']  = 42
+    init['end_offs']    = 115200
+    
+    regs = new ['FixedIntegerArray']
+    regs = 4
+    regs[0] = 1
+    regs[1] = 2
+    regs[2] = 6
+    regs[3] = 24
+    init['n_regs_used'] = regs
+
+    arg_info = new ['Hash']
+    arg_info['pos_required']    = 1
+    arg_info['pos_optional']    = 1
+    arg_info['pos_slurpy']      = 2
+    arg_info['named_required']  = 3
+    arg_info['named_optional']  = 5
+    arg_info['named_slurpy']    = 8
+    init['arg_info'] = arg_info
+
+    s = new ['Sub'], init
+
+    $I0 = s.'start_offs'()
+    print 'start_offs '
+    say $I0
+
+    print 'end_offs '
+    $I0 = s.'end_offs'()
+    say $I0
+
+    # Check n_regs_used
+    $I0 = s.'__get_regs_used'('I')
+    print 'I regs '
+    say $I0
+
+    $I0 = s.'__get_regs_used'('N')
+    print 'N regs '
+    say $I0
+
+    $I0 = s.'__get_regs_used'('S')
+    print 'S regs '
+    say $I0
+
+    $I0 = s.'__get_regs_used'('P')
+    print 'P regs '
+    say $I0
+
+    # Check arg_info
+    $P0 = inspect s, 'pos_required'
+    print 'pos_required '
+    say $P0
+
+    $P0 = inspect s, 'pos_optional'
+    print 'pos_optional '
+    say $P0
+    
+    $P0 = inspect s, 'pos_slurpy'
+    print 'pos_slurpy '
+    say $P0
+
+    $P0 = inspect s, 'named_required'
+    print 'named_required '
+    say $P0
+
+    $P0 = inspect s, 'named_optional'
+    print 'named_optional '
+    say $P0
+
+    $P0 = inspect s, 'named_slurpy'
+    print 'named_slurpy '
+    say $P0
+
+    # We need more tests for other fields. And more accessors obviously.
+.end
+CODE
+start_offs 42
+end_offs 115200
+I regs 1
+N regs 2
+S regs 6
+P regs 24
+pos_required 1
+pos_optional 1
+pos_slurpy 2
+named_required 3
+named_optional 5
+named_slurpy 8
+OUTPUT
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4


More information about the parrot-commits mailing list