t/op/interp.t

   1 #!perl
   2 # Copyright (C) 2001-2009, Parrot 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 => 8;
  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 # we probably shouldn't just run a label, but this catches a potential seggie
  28 pasm_output_is( <<'CODE', <<'OUTPUT', "runinterp - new style" );
  29     new P0, 'ParrotInterpreter'
  30     say 'calling'
  31     # set_addr/invoke ?
  32     runinterp P0, foo
  33     say 'ending'
  34     end
  35     say 'bad things!'
  36   foo:
  37     say 'In 2'
  38     end
  39 CODE
  40 calling
  41 In 2
  42 ending
  43 OUTPUT
  44
  45 pir_output_is( <<'CODE', <<'OUTPUT', 'runinterp - works with printing' );
  46 .sub 'test' :main
  47     .local string actual
  48     .local pmc test_interp
  49                test_interp = new 'ParrotInterpreter'
  50     .local pmc stdout
  51                stdout = getstdout
  52
  53     print "uno\n"
  54     runinterp test_interp, pasm
  55     print "dos\n"
  56     goto pasm_end
  57
  58   pasm:
  59     noop
  60     end
  61   pasm_end:
  62 .end
  63 CODE
  64 uno
  65 dos
  66 OUTPUT
  67
  68 # Need to disable GC while trace is on, as there's a non-zero chance that a
  69 # GC sweep would occur, causing a bonus "GC mark" line in the output, which makes
  70 # the test fail.
  71 pasm_output_like(
  72     <<'CODE', <<'OUTPUT', "restart trace" );
  73     printerr "ok 1\n"
  74     sweepoff
  75     set I0, 1
  76     trace I0
  77     dec I0
  78     trace I0
  79     sweepon
  80     printerr "ok 2\n"
  81     end
  82 CODE
  83 /^ok\s1\n
  84 (?:\s+8.*)?\n
  85 (?:\s+10.*)?\n
  86 ok\s2\n$/x
  87 OUTPUT
  88
  89 pasm_output_is( <<'CODE', 'nada:', 'interp - warnings' );
  90     new P0, 'Undef'
  91     set I0, P0
  92     printerr "nada:"
  93     warningson 1
  94     new P1, 'Undef'
  95     set I0, P1
  96     end
  97 CODE
  98
  99 pasm_output_is( <<'CODE', <<'OUTPUT', "getinterp" );
 100     .include "interpinfo.pasm"
 101     getinterp P0
 102     print "ok 1\n"
 103     set I0, P0[.INTERPINFO_ACTIVE_PMCS]
 104     interpinfo I1, .INTERPINFO_ACTIVE_PMCS
 105     eq I0, I1, ok2
 106     print "not "
 107   ok2:
 108     print "ok 2\n"
 109     end
 110 CODE
 111 ok 1
 112 ok 2
 113 OUTPUT
 114
 115 pasm_output_is( <<'CODE', <<'OUTPUT', "access argv" );
 116     get_params "0", P5
 117     .include "iglobals.pasm"
 118     getinterp P1
 119     set P2, P1[.IGLOBALS_ARGV_LIST]
 120     set I0, P5
 121     set I1, P2
 122     eq I0, I1, ok1
 123     print "not "
 124   ok1:
 125     print "ok 1\n"
 126     set S0, P5[0]
 127     set S1, P2[0]
 128     eq S0, S1, ok2
 129     print "not "
 130   ok2:
 131     print "ok 2\n"
 132     end
 133 CODE
 134 ok 1
 135 ok 2
 136 OUTPUT
 137
 138 pasm_output_is( <<'CODE', <<'OUTPUT', "check_events" );
 139     print "before\n"
 140     check_events
 141     print "after\n"
 142     end
 143 CODE
 144 before
 145 after
 146 OUTPUT
 147
 148
 149 pir_output_is( <<'CODE', <<'OUTPUT', "interpinfo & getinterp: current runcore" );
 150 .include 'interpinfo.pasm'
 151 .include 'interpcores.pasm'
 152
 153 .sub 'test' :main
 154     $I0 = interpinfo .INTERPINFO_CURRENT_RUNCORE
 155     if $I0 == .PARROT_FUNCTION_CORE   goto ok1
 156     if $I0 == .PARROT_FAST_CORE       goto ok1
 157     if $I0 == .PARROT_SWITCH_CORE     goto ok1
 158     if $I0 == .PARROT_CGOTO_CORE      goto ok1
 159     if $I0 == .PARROT_CGP_CORE        goto ok1
 160     if $I0 == .PARROT_EXEC_CORE       goto ok1
 161     if $I0 == .PARROT_GC_DEBUG_CORE   goto ok1
 162     print 'not '
 163   ok1:
 164     say 'ok 1'
 165
 166     $P0 = getinterp
 167     $I1 = $P0[.INTERPINFO_CURRENT_RUNCORE]
 168     if $I0 == $I1 goto ok2
 169     print 'not '
 170   ok2:
 171     say 'ok 2'
 172 .end
 173 CODE
 174 ok 1
 175 ok 2
 176 OUTPUT
 177
 178 # Local Variables:
 179 #   mode: cperl
 180 #   cperl-indent-level: 4
 181 #   fill-column: 100
 182 # End:
 183 # vim: expandtab shiftwidth=4: