From 01f8171019d421117aa8ceec8e000eda566611da Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Thu, 16 Apr 2009 21:32:58 +0000 Subject: [PATCH] Added build validation script and called as part of the windows cli build. Removed the appInitCmd and call the same preInitCmd code for all interpreters. Guards in the boot.tcl script prevent reinitialization of vfs code. This is required to ensure that all child interpreters and also any thread package interpreters can be initialized correctly. Checked both tclkit executables and with a basekit dll using the validation script. git-svn-id: svn://svn.equi4.com/kitgen/trunk@4472 9e558909-932a-0410-a563-af77432da1eb --- Makefile.vc | 44 ++++++++++++++++++++++---------------------- kitInit.c | 29 ++++++++--------------------- validate.tcl | 42 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 72 insertions(+), 43 deletions(-) create mode 100644 validate.tcl diff --git a/Makefile.vc b/Makefile.vc index 70dda22..05d47ad 100644 --- a/Makefile.vc +++ b/Makefile.vc @@ -172,17 +172,7 @@ tclkit-cli.exe: kit-cli.exe tidy @$(COPY) kit-cli.exe $@ -@$(UPXCOMP) kit-cli.exe -init- ../../setupvfs.tcl $(KITOPTS) $@ cli - $@ << -puts "version : Tcl [info patchlevel] $$tcl_platform(osVersion) $$tcl_platform(machine)" -set ext {starkit rechan registry dde} -foreach lib [info loaded] {if {[lindex $$lib 1] eq "zlib"} {lappend ext zlib}} -foreach pkg $$ext {package require $$pkg} -set f [open [info nameofexecutable]/boot.tcl r] -list [seek $$f 0 end] [tell $$f] [close $$f] -interp create slave -slave eval [list foreach pkg $$ext {package require $$pkg}] -<< - + $@ ../../validate.tcl tclkit-gui.exe: kit-gui.exe tidy @$(COPY) kit-gui.exe $@ @@ -220,16 +210,7 @@ tclkitsh.exe: kitsh.exe tidy @$(COPY) kitsh.exe $@ -@$(UPXCOMP) kitsh.exe -init- ../../setupvfs.tcl $(KITOPTS) $@ cli - $@ << -puts "version : Tcl [info patchlevel] $$tcl_platform(osVersion) $$tcl_platform(machine)" -set ext {starkit rechan registry dde Mk4tcl Itcl} -foreach lib [info loaded] {if {[lindex $$lib 1] eq "zlib"} {lappend ext zlib}} -foreach pkg $$ext {package require $$pkg} -set f [open [info nameofexecutable]/boot.tcl r] -list [seek $$f 0 end] [tell $$f] [close $$f] -interp create slave -slave eval [list foreach pkg $$ext {package require $$pkg}] -<< + $@ ../../validate.tcl tclkit.exe: kitsh.exe kit.exe tidy @$(COPY) kit.exe $@ @@ -244,7 +225,7 @@ kitsh.exe: setup tcl mk itcl $(PARTS:vqtcl=) files $(CLIOBJS) $(BUILD)\mk4tcl.obj $(BUILD)\mk4too.obj \ $(BUILD)\lib\vfs1.4\vfs1*.lib \ $(BUILD)\lib\mk4vc*.lib \ - $(BUILD)\lib\itcl3.4\itcl3*.lib \ +r $(BUILD)\lib\itcl3.4\itcl3*.lib \ $(BUILD)\lib\tcl$V*.lib \ $(BUILD)\lib\tcldde1*.lib \ $(BUILD)\lib\tclreg1*.lib $(LIBS) @@ -373,6 +354,25 @@ files: setup: @if not exist $(BUILD) mkdir $(BUILD) +release: + @if exist tclkit-cli.exe (\ + $(COPY) tclkit-cli.exe tmp.exe \ + ) else ( \ + $(COPY) tclkitsh.exe tmp.exe \ + ) + @tmp.exe << +set D "release-[package provide Tcl]" +set V [string map {. {}} [package provide Tcl]] +puts "copying executables to $$D" +file mkdir $$D +foreach {f s} {tclkit-cli - tclkit-gui - tclkitsh "" tclkit ""} { + if {[file exists $$f.exe]} { + file copy -force $$f.exe $$D/$$f$$s$$V.exe + } +} +<< + @del tmp.exe >NUL + tidy: @echo Tidying... -@if exist kit-cli.exp del kit-cli.exp diff --git a/kitInit.c b/kitInit.c index b35ffa6..cabc7aa 100644 --- a/kitInit.c +++ b/kitInit.c @@ -86,13 +86,15 @@ static void TclKit_InitStdChannels(void); * If there isn't one, try to open a regular "setup.tcl" file instead. * If that fails, this code will throw an error, using a message box. * - * The appInitCmd will only be run once in the main (initial) interpreter. - * The preInitCmd will be registered to run in any created interpreter. + * The tclKitPreInit script gets run for every interpreter and there are + * guards in the boot.tcl to avoid re-initializing things than do not need + * it. This is required to make child interpreters and thread interps + * initialize properly. */ -static char appInitCmd[] = -"proc tclKitInit {} {\n" - "rename tclKitInit {}\n" +static char preInitCmd[] = +"proc tclKitPreInit {} {\n" + "rename tclKitPreInit {}\n" "load {} tclkitpath\n" /*"puts \"appInit: [encoding system] $::tcl::kitpath\"\n"*/ #if KIT_INCLUDES_ZLIB @@ -129,20 +131,6 @@ static char appInitCmd[] = "error \"\n $::tcl::kitpath has no VFS data to start up\"\n" "}\n" "}\n" -"tclKitInit" -; - -static char preInitCmd[] = -"proc tclKitPreInit {} {\n" - "rename tclKitPreInit {}\n" - /* In 8.5 we need to set these paths for child interps */ - "global tcl_library tcl_libPath tcl_version\n" - "load {} tclkitpath\n" - "set noe $::tcl::kitpath\n" - "set tcl_library [file join $noe lib tcl$tcl_version]\n" - "set tcl_libPath [list $tcl_library [file join $noe lib]]\n" - "set tcl_pkgPath [list $tcl_library [file join $noe lib]]\n" -"}\n" "tclKitPreInit" ; @@ -228,8 +216,7 @@ TclKit_AppInit(Tcl_Interp *interp) #endif TclSetPreInitScript(preInitCmd); - if ((Tcl_EvalEx(interp, appInitCmd, -1, TCL_EVAL_GLOBAL) == TCL_ERROR) - || (Tcl_Init(interp) == TCL_ERROR)) + if (Tcl_Init(interp) == TCL_ERROR) goto error; #if defined(KIT_INCLUDES_TK) && defined(_WIN32) diff --git a/validate.tcl b/validate.tcl new file mode 100644 index 0000000..e931d48 --- /dev/null +++ b/validate.tcl @@ -0,0 +1,42 @@ +# validate.tcl - Copyright (C) 2009 Pat Thoyts +# +# Basic build validation for TclKit. +# +# Check that the static packages are all properly loaded into the main, child +# and any thread interpreters. +# +puts "version : Tcl [info patchlevel] $tcl_platform(osVersion) $tcl_platform(machine)" + +# check packages +set ext {rechan registry dde starkit } +foreach lib [info loaded] { + if {[lindex $lib 1] eq "zlib"} {lappend ext zlib} + if {[lindex $lib 1] eq "Mk4tcl"} {lappend ext Mk4tcl} + if {[lindex $lib 1] eq "Itcl"} {lappend ext Itcl} +} +set r {} +foreach pkg $ext {lappend r $pkg [package require $pkg]} +puts "main : $r" + +# check seeking on vfs file +set f [open [file join $::tcl::kitpath boot.tcl] r] +list [seek $f 0 end] [tell $f] [close $f] + +# check child interps +interp create slave +set r {} +foreach pkg $ext { + lappend r $pkg [slave eval [list package require $pkg]] +} +puts "child : $r" + +# check thread +set r {} +if {![catch {package require Thread}]} { + set tid [thread::create] + foreach pkg $ext { + lappend r $pkg \ + [thread::send $tid [list package require $pkg]] + } + puts "thread: $r" +} -- 2.23.0