From 37076881576fb0897e3c1c257ca37cd87685da0c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 14 Nov 2019 14:01:13 +0000 Subject: Better - more complete - fix for [d433c0e0ad]: TCL_UTF_MAX == 4 problems. It allows emoji to be produced by the system encoding, even for other values of TCL_UTF_MAX. Also added test-cases for this. --- generic/tclEncoding.c | 37 +++++++++++++++++++++++++------------ tests/encoding.test | 16 ++++++++++++++++ 2 files changed, 41 insertions(+), 12 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index f159b32..00b97f5 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2155,7 +2155,7 @@ BinaryProc( /* *------------------------------------------------------------------------- * - * UtfExtToUtfIntProc -- + * UtfIntToUtfExtProc -- * * Convert from UTF-8 to UTF-8. While converting null-bytes from the * Tcl's internal representation (0xc0, 0x80) to the official @@ -2296,7 +2296,7 @@ UtfToUtfProc( * output buffer. */ int pureNullMode) /* Convert embedded nulls from internal * representation to real null-bytes or vice - * versa. */ + * versa. Also combine or separate surrogate pairs */ { const char *srcStart, *srcEnd, *srcClose; const char *dstStart, *dstEnd; @@ -2312,14 +2312,14 @@ UtfToUtfProc( srcEnd = src + srcLen; srcClose = srcEnd; if ((flags & TCL_ENCODING_END) == 0) { - srcClose -= TCL_UTF_MAX; + srcClose -= 6; } if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } dstStart = dst; - dstEnd = dst + dstLen - TCL_UTF_MAX; + dstEnd = dst + dstLen - ((pureNullMode == 1) ? 4 : TCL_UTF_MAX); for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { @@ -2361,15 +2361,28 @@ UtfToUtfProc( src += 1; dst += Tcl_UniCharToUtf(*chPtr, dst); } else { - int len = TclUtfToUniChar(src, chPtr); - src += len; - dst += Tcl_UniCharToUtf(*chPtr, dst); -#if TCL_UTF_MAX == 4 - if ((*chPtr >= 0xD800) && (len < 3)) { - src += Tcl_UtfToUniChar(src, chPtr); - dst += Tcl_UniCharToUtf(*chPtr, dst); + src += TclUtfToUniChar(src, chPtr); + if ((*chPtr & 0xFC00) == 0xD800) { + /* A high surrogate character is detected, handle especially */ + Tcl_UniChar low = *chPtr; + size_t len = Tcl_UtfToUniChar(src, &low); + if ((low & 0xFC00) != 0xDC00) { + *dst++ = (char) (((*chPtr >> 12) | 0xE0) & 0xEF); + *dst++ = (char) (((*chPtr >> 6) | 0x80) & 0xBF); + *dst++ = (char) ((*chPtr | 0x80) & 0xBF); + continue; + } else if (pureNullMode == 1) { + int full = (((*chPtr & 0x3FF) << 10) | (low & 0x3FF)) + 0x10000; + *dst++ = (char) (((full >> 18) | 0xF0) & 0xF7); + *dst++ = (char) (((full >> 12) | 0x80) & 0xBF); + *dst++ = (char) (((full >> 6) | 0x80) & 0xBF); + *dst++ = (char) ((full | 0x80) & 0xBF); + *chPtr = 0; + src += len; + continue; + } } -#endif + dst += Tcl_UniCharToUtf(*chPtr, dst); } } diff --git a/tests/encoding.test b/tests/encoding.test index ed0e6a4..cf27190 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -328,6 +328,22 @@ test encoding-15.3 {UtfToUtfProc null character input} { binary scan [encoding convertto identity $y] H* z list [string bytelength $x] [string bytelength $y] $z } {1 2 c080} +test encoding-15.4 {UtfToUtfProc emoji character input} { + set x \xED\xA0\xBD\xED\xB8\x82 + set y [encoding convertfrom utf-8 \xED\xA0\xBD\xED\xB8\x82] + list [string length $x] [string length $y] $y +} "6 2 \uD83D\uDE02" +test encoding-15.5 {UtfToUtfProc emoji character input} { + set x \xF0\x9F\x98\x82 + set y [encoding convertfrom utf-8 \xF0\x9F\x98\x82] + list [string length $x] [string length $y] $y +} "4 2 \uD83D\uDE02" +test encoding-15.6 {UtfToUtfProc emoji character output} { + set x \uD83D\uDE02 + set y [encoding convertto utf-8 \uD83D\uDE02] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {2 4 f09f9882} test encoding-16.1 {UnicodeToUtfProc} { set val [encoding convertfrom unicode NN] -- cgit v0.12 From f00d9f9d02d293675899b1c0ce23aa5cb641cd92 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 14 Nov 2019 17:04:39 +0000 Subject: bug [135804138e]: test case illustrating the segfault --- tests/oo.test | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/tests/oo.test b/tests/oo.test index b0704da..55018e9 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -1353,6 +1353,35 @@ test oo-7.9 {OO: defining inheritance in namespaces} -setup { return } } -result {} +test oo-7.10 {OO: next after object deletion, bug [135804138e]} -setup { + set ::result "" + oo::class create c1 { + method m1 {} { + lappend ::result c1::m1 + } + } + oo::class create c2 { + superclass c1 + destructor { + lappend ::result c2::destructor + my m1 + lappend ::result /c2::destructor + } + method m1 {} { + lappend ::result delete + rename [self] {} + lappend ::result no-self + next + lappend ::result unreachable + } + } +} -body { + c2 create o + lappend ::result [catch {o m1} msg] $msg +} -cleanup { + c1 destroy + unset ::result +} -result {delete c2::destructor delete no-self c1::m1 unreachable /c2::destructor no-self 1 {no next method implementation}} test oo-8.1 {OO: global must work in methods} { oo::object create foo -- cgit v0.12 From b098fb32795b2f8e09c277d0d306986a6f5a9c7e Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 14 Nov 2019 17:06:06 +0000 Subject: fixed SF [135804138e] -- no call of next possible after object namespace is deleted --- generic/tclOOMethod.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 3e64ba2..fbd23c0 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -671,11 +671,11 @@ InvokeProcedureMethod( * call frame's lifetime). */ /* - * If the interpreter was deleted, we just skip to the next thing in the - * chain. + * If the object namespace (or interpreter) were deleted, we just skip to + * the next thing in the chain. */ - if (Tcl_InterpDeleted(interp)) { + if (!((CallContext *)context)->oPtr->namespacePtr) { return TclNRObjectContextInvokeNext(interp, context, objc, objv, Tcl_ObjectContextSkippedArgs(context)); } -- cgit v0.12 From 05b4cb2080209949f44fdf00e08a044584bffe73 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 14 Nov 2019 17:41:51 +0000 Subject: make oo-7.10 test more readable --- tests/oo.test | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/oo.test b/tests/oo.test index 55018e9..77fca68 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -1368,11 +1368,11 @@ test oo-7.10 {OO: next after object deletion, bug [135804138e]} -setup { lappend ::result /c2::destructor } method m1 {} { - lappend ::result delete + lappend ::result c2::m1 rename [self] {} lappend ::result no-self next - lappend ::result unreachable + lappend ::result /c2::m1 } } } -body { @@ -1381,7 +1381,7 @@ test oo-7.10 {OO: next after object deletion, bug [135804138e]} -setup { } -cleanup { c1 destroy unset ::result -} -result {delete c2::destructor delete no-self c1::m1 unreachable /c2::destructor no-self 1 {no next method implementation}} +} -result {c2::m1 c2::destructor c2::m1 no-self c1::m1 /c2::m1 /c2::destructor no-self 1 {no next method implementation}} test oo-8.1 {OO: global must work in methods} { oo::object create foo -- cgit v0.12 From 434361c3c66494a5fb28d24bdf591b9ac803673c Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 14 Nov 2019 19:22:46 +0000 Subject: restore verification for deleted interp --- generic/tclOOMethod.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index fbd23c0..0c5f4bb 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -675,7 +675,9 @@ InvokeProcedureMethod( * the next thing in the chain. */ - if (!((CallContext *)context)->oPtr->namespacePtr) { + if (!((CallContext *)context)->oPtr->namespacePtr || + Tcl_InterpDeleted(interp) + ) { return TclNRObjectContextInvokeNext(interp, context, objc, objv, Tcl_ObjectContextSkippedArgs(context)); } -- cgit v0.12 From bb1eeada78e64c97e89d7bddf99cb8dcfe845d8c Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 14 Nov 2019 19:57:12 +0000 Subject: remove unneeded constraint --- tests/io.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/io.test b/tests/io.test index 4257d51..04fa1d2 100644 --- a/tests/io.test +++ b/tests/io.test @@ -7347,7 +7347,7 @@ test io-53.3 {CopyData: background read underflow} {stdio unix openpipe fcopy} { close $f set result } "ready line1 line2 {done\n}" -test io-53.4 {CopyData: background write overflow} {stdio unix openpipe fileevent fcopy} { +test io-53.4 {CopyData: background write overflow} {stdio openpipe fileevent fcopy} { set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n variable x for {set x 0} {$x < 12} {incr x} { -- cgit v0.12 From e00ef49560bb5bd4349d017887c7cd5a2d0ba38e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 15 Nov 2019 09:41:03 +0000 Subject: Protect additional Tcl_UtfToUniChar() call, for the case when not enough bytes are available in the buffer any more. Add additional test-cases for those situations (upper surrogate followed by somthing other than lower surrogate) --- generic/tclEncoding.c | 2 +- tests/encoding.test | 24 +++++++++++++++++++++--- 2 files changed, 22 insertions(+), 4 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 00b97f5..9e1d262 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2365,7 +2365,7 @@ UtfToUtfProc( if ((*chPtr & 0xFC00) == 0xD800) { /* A high surrogate character is detected, handle especially */ Tcl_UniChar low = *chPtr; - size_t len = Tcl_UtfToUniChar(src, &low); + size_t len = (src <= srcEnd-3) ? Tcl_UtfToUniChar(src, &low) : 0; if ((low & 0xFC00) != 0xDC00) { *dst++ = (char) (((*chPtr >> 12) | 0xE0) & 0xEF); *dst++ = (char) (((*chPtr >> 6) | 0x80) & 0xBF); diff --git a/tests/encoding.test b/tests/encoding.test index cf27190..36fcff6 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -339,11 +339,29 @@ test encoding-15.5 {UtfToUtfProc emoji character input} { list [string length $x] [string length $y] $y } "4 2 \uD83D\uDE02" test encoding-15.6 {UtfToUtfProc emoji character output} { - set x \uD83D\uDE02 - set y [encoding convertto utf-8 \uD83D\uDE02] + set x \uDE02\uD83D\uDE02\uD83D + set y [encoding convertto utf-8 \uDE02\uD83D\uDE02\uD83D] binary scan $y H* z list [string length $x] [string length $y] $z -} {2 4 f09f9882} +} {4 10 edb882f09f9882eda0bd} +test encoding-15.7 {UtfToUtfProc emoji character output} { + set x \uDE02\uD83D\uD83D + set y [encoding convertto utf-8 \uDE02\uD83D\uD83D] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {3 9 edb882eda0bdeda0bd} +test encoding-15.8 {UtfToUtfProc emoji character output} { + set x \uDE02\uD83D\xE9 + set y [encoding convertto utf-8 \uDE02\uD83D\xE9] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {3 8 edb882eda0bdc3a9} +test encoding-15.9 {UtfToUtfProc emoji character output} { + set x \uDE02\uD83DX + set y [encoding convertto utf-8 \uDE02\uD83DX] + binary scan $y H* z + list [string length $x] [string length $y] $z +} {3 7 edb882eda0bd58} test encoding-16.1 {UnicodeToUtfProc} { set val [encoding convertfrom unicode NN] -- cgit v0.12 From b99314020d3b01f6b4616e7d1f36a9d120b0d7ec Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 15 Nov 2019 12:54:12 +0000 Subject: Remove mp_get_bit() from the libtommath stub table: It wasn't present in Tcl 8.6.9, isn't used anywhere in Tcl, and is going to be deprecated in libtommath. --- generic/tclStubInit.c | 2 +- generic/tclTomMath.decls | 3 --- generic/tclTomMathDecls.h | 10 +++------- unix/Makefile.in | 17 +++++++---------- win/Makefile.in | 1 - win/makefile.vc | 1 - 6 files changed, 11 insertions(+), 23 deletions(-) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 09c975d..631a417 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -925,7 +925,7 @@ const TclTomMathStubs tclTomMathStubs = { TclBN_mp_tc_or, /* 74 */ TclBN_mp_tc_xor, /* 75 */ TclBN_mp_signed_rsh, /* 76 */ - TclBN_mp_get_bit, /* 77 */ + 0, /* 77 */ TclBN_mp_to_ubin, /* 78 */ 0, /* 79 */ TclBN_mp_to_radix, /* 80 */ diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls index c5645a4..40b182f 100644 --- a/generic/tclTomMath.decls +++ b/generic/tclTomMath.decls @@ -254,9 +254,6 @@ declare 75 { declare 76 { mp_err TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c) } -declare 77 { - mp_bool TclBN_mp_get_bit(const mp_int *a, unsigned int b) -} # Added in libtommath 1.2.0 declare 78 { diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h index a1da2c9..3436798 100644 --- a/generic/tclTomMathDecls.h +++ b/generic/tclTomMathDecls.h @@ -72,7 +72,6 @@ #define mp_expt_d TclBN_mp_expt_d #define mp_expt_d_ex TclBN_mp_expt_d_ex #define mp_expt_u32 TclBN_mp_expt_d -#define mp_get_bit TclBN_mp_get_bit #define mp_grow TclBN_mp_grow #define mp_init TclBN_mp_init #define mp_init_copy TclBN_mp_init_copy @@ -119,7 +118,6 @@ #define mp_zero TclBN_mp_zero #define s_mp_add TclBN_s_mp_add #define s_mp_balance_mul TclBN_mp_balance_mul -#define s_mp_get_bit TclBN_mp_get_bit #define s_mp_karatsuba_mul TclBN_mp_karatsuba_mul #define s_mp_karatsuba_sqr TclBN_mp_karatsuba_sqr #define s_mp_mul_digs TclBN_s_mp_mul_digs @@ -341,8 +339,7 @@ EXTERN mp_err TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, /* 76 */ EXTERN mp_err TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c); -/* 77 */ -EXTERN mp_bool TclBN_mp_get_bit(const mp_int *a, unsigned int b); +/* Slot 77 is reserved */ /* 78 */ EXTERN int TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written); @@ -432,7 +429,7 @@ typedef struct TclTomMathStubs { mp_err (*tclBN_mp_tc_or) (const mp_int *a, const mp_int *b, mp_int *c); /* 74 */ mp_err (*tclBN_mp_tc_xor) (const mp_int *a, const mp_int *b, mp_int *c); /* 75 */ mp_err (*tclBN_mp_signed_rsh) (const mp_int *a, int b, mp_int *c); /* 76 */ - mp_bool (*tclBN_mp_get_bit) (const mp_int *a, unsigned int b); /* 77 */ + void (*reserved77)(void); int (*tclBN_mp_to_ubin) (const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written); /* 78 */ void (*reserved79)(void); int (*tclBN_mp_to_radix) (const mp_int *a, char *str, size_t maxlen, size_t *written, int radix); /* 80 */ @@ -600,8 +597,7 @@ extern const TclTomMathStubs *tclTomMathStubsPtr; (tclTomMathStubsPtr->tclBN_mp_tc_xor) /* 75 */ #define TclBN_mp_signed_rsh \ (tclTomMathStubsPtr->tclBN_mp_signed_rsh) /* 76 */ -#define TclBN_mp_get_bit \ - (tclTomMathStubsPtr->tclBN_mp_get_bit) /* 77 */ +/* Slot 77 is reserved */ #define TclBN_mp_to_ubin \ (tclTomMathStubsPtr->tclBN_mp_to_ubin) /* 78 */ /* Slot 79 is reserved */ diff --git a/unix/Makefile.in b/unix/Makefile.in index 321b0e2..af9e090 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -319,26 +319,26 @@ OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \ TOMMATH_OBJS = bn_s_mp_reverse.o bn_s_mp_mul_digs_fast.o \ bn_s_mp_sqr_fast.o bn_mp_add.o bn_mp_and.o \ - bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \ - bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \ + bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \ + bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \ bn_mp_cnt_lsb.o bn_mp_copy.o \ bn_mp_count_bits.o bn_mp_div.o bn_mp_div_d.o bn_mp_div_2.o \ bn_mp_div_2d.o bn_mp_div_3.o bn_mp_exch.o bn_mp_expt_u32.o \ - bn_s_mp_get_bit.o bn_mp_grow.o bn_mp_init.o \ + bn_mp_grow.o bn_mp_init.o \ bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \ bn_mp_init_size.o bn_s_mp_karatsuba_mul.o \ bn_s_mp_karatsuba_sqr.o bn_s_mp_balance_mul.o \ - bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \ - bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \ + bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \ + bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \ bn_mp_radix_size.o bn_mp_radix_smap.o \ - bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o \ + bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o \ bn_mp_shrink.o \ bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \ bn_mp_signed_rsh.o \ bn_mp_to_ubin.o \ bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o bn_mp_to_radix.o \ bn_mp_ubin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \ - bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o + bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o STUB_LIB_OBJS = tclStubLib.o \ tclTomMathStubLib.o \ @@ -1515,9 +1515,6 @@ bn_mp_exch.o: $(TOMMATH_DIR)/bn_mp_exch.c $(MATHHDRS) bn_mp_expt_u32.o: $(TOMMATH_DIR)/bn_mp_expt_u32.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_u32.c -bn_s_mp_get_bit.o: $(TOMMATH_DIR)/bn_s_mp_get_bit.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_get_bit.c - bn_mp_grow.o: $(TOMMATH_DIR)/bn_mp_grow.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_grow.c diff --git a/win/Makefile.in b/win/Makefile.in index 5e3252e..d7b4142 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -364,7 +364,6 @@ TOMMATH_OBJS = \ bn_mp_zero.${OBJEXT} \ bn_s_mp_add.${OBJEXT} \ bn_s_mp_balance_mul.$(OBJEXT) \ - bn_s_mp_get_bit.${OBJEXT} \ bn_s_mp_karatsuba_mul.${OBJEXT} \ bn_s_mp_karatsuba_sqr.$(OBJEXT) \ bn_s_mp_mul_digs.${OBJEXT} \ diff --git a/win/makefile.vc b/win/makefile.vc index 6a428aa..9b36abf 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -367,7 +367,6 @@ TOMMATHOBJS = \ $(TMP_DIR)\bn_mp_zero.obj \ $(TMP_DIR)\bn_s_mp_add.obj \ $(TMP_DIR)\bn_s_mp_balance_mul.obj \ - $(TMP_DIR)\bn_s_mp_get_bit.obj \ $(TMP_DIR)\bn_s_mp_karatsuba_mul.obj \ $(TMP_DIR)\bn_s_mp_karatsuba_sqr.obj \ $(TMP_DIR)\bn_s_mp_mul_digs.obj \ -- cgit v0.12 From 521b33f6ec17381c19722e73043934c1dc81bea4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 15 Nov 2019 14:35:12 +0000 Subject: Backout [b5c1404365f53fe0], removing TclFreeObj() is a step too far for 8.7 --- generic/tcl.decls | 3 +-- generic/tcl.h | 11 ++--------- generic/tclDecls.h | 8 ++++---- generic/tclInt.h | 1 - generic/tclStubInit.c | 4 +--- 5 files changed, 8 insertions(+), 19 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 910c29e..8555ac2 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -132,9 +132,8 @@ declare 28 { declare 29 { Tcl_Obj *Tcl_DuplicateObj(Tcl_Obj *objPtr) } -# Only available as stub-entry, for backwards-compatible stub-enabled extensions declare 30 { - void TclOldFreeObj(Tcl_Obj *objPtr) + void TclFreeObj(Tcl_Obj *objPtr) } declare 31 { int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr) diff --git a/generic/tcl.h b/generic/tcl.h index c1187c6..5fb91f2 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2452,14 +2452,7 @@ EXTERN int TclZipfs_AppHook(int *argc, char ***argv); # undef Tcl_IsShared # define Tcl_IsShared(objPtr) \ Tcl_DbIsShared(objPtr, __FILE__, __LINE__) -#elif (!defined(TCL_NO_DEPRECATED) && defined(USE_TCL_STUBS)) -/* - * When compiling stub-enabled extensions without -DTCL_NO_DEPRECATED, - * those extensions are expected to run fine with Tcl 8.6 as well. - * This means we must continue to use macro's for the above 3 functions, - * and the old stub entry for TclFreeObj. All other usage of TclFreeObj() - * is forbidden now, therefore it is changed to be MODULE_SCOPE internal. - */ +#else # undef Tcl_IncrRefCount # define Tcl_IncrRefCount(objPtr) \ ++(objPtr)->refCount @@ -2472,7 +2465,7 @@ EXTERN int TclZipfs_AppHook(int *argc, char ***argv); do { \ Tcl_Obj *_objPtr = (objPtr); \ if ((_objPtr)->refCount-- <= 1) { \ - TclOldFreeObj(_objPtr); \ + TclFreeObj(_objPtr); \ } \ } while(0) # undef Tcl_IsShared diff --git a/generic/tclDecls.h b/generic/tclDecls.h index b37491a..4f2d63f 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -143,7 +143,7 @@ EXTERN Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, int length, /* 29 */ EXTERN Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr); /* 30 */ -EXTERN void TclOldFreeObj(Tcl_Obj *objPtr); +EXTERN void TclFreeObj(Tcl_Obj *objPtr); /* 31 */ EXTERN int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr); @@ -1970,7 +1970,7 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */ Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */ Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */ - void (*tclOldFreeObj) (Tcl_Obj *objPtr); /* 30 */ + void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */ int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */ int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */ unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */ @@ -2683,8 +2683,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_DbNewStringObj) /* 28 */ #define Tcl_DuplicateObj \ (tclStubsPtr->tcl_DuplicateObj) /* 29 */ -#define TclOldFreeObj \ - (tclStubsPtr->tclOldFreeObj) /* 30 */ +#define TclFreeObj \ + (tclStubsPtr->tclFreeObj) /* 30 */ #define Tcl_GetBoolean \ (tclStubsPtr->tcl_GetBoolean) /* 31 */ #define Tcl_GetBooleanFromObj \ diff --git a/generic/tclInt.h b/generic/tclInt.h index 790eba1..681cb61 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4130,7 +4130,6 @@ MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr, */ MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr); -MODULE_SCOPE void TclFreeObj(Tcl_Obj *objPtr); MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr); MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr); diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index a077a65..a19992d 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -512,7 +512,6 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig # define Tcl_SetPanicProc 0 # define Tcl_FindExecutable 0 # define Tcl_GetUnicode 0 -# define TclOldFreeObj 0 # undef Tcl_StringMatch # define Tcl_StringMatch 0 # define TclBN_reverse 0 @@ -547,7 +546,6 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig # define TclGetCommandFullName Tcl_GetCommandFullName # define TclpLocaltime_unix TclpLocaltime # define TclpGmtime_unix TclpGmtime -# define TclOldFreeObj TclFreeObj static int seekOld( @@ -1113,7 +1111,7 @@ const TclStubs tclStubs = { Tcl_DbNewObj, /* 27 */ Tcl_DbNewStringObj, /* 28 */ Tcl_DuplicateObj, /* 29 */ - TclOldFreeObj, /* 30 */ + TclFreeObj, /* 30 */ Tcl_GetBoolean, /* 31 */ Tcl_GetBooleanFromObj, /* 32 */ Tcl_GetByteArrayFromObj, /* 33 */ -- cgit v0.12