summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tcl.h2
-rw-r--r--generic/tclInt.h16
-rw-r--r--generic/tclProc.c32
-rw-r--r--library/auto.tcl4
-rw-r--r--library/init.tcl1
-rw-r--r--library/install.tcl3
-rw-r--r--library/package.tcl1
-rw-r--r--library/safe.tcl7
-rw-r--r--tests/uplevel.test2
9 files changed, 38 insertions, 30 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index c69ea9d..44f8246 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2281,7 +2281,7 @@ EXTERN int TclZipfs_AppHook(int *argc, char ***argv);
# 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 04a1866..2e88348 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4478,12 +4478,15 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*/
#define TclInvalidateStringRep(objPtr) \
- if ((objPtr)->bytes != NULL) { \
- if ((objPtr)->bytes != &tclEmptyString) { \
- Tcl_Free((objPtr)->bytes); \
+ do { \
+ Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \
+ if (_isobjPtr->bytes != NULL) { \
+ if (_isobjPtr->bytes != &tclEmptyString) { \
+ Tcl_Free((char *)_isobjPtr->bytes); \
+ } \
+ _isobjPtr->bytes = NULL; \
} \
- (objPtr)->bytes = NULL; \
- }
+ } while (0)
/*
* These form part of the native filesystem support. They are needed here
@@ -4510,7 +4513,8 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
*----------------------------------------------------------------
*/
-#define TclHasStringRep(objPtr) ((objPtr)->bytes != NULL)
+#define TclHasStringRep(objPtr) \
+ ((objPtr)->bytes != NULL)
/*
*----------------------------------------------------------------
diff --git a/generic/tclProc.c b/generic/tclProc.c
index a7d3f48..4c9694b 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -905,13 +905,12 @@ TclNRUplevelObjCmd(
Interp *iPtr = (Interp *) interp;
CmdFrame *invoker = NULL;
int word = 0;
- int havelevel = 0;
int result;
CallFrame *savedVarFramePtr, *framePtr;
Tcl_Obj *objPtr;
if (objc < 2) {
- /* to do
+ /* to do
* simplify things by interpreting the argument as a command when there
* is only one argument. This requires a TIP since currently a single
* argument is interpreted as a level indicator if possible.
@@ -919,7 +918,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) {
@@ -929,28 +928,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.
diff --git a/library/auto.tcl b/library/auto.tcl
index 2deae05..41ef1a0 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 -encoding utf-8 -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 -encoding utf-8 -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 -encoding utf-8 -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 -encoding utf-8 -eofchar \032
set contents [read $fid]
close $fid
diff --git a/library/init.tcl b/library/init.tcl
index 9775320..a13d3eb 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -442,6 +442,7 @@ proc auto_load_index {} {
continue
} else {
set error [catch {
+ fconfigure $f -encoding utf-8 -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..8d37d78 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 -encoding utf-8 -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 -encoding utf-8 -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 -encoding utf-8 -eofchar \032
set dat [read $fin]
close $fin
set trace 0
diff --git a/library/package.tcl b/library/package.tcl
index eebe91c..ac9a3dc 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 -encoding utf-8 -translation lf
puts $f $index
close $f
}
diff --git a/library/safe.tcl b/library/safe.tcl
index a9bb7f3..7eea772 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -937,7 +937,7 @@ proc ::safe::AliasSource {child args} {
}
} else {
set at 0
- set encoding {}
+ set encoding utf-8
}
if {$argc != 1} {
set msg "wrong # args: should be \"source ?-encoding E? fileName\""
@@ -980,10 +980,7 @@ proc ::safe::AliasSource {child args} {
set replacementMsg "script error"
set code [catch {
set f [open $realfile]
- fconfigure $f -eofchar \032
- if {$encoding ne ""} {
- fconfigure $f -encoding $encoding
- }
+ fconfigure $f -encoding $encoding -eofchar \032
set contents [read $f]
close $f
::interp eval $child [list info script $file]
diff --git a/tests/uplevel.test b/tests/uplevel.test
index 5dc2806..4ee6a34 100644
--- a/tests/uplevel.test
+++ b/tests/uplevel.test
@@ -309,7 +309,7 @@ test uplevel-7.3 {var access, LVT in upper level} -setup {
test uplevel-8.0 {
string representation isn't generated when there is only one argument
} -body {
- set res {}
+ set res {}
set script [list lindex 5]
lappend res [apply {script {
uplevel $script
generated by cgit v0.12 at 2025-12-09 23:18:35 (GMT)