From 70cf69246f83c91f78fd4de65ac48fa39aa634d4 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Wed, 15 Mar 2023 20:13:22 +0000 Subject: New script used in the "valgrind_each" target in Makefile.in --- tools/valgrind_check_success | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100644 tools/valgrind_check_success diff --git a/tools/valgrind_check_success b/tools/valgrind_check_success new file mode 100644 index 0000000..24830d5 --- /dev/null +++ b/tools/valgrind_check_success @@ -0,0 +1,30 @@ +#! /usr/bin/env tclsh + + +proc main {sourcetype source} { + switch $sourcetype { + file { + set chan [open $source] + try { + set data [read $chan] + } finally { + close $chan + } + } + string { + set data $source + } + default { + error [list {wrong # args}] + } + } + set found [regexp -inline -all {blocks are\ + (?:(?:(?:definitely|indirectly|possibly) lost)|still reachable)} $data] + if {[llength $found]} { + puts 0 + } else { + puts 1 + } + flush stdout +} +main {*}$argv -- cgit v0.12 From 5846b1666f9fda4d12d9cc46f8bd2050b1ed4ef4 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Thu, 16 Mar 2023 08:15:03 +0000 Subject: Make valgrind_foreach target in Makefile.in properly handle interrupted tests. --- unix/Makefile.in | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index da057d8..e092a2d 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -956,7 +956,8 @@ testresults/valgrind/%.result: ${TCL_EXE} ${TCLTEST_EXE} @mkdir -p testresults/valgrind $(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} \ $(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind \ - -file $(basename $(notdir $@)) > $@ 2>&1 + -file $(basename $(notdir $@)) > $@.tmp 2>&1 + @mv $@.tmp $@ .PRECIOUS: testresults/valgrind/%.result @@ -966,7 +967,7 @@ testresults/valgrind/%.success: testresults/valgrind/%.result @printf '\n >&2' @status=$$(./${TCLTEST_EXE} $(TOP_DIR)/tools/valgrind_check_success \ file $(basename $@).result); \ - if [ "$$status" -eq 1 ]; then exit 0; else exit 1; fi + if [ "$$status" -eq 1 ]; then touch $@; exit 0; else exit 1; fi valgrind_each: $(addprefix testresults/valgrind/,$(addsuffix .success,$(notdir\ $(wildcard $(TOP_DIR)/tests/*.test)))) -- cgit v0.12 From e019e5bd1d3ddb51539ca9e4872e6c9d310dd390 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 16 Mar 2023 11:29:14 +0000 Subject: Fix (minor) warning on 32-bit platforms --- generic/tclTest.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 668a05a..15eaa56 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -2119,7 +2119,7 @@ static int UtfExtWrapper( /* Assumes state is integer if not "" */ Tcl_WideInt wide; if (Tcl_GetWideIntFromObj(interp, objv[5], &wide) == TCL_OK) { - encState = (Tcl_EncodingState) wide; + encState = (Tcl_EncodingState)(size_t)wide; encStatePtr = &encState; } else if (Tcl_GetCharLength(objv[5]) == 0) { encStatePtr = NULL; @@ -2209,7 +2209,7 @@ static int UtfExtWrapper( } result = TCL_OK; resultObjs[1] = - encStatePtr ? Tcl_NewWideIntObj((Tcl_WideInt)encState) : Tcl_NewObj(); + encStatePtr ? Tcl_NewWideIntObj((Tcl_WideInt)(size_t)encState) : Tcl_NewObj(); resultObjs[2] = Tcl_NewByteArrayObj(bufPtr, dstLen); if (srcReadVar) { if (Tcl_ObjSetVar2(interp, -- cgit v0.12 From 1a6f1d5c40570e83189a91e4301d9e89369ce00e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 16 Mar 2023 15:12:17 +0000 Subject: Add some undocumented stub functions. Those can prevent a crash like [http://paste.tclers.tk/5763|this] example, when compiled with 8.7 headers but running it in Tcl 8.6. --- generic/tcl.decls | 16 +++++++++++++-- generic/tclDecls.h | 30 +++++++++++++++++++--------- generic/tclPlatDecls.h | 19 ++++++++++-------- generic/tclStubInit.c | 54 +++++++++++++++++++++++++++++++++++++++++++++----- 4 files changed, 95 insertions(+), 24 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index d20a945..7f734c6 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2326,6 +2326,18 @@ declare 630 { # ----- BASELINE -- FOR -- 8.6.0 ----- # +# TIP #481 (undocumented stub entries) +declare 651 { + char *TclGetStringFromObj_(Tcl_Obj *objPtr, size_t *lengthPtr) +} +declare 652 { + unsigned short *TclGetUnicodeFromObj_(Tcl_Obj *objPtr, size_t *lengthPtr) +} +# Only available in Tcl 8.x, NULL in Tcl 9.0 +declare 653 { + unsigned char *TclGetByteArrayFromObj_(Tcl_Obj *objPtr, size_t *numBytesPtr) +} + declare 687 { void TclUnusedStubEntry(void) } @@ -2355,7 +2367,7 @@ declare 1 win { char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr) } declare 3 win { - void TclUnusedStubEntry(void) + void TclWinConvertError_(unsigned errCode) } ################################ @@ -2372,7 +2384,7 @@ declare 1 macosx { int hasResourceFile, int maxPathLen, char *libraryPath) } declare 2 macosx { - void TclUnusedStubEntry(void) + void TclMacOSXNotifierAddRunLoopMode_(const void *runLoopMode) } ############################################################################## diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 6c109de..551a5b6 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1835,9 +1835,15 @@ EXTERN void Tcl_ZlibStreamSetCompressionDictionary( /* Slot 648 is reserved */ /* Slot 649 is reserved */ /* Slot 650 is reserved */ -/* Slot 651 is reserved */ -/* Slot 652 is reserved */ -/* Slot 653 is reserved */ +/* 651 */ +EXTERN char * TclGetStringFromObj_(Tcl_Obj *objPtr, + size_t *lengthPtr); +/* 652 */ +EXTERN unsigned short * TclGetUnicodeFromObj_(Tcl_Obj *objPtr, + size_t *lengthPtr); +/* 653 */ +EXTERN unsigned char * TclGetByteArrayFromObj_(Tcl_Obj *objPtr, + size_t *numBytesPtr); /* Slot 654 is reserved */ /* Slot 655 is reserved */ /* Slot 656 is reserved */ @@ -2559,9 +2565,9 @@ typedef struct TclStubs { void (*reserved648)(void); void (*reserved649)(void); void (*reserved650)(void); - void (*reserved651)(void); - void (*reserved652)(void); - void (*reserved653)(void); + char * (*tclGetStringFromObj_) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 651 */ + unsigned short * (*tclGetUnicodeFromObj_) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */ + unsigned char * (*tclGetByteArrayFromObj_) (Tcl_Obj *objPtr, size_t *numBytesPtr); /* 653 */ void (*reserved654)(void); void (*reserved655)(void); void (*reserved656)(void); @@ -3908,9 +3914,12 @@ extern const TclStubs *tclStubsPtr; /* Slot 648 is reserved */ /* Slot 649 is reserved */ /* Slot 650 is reserved */ -/* Slot 651 is reserved */ -/* Slot 652 is reserved */ -/* Slot 653 is reserved */ +#define TclGetStringFromObj_ \ + (tclStubsPtr->tclGetStringFromObj_) /* 651 */ +#define TclGetUnicodeFromObj_ \ + (tclStubsPtr->tclGetUnicodeFromObj_) /* 652 */ +#define TclGetByteArrayFromObj_ \ + (tclStubsPtr->tclGetByteArrayFromObj_) /* 653 */ /* Slot 654 is reserved */ /* Slot 655 is reserved */ /* Slot 656 is reserved */ @@ -3984,6 +3993,9 @@ extern const TclStubs *tclStubsPtr; #undef Tcl_SeekOld #undef Tcl_TellOld +#undef TclGetStringFromObj_ +#undef TclGetUnicodeFromObj_ +#undef TclGetByteArrayFromObj_ #undef Tcl_PkgPresent #define Tcl_PkgPresent(interp, name, version, exact) \ diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index cb420fd..46181a1 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -59,7 +59,7 @@ EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr); /* Slot 2 is reserved */ /* 3 */ -EXTERN void TclUnusedStubEntry(void); +EXTERN void TclWinConvertError_(unsigned errCode); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ @@ -73,7 +73,8 @@ EXTERN int Tcl_MacOSXOpenVersionedBundleResources( int hasResourceFile, int maxPathLen, char *libraryPath); /* 2 */ -EXTERN void TclUnusedStubEntry(void); +EXTERN void TclMacOSXNotifierAddRunLoopMode_( + const void *runLoopMode); #endif /* MACOSX */ typedef struct TclPlatStubs { @@ -84,12 +85,12 @@ typedef struct TclPlatStubs { TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */ char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */ void (*reserved2)(void); - void (*tclUnusedStubEntry) (void); /* 3 */ + void (*tclWinConvertError_) (unsigned errCode); /* 3 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */ int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */ - void (*tclUnusedStubEntry) (void); /* 2 */ + void (*tclMacOSXNotifierAddRunLoopMode_) (const void *runLoopMode); /* 2 */ #endif /* MACOSX */ } TclPlatStubs; @@ -111,16 +112,16 @@ extern const TclPlatStubs *tclPlatStubsPtr; #define Tcl_WinTCharToUtf \ (tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */ /* Slot 2 is reserved */ -#define TclUnusedStubEntry \ - (tclPlatStubsPtr->tclUnusedStubEntry) /* 3 */ +#define TclWinConvertError_ \ + (tclPlatStubsPtr->tclWinConvertError_) /* 3 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ #define Tcl_MacOSXOpenBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */ #define Tcl_MacOSXOpenVersionedBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ -#define TclUnusedStubEntry \ - (tclPlatStubsPtr->tclUnusedStubEntry) /* 2 */ +#define TclMacOSXNotifierAddRunLoopMode_ \ + (tclPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode_) /* 2 */ #endif /* MACOSX */ #endif /* defined(USE_TCL_STUBS) */ @@ -128,6 +129,8 @@ extern const TclPlatStubs *tclPlatStubsPtr; /* !END!: Do not edit above this line. */ #undef TclUnusedStubEntry +#undef TclMacOSXNotifierAddRunLoopMode_ +#undef TclWinConvertError_ #ifdef MAC_OSX_TCL /* MACOSX */ #undef Tcl_MacOSXOpenBundleResources #define Tcl_MacOSXOpenBundleResources(a,b,c,d,e) Tcl_MacOSXOpenVersionedBundleResources(a,b,NULL,c,d,e) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ee0412a..565dd8c 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -59,6 +59,7 @@ #define TclBN_mp_tc_or TclBN_mp_or #define TclBN_mp_tc_xor TclBN_mp_xor #define TclStaticPackage Tcl_StaticPackage +#define TclMacOSXNotifierAddRunLoopMode_ TclMacOSXNotifierAddRunLoopMode #define TclUnusedStubEntry 0 /* See bug 510001: TclSockMinimumBuffers needs plat imp */ @@ -138,12 +139,55 @@ static const char *TclGetStartupScriptFileName(void) return Tcl_GetString(path); } +#define TclGetStringFromObj_ getStringFromObj +static char * +TclGetStringFromObj_( + Tcl_Obj *objPtr, + size_t *lengthPtr) +{ + int length; + char *result = Tcl_GetStringFromObj(objPtr, &length); + *lengthPtr = (size_t)length; + return result; +} + +#define TclGetUnicodeFromObj_ getUnicodeFromObj +static unsigned short * +TclGetUnicodeFromObj_( + Tcl_Obj *objPtr, + size_t *lengthPtr) +{ + int length; + Tcl_UniChar *result = Tcl_GetUnicodeFromObj(objPtr, &length); + *lengthPtr = (size_t)length; + return result; +} + +#define TclGetByteArrayFromObj_ getByteArrayFromObj +static unsigned char * +TclGetByteArrayFromObj_( + Tcl_Obj *objPtr, + size_t *numBytesPtr) +{ + int numBytes; + unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &numBytes); + *numBytesPtr = (size_t)numBytes; + return result; +} + + #if defined(_WIN32) || defined(__CYGWIN__) #undef TclWinNToHS #define TclWinNToHS winNToHS static unsigned short TclWinNToHS(unsigned short ns) { return ntohs(ns); } +#define TclWinConvertError_ winConvertError +static void +TclWinConvertError_(unsigned errCode) { + return TclWinConvertError(errCode); +} + #endif #define TclpCreateTempFile_ TclpCreateTempFile @@ -865,12 +909,12 @@ static const TclPlatStubs tclPlatStubs = { Tcl_WinUtfToTChar, /* 0 */ Tcl_WinTCharToUtf, /* 1 */ 0, /* 2 */ - TclUnusedStubEntry, /* 3 */ + TclWinConvertError_, /* 3 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ Tcl_MacOSXOpenBundleResources, /* 0 */ Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ - TclUnusedStubEntry, /* 2 */ + TclMacOSXNotifierAddRunLoopMode_, /* 2 */ #endif /* MACOSX */ }; @@ -1644,9 +1688,9 @@ const TclStubs tclStubs = { 0, /* 648 */ 0, /* 649 */ 0, /* 650 */ - 0, /* 651 */ - 0, /* 652 */ - 0, /* 653 */ + TclGetStringFromObj_, /* 651 */ + TclGetUnicodeFromObj_, /* 652 */ + TclGetByteArrayFromObj_, /* 653 */ 0, /* 654 */ 0, /* 655 */ 0, /* 656 */ -- cgit v0.12