diff options
39 files changed, 134 insertions, 63 deletions
diff --git a/doc/DString.3 b/doc/DString.3 index 00f1b8a..66323a7 100644 --- a/doc/DString.3 +++ b/doc/DString.3 @@ -41,6 +41,10 @@ char * \fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR) .sp \fBTcl_DStringGetResult\fR(\fIinterp, dsPtr\fR) +.sp +Tcl_Obj * +\fBTcl_DStringToObj\fR(\fIdsPtr\fR) +.sp .SH ARGUMENTS .AS Tcl_DString newLength in/out .AP Tcl_DString *dsPtr in/out @@ -142,12 +146,25 @@ a pointer from \fIdsPtr\fR to the interpreter's result. This saves the cost of allocating new memory and copying the string. \fBTcl_DStringResult\fR also reinitializes the dynamic string to an empty string. +Since the dynamic string is reinitialized, there is no need to +further call \fBTcl_DStringFree\fR on it and it can be reused without +calling \fBTcl_DStringInit\fR. .PP \fBTcl_DStringGetResult\fR does the opposite of \fBTcl_DStringResult\fR. It sets the value of \fIdsPtr\fR to the result of \fIinterp\fR and it clears \fIinterp\fR's result. If possible it does this by moving a pointer rather than by copying the string. +.PP +\fBTcl_DStringToObj\fR returns a \fBTcl_Obj\fR containing the value of +the dynamic string given by \fIdsPtr\fR. It does this by moving +a pointer from \fIdsPtr\fR to a newly allocated \fBTcl_Obj\fR +and reinitializing to dynamic string to an empty string. +This saves the cost of allocating new memory and copying the string. +Since the dynamic string is reinitialized, there is no need to +further call \fBTcl_DStringFree\fR on it and it can be reused without +calling \fBTcl_DStringInit\fR. +The returned \fBTcl_Obj\fR has a reference count of 0. .SH KEYWORDS append, dynamic string, free, result diff --git a/generic/tcl.decls b/generic/tcl.decls index 3f4103f..59d0ece 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2566,10 +2566,10 @@ declare 683 { # Tcl_WideUInt *uwidePtr) #} -# TIP 651 (reserved) -#declare 687 { -# Tcl_Obj *Tcl_DStringToObj(Tcl_DString *dsPtr) -#} +# TIP 651 +declare 687 { + Tcl_Obj *Tcl_DStringToObj(Tcl_DString *dsPtr) +} # ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- # diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 1e9832a..9905633 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -654,7 +654,7 @@ EncodingConvertfromObjCmd( * truncate the string at the first null byte. */ - Tcl_SetObjResult(interp, TclDStringToObj(&ds)); + Tcl_SetObjResult(interp, Tcl_DStringToObj(&ds)); /* * We're done with the encoding @@ -2060,7 +2060,7 @@ PathNativeNameCmd( if (Tcl_TranslateFileName(interp, TclGetString(objv[1]), &ds) == NULL) { return TCL_ERROR; } - Tcl_SetObjResult(interp, TclDStringToObj(&ds)); + Tcl_SetObjResult(interp, Tcl_DStringToObj(&ds)); return TCL_OK; } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 0888ecf..3a57b2f 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -2040,6 +2040,11 @@ EXTERN int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 683 */ EXTERN int Tcl_GetEncodingNulLength(Tcl_Encoding encoding); +/* Slot 684 is reserved */ +/* Slot 685 is reserved */ +/* Slot 686 is reserved */ +/* 687 */ +EXTERN Tcl_Obj * Tcl_DStringToObj(Tcl_DString *dsPtr); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2759,6 +2764,10 @@ typedef struct TclStubs { int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, size_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */ int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */ int (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ + void (*reserved684)(void); + void (*reserved685)(void); + void (*reserved686)(void); + Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 687 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -4157,6 +4166,11 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_RemoveChannelMode) /* 682 */ #define Tcl_GetEncodingNulLength \ (tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */ +/* Slot 684 is reserved */ +/* Slot 685 is reserved */ +/* Slot 686 is reserved */ +#define Tcl_DStringToObj \ + (tclStubsPtr->tcl_DStringToObj) /* 687 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 3cdd52f..3ca1ab5 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -454,7 +454,7 @@ TclpGetNativePathType( if ((rootEnd != path) && (driveNameLengthPtr != NULL)) { *driveNameLengthPtr = rootEnd - path; if (driveNameRef != NULL) { - *driveNameRef = TclDStringToObj(&ds); + *driveNameRef = Tcl_DStringToObj(&ds); Tcl_IncrRefCount(*driveNameRef); } } @@ -734,7 +734,7 @@ SplitWinPath( */ if (p != path) { - Tcl_ListObjAppendElement(NULL, result, TclDStringToObj(&buf)); + Tcl_ListObjAppendElement(NULL, result, Tcl_DStringToObj(&buf)); } Tcl_DStringFree(&buf); @@ -1767,7 +1767,7 @@ TclGlob( if (head != Tcl_DStringValue(&buffer)) { Tcl_DStringAppend(&buffer, head, -1); } - pathPrefix = TclDStringToObj(&buffer); + pathPrefix = Tcl_DStringToObj(&buffer); Tcl_IncrRefCount(pathPrefix); globFlags |= TCL_GLOBMODE_DIR; if (c != '\0') { @@ -2427,7 +2427,7 @@ DoGlob( */ if (pathPtr == NULL) { - joinedPtr = TclDStringToObj(&append); + joinedPtr = Tcl_DStringToObj(&append); } else if (flags) { joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append), Tcl_DStringLength(&append)); diff --git a/generic/tclInt.h b/generic/tclInt.h index 2d29e1d..8c5d1da 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3128,7 +3128,6 @@ MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, Tcl_Obj *objPtr); MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); -MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr); MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp, Tcl_Obj *const *objv, int objc, int *objcPtr); MODULE_SCOPE Tcl_Obj *const *TclEnsembleGetRewriteValues(Tcl_Interp *interp); diff --git a/generic/tclMain.c b/generic/tclMain.c index 5083383..628deaa 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -55,7 +55,7 @@ NewNativeObj( #else Tcl_ExternalToUtfDString(NULL, (char *)string, -1, &ds); #endif - return TclDStringToObj(&ds); + return Tcl_DStringToObj(&ds); } /* diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 250ad6a..87aed3a 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -2295,7 +2295,7 @@ SetFsPathFromAny( Tcl_DStringFree(&userName); } - transPtr = TclDStringToObj(&temp); + transPtr = Tcl_DStringToObj(&temp); if (split != len) { /* @@ -2657,7 +2657,7 @@ TclGetHomeDirObj( if (MakeTildeRelativePath(interp, user, NULL, &dirString) != TCL_OK) { return NULL; } - return TclDStringToObj(&dirString); + return Tcl_DStringToObj(&dirString); } /* @@ -2729,7 +2729,7 @@ TclResolveTildePath( } Tcl_DStringFree(&userName); } - return TclDStringToObj(&resolvedPath); + return Tcl_DStringToObj(&resolvedPath); } /* diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index ff7c72c..bb4ffc9 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -959,7 +959,7 @@ CompileRegexp( if (TclReToGlob(NULL, string, length, &stringBuf, &exact, NULL) == TCL_OK) { - regexpPtr->globObjPtr = TclDStringToObj(&stringBuf); + regexpPtr->globObjPtr = Tcl_DStringToObj(&stringBuf); Tcl_IncrRefCount(regexpPtr->globObjPtr); } else { regexpPtr->globObjPtr = NULL; diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ad60fc3..b3eb0de 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -2055,6 +2055,10 @@ const TclStubs tclStubs = { Tcl_GetNumber, /* 681 */ Tcl_RemoveChannelMode, /* 682 */ Tcl_GetEncodingNulLength, /* 683 */ + 0, /* 684 */ + 0, /* 685 */ + 0, /* 686 */ + Tcl_DStringToObj, /* 687 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index 2ebbcc2..bc3b553 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -1936,6 +1936,11 @@ TestdstringCmd( goto wrongNumArgs; } Tcl_DStringResult(interp, &dstring); + } else if (strcmp(argv[1], "toobj") == 0) { + if (argc != 2) { + goto wrongNumArgs; + } + Tcl_SetObjResult(interp, Tcl_DStringToObj(&dstring)); } else if (strcmp(argv[1], "trunc") == 0) { if (argc != 3) { goto wrongNumArgs; @@ -1951,8 +1956,8 @@ TestdstringCmd( Tcl_DStringStartSublist(&dstring); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be append, element, end, free, get, length, " - "result, trunc, or start", NULL); + "\": must be append, element, end, free, get, gresult, length, " + "result, start, toobj, or trunc", NULL); return TCL_ERROR; } return TCL_OK; diff --git a/generic/tclUtil.c b/generic/tclUtil.c index ab97461..73f5cf2 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2973,7 +2973,7 @@ Tcl_DStringResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the * result of interp. */ { - Tcl_SetObjResult(interp, TclDStringToObj(dsPtr)); + Tcl_SetObjResult(interp, Tcl_DStringToObj(dsPtr)); } /* @@ -3087,7 +3087,7 @@ Tcl_DStringGetResult( /* *---------------------------------------------------------------------- * - * TclDStringToObj -- + * Tcl_DStringToObj -- * * This function moves a dynamic string's contents to a new Tcl_Obj. Be * aware that this function does *not* check that the encoding of the @@ -3107,7 +3107,7 @@ Tcl_DStringGetResult( */ Tcl_Obj * -TclDStringToObj( +Tcl_DStringToObj( Tcl_DString *dsPtr) { Tcl_Obj *result; diff --git a/generic/tclZlib.c b/generic/tclZlib.c index f6d7660..61dc0ee 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -548,7 +548,7 @@ ExtractHeader( Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1, &tmp); - SetValue(dictObj, "comment", TclDStringToObj(&tmp)); + SetValue(dictObj, "comment", Tcl_DStringToObj(&tmp)); } SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc)); if (headerPtr->name != Z_NULL) { @@ -565,7 +565,7 @@ ExtractHeader( Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, -1, &tmp); - SetValue(dictObj, "filename", TclDStringToObj(&tmp)); + SetValue(dictObj, "filename", Tcl_DStringToObj(&tmp)); } if (headerPtr->os != 255) { SetValue(dictObj, "os", Tcl_NewWideIntObj(headerPtr->os)); diff --git a/tests/chanio.test b/tests/chanio.test index 4193f54..787d926 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -39,6 +39,7 @@ namespace eval ::tcl::test::io { package require -exact tcl::test [info patchlevel] set ::tcltestlib [info loaded {} Tcltest] } + source [file join [file dirname [info script]] tcltests.tcl] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] diff --git a/tests/dstring.test b/tests/dstring.test index 11c5754..314cee8 100644 --- a/tests/dstring.test +++ b/tests/dstring.test @@ -473,6 +473,45 @@ test dstring-6.5 {Tcl_DStringGetResult} -constraints testdstring -body { } -cleanup { testdstring free } -result {{} {This is a specially-allocated stringz}} + +test dstring-7.1 {copying to Tcl_Obj} -constraints testdstring -setup { + testdstring free +} -body { + testdstring append xyz -1 + list [testdstring toobj] [testdstring length] +} -cleanup { + testdstring free +} -result {xyz 0} +test dstring-7.2 {copying to a Tcl_Obj} -constraints testdstring -setup { + testdstring free + unset -nocomplain a +} -body { + foreach l {a b c d e f g h i j k l m n o p} { + testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1 + } + set a [testdstring toobj] + testdstring append abc -1 + list $a [testdstring get] +} -cleanup { + testdstring free +} -result {{aaaaaaaaaaaaaaaaaaaaa +bbbbbbbbbbbbbbbbbbbbb +ccccccccccccccccccccc +ddddddddddddddddddddd +eeeeeeeeeeeeeeeeeeeee +fffffffffffffffffffff +ggggggggggggggggggggg +hhhhhhhhhhhhhhhhhhhhh +iiiiiiiiiiiiiiiiiiiii +jjjjjjjjjjjjjjjjjjjjj +kkkkkkkkkkkkkkkkkkkkk +lllllllllllllllllllll +mmmmmmmmmmmmmmmmmmmmm +nnnnnnnnnnnnnnnnnnnnn +ooooooooooooooooooooo +ppppppppppppppppppppp +} abc} + # cleanup if {[testConstraint testdstring]} { diff --git a/tests/encoding.test b/tests/encoding.test index 8e529af..d234e0c 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -22,7 +22,7 @@ catch { package require -exact tcl::test [info patchlevel] } -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] proc toutf {args} { variable x diff --git a/tests/env.test b/tests/env.test index 4fb4a86..ce7c01e 100644 --- a/tests/env.test +++ b/tests/env.test @@ -16,6 +16,8 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } +source [file join [file dirname [info script]] tcltests.tcl] + # [exec] is required here to see the actual environment received by child # processes. proc getenv {} { diff --git a/tests/exec.test b/tests/exec.test index f8bfbde..d1ef418 100644 --- a/tests/exec.test +++ b/tests/exec.test @@ -18,10 +18,8 @@ if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } +source [file join [file dirname [info script]] tcltests.tcl] -# All tests require the "exec" command. -# Skip them if exec is not defined. -testConstraint exec [llength [info commands exec]] # Some skips when running in a macOS CI environment testConstraint noosxCI [expr {![info exists ::env(MAC_CI)]}] diff --git a/tests/fileSystemEncoding.test b/tests/fileSystemEncoding.test index c9d36d2..f47635d 100644 --- a/tests/fileSystemEncoding.test +++ b/tests/fileSystemEncoding.test @@ -15,20 +15,7 @@ namespace eval ::tcl::test::fileSystemEncoding { variable fname1 登鸛鵲樓 - proc autopath {} { - global auto_path - set scriptpath [info script] - set scriptpathnorm [file dirname [file normalize $scriptpath/...]] - set dirnorm [file dirname $scriptpathnorm] - set idx [lsearch -exact $auto_path $dirnorm] - if {$idx >= 0} { - set auto_path [lreplace $auto_path[set auto_path {}] $idx $idx {}] - } - set auto_path [linsert $auto_path[set auto_path {}] 0 0 $dirnorm] - } - autopath - - package require tcltests + source [file join [file dirname [info script]] tcltests.tcl] test filesystemEncoding-1.0 { issue bcd100410465 diff --git a/tests/http.test b/tests/http.test index 08195a6..587e6e4 100644 --- a/tests/http.test +++ b/tests/http.test @@ -15,7 +15,7 @@ if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] package require http 2.10 diff --git a/tests/info.test b/tests/info.test index c17588f..ef41bdf 100644 --- a/tests/info.test +++ b/tests/info.test @@ -20,7 +20,7 @@ if {{::tcltest} ni [namespace children]} { namespace import -force ::tcltest::* } ::tcltest::loadTestedCommands -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] catch [list package require -exact tcl::test [info patchlevel]] testConstraint zlib [llength [info commands zlib]] # Set up namespaces needed to test operation of "info args", "info body", diff --git a/tests/io.test b/tests/io.test index 21a2bf8..9ae25bb 100644 --- a/tests/io.test +++ b/tests/io.test @@ -34,6 +34,7 @@ namespace eval ::tcl::test::io { package require -exact tcl::test [info patchlevel] set ::tcltestlib [info loaded {} Tcltest] } + source [file join [file dirname [info script]] tcltests.tcl] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] diff --git a/tests/ioCmd.test b/tests/ioCmd.test index e4584ba..c4edd25 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -17,6 +17,7 @@ if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } +source [file join [file dirname [info script]] tcltests.tcl] ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] diff --git a/tests/obj.test b/tests/obj.test index 7563422..64a1d5b 100644 --- a/tests/obj.test +++ b/tests/obj.test @@ -19,7 +19,7 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] testConstraint testobj [llength [info commands testobj]] testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}] diff --git a/tests/platform.test b/tests/platform.test index b5fd405..33aea3a 100644 --- a/tests/platform.test +++ b/tests/platform.test @@ -10,6 +10,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest 2.5 +source [file join [file dirname [info script]] tcltests.tcl] namespace eval ::tcl::test::platform { namespace import ::tcltest::testConstraint @@ -22,7 +23,6 @@ namespace eval ::tcl::test::platform { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests testConstraint testCPUID [llength [info commands testcpuid]] testConstraint testlongsize [llength [info commands testlongsize]] diff --git a/tests/regexp.test b/tests/regexp.test index f0f05a0..16c775e 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} { } unset -nocomplain foo -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] testConstraint exec [llength [info commands exec]] # Used for constraining memory leak tests diff --git a/tests/regexpComp.test b/tests/regexpComp.test index a556b7a..42f1b3b 100644 --- a/tests/regexpComp.test +++ b/tests/regexpComp.test @@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} { namespace import -force ::tcltest::* } -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] # Procedure to evaluate a script within a proc, to test compilation # functionality diff --git a/tests/string.test b/tests/string.test index ba5be14..6623f04 100644 --- a/tests/string.test +++ b/tests/string.test @@ -19,7 +19,8 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] + # Helper commands to test various optimizations, code paths, and special cases. proc makeByteArray {s} {binary format a* $s} diff --git a/tests/stringObj.test b/tests/stringObj.test index 0c65cdc..2fd4369 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -19,7 +19,7 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] testConstraint testobj [llength [info commands testobj]] testConstraint testbytestring [llength [info commands testbytestring]] diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl index cc0d6a7..a2251bf 100644 --- a/tests/tcltests.tcl +++ b/tests/tcltests.tcl @@ -1,5 +1,8 @@ #! /usr/bin/env tclsh +# Don't overwrite tcltests facilities already present +if {[package provide tcltests] ne {}} return + package require tcltest 2.5 namespace import ::tcltest::* testConstraint exec [llength [info commands exec]] diff --git a/tests/thread.test b/tests/thread.test index 22c1a4f..636d7a8 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -20,11 +20,10 @@ if {"::tcltest" ni [namespace children]} { # be fully finalized, which avoids valgrind "still reachable" reports. package require tcltest 2.5 -namespace import ::tcltest::* +source [file join [file dirname [info script]] tcltests.tcl] ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests # Some tests require the testthread command diff --git a/tests/utf.test b/tests/utf.test index 60596f7..5a6bbd4 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} { ::tcltest::loadTestedCommands catch [list package require -exact tcl::test [info patchlevel]] -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] testConstraint ucs2 [expr {[format %c 0x010000] eq "\uFFFD"}] testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}] diff --git a/tests/winDde.test b/tests/winDde.test index ad21426..c56d27d 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -13,7 +13,7 @@ if {"::tcltest" ni [namespace children]} { package require tcltest 2.5 namespace import -force ::tcltest::* } -package require tcltests +source [file join [file dirname [info script]] tcltests.tcl] testConstraint dde 0 if {[testConstraint win]} { diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 818209d..ed6a6e0 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -1422,7 +1422,7 @@ GetOwnerAttribute( Tcl_DString ds; (void) Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, TCL_INDEX_NONE, &ds); - *attributePtrPtr = TclDStringToObj(&ds); + *attributePtrPtr = Tcl_DStringToObj(&ds); } return TCL_OK; } @@ -2339,7 +2339,7 @@ TclpCreateTemporaryDirectory( Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&templ), Tcl_DStringLength(&templ), &tmp); Tcl_DStringFree(&templ); - return TclDStringToObj(&tmp); + return Tcl_DStringToObj(&tmp); } #if defined(__CYGWIN__) diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index d1b656b..99f8046 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -997,7 +997,7 @@ TclpObjLink( } Tcl_ExternalToUtfDString(NULL, link, length, &ds); - linkPtr = TclDStringToObj(&ds); + linkPtr = Tcl_DStringToObj(&ds); Tcl_IncrRefCount(linkPtr); return linkPtr; } @@ -1062,7 +1062,7 @@ TclpNativeToNormalized( Tcl_DString ds; Tcl_ExternalToUtfDString(NULL, (const char *) clientData, TCL_INDEX_NONE, &ds); - return TclDStringToObj(&ds); + return Tcl_DStringToObj(&ds); } /* diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 21910e1..1252043 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -510,7 +510,7 @@ TclpInitLibraryPath( pathv[pathc - 1] = installLib + 4; str = Tcl_JoinPath(pathc, pathv, &ds); - Tcl_ListObjAppendElement(NULL, pathPtr, TclDStringToObj(&ds)); + Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_DStringToObj(&ds)); } ckfree(pathv); } diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 2ca041b..656db04 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1002,7 +1002,7 @@ TclpObjRemoveDirectory( !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) { *errorPtr = pathPtr; } else { - *errorPtr = TclDStringToObj(&ds); + *errorPtr = Tcl_DStringToObj(&ds); } Tcl_IncrRefCount(*errorPtr); } @@ -1725,7 +1725,7 @@ ConvertFileNameFormat( Tcl_DStringLength(&dsTemp)); Tcl_DStringFree(&dsTemp); } else { - tempPath = TclDStringToObj(&dsTemp); + tempPath = Tcl_DStringToObj(&dsTemp); } Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath); FindClose(handle); @@ -2080,7 +2080,7 @@ TclpCreateTemporaryDirectory( Tcl_DStringInit(&name); Tcl_WCharToUtfDString((LPCWSTR) Tcl_DStringValue(&base), TCL_INDEX_NONE, &name); Tcl_DStringFree(&base); - return TclDStringToObj(&name); + return Tcl_DStringToObj(&name); } /* diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 56ef8cb..16c1d59 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -2502,7 +2502,7 @@ TclpFilesystemPathType( Tcl_DStringInit(&ds); Tcl_WCharToUtfDString(volType, TCL_INDEX_NONE, &ds); - return TclDStringToObj(&ds); + return Tcl_DStringToObj(&ds); } #undef VOL_BUF_SIZE } diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 8fa176b..77ee107 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -255,7 +255,7 @@ AppendEnvironment( pathv[pathc - 1] = shortlib; Tcl_DStringInit(&ds); (void) Tcl_JoinPath(pathc, pathv, &ds); - objPtr = TclDStringToObj(&ds); + objPtr = Tcl_DStringToObj(&ds); } else { objPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE); } |