Merge 8.6

Author: jan.nijtmans

tests-perf/test-performance.tcl

@@ -137,7 +137,7 @@ proc _test_run {args} {
       set args [lrange $args 1 end]
     } else {
       if {[llength $args] <= 2} {
-        return -code error "value expected for option $o"
+	return -code error "value expected for option $o"
       }
       set _($o) [lindex $args 1]
       set args [lrange $args 2 end]
@@ -169,7 +169,7 @@ proc _test_run {args} {
     if {[regexp {^\s*(?:setup|cleanup)\s+} $_(c)]} {
       set _(c) [lindex $_(c) 1]
       if {$_(-uplevel)} {
-        set _(c) [list uplevel 1 $_(c)]
+	set _(c) [list uplevel 1 $_(c)]
       }
       {*}$_(outcmd) [if 1 $_(c)]
       continue
@@ -184,7 +184,7 @@ proc _test_run {args} {
       if {$_(-convert-result) ne ""} { set _(r) [if 1 $_(-convert-result)] }
       {*}$_(outcmd) $_(r)
       if {[llength $_(ittime)] > 1} { # decrement max-count
-        lset _(ittime) 1 [expr {[lindex $_(ittime) 1] - 1}]
+	lset _(ittime) 1 [expr {[lindex $_(ittime) 1] - 1}]
       }
     }
     {*}$_(outcmd) [set _(m) [timerate $_(c) {*}$_(ittime)]]

tests/parseOld.test

@@ -1,6 +1,5 @@
-# Commands covered:  set (plus basic command syntax).  Also tests the
-# procedures in the file tclOldParse.c.  This set of tests is an old
-# one that predates the new parser in Tcl 8.1.
+# Commands covered:  set (plus basic command syntax).  This set
+# of tests is an old one that predates the parser in Tcl 8.1.
 #
 # This file contains a collection of tests for one or more of the Tcl
 # built-in commands.  Sourcing this file into Tcl runs the tests and
@@ -363,17 +362,17 @@ test parseOld-10.14 {syntax errors} {
 "eval \$x[format "%01000d" 0]("}}
 test parseOld-10.15 {syntax errors, missplaced braces} {
     catch {
-        proc misplaced_end_brace {} {
-            set what foo
-            set when [expr ${what}size - [set off$what]}]
+	proc misplaced_end_brace {} {
+	    set what foo
+	    set when [expr ${what}size - [set off$what]}]
     } msg
     set msg
 } {extra characters after close-brace}
 test parseOld-10.16 {syntax errors, missplaced braces} {
     catch {
-        set a {
-            set what foo
-            set when [expr ${what}size - [set off$what]}]
+	set a {
+	    set what foo
+	    set when [expr ${what}size - [set off$what]}]
     } msg
     set msg
 } {extra characters after close-brace}

tests/tcltests.tcl

@@ -15,6 +15,11 @@ testConstraint debugpurify [
 	&& [testConstraint debug]
 	&& [testConstraint purify]
     }]
+testConstraint bigmem [expr {[
+	info exists ::env(TCL_TESTCONSTRAINT_BIGMEM)]
+		? !!$::env(TCL_TESTCONSTRAINT_BIGMEM)
+		: 1
+}]
 testConstraint fcopy         [llength [info commands fcopy]]
 testConstraint fileevent     [llength [info commands fileevent]]
 testConstraint thread        [expr {![catch {package require Thread 2.7-}]}]
@@ -70,47 +75,47 @@ namespace eval ::tcltests {
     #  testnumargs "lappend" "varName" "?value ...?"
     proc testnumargs {cmd {fixed {}} {optional {}} args} {
 	variable count
-        set minargs [llength $fixed]
-        set maxargs [expr {$minargs + [llength $optional]}]
-        if {[regexp {\.\.\.\??$} [lindex $optional end]]} {
-            unset maxargs; # No upper limit on num of args
-        }
-        set message "wrong # args: should be \"$cmd"
-        if {[llength $fixed]} {
-            append message " $fixed"
-        }
-        if {[llength $optional]} {
-            append message " $optional"
-        }
-        if {[llength $fixed] == 0 && [llength $optional] == 0} {
-            append message " \""
-        } else {
-            append message "\""
-        }
-        set label [join $cmd -]
-        if {$minargs > 0} {
-            set arguments [lrepeat [expr {$minargs-1}] x]
-            test $label-minargs-[incr count($label-minargs)] \
+	set minargs [llength $fixed]
+	set maxargs [expr {$minargs + [llength $optional]}]
+	if {[regexp {\.\.\.\??$} [lindex $optional end]]} {
+	    unset maxargs; # No upper limit on num of args
+	}
+	set message "wrong # args: should be \"$cmd"
+	if {[llength $fixed]} {
+	    append message " $fixed"
+	}
+	if {[llength $optional]} {
+	    append message " $optional"
+	}
+	if {[llength $fixed] == 0 && [llength $optional] == 0} {
+	    append message " \""
+	} else {
+	    append message "\""
+	}
+	set label [join $cmd -]
+	if {$minargs > 0} {
+	    set arguments [lrepeat [expr {$minargs-1}] x]
+	    test $label-minargs-[incr count($label-minargs)] \
 		"$label no arguments" \
-                -body "$cmd" \
-                -result $message -returnCodes error \
-                {*}$args
-            if {$minargs > 1} {
-                test $label-minargs-[incr count($label-minargs)] \
+		-body "$cmd" \
+		-result $message -returnCodes error \
+		{*}$args
+	    if {$minargs > 1} {
+		test $label-minargs-[incr count($label-minargs)] \
 		    "$label missing arguments" \
-                    -body "$cmd $arguments" \
-                    -result $message -returnCodes error \
-                    {*}$args
-            }
-        }
-        if {[info exists maxargs]} {
-            set arguments [lrepeat [expr {$maxargs+1}] x]
-            test $label-maxargs-[incr count($label-maxargs)] \
+		    -body "$cmd $arguments" \
+		    -result $message -returnCodes error \
+		    {*}$args
+	    }
+	}
+	if {[info exists maxargs]} {
+	    set arguments [lrepeat [expr {$maxargs+1}] x]
+	    test $label-maxargs-[incr count($label-maxargs)] \
 		"$label extra arguments" \
-                -body "$cmd $arguments" \
-                -result $message -returnCodes error \
-                {*}$args
-        }
+		-body "$cmd $arguments" \
+		-result $message -returnCodes error \
+		{*}$args
+	}
     }
 
     init