Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/parseOld.test@260cb5ec6c19

     1 # Commands covered:  set (plus basic command syntax).  Also tests the

     2 # procedures in the file tclOldParse.c.  This set of tests is an old

     3 # one that predates the new parser in Tcl 8.1.

4 #

     5 # This file contains a collection of tests for one or more of the Tcl

     6 # built-in commands.  Sourcing this file into Tcl runs the tests and

     7 # generates output for errors.  No output means no errors were found.

8 #

     9 # Copyright (c) 1991-1993 The Regents of the University of California.

    10 # Copyright (c) 1994-1996 Sun Microsystems, Inc.

    11 # Copyright (c) 1998-1999 by Scriptics Corporation.

    12 #

    13 # See the file "license.terms" for information on usage and redistribution

    14 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.

    15 #

    16 # RCS: @(#) $Id: parseOld.test,v 1.11.2.1 2003/03/27 13:49:22 dkf Exp $

    18 if {[lsearch [namespace children] ::tcltest] == -1} {

    19     package require tcltest

    20     namespace import -force ::tcltest::*

    21 }

    23 tcltest::testConstraint testwordend \

    24 	[string equal "testwordend" [info commands testwordend]]

    26 # Save the argv value for restoration later

    27 set savedArgv $argv

    29 proc fourArgs {a b c d} {

    30     global arg1 arg2 arg3 arg4

    31     set arg1 $a

    32     set arg2 $b

    33     set arg3 $c

    34     set arg4 $d

    35 }

    37 proc getArgs args {

    38     global argv

    39     set argv $args

    40 }

    42 # Basic argument parsing.

    44 test parseOld-1.1 {basic argument parsing} {

    45     set arg1 {}

    46     fourArgs a b	c 		 d

    47     list $arg1 $arg2 $arg3 $arg4

    48 } {a b c d}

    49 test parseOld-1.2 {basic argument parsing} {

    50     set arg1 {}

    51     eval "fourArgs 123\v4\f56\r7890"

    52     list $arg1 $arg2 $arg3 $arg4

    53 } {123 4 56 7890}

    55 # Quotes.

    57 test parseOld-2.1 {quotes and variable-substitution} {

    58     getArgs "a b c" d

    59     set argv

    60 } {{a b c} d}

    61 test parseOld-2.2 {quotes and variable-substitution} {

    62     set a 101

    63     getArgs "a$a b c"

    64     set argv

    65 } {{a101 b c}}

    66 test parseOld-2.3 {quotes and variable-substitution} {

    67     set argv "xy[format xabc]"

    68     set argv

    69 } {xyxabc}

    70 test parseOld-2.4 {quotes and variable-substitution} {

    71     set argv "xy\t"

    72     set argv

    73 } xy\t

    74 test parseOld-2.5 {quotes and variable-substitution} {

    75     set argv "a b	c

    76 d e f"

    77     set argv

    78 } a\ b\tc\nd\ e\ f

    79 test parseOld-2.6 {quotes and variable-substitution} {

    80     set argv a"bcd"e

    81     set argv

    82 } {a"bcd"e}

    84 # Braces.

    86 test parseOld-3.1 {braces} {

    87     getArgs {a b c} d

    88     set argv

    89 } "{a b c} d"

    90 test parseOld-3.2 {braces} {

    91     set a 101

    92     set argv {a$a b c}

    93     set b [string index $argv 1]

    94     set b

    95 } {$}

    96 test parseOld-3.3 {braces} {

    97     set argv {a[format xyz] b}

    98     string length $argv

    99 } 15

   100 test parseOld-3.4 {braces} {

   101     set argv {a\nb\}}

   102     string length $argv

   103 } 6

   104 test parseOld-3.5 {braces} {

   105     set argv {{{{}}}}

   106     set argv

   107 } "{{{}}}"

   108 test parseOld-3.6 {braces} {

   109     set argv a{{}}b

   110     set argv

   111 } "a{{}}b"

   112 test parseOld-3.7 {braces} {

   113     set a [format "last]"]

   114     set a

   115 } {last]}

   117 # Command substitution.

   119 test parseOld-4.1 {command substitution} {

   120     set a [format xyz]

   121     set a

   122 } xyz

   123 test parseOld-4.2 {command substitution} {

   124     set a a[format xyz]b[format q]

   125     set a

   126 } axyzbq

   127 test parseOld-4.3 {command substitution} {

   128     set a a[

   129 set b 22;

   130 format %s $b

   132 ]b

   133     set a

   134 } a22b

   135 test parseOld-4.4 {command substitution} {

   136     set a 7.7

   137     if [catch {expr int($a)}] {set a foo}

   138     set a

   139 } 7.7

   141 # Variable substitution.

   143 test parseOld-5.1 {variable substitution} {

   144     set a 123

   145     set b $a

   146     set b

   147 } 123

   148 test parseOld-5.2 {variable substitution} {

   149     set a 345

   150     set b x$a.b

   151     set b

   152 } x345.b

   153 test parseOld-5.3 {variable substitution} {

   154     set _123z xx

   155     set b $_123z^

   156     set b

   157 } xx^

   158 test parseOld-5.4 {variable substitution} {

   159     set a 78

   160     set b a${a}b

   161     set b

   162 } a78b

   163 test parseOld-5.5 {variable substitution} {catch {$_non_existent_} msg} 1

   164 test parseOld-5.6 {variable substitution} {

   165     catch {$_non_existent_} msg

   166     set msg

   167 } {can't read "_non_existent_": no such variable}

   168 test parseOld-5.7 {array variable substitution} {

   169     catch {unset a}

   170     set a(xyz) 123

   171     set b $a(xyz)foo

   172     set b

   173 } 123foo

   174 test parseOld-5.8 {array variable substitution} {

   175     catch {unset a}

   176     set "a(x y z)" 123

   177     set b $a(x y z)foo

   178     set b

   179 } 123foo

   180 test parseOld-5.9 {array variable substitution} {

   181     catch {unset a}; catch {unset qqq}

   182     set "a(x y z)" qqq

   183     set $a([format x]\ y [format z]) foo

   184     set qqq

   185 } foo

   186 test parseOld-5.10 {array variable substitution} {

   187     catch {unset a}

   188     list [catch {set b $a(22)} msg] $msg

   189 } {1 {can't read "a(22)": no such variable}}

   190 test parseOld-5.11 {array variable substitution} {

   191     set b a$!

   192     set b

   193 } {a$!}

   194 test parseOld-5.12 {empty array name support} {

   195     list [catch {set b a$()} msg] $msg

   196 } {1 {can't read "()": no such variable}}

   197 catch {unset a}

   198 test parseOld-5.13 {array variable substitution} {

   199     catch {unset a}

   200     set long {This is a very long variable, long enough to cause storage \

   201 	allocation to occur in Tcl_ParseVar.  If that storage isn't getting \

   202 	freed up correctly, then a core leak will occur when this test is \

   203 	run.  This text is probably beginning to sound like drivel, but I've \

   204 	run out of things to say and I need more characters still.}

   205     set a($long) 777

   206     set b $a($long)

   207     list $b [array names a]

   208 } {777 {{This is a very long variable, long enough to cause storage \

   209 	allocation to occur in Tcl_ParseVar.  If that storage isn't getting \

   210 	freed up correctly, then a core leak will occur when this test is \

   211 	run.  This text is probably beginning to sound like drivel, but I've \

   212 	run out of things to say and I need more characters still.}}}

   213 test parseOld-5.14 {array variable substitution} {

   214     catch {unset a}; catch {unset b}; catch {unset a1}

   215     set a1(22) foo

   216     set a(foo) bar

   217     set b $a($a1(22))

   218     set b

   219 } bar

   220 catch {unset a}; catch {unset a1}

   222 test parseOld-7.1 {backslash substitution} {

   223     set a "\a\c\n\]\}"

   224     string length $a

   225 } 5

   226 test parseOld-7.2 {backslash substitution} {

   227     set a {\a\c\n\]\}}

   228     string length $a

   229 } 10

   230 test parseOld-7.3 {backslash substitution} {

   231     set a "abc\

   232 def"

   233     set a

   234 } {abc def}

   235 test parseOld-7.4 {backslash substitution} {

   236     set a {abc\

   237 def}

   238     set a

   239 } {abc def}

   240 test parseOld-7.5 {backslash substitution} {

   241     set msg {}

   242     set a xxx

   243     set error [catch {if {24 < \

   244 	35} {set a 22} {set \

   245 	    a 33}} msg]

   246     list $error $msg $a

   247 } {0 22 22}

   248 test parseOld-7.6 {backslash substitution} {

   249     eval "concat abc\\"

   250 } "abc\\"

   251 test parseOld-7.7 {backslash substitution} {

   252     eval "concat \\\na"

   253 } "a"

   254 test parseOld-7.8 {backslash substitution} {

   255     eval "concat x\\\n   	a"

   256 } "x a"

   257 test parseOld-7.9 {backslash substitution} {

   258     eval "concat \\x"

   259 } "x"

   260 test parseOld-7.10 {backslash substitution} {

   261     eval "list a b\\\nc d"

   262 } {a b c d}

   263 test parseOld-7.11 {backslash substitution} {

   264     eval "list a \"b c\"\\\nd e"

   265 } {a {b c} d e}

   266 test parseOld-7.12 {backslash substitution} {

   267     list \ua2

   268 } [bytestring "\xc2\xa2"]

   269 test parseOld-7.13 {backslash substitution} {

   270     list \u4e21

   271 } [bytestring "\xe4\xb8\xa1"]

   272 test parseOld-7.14 {backslash substitution} {

   273     list \u4e2k

   274 } [bytestring "\xd3\xa2k"]

   276 # Semi-colon.

   278 test parseOld-8.1 {semi-colons} {

   279     set b 0

   280     getArgs a;set b 2

   281     set argv

   282 } a

   283 test parseOld-8.2 {semi-colons} {

   284     set b 0

   285     getArgs a;set b 2

   286     set b

   287 } 2

   288 test parseOld-8.3 {semi-colons} {

   289     getArgs a b ; set b 1

   290     set argv

   291 } {a b}

   292 test parseOld-8.4 {semi-colons} {

   293     getArgs a b ; set b 1

   294     set b

   295 } 1

   297 # The following checks are to ensure that the interpreter's result

   298 # gets re-initialized by Tcl_Eval in all the right places.

   300 test parseOld-9.1 {result initialization} {concat abc} abc

   301 test parseOld-9.2 {result initialization} {concat abc; proc foo {} {}} {}

   302 test parseOld-9.3 {result initialization} {concat abc; proc foo {} $a} {}

   303 test parseOld-9.4 {result initialization} {proc foo {} [concat abc]} {}

   304 test parseOld-9.5 {result initialization} {concat abc; } abc

   305 test parseOld-9.6 {result initialization} {

   306     eval {

   307     concat abc

   308 }} abc

   309 test parseOld-9.7 {result initialization} {} {}

   310 test parseOld-9.8 {result initialization} {concat abc; ; ;} abc

   312 # Syntax errors.

   314 test parseOld-10.1 {syntax errors} {catch "set a \{bcd" msg} 1

   315 test parseOld-10.2 {syntax errors} {

   316 	catch "set a \{bcd" msg

   317 	set msg

   318 } {missing close-brace}

   319 test parseOld-10.3 {syntax errors} {catch {set a "bcd} msg} 1

   320 test parseOld-10.4 {syntax errors} {

   321 	catch {set a "bcd} msg

   322 	set msg

   323 } {missing "}

   324 #" Emacs formatting >:^(

   325 test parseOld-10.5 {syntax errors} {catch {set a "bcd"xy} msg} 1

   326 test parseOld-10.6 {syntax errors} {

   327 	catch {set a "bcd"xy} msg

   328 	set msg

   329 } {extra characters after close-quote}

   330 test parseOld-10.7 {syntax errors} {catch "set a {bcd}xy" msg} 1

   331 test parseOld-10.8 {syntax errors} {

   332 	catch "set a {bcd}xy" msg

   333 	set msg

   334 } {extra characters after close-brace}

   335 test parseOld-10.9 {syntax errors} {catch {set a [format abc} msg} 1

   336 test parseOld-10.10 {syntax errors} {

   337 	catch {set a [format abc} msg

   338 	set msg

   339 } {missing close-bracket}

   340 test parseOld-10.11 {syntax errors} {catch gorp-a-lot msg} 1

   341 test parseOld-10.12 {syntax errors} {

   342 	catch gorp-a-lot msg

   343 	set msg

   344 } {invalid command name "gorp-a-lot"}

   345 test parseOld-10.13 {syntax errors} {

   346     set a [concat {a}\

   347  {b}]

   348     set a

   349 } {a b}

   351 # The next test will fail on the Mac, 'cause the MSL uses a fixed sized

   352 # buffer for %d conversions (LAME!).  I won't leave the test out, however,

   353 # since MetroWerks may some day fix this.

   355 test parseOld-10.14 {syntax errors} {

   356     list [catch {eval \$x[format "%01000d" 0](} msg] $msg $errorInfo

   357 } {1 {missing )} {missing )

   358     while executing

   359 "$x0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000..."

   360     ("eval" body line 1)

   361     invoked from within

   362 "eval \$x[format "%01000d" 0]("}}

   363 test parseOld-10.15 {syntax errors, missplaced braces} {

   364     catch {

   365         proc misplaced_end_brace {} {

   366             set what foo

   367             set when [expr ${what}size - [set off$what]}]

   368     } msg

   369     set msg

   370 } {extra characters after close-brace}

   371 test parseOld-10.16 {syntax errors, missplaced braces} {

   372     catch {

   373         set a {

   374             set what foo

   375             set when [expr ${what}size - [set off$what]}]

   376     } msg

   377     set msg

   378 } {extra characters after close-brace}

   379 test parseOld-10.17 {syntax errors, unusual spacing} {

   380     list [catch {return [ [1]]} msg] $msg

   381 } {1 {invalid command name "1"}}

   382 # Long values (stressing storage management)

   384 set a {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH}

   386 test parseOld-11.1 {long values} {

   387     string length $a

   388 } 214

   389 test parseOld-11.2 {long values} {

   390     llength $a

   391 } 43

   392 test parseOld-11.3 {long values} {

   393     set b "1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH"

   394     set b

   395 } $a

   396 test parseOld-11.4 {long values} {

   397     set b "$a"

   398     set b

   399 } $a

   400 test parseOld-11.5 {long values} {

   401     set b [set a]

   402     set b

   403 } $a

   404 test parseOld-11.6 {long values} {

   405     set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]

   406     string length $b

   407 } 214

   408 test parseOld-11.7 {long values} {

   409     set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]

   410     llength $b

   411 } 43

   412 test parseOld-11.8 {long values} {

   413     set b

   414 } $a

   415 test parseOld-11.9 {long values} {

   416     set a [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ]

   417     llength $a

   418 } 62

   419 set i 0

   420 foreach j [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ] {

   421     set test [string index 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ $i]

   422     set test $test$test$test$test

   423     test parseOld-11.10-[incr i] {long values} {

   424 	set j

   425     } $test

   426 }

   427 test parseOld-11.11 {test buffer overflow in backslashes in braces} {

   428     expr {"a" == {xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101\101}}

   429 } 0

   431 test parseOld-12.1 {comments} {

   432     set a old

   433     eval {  # set a new}

   434     set a

   435 } {old}

   436 test parseOld-12.2 {comments} {

   437     set a old

   438     eval "  # set a new\nset a new"

   439     set a

   440 } {new}

   441 test parseOld-12.3 {comments} {

   442     set a old

   443     eval "  # set a new\\\nset a new"

   444     set a

   445 } {old}

   446 test parseOld-12.4 {comments} {

   447     set a old

   448     eval "  # set a new\\\\\nset a new"

   449     set a

   450 } {new}

   452 test parseOld-13.1 {comments at the end of a bracketed script} {

   453     set x "[

   454 expr 1+1

   455 # skip this!

   456 ]"

   457 } {2}

   459 test parseOld-14.1 {TclWordEnd procedure} {testwordend} {

   460     testwordend " 	\n abc"

   461 } {c}

   462 test parseOld-14.2 {TclWordEnd procedure} {testwordend} {

   463     testwordend "   \\\n"

   464 } {}

   465 test parseOld-14.3 {TclWordEnd procedure} {testwordend} {

   466     testwordend "   \\\n "

   467 } { }

   468 test parseOld-14.4 {TclWordEnd procedure} {testwordend} {

   469     testwordend {"abc"}

   470 } {"}

   471 #" Emacs formatting >:^(

   472 test parseOld-14.5 {TclWordEnd procedure} {testwordend} {

   473     testwordend {{xyz}}

   474 } \}

   475 test parseOld-14.6 {TclWordEnd procedure} {testwordend} {

   476     testwordend {{a{}b{}\}} xyz}

   477 } "\} xyz"

   478 test parseOld-14.7 {TclWordEnd procedure} {testwordend} {

   479     testwordend {abc[this is a]def ghi}

   480 } {f ghi}

   481 test parseOld-14.8 {TclWordEnd procedure} {testwordend} {

   482     testwordend "puts\\\n\n  "

   483 } "s\\\n\n  "

   484 test parseOld-14.9 {TclWordEnd procedure} {testwordend} {

   485     testwordend "puts\\\n   	"

   486 } "s\\\n   	"

   487 test parseOld-14.10 {TclWordEnd procedure} {testwordend} {

   488     testwordend "puts\\\n   	xyz"

   489 } "s\\\n   	xyz"

   490 test parseOld-14.11 {TclWordEnd procedure} {testwordend} {

   491     testwordend {a$x.$y(a long index) foo}

   492 } ") foo"

   493 test parseOld-14.12 {TclWordEnd procedure} {testwordend} {

   494     testwordend {abc; def}

   495 } {; def}

   496 test parseOld-14.13 {TclWordEnd procedure} {testwordend} {

   497     testwordend {abc def}

   498 } {c def}

   499 test parseOld-14.14 {TclWordEnd procedure} {testwordend} {

   500     testwordend {abc	def}

   501 } {c	def}

   502 test parseOld-14.15 {TclWordEnd procedure} {testwordend} {

   503     testwordend "abc\ndef"

   504 } "c\ndef"

   505 test parseOld-14.16 {TclWordEnd procedure} {testwordend} {

   506     testwordend "abc"

   507 } {c}

   508 test parseOld-14.17 {TclWordEnd procedure} {testwordend} {

   509     testwordend "a\000bc"

   510 } {c}

   511 test parseOld-14.18 {TclWordEnd procedure} {testwordend} {

   512     testwordend \[a\000\]

   513 } {]}

   514 test parseOld-14.19 {TclWordEnd procedure} {testwordend} {

   515     testwordend \"a\000\"

   516 } {"}

   517 #" Emacs formatting >:^(

   518 test parseOld-14.20 {TclWordEnd procedure} {testwordend} {

   519     testwordend a{\000}b

   520 } {b}

   521 test parseOld-14.21 {TclWordEnd procedure} {testwordend} {

   522     testwordend "   \000b"

   523 } {b}

   525 test parseOld-15.1 {TclScriptEnd procedure} {

   526     info complete {puts [

   527 	expr 1+1

   528 	#this is a comment ]}

   529 } {0}

   530 test parseOld-15.2 {TclScriptEnd procedure} {

   531     info complete "abc\\\n"

   532 } {0}

   533 test parseOld-15.3 {TclScriptEnd procedure} {

   534     info complete "abc\\\\\n"

   535 } {1}

   536 test parseOld-15.4 {TclScriptEnd procedure} {

   537     info complete "xyz \[abc \{abc\]"

   538 } {0}

   539 test parseOld-15.5 {TclScriptEnd procedure} {

   540     info complete "xyz \[abc"

   541 } {0}

   543 # cleanup

   544 set argv $savedArgv

   545 ::tcltest::cleanupTests

   546 return

author	sl
	Tue, 10 Jun 2014 14:32:02 +0200
changeset 1	260cb5ec6c19
permissions	-rw-r--r--