Tcl Source Code

Artifact [9ed0221a74]
Login

Artifact 9ed0221a74da528e86534b0a6f6d2cdffa197163:

Attachment "td-3549770-3.patch" to ticket [3549770fff] added by twylite 2012-07-30 16:33:30.
Index: ChangeLog
==================================================================
--- ChangeLog
+++ ChangeLog
@@ -1,5 +1,19 @@
+2012-07-30  Trevor Davel  <[email protected]>
+
+	* win/Makefile.in: [Bug 3549770] All tests that use registry or dde packages
+	* win/makefile.vc: should try the static extension first, then the DLL
+	* tests/clock.test: indicated by the build system, then fall back to
+	* tests/fCmd.test: package require.
+	* tests/registry.test:
+	* tests/winDde.test:            
+	* library/dde/pkgIndex.tcl: Communicate library file back to tests so that  
+	* library/reg/pkgIndex.tcl: the test suite can be executed outside the build
+	environment.   
+	* tests/info.test: Fix regression caused by inserted lines that affected
+	hard-coded expected results for [info frame].  
+
 2012-07-29  Jan Nijtmans  <[email protected]>
 
 	* win/Makefile.in:  No longer build tcltest.exe to run the tests,
 	but use tclsh86.exe in combination with tcltest86.dll to do that.
 	* tests/*.test:     load tcltest86.dll if necessary.

Index: library/dde/pkgIndex.tcl
==================================================================
--- library/dde/pkgIndex.tcl
+++ library/dde/pkgIndex.tcl
@@ -3,5 +3,9 @@
 if {[::tcl::pkgconfig get debug]} {
     package ifneeded dde 1.4.0b1 [list load [file join $dir tcldde14g.dll] dde]
 } else {
     package ifneeded dde 1.4.0b1 [list load [file join $dir tcldde14.dll] dde]
 }
+if { [info exists ::ddelib] } {
+  # ::ddelib is required by windde.test
+  set ::ddelib [lindex [package ifneeded dde 1.4.0b1] 1]
+}

Index: library/reg/pkgIndex.tcl
==================================================================
--- library/reg/pkgIndex.tcl
+++ library/reg/pkgIndex.tcl
@@ -5,5 +5,9 @@
             [list load [file join $dir tclreg13g.dll] registry]
 } else {
     package ifneeded registry 1.3.0 \
             [list load [file join $dir tclreg13.dll] registry]
 }
+if { [info exists ::reglib] } {
+  # ::reglib is required by clock.test, fCmd.test and registry.test
+  set ::reglib [lindex [package ifneeded dde 1.4.0b1] 1]
+}

Index: tests/clock.test
==================================================================
--- tests/clock.test
+++ tests/clock.test
@@ -15,14 +15,13 @@
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
 if {[testConstraint win]} {
-    if {[catch {
-	    ::tcltest::loadTestedCommands
-	    package require registry
-	}]} {
+  if { (0 != [catch { load {} Registry; set ::reglib {} }])
+    && (0 != [catch { ::tcltest::loadTestedCommands; load $::reglib Registry }])
+    && (0 != [catch { set ::reglib {}; package require registry 1.1 }]) } {
 	namespace eval ::tcl::clock {variable NoRegistry {}}
     }
 }
 
 package require msgcat 1.4

Index: tests/fCmd.test
==================================================================
--- tests/fCmd.test
+++ tests/fCmd.test
@@ -26,20 +26,13 @@
 testConstraint win2000orXP 0
 # Don't know how to determine this constraint correctly
 testConstraint notNetworkFilesystem 0
 testConstraint reg 0
 if {[testConstraint win]} {
-    catch {
-	# Is the registry extension already static to this shell?
-	try {
-	    load {} Registry
-	    set ::reglib {}
-	} on error {} {
-	    # try the location given to use on the commandline to tcltest
-	    ::tcltest::loadTestedCommands
-	    load $::reglib Registry
-	}
+  if { (0 == [catch { load {} Registry; set ::reglib {} }])
+    || (0 == [catch { ::tcltest::loadTestedCommands; load $::reglib Registry }])
+    || (0 == [catch { set ::reglib {}; package require registry }]) } {
 	testConstraint reg 1
     }
 }
 
 set tmpspace /tmp;# default value

Index: tests/info.test
==================================================================
--- tests/info.test
+++ tests/info.test
@@ -17,17 +17,14 @@
 
 if {{::tcltest} ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
-
-::tcltest::loadTestedCommands
-catch [list package require -exact Tcltest [info patchlevel]]
+::tcltest::loadTestedCommands; catch [list package require -exact Tcltest [info patchlevel]]
 
 # Set up namespaces needed to test operation of "info args", "info body",
 # "info default", and "info procs" with imported procedures.
-
 catch {namespace delete test_ns_info1 test_ns_info2}
 
 namespace eval test_ns_info1 {
     namespace export *
     proc p {x} {return "x=$x"}

Index: tests/registry.test
==================================================================
--- tests/registry.test
+++ tests/registry.test
@@ -15,14 +15,13 @@
     namespace import -force ::tcltest::*
 }
 
 testConstraint reg 0
 if {[testConstraint win]} {
-    if {![catch {
-	    ::tcltest::loadTestedCommands
-	    package require registry
-	}]} {
+  if { (0 == [catch { load {} Registry; set ::reglib {} }])
+    || (0 == [catch { ::tcltest::loadTestedCommands; load $::reglib Registry }])
+    || (0 == [catch { set ::reglib {}; package require registry }]) } {
 	testConstraint reg 1
     }
 }
 
 # determine the current locale

Index: tests/winDde.test
==================================================================
--- tests/winDde.test
+++ tests/winDde.test
@@ -14,17 +14,14 @@
     #tcltest::configure -verbose {pass start}
     namespace import -force ::tcltest::*
 }
 
 testConstraint dde 0
-if {[testConstraint win]} {
-    if {![catch {
-	    ::tcltest::loadTestedCommands
-	    package require dde 1.4.0b1
-	    set ::ddelib [lindex [package ifneeded dde 1.4.0b1] 1]}]} {
+if { (0 == [catch { load {} Dde; set ::ddelib {} }])
+  || (0 == [catch { ::tcltest::loadTestedCommands; load $::ddelib Dde }])
+  || (0 == [catch { set ::ddelib {}; package require dde }]) } {
 	testConstraint dde 1
-    }
 }
 
 
 # -------------------------------------------------------------------------
 # Setup a script for a test server

Index: win/Makefile.in
==================================================================
--- win/Makefile.in
+++ win/Makefile.in
@@ -715,19 +715,19 @@
 
 test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE) $(DDE_DLL_FILE) $(REG_DLL_FILE)
 	TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
 	./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
 	-load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
-	package ifneeded dde 1.4.0b1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
-	package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
+	set ::ddelib [file normalize ${DDE_DLL_FILE}]; \
+	set ::reglib [file normalize ${REG_DLL_FILE}]" | ./$(CAT32)
 
 # Useful target to launch a built tcltest with the proper path,...
 runtest: binaries $(TCLSH) $(TEST_DLL_FILE) $(DDE_DLL_FILE) $(REG_DLL_FILE)
 	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
 	./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
-	package ifneeded dde 1.4.0b1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
-	package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
+	set ::ddelib [file normalize ${DDE_DLL_FILE}]; \
+	set ::reglib [file normalize ${REG_DLL_FILE}]" $(SCRIPT)
 
 # This target can be used to run tclsh from the build directory via
 # `make shell SCRIPT=foo.tcl`
 shell: binaries
 	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \

Index: win/makefile.vc
==================================================================
--- win/makefile.vc
+++ win/makefile.vc
@@ -566,18 +566,18 @@
 test: test-core test-pkgs
 test-core: setup $(TCLTEST) dlls $(CAT32)
 	set TCL_LIBRARY=$(ROOT:\=/)/library
 !if "$(OS)" == "Windows_NT"  || "$(MSVCDIR)" == "IDE"
 	$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
-		package ifneeded dde 1.4.0b1 [list load "$(TCLDDELIB:\=/)" dde]
-		package ifneeded registry 1.3.0 [list load "$(TCLREGLIB:\=/)" registry]
+		set ::ddelib [file normalize "$(TCLDDELIB:\=/)"]
+		set ::reglib [file normalize "$(TCLREGLIB:\=/)"]
 <<
 !else
 	@echo Please wait while the tests are collected...
 	$(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
-		package ifneeded dde 1.4.0b1 "$(TCLDDELIB:\=/)" dde]
-		package ifneeded registry 1.3.0 "$(TCLREGLIB:\=/)" registry]
+		set ::ddelib [file normalize "$(TCLDDELIB:\=/)"]
+		set ::reglib [file normalize "$(TCLREGLIB:\=/)"]
 <<
 	type tests.log | more
 !endif
 
 runtest: setup $(TCLTEST) dlls $(CAT32)