[svn:parrot] r40812 - trunk/t/pmc
dukeleto at svn.parrot.org
dukeleto at svn.parrot.org
Wed Aug 26 06:09:49 UTC 2009
Author: dukeleto
Date: Wed Aug 26 06:09:41 2009
New Revision: 40812
URL: https://trac.parrot.org/parrot/changeset/40812
Log:
[t] Convert t/pmc/pmc.t to perl+pir instead of perl+pasm
Modified:
trunk/t/pmc/pmc.t
Modified: trunk/t/pmc/pmc.t
==============================================================================
--- trunk/t/pmc/pmc.t Wed Aug 26 04:57:21 2009 (r40811)
+++ trunk/t/pmc/pmc.t Wed Aug 26 06:09:41 2009 (r40812)
@@ -24,24 +24,26 @@
=cut
-pasm_output_is( <<'CODE', <<'OUTPUT', "newpmc" );
- print "starting\n"
- new P0, ['Integer']
- print "ending\n"
- end
+pir_output_is( <<'CODE', <<'OUTPUT', "newpmc" );
+.sub main
+ say "starting"
+ new $P0, ['Integer']
+ say "ending"
+.end
CODE
starting
ending
OUTPUT
-pasm_output_is( <<'CODE', <<'OUTPUT', 'typeof' );
- new P0, ['Integer']
- typeof S0,P0
- eq S0, "Integer", OK_1
+pir_output_is( <<'CODE', <<'OUTPUT', 'typeof' );
+.sub main
+ new $P0, ['Integer']
+ typeof $S0, $P0
+ eq $S0, "Integer", OK_1
print "not "
OK_1:
print "ok 1\n"
- end
+.end
CODE
ok 1
OUTPUT
@@ -56,203 +58,207 @@
while ( my ( $type, $id ) = each %pmc_types ) {
next
if $types_we_cant_test{$type};
- my $set_ro = ( $type =~ /^Const\w+/ ) ? <<EOPASM : '';
- new P10, ['Integer']
- set P10, 1
- setprop P0, "_ro", P10
-EOPASM
- $checkTypes .= <<"CHECK";
- new P0, '$type'
- $set_ro
- set S1, "$type"
- typeof S0, P0
- ne S0, S1, L_BadName
+ my $set_ro = ( $type =~ /^Const\w+/ ) ? <<'PIR' : '';
+ new $P10, ['Integer']
+ set $P10, 1
+ setprop $P0, "_ro", $P10
+PIR
+ $checkTypes .= qq{ new \$P0, '$type'\n$set_ro\n};
+ $checkTypes .= qq{ set \$S1, "$type"\n};
+ $checkTypes .= <<'CHECK';
+ typeof $S0, $P0
+ ne $S0, $S1, L_BadName
CHECK
}
-pasm_output_like( <<"CODE", <<OUTPUT, "PMC type check" );
- new P10, ['Hash']
- new P11, ['Hash']
+pir_output_like( <<"CODE", qr/All names ok/, "PMC type check" );
+.sub main
+ new \$P10, ['Hash']
+ new \$P11, ['Hash']
$checkTypes
- print "All names ok.\\n"
+ say "All names ok."
end
L_BadName:
- print S1
+ print \$S1
print " PMCs have incorrect name \\""
- print S0
+ print \$S0
print "\\"\\n"
- end
+.end
CODE
-/All names ok/
-OUTPUT
-pasm_error_output_like( <<'CODE', <<'OUTPUT', 'find_method' );
- new P1, ['Integer']
- find_method P0, P1, "no_such_meth"
- end
+pir_error_output_like( <<'CODE', <<'OUTPUT', 'find_method' );
+.sub main
+ new $P1, ['Integer']
+ find_method $P0, $P1, "no_such_meth"
+.end
CODE
/Method 'no_such_meth' not found for invocant of class 'Integer'/
OUTPUT
-pasm_output_is( <<'CODE', <<'OUTPUT', "eq_addr same" );
- new P0, ['Integer']
- set P1, P0
- eq_addr P0, P1, OK1
+pir_output_is( <<'CODE', <<'OUTPUT', "eq_addr same" );
+.sub main
+ new $P0, ['Integer']
+ set $P1, $P0
+ eq_addr $P0, $P1, OK1
print "not "
OK1: print "ok 1\n"
- ne_addr P0, P1, BAD2
+ ne_addr $P0, $P1, BAD2
branch OK2
BAD2: print "not "
OK2: print "ok 2\n"
- end
+.end
CODE
ok 1
ok 2
OUTPUT
-pasm_output_is( <<'CODE', <<'OUTPUT', "eq_addr diff" );
- new P0, ['Integer']
- new P1, ['Integer']
- ne_addr P0, P1, OK1
+pir_output_is( <<'CODE', <<'OUTPUT', "eq_addr diff" );
+.sub main
+ new $P0, ['Integer']
+ new $P1, ['Integer']
+ ne_addr $P0, $P1, OK1
print "not "
OK1: print "ok 1\n"
- eq_addr P0, P1, BAD2
+ eq_addr $P0, $P1, BAD2
branch OK2
BAD2: print "not "
OK2: print "ok 2\n"
- end
+.end
CODE
ok 1
ok 2
OUTPUT
-pasm_output_is( <<'CODE', <<'OUTPUT', "if_null" );
- null P0
- if_null P0, OK1
+pir_output_is( <<'CODE', <<'OUTPUT', "if_null" );
+.sub main
+ null $P0
+ if_null $P0, OK1
print "not "
OK1: print "ok 1\n"
- new P0, ['Integer']
- if_null P0, BAD2
+ new $P0, ['Integer']
+ if_null $P0, BAD2
branch OK2
BAD2: print "not "
OK2: print "ok 2\n"
- end
+.end
CODE
ok 1
ok 2
OUTPUT
-pasm_output_is( <<'CODE', <<'OUTPUT', "Env PMCs are singletons" );
- new P0, ['Env']
- new P1, ['Env']
- eq_addr P0, P1, ok
+pir_output_is( <<'CODE', <<'OUTPUT', "Env PMCs are singletons" );
+.sub main
+ new $P0, ['Env']
+ new $P1, ['Env']
+ eq_addr $P0, $P1, ok
print "not the same "
ok: print "ok\n"
- end
+.end
CODE
ok
OUTPUT
-pasm_output_is( <<'CODE', <<'OUTPUT', "issame" );
- new P0, ['Undef']
- new P1, ['Undef']
- set P1, P0
- issame I0, P0, P1
- print I0
- isntsame I0, P0, P1
- print I0
- new P2, ['Undef']
- issame I0, P0, P2
- print I0
- isntsame I0, P0, P2
- print I0
- print "\n"
- end
+pir_output_is( <<'CODE', <<'OUTPUT', "issame" );
+.sub main
+ new $P0, ['Undef']
+ new $P1, ['Undef']
+ set $P1, $P0
+ issame $I0, $P0, $P1
+ print $I0
+ isntsame $I0, $P0, $P1
+ print $I0
+ new $P2, ['Undef']
+ issame $I0, $P0, $P2
+ print $I0
+ isntsame $I0, $P0, $P2
+ say $I0
+.end
CODE
1001
OUTPUT
-pasm_output_is( <<'CODE', <<'OUT', ".const - Sub constant" );
-.pcc_sub :main main:
+pir_output_is( <<'CODE', <<'OUT', ".const - Sub constant" );
+.sub main
print "ok 1\n"
- .const 'Sub' P0 = "foo"
- invokecc P0
+ .const 'Sub' $P0 = "foo"
+ invokecc $P0
print "ok 3\n"
- end
-.pcc_sub foo:
+.end
+.sub foo
print "ok 2\n"
returncc
+.end
CODE
ok 1
ok 2
ok 3
OUT
-pir_output_is( <<'CODE', <<'OUT', "pmc constant 1" );
+pir_output_is( <<'CODE', <<'OUT', "Integer pmc constant " );
.sub main :main
.const 'Integer' i = "42"
- print i
- print "\n"
+ say i
.end
CODE
42
OUT
-pir_output_is( <<'CODE', <<'OUT', "pmc constant 2" );
+pir_output_is( <<'CODE', <<'OUT', "Float pmc constant " );
.sub main :main
- .const 'Integer' i = "42"
- print i
- print "\n"
+ .const 'Float' j = "4.2"
+ say j
.end
CODE
-42
+4.2
OUT
-pasm_output_is( <<'CODE', <<'OUT', "pmc constant PASM" );
- .const 'Integer' P0 = "42"
- print P0
- print "\n"
- end
+pir_output_is( <<'CODE', <<'OUT', "pmc constant" );
+.sub main
+ .const 'Integer' $P0 = "42"
+ say $P0
+.end
CODE
42
OUT
-pasm_output_is( <<'CODE', <<'OUT', "logical or, and, xor" );
- new P0, ['Integer']
- set P0, 2
- new P1, ['Undef']
- or P2, P0, P1
- eq_addr P2, P0, ok1
+pir_output_is( <<'CODE', <<'OUT', "logical or, and, xor" );
+.sub main
+ new $P0, ['Integer']
+ set $P0, 2
+ new $P1, ['Undef']
+ or $P2, $P0, $P1
+ eq_addr $P2, $P0, ok1
print "not "
ok1:
print "ok 1\n"
- and P2, P0, P1
- eq_addr P2, P1, ok2
+ and $P2, $P0, $P1
+ eq_addr $P2, $P1, ok2
print "not "
ok2:
print "ok 2\n"
- xor P2, P0, P1
- eq_addr P2, P0, ok3
+ xor $P2, $P0, $P1
+ eq_addr $P2, $P0, ok3
print "not "
ok3:
print "ok 3\n"
- end
+.end
CODE
ok 1
ok 2
ok 3
OUT
-pasm_output_is( <<'CODE', <<'OUTPUT', "new_p_s" );
- new P3, ['Integer']
- set P3, "42"
- typeof S0, P3
- print S0
+pir_output_is( <<'CODE', <<'OUTPUT', "new_p_s" );
+.sub main
+ new $P3, ['Integer']
+ set $P3, "42"
+ typeof $S0, $P3
+ print $S0
print "\n"
- set I0, P3
- print I0
+ set $I0, $P3
+ print $I0
print "\n"
- end
+.end
CODE
String
42
More information about the parrot-commits
mailing list