t/op/interp.t

   1 #!perl
   2 # Copyright (C) 2001-2006, The Perl Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8
   9 use Test::More;
  10 use Parrot::Test tests => 9;
  11
  12 =head1 NAME
  13
  14 t/op/interp.t - Running the Interpreter
  15
  16 =head1 SYNOPSIS
  17
  18     % prove t/op/interp.t
  19
  20 =head1 DESCRIPTION
  21
  22 Tests the old and new styles of running the Parrot interpreter and the
  23 C<interpinfo> opcode.
  24
  25 =cut
  26
  27 SKIP: {
  28     skip( "we really shouldn't run just a label - use a sub", 1 );
  29
  30     pasm_output_is( <<'CODE', <<'OUTPUT', "runinterp - new style" );
  31     new P0, 'ParrotInterpreter'
  32     print "calling\n"
  33     # set_addr/invoke ?
  34     runinterp P0, foo
  35     print "ending\n"
  36     end
  37     print "bad things!\n"
  38   foo:
  39     print "In 2\n"
  40     end
  41 CODE
  42 calling
  43 In 2
  44 ending
  45 OUTPUT
  46 }
  47
  48 pir_output_is( <<'CODE', <<'OUTPUT', 'runinterp - works without printing' );
  49 .sub 'test' :main
  50     .local string actual
  51     .local pmc test_interp
  52                test_interp = new 'ParrotInterpreter'
  53     .local pmc stdout
  54                stdout = getstdout
  55     push stdout, 'string'
  56
  57     print "uno\n"
  58     runinterp test_interp, pasm
  59     print "dos\n"
  60
  61   get_stdout:
  62     $S0 = readline stdout
  63     actual .= $S0
  64     if $S0 goto get_stdout
  65     $S0 = pop stdout
  66
  67     print actual
  68     goto pasm_end
  69
  70   pasm:
  71     noop
  72     end
  73   pasm_end:
  74 .end
  75 CODE
  76 uno
  77 dos
  78 OUTPUT
  79
  80 pir_output_is(
  81     <<'CODE', <<'OUTPUT', 'runinterp - works with printing', todo => 'something funky here' );
  82 .sub 'test' :main
  83     .local string actual
  84     .local pmc test_interp
  85                test_interp = new 'ParrotInterpreter'
  86     .local pmc stdout
  87                stdout = getstdout
  88     push stdout, 'string'
  89
  90     print "uno\n"
  91     runinterp test_interp, pasm
  92     print "dos\n"
  93
  94   get_stdout:
  95     $S0 = readline stdout
  96     actual .= $S0
  97     if $S0 goto get_stdout
  98     $S0 = pop stdout
  99
 100     print actual
 101     goto pasm_end
 102
 103   pasm:
 104     print "y uno es igual a\n"
 105     end
 106   pasm_end:
 107 .end
 108 CODE
 109 uno
 110 y uno es igual a
 111 dos
 112 OUTPUT
 113
 114 # Need to disable DOD while trace is on, as there's a non-zero chance that a
 115 # DOD sweep would occur, causing a bonus "DOD" line in the output, which makes
 116 # the test fail.
 117 pasm_output_like(
 118     <<'CODE', <<'OUTPUT', "restart trace", todo => "lines are out of order due to buffering" );
 119     printerr "ok 1\n"
 120     sweepoff
 121     set I0, 1
 122     trace I0
 123     printerr "ok 2\n"
 124     dec I0
 125     trace I0
 126     sweepon
 127     printerr "ok 3\n"
 128     end
 129 CODE
 130 /^ok\s1\n
 131 (?:\s+8.*)?\n
 132 ok\s2\n
 133 (?:\s+10.*)?\n
 134 (?:\s+12.*)?\n
 135 ok\s3\n$/x
 136 OUTPUT
 137
 138 # This is the behavior as of Parrot 0.4.3
 139 # RT#46819 Should there be a warning?
 140 pasm_output_is( <<'CODE', 'nada:', 'interp - warnings' );
 141     new P0, 'Undef'
 142     set I0, P0
 143     printerr "nada:"
 144     warningson 1
 145     new P1, 'Undef'
 146     set I0, P1
 147     end
 148 CODE
 149
 150 pasm_output_is( <<'CODE', <<'OUTPUT', "getinterp" );
 151     .include "interpinfo.pasm"
 152     getinterp P0
 153     print "ok 1\n"
 154     set I0, P0[.INTERPINFO_ACTIVE_PMCS]
 155     interpinfo I1, .INTERPINFO_ACTIVE_PMCS
 156     eq I0, I1, ok2
 157     print "not "
 158   ok2:
 159     print "ok 2\n"
 160     end
 161 CODE
 162 ok 1
 163 ok 2
 164 OUTPUT
 165
 166 pasm_output_is( <<'CODE', <<'OUTPUT', "access argv" );
 167     get_params "0", P5
 168     .include "iglobals.pasm"
 169     getinterp P1
 170     set P2, P1[.IGLOBALS_ARGV_LIST]
 171     set I0, P5
 172     set I1, P2
 173     eq I0, I1, ok1
 174     print "not "
 175   ok1:
 176     print "ok 1\n"
 177     set S0, P5[0]
 178     set S1, P2[0]
 179     eq S0, S1, ok2
 180     print "not "
 181   ok2:
 182     print "ok 2\n"
 183     end
 184 CODE
 185 ok 1
 186 ok 2
 187 OUTPUT
 188
 189 pasm_output_is( <<'CODE', <<'OUTPUT', "check_events" );
 190     print "before\n"
 191     check_events
 192     print "after\n"
 193     end
 194 CODE
 195 before
 196 after
 197 OUTPUT
 198
 199
 200 pir_output_is( <<'CODE', <<'OUTPUT', "interpinfo & getinterp: current runcore" );
 201 .include 'interpinfo.pasm'
 202 .include 'interpcores.pasm'
 203
 204 .sub 'test' :main
 205     $I0 = interpinfo .INTERPINFO_CURRENT_RUNCORE
 206     if $I0 == .PARROT_FUNCTION_CORE   goto ok1
 207     if $I0 == .PARROT_FAST_CORE       goto ok1
 208     if $I0 == .PARROT_SWITCH_CORE     goto ok1
 209     if $I0 == .PARROT_CGOTO_CORE      goto ok1
 210     if $I0 == .PARROT_CGP_CORE        goto ok1
 211     if $I0 == .PARROT_JIT_CORE        goto ok1
 212     if $I0 == .PARROT_SWITCH_JIT_CORE goto ok1
 213     if $I0 == .PARROT_CGP_JIT_CORE    goto ok1
 214     if $I0 == .PARROT_EXEC_CORE       goto ok1
 215     if $I0 == .PARROT_GC_DEBUG_CORE   goto ok1
 216     print 'not '
 217   ok1:
 218     say 'ok 1'
 219
 220     $P0 = getinterp
 221     $I1 = $P0[.INTERPINFO_CURRENT_RUNCORE]
 222     if $I0 == $I1 goto ok2
 223     print 'not '
 224   ok2:
 225     say 'ok 2'
 226 .end
 227 CODE
 228 ok 1
 229 ok 2
 230 OUTPUT
 231
 232
 233 # Local Variables:
 234 #   mode: cperl
 235 #   cperl-indent-level: 4
 236 #   fill-column: 100
 237 # End:
 238 # vim: expandtab shiftwidth=4: