[svn:parrot] r45786 - in trunk: runtime/parrot/library/TAP tools/dev

[fperrad at svn.parrot.org]

Author: fperrad
Date: Sun Apr 18 15:52:47 2010
New Revision: 45786
URL: https://trac.parrot.org/parrot/changeset/45786

Log:
[TAP] handle shebang

Modified:
   trunk/runtime/parrot/library/TAP/Harness.pir
   trunk/runtime/parrot/library/TAP/Parser.pir
   trunk/tools/dev/tapir.pir

Modified: trunk/runtime/parrot/library/TAP/Harness.pir
==============================================================================
--- trunk/runtime/parrot/library/TAP/Harness.pir	Sun Apr 18 11:20:21 2010	(r45785)
+++ trunk/runtime/parrot/library/TAP/Harness.pir	Sun Apr 18 15:52:47 2010	(r45786)
@@ -18,8 +18,8 @@
 .namespace ['TAP';'Harness']
 
 .sub '' :init :load :anon
-    load_bytecode 'TAP/Parser.pir'
-    load_bytecode 'TAP/Formatter.pir'
+    load_bytecode 'TAP/Parser.pbc'
+    load_bytecode 'TAP/Formatter.pbc'
     $P0 = subclass ['TAP';'Base'], ['TAP';'Harness']
     $P0.'add_attribute'('formatter')
     $P0.'add_attribute'('exec')
@@ -83,34 +83,39 @@
     $P0 = getattribute self, 'formatter'
     $P0.'prepare'(tests)
     .local string exec
-    exec = 'parrot'
+    exec = ''
     $P0 = getattribute self, 'exec'
-    if null $P0 goto L0
+    if null $P0 goto L1
     exec = $P0
-  L0:
-    $P0 = iter tests
   L1:
-    unless $P0 goto L2
+    $P0 = iter tests
+  L2:
+    unless $P0 goto L3
     $S0 = shift $P0
     .local pmc parser, session
     (parser, session) = self.'make_parser'($S0)
+    unless exec == '' goto L4
+    parser.'file'($S0)
+    goto L5
+  L4:
     parser.'exec'(exec, $S0)
+  L5:
     .local pmc coro
     $P1 = get_hll_global ['TAP';'Parser'], 'next'
     coro = newclosure $P1
-  L3:
+  L6:
     .local pmc result
     result = coro(parser)
-    if null result goto L4
+    if null result goto L7
     session.'result'(result)
     $I0 = isa result, ['TAP';'Parser';'Result';'Bailout']
-    unless $I0 goto L3
+    unless $I0 goto L6
     self.'_bailout'(result)
-  L4:
+  L7:
     self.'finish_parser'(parser, session)
     self.'_after_test'(aggregate, $S0, parser)
-    goto L1
-  L2:
+    goto L2
+  L3:
 .end
 
 .sub '_after_test' :method

Modified: trunk/runtime/parrot/library/TAP/Parser.pir
==============================================================================
--- trunk/runtime/parrot/library/TAP/Parser.pir	Sun Apr 18 11:20:21 2010	(r45785)
+++ trunk/runtime/parrot/library/TAP/Parser.pir	Sun Apr 18 15:52:47 2010	(r45786)
@@ -486,6 +486,8 @@
 .namespace ['TAP';'Parser']
 
 .sub '' :init :load :anon
+    load_bytecode 'osutils.pbc'
+
     $P0 = subclass ['TAP';'Base'], ['TAP';'Parser']
     $P0.'add_attribute'('stream')
     $P0.'add_attribute'('skipped')
@@ -681,6 +683,14 @@
     push_eh _handler
     $P0.'open'(filename, 'r')
     pop_eh
+    $S0 = readline $P0
+    $I0 = index $S0, '#!'
+    unless $I0 == 0 goto L1
+    close $P0
+    $S0 = _get_exec($S0)
+    .tailcall self.'exec'($S0, filename)
+  L1:
+    seek $P0, 0, 0
     setattribute self, 'stream', $P0
     .return ()
   _handler:
@@ -696,6 +706,23 @@
     rethrow ex
 .end
 
+.include 'iglobals.pasm'
+
+.sub '_get_exec' :anon
+    .param string line
+    $S0 = chomp(line)
+    $I0 = length $S0
+    $I0 = find_not_cclass .CCLASS_WHITESPACE, $S0, 2, $I0
+    $S0 = substr $S0, $I0
+    .local string slash
+    $P0 = getinterp
+    $P1 = $P0[.IGLOBALS_CONFIG_HASH]
+    slash = $P1['slash']
+    $P0 = split "/", $S0
+    $S0 = join slash, $P0
+    .return ($S0)
+.end
+
 .sub 'exec' :method
     .param pmc cmds :slurpy
     .local string cmd
@@ -719,19 +746,6 @@
     rethrow ex
 .end
 
-.sub 'chomp' :anon
-    .param string str
-    $I0 = index str, "\r"
-    if $I0 < 0 goto L1
-    str = substr str, 0, $I0
-  L1:
-    $I1 = index str, "\n"
-    if $I1 < 0 goto L2
-    str = substr str, 0, $I1
-  L2:
-    .return (str)
-.end
-
 .sub 'run' :method
     .const 'Sub' $P0 = 'next'
     $P0 = newclosure $P0

Modified: trunk/tools/dev/tapir.pir
==============================================================================
--- trunk/tools/dev/tapir.pir	Sun Apr 18 11:20:21 2010	(r45785)
+++ trunk/tools/dev/tapir.pir	Sun Apr 18 15:52:47 2010	(r45786)
@@ -84,7 +84,7 @@
 .sub 'do' :anon
     .param pmc opts
     .param pmc files
-    load_bytecode 'TAP/Harness.pir'
+    load_bytecode 'TAP/Harness.pbc'
     .local pmc harness, aggregate
     $I0 = exists opts['archive']
     if $I0 goto L1