From fac7c80aed10356b5116daca1d8b8a160aa1d18d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 28 Jul 2012 14:52:43 +0000 Subject: [Bug 3549770] Multiple test failures running tcltest outside build tree --- ChangeLog | 6 ++++++ tests/clock.test | 4 ++-- tests/registry.test | 11 +++++------ tests/winDde.test | 19 ++++++++++--------- 4 files changed, 23 insertions(+), 17 deletions(-) diff --git a/ChangeLog b/ChangeLog index 4918ede..14cb0b2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2012-07-28 Jan Nijtmans + + * tests/clock.test: [Bug 3549770] Multiple test failures running tcltest + * tests/registry.test: outside build tree + * tests/winDde.test: + 2012-07-27 Jan Nijtmans * generic/tclUniData.c: Support Unicode 6.2 (Add Turkish lira sign) diff --git a/tests/clock.test b/tests/clock.test index 42675a5..5db6273 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -17,8 +17,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } if {[testConstraint win]} { - if {[catch {package require registry 1.1}] - && [catch {load {} Registry}] + if {[catch {load {} Registry}] + && [catch {package require registry}] && [catch { ::tcltest::loadTestedCommands load $::reglib Registry diff --git a/tests/registry.test b/tests/registry.test index f90f602..cda914f 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -17,13 +17,12 @@ if {[lsearch [namespace children] ::tcltest] == -1} { testConstraint reg 0 if {[testConstraint win]} { - catch { - # Is the registry extension already static to this shell? - if [catch {load {} Registry; set ::reglib {}}] { - # try the location given to use on the commandline to tcltest + if {![catch {load {} Registry}] + || ![catch {package require registry}] + || ![catch { ::tcltest::loadTestedCommands load $::reglib Registry - } + }]} { testConstraint reg 1 } } @@ -460,7 +459,7 @@ test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} { registry delete HKEY_CURRENT_USER\\TclFoobar set result } "foo ba r baz" -test registry-6.21 {GetValue: very long value names and values} {pcOnly} { +test registry-6.21 {GetValue: very long value names and values} {pcOnly reg} { registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 199] [string repeat x 199] multi_sz set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 199]] registry delete HKEY_CURRENT_USER\\TclFoobar diff --git a/tests/winDde.test b/tests/winDde.test index 9c777c3..b684394 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -15,17 +15,16 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +testConstraint dde 0 if {[testConstraint win]} { - if [catch { - # Is the dde extension already static to this shell? - if [catch {load {} Dde; set ::ddelib {}}] { - # try the location given to use on the commandline to tcltest + if {![catch {load {} Dde; set ::ddelib {}}] + || ![catch { + package require dde + set ::ddelib [lindex [package ifneeded dde 1.3.3] 1]}] + || ![catch { ::tcltest::loadTestedCommands - load $::ddelib Dde - } + load $::ddelib Dde}]} { testConstraint dde 1 - }] { - testConstraint dde 0 } } @@ -41,8 +40,10 @@ proc createChildProcess { ddeServerName {handler {}}} { set f [open $::scriptName w+] puts $f [list set ddeServerName $ddeServerName] - if {$::ddelib != ""} { + if {[info exists ::ddelib]} { puts $f [list load $::ddelib Dde] + } else { + puts $f [list package require dde] } puts $f { # DDE child server - -- cgit v0.12 From a8b104c3b5ef5cf3721b20a37d48360b90f77a10 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 28 Jul 2012 22:54:19 +0000 Subject: Bug [3549770]: Multiple test failures running tcltest outside build tree --- tests/clock.test | 6 ++---- tests/registry.test | 6 ++---- tests/winDde.test | 17 +++++------------ win/Makefile.in | 8 ++++---- win/makefile.vc | 8 ++++---- 5 files changed, 17 insertions(+), 28 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index 5db6273..fea1fc9 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -17,11 +17,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } if {[testConstraint win]} { - if {[catch {load {} Registry}] - && [catch {package require registry}] - && [catch { + if {[catch { ::tcltest::loadTestedCommands - load $::reglib Registry + package require registry }]} { namespace eval ::tcl::clock {variable NoRegistry {}} } diff --git a/tests/registry.test b/tests/registry.test index cda914f..cbca4fd 100644 --- a/tests/registry.test +++ b/tests/registry.test @@ -17,11 +17,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { testConstraint reg 0 if {[testConstraint win]} { - if {![catch {load {} Registry}] - || ![catch {package require registry}] - || ![catch { + if {![catch { ::tcltest::loadTestedCommands - load $::reglib Registry + package require registry }]} { testConstraint reg 1 } diff --git a/tests/winDde.test b/tests/winDde.test index b684394..f0ef56c 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -17,13 +17,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} { testConstraint dde 0 if {[testConstraint win]} { - if {![catch {load {} Dde; set ::ddelib {}}] - || ![catch { - package require dde - set ::ddelib [lindex [package ifneeded dde 1.3.3] 1]}] - || ![catch { + if {![catch { ::tcltest::loadTestedCommands - load $::ddelib Dde}]} { + package require dde + set ::ddelib [lindex [package ifneeded dde 1.3.3] 1]}]} { testConstraint dde 1 } } @@ -35,16 +32,12 @@ if {[testConstraint win]} { set scriptName [makeFile {} script1.tcl] -proc createChildProcess { ddeServerName {handler {}}} { +proc createChildProcess {ddeServerName {handler {}}} { file delete -force $::scriptName set f [open $::scriptName w+] puts $f [list set ddeServerName $ddeServerName] - if {[info exists ::ddelib]} { - puts $f [list load $::ddelib Dde] - } else { - puts $f [list package require dde] - } + puts $f [list load $::ddelib dde] puts $f { # DDE child server - # diff --git a/win/Makefile.in b/win/Makefile.in index a06cc3f..8e01818 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -696,14 +696,14 @@ install-private-headers: libraries test: binaries $(TCLTEST) TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ - -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \ - set ::reglib [file normalize ${REG_DLL_FILE}]" | ./$(CAT32) + -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) # Useful target to launch a built tcltest with the proper path,... runtest: binaries $(TCLTEST) @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ - ./$(TCLTEST) $(TESTFLAGS) -load "set ::ddelib [file normalize ${DDE_DLL_FILE}]; \ - set ::reglib [file normalize ${REG_DLL_FILE}]" $(SCRIPT) + ./$(TCLTEST) $(TESTFLAGS) -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ + package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) # This target can be used to run tclsh from the build directory via # `make shell SCRIPT=foo.tcl` diff --git a/win/makefile.vc b/win/makefile.vc index e453df1..5db8143 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -527,14 +527,14 @@ test: setup $(TCLTEST) dlls $(CAT32) set TCL_LIBRARY=$(ROOT)/library !if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE" $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile << - set ::ddelib [file normalize $(TCLDDELIB:\=/)] - set ::reglib [file normalize $(TCLREGLIB:\=/)] + package ifneeded dde 1.3.3 [list load "$(TCLDDELIB:\=/)" dde] + package ifneeded registry 1.2.2 [list load "$(TCLREGLIB:\=/)" registry] << !else @echo Please wait while the tests are collected... $(TCLTEST) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log - set ::ddelib [file normalize $(TCLDDELIB:\=/)] - set ::reglib [file normalize $(TCLREGLIB:\=/)] + package ifneeded dde 1.3.3 "$(TCLDDELIB:\=/)" dde] + package ifneeded registry 1.2.2 "$(TCLREGLIB:\=/)" registry] << type tests.log | more !endif -- cgit v0.12