From ae33d6bbf676b0bdd074ee8a295a1c35a6107459 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 6 Nov 2019 13:25:09 +0000 Subject: Fix tclScan.c, not generating a string representation any more with unsigned wideints and unsigned longs. --- generic/tclScan.c | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/generic/tclScan.c b/generic/tclScan.c index b0669ab..4b9298d 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -585,9 +585,6 @@ Tcl_ScanObjCmd( Tcl_UniChar ch = 0, sch = 0; Tcl_Obj **objs = NULL, *objPtr = NULL; int flags; - char buf[513]; /* Temporary buffer to hold scanned number - * strings before they are passed to - * strtoul. */ if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, @@ -937,9 +934,9 @@ Tcl_ScanObjCmd( } } if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) { - sprintf(buf, "%" TCL_LL_MODIFIER "u", - (Tcl_WideUInt)wideValue); - Tcl_SetStringObj(objPtr, buf, -1); + mp_int big; + TclBNInitBignumFromWideUInt(&big, (Tcl_WideUInt)wideValue); + Tcl_SetBignumObj(objPtr, &big); } else { Tcl_SetWideIntObj(objPtr, wideValue); } @@ -952,8 +949,13 @@ Tcl_ScanObjCmd( } } if ((flags & SCAN_UNSIGNED) && (value < 0)) { - sprintf(buf, "%lu", value); /* INTL: ISO digit */ - Tcl_SetStringObj(objPtr, buf, -1); +#ifdef TCL_WIDE_INT_IS_LONG + mp_int big; + TclBNInitBignumFromWideUInt(&big, (unsigned long)value); + Tcl_SetBignumObj(objPtr, &big); +#else + Tcl_SetWideIntObj(objPtr, (unsigned long)value); +#endif } else { Tcl_SetLongObj(objPtr, value); } -- cgit v0.12 From 41cd7b2754b0d81fb8fc35f0a3abaace7249471c Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 6 Nov 2019 23:03:43 +0000 Subject: cmdMZ.test: solved timing issues (too slow machines, debug builds, etc) --- tests/cmdMZ.test | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test index 5f94777..f72d39f 100644 --- a/tests/cmdMZ.test +++ b/tests/cmdMZ.test @@ -29,8 +29,6 @@ namespace eval ::tcl::test::cmdMZ { namespace import ::tcl::unsupported::timerate } - testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}] - # Tcl_PwdObjCmd test cmdMZ-1.1 {Tcl_PwdObjCmd} { @@ -333,8 +331,12 @@ test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} { proc _nrt_sleep {msec} { set usec [expr {$msec * 1000}] set stime [clock microseconds] - while {abs([clock microseconds] - $stime) < $usec} {after 0} + while {abs([clock microseconds] - $stime) < $usec} { + # don't use after 0 unless it's NRT-capable, so yes - busy-wait (but it's more precise): + # after 0 + } } +_nrt_sleep 0; # warm up (clock, compile, etc) test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} { list [catch {time} msg] $msg @@ -351,8 +353,8 @@ test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} { regexp {^\d+ microseconds per iteration} [time {format 1}] } 1 -test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} knownMsvcBug { - expr {[lindex [time {_nrt_sleep 1}] 0] < [lindex [time {_nrt_sleep 20}] 0]} +test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} { + expr {[lindex [time {_nrt_sleep 0.01}] 0] < [lindex [time {_nrt_sleep 10.0}] 0]} } 1 test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} { list [catch {time {error foo}} msg] $msg $::errorInfo @@ -404,19 +406,20 @@ test cmdMZ-6.5a {Tcl_TimeRateObjCmd: result format and one iteration} { test cmdMZ-6.5b {Tcl_TimeRateObjCmd: result format without iterations} { regexp {^0 \ws/# 0 # 0 #/sec 0 net-ms$} [timerate {} 0 0] } 1 -test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} knownMsvcBug { - set m1 [timerate {_nrt_sleep 0} 20] - set m2 [timerate {_nrt_sleep 0.2} 20] +test cmdMZ-6.6 {Tcl_TimeRateObjCmd: slower commands take longer, but it remains almost the same time of measument} { + lassign [timerate {_nrt_sleep 0} 50] ovh + set m1 [timerate -overhead $ovh {_nrt_sleep 0.01} 50] + set m2 [timerate -overhead $ovh {_nrt_sleep 1.00} 50] list \ [expr {[lindex $m1 0] < [lindex $m2 0]}] \ [expr {[lindex $m1 0] < 100}] \ [expr {[lindex $m2 0] > 100}] \ - [expr {[lindex $m1 2] > 1000}] \ - [expr {[lindex $m2 2] < 1000}] \ - [expr {[lindex $m1 4] > 50000}] \ - [expr {[lindex $m2 4] < 50000}] \ - [expr {[lindex $m1 6] > 10 && [lindex $m1 6] < 100}] \ - [expr {[lindex $m2 6] > 10 && [lindex $m2 6] < 100}] + [expr {[lindex $m1 2] > 500}] \ + [expr {[lindex $m2 2] < 500}] \ + [expr {[lindex $m1 4] > 10000}] \ + [expr {[lindex $m2 4] < 10000}] \ + [expr {[lindex $m1 6] > 5 && [lindex $m1 6] < 100}] \ + [expr {[lindex $m2 6] > 5 && [lindex $m2 6] < 100}] } [lrepeat 9 1] test cmdMZ-6.7 {Tcl_TimeRateObjCmd: errors generate right trace} { list [catch {timerate {error foo} 1} msg] $msg $::errorInfo -- cgit v0.12 From 208e4fd87b7123289717f2a292a056da196f3665 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 7 Nov 2019 14:56:58 +0000 Subject: Make mp_mul(a,a,c) equivalent to mp_sqr(a,c). Optimization backported from libtommath. --- libtommath/bn_mp_mul.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/libtommath/bn_mp_mul.c b/libtommath/bn_mp_mul.c index 561913a..b00334d 100644 --- a/libtommath/bn_mp_mul.c +++ b/libtommath/bn_mp_mul.c @@ -12,7 +12,9 @@ mp_err mp_mul(const mp_int *a, const mp_int *b, mp_int *c) digs = a->used + b->used + 1; mp_sign neg = (a->sign == b->sign) ? MP_ZPOS : MP_NEG; - if (MP_HAS(S_MP_BALANCE_MUL) && + if (a == b) { + return mp_sqr(a,c); + } else if (MP_HAS(S_MP_BALANCE_MUL) && /* Check sizes. The smaller one needs to be larger than the Karatsuba cut-off. * The bigger one needs to be at least about one MP_KARATSUBA_MUL_CUTOFF bigger * to make some sense, but it depends on architecture, OS, position of the -- cgit v0.12 From c1f8c0290006c19eba948b7aaec6ae6ae0e0099c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 8 Nov 2019 15:32:33 +0000 Subject: Add support for mp_init_i32/mp_init_i64/mp_init_l/mp_init_ll/mp_init_u32/mp_init_u64/mp_init_ul/mp_init_ull/mp_set_ull, the main functions in libtommath 1.2.0 for setting values directly in mp_int's. One new stub entry (mp_set_ull), the others make use of already existing stub entries. This is 100% fully upwards compatible. --- generic/tclStubInit.c | 8 ++--- generic/tclTestObj.c | 2 +- generic/tclTomMath.decls | 11 ++++--- generic/tclTomMathDecls.h | 68 +++++++++++++++++++++++++++++++++++++------ generic/tclTomMathInterface.c | 9 ++++-- 5 files changed, 77 insertions(+), 21 deletions(-) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 0618f00..09c975d 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -70,12 +70,12 @@ static int TclSockMinimumBuffersOld(int sock, int size) } #endif -static MP_SET_UNSIGNED(bn_mp_set_ull, Tcl_WideUInt) +MP_SET_UNSIGNED(mp_set_ull, Tcl_WideUInt) mp_err TclBN_mp_set_int(mp_int *a, unsigned long i) { - bn_mp_set_ull(a, i); + mp_set_ull(a, i); return MP_OKAY; } @@ -83,7 +83,7 @@ mp_err TclBN_mp_init_set_int(mp_int *a, unsigned long i) { mp_err result = mp_init(a); if (result == MP_OKAY) { - bn_mp_set_ull(a, i); + mp_set_ull(a, i); } return result; } @@ -916,7 +916,7 @@ const TclTomMathStubs tclTomMathStubs = { TclBNInitBignumFromWideInt, /* 65 */ TclBNInitBignumFromWideUInt, /* 66 */ TclBN_mp_expt_d_ex, /* 67 */ - 0, /* 68 */ + TclBN_mp_set_ull, /* 68 */ 0, /* 69 */ 0, /* 70 */ 0, /* 71 */ diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 7f9b561..f741714 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -131,7 +131,7 @@ TclObjTest_Init( * * TestbignumobjCmd -- * - * This function implmenets the "testbignumobj" command. It is used + * This function implements the "testbignumobj" command. It is used * to exercise the bignum Tcl object type implementation. * * Results: diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls index 8325922..c5645a4 100644 --- a/generic/tclTomMath.decls +++ b/generic/tclTomMath.decls @@ -224,20 +224,23 @@ declare 63 { # Formerly internal API to allow initialisation of bignums without knowing the # typedefs of how a bignum works internally. declare 64 { - void TclBNInitBignumFromLong(mp_int *bignum, long initVal) + int TclBNInitBignumFromLong(mp_int *bignum, long initVal) } declare 65 { - void TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal) + int TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal) } declare 66 { - void TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal) + int TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal) } # Added in libtommath 1.0 declare 67 { mp_err TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) } - +# Added in libtommath 1.0.1 +declare 68 { + void TclBN_mp_set_ull(mp_int *a, Tcl_WideUInt i) +} # Added in libtommath 1.1.0 declare 73 { mp_err TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h index 9131041..a1da2c9 100644 --- a/generic/tclTomMathDecls.h +++ b/generic/tclTomMathDecls.h @@ -96,6 +96,8 @@ #define mp_set_int(a,b) (TclBN_mp_set_int(a,(unsigned int)(b)),MP_OKAY) #define mp_set_long(a,b) (TclBN_mp_set_int(a,b),MP_OKAY) #define mp_set_ul(a,b) (void)TclBN_mp_set_int(a,b) +#define mp_set_ull TclBN_mp_set_ull +#define mp_set_u64 TclBN_mp_set_ull #define mp_shrink TclBN_mp_shrink #define mp_sqr TclBN_mp_sqr #define mp_sqrt TclBN_mp_sqrt @@ -311,17 +313,18 @@ EXTERN mp_err TclBN_mp_set_int(mp_int *a, unsigned long i); /* 63 */ EXTERN int TclBN_mp_cnt_lsb(const mp_int *a); /* 64 */ -EXTERN void TclBNInitBignumFromLong(mp_int *bignum, long initVal); +EXTERN int TclBNInitBignumFromLong(mp_int *bignum, long initVal); /* 65 */ -EXTERN void TclBNInitBignumFromWideInt(mp_int *bignum, +EXTERN int TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal); /* 66 */ -EXTERN void TclBNInitBignumFromWideUInt(mp_int *bignum, +EXTERN int TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal); /* 67 */ EXTERN mp_err TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast); -/* Slot 68 is reserved */ +/* 68 */ +EXTERN void TclBN_mp_set_ull(mp_int *a, Tcl_WideUInt i); /* Slot 69 is reserved */ /* Slot 70 is reserved */ /* Slot 71 is reserved */ @@ -416,11 +419,11 @@ typedef struct TclTomMathStubs { mp_err (*tclBN_mp_init_set_int) (mp_int *a, unsigned long i); /* 61 */ mp_err (*tclBN_mp_set_int) (mp_int *a, unsigned long i); /* 62 */ int (*tclBN_mp_cnt_lsb) (const mp_int *a); /* 63 */ - void (*tclBNInitBignumFromLong) (mp_int *bignum, long initVal); /* 64 */ - void (*tclBNInitBignumFromWideInt) (mp_int *bignum, Tcl_WideInt initVal); /* 65 */ - void (*tclBNInitBignumFromWideUInt) (mp_int *bignum, Tcl_WideUInt initVal); /* 66 */ + int (*tclBNInitBignumFromLong) (mp_int *bignum, long initVal); /* 64 */ + int (*tclBNInitBignumFromWideInt) (mp_int *bignum, Tcl_WideInt initVal); /* 65 */ + int (*tclBNInitBignumFromWideUInt) (mp_int *bignum, Tcl_WideUInt initVal); /* 66 */ mp_err (*tclBN_mp_expt_d_ex) (const mp_int *a, mp_digit b, mp_int *c, int fast); /* 67 */ - void (*reserved68)(void); + void (*tclBN_mp_set_ull) (mp_int *a, Tcl_WideUInt i); /* 68 */ void (*reserved69)(void); void (*reserved70)(void); void (*reserved71)(void); @@ -583,7 +586,8 @@ extern const TclTomMathStubs *tclTomMathStubsPtr; (tclTomMathStubsPtr->tclBNInitBignumFromWideUInt) /* 66 */ #define TclBN_mp_expt_d_ex \ (tclTomMathStubsPtr->tclBN_mp_expt_d_ex) /* 67 */ -/* Slot 68 is reserved */ +#define TclBN_mp_set_ull \ + (tclTomMathStubsPtr->tclBN_mp_set_ull) /* 68 */ /* Slot 69 is reserved */ /* Slot 70 is reserved */ /* Slot 71 is reserved */ @@ -611,4 +615,50 @@ extern const TclTomMathStubs *tclTomMathStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT +#ifdef USE_TCL_STUBS +#undef TclBNInitBignumFromLong +#define TclBNInitBignumFromLong(a,b) \ + do { \ + (a)->dp = NULL; \ + (void)tclTomMathStubsPtr->tclBNInitBignumFromLong((a),(b)); \ + if ((a)->dp == NULL) { \ + Tcl_Panic("initialization failure in TclBNInitBignumFromLong"); \ + } \ + } while (0) +#undef TclBNInitBignumFromWideInt +#define TclBNInitBignumFromWideInt(a,b) \ + do { \ + (a)->dp = NULL; \ + (void)tclTomMathStubsPtr->tclBNInitBignumFromWideInt((a),(b)); \ + if ((a)->dp == NULL) { \ + Tcl_Panic("initialization failure in TclBNInitBignumFromWideInt"); \ + } \ + } while (0) +#undef TclBNInitBignumFromWideUInt +#define TclBNInitBignumFromWideUInt(a,b) \ + do { \ + (a)->dp = NULL; \ + (void)tclTomMathStubsPtr->tclBNInitBignumFromWideUInt((a),(b)); \ + if ((a)->dp == NULL) { \ + Tcl_Panic("initialization failure in TclBNInitBignumFromWideUInt"); \ + } \ + } while (0) +#define mp_init_i32(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromLong((a),(int32_t)(b)),(a)->dp)?MP_OKAY:MP_ERR) +#define mp_init_l(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromLong((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) +#define mp_init_ll(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromWideInt((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) +#define mp_init_i64(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromWideInt((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) +#define mp_init_u32(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromWideUInt((a),(uint32_t)(b)),(a)->dp)?MP_OKAY:MP_ERR) +#define mp_init_ul(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromWideUInt((a),(unsigned long)(b)),(a)->dp)?MP_OKAY:MP_ERR) +#define mp_init_ull(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromWideUInt((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) +#define mp_init_u64(a,b) (((a)->dp=NULL,tclTomMathStubsPtr->tclBNInitBignumFromWideUInt((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) +#else +#define mp_init_i32(a,b) (((a)->dp=NULL,(TclBNInitBignumFromLong)((a),(int32_t)(b)),(a)->dp)?MP_OKAY:MP_ERR) +#define mp_init_l(a,b) (((a)->dp=NULL,(TclBNInitBignumFromLong)((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) +#define mp_init_ll(a,b) (((a)->dp=NULL,(TclBNInitBignumFromWideInt)((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) +#define mp_init_i64(a,b) (((a)->dp=NULL,(TclBNInitBignumFromWideInt)((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) +#define mp_init_u32(a,b) (((a)->dp=NULL,(TclBNInitBignumFromWideUInt)((a),(uint32_t)(b)),(a)->dp)?MP_OKAY:MP_ERR) +#define mp_init_ul(a,b) (((a)->dp=NULL,(TclBNInitBignumFromWideUInt)((a),(unsigned long)(b)),(a)->dp)?MP_OKAY:MP_ERR) +#define mp_init_ull(a,b) (((a)->dp=NULL,(TclBNInitBignumFromWideUInt)((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) +#define mp_init_u64(a,b) (((a)->dp=NULL,(TclBNInitBignumFromWideUInt)((a),(b)),(a)->dp)?MP_OKAY:MP_ERR) +#endif /* USE_TCL_STUBS */ #endif /* _TCLINTDECLS */ diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c index c28b3b1..2dc8c2d 100644 --- a/generic/tclTomMathInterface.c +++ b/generic/tclTomMathInterface.c @@ -106,7 +106,7 @@ TclBN_revision(void) *---------------------------------------------------------------------- */ -void +int TclBNInitBignumFromLong( mp_int *a, long initVal) @@ -146,6 +146,7 @@ TclBNInitBignumFromLong( v >>= MP_DIGIT_BIT; } a->used = p - a->dp; + return MP_OKAY; } /* @@ -164,7 +165,7 @@ TclBNInitBignumFromLong( *---------------------------------------------------------------------- */ -void +int TclBNInitBignumFromWideInt( mp_int *a, /* Bignum to initialize */ Tcl_WideInt v) /* Initial value */ @@ -175,6 +176,7 @@ TclBNInitBignumFromWideInt( } else { TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)v); } + return MP_OKAY; } /* @@ -193,7 +195,7 @@ TclBNInitBignumFromWideInt( *---------------------------------------------------------------------- */ -void +int TclBNInitBignumFromWideUInt( mp_int *a, /* Bignum to initialize */ Tcl_WideUInt v) /* Initial value */ @@ -222,6 +224,7 @@ TclBNInitBignumFromWideUInt( v >>= MP_DIGIT_BIT; } a->used = p - a->dp; + return MP_OKAY; } /* -- cgit v0.12 From e85c33074d52d9b69f1c521915615e8660f07d33 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 11 Nov 2019 16:32:42 +0000 Subject: On win32, include if available, just as on UNIX. Disable compiler warning C4244 on all Microsoft compiler versions, not just the latest ones. --- win/tclWinPort.h | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/win/tclWinPort.h b/win/tclWinPort.h index c30d346..e9ae9dc 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -14,6 +14,7 @@ #ifndef _TCLWINPORT #define _TCLWINPORT + #if !defined(_WIN64) && !defined(__MINGW_USE_VC2005_COMPAT) /* See [Bug 3354324]: file mtime sets wrong time */ # define __MINGW_USE_VC2005_COMPAT @@ -62,6 +63,9 @@ typedef DWORD_PTR * PDWORD_PTR; #include #include #include +#if HAVE_INTTYPES_H +# include +#endif #include #ifndef __GNUC__ @@ -379,12 +383,14 @@ typedef DWORD_PTR * PDWORD_PTR; * including the *printf family and others. Tell it to shut up. * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0) */ -#if defined(_MSC_VER) && (_MSC_VER >= 1400) +#if defined(_MSC_VER) # pragma warning(disable:4244) -# pragma warning(disable:4267) -# pragma warning(disable:4311) -# pragma warning(disable:4312) -# pragma warning(disable:4996) +# if _MSC_VER >= 1400 +# pragma warning(disable:4267) +# pragma warning(disable:4311) +# pragma warning(disable:4312) +# pragma warning(disable:4996) +# endif #endif -- cgit v0.12 From de04d595faa9eff7914a831e767b11a2d5116b44 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 13 Nov 2019 08:16:51 +0000 Subject: Fix compiler warning when compiling with -DTCL_UTF_MAX=4 or 6 --- win/tclWinDde.c | 4 ++-- win/tclWinReg.c | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/win/tclWinDde.c b/win/tclWinDde.c index cbbcdae..267ee6e 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -119,8 +119,8 @@ static int DdeObjCmd(void *clientData, #if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) # if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf(a,(b)*sizeof(WCHAR),c) -# define Tcl_UtfToWCharDString(a,b,c) Tcl_WinUtfToTChar(a,b,c) +# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) +# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) # else # define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString # define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString diff --git a/win/tclWinReg.c b/win/tclWinReg.c index b66282a..2c1b8a5 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -126,8 +126,8 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, #if (TCL_MAJOR_VERSION < 9) && (TCL_MINOR_VERSION < 7) # if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf(a,(b)*sizeof(WCHAR),c) -# define Tcl_UtfToWCharDString(a,b,c) Tcl_WinUtfToTChar(a,b,c) +# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) +# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) # else # define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString # define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString -- cgit v0.12 From 3181ee9123bf2402abeba55ca2b9469d74382ed1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 13 Nov 2019 09:07:08 +0000 Subject: Fix TIP #389 implementation, bug [d433c0e0ad]: TCL_UTF_MAX == 4 problems. Thanks to Christian Werner for the report. --- generic/tclEncoding.c | 2 +- generic/tclInt.h | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 002c765..1c1f94c 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2366,7 +2366,7 @@ UtfToUtfProc( dst += Tcl_UniCharToUtf(*chPtr, dst); #if TCL_UTF_MAX == 4 if ((*chPtr >= 0xD800) && (len < 3)) { - src += TclUtfToUniChar(src + len, chPtr); + src += Tcl_UtfToUniChar(src + len, chPtr); dst += Tcl_UniCharToUtf(*chPtr, dst); } #endif diff --git a/generic/tclInt.h b/generic/tclInt.h index 9038a56..39fb740 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4429,7 +4429,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclUtfToUniChar(str, chPtr) \ - ((((unsigned char) *(str)) < 0xC0) ? \ + ((((unsigned char) *(str)) < 0x80) ? \ ((*(chPtr) = (unsigned char) *(str)), 1) \ : Tcl_UtfToUniChar(str, chPtr)) -- cgit v0.12 From d3315530e8ae5a6b4dd6fce55c2bea70f4798131 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 13 Nov 2019 12:37:24 +0000 Subject: Part 2 of bugfix [d433c0e0ad]: TCL_UTF_MAX == 4 problems --- generic/tclEncoding.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 1c1f94c..f159b32 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2366,7 +2366,7 @@ UtfToUtfProc( dst += Tcl_UniCharToUtf(*chPtr, dst); #if TCL_UTF_MAX == 4 if ((*chPtr >= 0xD800) && (len < 3)) { - src += Tcl_UtfToUniChar(src + len, chPtr); + src += Tcl_UtfToUniChar(src, chPtr); dst += Tcl_UniCharToUtf(*chPtr, dst); } #endif -- cgit v0.12 From db160493def9e4d6ec6cb55fe788a5784447f1c5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 13 Nov 2019 15:59:11 +0000 Subject: Don't install tommath_class.h and tommath_superclass.h on Windows any more by makefile.vc. Those are purely internal, not needed by extensions. --- win/makefile.vc | 2 -- 1 file changed, 2 deletions(-) diff --git a/win/makefile.vc b/win/makefile.vc index 01cdb1f..6a428aa 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -893,8 +893,6 @@ install-libraries: tclConfig tcl-nmake install-msgs install-tzdata @$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\" @$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\" - @$(CPY) "$(TOMMATHDIR)\tommath_class.h" "$(INCLUDE_INSTALL_DIR)\" - @$(CPY) "$(TOMMATHDIR)\tommath_superclass.h" "$(INCLUDE_INSTALL_DIR)\" @echo Installing library files to $(SCRIPT_INSTALL_DIR) @$(CPY) "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\init.tcl" "$(SCRIPT_INSTALL_DIR)\" -- cgit v0.12 From ed907ec2d18048ab42baa3a8a6b4436894dc8912 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 13 Nov 2019 16:01:35 +0000 Subject: Make tclWinFile compile warningless using -DTCL_UTF_MAX=6 (not officially supported, but used by Androwish) --- win/tclWinFile.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 20cd6d4..e050862 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -1472,14 +1472,14 @@ TclpGetUserHome( Tcl_DStringFree(&ds); } else { Tcl_DStringInit(&ds); - wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds); + wName = (WCHAR *)Tcl_WinUtfToTChar(domain + 1, -1, &ds); rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain); Tcl_DStringFree(&ds); nameLen = domain - name; } if (rc == 0) { Tcl_DStringInit(&ds); - wName = Tcl_UtfToUniCharDString(name, nameLen, &ds); + wName = (WCHAR *)Tcl_WinUtfToTChar(name, nameLen, &ds); while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) { /* * User does not exist; if domain was not specified, try again @@ -1507,7 +1507,7 @@ TclpGetUserHome( wHomeDir = uiPtr->usri1_home_dir; if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) { size = lstrlenW(wHomeDir); - Tcl_UniCharToUtfDString(wHomeDir, size, bufferPtr); + Tcl_WinTCharToUtf((TCHAR *)wHomeDir, size*sizeof(WCHAR), bufferPtr); } else { /* * User exists but has no home dir. Return @@ -1515,7 +1515,7 @@ TclpGetUserHome( */ GetProfilesDirectoryW(buf, &size); - Tcl_UniCharToUtfDString(buf, size-1, bufferPtr); + Tcl_WinTCharToUtf((TCHAR *)buf, (size-1)*sizeof(WCHAR), bufferPtr); Tcl_DStringAppend(bufferPtr, "/", 1); Tcl_DStringAppend(bufferPtr, name, nameLen); } -- cgit v0.12