[svn:parrot] r42302 - in trunk: src/ops t/op

chromatic at svn.parrot.org chromatic at svn.parrot.org
Fri Nov 6 08:19:07 UTC 2009


Author: chromatic
Date: Fri Nov  6 08:19:05 2009
New Revision: 42302
URL: https://trac.parrot.org/parrot/changeset/42302

Log:
[ops] Added experimental vivify opcode and tests; much credit to Patrick
Michaud for the implementation.

Added:
   trunk/t/op/vivify.t
Modified:
   trunk/src/ops/experimental.ops

Modified: trunk/src/ops/experimental.ops
==============================================================================
--- trunk/src/ops/experimental.ops	Fri Nov  6 07:03:30 2009	(r42301)
+++ trunk/src/ops/experimental.ops	Fri Nov  6 08:19:05 2009	(r42302)
@@ -151,6 +151,88 @@
     }
 }
 
+=item B<vivify>(out PMC, in PMC, in PMC, in PMC)
+
+Fetches a value from $2, keyed by $3 into $1.  If the resulting PMC is PMCNULL,
+uses the type in $4 to create and return a new PMC.
+
+=item B<vivify>(out PMC, in PMC, in INT, in PMC)
+
+=item B<vivify>(out PMC, in PMC, in STR, in PMC)
+
+=back
+
+=cut
+
+inline op vivify(out PMC, in PMC, in PMC, in PMC) :base_core {
+    $1 = VTABLE_get_pmc_keyed(interp, $2, $3);
+
+    if (PMC_IS_NULL($1)) {
+        PMC * const classobj = Parrot_oo_get_class(interp, $4);
+
+        if (!PMC_IS_NULL(classobj))
+            $1 = VTABLE_instantiate(interp, classobj, PMCNULL);
+        else {
+            const INTVAL type = pmc_type_p(interp, $4);
+            if (type <= 0) {
+                opcode_t *dest = Parrot_ex_throw_from_op_args(
+                    interp, expr NEXT(), EXCEPTION_NO_CLASS,
+                    "Class '%Ss' not found", VTABLE_get_repr(interp, $4));
+                goto ADDRESS(dest);
+            }
+
+            $1 = pmc_new(interp, type);
+        }
+        VTABLE_set_pmc_keyed(interp, $2, $3, $1);
+    }
+}
+
+inline op vivify(out PMC, in PMC, in INT, in PMC) :base_core {
+    $1 = VTABLE_get_pmc_keyed_int(interp, $2, $3);
+
+    if (PMC_IS_NULL($1)) {
+        PMC * const classobj = Parrot_oo_get_class(interp, $4);
+        if (!PMC_IS_NULL(classobj))
+            $1 = VTABLE_instantiate(interp, classobj, PMCNULL);
+        else {
+            const INTVAL type = pmc_type_p(interp, $4);
+            if (type <= 0) {
+                opcode_t *dest = Parrot_ex_throw_from_op_args(
+                    interp, expr NEXT(), EXCEPTION_NO_CLASS,
+                    "Class '%Ss' not found", VTABLE_get_repr(interp, $4));
+                goto ADDRESS(dest);
+            }
+
+            $1 = pmc_new(interp, type);
+        }
+
+        VTABLE_set_pmc_keyed_int(interp, $2, $3, $1);
+    }
+}
+
+inline op vivify(out PMC, in PMC, in STR, in PMC) :base_core {
+    $1 = VTABLE_get_pmc_keyed_str(interp, $2, $3);
+
+    if (PMC_IS_NULL($1)) {
+        PMC * const classobj = Parrot_oo_get_class(interp, $4);
+        if (!PMC_IS_NULL(classobj))
+            $1 = VTABLE_instantiate(interp, classobj, PMCNULL);
+        else {
+            const INTVAL type = pmc_type_p(interp, $4);
+            if (type <= 0) {
+                opcode_t *dest = Parrot_ex_throw_from_op_args(
+                    interp, expr NEXT(), EXCEPTION_NO_CLASS,
+                    "Class '%Ss' not found", VTABLE_get_repr(interp, $4));
+                goto ADDRESS(dest);
+            }
+
+            $1 = pmc_new(interp, type);
+        }
+
+        VTABLE_set_pmc_keyed_str(interp, $2, $3, $1);
+    }
+}
+
 =head1 COPYRIGHT
 
 Copyright (C) 2001-2009, Parrot Foundation.

Added: trunk/t/op/vivify.t
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/t/op/vivify.t	Fri Nov  6 08:19:05 2009	(r42302)
@@ -0,0 +1,140 @@
+#!parrot
+# Copyright (C) 2009, Parrot Foundation.
+# $Id: fetch.t 42138 2009-10-27 20:14:56Z chromatic $
+
+=head1 NAME
+
+t/op/vivify.t - the vivify opcode
+
+=head1 SYNOPSIS
+
+     % prove t/op/vivify.t
+
+=head1 DESCRIPTION
+
+Tests Parrot's experimental vivify opcode.
+
+=cut
+
+.sub 'main' :main
+    .include 'test_more.pir'
+
+    plan(25)
+
+    test_vivify_keyed_pmc()
+    test_vivify_keyed_int()
+    test_vivify_keyed_str()
+    # END_OF_TESTS
+.end
+
+.sub 'test_vivify_keyed_int'
+    diag( 'test_vivify_keyed_int' )
+    $P0    = new [ 'Hash' ]
+    $P1    = box 111
+    $P0[1] = $P1
+    $P0[3] = $P1
+
+    $P3 = vivify $P0, 1, [ 'Integer' ]
+    is( $P3, 111, 'vivify should return existing element unmodified' )
+    $P1 = 123
+    is( $P3, 123, '... the exact PMC itself' )
+
+    $P4 = $P0[1]
+    $I0 = issame $P1, $P4
+    ok( $I0, ' ... existing entry in Hash should be unmodified')
+
+    $P3 = vivify $P0, 3, [ 'Integer' ]
+    is( $P3, 123, '... even if stored in multiple locations' )
+
+    $P3 = vivify $P0, 2, [ 'Integer' ]
+    is( $P3, 0, 'vivify should create new PMC if not-existent' )
+    isa_ok( $P3, 'Integer', 'new PMC should have requested type' )
+
+    $P4 = $P0[2]
+    $I0 = issame $P3, $P4
+    ok( $I0, ' ... and should be bound in Hash')
+.end
+
+.sub 'test_vivify_keyed_str'
+    diag( 'test_vivify_keyed_str' )
+    $P0          = new [ 'Hash' ]
+    $P1          = box 111
+    $P0['one']   = $P1
+    $P0['three'] = $P1
+
+    $P3 = vivify $P0, 'one', [ 'Integer' ]
+    is( $P3, 111, 'vivify should return existing element unmodified' )
+    $P1 = 123
+    is( $P3, 123, '... the exact PMC itself' )
+
+    $P4 = $P0['one']
+    $I0 = issame $P1, $P4
+    ok( $I0, ' ... existing entry in Hash should be unmodified')
+
+    $P3 = vivify $P0, 'three', [ 'Integer' ]
+    is( $P3, 123, '... even if stored in multiple locations' )
+
+    $P3 = vivify $P0, 'two', [ 'Integer' ]
+    is( $P3, 0, 'vivify should create new PMC if not-existent' )
+    isa_ok( $P3, 'Integer', 'new PMC should have requested type' )
+
+    $P4 = $P0['two']
+    $I0 = issame $P3, $P4
+    ok( $I0, ' ... and should be bound in Hash')
+.end
+
+.sub 'test_vivify_keyed_pmc'
+    diag( 'test_vivify_keyed_pmc' )
+    $P0          = new [ 'Hash' ]
+    $P1          = box 111
+
+    .local pmc str_key
+    str_key      = box 'foo'
+    $P0[str_key] = $P1
+
+    .local pmc int_key
+    int_key      = box 435
+    $P0[int_key] = $P1
+
+    $P3          = vivify $P0, str_key, [ 'String' ]
+    is( $P3, 111, 'vivify should return existing element unmodified' )
+
+    $P1          = 123
+    is( $P3, 123, '... the exact PMC itself' )
+
+    $P4 = $P0[str_key]
+    $I0 = issame $P1, $P4
+    ok( $I0, ' ... existing entry in Hash should be unmodified')
+
+    $P3 = vivify $P0, int_key, [ 'String' ]
+    is( $P3, 123, '... even if stored in multiple locations' )
+
+    $P4 = $P0[int_key]
+    $I0 = issame $P1, $P4
+    ok( $I0, ' ... existing entry in Hash should be unmodified')
+
+    str_key = 'baz'
+    $P3 = vivify $P0, str_key, [ 'String' ]
+    is( $P3, '', 'vivify should return new PMC if keyed PMC is not there' )
+    isa_ok( $P3, 'String', 'new PMC should have given type' )
+
+    $P4 = $P0[str_key]
+    $I0 = issame $P3, $P4
+    ok( $I0, ' ... and should be bound in Hash')
+
+    int_key = 789
+    $P3 = vivify $P0, int_key, [ 'String' ]
+    is( $P3, '', 'vivify should return new PMC if keyed PMC is not there' )
+    isa_ok( $P3, 'String', 'new PMC should have given type' )
+
+    $P4 = $P0[int_key]
+    $I0 = issame $P3, $P4
+    ok( $I0, ' ... and should be bound in Hash')
+.end
+
+# Local Variables:
+#   mode: pir
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir :


More information about the parrot-commits mailing list