From bbf5a2c5e826697af18de1442146f1933f11022d Mon Sep 17 00:00:00 2001
From: Bernhard Schmalhofer <Bernhard.Schmalhofer@gmx.de>
Date: Wed, 4 Mar 2009 20:38:32 +0100
Subject: [PATCH] Add a '--run-pir' option to pipp.pbc. For some reason this
 fails when run by t/harness.

---
 pipp.pir        | 53 +++++++++++++++++++++++++++++++++++++++----------
 t/harness       |  2 ++
 t/pmc/array.t   |  2 ++
 t/pmc/boolean.t |  4 +++-
 t/pmc/null.t    |  3 +++
 5 files changed, 52 insertions(+), 12 deletions(-)

diff --git a/pipp.pir b/pipp.pir
index 8698138..15f062c 100755
--- a/pipp.pir
+++ b/pipp.pir
@@ -116,11 +116,11 @@ Bernhard Schmalhofer - L<Bernhard.Schmalhofer@gmx.de>
 .sub 'pipp' :main
     .param pmc argv
 
-    .local string prog, php_source_fn
+    .local string prog, source_fn
     .local pmc    opt
-    (prog, opt, php_source_fn) = parse_arguments(argv)
+    (prog, opt, source_fn) = parse_arguments(argv)
 
-    if php_source_fn goto GOT_PHP_SOURCE_FN
+    if source_fn goto GOT_PHP_SOURCE_FN
         # XXX: should do REPL or read from stdin
         printerr "No input file specified.\n"
         exit -1
@@ -157,6 +157,10 @@ Bernhard Schmalhofer - L<Bernhard.Schmalhofer@gmx.de>
     $I0 = defined opt['run-nqp']
     if  $I0                   goto RUN_NQP
 
+    # run the PIR-code when called with --run-pir
+    $I0 = defined opt['run-pir']
+    if  $I0                   goto RUN_PIR
+
     # check for the variant from the commandline or from the environment
     $I0 = defined opt['variant']
     unless $I0 goto GET_VARIANT_FROM_ENV
@@ -191,7 +195,7 @@ VARIANT_PCT:
     .local pmc args
     args = new 'ResizableStringArray'
     push args, prog
-    push args, php_source_fn
+    push args, source_fn
 
     # $P0 = get_root_global ['parrot'], '_dumper'
     # $P0( args )
@@ -204,7 +208,7 @@ VARIANT_PHC:
     # work with the XML generated by PHC, the PHP Compiler
     err_msg = 'Creating XML-AST with phc failed'
     cmd = 'phc --dump-ast-xml=ast '
-    cmd .= php_source_fn
+    cmd .= source_fn
     cmd .= '> pipp_phc_ast.xml'
     ret = spawnw cmd
     if ret goto ERROR
@@ -226,7 +230,10 @@ VARIANT_PHC:
     .tailcall run_nqp( 'pipp_phc_past.nqp', target )
 
 RUN_NQP:
-    .tailcall run_nqp( php_source_fn, target )
+    .tailcall run_nqp( source_fn, target )
+
+RUN_PIR:
+    .tailcall run_pir( source_fn )
 
 ERROR:
     printerr err_msg
@@ -236,7 +243,30 @@ ERROR:
 
 .end
 
-# currently not used
+# taken from parrot_compiler.pir
+.sub run_pir
+    .param string pir_source_fn
+
+    # for now slurp into a fixed buffer
+    $P0 = new [ 'FileHandle' ]
+    $P1 = $P0.'open'(pir_source_fn)
+    $S0 = $P1.'read'(100000)
+    # print $S0
+
+    # Assume that the input is PIR and compile it
+    compreg $P2, 'PIR'
+    $P3 = $P2( $S0 )
+
+    $P3()
+
+    # Invoke in different interpreter.
+    #$P4 = new ['ParrotInterpreter']
+    #runinterp $P4, $P3
+
+    exit 0
+.end
+
+# Evaluate a PIR-dump of a PAST-datastructure
 .sub run_nqp
     .param string nqp_source_fn
     .param string target
@@ -299,6 +329,7 @@ ERROR:
     push getopts, 'variant=s'          # switch between variants
     push getopts, 'target=s'           # compilation target, used during development
     push getopts, 'run-nqp'            # run PAST set up in NQP
+    push getopts, 'run-pir'            # run PIR, used for testing
     push getopts, 'output|o=s'
 
     # standard PHP options
@@ -334,21 +365,21 @@ ERROR:
 
     # Find the name of the input file
     .local int argc
-    .local string php_source_fn
+    .local string source_fn
     argc = elements argv
     if argc < 1 goto NO_PHP_SCRIPT_NAME
         dec argc
-        php_source_fn = argv[argc]
+        source_fn = argv[argc]
         goto GOT_PHP_SOURCE_FN
   NO_PHP_SCRIPT_NAME:
 
     $I0 = defined opt['f']
     unless $I0 goto GOT_NO_F_OPTION
-        php_source_fn = opt['f']
+        source_fn = opt['f']
   GOT_NO_F_OPTION:
 
   GOT_PHP_SOURCE_FN:
-    .return (prog, opt, php_source_fn)
+    .return (prog, opt, source_fn)
 .end
 
 # keep arguments from the command line and from ini-file
diff --git a/t/harness b/t/harness
index de91190..768905b 100644
--- a/t/harness
+++ b/t/harness
@@ -84,9 +84,11 @@ $verbosity ||= 0;
               my ( $harness, $test_file ) = @_;
 
               # the directory t/embed contains only PIR test files
+              #return [ "$path_to_parrot/parrot pipp.pbc",  '--run-pir', $test_file ] if $test_file =~ m!t/embed/.*[.]t$!;
               return [ "$path_to_parrot/parrot", $test_file ] if $test_file =~ m!t/embed/.*[.]t$!;
 
               # the directory t/pmc contains only PIR test files
+              #return [ "$path_to_parrot/parrot pipp.pbc", '--run-pir', $test_file ] if $test_file =~ m!t/pmc/.*[.]t$!;
               return [ "$path_to_parrot/parrot", $test_file ] if $test_file =~ m!t/pmc/.*[.]t$!;
 
               # the directory t/in_php contains only test scripts written in PHP
diff --git a/t/pmc/array.t b/t/pmc/array.t
index c2df4cf..a243588 100644
--- a/t/pmc/array.t
+++ b/t/pmc/array.t
@@ -18,6 +18,8 @@ Tests the PhpArray PMC.
 .loadlib 'pipp_group'
 
 .sub main :main
+    $P0 = loadlib "pipp_group"
+
     .include 'include/test_more.pir'
 
     plan(91)
diff --git a/t/pmc/boolean.t b/t/pmc/boolean.t
index a52ac98..17c739c 100644
--- a/t/pmc/boolean.t
+++ b/t/pmc/boolean.t
@@ -15,10 +15,12 @@ Tests C<PhpBoolean> PMC.
 
 =cut
 
-.loadlib "pipp_group"
 
 .sub 'main' :main
+    $P0 = loadlib "pipp_group"
+
     .include "include/test_more.pir"
+
     plan(2)
 
     truth_tests()
diff --git a/t/pmc/null.t b/t/pmc/null.t
index d269263..02d9b24 100644
--- a/t/pmc/null.t
+++ b/t/pmc/null.t
@@ -18,7 +18,10 @@ Tests C<PhpNull> PMC.
 .loadlib "pipp_group"
 
 .sub 'main' :main
+    $P0 = loadlib "pipp_group"
+
     .include "include/test_more.pir"
+
     plan(2)
 
     truth_tests()