merged tcl 8.1 branch back into the main trunk

1 files changed, 594 insertions, 8 deletions

diff --git a/tests/if.test b/tests/if.test
index 8da1a0d..99e7c37 100644
--- a/tests/if.test
+++ b/tests/if.test
@@ -5,13 +5,16 @@
 # generates output for errors.  No output means no errors were found.
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: if.test,v 1.2 1998/09/14 18:40:10 stanton Exp $
+# RCS: @(#) $Id: if.test,v 1.3 1999/04/16 00:47:28 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 # Basic "if" operation.
 
@@ -495,11 +498,594 @@ test if-4.5 {TclCompileIfCmd: return value} {
 
 # Check "if" and computed command names.
 
-test if-5.1 {if and computed command names} {
-    set i 0
+catch {unset a}
+test if-5.1 {if cmd with computed command names: missing if/elseif test} {
     set z if
-    $z 1 {
-        set i 1
-    }
-    set i
+    list [catch {$z} msg] $msg
+} {1 {wrong # args: no expression after "if" argument}}
+
+test if-5.2 {if cmd with computed command names: error in if/elseif test} {
+    set z if
+    list [catch {$z {[error "error in condition"]} foo} msg] $msg
+} {1 {error in condition}}
+test if-5.3 {if cmd with computed command names: error in if/elseif test} {
+    set z if
+    list [catch {$z {1+}} msg] $msg $errorInfo
+} {1 {syntax error in expression "1+"} {syntax error in expression "1+"
+    while executing
+"$z {1+}"}}
+test if-5.4 {if cmd with computed command names: if/elseif test in braces} {
+    set z if
+    set a {}
+    $z {1<2} {set a 1}
+    set a
+} {1}
+test if-5.5 {if cmd with computed command names: if/elseif test not in braces} {
+    set z if
+    set a {}
+    $z 1<2 {set a 1}
+    set a
+} {1}
+test if-5.6 {if cmd with computed command names: multiline test expr} {
+    set z if
+    set a {}
+    $z {($tcl_platform(platform) != "foobar1") && \
+	($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4}
+    set a
+} 3
+test if-5.7 {if cmd with computed command names: "then" after if/elseif test} {
+    set z if
+    set a {}
+    $z 4>3 then {set a 1}
+    set a
+} {1}
+test if-5.8 {if cmd with computed command names: keyword other than "then" after if/elseif test} {
+    set z if
+    set a {}
+    catch {$z 1<2 therefore {set a 1}} msg 
+    set msg
+} {invalid command name "therefore"}
+test if-5.9 {if cmd with computed command names: missing "then" body} {
+    set z if
+    set a {}
+    catch {$z 1<2 then} msg 
+    set msg
+} {wrong # args: no script following "then" argument}
+test if-5.10 {if cmd with computed command names: error in "then" body} {
+    set z if
+    set a {}
+    list [catch {$z {$a!="xxx"} then {set}} msg] $msg $errorInfo
+} {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
+    while compiling
+"set"
+    invoked from within
+"$z {$a!="xxx"} then {set}"}}
+test if-5.11 {if cmd with computed command names: error in "then" body} {
+    set z if
+    list [catch {$z 2 then {[error "error in then clause"]}} msg] $msg
+} {1 {error in then clause}}
+test if-5.12 {if cmd with computed command names: "then" body in quotes} {
+    set z if
+    set a {}
+    $z 27>17 "append a x"
+    set a
+} {x}
+test if-5.13 {if cmd with computed command names: computed "then" body} {
+    set z if
+    catch {unset x1}
+    catch {unset x2}
+    set a {}
+    set x1 {append a x1}
+    set x2 {; append a x2}
+    set a {}
+    $z 1 $x1$x2
+    set a
+} {x1x2}
+test if-5.14 {if cmd with computed command names: taking proper branch} {
+    set z if
+    set a {}
+    $z 1<2 {set a 1}
+    set a
 } 1
+test if-5.15 {if cmd with computed command names: taking proper branch} {
+    set z if
+    set a {}
+    $z 1>2 {set a 1}
+    set a
+} {}
+test if-5.16 {if cmd with computed command names: test jumpFalse instruction replacement after long "then" body} {
+    set z if
+    catch {unset i}
+    set a {}
+    $z 1<2 {
+	set a 1
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 2
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 3
+    }
+    set a
+} 3
+test if-5.17 {if cmd with computed command names: if/elseif test in quotes} {
+    set z if
+    set a {}
+    list [catch {$z {"0 < 3"} {set a 1}} msg] $msg
+} {1 {expected boolean value but got "0 < 3"}}
+
+
+test if-6.1 {if cmd with computed command names: "elseif" after if/elseif test} {
+    set z if
+    set a {}
+    $z 3>4 {set a 1} elseif 1 {set a 2}
+    set a
+} {2}
+# Since "else" is optional, the "elwood" below is treated as a command.
+# But then there shouldn't be any additional argument words for the "if".
+test if-6.2 {if cmd with computed command names: keyword other than "elseif"} {
+    set z if
+    set a {}
+    catch {$z 1<2 {set a 1} elwood {set a 2}} msg 
+    set msg
+} {wrong # args: extra words after "else" clause in "if" command}
+test if-6.3 {if cmd with computed command names: missing expression after "elseif"} {
+    set z if
+    set a {}
+    catch {$z 1<2 {set a 1} elseif} msg 
+    set msg
+} {wrong # args: no expression after "elseif" argument}
+test if-6.4 {if cmd with computed command names: error in expression after "elseif"} {
+    set z if
+    set a {}
+    list [catch {$z 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
+} {1 {syntax error in expression "1>"} {syntax error in expression "1>"
+    while executing
+"$z 3>4 {set a 1} elseif {1>}"}}
+test if-6.5 {if cmd with computed command names: test jumpFalse instruction replacement after long "elseif" body} {
+    set z if
+    catch {unset i}
+    set a {}
+    $z 1>2 {
+	set a 1
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 2
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 3
+    } elseif 1<2 then { #; this if arm should be taken
+	set a 4
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 5
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 6
+    }
+    set a
+} 6
+
+test if-7.1 {if cmd with computed command names: "else" clause} {
+    set z if
+    set a {}
+    $z 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3}
+    set a
+} 3
+# Since "else" is optional, the "elsex" below is treated as a command.
+# But then there shouldn't be any additional argument words for the "if".
+test if-7.2 {if cmd with computed command names: keyword other than "else"} {
+    set z if
+    set a {}
+    catch {$z 1<2 then {set a 1} elsex {set a 2}} msg 
+    set msg
+} {wrong # args: extra words after "else" clause in "if" command}
+test if-7.3 {if cmd with computed command names: missing body after "else"} {
+    set z if
+    set a {}
+    catch {$z 2<1 {set a 1} else} msg 
+    set msg
+} {wrong # args: no script following "else" argument}
+test if-7.4 {if cmd with computed command names: error compiling body after "else"} {
+    set z if
+    set a {}
+    catch {$z 2<1 {set a 1} else {set}} msg 
+    set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+    while compiling
+"set"
+    invoked from within
+"$z 2<1 {set a 1} else {set}"}
+test if-7.5 {if cmd with computed command names: extra arguments after "else" argument} {
+    set z if
+    set a {}
+    catch {$z 2<1 {set a 1} else {set a 2} or something} msg 
+    set msg
+} {wrong # args: extra words after "else" clause in "if" command}
+# The following test also checks whether contained loops and other
+# commands are properly relocated because a short jump must be replaced
+# by a "long distance" one.
+test if-7.6 {if cmd with computed command names: test jumpFalse instruction replacement after long "else" clause} {
+    set z if
+    catch {unset i}
+    set a {}
+    $z 1>2 {
+	set a 1
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 2
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 3
+    } elseif 1==2 then { #; this if arm should be taken
+	set a 4
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 5
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 6
+    } else {
+	set a 7
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 8
+	while {$a != "xxx"} {
+	    break;
+	    while {$i >= 0} {
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		$z {[string compare $a "bar"] < 0} {
+		    set i $i
+		    set i [lindex $s $i]
+		}
+		set i [expr $i-1]
+	    }
+	}
+	set a 9
+    }
+    set a
+} 9
+
+test if-8.1 {if cmd with computed command names: "if" command result} {
+    set z if
+    set a {}
+    set a [$z 3<4 {set i 27}]
+    set a
+} 27
+test if-8.2 {if cmd with computed command names: "if" command result} {
+    set z if
+    set a {}
+    set a [$z 3>4 {set i 27}]
+    set a
+} {}
+test if-8.3 {if cmd with computed command names: "if" command result} {
+    set z if
+    set a {}
+    set a [$z 0 {set i 1} elseif 1 {set i 2}]
+    set a
+} 2
+test if-8.4 {if cmd with computed command names: "if" command result} {
+    set z if
+    set a {}
+    set a [$z 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}]
+    set a
+} 4
+test if-8.5 {if cmd with computed command names: return value} {
+    set z if
+    $z 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
+} def
+
+test if-9.1 {if cmd with namespace qualifiers} {
+    ::if {1} {set x 4}
+} 4
+
+# Test for incorrect "double evaluation semantics"
+
+test if-10.1 {delayed substitution of then body} {knownBug} {
+    set j 0
+    if {[incr j] == 1} "
+       set result $j
+    "
+    set result
+} {0}
+test if-10.2 {delayed substitution of elseif expression} {knownBug} {
+    set j 0
+    if {[incr j] == 0} {
+       set result badthen
+    } elseif "$j == 1" {
+       set result badelseif
+    } else {
+       set result ok
+    }
+    set result
+} {ok}
+test if-10.3 {delayed substitution of elseif body} {knownBug} {
+    set j 0
+    if {[incr j] == 0} {
+       set result badthen
+    } elseif {1} "
+       set result $j
+    "
+    set result
+} {0}
+test if-10.4 {delayed substitution of else body} {knownBug} {
+    set j 0
+    if {[incr j] == 0} {
+       set result badthen
+    } else "
+       set result $j
+    "
+    set result
+} {0}
+test if-10.5 {substituted control words} {knownBug} {
+    set then then; proc then {} {return badthen}
+    set else else; proc else {} {return badelse}
+    set elseif elseif; proc elseif {} {return badelseif}
+    list [catch {if 1 $then {if 0 {} $elseif 1 {if 0 {} $else {list ok}}}} a] $a
+} {0 ok}
+test if-10.6 {double invocation of variable traces} {knownBug} {
+    set iftracecounter 0
+    proc iftraceproc {args} {
+       upvar #0 iftracecounter counter
+       set argc [llength $args]
+       set extraargs [lrange $args 0 [expr {$argc - 4}]]
+       set name [lindex $args [expr {$argc - 3}]]
+       upvar 1 $name var
+       if {[incr counter] % 2 == 1} {
+           set var "$counter oops [concat $extraargs]"
+       } else {
+           set var "$counter + [concat $extraargs]"
+       }
+    }
+    trace variable iftracevar r [list iftraceproc 10]
+    list [catch {if "$iftracevar + 20" {}} a] $a \
+        [catch {if "$iftracevar + 20" {}} b] $b \
+        [unset iftracevar iftracecounter]
+} {1 {syntax error in expression "1 oops 10 + 20"} 0 {} {}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+