From 7635c56e5d97f850720e137724350c619d398810 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 Nov 2012 15:25:30 +0000 Subject: Create Tcl 8.6.0 release branch --- README | 2 +- generic/tcl.h | 6 +++--- library/init.tcl | 2 +- unix/configure | 2 +- unix/configure.in | 2 +- unix/tcl.spec | 2 +- win/configure | 2 +- win/configure.in | 2 +- 8 files changed, 10 insertions(+), 10 deletions(-) diff --git a/README b/README index 56f7e38..f8965b4 100644 --- a/README +++ b/README @@ -1,5 +1,5 @@ README: Tcl - This is the Tcl 8.6b3 source distribution. + This is the Tcl 8.6.0 source distribution. http://tcl.sourceforge.net/ You can get any source release of Tcl from the file distributions link at the above URL. diff --git a/generic/tcl.h b/generic/tcl.h index 5f6146e..d765967 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -55,11 +55,11 @@ extern "C" { #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 6 -#define TCL_RELEASE_LEVEL TCL_BETA_RELEASE -#define TCL_RELEASE_SERIAL 3 +#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE +#define TCL_RELEASE_SERIAL 0 #define TCL_VERSION "8.6" -#define TCL_PATCH_LEVEL "8.6b3" +#define TCL_PATCH_LEVEL "8.6.0" /* *---------------------------------------------------------------------------- diff --git a/library/init.tcl b/library/init.tcl index 3ec78af..e836df9 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -15,7 +15,7 @@ if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 8.6b3 +package require -exact Tcl 8.6.0 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/unix/configure b/unix/configure index cbb10b4..f778a7b 100755 --- a/unix/configure +++ b/unix/configure @@ -1335,7 +1335,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL="b3" +TCL_PATCH_LEVEL=".0" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ diff --git a/unix/configure.in b/unix/configure.in index f4b695d..087bb05 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -25,7 +25,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL="b3" +TCL_PATCH_LEVEL=".0" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ diff --git a/unix/tcl.spec b/unix/tcl.spec index 0c42aa4..27f7189 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.6b3 +Version: 8.6.0 Release: 2 License: BSD Group: Development/Languages diff --git a/win/configure b/win/configure index 0258898..03a20b4 100755 --- a/win/configure +++ b/win/configure @@ -1311,7 +1311,7 @@ SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL="b3" +TCL_PATCH_LEVEL=".0" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 diff --git a/win/configure.in b/win/configure.in index 0426bb1..b0c007a 100644 --- a/win/configure.in +++ b/win/configure.in @@ -14,7 +14,7 @@ SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL="b3" +TCL_PATCH_LEVEL=".0" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 -- cgit v0.12 From ea58b7b66f821c689964f63701927b32b4de3369 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 Nov 2012 15:43:45 +0000 Subject: Declare TclOO portion of the Tcl API to be stable -> TclOO 1.0 --- generic/tclOO.h | 2 +- tests/oo.test | 2 +- tests/ooNext2.test | 2 +- unix/tclooConfig.sh | 2 +- win/tclooConfig.sh | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/generic/tclOO.h b/generic/tclOO.h index 280481c..cf253b1 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -39,7 +39,7 @@ extern const char *TclOOInitializeStubs( * win/tclooConfig.sh */ -#define TCLOO_VERSION "0.7" +#define TCLOO_VERSION "1.0" #define TCLOO_PATCHLEVEL TCLOO_VERSION /* diff --git a/tests/oo.test b/tests/oo.test index 540cdf3..5d34077 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require -exact TclOO 0.7 ;# Must match value in generic/tclOO.h +package require TclOO 1.0 package require tcltest 2 if {"::tcltest" in [namespace children]} { namespace import -force ::tcltest::* diff --git a/tests/ooNext2.test b/tests/ooNext2.test index e78e0d0..d77e8d1 100644 --- a/tests/ooNext2.test +++ b/tests/ooNext2.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require -exact TclOO 0.7 ;# Must match value in configure.in +package require TclOO 1.0 package require tcltest 2 if {"::tcltest" in [namespace children]} { namespace import -force ::tcltest::* diff --git a/unix/tclooConfig.sh b/unix/tclooConfig.sh index dce540a..d2be8dd 100644 --- a/unix/tclooConfig.sh +++ b/unix/tclooConfig.sh @@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC="" TCLOO_INCLUDE_SPEC="" TCLOO_PRIVATE_INCLUDE_SPEC="" TCLOO_CFLAGS=-DUSE_TCLOO_STUBS -TCLOO_VERSION=0.7 +TCLOO_VERSION=1.0 diff --git a/win/tclooConfig.sh b/win/tclooConfig.sh index dce540a..d2be8dd 100644 --- a/win/tclooConfig.sh +++ b/win/tclooConfig.sh @@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC="" TCLOO_INCLUDE_SPEC="" TCLOO_PRIVATE_INCLUDE_SPEC="" TCLOO_CFLAGS=-DUSE_TCLOO_STUBS -TCLOO_VERSION=0.7 +TCLOO_VERSION=1.0 -- cgit v0.12 From 6428006e92c49aaf5a4f3373c068655e73ac01be Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 12 Dec 2012 20:16:13 +0000 Subject: Prefer to extract package data from the *contents* not the directory name. --- pkgs/package.list.txt | 2 +- tools/tcltk-man2html.tcl | 57 +++++++++++++++++++++++++++++++++++++++++------- unix/Makefile.in | 3 +-- 3 files changed, 51 insertions(+), 11 deletions(-) diff --git a/pkgs/package.list.txt b/pkgs/package.list.txt index f12111d..a13b0fb 100644 --- a/pkgs/package.list.txt +++ b/pkgs/package.list.txt @@ -23,4 +23,4 @@ TDBC TDBC tdbcmysql tdbc::mysql tdbcodbc tdbc::odbc tdbcpostgres tdbc::postgres -tdbcsqlite3- tdbc::sqlite3 +tdbcsqlite3 tdbc::sqlite3 diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index 270a774..f392bce 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -461,18 +461,15 @@ proc plus-pkgs {type args} { if {!$build_tcl} return set result {} set pkgsdir $tcltkdir/$tcldir/pkgs - foreach {dir name} $args { - set globpat $pkgsdir/{$dir,$dir\[0-9\]*}/doc/*.$type + foreach {dir name version} $args { + set globpat $pkgsdir/$dir/doc/*.$type if {![llength [glob -type f -nocomplain $globpat]]} { # Fallback for manpages generated using doctools - set globpat $pkgsdir/{$dir,$dir\[0-9\]*}/doc/man/*.$type + set globpat $pkgsdir/$dir/doc/man/*.$type if {![llength [glob -type f -nocomplain $globpat]]} { continue } } - regexp "pkgs/${dir}(.*)/doc$" \ - [lindex [glob -type d $pkgsdir/{$dir,$dir\[0-9\]*}/doc] 0] \ - -> version switch $type { n { set title "$name Package Commands" @@ -650,6 +647,42 @@ try { append appdir "$tkdir" } + + # When building docs for Tcl, try to build docs for bundled packages too + set packageBuildList {} + if {$build_tcl} { + set pkgsDir [file join $tcltkdir $tcldir pkgs] + set subdirs [glob -nocomplain -types d -tails -directory $pkgsDir *] + + foreach dir [lsort $subdirs] { + # Parse the subdir name into (name, version) as fallback... + set description [split $dir -] + if {2 != [llength $description]} { + regexp {([^0-9]*)(.*)} $dir -> n v + set description [list $n $v] + } + + # ... but try to extract (name, version) from subdir contents + try { + set f [open [file join $pkgsDir $dir configure.in]] + foreach line [split [read $f] \n] { + if {2 == [scan $line \ + { AC_INIT ( [%[^]]] , [%[^]]] ) } n v]} { + set description [list $n $v] + break + } + } + } finally { + catch {close $f; unset f} + } + + if {[file exists [file join $pkgsDir $dir configure]]} { + # Looks like a package, record our best extraction attempt + lappend packageBuildList $dir {*}$description + } + } + } + # Get the list of packages to try, and what their human-readable names # are. Note that the package directory list should be version-less. try { @@ -674,6 +707,14 @@ try { } } + # Convert to human readable names, if applicable + for {set idx 0} {$idx < [llength $packageBuildList]} {incr idx 3} { + lassign [lrange $packageBuildList $idx $idx+2] d n v + if {[dict exists $packageDirNameMap $n]} { + lset packageBuildList $idx+1 [dict get $packageDirNameMap $n] + } + } + # # Invoke the scraper/converter engine. # @@ -684,12 +725,12 @@ try { "The commands which the tclsh interpreter implements."] \ [plus-base $build_tk $tkdir doc/*.n {Tk Commands} TkCmd \ "The additional commands which the wish interpreter implements."] \ - {*}[plus-pkgs n {*}$packageDirNameMap] \ + {*}[plus-pkgs n {*}$packageBuildList] \ [plus-base $build_tcl $tcldir doc/*.3 {Tcl C API} TclLib \ "The C functions which a Tcl extended C program may use."] \ [plus-base $build_tk $tkdir doc/*.3 {Tk C API} TkLib \ "The additional C functions which a Tk extended C program may use."] \ - {*}[plus-pkgs 3 {*}$packageDirNameMap] + {*}[plus-pkgs 3 {*}$packageBuildList] } on error {msg opts} { # On failure make sure we show what went wrong. We're not supposed # to get here though; it represents a bug in the script. diff --git a/unix/Makefile.in b/unix/Makefile.in index 680d4ce..df05759 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -2019,8 +2019,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h \ $(DISTDIR)/libtommath mkdir $(DISTDIR)/pkgs - cp $(TOP_DIR)/pkgs/README $(TOP_DIR)/pkgs/package.list.txt \ - $(DISTDIR)/pkgs + cp $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \ tar -C $(DISTDIR)/pkgs -xzf "$$i"; \ done -- cgit v0.12 From 093fb49d43ccd695857584d78cab37848c0f362a Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 13 Dec 2012 19:43:43 +0000 Subject: Simplify the [info object] and [info class] additions. --- generic/tclOOInfo.c | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index e09ee4e..3f37a6d 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -114,21 +114,15 @@ TclOOInitInfo( infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY); if (infoCmd != NULL && Tcl_IsEnsemble(infoCmd)) { - Tcl_Obj *mapDict, *objectObj, *classObj; + Tcl_Obj *mapDict; Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict); if (mapDict != NULL) { - objectObj = Tcl_NewStringObj("object", -1); - classObj = Tcl_NewStringObj("class", -1); - Tcl_IncrRefCount(objectObj); - Tcl_IncrRefCount(classObj); - Tcl_DictObjPut(NULL, mapDict, objectObj, + Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1), Tcl_NewStringObj("::oo::InfoObject", -1)); - Tcl_DictObjPut(NULL, mapDict, classObj, + Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1), Tcl_NewStringObj("::oo::InfoClass", -1)); - Tcl_DecrRefCount(objectObj); - Tcl_DecrRefCount(classObj); Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict); } } -- cgit v0.12 From b13b1c602065dce05521c69866b973df90affb6b Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 17 Dec 2012 14:27:44 +0000 Subject: Slim down the code a bit more; we can make more safe assumptions. --- generic/tclOOInfo.c | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index 3f37a6d..5be9b01 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -100,6 +100,7 @@ TclOOInitInfo( Tcl_Interp *interp) { Tcl_Command infoCmd; + Tcl_Obj *mapDict; /* * Build the ensembles used to implement [info object] and [info class]. @@ -113,19 +114,12 @@ TclOOInitInfo( */ infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY); - if (infoCmd != NULL && Tcl_IsEnsemble(infoCmd)) { - Tcl_Obj *mapDict; - - Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict); - if (mapDict != NULL) { - - Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1), - Tcl_NewStringObj("::oo::InfoObject", -1)); - Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1), - Tcl_NewStringObj("::oo::InfoClass", -1)); - Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict); - } - } + Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict); + Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1), + Tcl_NewStringObj("::oo::InfoObject", -1)); + Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1), + Tcl_NewStringObj("::oo::InfoClass", -1)); + Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict); } /* -- cgit v0.12 From 569360bf40839acdb1eefefb0cf1fbb8b7e33083 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 18 Dec 2012 09:37:42 +0000 Subject: Generate better code for the common case of subst-ed variables where the variable is a simple scalar or an array with a simple literal element name. --- generic/tclCompCmdsSZ.c | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 9c93fb2..71a1dfc 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -836,6 +836,21 @@ TclSubstCompile( TclEmitPush(literal, envPtr); count++; continue; + case TCL_TOKEN_VARIABLE: + /* + * Simple variable access; can only generate TCL_OK or TCL_ERROR + * so no need to generate elaborate exception-management code. + */ + + if (tokenPtr->numComponents == 1 || (tokenPtr->numComponents == 2 + && tokenPtr[2].type == TCL_TOKEN_TEXT)) { + envPtr->line = bline; + TclCompileVarSubst(interp, tokenPtr, envPtr); + bline = envPtr->line; + count++; + continue; + } + break; } while (count > 255) { -- cgit v0.12 From 81a67b9cf4d7fa11160de36419042e5f5812cc5c Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 18 Dec 2012 10:21:34 +0000 Subject: Better version that can handle simple composite array keys as well. As long as they are free of command substitutions, we can still safely omit the exception processor code. --- generic/tclCompCmdsSZ.c | 33 +++++++++++++++++++++++---------- 1 file changed, 23 insertions(+), 10 deletions(-) diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 71a1dfc..7bead0d 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -838,19 +838,32 @@ TclSubstCompile( continue; case TCL_TOKEN_VARIABLE: /* - * Simple variable access; can only generate TCL_OK or TCL_ERROR - * so no need to generate elaborate exception-management code. + * Check for simple variable access; see if we can only generate + * TCL_OK or TCL_ERROR from the substituted variable read; if so, + * there is no need to generate elaborate exception-management + * code. Note that the first component of TCL_TOKEN_VARIABLE is + * always TCL_TOKEN_TEXT... */ - if (tokenPtr->numComponents == 1 || (tokenPtr->numComponents == 2 - && tokenPtr[2].type == TCL_TOKEN_TEXT)) { - envPtr->line = bline; - TclCompileVarSubst(interp, tokenPtr, envPtr); - bline = envPtr->line; - count++; - continue; + if (tokenPtr->numComponents > 1) { + int i, foundCommand = 0; + + for (i=2 ; i<=tokenPtr->numComponents ; i++) { + if (tokenPtr[i].type == TCL_TOKEN_COMMAND) { + foundCommand = 1; + break; + } + } + if (foundCommand) { + break; + } } - break; + + envPtr->line = bline; + TclCompileVarSubst(interp, tokenPtr, envPtr); + bline = envPtr->line; + count++; + continue; } while (count > 255) { -- cgit v0.12 From fac8f9d0ae0b5845ac81ae09a4cbec06964ec2a4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 21 Dec 2012 08:16:50 +0000 Subject: Turn pkgb.so into a Tcl9 interoperability test library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 9 should either result in an error-message, either succeed, but never crash. Eliminate unnessarcy static HasStubSupport() and isDigit() functions, just do the same inline. --- ChangeLog | 8 ++++++ generic/tclStubLib.c | 33 +++++++---------------- unix/dltest/pkgb.c | 76 ++++++++++++++++++++++++++++------------------------ 3 files changed, 58 insertions(+), 59 deletions(-) diff --git a/ChangeLog b/ChangeLog index 092d5f9..204275f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2012-12-21 Jan Nijtmans + + * unix/dltest/pkgb.c: Turn pkgb.so into a Tcl9 interoperability test + library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 9 should + either result in an error-message, either succeed, but never crash. + * generic/tclStubLib.c: Eliminate unnessarcy static HasStubSupport() and + isDigit() functions, just do the same inline. + 2012-12-13 Jan Nijtmans * generic/tcl.h: Fix Tcl_DecrRefCount macro such that it diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index ceee8f3..7b62f5e 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -19,28 +19,11 @@ TclPlatStubs *tclPlatStubsPtr = NULL; TclIntStubs *tclIntStubsPtr = NULL; TclIntPlatStubs *tclIntPlatStubsPtr = NULL; -static TclStubs * -HasStubSupport(interp) - Tcl_Interp *interp; -{ - Interp *iPtr = (Interp *) interp; - - if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) { - return iPtr->stubTable; - } - interp->result = "interpreter uses an incompatible stubs mechanism"; - interp->freeProc = TCL_STATIC; - return NULL; -} - /* - * Use our own isdigit to avoid linking to libc on windows + * Use our own ISDIGIT to avoid linking to libc on windows */ -static int isDigit(const int c) -{ - return (c >= '0' && c <= '9'); -} +#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9) /* *---------------------------------------------------------------------- @@ -66,9 +49,10 @@ Tcl_InitStubs(interp, version, exact) CONST char *version; int exact; { + Interp *iPtr = (Interp *) interp; CONST char *actualVersion = NULL; ClientData pkgData = NULL; - TclStubs *stubsPtr; + TclStubs *stubsPtr = iPtr->stubTable; /* * We can't optimize this check by caching tclStubsPtr because that @@ -76,8 +60,9 @@ Tcl_InitStubs(interp, version, exact) * times. [Bug 615304] */ - stubsPtr = HasStubSupport(interp); - if (!stubsPtr) { + if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) { + iPtr->result = "interpreter uses an incompatible stubs mechanism"; + iPtr->freeProc = TCL_STATIC; return NULL; } @@ -90,7 +75,7 @@ Tcl_InitStubs(interp, version, exact) int count = 0; while (*p) { - count += !isDigit(*p++); + count += !ISDIGIT(*p++); } if (count == 1) { CONST char *q = actualVersion; @@ -99,7 +84,7 @@ Tcl_InitStubs(interp, version, exact) while (*p && (*p == *q)) { p++; q++; } - if (*p || isDigit(*q)) { + if (*p || ISDIGIT(*q)) { /* Construct error message */ stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); return NULL; diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index d7a7e5b..0bff98b 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -1,15 +1,16 @@ -/* +/* * pkgb.c -- * - * This file contains a simple Tcl package "pkgb" that is intended - * for testing the Tcl dynamic loading facilities. It can be used - * in both safe and unsafe interpreters. + * This file contains a simple Tcl package "pkgb" that is intended for + * testing the Tcl dynamic loading facilities. It can be used in both + * safe and unsafe interpreters. * * Copyright (c) 1995 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ + #include "tcl.h" /* @@ -17,17 +18,17 @@ */ static int Pkgb_SubObjCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int Pkgb_UnsafeObjCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])); + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); /* *---------------------------------------------------------------------- * * Pkgb_SubObjCmd -- * - * This procedure is invoked to process the "pkgb_sub" Tcl command. - * It expects two arguments and returns their difference. + * This procedure is invoked to process the "pkgb_sub" Tcl command. It + * expects two arguments and returns their difference. * * Results: * A standard Tcl result. @@ -43,17 +44,17 @@ Pkgb_SubObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ - Tcl_Obj * CONST objv[]; /* Argument objects. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { int first, second; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "num num"); - return TCL_ERROR; + return TCL_ERROR; } if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) { - return TCL_ERROR; + return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second)); return TCL_OK; @@ -64,8 +65,8 @@ Pkgb_SubObjCmd(dummy, interp, objc, objv) * * Pkgb_UnsafeObjCmd -- * - * This procedure is invoked to process the "pkgb_unsafe" Tcl command. - * It just returns a constant string. + * This procedure is invoked to process the "pkgb_unsafe" Tcl command. It + * just returns a constant string. * * Results: * A standard Tcl result. @@ -81,10 +82,9 @@ Pkgb_UnsafeObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ - Tcl_Obj * CONST objv[]; /* Argument objects. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unsafe command invoked", -1)); - return TCL_OK; + return Tcl_EvalEx(interp, "list unsafe command invoked", -1, TCL_EVAL_GLOBAL); } /* @@ -92,8 +92,8 @@ Pkgb_UnsafeObjCmd(dummy, interp, objc, objv) * * Pkgb_Init -- * - * This is a package initialization procedure, which is called - * by Tcl when this package is to be added to an interpreter. + * This is a package initialization procedure, which is called by Tcl + * when this package is to be added to an interpreter. * * Results: * None. @@ -104,17 +104,20 @@ Pkgb_UnsafeObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ -int +DLLEXPORT int Pkgb_Init(interp) - Tcl_Interp *interp; /* Interpreter in which the package is - * to be made available. */ + Tcl_Interp *interp; /* Interpreter in which the package is to be + * made available. */ { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) { - return TCL_ERROR; + if (Tcl_InitStubs(interp, "8.4", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) { + return TCL_ERROR; + } + Tcl_ResetResult(interp); } - code = Tcl_PkgProvide(interp, "Pkgb", "2.3"); + code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL); if (code != TCL_OK) { return code; } @@ -130,8 +133,8 @@ Pkgb_Init(interp) * * Pkgb_SafeInit -- * - * This is a package initialization procedure, which is called - * by Tcl when this package is to be added to an unsafe interpreter. + * This is a package initialization procedure, which is called by Tcl + * when this package is to be added to a safe interpreter. * * Results: * None. @@ -142,19 +145,22 @@ Pkgb_Init(interp) *---------------------------------------------------------------------- */ -int +DLLEXPORT int Pkgb_SafeInit(interp) - Tcl_Interp *interp; /* Interpreter in which the package is - * to be made available. */ + Tcl_Interp *interp; /* Interpreter in which the package is to be + * made available. */ { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) { - return TCL_ERROR; + if (Tcl_InitStubs(interp, "8.4", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) { + return TCL_ERROR; + } + Tcl_ResetResult(interp); } - code = Tcl_PkgProvide(interp, "Pkgb", "2.3"); + code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL); if (code != TCL_OK) { - return code; + return code; } Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); -- cgit v0.12