[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