[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