Permalink
Browse files

[tcl]

Ran all the tests through tcl 8.5.1; some behavior (mostly diagnostic output)
has changed; update the tests, TODO them for parrot where necessary. Delete
a few invalid tests that partcl happens to pass, but shouldn't.


git-svn-id: https://svn.parrot.org/parrot/trunk@26472 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
1 parent 3fb0bff commit 446f956a383d770a4107d7f1573a6fce07cb59f4 @coke coke committed Mar 18, 2008
@@ -1,6 +1,6 @@
#!perl
-# Copyright (C) 2006, The Perl Foundation.
+# Copyright (C) 2006-2008, The Perl Foundation.
# $Id$
# the following lines re-execute this as a tcl script
@@ -24,7 +24,7 @@ eval_is {apply {foo bar baz bit}} \
{bad lamdba expression}
eval_is {apply {foo bar baz}} \
- {cannot find namespace "::baz"} \
+ {namespace "::baz" not found} \
{namespace doesn't exist} \
$TODO
@@ -1,6 +1,6 @@
#!perl
-# Copyright (C) 2004-2006, The Perl Foundation.
+# Copyright (C) 2004-2008, The Perl Foundation.
# $Id$
# the following lines re-execute this as a tcl script
@@ -225,9 +225,8 @@ eval_is {
} {{b c}} {array names, insure list results}
eval_is {array names a b c} \
- {} \
- {array names, bad option} \
- {SKIP {verified behavior in 8.5}}
+ {bad option "b": must be -exact, -glob, or -regexp} \
+ {array names, bad option}
eval_is {array names a b c d}\
{wrong # args: should be "array names arrayName ?mode? ?pattern?"}\
View
@@ -1,6 +1,6 @@
#!perl
-# Copyright (C) 2006-2007, The Perl Foundation.
+# Copyright (C) 2006-2008, The Perl Foundation.
# $Id$
# the following lines re-execute this as a tcl script
@@ -26,8 +26,10 @@ is [expr 2.3e2] 230.0 {scientific with float base}
is [expr 2.3E2] 230.0 {scientific with float base (upper E)}
is [expr 2e17] 2e+17 {scientific in, scientific out}
eval_is {expr 3e2.0} \
- {syntax error in expression "3e2.0": extra tokens at end of expression} \
- {can only e with an integer exponent}
+ {missing operator at _@_
+in expression "3e2_@_.0"} \
+ {can only e with an integer exponent} \
+{TODO {new behavior in tcl 8.5.1}}
# booleans
is [expr TrUe] TrUe {true}
@@ -49,17 +51,26 @@ is [expr !!Y] 1 {y}
is [expr !!No] 0 {no}
is [expr !!N] 0 {n}
-eval_is {expr trues} \
- {syntax error in expression "trues": the word "trues" requires a preceding $ if it's a variable or function arguments if it's a function} \
- {trues}
+eval_is {expr trues} \
+ {invalid bareword "trues"
+in expression "trues";
+should be "$trues" or "{trues}" or "trues(...)" or ...} {trues} \
+{TODO {new behavior in tcl 8.5.1}}
eval_is {expr falses} \
- {syntax error in expression "falses": the word "falses" requires a preceding $ if it's a variable or function arguments if it's a function} \
- {falses}
+ {invalid bareword "falses"
+in expression "falses";
+should be "$falses" or "{falses}" or "falses(...)" or ...} {falses} \
+{TODO {new behavior in tcl 8.5.1}}
+
+# expected : 'syntax error in expression "falses": the word "falses" requires a preceding $ if it's a variable or function arguments if it's a function'
+
+
is [expr 0b1001] 9 {binary}
is [expr 0b10] 2 {binary}
is [expr 0b101010] 42 {binary}
-eval_is {expr {}} {syntax error in expression "": premature end of expression}
+eval_is {expr {}} {empty expression
+in expression ""} {empty expr} {TODO {new behavior in tcl 8.5.1}}
# simple unary ops.
is [expr -2] -2 {unary -}
@@ -1,6 +1,6 @@
#!perl
-# Copyright (C) 2004-2006, The Perl Foundation.
+# Copyright (C) 2004-2008, The Perl Foundation.
# $Id$
# the following lines re-execute this as a tcl script
@@ -27,8 +27,9 @@ eval_is {foreach {} {a b c} {puts foo}} \
eval_is {
array set a {}
foreach a {1 2 3 4} {puts $a}
-} {couldn't set loop variable: "a"} \
- {couldn't set loop variable}
+} {can't set "a": variable is array} \
+ {couldn't set loop variable} \
+ {TODO {new behavior in tcl 8.5.1}}
unset -nocomplain a
is [foreach a {1 2 3 4} {set a}] {} {return value}
View
@@ -1,6 +1,6 @@
#!perl
-# Copyright (C) 2004-2006, The Perl Foundation.
+# Copyright (C) 2004-2008, The Perl Foundation.
# $Id$
# the following lines re-execute this as a tcl script
@@ -10,7 +10,7 @@ use Tcl::Test; #\
__DATA__
source lib/test_more.tcl
-plan 20
+plan 18
eval_is {
set a ""
@@ -150,21 +150,11 @@ eval_is {
}
} ok {namespace resolution in body}
-eval_is {
- if {[error moo]&&1} {error oink} else
-} {wrong # args: no expression after "else" argument} \
- {no expression after else, occurs before command invocation} \
- {SKIP {doesn't pass in tclsh8.5...}}
-
-eval_is {
- if {[error moo]&&1} {error oink} elseif
-} {wrong # args: no expression after "elseif" argument} \
- {no expression after elseif, occurs before command invocation} \
- {SKIP {doesn't pass in tclsh8.5...}}
-
eval_is {if {}} \
- {syntax error in expression "": premature end of expression} \
- {expression errors before [if] errors}
+ {empty expression
+in expression ""} \
+ {expression errors before [if] errors} \
+ {TODO {new behavior in 8.5.1}}
eval_is {if 0 then} \
{wrong # args: no script following "then" argument} \
View
@@ -1,6 +1,6 @@
#!perl
-# Copyright (C) 2005-2007, The Perl Foundation.
+# Copyright (C) 2005-2008, The Perl Foundation.
# $Id$
# the following lines re-execute this as a tcl script
@@ -13,12 +13,12 @@ source lib/test_more.tcl
plan 52
eval_is {info} \
- {wrong # args: should be "info option ?arg arg ...?"} \
- {info no subcommand}
+ {wrong # args: should be "info subcommand ?argument ...?"} \
+ {info no subcommand} {TODO {new behavior in tcl 8.5.1}}
eval_is {info bork} \
- {bad option "bork": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars} \
- {info bad subcommand}
+ {unknown or ambiguous subcommand "bork": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars} \
+ {info bad subcommand} {TODO {new behavior in tcl 8.5.1}}
eval_is {info args} \
{wrong # args: should be "info args procname"} \
@@ -217,7 +217,9 @@ eval_is {
list [info default defaults1 a x] $x
} {0 {}} {something without a default}
+# Note: this test will fail when run with tclsh8.5
like [info nameofexecutable] parrot {basic exec name}
+
eval_is {info nameofexecutable 1} \
{wrong # args: should be "info nameofexecutable"} {too many args}
@@ -1,6 +1,6 @@
#!perl
-# Copyright (C) 2005-2006, The Perl Foundation.
+# Copyright (C) 2005-2008, The Perl Foundation.
# $Id$
# the following lines re-execute this as a tcl script
@@ -73,8 +73,9 @@ is [lsort -decreasing -integer -unique {10 2 30 5 0 -5 2}] \
{decreasing integer unique}
eval_is {lsort -dictionary {a10 B1 abc ab b1 a1 ab a2}} \
- {a1 a2 a10 ab ab abc b1 B1} \
- {-dictionary}
+ {a1 a2 a10 ab ab abc B1 b1} \
+ {-dictionary} \
+ {TODO {new behavior in 8.5.1}}
eval_is {
lsort -real {4.28 5.65 6.20 7.66 7.6 2.4 8.5 0.4 7.6 6.3}
@@ -1,6 +1,6 @@
#!perl
-# Copyright (C) 2005-2006, The Perl Foundation.
+# Copyright (C) 2005-2008, The Perl Foundation.
# $Id$
# the following lines re-execute this as a tcl script
@@ -26,8 +26,9 @@ eval_is {namespace children a b c} \
{namespace children: too many args}
eval_is {namespace children what?} \
- {unknown namespace "what?" in namespace children command} \
- {namespace children: unknown namespace}
+ {namespace "what?" not found in "::"} \
+ {namespace children: unknown namespace} \
+ {TODO {new behavior in 8.5.1}}
is [namespace children] {::tcltest ::tcl} {namespace children: no args}
is [namespace children ::] {::tcltest ::tcl} {namespace children: ::}
@@ -1,6 +1,6 @@
#!perl
-# Copyright (C) 2006-2007, The Perl Foundation.
+# Copyright (C) 2006-2008, The Perl Foundation.
# $Id$
# the following lines re-execute this as a tcl script
@@ -14,7 +14,8 @@ plan 136
# arg checking
eval_is {string} \
- {wrong # args: should be "string option arg ?arg ...?"} {no args}
+ {wrong # args: should be "string subcommand ?argument ...?"} {no args} \
+ {TODO {new behavior in 8.5.1}}
# [string first]
is [string first a abcdefa] 0 {first, initial}
@@ -30,12 +31,12 @@ eval_is {string first c abcd joe} \
{first, index, invalid index}
eval_is {string first} \
- {wrong # args: should be "string first subString string ?startIndex?"} \
- {first, not enough args}
+ {wrong # args: should be "string first needleString haystackString ?startIndex?"} \
+ {first, not enough args} {TODO {new behavior in 8.5.1}}
eval_is {string first a b c d} \
- {wrong # args: should be "string first subString string ?startIndex?"} \
- {first, too many args}
+ {wrong # args: should be "string first needleString haystackString ?startIndex?"} \
+ {first, too many args} {TODO {new behavior in 8.5.1}}
# [string last]
is [string last a abcdefa] 6 {last, initial}
@@ -53,11 +54,11 @@ eval_is {string last c abcdc joe} \
{bad index "joe": must be integer?[+-]integer? or end?[+-]integer?} \
{last, index, invalid index}
eval_is {string last} \
- {wrong # args: should be "string last subString string ?startIndex?"} \
- {last, not enough args}
+ {wrong # args: should be "string last needleString haystackString ?startIndex?"} \
+ {last, not enough args} {TODO {new behavior in 8.5.1}}
eval_is {string last a b c d} \
- {wrong # args: should be "string last subString string ?startIndex?"} \
- {last, too many args}
+ {wrong # args: should be "string last needleString haystackString ?startIndex?"} \
+ {last, too many args} {TODO {new behavior in 8.5.1}}
# [string index]
is [string index abcde 0] a {index, initial}
@@ -1,6 +1,6 @@
#!perl
-# Copyright (C) 2005-2007, The Perl Foundation.
+# Copyright (C) 2005-2008, The Perl Foundation.
# $Id$
# the following lines re-execute this as a tcl script
@@ -21,8 +21,8 @@ eval_is {switch a} \
{too few args, 1}
eval_is {switch -monkey a} \
- {bad option "-monkey": must be -exact, -glob, -indexvar, -matchvar, -nocase, -regexp, or --} \
- {bad flag, -monkey}
+ {extra switch pattern with no body} \
+ {bad flag, -monkey} {TODO {new behavior in 8.5.1}}
eval_is {switch a { }} \
{wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"} \

0 comments on commit 446f956

Please sign in to comment.