perl.cvs.parrot
[Top] [All Lists]

[svn:parrot] r31511 - in trunk/languages/tcl: runtime t/internals

Subject: [svn:parrot] r31511 - in trunk/languages/tcl: runtime t/internals
From:
Date: Tue, 30 Sep 2008 07:18:57 -0700 PDT
Newsgroups: perl.cvs.parrot

Author: coke
Date: Tue Sep 30 07:18:56 2008
New Revision: 31511

Modified:
   trunk/languages/tcl/runtime/options.pir
   trunk/languages/tcl/t/internals/select_switches.t

Log:
[tcl] "-1" isn't a switch, it's a number.


Modified: trunk/languages/tcl/runtime/options.pir
==============================================================================
--- trunk/languages/tcl/runtime/options.pir     (original)
+++ trunk/languages/tcl/runtime/options.pir     Tue Sep 30 07:18:56 2008
@@ -128,9 +128,13 @@
   .param string name   :named('name') :optional
   .param int has_name  :opt_flag
 
+  .local pmc toNumber
+  toNumber = get_root_global [ '_tcl' ], 'toNumber'
+
   if has_ends goto check_catch
   endswitch = 0
 
+
 check_catch:
   if has_catch goto check_name
   catchbad = 0
@@ -176,6 +180,12 @@
   # and not have any whitespace.
   $I1 = index arg, ' '
   if $I1 != -1 goto loop_done
+  # and not be a number
+  push_eh not_num
+    toNumber(arg)
+  pop_eh
+  goto loop_done # was a number
+not_num:
   unless endswitch goto loop_2
   if arg == '-' goto handle_endswitch # already ate one -
 loop_2:

Modified: trunk/languages/tcl/t/internals/select_switches.t
==============================================================================
--- trunk/languages/tcl/t/internals/select_switches.t   (original)
+++ trunk/languages/tcl/t/internals/select_switches.t   Tue Sep 30 07:18:56 2008
@@ -32,7 +32,7 @@
 
     load_bytecode 'languages/tcl/runtime/tcllib.pir'
 
-    plan(31)
+    plan(32)
     .local string message
 
     # 1
@@ -302,6 +302,29 @@
 check_31:
     is($P2, '', message)
 
+    # 32
+    options = new 'TclList'
+    options[0] = 'good0'
+    options[1] = 'good1'
+
+    argv = new 'TclList'
+    argv[0] = '-1'
+    argv[1] = 'bag_o_donuts'
+    message='negative integer is not a switch'
+
+    push_eh eh_32
+      $P1 = select_switches(options, argv, 0, 1)
+    pop_eh
+
+    $P2 = new 'TclString'
+    $P2 = ''
+    goto check_32 
+
+eh_32: 
+    get_results '0', $P2
+check_32:
+    is($P2, '', message)
+
 
 .end
 

<Prev in Thread] Current Thread [Next in Thread>
  • [svn:parrot] r31511 - in trunk/languages/tcl: runtime t/internals, coke <=