From 7c3322a2ee80527c01e51cde6a9681d96228fab3 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 25 Oct 2023 17:57:00 +0000 Subject: Since TIP 258 (2005) and development efforts leading up to it (2004), the Tcltest package has not been a caller of routines Tcl(Get|Set)LibraryPath, so there's no longer a need for those to be in the internal stubs table. After they are removed from the table, they no longer need to exist at all. --- generic/tclEncoding.c | 48 +----------------------------------------------- generic/tclInt.decls | 13 +++++++------ generic/tclIntDecls.h | 16 ++++++---------- generic/tclStubInit.c | 4 ++-- 4 files changed, 16 insertions(+), 65 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index e461db2..b441bf63 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -409,52 +409,6 @@ Tcl_SetEncodingSearchPath( } /* - *---------------------------------------------------------------------- - * - * TclGetLibraryPath -- - * - * Keeps the per-thread copy of the library path current with changes to - * the global copy. - * - * Results: - * Returns a "list" (Tcl_Obj *) that contains the library path. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclGetLibraryPath(void) -{ - return TclGetProcessGlobalValue(&libraryPath); -} - -/* - *---------------------------------------------------------------------- - * - * TclSetLibraryPath -- - * - * Keeps the per-thread copy of the library path current with changes to - * the global copy. - * - * Since the result of this routine is void, if searchPath is not a valid - * list this routine silently does nothing. - * - *---------------------------------------------------------------------- - */ - -void -TclSetLibraryPath( - Tcl_Obj *path) -{ - Tcl_Size dummy; - - if (TCL_ERROR == TclListObjLengthM(NULL, path, &dummy)) { - return; - } - TclSetProcessGlobalValue(&libraryPath, path, NULL); -} - -/* *--------------------------------------------------------------------------- * * FillEncodingFileMap -- @@ -4382,7 +4336,7 @@ InitializeEncodingSearchPath( TclNewObj(searchPathObj); Tcl_IncrRefCount(encodingObj); Tcl_IncrRefCount(searchPathObj); - libPathObj = TclGetLibraryPath(); + libPathObj = TclGetProcessGlobalValue(&libraryPath); Tcl_IncrRefCount(libPathObj); TclListObjLengthM(NULL, libPathObj, &numDirs); diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 62f7580..b7b1703 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -364,12 +364,13 @@ declare 151 { void TclRegExpRangeUniChar(Tcl_RegExp re, Tcl_Size index, Tcl_Size *startPtr, Tcl_Size *endPtr) } -declare 152 { - void TclSetLibraryPath(Tcl_Obj *pathPtr) -} -declare 153 { - Tcl_Obj *TclGetLibraryPath(void) -} +# Tcl*LibraryPath routines were obsoleted in Tcl 8.5 +#declare 152 { +# void TclSetLibraryPath(Tcl_Obj *pathPtr) +#} +#declare 153 { +# Tcl_Obj *TclGetLibraryPath(void) +#} declare 156 { void TclRegError(Tcl_Interp *interp, const char *msg, int status) diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 3ebe2eb..d94dcb2 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -413,10 +413,8 @@ EXTERN int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re); /* 151 */ EXTERN void TclRegExpRangeUniChar(Tcl_RegExp re, Tcl_Size index, Tcl_Size *startPtr, Tcl_Size *endPtr); -/* 152 */ -EXTERN void TclSetLibraryPath(Tcl_Obj *pathPtr); -/* 153 */ -EXTERN Tcl_Obj * TclGetLibraryPath(void); +/* Slot 152 is reserved */ +/* Slot 153 is reserved */ /* Slot 154 is reserved */ /* Slot 155 is reserved */ /* 156 */ @@ -846,8 +844,8 @@ typedef struct TclIntStubs { void (*tclHandleRelease) (TclHandle handle); /* 149 */ int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */ void (*tclRegExpRangeUniChar) (Tcl_RegExp re, Tcl_Size index, Tcl_Size *startPtr, Tcl_Size *endPtr); /* 151 */ - void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */ - Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */ + void (*reserved152)(void); + void (*reserved153)(void); void (*reserved154)(void); void (*reserved155)(void); void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */ @@ -1217,10 +1215,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclRegAbout) /* 150 */ #define TclRegExpRangeUniChar \ (tclIntStubsPtr->tclRegExpRangeUniChar) /* 151 */ -#define TclSetLibraryPath \ - (tclIntStubsPtr->tclSetLibraryPath) /* 152 */ -#define TclGetLibraryPath \ - (tclIntStubsPtr->tclGetLibraryPath) /* 153 */ +/* Slot 152 is reserved */ +/* Slot 153 is reserved */ /* Slot 154 is reserved */ /* Slot 155 is reserved */ #define TclRegError \ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 97f37b0..8ba5e4e 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -932,8 +932,8 @@ static const TclIntStubs tclIntStubs = { TclHandleRelease, /* 149 */ TclRegAbout, /* 150 */ TclRegExpRangeUniChar, /* 151 */ - TclSetLibraryPath, /* 152 */ - TclGetLibraryPath, /* 153 */ + 0, /* 152 */ + 0, /* 153 */ 0, /* 154 */ 0, /* 155 */ TclRegError, /* 156 */ -- cgit v0.12 From 21e5eb5e3e51e0d244cc9dd876049dc25db27c49 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 30 Oct 2023 19:32:29 +0000 Subject: Testing commands [test(g|s)etencpath] have evolved themselves into functional duplicates of [encoding dirs]. We don't need them anymore. --- generic/tclTest.c | 72 ----------------------------------------------------- tests/encoding.test | 13 ++++------ tests/unixInit.test | 2 -- 3 files changed, 5 insertions(+), 82 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 6a90b67..895de64 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -321,8 +321,6 @@ static Tcl_ObjCmdProc TestFilesystemObjCmd; static Tcl_ObjCmdProc TestSimpleFilesystemObjCmd; static void TestReport(const char *cmd, Tcl_Obj *arg1, Tcl_Obj *arg2); -static Tcl_ObjCmdProc TestgetencpathObjCmd; -static Tcl_ObjCmdProc TestsetencpathObjCmd; static Tcl_Obj * TestReportGetNativePath(Tcl_Obj *pathPtr); static Tcl_FSStatProc TestReportStat; static Tcl_FSAccessProc TestReportAccess; @@ -749,10 +747,6 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd, - NULL, NULL); Tcl_CreateObjCommand(interp, "testapplylambda", TestApplyLambdaObjCmd, NULL, NULL); @@ -8418,72 +8412,6 @@ TestconcatobjCmd( /* *---------------------------------------------------------------------- * - * TestgetencpathObjCmd -- - * - * This function implements the "testgetencpath" command. It is used to - * test Tcl_GetEncodingSearchPath(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestgetencpathObjCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ -{ - if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, ""); - return TCL_ERROR; - } - - Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath()); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TestsetencpathCmd -- - * - * This function implements the "testsetencpath" command. It is used to - * test Tcl_SetDefaultEncodingDir(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestsetencpathObjCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ -{ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "defaultDir"); - return TCL_ERROR; - } - - Tcl_SetEncodingSearchPath(objv[1]); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * TestparseargsCmd -- * * This procedure implements the "testparseargs" command. It is used to diff --git a/tests/encoding.test b/tests/encoding.test index 76b5306..70aa99e 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -41,7 +41,6 @@ testConstraint testencoding [llength [info commands testencoding]] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint teststringbytes [llength [info commands teststringbytes]] testConstraint exec [llength [info commands exec]] -testConstraint testgetencpath [llength [info commands testgetencpath]] # TclInitEncodingSubsystem is tested by the rest of this file # TclFinalizeEncodingSubsystem is not currently tested @@ -1031,15 +1030,13 @@ foreach from {cp932 shiftjis euc-jp iso2022-jp} { } } -test encoding-26.0 {Tcl_GetEncodingSearchPath} -constraints { - testgetencpath -} -setup { - set origPath [testgetencpath] - testsetencpath slappy +test encoding-26.0 {Tcl_GetEncodingSearchPath} -setup { + set origPath [encoding dirs] + encoding dirs slappy } -body { - testgetencpath + encoding dirs } -cleanup { - testsetencpath $origPath + encoding dirs $origPath } -result slappy file delete {*}[glob -directory [temporaryDirectory] *.chars *.tcltestout] diff --git a/tests/unixInit.test b/tests/unixInit.test index 3a9fa6d..7c2c78c 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -18,8 +18,6 @@ unset -nocomplain path catch {set oldlang $env(LANG)} set env(LANG) C -# Some tests require the testgetencpath command -testConstraint testgetencpath [llength [info commands testgetencpath]] test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} { set x {} -- cgit v0.12 From 097954529a4f7cbc2bba17841f07a4283b68f1cc Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 13 Nov 2023 20:10:15 +0000 Subject: remove debugs --- generic/tclCmdAH.c | 2 -- generic/tclEncoding.c | 6 ------ generic/tclInterp.c | 8 -------- generic/tclZipfs.c | 1 - 4 files changed, 17 deletions(-) diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 86f1cda..e7e929f 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -865,13 +865,11 @@ EncodingDirsObjCmd( return TCL_ERROR; } if (objc == 1) { -fprintf(stdout, "ED GET CALLER\n"); fflush(stdout); Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath()); return TCL_OK; } dirListObj = objv[1]; -fprintf(stdout, "ED SET CALLER\n"); fflush(stdout); if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected directory list but got \"%s\"", diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index ff73904..1d87622 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -439,7 +439,6 @@ FillEncodingFileMap(void) Tcl_Size i, numDirs = 0; Tcl_Obj *map, *searchPath; -fprintf(stdout, "FEFM CALLER\n"); fflush(stdout); searchPath = Tcl_GetEncodingSearchPath(); Tcl_IncrRefCount(searchPath); TclListObjLengthM(NULL, searchPath, &numDirs); @@ -723,7 +722,6 @@ Tcl_GetDefaultEncodingDir(void) { int numDirs; Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath(); -fprintf(stdout, "GDE CALLER\n"); fflush(stdout); TclListObjLengthM(NULL, searchPath, &numDirs); if (numDirs == 0) { @@ -760,7 +758,6 @@ Tcl_SetDefaultEncodingDir( searchPath = Tcl_DuplicateObj(searchPath); Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory); -fprintf(stdout, "SDE CALLER\n"); fflush(stdout); Tcl_SetEncodingSearchPath(searchPath); } #endif @@ -1775,7 +1772,6 @@ OpenEncodingFileChannel( Tcl_Obj **dir, *path, *directory = NULL; Tcl_Channel chan = NULL; Tcl_Size i, numDirs; -fprintf(stdout, "OEFC CALLER\n"); fflush(stdout); TclListObjGetElementsM(NULL, searchPath, &numDirs, &dir); Tcl_IncrRefCount(nameObj); @@ -4317,8 +4313,6 @@ InitializeEncodingSearchPath( Tcl_Size i, numDirs, numBytes; Tcl_Obj *libPathObj, *encodingObj, *searchPathObj; -fprintf(stdout, "IESP\n"); fflush(stdout); - TclNewLiteralStringObj(encodingObj, "encoding"); TclNewObj(searchPathObj); Tcl_IncrRefCount(encodingObj); diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 0325091..b023615 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -393,25 +393,19 @@ Tcl_Init( " rename tclInit {}\n" " if {[info exists tcl_library]} {\n" " set scripts {{set tcl_library}}\n" -"puts A-SCRIPTS:$scripts\n" " } else {\n" " set scripts {}\n" " if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n" " lappend scripts {set env(TCL_LIBRARY)}\n" -"puts B-SCRIPTS:$scripts\n" " lappend scripts {\n" "if {[regexp ^tcl(.*)$ [file tail $env(TCL_LIBRARY)] -> tail] == 0} continue\n" "if {$tail eq [info tclversion]} continue\n" "file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n" -"puts C-SCRIPTS:$scripts\n" " }\n" -"puts D-SCRIPTS:$scripts\n" " if {[info exists tclDefaultLibrary]} {\n" " lappend scripts {set tclDefaultLibrary}\n" -"puts E-SCRIPTS:$scripts\n" " } else {\n" " lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n" -"puts F-SCRIPTS:$scripts\n" " }\n" " lappend scripts {\n" "set parentDir [file dirname [file dirname [info nameofexecutable]]]\n" @@ -430,14 +424,12 @@ Tcl_Init( " lappend scripts [list lindex \\$tcl_libPath $i]\n" " }\n" " }\n" -"puts G-SCRIPTS:$scripts\n" " }\n" " set dirs {}\n" " set errors {}\n" " foreach script $scripts {\n" " lappend dirs [eval $script]\n" " set tcl_library [lindex $dirs end]\n" -"puts TRIAL:$tcl_library\n" " set tclfile [file join $tcl_library init.tcl]\n" " if {[file exists $tclfile]} {\n" " if {[catch {uplevel #0 [list source $tclfile]} msg opts]} {\n" diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 5400f92..adabcda 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -4272,7 +4272,6 @@ ScriptLibrarySetup( Tcl_FSJoinToPath(libDirObj, 1, &subDirObj)); Tcl_DecrRefCount(subDirObj); Tcl_IncrRefCount(searchPathObj); -fprintf(stdout, "AH CALLER\n"); fflush(stdout); Tcl_SetEncodingSearchPath(searchPathObj); Tcl_DecrRefCount(searchPathObj); return libDirObj; -- cgit v0.12 From c06af67a15fe0eef8a17ff3d89d0f88193d5a6d6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 23 Nov 2023 13:48:05 +0000 Subject: Remove testgetencpath/testsetencpath test commands: Testcase can use "encoding dirs" as well. (borrowed from bug-2a0966cdc9 branch, testcase only) --- generic/tclTest.c | 72 ----------------------------------------------------- tests/encoding.test | 13 ++++------ tests/unixInit.test | 3 --- 3 files changed, 5 insertions(+), 83 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index e9a0a40..02e1fac 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -321,8 +321,6 @@ static Tcl_ObjCmdProc TestFilesystemObjCmd; static Tcl_ObjCmdProc TestSimpleFilesystemObjCmd; static void TestReport(const char *cmd, Tcl_Obj *arg1, Tcl_Obj *arg2); -static Tcl_ObjCmdProc TestgetencpathObjCmd; -static Tcl_ObjCmdProc TestsetencpathObjCmd; static Tcl_Obj * TestReportGetNativePath(Tcl_Obj *pathPtr); static Tcl_FSStatProc TestReportStat; static Tcl_FSAccessProc TestReportAccess; @@ -749,10 +747,6 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd, - NULL, NULL); Tcl_CreateObjCommand(interp, "testapplylambda", TestApplyLambdaObjCmd, NULL, NULL); @@ -8417,72 +8411,6 @@ TestconcatobjCmd( /* *---------------------------------------------------------------------- * - * TestgetencpathObjCmd -- - * - * This function implements the "testgetencpath" command. It is used to - * test Tcl_GetEncodingSearchPath(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestgetencpathObjCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ -{ - if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, ""); - return TCL_ERROR; - } - - Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath()); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TestsetencpathCmd -- - * - * This function implements the "testsetencpath" command. It is used to - * test Tcl_SetDefaultEncodingDir(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestsetencpathObjCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ -{ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "defaultDir"); - return TCL_ERROR; - } - - Tcl_SetEncodingSearchPath(objv[1]); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * TestparseargsCmd -- * * This procedure implements the "testparseargs" command. It is used to diff --git a/tests/encoding.test b/tests/encoding.test index 76b5306..70aa99e 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -41,7 +41,6 @@ testConstraint testencoding [llength [info commands testencoding]] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint teststringbytes [llength [info commands teststringbytes]] testConstraint exec [llength [info commands exec]] -testConstraint testgetencpath [llength [info commands testgetencpath]] # TclInitEncodingSubsystem is tested by the rest of this file # TclFinalizeEncodingSubsystem is not currently tested @@ -1031,15 +1030,13 @@ foreach from {cp932 shiftjis euc-jp iso2022-jp} { } } -test encoding-26.0 {Tcl_GetEncodingSearchPath} -constraints { - testgetencpath -} -setup { - set origPath [testgetencpath] - testsetencpath slappy +test encoding-26.0 {Tcl_GetEncodingSearchPath} -setup { + set origPath [encoding dirs] + encoding dirs slappy } -body { - testgetencpath + encoding dirs } -cleanup { - testsetencpath $origPath + encoding dirs $origPath } -result slappy file delete {*}[glob -directory [temporaryDirectory] *.chars *.tcltestout] diff --git a/tests/unixInit.test b/tests/unixInit.test index 3a9fa6d..3bbe1e9 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -17,9 +17,6 @@ if {"::tcltest" ni [namespace children]} { unset -nocomplain path catch {set oldlang $env(LANG)} set env(LANG) C - -# Some tests require the testgetencpath command -testConstraint testgetencpath [llength [info commands testgetencpath]] test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} { set x {} -- cgit v0.12