From 107d130ce3db87a24b5136c006f32136b60d079c Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sun, 20 Sep 2020 10:38:41 +0000 Subject: Make the check to avoid generating a string representation in [uplevel] a little less intrusive. --- generic/tclInt.h | 3 +++ generic/tclProc.c | 30 ++++++++++++++---------------- 2 files changed, 17 insertions(+), 16 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 46ba764..9629709 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4376,6 +4376,9 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, objPtr->bytes = NULL; \ } +#define TclHasStringRep(objPtr) \ + objPtr->bytes != NULL + /* *---------------------------------------------------------------- * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same diff --git a/generic/tclProc.c b/generic/tclProc.c index 0313b29..56757ff 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -898,7 +898,6 @@ TclNRUplevelObjCmd( Interp *iPtr = (Interp *) interp; CmdFrame *invoker = NULL; int word = 0; - int havelevel = 0; int result; CallFrame *savedVarFramePtr, *framePtr; Tcl_Obj *objPtr; @@ -912,7 +911,7 @@ TclNRUplevelObjCmd( uplevelSyntax: Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?"); return TCL_ERROR; - } else if (objc == 2) { + } else if (!TclHasStringRep(objv[1]) && objc == 2) { int status ,llength; status = Tcl_ListObjLength(interp, objv[1], &llength); if (status == TCL_OK && llength > 1) { @@ -922,28 +921,27 @@ TclNRUplevelObjCmd( if (result == -1) { return TCL_ERROR; } - havelevel = 1; objc -= 1; objv += 1; + goto havelevel; } } - if (!havelevel) { - /* - * Find the level to use for executing the command. - */ + /* + * Find the level to use for executing the command. + */ - result = TclObjGetFrame(interp, objv[1], &framePtr); - if (result == -1) { - return TCL_ERROR; - } - objc -= result + 1; - if (objc == 0) { - goto uplevelSyntax; - } - objv += result + 1; + result = TclObjGetFrame(interp, objv[1], &framePtr); + if (result == -1) { + return TCL_ERROR; + } + objc -= result + 1; + if (objc == 0) { + goto uplevelSyntax; } + objv += result + 1; + havelevel: /* * Modify the interpreter state to execute in the given frame. -- cgit v0.12 From 7a56ff406f3244d777f60d9a5e0da1e5e08f3ef9 Mon Sep 17 00:00:00 2001 From: dgp Date: Sun, 20 Sep 2020 15:53:37 +0000 Subject: Silence compiler warning -- fix safety of macro. --- generic/tclInt.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 9629709..3dbffeb 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4377,7 +4377,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, } #define TclHasStringRep(objPtr) \ - objPtr->bytes != NULL + (objPtr->bytes != NULL) /* *---------------------------------------------------------------- -- cgit v0.12 From 9e43cbb9739ecfd05d38ff31a49050a0eb04505b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 20 Sep 2020 21:32:35 +0000 Subject: Improve TclInvalidateStringRep() macro such that (objPtr) is only evaluated once. Addation brackets in TclHasStringRep() macro --- generic/tcl.h | 2 +- generic/tclInt.h | 15 +++++++++------ 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 458072a..914f62b 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2517,7 +2517,7 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); # define Tcl_DecrRefCount(objPtr) \ do { \ Tcl_Obj *_objPtr = (objPtr); \ - if ((_objPtr)->refCount-- <= 1) { \ + if (_objPtr->refCount-- <= 1) { \ TclFreeObj(_objPtr); \ } \ } while(0) diff --git a/generic/tclInt.h b/generic/tclInt.h index 3dbffeb..f2f097c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4369,15 +4369,18 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclInvalidateStringRep(objPtr) \ - if (objPtr->bytes != NULL) { \ - if (objPtr->bytes != tclEmptyStringRep) { \ - ckfree((char *) objPtr->bytes); \ + do { \ + Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \ + if (_isobjPtr->bytes != NULL) { \ + if (_isobjPtr->bytes != tclEmptyStringRep) { \ + ckfree((char *)_isobjPtr->bytes); \ + } \ + _isobjPtr->bytes = NULL; \ } \ - objPtr->bytes = NULL; \ - } + } while (0) #define TclHasStringRep(objPtr) \ - (objPtr->bytes != NULL) + ((objPtr)->bytes != NULL) /* *---------------------------------------------------------------- -- cgit v0.12 From a9ba2a08b562e5c0f60b9671df3b4a0c20a23879 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 22 Sep 2020 12:18:17 +0000 Subject: When writing script files (like pkgIndex.tcl), always use -translation lf, so they don't cause problems on non-windows. When reading script files, always use -eofchar \032, as this might be left by Windows editors. --- library/auto.tcl | 4 ++++ library/init.tcl | 1 + library/install.tcl | 3 +++ library/package.tcl | 1 + 4 files changed, 9 insertions(+) diff --git a/library/auto.tcl b/library/auto.tcl index 2deae05..32da97c 100644 --- a/library/auto.tcl +++ b/library/auto.tcl @@ -265,6 +265,7 @@ proc auto_mkindex {dir args} { auto_mkindex_parser::cleanup set fid [open "tclIndex" w] + fconfigure $fid -translation lf puts -nonewline $fid $index close $fid cd $oldDir @@ -291,6 +292,7 @@ proc auto_mkindex_old {dir args} { set f "" set error [catch { set f [open $file] + fconfigure $f -eofchar \032 while {[gets $f line] >= 0} { if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} { set procName [lindex [auto_qualify $procName "::"] 0] @@ -309,6 +311,7 @@ proc auto_mkindex_old {dir args} { set f "" set error [catch { set f [open tclIndex w] + fconfigure $f -translation lf puts -nonewline $f $index close $f cd $oldDir @@ -401,6 +404,7 @@ proc auto_mkindex_parser::mkindex {file} { set scriptFile $file set fid [open $file] + fconfigure $fid -eofchar \032 set contents [read $fid] close $fid diff --git a/library/init.tcl b/library/init.tcl index 94f65cf..16d5d67 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -442,6 +442,7 @@ proc auto_load_index {} { continue } else { set error [catch { + fconfigure $f -eofchar \032 set id [gets $f] if {$id eq "# Tcl autoload index file, version 2.0"} { eval [read $f] diff --git a/library/install.tcl b/library/install.tcl index 227d0b8..26e5e68 100644 --- a/library/install.tcl +++ b/library/install.tcl @@ -35,6 +35,7 @@ proc ::practcl::_pkgindex_directory {path} { # Read the file, and override assumptions as needed ### set fin [open $file r] + fconfigure $fin -eofchar \032 set dat [read $fin] close $fin # Look for a teapot style Package statement @@ -58,6 +59,7 @@ proc ::practcl::_pkgindex_directory {path} { foreach file [glob -nocomplain $path/*.tcl] { if { [file tail $file] == "version_info.tcl" } continue set fin [open $file r] + fconfigure $fin -eofchar \032 set dat [read $fin] close $fin if {![regexp "package provide" $dat]} continue @@ -77,6 +79,7 @@ proc ::practcl::_pkgindex_directory {path} { return $buffer } set fin [open $pkgidxfile r] + fconfigure $fin -eofchar \032 set dat [read $fin] close $fin set trace 0 diff --git a/library/package.tcl b/library/package.tcl index eebe91c..64fac7b 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -409,6 +409,7 @@ proc pkg_mkIndex {args} { } set f [open [file join $dir pkgIndex.tcl] w] + fconfigure $f -translation lf puts $f $index close $f } -- cgit v0.12