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

     1 # Commands covered:  while

2 #

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

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

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

6 #

     7 # Copyright (c) 1996 Sun Microsystems, Inc.

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

9 #

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

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

    12 #

    13 # RCS: @(#) $Id: while.test,v 1.8 2001/12/04 15:36:29 dkf Exp $

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

    16     package require tcltest

    17     namespace import -force ::tcltest::*

    18 }

    20 # Basic "while" operation.

    22 catch {unset i}

    23 catch {unset a}

    25 test while-1.1 {TclCompileWhileCmd: missing test expression} {

    26     catch {while } msg

    27     set msg

    28 } {wrong # args: should be "while test command"}

    29 test while-1.2 {TclCompileWhileCmd: error in test expression} {

    30     set i 0

    31     catch {while {$i<} break} msg

    32     set errorInfo

    33 } {syntax error in expression "$i<": premature end of expression

    34     ("while" test expression)

    35     while compiling

    36 "while {$i<} break"}

    37 test while-1.3 {TclCompileWhileCmd: error in test expression} {

    38     set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]

    39     list $err $msg

    40 } {1 {can't use non-numeric string as operand of "+"}}

    41 test while-1.4 {TclCompileWhileCmd: multiline test expr} {

    42     set value 1

    43     while {($tcl_platform(platform) != "foobar1") && \

    44 	    ($tcl_platform(platform) != "foobar2")} {

    45         incr value

    46         break

    47     }

    48     set value

    49 } {2}

    50 test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} {

    51     set value 1

    52     while {"true"} {

    53 	incr value;

    54 	if {$value > 5} {

    55 	    break;

    56 	}

    57     }

    58     set value

    59 } 6

    60 test while-1.6 {TclCompileWhileCmd: test expr is enclosed in quotes} {

    61     set i 0

    62     while "$i > 5" {}

    63 } {}

    64 test while-1.7 {TclCompileWhileCmd: missing command body} {

    65     set i 0

    66     catch {while {$i < 5} } msg

    67     set msg

    68 } {wrong # args: should be "while test command"}

    69 test while-1.8 {TclCompileWhileCmd: error compiling command body} {

    70     set i 0

    71     catch {while {$i < 5} {set}} msg

    72     set errorInfo

    73 } {wrong # args: should be "set varName ?newValue?"

    74     while compiling

    75 "set"

    76     ("while" body line 1)

    77     while compiling

    78 "while {$i < 5} {set}"}

    79 test while-1.9 {TclCompileWhileCmd: simple command body} {

    80     set a {}

    81     set i 1

    82     while {$i<6} {

    83 	if $i==4 break

    84 	set a [concat $a $i]

    85         incr i

    86     }

    87     set a

    88 } {1 2 3}

    89 test while-1.10 {TclCompileWhileCmd: command body in quotes} {

    90     set a {}

    91     set i 1

    92     while {$i<6} "append a x; incr i"

    93     set a

    94 } {xxxxx}

    95 test while-1.11 {TclCompileWhileCmd: computed command body} {

    96     catch {unset x1}

    97     catch {unset bb}

    98     catch {unset x2}

    99     set x1 {append a x1; }

   100     set bb {break}

   101     set x2 {; append a x2; incr i}

   102     set a {}

   103     set i 1

   104     while {$i<6} $x1$bb$x2

   105     set a

   106 } {x1}

   107 test while-1.12 {TclCompileWhileCmd: long command body} {

   108     set a {}

   109     set i 1

   110     while {$i<6} {

   111 	if $i==4 break

   112 	if $i>5 continue

   113 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   114 	    catch {set a $a} msg

   115 	    catch {incr i 5} msg

   116 	    catch {incr i -5} msg

   117 	}

   118 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   119 	    catch {set a $a} msg

   120 	    catch {incr i 5} msg

   121 	    catch {incr i -5} msg

   122 	}

   123 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   124 	    catch {set a $a} msg

   125 	    catch {incr i 5} msg

   126 	    catch {incr i -5} msg

   127 	}

   128 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   129 	    catch {set a $a} msg

   130 	    catch {incr i 5} msg

   131 	    catch {incr i -5} msg

   132 	}

   133 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   134 	    catch {set a $a} msg

   135 	    catch {incr i 5} msg

   136 	    catch {incr i -5} msg

   137 	}

   138 	set a [concat $a $i]

   139         incr i

   140     }

   141     set a

   142 } {1 2 3}

   143 test while-1.13 {TclCompileWhileCmd: while command result} {

   144     set i 0

   145     set a [while {$i < 5} {incr i}]

   146     set a

   147 } {}

   148 test while-1.14 {TclCompileWhileCmd: while command result} {

   149     set i 0

   150     set a [while {$i < 5} {if $i==3 break; incr i}]

   151     set a

   152 } {}

   154 # Check "while" and "continue".

   156 test while-2.1 {continue tests} {

   157     set a {}

   158     set i 1

   159     while {$i <= 4} {

   160         incr i

   161 	if {$i == 3} continue

   162 	set a [concat $a $i]

   163     }

   164     set a

   165 } {2 4 5}

   166 test while-2.2 {continue tests} {

   167     set a {}

   168     set i 1

   169     while {$i <= 4} {

   170         incr i

   171 	if {$i != 2} continue

   172 	set a [concat $a $i]

   173     }

   174     set a

   175 } {2}

   176 test while-2.3 {continue tests, nested loops} {

   177     set msg {}

   178     set i 1

   179     while {$i <= 4} {

   180         incr i

   181         set a 1

   182 	while {$a <= 2} {

   183             incr a

   184             if {$i>=3 && $a>=3} continue

   185             set msg [concat $msg "$i.$a"]

   186         }

   187     }

   188     set msg

   189 } {2.2 2.3 3.2 4.2 5.2}

   190 test while-2.4 {continue tests, long command body} {

   191     set a {}

   192     set i 1

   193     while {$i<6} {

   194 	if $i==2 {incr i; continue}

   195 	if $i==4 break

   196 	if $i>5 continue

   197 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   198 	    catch {set a $a} msg

   199 	    catch {incr i 5} msg

   200 	    catch {incr i -5} msg

   201 	}

   202 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   203 	    catch {set a $a} msg

   204 	    catch {incr i 5} msg

   205 	    catch {incr i -5} msg

   206 	}

   207 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   208 	    catch {set a $a} msg

   209 	    catch {incr i 5} msg

   210 	    catch {incr i -5} msg

   211 	}

   212 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   213 	    catch {set a $a} msg

   214 	    catch {incr i 5} msg

   215 	    catch {incr i -5} msg

   216 	}

   217 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   218 	    catch {set a $a} msg

   219 	    catch {incr i 5} msg

   220 	    catch {incr i -5} msg

   221 	}

   222 	set a [concat $a $i]

   223         incr i

   224     }

   225     set a

   226 } {1 3}

   228 # Check "while" and "break".

   230 test while-3.1 {break tests} {

   231     set a {}

   232     set i 1

   233     while {$i <= 4} {

   234 	if {$i == 3} break

   235 	set a [concat $a $i]

   236         incr i

   237     }

   238     set a

   239 } {1 2}

   240 test while-3.2 {break tests, nested loops} {

   241     set msg {}

   242     set i 1

   243     while {$i <= 4} {

   244         set a 1

   245 	while {$a <= 2} {

   246             if {$i>=2 && $a>=2} break

   247             set msg [concat $msg "$i.$a"]

   248             incr a

   249         }

   250         incr i

   251     }

   252     set msg

   253 } {1.1 1.2 2.1 3.1 4.1}

   254 test while-3.3 {break tests, long command body} {

   255     set a {}

   256     set i 1

   257     while {$i<6} {

   258 	if $i==2 {incr i; continue}

   259 	if $i==5 break

   260 	if $i>5 continue

   261 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   262 	    catch {set a $a} msg

   263 	    catch {incr i 5} msg

   264 	    catch {incr i -5} msg

   265 	}

   266 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   267 	    catch {set a $a} msg

   268 	    catch {incr i 5} msg

   269 	    catch {incr i -5} msg

   270 	}

   271 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   272 	    catch {set a $a} msg

   273 	    catch {incr i 5} msg

   274 	    catch {incr i -5} msg

   275 	}

   276 	if $i==4 break

   277 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   278 	    catch {set a $a} msg

   279 	    catch {incr i 5} msg

   280 	    catch {incr i -5} msg

   281 	}

   282 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   283 	    catch {set a $a} msg

   284 	    catch {incr i 5} msg

   285 	    catch {incr i -5} msg

   286 	}

   287 	set a [concat $a $i]

   288         incr i

   289     }

   290     set a

   291 } {1 3}

   293 # Check "while" with computed command names.

   295 test while-4.1 {while and computed command names} {

   296     set i 0

   297     set z while

   298     $z {$i < 10} {

   299         incr i

   300     }

   301     set i

   302 } 10

   303 test while-4.2 {while (not compiled): missing test expression} {

   304     set z while

   305     catch {$z } msg

   306     set msg

   307 } {wrong # args: should be "while test command"}

   308 test while-4.3 {while (not compiled): error in test expression} {

   309     set i 0

   310     set z while

   311     catch {$z {$i<} {set x 1}} msg

   312     set errorInfo

   313 } {syntax error in expression "$i<": premature end of expression

   314     while executing

   315 "$z {$i<} {set x 1}"}

   316 test while-4.4 {while (not compiled): error in test expression} {

   317     set z while

   318     set err [catch {$z {"a"+"b"} {error "loop aborted"}} msg]

   319     list $err $msg

   320 } {1 {can't use non-numeric string as operand of "+"}}

   321 test while-4.5 {while (not compiled): multiline test expr} {

   322     set value 1

   323     set z while

   324     $z {($tcl_platform(platform) != "foobar1") && \

   325 	    ($tcl_platform(platform) != "foobar2")} {

   326         incr value

   327         break

   328     }

   329     set value

   330 } {2}

   331 test while-4.6 {while (not compiled): non-numeric boolean test expr} {

   332     set value 1

   333     set z while

   334     $z {"true"} {

   335 	incr value;

   336 	if {$value > 5} {

   337 	    break;

   338 	}

   339     }

   340     set value

   341 } 6

   342 test while-4.7 {while (not compiled): test expr is enclosed in quotes} {

   343     set i 0

   344     set z while

   345     $z "$i > 5" {}

   346 } {}

   347 test while-4.8 {while (not compiled): missing command body} {

   348     set i 0

   349     set z while

   350     catch {$z {$i < 5} } msg

   351     set msg

   352 } {wrong # args: should be "while test command"}

   353 test while-4.9 {while (not compiled): error compiling command body} {

   354     set i 0

   355     set z while

   356     catch {$z {$i < 5} {set}} msg

   357     set errorInfo

   358 } {wrong # args: should be "set varName ?newValue?"

   359     while compiling

   360 "set"

   361     ("while" body line 1)

   362     invoked from within

   363 "$z {$i < 5} {set}"}

   364 test while-4.10 {while (not compiled): simple command body} {

   365     set a {}

   366     set i 1

   367     set z while

   368     $z {$i<6} {

   369 	if $i==4 break

   370 	set a [concat $a $i]

   371         incr i

   372     }

   373     set a

   374 } {1 2 3}

   375 test while-4.11 {while (not compiled): command body in quotes} {

   376     set a {}

   377     set i 1

   378     set z while

   379     $z {$i<6} "append a x; incr i"

   380     set a

   381 } {xxxxx}

   382 test while-4.12 {while (not compiled): computed command body} {

   383     set z while

   384     catch {unset x1}

   385     catch {unset bb}

   386     catch {unset x2}

   387     set x1 {append a x1; }

   388     set bb {break}

   389     set x2 {; append a x2; incr i}

   390     set a {}

   391     set i 1

   392     $z {$i<6} $x1$bb$x2

   393     set a

   394 } {x1}

   395 test while-4.13 {while (not compiled): long command body} {

   396     set a {}

   397     set z while

   398     set i 1

   399     $z {$i<6} {

   400 	if $i==4 break

   401 	if $i>5 continue

   402 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   403 	    catch {set a $a} msg

   404 	    catch {incr i 5} msg

   405 	    catch {incr i -5} msg

   406 	}

   407 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   408 	    catch {set a $a} msg

   409 	    catch {incr i 5} msg

   410 	    catch {incr i -5} msg

   411 	}

   412 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   413 	    catch {set a $a} msg

   414 	    catch {incr i 5} msg

   415 	    catch {incr i -5} msg

   416 	}

   417 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   418 	    catch {set a $a} msg

   419 	    catch {incr i 5} msg

   420 	    catch {incr i -5} msg

   421 	}

   422 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   423 	    catch {set a $a} msg

   424 	    catch {incr i 5} msg

   425 	    catch {incr i -5} msg

   426 	}

   427 	set a [concat $a $i]

   428         incr i

   429     }

   430     set a

   431 } {1 2 3}

   432 test while-4.14 {while (not compiled): while command result} {

   433     set i 0

   434     set z while

   435     set a [$z {$i < 5} {incr i}]

   436     set a

   437 } {}

   438 test while-4.15 {while (not compiled): while command result} {

   439     set i 0

   440     set z while

   441     set a [$z {$i < 5} {if $i==3 break; incr i}]

   442     set a

   443 } {}

   445 # Check "break" with computed command names.

   447 test while-5.1 {break and computed command names} {

   448     set i 0

   449     set z break

   450     while 1 {

   451         if {$i > 10} $z

   452         incr i

   453     }

   454     set i

   455 } 11

   456 test while-5.2 {break tests with computed command names} {

   457     set a {}

   458     set i 1

   459     set z break

   460     while {$i <= 4} {

   461 	if {$i == 3} $z

   462 	set a [concat $a $i]

   463         incr i

   464     }

   465     set a

   466 } {1 2}

   467 test while-5.3 {break tests, nested loops with computed command names} {

   468     set msg {}

   469     set i 1

   470     set z break

   471     while {$i <= 4} {

   472         set a 1

   473 	while {$a <= 2} {

   474             if {$i>=2 && $a>=2} $z

   475             set msg [concat $msg "$i.$a"]

   476             incr a

   477         }

   478         incr i

   479     }

   480     set msg

   481 } {1.1 1.2 2.1 3.1 4.1}

   482 test while-5.4 {break tests, long command body with computed command names} {

   483     set a {}

   484     set i 1

   485     set z break

   486     while {$i<6} {

   487 	if $i==2 {incr i; continue}

   488 	if $i==5 $z

   489 	if $i>5 continue

   490 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   491 	    catch {set a $a} msg

   492 	    catch {incr i 5} msg

   493 	    catch {incr i -5} msg

   494 	}

   495 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   496 	    catch {set a $a} msg

   497 	    catch {incr i 5} msg

   498 	    catch {incr i -5} msg

   499 	}

   500 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   501 	    catch {set a $a} msg

   502 	    catch {incr i 5} msg

   503 	    catch {incr i -5} msg

   504 	}

   505 	if $i==4 $z

   506 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   507 	    catch {set a $a} msg

   508 	    catch {incr i 5} msg

   509 	    catch {incr i -5} msg

   510 	}

   511 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   512 	    catch {set a $a} msg

   513 	    catch {incr i 5} msg

   514 	    catch {incr i -5} msg

   515 	}

   516 	set a [concat $a $i]

   517         incr i

   518     }

   519     set a

   520 } {1 3}

   522 # Check "continue" with computed command names.

   524 test while-6.1 {continue and computed command names} {

   525     set i 0

   526     set z continue

   527     while 1 {

   528         incr i

   529         if {$i < 10} $z

   530         break

   531     }

   532     set i

   533 } 10

   534 test while-6.2 {continue tests} {

   535     set a {}

   536     set i 1

   537     set z continue

   538     while {$i <= 4} {

   539         incr i

   540 	if {$i == 3} $z

   541 	set a [concat $a $i]

   542     }

   543     set a

   544 } {2 4 5}

   545 test while-6.3 {continue tests with computed command names} {

   546     set a {}

   547     set i 1

   548     set z continue

   549     while {$i <= 4} {

   550         incr i

   551 	if {$i != 2} $z

   552 	set a [concat $a $i]

   553     }

   554     set a

   555 } {2}

   556 test while-6.4 {continue tests, nested loops with computed command names} {

   557     set msg {}

   558     set i 1

   559     set z continue

   560     while {$i <= 4} {

   561         incr i

   562         set a 1

   563 	while {$a <= 2} {

   564             incr a

   565             if {$i>=3 && $a>=3} $z

   566             set msg [concat $msg "$i.$a"]

   567         }

   568     }

   569     set msg

   570 } {2.2 2.3 3.2 4.2 5.2}

   571 test while-6.5 {continue tests, long command body with computed command names} {

   572     set a {}

   573     set i 1

   574     set z continue

   575     while {$i<6} {

   576 	if $i==2 {incr i; continue}

   577 	if $i==4 break

   578 	if $i>5 $z

   579 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   580 	    catch {set a $a} msg

   581 	    catch {incr i 5} msg

   582 	    catch {incr i -5} msg

   583 	}

   584 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   585 	    catch {set a $a} msg

   586 	    catch {incr i 5} msg

   587 	    catch {incr i -5} msg

   588 	}

   589 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   590 	    catch {set a $a} msg

   591 	    catch {incr i 5} msg

   592 	    catch {incr i -5} msg

   593 	}

   594 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   595 	    catch {set a $a} msg

   596 	    catch {incr i 5} msg

   597 	    catch {incr i -5} msg

   598 	}

   599 	if {$i>6 && $tcl_platform(machine)=="xxx"} {

   600 	    catch {set a $a} msg

   601 	    catch {incr i 5} msg

   602 	    catch {incr i -5} msg

   603 	}

   604 	set a [concat $a $i]

   605         incr i

   606     }

   607     set a

   608 } {1 3}

   610 # Test for incorrect "double evaluation" semantics

   612 test while-7.1 {delayed substitution of body} {

   613     set i 0

   614     while {[incr i] < 10} "

   615        set result $i

   616     "

   617     proc p {} {

   618 	set i 0

   619 	while {[incr i] < 10} "

   620 	    set result $i

   621 	"

   622 	set result

   623     }

   624     append result [p]

   625 } {00}

   627 # cleanup

   628 ::tcltest::cleanupTests

   629 return

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