From e5fd7b2a2adac4fd495a5c5f955af750e732292c Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 5 Oct 2018 18:13:40 +0000 Subject: scan: new tests for validation rules: invalid time (DST-hole, out of range in time-zone) --- tests/clock.test | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/tests/clock.test b/tests/clock.test index 20ebb0a..4e81c10 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -36604,6 +36604,68 @@ test clock-46.17$idx {scan: validation rules: invalid year} -setup { }; # foreach unset -nocomplain idx relstr +set dst_hole_check { + {":Europe/Berlin" + "2017-03-26 01:59:59" "2017-03-26 02:00:00" "2017-03-26 02:59:59" "2017-03-26 03:00:00" + "2017-10-29 01:59:59" "2017-10-29 02:00:00"} + {":Europe/Berlin" + "2018-03-25 01:59:59" "2018-03-25 02:00:00" "2018-03-25 02:59:59" "2018-03-25 03:00:00" + "2018-10-28 01:59:59" "2018-10-28 02:00:00"} + {":America/New_York" + "2017-03-12 01:59:59" "2017-03-12 02:00:00" "2017-03-12 02:59:59" "2017-03-12 03:00:00" + "2017-11-05 01:59:59" "2017-11-05 02:00:00"} + {":America/New_York" + "2018-03-11 01:59:59" "2018-03-11 02:00:00" "2018-03-11 02:59:59" "2018-03-11 03:00:00" + "2018-11-04 01:59:59" "2018-11-04 02:00:00"} +} +test clock-46.19-1 {free-scan: validation rules: invalid time (DST-hole, out of range in time-zone)} \ + -body { + set res {} + foreach tz $dst_hole_check { set dt [lassign $tz tz]; foreach dt $dt { + lappend res [set v [catch {clock scan $dt -timezone $tz -valid 1} msg]] + if {$v} { lappend res $msg } + }} + set res + } -cleanup { + unset -nocomplain res v dt tz + } -result [lrepeat 4 \ + {*}[list 0 {*}[lrepeat 2 1 {unable to convert input string: invalid time (does not exist in this time-zone)}] 0 0 0]] +test clock-46.19-2 {free-scan: validation rules regression: all scans successful, if -valid 0} \ + -body { + set res {} + set res {} + foreach tz $dst_hole_check { set dt [lassign $tz tz]; foreach dt $dt { + lappend res [set v [catch {clock scan $dt -timezone $tz} msg]] + }} + set res + } -cleanup { + unset -nocomplain res v dt tz + } -result [lrepeat 4 {*}[if {$valid_mode} {list 0 1 1 0 0 0} else {list 0 0 0 0 0 0}]] +test clock-46.19-3 {scan: validation rules: invalid time (DST-hole, out of range in time-zone)} \ + -body { + set res {} + foreach tz $dst_hole_check { set dt [lassign $tz tz]; foreach dt $dt { + lappend res [set v [catch {clock scan $dt -timezone $tz -format "%Y-%m-%d %H:%M:%S" -valid 1} msg]] + if {$v} { lappend res $msg } + }} + set res + } -cleanup { + unset -nocomplain res v dt tz + } -result [lrepeat 4 \ + {*}[list 0 {*}[lrepeat 2 1 {unable to convert input string: invalid time (does not exist in this time-zone)}] 0 0 0]] +test clock-46.19-4 {scan: validation rules regression: all scans successful, if -valid 0} \ + -body { + set res {} + set res {} + foreach tz $dst_hole_check { set dt [lassign $tz tz]; foreach dt $dt { + lappend res [set v [catch {clock scan $dt -timezone $tz -format "%Y-%m-%d %H:%M:%S"} msg]] + }} + set res + } -cleanup { + unset -nocomplain res v dt tz + } -result [lrepeat 4 {*}[if {$valid_mode} {list 0 1 1 0 0 0} else {list 0 0 0 0 0 0}]] +unset -nocomplain dst_hole_check + test clock-46.20 {scan: validation rules: invalid time} \ -body { # 13:00 am/pm are invalid input strings... -- cgit v0.12 From ed80b6476b460a6247856a1c4eb3cbb50af09382 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 5 Oct 2018 19:38:19 +0000 Subject: =?UTF-8?q?Introduces=20new=20validity=20rule=20(gh-11):=20check?= =?UTF-8?q?=20input-time=20is=20valid=20regarding=20time-zone=20conversion?= =?UTF-8?q?=20inside=20the=20time-zone=20ranges=20(not=20in=20DST-hole);?= =?UTF-8?q?=20ConvertLocalToUTC/ConvertUTCToLocal=20rewritten=20to=20use?= =?UTF-8?q?=20common=20cache=20(and=20ConvertLocalToUTC=20invalidates=20th?= =?UTF-8?q?e=20local=20seconds,=20if=20it=20was=20outside=20the=20time-zon?= =?UTF-8?q?e=20ranges=20during=20conversion);=20Bonus:=20improves=20perfor?= =?UTF-8?q?mance=20of=20the=20involved=20cache=20by=20time-zone=20conversi?= =?UTF-8?q?ons=20(if=20more=20as=201=20TZ),=20see=20both=20performance=20t?= =?UTF-8?q?est-cases=20"Convert=20TZ:=20direct":=20(1.3=C2=B5s=20vs.=201.7?= =?UTF-8?q?=C2=B5s=20previously)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- generic/tclClock.c | 282 ++++++++++++++++++++++++++++++----------------------- generic/tclDate.h | 43 ++++---- 2 files changed, 179 insertions(+), 146 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index dba98fd..dfa760c 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -262,9 +262,8 @@ TclClockInit( data->prevUsedLocaleDict = NULL; data->lastBase.timezoneObj = NULL; - data->utc2local.timezoneObj = NULL; - data->utc2local.tzName = NULL; - data->local2utc.timezoneObj = NULL; + + memset(&data->lastTZOffsCache, 0, sizeof(data->lastTZOffsCache)); data->defFlags = 0; @@ -337,9 +336,11 @@ ClockConfigureClear( data->prevUsedLocaleDict = NULL; Tcl_UnsetObjRef(data->lastBase.timezoneObj); - Tcl_UnsetObjRef(data->utc2local.timezoneObj); - Tcl_UnsetObjRef(data->utc2local.tzName); - Tcl_UnsetObjRef(data->local2utc.timezoneObj); + + Tcl_UnsetObjRef(data->lastTZOffsCache[0].timezoneObj); + Tcl_UnsetObjRef(data->lastTZOffsCache[0].tzName); + Tcl_UnsetObjRef(data->lastTZOffsCache[1].timezoneObj); + Tcl_UnsetObjRef(data->lastTZOffsCache[1].tzName); Tcl_UnsetObjRef(data->mcDicts); } @@ -1869,6 +1870,7 @@ ConvertLocalToUTC( int rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ Tcl_WideInt seconds; + ClockLastTZOffs * ltzoc = NULL; /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */ if (timezoneObj == dataPtr->literals[LIT_GMT]) { @@ -1879,38 +1881,30 @@ ConvertLocalToUTC( /* * Check cacheable conversion could be used - * (last-period Local2UTC cache within the same TZ) + * (last-period UTC2Local cache within the same TZ and seconds) */ - seconds = fields->localSeconds - dataPtr->local2utc.tzOffset; - if ( timezoneObj == dataPtr->local2utc.timezoneObj - && ( fields->localSeconds == dataPtr->local2utc.localSeconds - || ( seconds >= dataPtr->local2utc.rangesVal[0] - && seconds < dataPtr->local2utc.rangesVal[1]) - ) - && changeover == dataPtr->local2utc.changeover - ) { - /* the same time zone and offset (UTC time inside the last minute) */ - fields->tzOffset = dataPtr->local2utc.tzOffset; - fields->seconds = seconds; - return TCL_OK; - } - - /* - * Check cacheable back-conversion could be used - * (last-period UTC2Local cache within the same TZ) - */ - seconds = fields->localSeconds - dataPtr->utc2local.tzOffset; - if ( timezoneObj == dataPtr->utc2local.timezoneObj - && ( seconds == dataPtr->utc2local.seconds - || ( seconds >= dataPtr->utc2local.rangesVal[0] - && seconds < dataPtr->utc2local.rangesVal[1]) - ) - && changeover == dataPtr->utc2local.changeover - ) { - /* the same time zone and offset (UTC time inside the last minute) */ - fields->tzOffset = dataPtr->utc2local.tzOffset; - fields->seconds = seconds; - return TCL_OK; + for (rowc = 0; rowc < 2; rowc++) { + ltzoc = &dataPtr->lastTZOffsCache[rowc]; + if (timezoneObj != ltzoc->timezoneObj || changeover != ltzoc->changeover) { + ltzoc = NULL; + continue; + } + seconds = fields->localSeconds - ltzoc->tzOffset; + if ( seconds >= ltzoc->rangesVal[0] + && seconds < ltzoc->rangesVal[1] + ) { + /* the same time zone and offset (UTC time inside the last minute) */ + fields->tzOffset = ltzoc->tzOffset; + fields->seconds = seconds; + return TCL_OK; + } + /* in the DST-hole (because of the check above) - correct localSeconds */ + if (fields->localSeconds == ltzoc->localSeconds) { + /* the same time zone and offset (but we'll shift local-time) */ + fields->tzOffset = ltzoc->tzOffset; + fields->seconds = seconds; + goto dstHole; + } } /* @@ -1932,25 +1926,58 @@ ConvertLocalToUTC( */ if (rowc == 0) { - dataPtr->local2utc.rangesVal[0] = 0; - dataPtr->local2utc.rangesVal[1] = 0; if (ConvertLocalToUTCUsingC(interp, fields, changeover) != TCL_OK) { return TCL_ERROR; }; + + /* we cannot cache (ranges unknown yet) - todo: check later the DST-hole here */ + return TCL_OK; + } else { + Tcl_WideInt rangesVal[2]; + if (ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv, - dataPtr->local2utc.rangesVal) != TCL_OK) { + rangesVal) != TCL_OK) { return TCL_ERROR; }; - } - /* Cache the last conversion */ - Tcl_SetObjRef(dataPtr->local2utc.timezoneObj, timezoneObj); - dataPtr->local2utc.localSeconds = fields->localSeconds; - dataPtr->local2utc.changeover = changeover; - dataPtr->local2utc.tzOffset = fields->tzOffset; + seconds = fields->seconds; + /* Cache the last conversion */ + if (ltzoc != NULL) { /* slot was found above */ + /* timezoneObj and changeover are the same */ + Tcl_SetObjRef(ltzoc->tzName, fields->tzName); /* may be NULL */ + } else { + /* no TZ in cache - just move second slot down and use the first one */ + ltzoc = &dataPtr->lastTZOffsCache[0]; + Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].timezoneObj); + Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].tzName); + memcpy(&dataPtr->lastTZOffsCache[1], ltzoc, sizeof(*ltzoc)); + Tcl_InitObjRef(ltzoc->timezoneObj, timezoneObj); + ltzoc->changeover = changeover; + Tcl_InitObjRef(ltzoc->tzName, fields->tzName); /* may be NULL */ + } + ltzoc->localSeconds = fields->localSeconds; + ltzoc->rangesVal[0] = rangesVal[0]; + ltzoc->rangesVal[1] = rangesVal[1]; + ltzoc->tzOffset = fields->tzOffset; + } + + + /* check DST-hole: if retrieved seconds is out of range */ + if ( ltzoc->rangesVal[0] > seconds || seconds >= ltzoc->rangesVal[1] ) { + dstHole: + #if 0 + printf("given local-time is outside the time-zone (in DST-hole): " + "%d - offs %d => %d <= %d < %d\n", + (int)fields->localSeconds, fields->tzOffset, + (int)ltzoc->rangesVal[0], (int)seconds, (int)ltzoc->rangesVal[1]); + #endif + /* because we don't know real TZ (we're outsize), just invalidate local + * time (which could be verified in ClockValidDate later) */ + fields->localSeconds = TCL_INV_SECONDS; /* not valid seconds */ + } return TCL_OK; } @@ -1983,10 +2010,12 @@ ConvertLocalToUTCUsingTable( Tcl_Obj *row; int cellc; Tcl_Obj **cellv; - int have[8]; + struct { + Tcl_Obj *tzName; + int tzOffset; + } have[8]; int nHave = 0; int i; - int found; /* * Perform an initial lookup assuming that local == UTC, and locate the @@ -1998,10 +2027,9 @@ ConvertLocalToUTCUsingTable( * Saving Time transition. */ - found = 0; fields->tzOffset = 0; fields->seconds = fields->localSeconds; - while (!found) { + while (1) { row = LookupLastTransition(interp, fields->seconds, rowc, rowv, rangesVal); if ((row == NULL) @@ -2011,57 +2039,23 @@ ConvertLocalToUTCUsingTable( &fields->tzOffset) != TCL_OK) { return TCL_ERROR; } - found = 0; - for (i = 0; !found && i < nHave; ++i) { - if (have[i] == fields->tzOffset) { - found = 1; - break; + for (i = 0; i < nHave; ++i) { + if (have[i].tzOffset == fields->tzOffset) { + goto found; } } - if (!found) { - if (nHave == 8) { - Tcl_Panic("loop in ConvertLocalToUTCUsingTable"); - } - have[nHave++] = fields->tzOffset; + if (nHave == 8) { + Tcl_Panic("loop in ConvertLocalToUTCUsingTable"); } + have[nHave].tzName = cellv[3]; + have[nHave++].tzOffset = fields->tzOffset; fields->seconds = fields->localSeconds - fields->tzOffset; } - fields->tzOffset = have[i]; - fields->seconds = fields->localSeconds - fields->tzOffset; -#if 0 - /* currently unused, test purposes only */ - /* - * Convert back from UTC, if local times are different - wrong local time - * (local time seems to be in between DST-hole). - */ - if (fields->tzOffset) { - - int corrOffset; - Tcl_WideInt backCompVal; - /* check DST-hole interval contains UTC time */ - TclGetWideIntFromObj(NULL, cellv[0], &backCompVal); - if ( fields->seconds >= backCompVal - fields->tzOffset - && fields->seconds <= backCompVal + fields->tzOffset - ) { - row = LookupLastTransition(interp, fields->seconds, rowc, rowv); - if (row == NULL || - TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK || - TclGetIntFromObj(interp, cellv[1], &corrOffset) != TCL_OK) { - return TCL_ERROR; - } - if (fields->localSeconds != fields->seconds + corrOffset) { - Tcl_Panic("wrong local time %ld by LocalToUTC conversion," - " local time seems to be in between DST-hole", - fields->localSeconds); - /* correcting offset * / - fields->tzOffset -= corrOffset; - fields->seconds += fields->tzOffset; - */ - } - } - } -#endif + found: + fields->tzOffset = have[i].tzOffset; + fields->seconds = fields->localSeconds - fields->tzOffset; + Tcl_SetObjRef(fields->tzName, have[i].tzName); return TCL_OK; } @@ -2176,6 +2170,7 @@ ConvertUTCToLocal( Tcl_Obj *tzdata; /* Time zone data */ int rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ + ClockLastTZOffs * ltzoc = NULL; /* fast phase-out for shared GMT-object (don't need to convert UTC 2 UTC) */ if (timezoneObj == dataPtr->literals[LIT_GMT]) { @@ -2196,20 +2191,23 @@ ConvertUTCToLocal( /* * Check cacheable conversion could be used - * (last-period UTC2Local cache within the same TZ) + * (last-period UTC2Local cache within the same TZ and seconds) */ - if ( timezoneObj == dataPtr->utc2local.timezoneObj - && ( fields->seconds == dataPtr->utc2local.seconds - || ( fields->seconds >= dataPtr->utc2local.rangesVal[0] - && fields->seconds < dataPtr->utc2local.rangesVal[1]) - ) - && changeover == dataPtr->utc2local.changeover - ) { - /* the same time zone and offset (UTC time inside the last minute) */ - Tcl_SetObjRef(fields->tzName, dataPtr->utc2local.tzName); - fields->tzOffset = dataPtr->utc2local.tzOffset; - fields->localSeconds = fields->seconds + fields->tzOffset; - return TCL_OK; + for (rowc = 0; rowc < 2; rowc++) { + ltzoc = &dataPtr->lastTZOffsCache[rowc]; + if (timezoneObj != ltzoc->timezoneObj || changeover != ltzoc->changeover) { + ltzoc = NULL; + continue; + } + if ( fields->seconds >= ltzoc->rangesVal[0] + && fields->seconds < ltzoc->rangesVal[1] + ) { + /* the same time zone and offset (UTC time inside the last minute) */ + fields->tzOffset = ltzoc->tzOffset; + fields->localSeconds = fields->seconds + fields->tzOffset; + Tcl_SetObjRef(fields->tzName, ltzoc->tzName); + return TCL_OK; + } } /* @@ -2231,25 +2229,40 @@ ConvertUTCToLocal( */ if (rowc == 0) { - dataPtr->utc2local.rangesVal[0] = 0; - dataPtr->utc2local.rangesVal[1] = 0; if (ConvertUTCToLocalUsingC(interp, fields, changeover) != TCL_OK) { return TCL_ERROR; } + + /* we cannot cache (ranges unknown yet) */ } else { + Tcl_WideInt rangesVal[2]; + if (ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv, - dataPtr->utc2local.rangesVal) != TCL_OK) { + rangesVal) != TCL_OK) { return TCL_ERROR; } + + /* Cache the last conversion */ + if (ltzoc != NULL) { /* slot was found above */ + /* timezoneObj and changeover are the same */ + Tcl_SetObjRef(ltzoc->tzName, fields->tzName); + } else { + /* no TZ in cache - just move second slot down and use the first one */ + ltzoc = &dataPtr->lastTZOffsCache[0]; + Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].timezoneObj); + Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].tzName); + memcpy(&dataPtr->lastTZOffsCache[1], ltzoc, sizeof(*ltzoc)); + Tcl_InitObjRef(ltzoc->timezoneObj, timezoneObj); + ltzoc->changeover = changeover; + Tcl_InitObjRef(ltzoc->tzName, fields->tzName); + } + ltzoc->localSeconds = fields->localSeconds; + ltzoc->rangesVal[0] = rangesVal[0]; + ltzoc->rangesVal[1] = rangesVal[1]; + ltzoc->tzOffset = fields->tzOffset; } - /* Cache the last conversion */ - Tcl_SetObjRef(dataPtr->utc2local.timezoneObj, timezoneObj); - dataPtr->utc2local.seconds = fields->seconds; - dataPtr->utc2local.changeover = changeover; - dataPtr->utc2local.tzOffset = fields->tzOffset; - Tcl_SetObjRef(dataPtr->utc2local.tzName, fields->tzName); return TCL_OK; } @@ -2421,7 +2434,7 @@ LookupLastTransition( int l = 0; int u; Tcl_Obj *compObj; - Tcl_WideInt compVal, fromVal = tick, toVal = tick; + Tcl_WideInt compVal, fromVal = LLONG_MIN, toVal = LLONG_MAX; /* * Examine the first row to make sure we're in bounds. @@ -2437,7 +2450,7 @@ LookupLastTransition( * anyway. */ - if (tick < compVal) { + if (tick < (fromVal = compVal)) { if (rangesVal) { rangesVal[0] = fromVal; rangesVal[1] = toVal; @@ -3422,7 +3435,7 @@ ClockParseFmtScnArgs( */ if ( baseObj->typePtr == &tclBignumType - || baseVal < -0x00F0000000000000L || baseVal > 0x00F0000000000000L + || baseVal < TCL_MIN_SECONDS || baseVal > TCL_MAX_SECONDS ) { Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); return TCL_ERROR; @@ -3760,8 +3773,15 @@ ClockValidDate( const char *errMsg = "", *errCode = ""; TclDateFields temp; int tempCpyFlg = 0; + ClockClientData *dataPtr = opts->clientData; - // printf("yyMonth %d, yyDay %d, yyDayOfYear %d, yyHour %d, yyMinutes %d, yySeconds %d\n", yyMonth, yyDay, yydate.dayOfYear, yyHour, yyMinutes, yySeconds); + #if 0 + printf("yyMonth %d, yyDay %d, yyDayOfYear %d, yyHour %d, yyMinutes %d, yySeconds %d, " + "yySecondOfDay %d, sec %d, daySec %d, tzOffset %d\n", + yyMonth, yyDay, yydate.dayOfYear, yyHour, yyMinutes, yySeconds, + yySecondOfDay, (int)yydate.localSeconds, (int)(yydate.localSeconds % SECONDS_PER_DAY), + yydate.tzOffset); + #endif if (!(stage & 1)) { goto stage_2; @@ -3769,8 +3789,6 @@ ClockValidDate( /* first year (used later in hath / daysInPriorMonths) */ if ((info->flags & (CLF_YEAR|CLF_ISO8601YEAR)) || yyHaveDate) { - ClockClientData *dataPtr = opts->clientData; - if ((info->flags & CLF_ISO8601YEAR)) { if ( yydate.iso8601Year < dataPtr->validMinYear || yydate.iso8601Year > dataPtr->validMaxYear ) { @@ -3853,10 +3871,26 @@ ClockValidDate( } /* - * Further tests expected ready calculated julianDay (inclusive relative) + * Further tests expected ready calculated julianDay (inclusive relative), + * and time-zone conversion (local to UTC time). */ stage_2: + /* time, regarding the modifications by the time-zone (looks for given time + * in between DST-time hole, so does not exist in this time-zone) */ + if (((info->flags & CLF_TIME) || yyHaveTime)) { + /* + * we don't need to do the backwards time-conversion (UTC to local) and + * compare results, because the after conversion (local to UTC) we + * should have valid localSeconds (was not invalidated to TCL_INV_SECONDS), + * so if it was invalidated - invalid time, outside the time-zone (in DST-hole) + */ + if ( yydate.localSeconds == TCL_INV_SECONDS ) { + errMsg = "invalid time (does not exist in this time-zone)"; + errCode = "out-of-time"; goto error; + } + } + /* day of week */ if (info->flags & CLF_DAYOFWEEK) { if (!tempCpyFlg) { diff --git a/generic/tclDate.h b/generic/tclDate.h index 1054b145..55eb331 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -56,6 +56,10 @@ CLF_MONTH | CLF_YEAR | CLF_ISO8601YEAR | \ CLF_DAYOFWEEK | CLF_ISO8601WEAK) +#define TCL_MIN_SECONDS -0x00F0000000000000L +#define TCL_MAX_SECONDS 0x00F0000000000000L +#define TCL_INV_SECONDS (TCL_MIN_SECONDS-1) + /* * Enumeration of the string literals used in [clock] */ @@ -274,6 +278,18 @@ typedef struct ClockFmtScnCmdArgs { Tcl_Obj *mcDictObj; /* Current dictionary of tcl::clock package for given localeObj*/ } ClockFmtScnCmdArgs; +/* Last-period cache for fast UTC to local and backwards conversion */ +typedef struct ClockLastTZOffs { + /* keys */ + Tcl_Obj *timezoneObj; + int changeover; + Tcl_WideInt localSeconds; + Tcl_WideInt rangesVal[2]; /* Bounds for cached time zone offset */ + /* values */ + int tzOffset; + Tcl_Obj *tzName; /* Name (abbreviation) of this area in TZ */ +} ClockLastTZOffs; + /* * Structure containing the client data for [clock] */ @@ -294,6 +310,7 @@ typedef struct ClockClientData { int yearOfCenturySwitch; int validMinYear; int validMaxYear; + Tcl_Obj *systemTimeZone; Tcl_Obj *systemSetupTZData; Tcl_Obj *gmtSetupTimeZoneUnnorm; @@ -306,7 +323,7 @@ typedef struct ClockClientData { Tcl_Obj *prevSetupTimeZoneUnnorm; Tcl_Obj *prevSetupTimeZone; Tcl_Obj *prevSetupTZData; - + Tcl_Obj *defaultLocale; Tcl_Obj *defaultLocaleDict; Tcl_Obj *currentLocale; @@ -323,27 +340,9 @@ typedef struct ClockClientData { Tcl_Obj *timezoneObj; TclDateFields date; } lastBase; - /* Las-period cache for fast UTC2Local conversion */ - struct { - /* keys */ - Tcl_Obj *timezoneObj; - int changeover; - Tcl_WideInt seconds; - Tcl_WideInt rangesVal[2]; /* Bounds for cached time zone offset */ - /* values */ - int tzOffset; - Tcl_Obj *tzName; - } utc2local; - /* Las-period cache for fast local2utc conversion */ - struct { - /* keys */ - Tcl_Obj *timezoneObj; - int changeover; - Tcl_WideInt localSeconds; - Tcl_WideInt rangesVal[2]; /* Bounds for cached time zone offset */ - /* values */ - int tzOffset; - } local2utc; + + /* Last-period cache for fast UTC to Local and backwards conversion */ + ClockLastTZOffs lastTZOffsCache[2]; int defFlags; /* Default flags (from configure), ATM * only CLF_VALIDATE supported */ -- cgit v0.12 From 9931564ea5b0968f70fcf434405bb6712c82df73 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 8 Oct 2018 14:08:05 +0000 Subject: tclGetDate.y: added missing semicolon, tclDate.c rebuilt using Bison 3.1; resolves warning "maybe-uninitialized" by `*++yyvsp = yylval;` --- generic/tclDate.c | 1789 +++++++++++++++++++++++++------------------------- generic/tclGetDate.y | 4 +- 2 files changed, 894 insertions(+), 899 deletions(-) diff --git a/generic/tclDate.c b/generic/tclDate.c index a48f5fa..165f911 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -1,20 +1,19 @@ -/* A Bison parser, made by GNU Bison 2.4.2. */ +/* A Bison parser, made by GNU Bison 3.1. */ + +/* Bison implementation for Yacc-like parsers in C + + Copyright (C) 1984, 1989-1990, 2000-2015, 2018 Free Software Foundation, Inc. -/* Skeleton implementation for Bison's Yacc-like parsers in C - - Copyright (C) 1984, 1989-1990, 2000-2006, 2009-2010 Free Software - Foundation, Inc. - This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. - + This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. - + You should have received a copy of the GNU General Public License along with this program. If not, see . */ @@ -27,7 +26,7 @@ special exception, which will cause the skeleton and the resulting Bison output files to be licensed under the GNU General Public License without this special exception. - + This special exception was added by the Free Software Foundation in version 2.2 of Bison. */ @@ -45,7 +44,7 @@ #define YYBISON 1 /* Bison version. */ -#define YYBISON_VERSION "2.4.2" +#define YYBISON_VERSION "3.1" /* Skeleton name. */ #define YYSKELETON_NAME "yacc.c" @@ -59,18 +58,14 @@ /* Pull parsers. */ #define YYPULL 1 -/* Using locations. */ -#define YYLSP_NEEDED 1 /* Substitute the variable and function names. */ #define yyparse TclDateparse #define yylex TclDatelex #define yyerror TclDateerror -#define yylval TclDatelval -#define yychar TclDatechar #define yydebug TclDatedebug #define yynerrs TclDatenerrs -#define yylloc TclDatelloc + /* Copy the first part of user declarations. */ @@ -149,10 +144,13 @@ typedef enum _DSTMODE { -/* Enabling traces. */ -#ifndef YYDEBUG -# define YYDEBUG 0 -#endif +# ifndef YY_NULLPTR +# if defined __cplusplus && 201103L <= __cplusplus +# define YY_NULLPTR nullptr +# else +# define YY_NULLPTR 0 +# endif +# endif /* Enabling verbose error messages. */ #ifdef YYERROR_VERBOSE @@ -162,44 +160,46 @@ typedef enum _DSTMODE { # define YYERROR_VERBOSE 0 #endif -/* Enabling the token table. */ -#ifndef YYTOKEN_TABLE -# define YYTOKEN_TABLE 0 -#endif +/* Debug traces. */ +#ifndef YYDEBUG +# define YYDEBUG 0 +#endif +#if YYDEBUG +extern int TclDatedebug; +#endif -/* Tokens. */ +/* Token type. */ #ifndef YYTOKENTYPE # define YYTOKENTYPE - /* Put the tokens into the symbol table, so that GDB and other debuggers - know about them. */ - enum yytokentype { - tAGO = 258, - tDAY = 259, - tDAYZONE = 260, - tID = 261, - tMERIDIAN = 262, - tMONTH = 263, - tMONTH_UNIT = 264, - tSTARDATE = 265, - tSEC_UNIT = 266, - tUNUMBER = 267, - tZONE = 268, - tZONEwO4 = 269, - tZONEwO2 = 270, - tEPOCH = 271, - tDST = 272, - tISOBASE = 273, - tDAY_UNIT = 274, - tNEXT = 275, - SP = 276 - }; + enum yytokentype + { + tAGO = 258, + tDAY = 259, + tDAYZONE = 260, + tID = 261, + tMERIDIAN = 262, + tMONTH = 263, + tMONTH_UNIT = 264, + tSTARDATE = 265, + tSEC_UNIT = 266, + tUNUMBER = 267, + tZONE = 268, + tZONEwO4 = 269, + tZONEwO2 = 270, + tEPOCH = 271, + tDST = 272, + tISOBASE = 273, + tDAY_UNIT = 274, + tNEXT = 275, + SP = 276 + }; #endif - - +/* Value type. */ #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED -typedef union YYSTYPE + +union YYSTYPE { @@ -207,27 +207,33 @@ typedef union YYSTYPE enum _MERIDIAN Meridian; +}; -} YYSTYPE; +typedef union YYSTYPE YYSTYPE; # define YYSTYPE_IS_TRIVIAL 1 -# define yystype YYSTYPE /* obsolescent; will be withdrawn */ # define YYSTYPE_IS_DECLARED 1 #endif +/* Location type. */ #if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED -typedef struct YYLTYPE +typedef struct YYLTYPE YYLTYPE; +struct YYLTYPE { int first_line; int first_column; int last_line; int last_column; -} YYLTYPE; -# define yyltype YYLTYPE /* obsolescent; will be withdrawn */ +}; # define YYLTYPE_IS_DECLARED 1 # define YYLTYPE_IS_TRIVIAL 1 #endif + +int TclDateparse (DateInfo* info); + + + /* Copy the second part of user declarations. */ @@ -258,23 +264,20 @@ typedef unsigned char yytype_uint8; #ifdef YYTYPE_INT8 typedef YYTYPE_INT8 yytype_int8; -#elif (defined __STDC__ || defined __C99__FUNC__ \ - || defined __cplusplus || defined _MSC_VER) -typedef signed char yytype_int8; #else -typedef short int yytype_int8; +typedef signed char yytype_int8; #endif #ifdef YYTYPE_UINT16 typedef YYTYPE_UINT16 yytype_uint16; #else -typedef unsigned short int yytype_uint16; +typedef unsigned short yytype_uint16; #endif #ifdef YYTYPE_INT16 typedef YYTYPE_INT16 yytype_int16; #else -typedef short int yytype_int16; +typedef short yytype_int16; #endif #ifndef YYSIZE_T @@ -282,12 +285,11 @@ typedef short int yytype_int16; # define YYSIZE_T __SIZE_TYPE__ # elif defined size_t # define YYSIZE_T size_t -# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \ - || defined __cplusplus || defined _MSC_VER) +# elif ! defined YYSIZE_T # include /* INFRINGES ON USER NAME SPACE */ # define YYSIZE_T size_t # else -# define YYSIZE_T unsigned int +# define YYSIZE_T unsigned # endif #endif @@ -297,39 +299,68 @@ typedef short int yytype_int16; # if defined YYENABLE_NLS && YYENABLE_NLS # if ENABLE_NLS # include /* INFRINGES ON USER NAME SPACE */ -# define YY_(msgid) dgettext ("bison-runtime", msgid) +# define YY_(Msgid) dgettext ("bison-runtime", Msgid) # endif # endif # ifndef YY_ -# define YY_(msgid) msgid +# define YY_(Msgid) Msgid +# endif +#endif + +#ifndef YY_ATTRIBUTE +# if (defined __GNUC__ \ + && (2 < __GNUC__ || (__GNUC__ == 2 && 96 <= __GNUC_MINOR__))) \ + || defined __SUNPRO_C && 0x5110 <= __SUNPRO_C +# define YY_ATTRIBUTE(Spec) __attribute__(Spec) +# else +# define YY_ATTRIBUTE(Spec) /* empty */ +# endif +#endif + +#ifndef YY_ATTRIBUTE_PURE +# define YY_ATTRIBUTE_PURE YY_ATTRIBUTE ((__pure__)) +#endif + +#ifndef YY_ATTRIBUTE_UNUSED +# define YY_ATTRIBUTE_UNUSED YY_ATTRIBUTE ((__unused__)) +#endif + +#if !defined _Noreturn \ + && (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112) +# if defined _MSC_VER && 1200 <= _MSC_VER +# define _Noreturn __declspec (noreturn) +# else +# define _Noreturn YY_ATTRIBUTE ((__noreturn__)) # endif #endif /* Suppress unused-variable warnings by "using" E. */ #if ! defined lint || defined __GNUC__ -# define YYUSE(e) ((void) (e)) +# define YYUSE(E) ((void) (E)) #else -# define YYUSE(e) /* empty */ +# define YYUSE(E) /* empty */ #endif -/* Identity function, used to suppress warnings about constant conditions. */ -#ifndef lint -# define YYID(n) (n) +#if defined __GNUC__ && ! defined __ICC && 407 <= __GNUC__ * 100 + __GNUC_MINOR__ +/* Suppress an incorrect diagnostic about yylval being uninitialized. */ +# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ + _Pragma ("GCC diagnostic push") \ + _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"")\ + _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"") +# define YY_IGNORE_MAYBE_UNINITIALIZED_END \ + _Pragma ("GCC diagnostic pop") #else -#if (defined __STDC__ || defined __C99__FUNC__ \ - || defined __cplusplus || defined _MSC_VER) -static int -YYID (int yyi) -#else -static int -YYID (yyi) - int yyi; +# define YY_INITIAL_VALUE(Value) Value #endif -{ - return yyi; -} +#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN +# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN +# define YY_IGNORE_MAYBE_UNINITIALIZED_END +#endif +#ifndef YY_INITIAL_VALUE +# define YY_INITIAL_VALUE(Value) /* Nothing. */ #endif + #if ! defined yyoverflow || YYERROR_VERBOSE /* The parser invokes alloca or malloc; define the necessary symbols. */ @@ -347,11 +378,11 @@ YYID (yyi) # define alloca _alloca # else # define YYSTACK_ALLOC alloca -# if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \ - || defined __cplusplus || defined _MSC_VER) +# if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS # include /* INFRINGES ON USER NAME SPACE */ -# ifndef _STDLIB_H -# define _STDLIB_H 1 + /* Use EXIT_SUCCESS as a witness for stdlib.h. */ +# ifndef EXIT_SUCCESS +# define EXIT_SUCCESS 0 # endif # endif # endif @@ -359,8 +390,8 @@ YYID (yyi) # endif # ifdef YYSTACK_ALLOC - /* Pacify GCC's `empty if-body' warning. */ -# define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0)) + /* Pacify GCC's 'empty if-body' warning. */ +# define YYSTACK_FREE(Ptr) do { /* empty */; } while (0) # ifndef YYSTACK_ALLOC_MAXIMUM /* The OS might guarantee only one guard page at the bottom of the stack, and a page size can be as small as 4096 bytes. So we cannot safely @@ -374,25 +405,23 @@ YYID (yyi) # ifndef YYSTACK_ALLOC_MAXIMUM # define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM # endif -# if (defined __cplusplus && ! defined _STDLIB_H \ +# if (defined __cplusplus && ! defined EXIT_SUCCESS \ && ! ((defined YYMALLOC || defined malloc) \ - && (defined YYFREE || defined free))) + && (defined YYFREE || defined free))) # include /* INFRINGES ON USER NAME SPACE */ -# ifndef _STDLIB_H -# define _STDLIB_H 1 +# ifndef EXIT_SUCCESS +# define EXIT_SUCCESS 0 # endif # endif # ifndef YYMALLOC # define YYMALLOC malloc -# if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \ - || defined __cplusplus || defined _MSC_VER) +# if ! defined malloc && ! defined EXIT_SUCCESS void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ # endif # endif # ifndef YYFREE # define YYFREE free -# if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \ - || defined __cplusplus || defined _MSC_VER) +# if ! defined free && ! defined EXIT_SUCCESS void free (void *); /* INFRINGES ON USER NAME SPACE */ # endif # endif @@ -402,8 +431,8 @@ void free (void *); /* INFRINGES ON USER NAME SPACE */ #if (! defined yyoverflow \ && (! defined __cplusplus \ - || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \ - && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) + || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \ + && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) /* A type that is properly aligned for any stack member. */ union yyalloc @@ -422,42 +451,46 @@ union yyalloc ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE) + sizeof (YYLTYPE)) \ + 2 * YYSTACK_GAP_MAXIMUM) -/* Copy COUNT objects from FROM to TO. The source and destination do - not overlap. */ -# ifndef YYCOPY -# if defined __GNUC__ && 1 < __GNUC__ -# define YYCOPY(To, From, Count) \ - __builtin_memcpy (To, From, (Count) * sizeof (*(From))) -# else -# define YYCOPY(To, From, Count) \ - do \ - { \ - YYSIZE_T yyi; \ - for (yyi = 0; yyi < (Count); yyi++) \ - (To)[yyi] = (From)[yyi]; \ - } \ - while (YYID (0)) -# endif -# endif +# define YYCOPY_NEEDED 1 /* Relocate STACK from its old location to the new one. The local variables YYSIZE and YYSTACKSIZE give the old and new number of elements in the stack, and YYPTR gives the new location of the stack. Advance YYPTR to a properly aligned location for the next stack. */ -# define YYSTACK_RELOCATE(Stack_alloc, Stack) \ - do \ - { \ - YYSIZE_T yynewbytes; \ - YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ - Stack = &yyptr->Stack_alloc; \ - yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ - yyptr += yynewbytes / sizeof (*yyptr); \ - } \ - while (YYID (0)) +# define YYSTACK_RELOCATE(Stack_alloc, Stack) \ + do \ + { \ + YYSIZE_T yynewbytes; \ + YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ + Stack = &yyptr->Stack_alloc; \ + yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ + yyptr += yynewbytes / sizeof (*yyptr); \ + } \ + while (0) #endif +#if defined YYCOPY_NEEDED && YYCOPY_NEEDED +/* Copy COUNT objects from SRC to DST. The source and destination do + not overlap. */ +# ifndef YYCOPY +# if defined __GNUC__ && 1 < __GNUC__ +# define YYCOPY(Dst, Src, Count) \ + __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src))) +# else +# define YYCOPY(Dst, Src, Count) \ + do \ + { \ + YYSIZE_T yyi; \ + for (yyi = 0; yyi < (Count); yyi++) \ + (Dst)[yyi] = (Src)[yyi]; \ + } \ + while (0) +# endif +# endif +#endif /* !YYCOPY_NEEDED */ + /* YYFINAL -- State number of the termination state. */ #define YYFINAL 2 /* YYLAST -- Last index in YYTABLE. */ @@ -469,17 +502,19 @@ union yyalloc #define YYNNTS 18 /* YYNRULES -- Number of rules. */ #define YYNRULES 66 -/* YYNRULES -- Number of states. */ +/* YYNSTATES -- Number of states. */ #define YYNSTATES 106 -/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX. */ +/* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned + by yylex, with out-of-bounds checking. */ #define YYUNDEFTOK 2 #define YYMAXUTOK 276 -#define YYTRANSLATE(YYX) \ - ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) +#define YYTRANSLATE(YYX) \ + ((unsigned) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) -/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX. */ +/* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM + as returned by yylex, without out-of-bounds checking. */ static const yytype_uint8 yytranslate[] = { 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -513,47 +548,7 @@ static const yytype_uint8 yytranslate[] = }; #if YYDEBUG -/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in - YYRHS. */ -static const yytype_uint8 yyprhs[] = -{ - 0, 0, 3, 4, 7, 11, 13, 15, 17, 19, - 21, 23, 25, 27, 29, 32, 37, 44, 47, 49, - 51, 55, 59, 62, 64, 67, 69, 72, 75, 80, - 84, 87, 91, 97, 99, 105, 111, 114, 119, 122, - 124, 128, 131, 135, 139, 142, 150, 158, 162, 167, - 170, 172, 177, 181, 184, 187, 191, 193, 195, 197, - 199, 201, 203, 205, 207, 209, 210 -}; - -/* YYRHS -- A `-1'-separated list of the rules' RHS. */ -static const yytype_int8 yyrhs[] = -{ - 29, 0, -1, -1, 29, 30, -1, 29, 21, 30, - -1, 31, -1, 32, -1, 35, -1, 36, -1, 34, - -1, 39, -1, 37, -1, 38, -1, 44, -1, 12, - 7, -1, 12, 22, 12, 45, -1, 12, 22, 12, - 22, 12, 45, -1, 13, 17, -1, 13, -1, 5, - -1, 14, 41, 43, -1, 15, 41, 43, -1, 41, - 43, -1, 23, -1, 23, 21, -1, 4, -1, 4, - 33, -1, 12, 4, -1, 41, 21, 12, 4, -1, - 41, 12, 4, -1, 20, 4, -1, 12, 24, 12, - -1, 12, 24, 12, 24, 12, -1, 18, -1, 12, - 25, 8, 25, 12, -1, 12, 25, 12, 25, 12, - -1, 8, 12, -1, 8, 12, 33, 12, -1, 12, - 8, -1, 16, -1, 12, 8, 12, -1, 20, 8, - -1, 20, 12, 8, -1, 18, 13, 18, -1, 18, - 18, -1, 18, 21, 12, 22, 12, 22, 12, -1, - 18, 13, 12, 22, 12, 22, 12, -1, 18, 21, - 18, -1, 10, 43, 26, 12, -1, 40, 3, -1, - 40, -1, 41, 21, 43, 42, -1, 41, 43, 42, - -1, 43, 42, -1, 20, 42, -1, 20, 43, 42, - -1, 42, -1, 25, -1, 27, -1, 11, -1, 19, - -1, 9, -1, 12, -1, 18, -1, 43, -1, -1, - 7, -1 -}; - -/* YYRLINE[YYN] -- source line where rule number YYN was defined. */ + /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_uint16 yyrline[] = { 0, 160, 160, 161, 162, 165, 168, 171, 174, 177, @@ -566,7 +561,7 @@ static const yytype_uint16 yyrline[] = }; #endif -#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE +#if YYDEBUG || YYERROR_VERBOSE || 0 /* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. First, the terminals, then, starting at YYNTOKENS, nonterminals. */ static const char *const yytname[] = @@ -577,13 +572,13 @@ static const char *const yytname[] = "tISOBASE", "tDAY_UNIT", "tNEXT", "SP", "':'", "','", "'/'", "'-'", "'.'", "'+'", "$accept", "spec", "item", "time", "zone", "comma", "day", "date", "ordMonth", "iso", "trek", "relspec", "relunits", "sign", "unit", - "INTNUM", "number", "o_merid", 0 + "INTNUM", "number", "o_merid", YY_NULLPTR }; #endif # ifdef YYPRINT -/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to - token YYLEX-NUM. */ +/* YYTOKNUM[NUM] -- (External) token number corresponding to the + (internal) symbol number NUM (which must be that of a token). */ static const yytype_uint16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, @@ -592,58 +587,18 @@ static const yytype_uint16 yytoknum[] = }; # endif -/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ -static const yytype_uint8 yyr1[] = -{ - 0, 28, 29, 29, 29, 30, 30, 30, 30, 30, - 30, 30, 30, 30, 31, 31, 31, 32, 32, 32, - 32, 32, 32, 33, 33, 34, 34, 34, 34, 34, - 34, 35, 35, 35, 35, 35, 35, 35, 35, 35, - 35, 36, 36, 37, 37, 37, 37, 37, 38, 39, - 39, 40, 40, 40, 40, 40, 40, 41, 41, 42, - 42, 42, 43, 43, 44, 45, 45 -}; +#define YYPACT_NINF -17 -/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN. */ -static const yytype_uint8 yyr2[] = -{ - 0, 2, 0, 2, 3, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 2, 4, 6, 2, 1, 1, - 3, 3, 2, 1, 2, 1, 2, 2, 4, 3, - 2, 3, 5, 1, 5, 5, 2, 4, 2, 1, - 3, 2, 3, 3, 2, 7, 7, 3, 4, 2, - 1, 4, 3, 2, 2, 3, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 0, 1 -}; +#define yypact_value_is_default(Yystate) \ + (!!((Yystate) == (-17))) -/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state - STATE-NUM when YYTABLE doesn't specify something else to do. Zero - means the default is an error. */ -static const yytype_uint8 yydefact[] = -{ - 2, 0, 1, 25, 19, 0, 61, 0, 59, 62, - 18, 0, 0, 39, 33, 60, 0, 0, 57, 58, - 3, 5, 6, 9, 7, 8, 11, 12, 10, 50, - 0, 56, 64, 13, 23, 26, 36, 62, 63, 0, - 27, 14, 38, 0, 0, 0, 17, 0, 0, 0, - 44, 0, 30, 41, 62, 54, 0, 4, 49, 62, - 0, 22, 53, 24, 0, 0, 40, 65, 31, 0, - 0, 20, 21, 0, 43, 0, 47, 42, 55, 29, - 62, 0, 52, 37, 48, 66, 0, 15, 0, 0, - 0, 0, 0, 28, 51, 65, 32, 34, 35, 0, - 0, 16, 0, 0, 46, 45 -}; +#define YYTABLE_NINF -1 -/* YYDEFGOTO[NTERM-NUM]. */ -static const yytype_int8 yydefgoto[] = -{ - -1, 1, 20, 21, 22, 35, 23, 24, 25, 26, - 27, 28, 29, 30, 31, 32, 33, 87 -}; +#define yytable_value_is_error(Yytable_value) \ + 0 -/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing - STATE-NUM. */ -#define YYPACT_NINF -17 + /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing + STATE-NUM. */ static const yytype_int8 yypact[] = { -17, 48, -17, -9, -17, 34, -17, 19, -17, -2, @@ -659,18 +614,41 @@ static const yytype_int8 yypact[] = 88, -17, 99, 100, -17, -17 }; -/* YYPGOTO[NTERM-NUM]. */ + /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. + Performed when YYTABLE does not specify something else to do. Zero + means the default is an error. */ +static const yytype_uint8 yydefact[] = +{ + 2, 0, 1, 25, 19, 0, 61, 0, 59, 62, + 18, 0, 0, 39, 33, 60, 0, 0, 57, 58, + 3, 5, 6, 9, 7, 8, 11, 12, 10, 50, + 0, 56, 64, 13, 23, 26, 36, 62, 63, 0, + 27, 14, 38, 0, 0, 0, 17, 0, 0, 0, + 44, 0, 30, 41, 62, 54, 0, 4, 49, 62, + 0, 22, 53, 24, 0, 0, 40, 65, 31, 0, + 0, 20, 21, 0, 43, 0, 47, 42, 55, 29, + 62, 0, 52, 37, 48, 66, 0, 15, 0, 0, + 0, 0, 0, 28, 51, 65, 32, 34, 35, 0, + 0, 16, 0, 0, 46, 45 +}; + + /* YYPGOTO[NTERM-NUM]. */ static const yytype_int8 yypgoto[] = { -17, -17, 96, -17, -17, 79, -17, -17, -17, -17, -17, -17, -17, 22, -16, -6, -17, 21 }; -/* YYTABLE[YYPACT[STATE-NUM]]. What to do in state STATE-NUM. If - positive, shift that token. If negative, reduce the rule which - number is the opposite. If zero, do what YYDEFACT says. - If YYTABLE_NINF, syntax error. */ -#define YYTABLE_NINF -1 + /* YYDEFGOTO[NTERM-NUM]. */ +static const yytype_int8 yydefgoto[] = +{ + -1, 1, 20, 21, 22, 35, 23, 24, 25, 26, + 27, 28, 29, 30, 31, 32, 33, 87 +}; + + /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If + positive, shift that token. If negative, reduce the rule whose + number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_uint8 yytable[] = { 55, 39, 40, 69, 52, 41, 42, 70, 53, 6, @@ -703,8 +681,8 @@ static const yytype_int8 yycheck[] = 22, 12, 12, 17, -1, 36, 95 }; -/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing - symbol of state STATE-NUM. */ + /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing + symbol of state STATE-NUM. */ static const yytype_uint8 yystos[] = { 0, 29, 0, 4, 5, 8, 9, 10, 11, 12, @@ -720,80 +698,106 @@ static const yytype_uint8 yystos[] = 12, 45, 22, 22, 12, 12 }; -#define yyerrok (yyerrstatus = 0) -#define yyclearin (yychar = YYEMPTY) -#define YYEMPTY (-2) -#define YYEOF 0 - -#define YYACCEPT goto yyacceptlab -#define YYABORT goto yyabortlab -#define YYERROR goto yyerrorlab - - -/* Like YYERROR except do call yyerror. This remains here temporarily - to ease the transition to the new meaning of YYERROR, for GCC. - Once GCC version 2 has supplanted version 1, this can go. However, - YYFAIL appears to be in use. Nevertheless, it is formally deprecated - in Bison 2.4.2's NEWS entry, where a plan to phase it out is - discussed. */ - -#define YYFAIL goto yyerrlab -#if defined YYFAIL - /* This is here to suppress warnings from the GCC cpp's - -Wunused-macros. Normally we don't worry about that warning, but - some users do, and we want to make it easy for users to remove - YYFAIL uses, which will produce warnings from Bison 2.5. */ -#endif + /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ +static const yytype_uint8 yyr1[] = +{ + 0, 28, 29, 29, 29, 30, 30, 30, 30, 30, + 30, 30, 30, 30, 31, 31, 31, 32, 32, 32, + 32, 32, 32, 33, 33, 34, 34, 34, 34, 34, + 34, 35, 35, 35, 35, 35, 35, 35, 35, 35, + 35, 36, 36, 37, 37, 37, 37, 37, 38, 39, + 39, 40, 40, 40, 40, 40, 40, 41, 41, 42, + 42, 42, 43, 43, 44, 45, 45 +}; + + /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN. */ +static const yytype_uint8 yyr2[] = +{ + 0, 2, 0, 2, 3, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 2, 4, 6, 2, 1, 1, + 3, 3, 2, 1, 2, 1, 2, 2, 4, 3, + 2, 3, 5, 1, 5, 5, 2, 4, 2, 1, + 3, 2, 3, 3, 2, 7, 7, 3, 4, 2, + 1, 4, 3, 2, 2, 3, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 0, 1 +}; + + +#define yyerrok (yyerrstatus = 0) +#define yyclearin (yychar = YYEMPTY) +#define YYEMPTY (-2) +#define YYEOF 0 + +#define YYACCEPT goto yyacceptlab +#define YYABORT goto yyabortlab +#define YYERROR goto yyerrorlab + #define YYRECOVERING() (!!yyerrstatus) -#define YYBACKUP(Token, Value) \ -do \ - if (yychar == YYEMPTY && yylen == 1) \ - { \ - yychar = (Token); \ - yylval = (Value); \ - yytoken = YYTRANSLATE (yychar); \ - YYPOPSTACK (1); \ - goto yybackup; \ - } \ - else \ - { \ +#define YYBACKUP(Token, Value) \ +do \ + if (yychar == YYEMPTY) \ + { \ + yychar = (Token); \ + yylval = (Value); \ + YYPOPSTACK (yylen); \ + yystate = *yyssp; \ + goto yybackup; \ + } \ + else \ + { \ yyerror (&yylloc, info, YY_("syntax error: cannot back up")); \ - YYERROR; \ - } \ -while (YYID (0)) - + YYERROR; \ + } \ +while (0) -#define YYTERROR 1 -#define YYERRCODE 256 +/* Error token number */ +#define YYTERROR 1 +#define YYERRCODE 256 /* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N]. If N is 0, then set CURRENT to the empty location which ends the previous symbol: RHS[0] (always defined). */ -#define YYRHSLOC(Rhs, K) ((Rhs)[K]) #ifndef YYLLOC_DEFAULT -# define YYLLOC_DEFAULT(Current, Rhs, N) \ - do \ - if (YYID (N)) \ - { \ - (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \ - (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \ - (Current).last_line = YYRHSLOC (Rhs, N).last_line; \ - (Current).last_column = YYRHSLOC (Rhs, N).last_column; \ - } \ - else \ - { \ - (Current).first_line = (Current).last_line = \ - YYRHSLOC (Rhs, 0).last_line; \ - (Current).first_column = (Current).last_column = \ - YYRHSLOC (Rhs, 0).last_column; \ - } \ - while (YYID (0)) +# define YYLLOC_DEFAULT(Current, Rhs, N) \ + do \ + if (N) \ + { \ + (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \ + (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \ + (Current).last_line = YYRHSLOC (Rhs, N).last_line; \ + (Current).last_column = YYRHSLOC (Rhs, N).last_column; \ + } \ + else \ + { \ + (Current).first_line = (Current).last_line = \ + YYRHSLOC (Rhs, 0).last_line; \ + (Current).first_column = (Current).last_column = \ + YYRHSLOC (Rhs, 0).last_column; \ + } \ + while (0) #endif +#define YYRHSLOC(Rhs, K) ((Rhs)[K]) + + +/* Enable debugging if requested. */ +#if YYDEBUG + +# ifndef YYFPRINTF +# include /* INFRINGES ON USER NAME SPACE */ +# define YYFPRINTF fprintf +# endif + +# define YYDPRINTF(Args) \ +do { \ + if (yydebug) \ + YYFPRINTF Args; \ +} while (0) + /* YY_LOCATION_PRINT -- Print the location on the stream. This macro was not mandated originally: define only if we know @@ -801,84 +805,74 @@ while (YYID (0)) #ifndef YY_LOCATION_PRINT # if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL -# define YY_LOCATION_PRINT(File, Loc) \ - fprintf (File, "%d.%d-%d.%d", \ - (Loc).first_line, (Loc).first_column, \ - (Loc).last_line, (Loc).last_column) -# else -# define YY_LOCATION_PRINT(File, Loc) ((void) 0) -# endif -#endif - -/* YYLEX -- calling `yylex' with the right arguments. */ +/* Print *YYLOCP on YYO. Private, do not rely on its existence. */ -#ifdef YYLEX_PARAM -# define YYLEX yylex (&yylval, &yylloc, YYLEX_PARAM) -#else -# define YYLEX yylex (&yylval, &yylloc, info) -#endif +YY_ATTRIBUTE_UNUSED +static unsigned +yy_location_print_ (FILE *yyo, YYLTYPE const * const yylocp) +{ + unsigned res = 0; + int end_col = 0 != yylocp->last_column ? yylocp->last_column - 1 : 0; + if (0 <= yylocp->first_line) + { + res += YYFPRINTF (yyo, "%d", yylocp->first_line); + if (0 <= yylocp->first_column) + res += YYFPRINTF (yyo, ".%d", yylocp->first_column); + } + if (0 <= yylocp->last_line) + { + if (yylocp->first_line < yylocp->last_line) + { + res += YYFPRINTF (yyo, "-%d", yylocp->last_line); + if (0 <= end_col) + res += YYFPRINTF (yyo, ".%d", end_col); + } + else if (0 <= end_col && yylocp->first_column < end_col) + res += YYFPRINTF (yyo, "-%d", end_col); + } + return res; + } -/* Enable debugging if requested. */ -#if YYDEBUG +# define YY_LOCATION_PRINT(File, Loc) \ + yy_location_print_ (File, &(Loc)) -# ifndef YYFPRINTF -# include /* INFRINGES ON USER NAME SPACE */ -# define YYFPRINTF fprintf +# else +# define YY_LOCATION_PRINT(File, Loc) ((void) 0) # endif +#endif -# define YYDPRINTF(Args) \ -do { \ - if (yydebug) \ - YYFPRINTF Args; \ -} while (YYID (0)) -# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \ -do { \ - if (yydebug) \ - { \ - YYFPRINTF (stderr, "%s ", Title); \ - yy_symbol_print (stderr, \ - Type, Value, Location, info); \ - YYFPRINTF (stderr, "\n"); \ - } \ -} while (YYID (0)) +# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \ +do { \ + if (yydebug) \ + { \ + YYFPRINTF (stderr, "%s ", Title); \ + yy_symbol_print (stderr, \ + Type, Value, Location, info); \ + YYFPRINTF (stderr, "\n"); \ + } \ +} while (0) -/*--------------------------------. -| Print this symbol on YYOUTPUT. | -`--------------------------------*/ +/*----------------------------------------. +| Print this symbol's value on YYOUTPUT. | +`----------------------------------------*/ -/*ARGSUSED*/ -#if (defined __STDC__ || defined __C99__FUNC__ \ - || defined __cplusplus || defined _MSC_VER) static void yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info) -#else -static void -yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info) - FILE *yyoutput; - int yytype; - YYSTYPE const * const yyvaluep; - YYLTYPE const * const yylocationp; - DateInfo* info; -#endif { - if (!yyvaluep) - return; + FILE *yyo = yyoutput; + YYUSE (yyo); YYUSE (yylocationp); YYUSE (info); + if (!yyvaluep) + return; # ifdef YYPRINT if (yytype < YYNTOKENS) YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); -# else - YYUSE (yyoutput); # endif - switch (yytype) - { - default: - break; - } + YYUSE (yytype); } @@ -886,24 +880,11 @@ yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info) | Print this symbol on YYOUTPUT. | `--------------------------------*/ -#if (defined __STDC__ || defined __C99__FUNC__ \ - || defined __cplusplus || defined _MSC_VER) static void yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info) -#else -static void -yy_symbol_print (yyoutput, yytype, yyvaluep, yylocationp, info) - FILE *yyoutput; - int yytype; - YYSTYPE const * const yyvaluep; - YYLTYPE const * const yylocationp; - DateInfo* info; -#endif { - if (yytype < YYNTOKENS) - YYFPRINTF (yyoutput, "token %s (", yytname[yytype]); - else - YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]); + YYFPRINTF (yyoutput, "%s %s (", + yytype < YYNTOKENS ? "token" : "nterm", yytname[yytype]); YY_LOCATION_PRINT (yyoutput, *yylocationp); YYFPRINTF (yyoutput, ": "); @@ -916,16 +897,8 @@ yy_symbol_print (yyoutput, yytype, yyvaluep, yylocationp, info) | TOP (included). | `------------------------------------------------------------------*/ -#if (defined __STDC__ || defined __C99__FUNC__ \ - || defined __cplusplus || defined _MSC_VER) static void yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop) -#else -static void -yy_stack_print (yybottom, yytop) - yytype_int16 *yybottom; - yytype_int16 *yytop; -#endif { YYFPRINTF (stderr, "Stack now"); for (; yybottom <= yytop; yybottom++) @@ -936,51 +909,42 @@ yy_stack_print (yybottom, yytop) YYFPRINTF (stderr, "\n"); } -# define YY_STACK_PRINT(Bottom, Top) \ -do { \ - if (yydebug) \ - yy_stack_print ((Bottom), (Top)); \ -} while (YYID (0)) +# define YY_STACK_PRINT(Bottom, Top) \ +do { \ + if (yydebug) \ + yy_stack_print ((Bottom), (Top)); \ +} while (0) /*------------------------------------------------. | Report that the YYRULE is going to be reduced. | `------------------------------------------------*/ -#if (defined __STDC__ || defined __C99__FUNC__ \ - || defined __cplusplus || defined _MSC_VER) static void -yy_reduce_print (YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info) -#else -static void -yy_reduce_print (yyvsp, yylsp, yyrule, info) - YYSTYPE *yyvsp; - YYLTYPE *yylsp; - int yyrule; - DateInfo* info; -#endif +yy_reduce_print (yytype_int16 *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info) { + unsigned long yylno = yyrline[yyrule]; int yynrhs = yyr2[yyrule]; int yyi; - unsigned long int yylno = yyrline[yyrule]; YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n", - yyrule - 1, yylno); + yyrule - 1, yylno); /* The symbols being reduced. */ for (yyi = 0; yyi < yynrhs; yyi++) { YYFPRINTF (stderr, " $%d = ", yyi + 1); - yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi], - &(yyvsp[(yyi + 1) - (yynrhs)]) - , &(yylsp[(yyi + 1) - (yynrhs)]) , info); + yy_symbol_print (stderr, + yystos[yyssp[yyi + 1 - yynrhs]], + &(yyvsp[(yyi + 1) - (yynrhs)]) + , &(yylsp[(yyi + 1) - (yynrhs)]) , info); YYFPRINTF (stderr, "\n"); } } -# define YY_REDUCE_PRINT(Rule) \ -do { \ - if (yydebug) \ - yy_reduce_print (yyvsp, yylsp, Rule, info); \ -} while (YYID (0)) +# define YY_REDUCE_PRINT(Rule) \ +do { \ + if (yydebug) \ + yy_reduce_print (yyssp, yyvsp, yylsp, Rule, info); \ +} while (0) /* Nonzero means print parse trace. It is left uninitialized so that multiple parsers can coexist. */ @@ -994,7 +958,7 @@ int yydebug; /* YYINITDEPTH -- initial size of the parser's stacks. */ -#ifndef YYINITDEPTH +#ifndef YYINITDEPTH # define YYINITDEPTH 200 #endif @@ -1009,7 +973,6 @@ int yydebug; # define YYMAXDEPTH 10000 #endif - #if YYERROR_VERBOSE @@ -1018,15 +981,8 @@ int yydebug; # define yystrlen strlen # else /* Return the length of YYSTR. */ -#if (defined __STDC__ || defined __C99__FUNC__ \ - || defined __cplusplus || defined _MSC_VER) static YYSIZE_T yystrlen (const char *yystr) -#else -static YYSIZE_T -yystrlen (yystr) - const char *yystr; -#endif { YYSIZE_T yylen; for (yylen = 0; yystr[yylen]; yylen++) @@ -1042,16 +998,8 @@ yystrlen (yystr) # else /* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in YYDEST. */ -#if (defined __STDC__ || defined __C99__FUNC__ \ - || defined __cplusplus || defined _MSC_VER) static char * yystpcpy (char *yydest, const char *yysrc) -#else -static char * -yystpcpy (yydest, yysrc) - char *yydest; - const char *yysrc; -#endif { char *yyd = yydest; const char *yys = yysrc; @@ -1081,27 +1029,27 @@ yytnamerr (char *yyres, const char *yystr) char const *yyp = yystr; for (;;) - switch (*++yyp) - { - case '\'': - case ',': - goto do_not_strip_quotes; - - case '\\': - if (*++yyp != '\\') - goto do_not_strip_quotes; - /* Fall through. */ - default: - if (yyres) - yyres[yyn] = *yyp; - yyn++; - break; - - case '"': - if (yyres) - yyres[yyn] = '\0'; - return yyn; - } + switch (*++yyp) + { + case '\'': + case ',': + goto do_not_strip_quotes; + + case '\\': + if (*++yyp != '\\') + goto do_not_strip_quotes; + /* Fall through. */ + default: + if (yyres) + yyres[yyn] = *yyp; + yyn++; + break; + + case '"': + if (yyres) + yyres[yyn] = '\0'; + return yyn; + } do_not_strip_quotes: ; } @@ -1112,204 +1060,189 @@ yytnamerr (char *yyres, const char *yystr) } # endif -/* Copy into YYRESULT an error message about the unexpected token - YYCHAR while in state YYSTATE. Return the number of bytes copied, - including the terminating null byte. If YYRESULT is null, do not - copy anything; just return the number of bytes that would be - copied. As a special case, return 0 if an ordinary "syntax error" - message will do. Return YYSIZE_MAXIMUM if overflow occurs during - size calculation. */ -static YYSIZE_T -yysyntax_error (char *yyresult, int yystate, int yychar) +/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message + about the unexpected token YYTOKEN for the state stack whose top is + YYSSP. + + Return 0 if *YYMSG was successfully written. Return 1 if *YYMSG is + not large enough to hold the message. In that case, also set + *YYMSG_ALLOC to the required number of bytes. Return 2 if the + required number of bytes is too large to store. */ +static int +yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg, + yytype_int16 *yyssp, int yytoken) { - int yyn = yypact[yystate]; + YYSIZE_T yysize0 = yytnamerr (YY_NULLPTR, yytname[yytoken]); + YYSIZE_T yysize = yysize0; + enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 }; + /* Internationalized format string. */ + const char *yyformat = YY_NULLPTR; + /* Arguments of yyformat. */ + char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM]; + /* Number of reported tokens (one for the "unexpected", one per + "expected"). */ + int yycount = 0; + + /* There are many possibilities here to consider: + - If this state is a consistent state with a default action, then + the only way this function was invoked is if the default action + is an error action. In that case, don't check for expected + tokens because there are none. + - The only way there can be no lookahead present (in yychar) is if + this state is a consistent state with a default action. Thus, + detecting the absence of a lookahead is sufficient to determine + that there is no unexpected or expected token to report. In that + case, just report a simple "syntax error". + - Don't assume there isn't a lookahead just because this state is a + consistent state with a default action. There might have been a + previous inconsistent state, consistent state with a non-default + action, or user semantic action that manipulated yychar. + - Of course, the expected token list depends on states to have + correct lookahead information, and it depends on the parser not + to perform extra reductions after fetching a lookahead from the + scanner and before detecting a syntax error. Thus, state merging + (from LALR or IELR) and default reductions corrupt the expected + token list. However, the list is correct for canonical LR with + one exception: it will still contain any token that will not be + accepted due to an error action in a later state. + */ + if (yytoken != YYEMPTY) + { + int yyn = yypact[*yyssp]; + yyarg[yycount++] = yytname[yytoken]; + if (!yypact_value_is_default (yyn)) + { + /* Start YYX at -YYN if negative to avoid negative indexes in + YYCHECK. In other words, skip the first -YYN actions for + this state because they are default actions. */ + int yyxbegin = yyn < 0 ? -yyn : 0; + /* Stay within bounds of both yycheck and yytname. */ + int yychecklim = YYLAST - yyn + 1; + int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; + int yyx; + + for (yyx = yyxbegin; yyx < yyxend; ++yyx) + if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR + && !yytable_value_is_error (yytable[yyx + yyn])) + { + if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM) + { + yycount = 1; + yysize = yysize0; + break; + } + yyarg[yycount++] = yytname[yyx]; + { + YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyx]); + if (! (yysize <= yysize1 + && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) + return 2; + yysize = yysize1; + } + } + } + } - if (! (YYPACT_NINF < yyn && yyn <= YYLAST)) - return 0; - else + switch (yycount) + { +# define YYCASE_(N, S) \ + case N: \ + yyformat = S; \ + break + default: /* Avoid compiler warnings. */ + YYCASE_(0, YY_("syntax error")); + YYCASE_(1, YY_("syntax error, unexpected %s")); + YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s")); + YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s")); + YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s")); + YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s")); +# undef YYCASE_ + } + + { + YYSIZE_T yysize1 = yysize + yystrlen (yyformat); + if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) + return 2; + yysize = yysize1; + } + + if (*yymsg_alloc < yysize) { - int yytype = YYTRANSLATE (yychar); - YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]); - YYSIZE_T yysize = yysize0; - YYSIZE_T yysize1; - int yysize_overflow = 0; - enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 }; - char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM]; - int yyx; - -# if 0 - /* This is so xgettext sees the translatable formats that are - constructed on the fly. */ - YY_("syntax error, unexpected %s"); - YY_("syntax error, unexpected %s, expecting %s"); - YY_("syntax error, unexpected %s, expecting %s or %s"); - YY_("syntax error, unexpected %s, expecting %s or %s or %s"); - YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"); -# endif - char *yyfmt; - char const *yyf; - static char const yyunexpected[] = "syntax error, unexpected %s"; - static char const yyexpecting[] = ", expecting %s"; - static char const yyor[] = " or %s"; - char yyformat[sizeof yyunexpected - + sizeof yyexpecting - 1 - + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2) - * (sizeof yyor - 1))]; - char const *yyprefix = yyexpecting; - - /* Start YYX at -YYN if negative to avoid negative indexes in - YYCHECK. */ - int yyxbegin = yyn < 0 ? -yyn : 0; - - /* Stay within bounds of both yycheck and yytname. */ - int yychecklim = YYLAST - yyn + 1; - int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; - int yycount = 1; - - yyarg[0] = yytname[yytype]; - yyfmt = yystpcpy (yyformat, yyunexpected); - - for (yyx = yyxbegin; yyx < yyxend; ++yyx) - if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) - { - if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM) - { - yycount = 1; - yysize = yysize0; - yyformat[sizeof yyunexpected - 1] = '\0'; - break; - } - yyarg[yycount++] = yytname[yyx]; - yysize1 = yysize + yytnamerr (0, yytname[yyx]); - yysize_overflow |= (yysize1 < yysize); - yysize = yysize1; - yyfmt = yystpcpy (yyfmt, yyprefix); - yyprefix = yyor; - } - - yyf = YY_(yyformat); - yysize1 = yysize + yystrlen (yyf); - yysize_overflow |= (yysize1 < yysize); - yysize = yysize1; - - if (yysize_overflow) - return YYSIZE_MAXIMUM; - - if (yyresult) - { - /* Avoid sprintf, as that infringes on the user's name space. - Don't have undefined behavior even if the translation - produced a string with the wrong number of "%s"s. */ - char *yyp = yyresult; - int yyi = 0; - while ((*yyp = *yyf) != '\0') - { - if (*yyp == '%' && yyf[1] == 's' && yyi < yycount) - { - yyp += yytnamerr (yyp, yyarg[yyi++]); - yyf += 2; - } - else - { - yyp++; - yyf++; - } - } - } - return yysize; + *yymsg_alloc = 2 * yysize; + if (! (yysize <= *yymsg_alloc + && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM)) + *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM; + return 1; } + + /* Avoid sprintf, as that infringes on the user's name space. + Don't have undefined behavior even if the translation + produced a string with the wrong number of "%s"s. */ + { + char *yyp = *yymsg; + int yyi = 0; + while ((*yyp = *yyformat) != '\0') + if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount) + { + yyp += yytnamerr (yyp, yyarg[yyi++]); + yyformat += 2; + } + else + { + yyp++; + yyformat++; + } + } + return 0; } #endif /* YYERROR_VERBOSE */ - /*-----------------------------------------------. | Release the memory associated to this symbol. | `-----------------------------------------------*/ -/*ARGSUSED*/ -#if (defined __STDC__ || defined __C99__FUNC__ \ - || defined __cplusplus || defined _MSC_VER) static void yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, DateInfo* info) -#else -static void -yydestruct (yymsg, yytype, yyvaluep, yylocationp, info) - const char *yymsg; - int yytype; - YYSTYPE *yyvaluep; - YYLTYPE *yylocationp; - DateInfo* info; -#endif { YYUSE (yyvaluep); YYUSE (yylocationp); YYUSE (info); - if (!yymsg) yymsg = "Deleting"; YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp); - switch (yytype) - { - - default: - break; - } + YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN + YYUSE (yytype); + YY_IGNORE_MAYBE_UNINITIALIZED_END } -/* Prevent warnings from -Wmissing-prototypes. */ -#ifdef YYPARSE_PARAM -#if defined __STDC__ || defined __cplusplus -int yyparse (void *YYPARSE_PARAM); -#else -int yyparse (); -#endif -#else /* ! YYPARSE_PARAM */ -#if defined __STDC__ || defined __cplusplus -int yyparse (DateInfo* info); -#else -int yyparse (); -#endif -#endif /* ! YYPARSE_PARAM */ - - -/*-------------------------. -| yyparse or yypush_parse. | -`-------------------------*/ +/*----------. +| yyparse. | +`----------*/ -#ifdef YYPARSE_PARAM -#if (defined __STDC__ || defined __C99__FUNC__ \ - || defined __cplusplus || defined _MSC_VER) -int -yyparse (void *YYPARSE_PARAM) -#else -int -yyparse (YYPARSE_PARAM) - void *YYPARSE_PARAM; -#endif -#else /* ! YYPARSE_PARAM */ -#if (defined __STDC__ || defined __C99__FUNC__ \ - || defined __cplusplus || defined _MSC_VER) int yyparse (DateInfo* info) -#else -int -yyparse (info) - DateInfo* info; -#endif -#endif { /* The lookahead symbol. */ int yychar; + /* The semantic value of the lookahead symbol. */ -YYSTYPE yylval; +/* Default value used for initialization, for pacifying older GCCs + or non-GCC compilers. */ +YY_INITIAL_VALUE (static YYSTYPE yyval_default;) +YYSTYPE yylval YY_INITIAL_VALUE (= yyval_default); /* Location data for the lookahead symbol. */ -YYLTYPE yylloc; +static YYLTYPE yyloc_default +# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL + = { 1, 1, 1, 1 } +# endif +; +YYLTYPE yylloc = yyloc_default; /* Number of syntax errors so far. */ int yynerrs; @@ -1319,11 +1252,11 @@ YYLTYPE yylloc; int yyerrstatus; /* The stacks and their tools: - `yyss': related to states. - `yyvs': related to semantic values. - `yyls': related to locations. + 'yyss': related to states. + 'yyvs': related to semantic values. + 'yyls': related to locations. - Refer to the stacks thru separate pointers, to allow yyoverflow + Refer to the stacks through separate pointers, to allow yyoverflow to reallocate them elsewhere. */ /* The state stack. */ @@ -1342,14 +1275,14 @@ YYLTYPE yylloc; YYLTYPE *yylsp; /* The locations where the error started and ended. */ - YYLTYPE yyerror_range[2]; + YYLTYPE yyerror_range[3]; YYSIZE_T yystacksize; int yyn; int yyresult; /* Lookahead token as an internal (translated) token number. */ - int yytoken; + int yytoken = 0; /* The variables used to return semantic value and location from the action routines. */ YYSTYPE yyval; @@ -1368,10 +1301,9 @@ YYLTYPE yylloc; Keep to zero when no symbol should be popped. */ int yylen = 0; - yytoken = 0; - yyss = yyssa; - yyvs = yyvsa; - yyls = yylsa; + yyssp = yyss = yyssa; + yyvsp = yyvs = yyvsa; + yylsp = yyls = yylsa; yystacksize = YYINITDEPTH; YYDPRINTF ((stderr, "Starting parse\n")); @@ -1380,21 +1312,7 @@ YYLTYPE yylloc; yyerrstatus = 0; yynerrs = 0; yychar = YYEMPTY; /* Cause a token to be read. */ - - /* Initialize stack pointers. - Waste one element of value and location stack - so that they stay on the same level as the state stack. - The wasted elements are never initialized. */ - yyssp = yyss; - yyvsp = yyvs; - yylsp = yyls; - -#if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL - /* Initialize the default location before parsing starts. */ - yylloc.first_line = yylloc.last_line = 1; - yylloc.first_column = yylloc.last_column = 1; -#endif - + yylsp[0] = yylloc; goto yysetstate; /*------------------------------------------------------------. @@ -1415,26 +1333,26 @@ YYLTYPE yylloc; #ifdef yyoverflow { - /* Give user a chance to reallocate the stack. Use copies of - these so that the &'s don't force the real ones into - memory. */ - YYSTYPE *yyvs1 = yyvs; - yytype_int16 *yyss1 = yyss; - YYLTYPE *yyls1 = yyls; - - /* Each stack pointer address is followed by the size of the - data in use in that stack, in bytes. This used to be a - conditional around just the two extra args, but that might - be undefined if yyoverflow is a macro. */ - yyoverflow (YY_("memory exhausted"), - &yyss1, yysize * sizeof (*yyssp), - &yyvs1, yysize * sizeof (*yyvsp), - &yyls1, yysize * sizeof (*yylsp), - &yystacksize); - - yyls = yyls1; - yyss = yyss1; - yyvs = yyvs1; + /* Give user a chance to reallocate the stack. Use copies of + these so that the &'s don't force the real ones into + memory. */ + YYSTYPE *yyvs1 = yyvs; + yytype_int16 *yyss1 = yyss; + YYLTYPE *yyls1 = yyls; + + /* Each stack pointer address is followed by the size of the + data in use in that stack, in bytes. This used to be a + conditional around just the two extra args, but that might + be undefined if yyoverflow is a macro. */ + yyoverflow (YY_("memory exhausted"), + &yyss1, yysize * sizeof (*yyssp), + &yyvs1, yysize * sizeof (*yyvsp), + &yyls1, yysize * sizeof (*yylsp), + &yystacksize); + + yyls = yyls1; + yyss = yyss1; + yyvs = yyvs1; } #else /* no yyoverflow */ # ifndef YYSTACK_RELOCATE @@ -1442,23 +1360,23 @@ YYLTYPE yylloc; # else /* Extend the stack our own way. */ if (YYMAXDEPTH <= yystacksize) - goto yyexhaustedlab; + goto yyexhaustedlab; yystacksize *= 2; if (YYMAXDEPTH < yystacksize) - yystacksize = YYMAXDEPTH; + yystacksize = YYMAXDEPTH; { - yytype_int16 *yyss1 = yyss; - union yyalloc *yyptr = - (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); - if (! yyptr) - goto yyexhaustedlab; - YYSTACK_RELOCATE (yyss_alloc, yyss); - YYSTACK_RELOCATE (yyvs_alloc, yyvs); - YYSTACK_RELOCATE (yyls_alloc, yyls); + yytype_int16 *yyss1 = yyss; + union yyalloc *yyptr = + (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); + if (! yyptr) + goto yyexhaustedlab; + YYSTACK_RELOCATE (yyss_alloc, yyss); + YYSTACK_RELOCATE (yyvs_alloc, yyvs); + YYSTACK_RELOCATE (yyls_alloc, yyls); # undef YYSTACK_RELOCATE - if (yyss1 != yyssa) - YYSTACK_FREE (yyss1); + if (yyss1 != yyssa) + YYSTACK_FREE (yyss1); } # endif #endif /* no yyoverflow */ @@ -1468,10 +1386,10 @@ YYLTYPE yylloc; yylsp = yyls + yysize - 1; YYDPRINTF ((stderr, "Stack size increased to %lu\n", - (unsigned long int) yystacksize)); + (unsigned long) yystacksize)); if (yyss + yystacksize - 1 <= yyssp) - YYABORT; + YYABORT; } YYDPRINTF ((stderr, "Entering state %d\n", yystate)); @@ -1491,7 +1409,7 @@ yybackup: /* First try to decide what to do without reference to lookahead token. */ yyn = yypact[yystate]; - if (yyn == YYPACT_NINF) + if (yypact_value_is_default (yyn)) goto yydefault; /* Not known => get a lookahead token if don't already have one. */ @@ -1500,7 +1418,7 @@ yybackup: if (yychar == YYEMPTY) { YYDPRINTF ((stderr, "Reading a token: ")); - yychar = YYLEX; + yychar = yylex (&yylval, &yylloc, info); } if (yychar <= YYEOF) @@ -1522,8 +1440,8 @@ yybackup: yyn = yytable[yyn]; if (yyn <= 0) { - if (yyn == 0 || yyn == YYTABLE_NINF) - goto yyerrlab; + if (yytable_value_is_error (yyn)) + goto yyerrlab; yyn = -yyn; goto yyreduce; } @@ -1540,7 +1458,9 @@ yybackup: yychar = YYEMPTY; yystate = yyn; + YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; + YY_IGNORE_MAYBE_UNINITIALIZED_END *++yylsp = yylloc; goto yynewstate; @@ -1563,7 +1483,7 @@ yyreduce: yylen = yyr2[yyn]; /* If YYLEN is nonzero, implement the default value of the action: - `$$ = $1'. + '$$ = $1'. Otherwise, the following line sets YYVAL to garbage. This behavior is undocumented and Bison @@ -1572,8 +1492,9 @@ yyreduce: GCC warning that YYVAL may be used uninitialized. */ yyval = yyvsp[1-yylen]; - /* Default location. */ + /* Default location. */ YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen); + yyerror_range[1] = yyloc; YY_REDUCE_PRINT (yyn); switch (yyn) { @@ -1581,42 +1502,48 @@ yyreduce: { yyHaveTime++; - ;} + } + break; case 6: { yyHaveZone++; - ;} + } + break; case 7: { yyHaveDate++; - ;} + } + break; case 8: { yyHaveOrdinalMonth++; - ;} + } + break; case 9: { yyHaveDay++; - ;} + } + break; case 10: { yyHaveRel++; - ;} + } + break; case 11: @@ -1624,7 +1551,8 @@ yyreduce: { yyHaveTime++; yyHaveDate++; - ;} + } + break; case 12: @@ -1633,208 +1561,232 @@ yyreduce: yyHaveTime++; yyHaveDate++; yyHaveRel++; - ;} + } + break; case 14: { - yyHour = (yyvsp[(1) - (2)].Number); + yyHour = (yyvsp[-1].Number); yyMinutes = 0; yySeconds = 0; - yyMeridian = (yyvsp[(2) - (2)].Meridian); - ;} + yyMeridian = (yyvsp[0].Meridian); + } + break; case 15: { - yyHour = (yyvsp[(1) - (4)].Number); - yyMinutes = (yyvsp[(3) - (4)].Number); + yyHour = (yyvsp[-3].Number); + yyMinutes = (yyvsp[-1].Number); yySeconds = 0; - yyMeridian = (yyvsp[(4) - (4)].Meridian); - ;} + yyMeridian = (yyvsp[0].Meridian); + } + break; case 16: { - yyHour = (yyvsp[(1) - (6)].Number); - yyMinutes = (yyvsp[(3) - (6)].Number); - yySeconds = (yyvsp[(5) - (6)].Number); - yyMeridian = (yyvsp[(6) - (6)].Meridian); - ;} + yyHour = (yyvsp[-5].Number); + yyMinutes = (yyvsp[-3].Number); + yySeconds = (yyvsp[-1].Number); + yyMeridian = (yyvsp[0].Meridian); + } + break; case 17: { - yyTimezone = (yyvsp[(1) - (2)].Number); + yyTimezone = (yyvsp[-1].Number); yyDSTmode = DSTon; - ;} + } + break; case 18: { - yyTimezone = (yyvsp[(1) - (1)].Number); + yyTimezone = (yyvsp[0].Number); yyDSTmode = DSToff; - ;} + } + break; case 19: { - yyTimezone = (yyvsp[(1) - (1)].Number); + yyTimezone = (yyvsp[0].Number); yyDSTmode = DSTon; - ;} + } + break; case 20: { /* GMT+0100, GMT-1000, etc. */ - yyTimezone = (yyvsp[(1) - (3)].Number) - (yyvsp[(2) - (3)].Number)*((yyvsp[(3) - (3)].Number) % 100 + ((yyvsp[(3) - (3)].Number) / 100) * 60); + yyTimezone = (yyvsp[-2].Number) - (yyvsp[-1].Number)*((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60); yyDSTmode = DSToff; - ;} + } + break; case 21: { /* GMT+1, GMT-10, etc. */ - yyTimezone = (yyvsp[(1) - (3)].Number) - (yyvsp[(2) - (3)].Number)*((yyvsp[(3) - (3)].Number) * 60); + yyTimezone = (yyvsp[-2].Number) - (yyvsp[-1].Number)*((yyvsp[0].Number) * 60); yyDSTmode = DSToff; - ;} + } + break; case 22: { /* +0100, -0100 */ - yyTimezone = -(yyvsp[(1) - (2)].Number)*((yyvsp[(2) - (2)].Number) % 100 + ((yyvsp[(2) - (2)].Number) / 100) * 60); + yyTimezone = -(yyvsp[-1].Number)*((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60); yyDSTmode = DSToff; - ;} + } + break; case 25: { yyDayOrdinal = 1; - yyDayOfWeek = (yyvsp[(1) - (1)].Number); + yyDayOfWeek = (yyvsp[0].Number); info->flags |= CLF_DAYOFWEEK; - ;} + } + break; case 26: { yyDayOrdinal = 1; - yyDayOfWeek = (yyvsp[(1) - (2)].Number); + yyDayOfWeek = (yyvsp[-1].Number); info->flags |= CLF_DAYOFWEEK; - ;} + } + break; case 27: { - yyDayOrdinal = (yyvsp[(1) - (2)].Number); - yyDayOfWeek = (yyvsp[(2) - (2)].Number); + yyDayOrdinal = (yyvsp[-1].Number); + yyDayOfWeek = (yyvsp[0].Number); info->flags |= CLF_DAYOFWEEK; - ;} + } + break; case 28: { - yyDayOrdinal = (yyvsp[(1) - (4)].Number) * (yyvsp[(3) - (4)].Number); - yyDayOfWeek = (yyvsp[(4) - (4)].Number); + yyDayOrdinal = (yyvsp[-3].Number) * (yyvsp[-1].Number); + yyDayOfWeek = (yyvsp[0].Number); info->flags |= CLF_DAYOFWEEK; - ;} + } + break; case 29: { - yyDayOrdinal = (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number); - yyDayOfWeek = (yyvsp[(3) - (3)].Number); + yyDayOrdinal = (yyvsp[-2].Number) * (yyvsp[-1].Number); + yyDayOfWeek = (yyvsp[0].Number); info->flags |= CLF_DAYOFWEEK; - ;} + } + break; case 30: { yyDayOrdinal = 2; - yyDayOfWeek = (yyvsp[(2) - (2)].Number); + yyDayOfWeek = (yyvsp[0].Number); info->flags |= CLF_DAYOFWEEK; - ;} + } + break; case 31: { - yyMonth = (yyvsp[(1) - (3)].Number); - yyDay = (yyvsp[(3) - (3)].Number); - ;} + yyMonth = (yyvsp[-2].Number); + yyDay = (yyvsp[0].Number); + } + break; case 32: { - yyMonth = (yyvsp[(1) - (5)].Number); - yyDay = (yyvsp[(3) - (5)].Number); - yyYear = (yyvsp[(5) - (5)].Number); - ;} + yyMonth = (yyvsp[-4].Number); + yyDay = (yyvsp[-2].Number); + yyYear = (yyvsp[0].Number); + } + break; case 33: { - yyYear = (yyvsp[(1) - (1)].Number) / 10000; - yyMonth = ((yyvsp[(1) - (1)].Number) % 10000)/100; - yyDay = (yyvsp[(1) - (1)].Number) % 100; - ;} + yyYear = (yyvsp[0].Number) / 10000; + yyMonth = ((yyvsp[0].Number) % 10000)/100; + yyDay = (yyvsp[0].Number) % 100; + } + break; case 34: { - yyDay = (yyvsp[(1) - (5)].Number); - yyMonth = (yyvsp[(3) - (5)].Number); - yyYear = (yyvsp[(5) - (5)].Number); - ;} + yyDay = (yyvsp[-4].Number); + yyMonth = (yyvsp[-2].Number); + yyYear = (yyvsp[0].Number); + } + break; case 35: { - yyMonth = (yyvsp[(3) - (5)].Number); - yyDay = (yyvsp[(5) - (5)].Number); - yyYear = (yyvsp[(1) - (5)].Number); - ;} + yyMonth = (yyvsp[-2].Number); + yyDay = (yyvsp[0].Number); + yyYear = (yyvsp[-4].Number); + } + break; case 36: { - yyMonth = (yyvsp[(1) - (2)].Number); - yyDay = (yyvsp[(2) - (2)].Number); - ;} + yyMonth = (yyvsp[-1].Number); + yyDay = (yyvsp[0].Number); + } + break; case 37: { - yyMonth = (yyvsp[(1) - (4)].Number); - yyDay = (yyvsp[(2) - (4)].Number); - yyYear = (yyvsp[(4) - (4)].Number); - ;} + yyMonth = (yyvsp[-3].Number); + yyDay = (yyvsp[-2].Number); + yyYear = (yyvsp[0].Number); + } + break; case 38: { - yyMonth = (yyvsp[(2) - (2)].Number); - yyDay = (yyvsp[(1) - (2)].Number); - ;} + yyMonth = (yyvsp[0].Number); + yyDay = (yyvsp[-1].Number); + } + break; case 39: @@ -1843,94 +1795,103 @@ yyreduce: yyMonth = 1; yyDay = 1; yyYear = EPOCH; - ;} + } + break; case 40: { - yyMonth = (yyvsp[(2) - (3)].Number); - yyDay = (yyvsp[(1) - (3)].Number); - yyYear = (yyvsp[(3) - (3)].Number); - ;} + yyMonth = (yyvsp[-1].Number); + yyDay = (yyvsp[-2].Number); + yyYear = (yyvsp[0].Number); + } + break; case 41: { yyMonthOrdinalIncr = 1; - yyMonthOrdinal = (yyvsp[(2) - (2)].Number); - ;} + yyMonthOrdinal = (yyvsp[0].Number); + } + break; case 42: { - yyMonthOrdinalIncr = (yyvsp[(2) - (3)].Number); - yyMonthOrdinal = (yyvsp[(3) - (3)].Number); - ;} + yyMonthOrdinalIncr = (yyvsp[-1].Number); + yyMonthOrdinal = (yyvsp[0].Number); + } + break; case 43: { - if ((yyvsp[(2) - (3)].Number) != HOUR( 7)) YYABORT; /* T */ - yyYear = (yyvsp[(1) - (3)].Number) / 10000; - yyMonth = ((yyvsp[(1) - (3)].Number) % 10000)/100; - yyDay = (yyvsp[(1) - (3)].Number) % 100; - yyHour = (yyvsp[(3) - (3)].Number) / 10000; - yyMinutes = ((yyvsp[(3) - (3)].Number) % 10000)/100; - yySeconds = (yyvsp[(3) - (3)].Number) % 100; - ;} + if ((yyvsp[-1].Number) != HOUR( 7)) YYABORT; /* T */ + yyYear = (yyvsp[-2].Number) / 10000; + yyMonth = ((yyvsp[-2].Number) % 10000)/100; + yyDay = (yyvsp[-2].Number) % 100; + yyHour = (yyvsp[0].Number) / 10000; + yyMinutes = ((yyvsp[0].Number) % 10000)/100; + yySeconds = (yyvsp[0].Number) % 100; + } + break; case 44: { - yyYear = (yyvsp[(1) - (2)].Number) / 10000; - yyMonth = ((yyvsp[(1) - (2)].Number) % 10000)/100; - yyDay = (yyvsp[(1) - (2)].Number) % 100; - yyHour = (yyvsp[(2) - (2)].Number) / 10000; - yyMinutes = ((yyvsp[(2) - (2)].Number) % 10000)/100; - yySeconds = (yyvsp[(2) - (2)].Number) % 100; - ;} + yyYear = (yyvsp[-1].Number) / 10000; + yyMonth = ((yyvsp[-1].Number) % 10000)/100; + yyDay = (yyvsp[-1].Number) % 100; + yyHour = (yyvsp[0].Number) / 10000; + yyMinutes = ((yyvsp[0].Number) % 10000)/100; + yySeconds = (yyvsp[0].Number) % 100; + } + break; case 45: { - yyYear = (yyvsp[(1) - (7)].Number) / 10000; - yyMonth = ((yyvsp[(1) - (7)].Number) % 10000)/100; - yyDay = (yyvsp[(1) - (7)].Number) % 100; - yyHour = (yyvsp[(3) - (7)].Number); - yyMinutes = (yyvsp[(5) - (7)].Number); - yySeconds = (yyvsp[(7) - (7)].Number); - ;} + yyYear = (yyvsp[-6].Number) / 10000; + yyMonth = ((yyvsp[-6].Number) % 10000)/100; + yyDay = (yyvsp[-6].Number) % 100; + yyHour = (yyvsp[-4].Number); + yyMinutes = (yyvsp[-2].Number); + yySeconds = (yyvsp[0].Number); + } + break; case 46: { - if ((yyvsp[(2) - (7)].Number) != HOUR( 7)) YYABORT; /* T */ - yyYear = (yyvsp[(1) - (7)].Number) / 10000; - yyMonth = ((yyvsp[(1) - (7)].Number) % 10000)/100; - yyDay = (yyvsp[(1) - (7)].Number) % 100; - yyHour = (yyvsp[(3) - (7)].Number); - yyMinutes = (yyvsp[(5) - (7)].Number); - yySeconds = (yyvsp[(7) - (7)].Number); - ;} + if ((yyvsp[-5].Number) != HOUR( 7)) YYABORT; /* T */ + yyYear = (yyvsp[-6].Number) / 10000; + yyMonth = ((yyvsp[-6].Number) % 10000)/100; + yyDay = (yyvsp[-6].Number) % 100; + yyHour = (yyvsp[-4].Number); + yyMinutes = (yyvsp[-2].Number); + yySeconds = (yyvsp[0].Number); + } + break; case 47: { - yyYear = (yyvsp[(1) - (3)].Number) / 10000; - yyMonth = ((yyvsp[(1) - (3)].Number) % 10000)/100; - yyDay = (yyvsp[(1) - (3)].Number) % 100; - yyHour = (yyvsp[(3) - (3)].Number) / 10000; - yyMinutes = ((yyvsp[(3) - (3)].Number) % 10000)/100; - yySeconds = (yyvsp[(3) - (3)].Number) % 100; - ;} + yyYear = (yyvsp[-2].Number) / 10000; + yyMonth = ((yyvsp[-2].Number) % 10000)/100; + yyDay = (yyvsp[-2].Number) % 100; + yyHour = (yyvsp[0].Number) / 10000; + yyMinutes = ((yyvsp[0].Number) % 10000)/100; + yySeconds = (yyvsp[0].Number) % 100; + } + break; case 48: @@ -1941,12 +1902,13 @@ yyreduce: * in a range accessible with a 32 bit clock seconds value. */ - yyYear = (yyvsp[(2) - (4)].Number)/1000 + 2323 - 377; + yyYear = (yyvsp[-2].Number)/1000 + 2323 - 377; yyDay = 1; yyMonth = 1; - yyRelDay += (((yyvsp[(2) - (4)].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000; - yyRelSeconds += (yyvsp[(4) - (4)].Number) * 144 * 60; - ;} + yyRelDay += (((yyvsp[-2].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000; + yyRelSeconds += (yyvsp[0].Number) * 144 * 60; + } + break; case 49: @@ -1955,141 +1917,169 @@ yyreduce: yyRelSeconds *= -1; yyRelMonth *= -1; yyRelDay *= -1; - ;} + } + break; case 51: { - *yyRelPointer += (yyvsp[(1) - (4)].Number) * (yyvsp[(3) - (4)].Number) * (yyvsp[(4) - (4)].Number); - ;} + *yyRelPointer += (yyvsp[-3].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number); + } + break; case 52: { - *yyRelPointer += (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number); - ;} + *yyRelPointer += (yyvsp[-2].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number); + } + break; case 53: { - *yyRelPointer += (yyvsp[(1) - (2)].Number) * (yyvsp[(2) - (2)].Number); - ;} + *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number); + } + break; case 54: { - *yyRelPointer += (yyvsp[(2) - (2)].Number); - ;} + *yyRelPointer += (yyvsp[0].Number); + } + break; case 55: { - *yyRelPointer += (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number); - ;} + *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number); + } + break; case 56: { - *yyRelPointer += (yyvsp[(1) - (1)].Number); - ;} + *yyRelPointer += (yyvsp[0].Number); + } + break; case 57: { (yyval.Number) = -1; - ;} + } + break; case 58: { (yyval.Number) = 1; - ;} + } + break; case 59: { - (yyval.Number) = (yyvsp[(1) - (1)].Number); + (yyval.Number) = (yyvsp[0].Number); yyRelPointer = &yyRelSeconds; - ;} + } + break; case 60: { - (yyval.Number) = (yyvsp[(1) - (1)].Number); + (yyval.Number) = (yyvsp[0].Number); yyRelPointer = &yyRelDay; - ;} + } + break; case 61: { - (yyval.Number) = (yyvsp[(1) - (1)].Number); + (yyval.Number) = (yyvsp[0].Number); yyRelPointer = &yyRelMonth; - ;} + } + break; case 62: { - (yyval.Number) = (yyvsp[(1) - (1)].Number) - ;} + (yyval.Number) = (yyvsp[0].Number); + } + break; case 63: { - (yyval.Number) = (yyvsp[(1) - (1)].Number) - ;} + (yyval.Number) = (yyvsp[0].Number); + } + break; case 64: { if (yyHaveTime && yyHaveDate && !yyHaveRel) { - yyYear = (yyvsp[(1) - (1)].Number); + yyYear = (yyvsp[0].Number); } else { yyHaveTime++; if (yyDigitCount <= 2) { - yyHour = (yyvsp[(1) - (1)].Number); + yyHour = (yyvsp[0].Number); yyMinutes = 0; } else { - yyHour = (yyvsp[(1) - (1)].Number) / 100; - yyMinutes = (yyvsp[(1) - (1)].Number) % 100; + yyHour = (yyvsp[0].Number) / 100; + yyMinutes = (yyvsp[0].Number) % 100; } yySeconds = 0; yyMeridian = MER24; } - ;} + } + break; case 65: { (yyval.Meridian) = MER24; - ;} + } + break; case 66: { - (yyval.Meridian) = (yyvsp[(1) - (1)].Meridian); - ;} + (yyval.Meridian) = (yyvsp[0].Meridian); + } + break; default: break; } + /* User semantic actions sometimes alter yychar, and that requires + that yytoken be updated with the new translation. We take the + approach of translating immediately before every use of yytoken. + One alternative is translating here after every semantic action, + but that translation would be missed if the semantic action invokes + YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or + if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an + incorrect destructor might then be invoked immediately. In the + case of YYERROR or YYBACKUP, subsequent parser actions might lead + to an incorrect destructor call or verbose syntax error message + before the lookahead is translated. */ YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc); YYPOPSTACK (yylen); @@ -2099,7 +2089,7 @@ yyreduce: *++yyvsp = yyval; *++yylsp = yyloc; - /* Now `shift' the result of the reduction. Determine what state + /* Now 'shift' the result of the reduction. Determine what state that goes to, based on the state we popped back to and the rule number reduced by. */ @@ -2114,10 +2104,14 @@ yyreduce: goto yynewstate; -/*------------------------------------. -| yyerrlab -- here on detecting error | -`------------------------------------*/ +/*--------------------------------------. +| yyerrlab -- here on detecting error. | +`--------------------------------------*/ yyerrlab: + /* Make sure we have latest lookahead translation. See comments at + user semantic actions for why this is necessary. */ + yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar); + /* If not already recovering from an error, report this error. */ if (!yyerrstatus) { @@ -2125,59 +2119,58 @@ yyerrlab: #if ! YYERROR_VERBOSE yyerror (&yylloc, info, YY_("syntax error")); #else +# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \ + yyssp, yytoken) { - YYSIZE_T yysize = yysyntax_error (0, yystate, yychar); - if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM) - { - YYSIZE_T yyalloc = 2 * yysize; - if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM)) - yyalloc = YYSTACK_ALLOC_MAXIMUM; - if (yymsg != yymsgbuf) - YYSTACK_FREE (yymsg); - yymsg = (char *) YYSTACK_ALLOC (yyalloc); - if (yymsg) - yymsg_alloc = yyalloc; - else - { - yymsg = yymsgbuf; - yymsg_alloc = sizeof yymsgbuf; - } - } - - if (0 < yysize && yysize <= yymsg_alloc) - { - (void) yysyntax_error (yymsg, yystate, yychar); - yyerror (&yylloc, info, yymsg); - } - else - { - yyerror (&yylloc, info, YY_("syntax error")); - if (yysize != 0) - goto yyexhaustedlab; - } + char const *yymsgp = YY_("syntax error"); + int yysyntax_error_status; + yysyntax_error_status = YYSYNTAX_ERROR; + if (yysyntax_error_status == 0) + yymsgp = yymsg; + else if (yysyntax_error_status == 1) + { + if (yymsg != yymsgbuf) + YYSTACK_FREE (yymsg); + yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc); + if (!yymsg) + { + yymsg = yymsgbuf; + yymsg_alloc = sizeof yymsgbuf; + yysyntax_error_status = 2; + } + else + { + yysyntax_error_status = YYSYNTAX_ERROR; + yymsgp = yymsg; + } + } + yyerror (&yylloc, info, yymsgp); + if (yysyntax_error_status == 2) + goto yyexhaustedlab; } +# undef YYSYNTAX_ERROR #endif } - yyerror_range[0] = yylloc; + yyerror_range[1] = yylloc; if (yyerrstatus == 3) { /* If just tried and failed to reuse lookahead token after an - error, discard it. */ + error, discard it. */ if (yychar <= YYEOF) - { - /* Return failure if at end of input. */ - if (yychar == YYEOF) - YYABORT; - } + { + /* Return failure if at end of input. */ + if (yychar == YYEOF) + YYABORT; + } else - { - yydestruct ("Error: discarding", - yytoken, &yylval, &yylloc, info); - yychar = YYEMPTY; - } + { + yydestruct ("Error: discarding", + yytoken, &yylval, &yylloc, info); + yychar = YYEMPTY; + } } /* Else will try to reuse lookahead token after shifting the error @@ -2196,8 +2189,7 @@ yyerrorlab: if (/*CONSTCOND*/ 0) goto yyerrorlab; - yyerror_range[0] = yylsp[1-yylen]; - /* Do not reclaim the symbols of the rule which action triggered + /* Do not reclaim the symbols of the rule whose action triggered this YYERROR. */ YYPOPSTACK (yylen); yylen = 0; @@ -2210,40 +2202,42 @@ yyerrorlab: | yyerrlab1 -- common code for both syntax error and YYERROR. | `-------------------------------------------------------------*/ yyerrlab1: - yyerrstatus = 3; /* Each real token shifted decrements this. */ + yyerrstatus = 3; /* Each real token shifted decrements this. */ for (;;) { yyn = yypact[yystate]; - if (yyn != YYPACT_NINF) - { - yyn += YYTERROR; - if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) - { - yyn = yytable[yyn]; - if (0 < yyn) - break; - } - } + if (!yypact_value_is_default (yyn)) + { + yyn += YYTERROR; + if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) + { + yyn = yytable[yyn]; + if (0 < yyn) + break; + } + } /* Pop the current state because it cannot handle the error token. */ if (yyssp == yyss) - YYABORT; + YYABORT; - yyerror_range[0] = *yylsp; + yyerror_range[1] = *yylsp; yydestruct ("Error: popping", - yystos[yystate], yyvsp, yylsp, info); + yystos[yystate], yyvsp, yylsp, info); YYPOPSTACK (1); yystate = *yyssp; YY_STACK_PRINT (yyss, yyssp); } + YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; + YY_IGNORE_MAYBE_UNINITIALIZED_END - yyerror_range[1] = yylloc; + yyerror_range[2] = yylloc; /* Using YYLLOC is tempting, but would change the location of the lookahead. YYLOC is available though. */ - YYLLOC_DEFAULT (yyloc, (yyerror_range - 1), 2); + YYLLOC_DEFAULT (yyloc, yyerror_range, 2); *++yylsp = yyloc; /* Shift the error token. */ @@ -2267,7 +2261,7 @@ yyabortlab: yyresult = 1; goto yyreturn; -#if !defined(yyoverflow) || YYERROR_VERBOSE +#if !defined yyoverflow || YYERROR_VERBOSE /*-------------------------------------------------. | yyexhaustedlab -- memory exhaustion comes here. | `-------------------------------------------------*/ @@ -2279,16 +2273,21 @@ yyexhaustedlab: yyreturn: if (yychar != YYEMPTY) - yydestruct ("Cleanup: discarding lookahead", - yytoken, &yylval, &yylloc, info); - /* Do not reclaim the symbols of the rule which action triggered + { + /* Make sure we have latest lookahead translation. See comments at + user semantic actions for why this is necessary. */ + yytoken = YYTRANSLATE (yychar); + yydestruct ("Cleanup: discarding lookahead", + yytoken, &yylval, &yylloc, info); + } + /* Do not reclaim the symbols of the rule whose action triggered this YYABORT or YYACCEPT. */ YYPOPSTACK (yylen); YY_STACK_PRINT (yyss, yyssp); while (yyssp != yyss) { yydestruct ("Cleanup: popping", - yystos[*yyssp], yyvsp, yylsp, info); + yystos[*yyssp], yyvsp, yylsp, info); YYPOPSTACK (1); } #ifndef yyoverflow @@ -2299,13 +2298,10 @@ yyreturn: if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); #endif - /* Make sure YYID is used. */ - return YYID (yyresult); + return yyresult; } - - /* * Month and day table. */ @@ -2902,4 +2898,3 @@ TclClockFreeScan( * fill-column: 78 * End: */ - diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 6aacf93..f25f45b 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -442,10 +442,10 @@ unit : tSEC_UNIT { ; INTNUM : tUNUMBER { - $$ = $1 + $$ = $1; } | tISOBASE { - $$ = $1 + $$ = $1; } ; -- cgit v0.12 From 68a780a3bf6f4754739c65c7776176bfaaf60cc5 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 29 Nov 2018 20:04:42 +0000 Subject: clock scan: consider multiple spaces between tokens (closes tclclockmod#13): combine multiple white-spaces as single token in format. --- generic/tclClockFmt.c | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 51bac2f..d3ec8c1 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -1862,11 +1862,10 @@ static const char *ScnOTokenMapAliasIndex[2] = { "dHHHu" }; -static const char *ScnSpecTokenMapIndex = - " "; -static ClockScanTokenMap ScnSpecTokenMap[] = { - {CTOKT_SPACE, 0, 0, 1, 1, 0, - NULL}, +/* Token map reserved for CTOKT_SPACE */ +static ClockScanTokenMap ScnSpaceTokenMap = { + CTOKT_SPACE, 0, 0, 1, 1, 0, + NULL, }; static ClockScanTokenMap ScnWordTokenMap = { @@ -2035,21 +2034,20 @@ ClockGetOrParseScanFormat( continue; } break; - case ' ': - cp = strchr(ScnSpecTokenMapIndex, *p); - if (!cp || *cp == '\0') { - p--; - goto word_tok; + default: + if ( *p == ' ' || isspace(UCHAR(*p)) ) { + tok->map = &ScnSpaceTokenMap; + tok->tokWord.start = p++; + while (p < e && isspace(UCHAR(*p))) { + p++; } - tok->map = &ScnSpecTokenMap[cp - ScnSpecTokenMapIndex]; + tok->tokWord.end = p; /* increase space count used in format */ fss->scnSpaceCount++; /* next token */ AllocTokenInChain(tok, scnTok, fss->scnTokC); tokCnt++; - p++; continue; - break; - default: + } word_tok: if (1) { ClockScanToken *wordTok = tok; -- cgit v0.12 From 577976dba721184f20b79b1ec1977b72ffe008f2 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 29 Nov 2018 20:11:14 +0000 Subject: clock scan: consider extra trailing spaces at end of input (closes tclclockmod#14), only the first space at end is interesting in non-strict mode (should match SPACE token if present in scan-format) --- generic/tclClockFmt.c | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index d3ec8c1..3f47be9 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -2149,14 +2149,18 @@ ClockScan( x = end; while (p < end) { if (isspace(UCHAR(*p))) { - x = p++; + x = ++p; /* after first space in space block */ yySpaceCount++; + while (p < end && isspace(UCHAR(*p))) { + p++; + yySpaceCount++; + } continue; } x = end; p++; } - /* ignore spaces at end */ + /* ignore more as 1 space at end */ yySpaceCount -= (end - x); end = x; /* ignore mandatory spaces used in format */ @@ -2245,9 +2249,10 @@ ClockScan( }; /* decrement count for possible spaces in match */ while (p < yyInput) { - if (isspace(UCHAR(*p++))) { + if (isspace(UCHAR(*p))) { yySpaceCount--; } + p++; } p = yyInput; flags = (flags & ~map->clearFlags) | map->flags; @@ -2258,7 +2263,8 @@ ClockScan( /* unmatched -> error */ goto not_match; } - yySpaceCount--; + /* don't decrement yySpaceCount by regular (first expected space), + * already considered above with fss->scnSpaceCount */; p++; while (p < end && isspace(UCHAR(*p))) { yySpaceCount--; @@ -2288,8 +2294,17 @@ ClockScan( } /* check end was reached */ if (p < end) { + /* in non-strict mode bypass spaces at end of input */ + if ( !(opts->flags & CLF_STRICT) && isspace(UCHAR(*p)) ) { + p++; + while (p < end && isspace(UCHAR(*p))) { + p++; + } + } /* something after last token - wrong format */ - goto not_match; + if (p < end) { + goto not_match; + } } /* end of string, check only optional tokens at end, otherwise - not match */ while (tok->map != NULL) { -- cgit v0.12 From a6482d22e22ee943e601d3105356593e141d333f Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 29 Nov 2018 20:12:45 +0000 Subject: test-cases: clock-45.* - new compatibility tests checking several scan regression on spaces --- tests/clock.test | 45 +++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 43 insertions(+), 2 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index 4e81c10..2b8c757 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -36511,13 +36511,54 @@ test clock-44.1 {regression test - time zone name containing hyphen } \ } } \ -result {12:34:56-0500} - -test clock-45.1 {regression test - time zone containing only two digits} \ +test clock-44.2 {regression test - time zone containing only two digits} \ -body { clock scan 1985-04-12T10:15:30+04 -format %Y-%m-%dT%H:%M:%S%Z } \ -result 482134530 +test clock-45.1 {compat: scan regression on spaces (multiple spaces in format)} \ + -body { + list \ + [clock scan "11/08/2018 0612" -format "%m/%d/%Y %H%M" -gmt 1] \ + [clock scan "11/08/2018 0612" -format "%m/%d/%Y %H%M" -gmt 1] \ + [clock scan "11/08/2018 0612" -format "%m/%d/%Y %H%M" -gmt 1] \ + [clock scan " 11/08/2018 0612" -format " %m/%d/%Y %H%M" -gmt 1] \ + [clock scan " 11/08/2018 0612" -format " %m/%d/%Y %H%M" -gmt 1] \ + [clock scan " 11/08/2018 0612" -format " %m/%d/%Y %H%M" -gmt 1] \ + [clock scan "11/08/2018 0612 " -format "%m/%d/%Y %H%M " -gmt 1] \ + [clock scan "11/08/2018 0612 " -format "%m/%d/%Y %H%M " -gmt 1] \ + [clock scan "11/08/2018 0612 " -format "%m/%d/%Y %H%M " -gmt 1] + } -result [lrepeat 9 1541657520] + +test clock-45.2 {compat: scan regression on spaces (multiple leading/trailing spaces in input)} \ + -body { + set sp [string repeat " " 20] + list \ + [clock scan "NOV 7${sp}" -format "%b %d" -base 0 -gmt 1 -locale en] \ + [clock scan "${sp}NOV 7" -format "%b %d" -base 0 -gmt 1 -locale en] \ + [clock scan "${sp}NOV 7${sp}" -format "%b %d" -base 0 -gmt 1 -locale en] \ + [clock scan "1970 NOV 7${sp}" -format "%Y %b %d" -gmt 1 -locale en] \ + [clock scan "${sp}1970 NOV 7" -format "%Y %b %d" -gmt 1 -locale en] \ + [clock scan "${sp}1970 NOV 7${sp}" -format "%Y %b %d" -gmt 1 -locale en] + } -result [lrepeat 6 26784000] +test clock-45.3 {compat: scan regression on spaces (shortest match)} \ + -body { + list \ + [clock scan "11 1 120" -format "%y%m%d %H%M%S" -gmt 1] \ + [clock scan "11 1 120 " -format "%y%m%d %H%M%S" -gmt 1] \ + [clock scan " 11 1 120" -format "%y%m%d %H%M%S" -gmt 1] \ + [clock scan "11 1 120 " -format "%y%m%d %H%M%S " -gmt 1] \ + [clock scan " 11 1 120" -format " %y%m%d %H%M%S" -gmt 1] + } -result [lrepeat 5 978310920] +test clock-45.4 {compat: scan regression on spaces (mandatory leading/trailing spaces in format)} \ + -body { + list \ + [catch {clock scan "11 1 120" -format "%y%m%d %H%M%S " -gmt 1} ret] $ret \ + [catch {clock scan "11 1 120" -format " %y%m%d %H%M%S" -gmt 1} ret] $ret \ + [catch {clock scan "11 1 120" -format " %y%m%d %H%M%S " -gmt 1} ret] $ret + } -result [lrepeat 3 1 "input string does not match supplied format"] + test clock-46.1 {regression test - month zero} -constraints valid_off \ -body { clock scan 2004-00-00 -format %Y-%m-%d -- cgit v0.12 From 6855aaa7995a839003a7c5f9ccef342144897726 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 29 Nov 2018 20:14:14 +0000 Subject: clock scan: compatibility - scan regression on spaces, mandatory trailing spaces in format, see test "clock-45.4" --- generic/tclClockFmt.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 3f47be9..254936c 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -2310,7 +2310,10 @@ ClockScan( while (tok->map != NULL) { if (!(opts->flags & CLF_STRICT) && (tok->map->type == CTOKT_SPACE)) { tok++; - if (tok->map == NULL) break; + if (tok->map == NULL) { + /* no tokens anymore - trailing spaces are mandatory */ + goto not_match; + } } if (!(tok->map->flags & CLF_OPTIONAL)) { goto not_match; -- cgit v0.12 From a4600a6847c0bd3f41f69d0446138d37063ef25b Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 10 Jan 2019 13:52:17 +0000 Subject: remove unneeded dependencies (taken along by pack-porting, not needed in mod now) --- generic/tclClock.c | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index dfa760c..e1c70e9 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -17,7 +17,6 @@ #include "tclInt.h" #include "tclStrIdxTree.h" #include "tclDate.h" -#include "tclCompile.h" /* * Windows has mktime. The configurators do not check. -- cgit v0.12 From 2aee61ea3055c9d7212040a402680c89b8df2a9e Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 10 Jan 2019 13:55:20 +0000 Subject: avoid possible leaking on tzName-object in error case (most impossible resp. rarely, but nevertheless better don't return directly). --- generic/tclClock.c | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index e1c70e9..4389e16 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -3634,7 +3634,8 @@ ClockScanObjCmd( Tcl_SetObjResult(interp, Tcl_NewStringObj("legacy [clock scan] does not support -locale", -1)); Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL); - return TCL_ERROR; + ret = TCL_ERROR; + goto done; } ret = ClockFreeScan(&yy, objv[1], &opts); } @@ -3657,9 +3658,9 @@ ClockScanObjCmd( /* Apply validation rules, if expected */ if ( (opts.flags & CLF_VALIDATE) ) { - if (ClockValidDate(&yy, &opts, - opts.formatObj == NULL ? 2 : 3) != TCL_OK) { - return TCL_ERROR; + ret = ClockValidDate(&yy, &opts, opts.formatObj == NULL ? 2 : 3); + if (ret != TCL_OK) { + goto done; } } -- cgit v0.12 From 903f7ee3c92b0cc8622f2df23dd64de1dd27b302 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 25 Jan 2019 20:16:57 +0000 Subject: introduced new configure option `-max-jdn` corresponds current setting of tcl-core clock scans for JulianDay per default (5373484 = "9999-12-31 23:59:59") --- generic/tclClock.c | 27 ++++++++++++++++++++++----- generic/tclDate.h | 1 + 2 files changed, 23 insertions(+), 5 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 4389e16..819f7fb 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -235,6 +235,7 @@ TclClockInit( data->yearOfCenturySwitch = ClockDefaultCenturySwitch; data->validMinYear = INT_MIN; data->validMaxYear = INT_MAX; + data->maxJulianDay = 5373484; /* corresponds 9999-12-31 23:59:59 per default */ data->systemTimeZone = NULL; data->systemSetupTZData = NULL; @@ -981,14 +982,14 @@ ClockConfigureObjCmd( "-system-tz", "-setup-tz", "-default-locale", "-current-locale", "-clear", "-year-century", "-century-switch", - "-min-year", "-max-year", "-validate", + "-min-year", "-max-year", "-max-jdn", "-validate", NULL }; enum optionInd { CLOCK_SYSTEM_TZ, CLOCK_SETUP_TZ, CLOCK_DEFAULT_LOCALE, CLOCK_CURRENT_LOCALE, CLOCK_CLEAR_CACHE, CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH, - CLOCK_MIN_YEAR, CLOCK_MAX_YEAR, CLOCK_VALIDATE + CLOCK_MIN_YEAR, CLOCK_MAX_YEAR, CLOCK_MAX_JDN, CLOCK_VALIDATE }; int optionIndex; /* Index of an option. */ int i; @@ -1117,6 +1118,21 @@ ClockConfigureObjCmd( Tcl_NewIntObj(dataPtr->validMaxYear)); } break; + case CLOCK_MAX_JDN: + if (i < objc) { + Tcl_WideInt jd; + if (TclGetWideIntFromObj(interp, objv[i], &jd) != TCL_OK) { + return TCL_ERROR; + } + dataPtr->maxJulianDay = jd; + Tcl_SetObjResult(interp, objv[i]); + continue; + } + if (i+1 >= objc) { + Tcl_SetObjResult(interp, + Tcl_NewWideIntObj(dataPtr->maxJulianDay)); + } + break; case CLOCK_VALIDATE: if (i < objc) { int val; @@ -3715,9 +3731,10 @@ ClockScanCommit( info->flags &= ~CLF_ASSEMBLE_JULIANDAY; } - /* some overflow checks, if not extended */ - if (!(opts->flags & CLF_EXTENDED)) { - if (yydate.julianDay > 5373484) { + /* some overflow checks */ + if (info->flags & CLF_JULIANDAY) { + ClockClientData *dataPtr = opts->clientData; + if (yydate.julianDay > dataPtr->maxJulianDay) { Tcl_SetObjResult(opts->interp, Tcl_NewStringObj( "requested date too large to represent", -1)); Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL); diff --git a/generic/tclDate.h b/generic/tclDate.h index 55eb331..9aa031a 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -310,6 +310,7 @@ typedef struct ClockClientData { int yearOfCenturySwitch; int validMinYear; int validMaxYear; + Tcl_WideInt maxJulianDay; Tcl_Obj *systemTimeZone; Tcl_Obj *systemSetupTZData; -- cgit v0.12 From 7a2c96b4211c5695bcfab86f361225c409e801c9 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 25 Jan 2019 20:17:26 +0000 Subject: fix of _witoaw: adjustment of width for negative wide-int (conversion wide to string using `_witoaw(buf, -1, '0', 1)` caused mistakenly 10-chars padding). --- generic/tclClockFmt.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 254936c..f3ac90a 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -247,7 +247,7 @@ _witoaw( if (!width) width++; /* check resp. recalculate width (regarding sign) */ width--; - if (val <= 10000000000L) { + if (val <= -10000000000L) { Tcl_WideInt val2; val2 = val / 10000000000L; while (width <= 9 && val2 <= -wrange[width]) { -- cgit v0.12 From ec6bc3e8fc49444829d56dfd699dd84bd27331fc Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 25 Jan 2019 20:17:46 +0000 Subject: small optimization of format-proc tokens, that are don't use `val` in callback, as well as don't do the back-conversion from int to string (output inside fmtproc) - switch to CFMTT_PROC token type. --- generic/tclClockFmt.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index f3ac90a..b4d7b14 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -2801,7 +2801,7 @@ static ClockFormatTokenMap FmtSTokenMap[] = { /* %V */ {CTOKT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.iso8601Week), NULL}, /* %z %Z */ - {CTOKT_INT, NULL, 0, 0, 0, 0, 0, + {CFMTT_PROC, NULL, 0, 0, 0, 0, 0, ClockFmtToken_TimeZone_Proc, NULL}, /* %g */ {CTOKT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.iso8601Year), NULL}, @@ -2818,7 +2818,7 @@ static ClockFormatTokenMap FmtSTokenMap[] = { /* %t */ {CTOKT_CHAR, "\t", 0, 0, 0, 0, 0, NULL}, /* %Q */ - {CTOKT_INT, NULL, 0, 0, 0, 0, 0, + {CFMTT_PROC, NULL, 0, 0, 0, 0, 0, ClockFmtToken_StarDate_Proc, NULL}, }; static const char *FmtSTokenMapAliasIndex[2] = { @@ -2830,7 +2830,7 @@ static const char *FmtETokenMapIndex = "Eys"; static ClockFormatTokenMap FmtETokenMap[] = { /* %EE */ - {CTOKT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.era), + {CFMTT_PROC, NULL, 0, 0, 0, 0, 0, ClockFmtToken_LocaleERA_Proc, NULL}, /* %Ey %EC */ {CTOKT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.year), -- cgit v0.12 From 5846943d27d4aa4f79753cda4526efdbae5f00d3 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 25 Jan 2019 20:18:09 +0000 Subject: fixes [16e4fc3096] julian day calculation (mostly affected for very small times, B.C.E. between 4714 and 4713), added test-cases covering that. --- generic/tclClock.c | 26 ++++++------------------- generic/tclDate.h | 25 ++++++++++++++++++++++++ tests/clock.test | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 87 insertions(+), 20 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 819f7fb..26d327e 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -1616,11 +1616,11 @@ ClockGetDateFields( } /* - * Extract Julian day. + * Extract Julian day and seconds of the day. */ - fields->julianDay = (fields->localSeconds + JULIAN_SEC_POSIX_EPOCH) - / SECONDS_PER_DAY; + ClockExtractJDAndSODFromSeconds(fields->julianDay, fields->secondOfDay, + fields->localSeconds); /* * Convert to Julian or Gregorian calendar. @@ -1630,15 +1630,6 @@ ClockGetDateFields( GetMonthDay(fields); GetYearWeekDay(fields, changeover); - - /* - * Seconds of the day. - */ - fields->secondOfDay = (int)(fields->localSeconds % SECONDS_PER_DAY); - if (fields->secondOfDay < 0) { - fields->secondOfDay += SECONDS_PER_DAY; - } - return TCL_OK; } @@ -2102,19 +2093,14 @@ ConvertLocalToUTCUsingC( struct tm timeVal; int localErrno; int secondOfDay; - Tcl_WideInt jsec; /* * Convert the given time to a date. */ - jsec = fields->localSeconds + JULIAN_SEC_POSIX_EPOCH; - fields->julianDay = (jsec / SECONDS_PER_DAY); - secondOfDay = (int)(jsec % SECONDS_PER_DAY); - if (secondOfDay < 0) { - secondOfDay += SECONDS_PER_DAY; - fields->julianDay--; - } + ClockExtractJDAndSODFromSeconds(fields->julianDay, secondOfDay, + fields->localSeconds); + GetGregorianEraYearDay(fields, changeover); GetMonthDay(fields); diff --git a/generic/tclDate.h b/generic/tclDate.h index 9aa031a..2751ee5 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -476,6 +476,31 @@ struct ClockFmtScnStorage { #endif }; +/* + * Clock macros. + */ + +/* + * Extracts Julian day and seconds of the day from posix seconds (tm). + */ +#define ClockExtractJDAndSODFromSeconds(jd, sod, tm) \ + if (1) { \ + jd = (tm + JULIAN_SEC_POSIX_EPOCH); \ + if (jd >= SECONDS_PER_DAY || jd <= -SECONDS_PER_DAY) { \ + jd /= SECONDS_PER_DAY; \ + sod = (int)(tm % SECONDS_PER_DAY); \ + } else { \ + sod = (int)jd, jd = 0; \ + } \ + if (sod < 0) { \ + sod += SECONDS_PER_DAY; \ + /* JD is affected, if switched into negative (avoid 24 hours difference) */ \ + if (jd <= 0) { \ + jd--; \ + } \ + } \ + } + /* * Prototypes of module functions. */ diff --git a/tests/clock.test b/tests/clock.test index 0e143ec..f7d5a83 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -15357,6 +15357,62 @@ test clock-4.96 { format time of day 23:59:59 } { -locale en_US_roman \ -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 59 lix PM pm 11:59:59 pm 23:59 59 lix 23:59:59 23:59:59 xxiii h lix m lix s Thu Jan 1 23:59:59 GMT 1970} + +test clock-4.97.1 { format julian day } { + clock format 0 -format {%J} -gmt true +} {2440588} +test clock-4.97.2 { format julian day } { + clock format 43200 -format {%J} -gmt true +} {2440588} +test clock-4.97.3 { format julian day } { + clock format 86399 -format {%J} -gmt true +} {2440588} +test clock-4.97.4 { format julian day } { + clock format 86400 -format {%J} -gmt true +} {2440589} +test clock-4.97.5 { format julian day } { + clock format 129599 -format {%J} -gmt true +} {2440589} +test clock-4.97.6 { format julian day } { + clock format 129600 -format {%J} -gmt true +} {2440589} +test clock-4.97.7 { format julian day } { + set i 1548249092 + list \ + [clock format $i -format {%J} -gmt true] \ + [clock format [incr i] -format {%J} -gmt true] \ + [clock format [incr i] -format {%J} -gmt true] +} {2458507 2458507 2458507} +test clock-4.97.8 { format julian day } { + set res {} + foreach i { + -172800 -129600 -86400 -43200 + -1 0 1 21600 43199 43200 86399 + 86400 86401 108000 129600 172800 + } { + lappend res $i [clock format [expr -210866803200 - $i] \ + -format {%EE %Y-%m-%d %T -- %J} -gmt true] + } + set res +} [list \ + -172800 {B.C.E. 4713-01-03 00:00:00 -- 2} \ + -129600 {B.C.E. 4713-01-02 12:00:00 -- 1} \ + -86400 {B.C.E. 4713-01-02 00:00:00 -- 1} \ + -43200 {B.C.E. 4713-01-01 12:00:00 -- 0} \ + -1 {B.C.E. 4713-01-01 00:00:01 -- 0} \ + 0 {B.C.E. 4713-01-01 00:00:00 -- 0} \ + 1 {B.C.E. 4714-12-31 23:59:59 -- -1} \ + 21600 {B.C.E. 4714-12-31 18:00:00 -- -1} \ + 43199 {B.C.E. 4714-12-31 12:00:01 -- -1} \ + 43200 {B.C.E. 4714-12-31 12:00:00 -- -1} \ + 86399 {B.C.E. 4714-12-31 00:00:01 -- -1} \ + 86400 {B.C.E. 4714-12-31 00:00:00 -- -1} \ + 86401 {B.C.E. 4714-12-30 23:59:59 -- -2} \ + 108000 {B.C.E. 4714-12-30 18:00:00 -- -2} \ + 129600 {B.C.E. 4714-12-30 12:00:00 -- -2} \ + 172800 {B.C.E. 4714-12-30 00:00:00 -- -2} \ +] + # END testcases4 # BEGIN testcases5 -- cgit v0.12 From 57f12fe4926235794c3e8baec90bb5870f77f032 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 25 Jan 2019 20:18:27 +0000 Subject: format: fix padding on output of julian day token `%J`: restored tcl-core compatibility (7x 0-padding, affected in B.C.E. only): `clock format -210866803200 -format %J -gmt 1` results into `0000000`. --- generic/tclClockFmt.c | 2 +- tests/clock.test | 54 ++++++++++++++++++++++++++++++++++++--------------- 2 files changed, 39 insertions(+), 17 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index b4d7b14..67a2ec4 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -2810,7 +2810,7 @@ static ClockFormatTokenMap FmtSTokenMap[] = { /* %j */ {CTOKT_INT, "0", 3, 0, 0, 0, TclOffset(DateFormat, date.dayOfYear), NULL}, /* %J */ - {CTOKT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.julianDay), NULL}, + {CTOKT_WIDE, "0", 7, 0, 0, 0, TclOffset(DateFormat, date.julianDay), NULL}, /* %s */ {CTOKT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.seconds), NULL}, /* %n */ diff --git a/tests/clock.test b/tests/clock.test index f7d5a83..72354c2 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -15395,22 +15395,44 @@ test clock-4.97.8 { format julian day } { } set res } [list \ - -172800 {B.C.E. 4713-01-03 00:00:00 -- 2} \ - -129600 {B.C.E. 4713-01-02 12:00:00 -- 1} \ - -86400 {B.C.E. 4713-01-02 00:00:00 -- 1} \ - -43200 {B.C.E. 4713-01-01 12:00:00 -- 0} \ - -1 {B.C.E. 4713-01-01 00:00:01 -- 0} \ - 0 {B.C.E. 4713-01-01 00:00:00 -- 0} \ - 1 {B.C.E. 4714-12-31 23:59:59 -- -1} \ - 21600 {B.C.E. 4714-12-31 18:00:00 -- -1} \ - 43199 {B.C.E. 4714-12-31 12:00:01 -- -1} \ - 43200 {B.C.E. 4714-12-31 12:00:00 -- -1} \ - 86399 {B.C.E. 4714-12-31 00:00:01 -- -1} \ - 86400 {B.C.E. 4714-12-31 00:00:00 -- -1} \ - 86401 {B.C.E. 4714-12-30 23:59:59 -- -2} \ - 108000 {B.C.E. 4714-12-30 18:00:00 -- -2} \ - 129600 {B.C.E. 4714-12-30 12:00:00 -- -2} \ - 172800 {B.C.E. 4714-12-30 00:00:00 -- -2} \ + -172800 {B.C.E. 4713-01-03 00:00:00 -- 0000002} \ + -129600 {B.C.E. 4713-01-02 12:00:00 -- 0000001} \ + -86400 {B.C.E. 4713-01-02 00:00:00 -- 0000001} \ + -43200 {B.C.E. 4713-01-01 12:00:00 -- 0000000} \ + -1 {B.C.E. 4713-01-01 00:00:01 -- 0000000} \ + 0 {B.C.E. 4713-01-01 00:00:00 -- 0000000} \ + 1 {B.C.E. 4714-12-31 23:59:59 -- -000001} \ + 21600 {B.C.E. 4714-12-31 18:00:00 -- -000001} \ + 43199 {B.C.E. 4714-12-31 12:00:01 -- -000001} \ + 43200 {B.C.E. 4714-12-31 12:00:00 -- -000001} \ + 86399 {B.C.E. 4714-12-31 00:00:01 -- -000001} \ + 86400 {B.C.E. 4714-12-31 00:00:00 -- -000001} \ + 86401 {B.C.E. 4714-12-30 23:59:59 -- -000002} \ + 108000 {B.C.E. 4714-12-30 18:00:00 -- -000002} \ + 129600 {B.C.E. 4714-12-30 12:00:00 -- -000002} \ + 172800 {B.C.E. 4714-12-30 00:00:00 -- -000002} \ +] +test clock-4.97.9 { format JDN/JD (calendar and astronomical) } { + set res {} + foreach i { + -86400 -43200 + -1 0 1 + 43199 43200 43201 86400 + } { + lappend res $i [clock format [expr 653133196800 + $i] \ + -format {%Y-%m-%d %T -- %J} -gmt true] + } + set res +} [list \ + -86400 {22666-12-19 00:00:00 -- 9999999} \ + -43200 {22666-12-19 12:00:00 -- 9999999} \ + -1 {22666-12-19 23:59:59 -- 9999999} \ + 0 {22666-12-20 00:00:00 -- 10000000} \ + 1 {22666-12-20 00:00:01 -- 10000000} \ + 43199 {22666-12-20 11:59:59 -- 10000000} \ + 43200 {22666-12-20 12:00:00 -- 10000000} \ + 43201 {22666-12-20 12:00:01 -- 10000000} \ + 86400 {22666-12-21 00:00:00 -- 10000001} \ ] # END testcases4 -- cgit v0.12 From 0849ec1f7645230c58daa59087a96ec24e919e22 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 13 Mar 2019 00:21:13 +0000 Subject: implemented scan of astronomical julian day (JDN/ID) with token `%Ej`, corresponds julian date of sqlite-database. In opposite to calendar julian day `%J`, it starts the day at noon (and can parse float, so contains a time fraction). **TODO** implement `clock format ... -format %Ej` and test-cases for format of this token. **TODO** implement `%EJ` token for calendar JD with time fraction. --- doc/clock.n | 18 +++++++++++++- generic/tclClock.c | 17 +++++++------ generic/tclClockFmt.c | 63 +++++++++++++++++++++++++++++++++++++++++++++- generic/tclDate.h | 2 +- tests/clock.test | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 159 insertions(+), 10 deletions(-) diff --git a/doc/clock.n b/doc/clock.n index 0dae993..4294412 100644 --- a/doc/clock.n +++ b/doc/clock.n @@ -400,6 +400,9 @@ seconds from the epoch, that group is used to determine the date. .IP [2] If the string contains a \fB%J\fR format group, representing the Julian Day Number, that group is used to determine the date. +Note, that in case of \fB%Ej\fR format group, representing +the astronomical Julian Date (with time fraction), this group is used +to determine the date and time. .IP [3] If the string contains a complete set of format groups specifying century, year, month, and day of month; century, year, and day of year; @@ -550,6 +553,19 @@ abbreviation appropriate to the current locale, and uses it to fix whether \fB%Y\fR refers to years before or after Year 1 of the Common Era. .TP +\fB%Ej\fR +On output, produces a string of digits giving the Astronomical Julian Date or +Astronomical Julian Day Number (JDN/JD). In opposite to calendar julian day +\fB%J\fR, it starts the day at noon. +On input, accepts a string of digits (or floating point with the time fraction) +and interprets it as an Astronomical Julian Day Number (JDN/JD). +The Astronomical Julian Date is a count of the number of calendar days +that have elapsed since 1 January, 4713 BCE of the proleptic +Julian calendar, which contains also the time fraktion (after floating point). +The epoch time of 1 January 1970 corresponds to Astronomical JDN 2440587.5. +This value corresponds the julian day used in sqlite-database, and is the same +as result of \fBselect julianday(:seconds, 'unixepoch')\fR. +.TP \fB%Es\fR This affects similar to \fB%s\fR, but in opposition to \fB%s\fR it parses or formats local seconds (not the posix seconds). @@ -605,7 +621,7 @@ On output, produces a three-digit number giving the day of the year (001-366). On input, accepts such a number. .TP \fB%J\fR -On output, produces a string of digits giving the Julian Day Number. +On output, produces a string of digits giving the calendar Julian Day Number. On input, accepts a string of digits and interprets it as a Julian Day Number. The Julian Day Number is a count of the number of calendar days that have elapsed since 1 January, 4713 BCE of the proleptic diff --git a/generic/tclClock.c b/generic/tclClock.c index 26d327e..7f31411 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -235,7 +235,8 @@ TclClockInit( data->yearOfCenturySwitch = ClockDefaultCenturySwitch; data->validMinYear = INT_MIN; data->validMaxYear = INT_MAX; - data->maxJulianDay = 5373484; /* corresponds 9999-12-31 23:59:59 per default */ + /* corresponds max of JDN in sqlite - 9999-12-31 23:59:59 per default */ + data->maxJDN = 5373484.499999994; data->systemTimeZone = NULL; data->systemSetupTZData = NULL; @@ -1120,17 +1121,17 @@ ClockConfigureObjCmd( break; case CLOCK_MAX_JDN: if (i < objc) { - Tcl_WideInt jd; - if (TclGetWideIntFromObj(interp, objv[i], &jd) != TCL_OK) { + double jd; + if (Tcl_GetDoubleFromObj(interp, objv[i], &jd) != TCL_OK) { return TCL_ERROR; } - dataPtr->maxJulianDay = jd; + dataPtr->maxJDN = jd; Tcl_SetObjResult(interp, objv[i]); continue; } if (i+1 >= objc) { Tcl_SetObjResult(interp, - Tcl_NewWideIntObj(dataPtr->maxJulianDay)); + Tcl_NewDoubleObj(dataPtr->maxJDN)); } break; case CLOCK_VALIDATE: @@ -3719,8 +3720,10 @@ ClockScanCommit( /* some overflow checks */ if (info->flags & CLF_JULIANDAY) { - ClockClientData *dataPtr = opts->clientData; - if (yydate.julianDay > dataPtr->maxJulianDay) { + ClockClientData *dataPtr = opts->clientData; + double curJDN = (double)yydate.julianDay + + ((double)yySecondOfDay - SECONDS_PER_DAY/2) / SECONDS_PER_DAY; + if (curJDN > dataPtr->maxJDN) { Tcl_SetObjResult(opts->interp, Tcl_NewStringObj( "requested date too large to represent", -1)); Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL); diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 67a2ec4..67e191a 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -1584,6 +1584,64 @@ ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, } static int +ClockScnToken_AstroJDN_Proc(ClockFmtScnCmdArgs *opts, + DateInfo *info, ClockScanToken *tok) +{ + int minLen, maxLen; + register const char *p = yyInput, *end; const char *s; + Tcl_WideInt intJD; int fractJD = 0, fractJDDiv = 1; + + DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + + end = yyInput + maxLen; + + /* currently positive astronomic dates only */ + if (*p == '+') { p++; }; + s = p; + while (p < end && isdigit(UCHAR(*p))) { + p++; + } + if ( _str2wideInt(&intJD, s, p, 1) != TCL_OK) { + return TCL_RETURN; + }; + yyInput = p; + if (p >= end || *p++ != '.') { /* allow pure integer astronomical JDN */ + goto done; + } + s = p; + while (p < end && isdigit(UCHAR(*p))) { + fractJDDiv *= 10; + p++; + } + if ( _str2int(&fractJD, s, p, 1) != TCL_OK) { + return TCL_RETURN; + }; + yyInput = p; + +done: + /* + * Build a date from julian day (integer and fraction). + * Note, astronomical JDN starts at noon in opposite to calendar julianday. + */ + + fractJD = (SECONDS_PER_DAY/2) + + (int)((Tcl_WideInt)SECONDS_PER_DAY * fractJD / fractJDDiv); + if (fractJD > SECONDS_PER_DAY) { + fractJD %= SECONDS_PER_DAY; + intJD += 1; + } + yydate.secondOfDay = fractJD; + yydate.julianDay = intJD; + + yydate.seconds = + -210866803200L + + ( SECONDS_PER_DAY * intJD ) + + ( fractJD ); + + return TCL_OK; +} + +static int ClockScnToken_TimeZone_Proc(ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok) { @@ -1815,11 +1873,14 @@ static const char *ScnSTokenMapAliasIndex[2] = { }; static const char *ScnETokenMapIndex = - "Eys"; + "Ejys"; static ClockScanTokenMap ScnETokenMap[] = { /* %EE */ {CTOKT_PARSER, 0, 0, 0, 0xffff, TclOffset(DateInfo, date.year), ClockScnToken_LocaleERA_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %Ej */ + {CTOKT_PARSER, CLF_JULIANDAY | CLF_POSIXSEC | CLF_SIGNED, 0, 1, 0xffff, 0, + ClockScnToken_AstroJDN_Proc, NULL}, /* %Ey */ {CTOKT_PARSER, 0, 0, 0, 0xffff, 0, /* currently no capture, parse only token */ ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, diff --git a/generic/tclDate.h b/generic/tclDate.h index 2751ee5..568aef1 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -310,7 +310,7 @@ typedef struct ClockClientData { int yearOfCenturySwitch; int validMinYear; int validMaxYear; - Tcl_WideInt maxJulianDay; + double maxJDN; Tcl_Obj *systemTimeZone; Tcl_Obj *systemSetupTZData; diff --git a/tests/clock.test b/tests/clock.test index 72354c2..50b6648 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18900,6 +18900,72 @@ test clock-7.9 {Julian Day, two values} { clock scan {2440588 2440589} -format {%J %J} -gmt true } 86400 + +test clock-7.11 {Astronomical JDN/JD} { + clock scan 0 -format %Ej -gmt true +} -210866760000 + +test clock-7.12 {Astronomical JDN/JD} { + clock format [clock scan 2440587.5 -format %Ej -gmt true] \ + -format "%Y-%m-%d %T" -gmt true +} "1970-01-01 00:00:00" + +test clock-7.13 {Astronomical JDN/JD} { + clock format [clock scan 2451544.5 -format %Ej -gmt true] \ + -format "%Y-%m-%d %T" -gmt true +} "2000-01-01 00:00:00" + +test clock-7.13.1 {Astronomical JDN/JD} { + clock format [clock scan 2488069.5 -format %Ej -gmt true] \ + -format "%Y-%m-%d %T" -gmt true +} "2100-01-01 00:00:00" + +test clock-7.14 {Astronomical JDN/JD} { + clock format [clock scan 5373483.5 -format %Ej -gmt true] \ + -format "%Y-%m-%d %T" -gmt true +} "9999-12-31 00:00:00" + +test clock-7.14.1 {Astronomical JDN/JD} { + clock format [clock scan 5373484 -format %Ej -gmt true] \ + -format "%Y-%m-%d %T" -gmt true +} "9999-12-31 12:00:00" +test clock-7.14.2 {Astronomical JDN/JD} { + clock format [clock scan 5373484.49999 -format %Ej -gmt true] \ + -format "%Y-%m-%d %T" -gmt true +} "9999-12-31 23:59:59" + +test clock-7.15 {Astronomical JDN/JD, bad} { + list [catch { + clock scan bogus -format %Ej + } result] $result $errorCode +} {1 {input string does not match supplied format} {CLOCK badInputString}} + +test clock-7.16 {Astronomical JDN/JD, overflow} { + list [catch { + clock scan 5373484.5 -format %Ej + } result] $result $errorCode \ + [catch { + clock scan 5373485 -format %Ej + } result] $result $errorCode \ + [catch { + clock scan 2147483648 -format %Ej + } result] $result $errorCode \ + [catch { + clock scan 2147483648.5 -format %Ej + } result] $result $errorCode +} [lrepeat 4 1 {requested date too large to represent} {CLOCK dateTooLarge}] + +test clock-7.18 {Astronomical JDN/JD, same precedence as seconds (last wins} { + list [clock scan {2440588 86400} -format {%Ej %s} -gmt true] \ + [clock scan {2440589 0} -format {%Ej %s} -gmt true] \ + [clock scan {86400 2440588} -format {%s %Ej} -gmt true] \ + [clock scan {0 2440589} -format {%s %Ej} -gmt true] +} {86400 0 43200 129600} + +test clock-7.19 {Astronomical JDN/JD, two values} { + clock scan {2440588 2440589} -format {%Ej %Ej} -gmt true +} 129600 + # BEGIN testcases8 # Test parsing of ccyymmdd @@ -21313,6 +21379,9 @@ test clock-9.1 {seconds take precedence over ccyymmdd} { test clock-9.2 {Julian day takes precedence over ccyymmdd} { clock scan {2440588 20000101} -format {%J %Y%m%d} -gmt true } 0 +test clock-9.2.1 {Astro julian day takes precedence over date-time} { + clock scan {2440587.5 20000101 010203} -format {%Ej %Y%m%d %H%M%S} -gmt true +} 0 # Test parsing of ccyyddd -- cgit v0.12 From 1ab33bd2400c55498d6d9d4603f55ce281c1daf6 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 13 Mar 2019 00:23:57 +0000 Subject: scan: extended with token `%EJ` to scan calendar julian day with time fraction (in opposite to astronomical JD `%Ej` it starts at midnight like `%J` token). --- doc/clock.n | 22 +++++++++++++++++----- generic/tclClockFmt.c | 28 ++++++++++++++++++++-------- tests/clock.test | 30 ++++++++++++++++++++++++------ 3 files changed, 61 insertions(+), 19 deletions(-) diff --git a/doc/clock.n b/doc/clock.n index 4294412..d75f32d 100644 --- a/doc/clock.n +++ b/doc/clock.n @@ -398,11 +398,12 @@ preprocessed format string. In order of preference: If the string contains a \fB%s\fR format group, representing seconds from the epoch, that group is used to determine the date. .IP [2] -If the string contains a \fB%J\fR format group, representing -the Julian Day Number, that group is used to determine the date. -Note, that in case of \fB%Ej\fR format group, representing -the astronomical Julian Date (with time fraction), this group is used -to determine the date and time. +If the string contains a \fB%J\fR, \fB%EJ\fR or \fB%Ej\fR format groups, +representing the Calendar or Astronomical Julian Day Number, that groups +are used to determine the date. +Note, that in case of \fB%EJ\fR or \fB%Ej\fR format groups, representing +the Julian Date with time fraction, this groups may be used to determine +the date and time. .IP [3] If the string contains a complete set of format groups specifying century, year, month, and day of month; century, year, and day of year; @@ -566,6 +567,17 @@ The epoch time of 1 January 1970 corresponds to Astronomical JDN 2440587.5. This value corresponds the julian day used in sqlite-database, and is the same as result of \fBselect julianday(:seconds, 'unixepoch')\fR. .TP +\fB%EJ\fR +On output, produces a string of digits giving the Calendar Julian Date. +In opposite to julian day \fB%J\fR format group, it produces float number. +In opposite to astronomical julian day \fB%Ej\fR group, it starts at midnight. +On input, accepts a string of digits (or floating point with the time fraction) +and interprets it as a Calendar Julian Day Number. +The Calendar Julian Date is a count of the number of calendar days +that have elapsed since 1 January, 4713 BCE of the proleptic +Julian calendar, which contains also the time fraktion (after floating point). +The epoch time of 1 January 1970 corresponds to Astronomical JDN 2440588. +.TP \fB%Es\fR This affects similar to \fB%s\fR, but in opposition to \fB%s\fR it parses or formats local seconds (not the posix seconds). diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 67e191a..4582190 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -1584,7 +1584,7 @@ ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, } static int -ClockScnToken_AstroJDN_Proc(ClockFmtScnCmdArgs *opts, +ClockScnToken_JDN_Proc(ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok) { int minLen, maxLen; @@ -1605,8 +1605,14 @@ ClockScnToken_AstroJDN_Proc(ClockFmtScnCmdArgs *opts, return TCL_RETURN; }; yyInput = p; - if (p >= end || *p++ != '.') { /* allow pure integer astronomical JDN */ - goto done; + if (p >= end || *p++ != '.') { /* allow pure integer JDN */ + /* by astronomical JD the seconds of day offs is 12 hours */ + if (tok->map->offs) { + goto done; + } + /* calendar JD */ + yydate.julianDay = intJD; + return TCL_OK; } s = p; while (p < end && isdigit(UCHAR(*p))) { @@ -1624,12 +1630,12 @@ done: * Note, astronomical JDN starts at noon in opposite to calendar julianday. */ - fractJD = (SECONDS_PER_DAY/2) + fractJD = (int)tok->map->offs /* 0 for calendar or 43200 for astro JD */ + (int)((Tcl_WideInt)SECONDS_PER_DAY * fractJD / fractJDDiv); if (fractJD > SECONDS_PER_DAY) { fractJD %= SECONDS_PER_DAY; intJD += 1; - } + } yydate.secondOfDay = fractJD; yydate.julianDay = intJD; @@ -1638,6 +1644,8 @@ done: + ( SECONDS_PER_DAY * intJD ) + ( fractJD ); + info->flags |= CLF_POSIXSEC | CLF_SIGNED; + return TCL_OK; } @@ -1873,14 +1881,17 @@ static const char *ScnSTokenMapAliasIndex[2] = { }; static const char *ScnETokenMapIndex = - "Ejys"; + "EJjys"; static ClockScanTokenMap ScnETokenMap[] = { /* %EE */ {CTOKT_PARSER, 0, 0, 0, 0xffff, TclOffset(DateInfo, date.year), ClockScnToken_LocaleERA_Proc, (void *)MCLIT_LOCALE_NUMERALS}, + /* %EJ */ + {CTOKT_PARSER, CLF_JULIANDAY, 0, 1, 0xffff, 0, /* calendar JDN starts at midnight */ + ClockScnToken_JDN_Proc, NULL}, /* %Ej */ - {CTOKT_PARSER, CLF_JULIANDAY | CLF_POSIXSEC | CLF_SIGNED, 0, 1, 0xffff, 0, - ClockScnToken_AstroJDN_Proc, NULL}, + {CTOKT_PARSER, CLF_JULIANDAY, 0, 1, 0xffff, (SECONDS_PER_DAY/2), /* astro JDN starts at noon */ + ClockScnToken_JDN_Proc, NULL}, /* %Ey */ {CTOKT_PARSER, 0, 0, 0, 0xffff, 0, /* currently no capture, parse only token */ ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, @@ -2385,6 +2396,7 @@ ClockScan( /* * Invalidate result */ + flags |= info->flags; /* seconds token (%s) take precedence over all other tokens */ if ((opts->flags & CLF_EXTENDED) || !(flags & CLF_POSIXSEC)) { diff --git a/tests/clock.test b/tests/clock.test index 50b6648..fa21a26 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18899,6 +18899,14 @@ test clock-7.8 {Julian Day, precedence below seconds} { test clock-7.9 {Julian Day, two values} { clock scan {2440588 2440589} -format {%J %J} -gmt true } 86400 +test clock-7.10 {Calendar vs Astronomical Julian Day (without and with time fraction)} { + list \ + [clock scan {2440588} -format {%J} -gmt true] \ + [clock scan {2440588} -format {%EJ} -gmt true] \ + [clock scan {2440588} -format {%Ej} -gmt true] \ + [clock scan {2440588.5} -format {%EJ} -gmt true] \ + [clock scan {2440588.5} -format {%Ej} -gmt true] \ +} {0 0 43200 43200 86400} test clock-7.11 {Astronomical JDN/JD} { @@ -21376,12 +21384,22 @@ test clock-9.1 {seconds take precedence over ccyymmdd} { clock scan {0 20000101} -format {%s %Y%m%d} -gmt true } 0 -test clock-9.2 {Julian day takes precedence over ccyymmdd} { - clock scan {2440588 20000101} -format {%J %Y%m%d} -gmt true -} 0 -test clock-9.2.1 {Astro julian day takes precedence over date-time} { - clock scan {2440587.5 20000101 010203} -format {%Ej %Y%m%d %H%M%S} -gmt true -} 0 +test clock-9.2 {Calendar julian day takes precedence over ccyymmdd} { + list \ + [clock scan {2440588 20000101} -format {%J %Y%m%d} -gmt true] \ + [clock scan {2440588 20000101} -format {%EJ %Y%m%d} -gmt true] +} {0 0} +test clock-9.2.1 {Calendar julian day (with time fraction) takes precedence over date-time} { + list \ + [clock scan {2440588.0 20000101 010203} -format {%EJ %Y%m%d %H%M%S} -gmt true] \ + [clock scan {2440588.5 20000101 010203} -format {%EJ %Y%m%d %H%M%S} -gmt true] + +} {0 43200} +test clock-9.3 {Astro julian day takes always precedence over date-time} { + list \ + [clock scan {2440587.5 20000101 010203} -format {%Ej %Y%m%d %H%M%S} -gmt true] \ + [clock scan {2440588 20000101 010203} -format {%Ej %Y%m%d %H%M%S} -gmt true] +} {0 43200} # Test parsing of ccyyddd -- cgit v0.12 From 72f8c81ad189b22d76ff2d8ca8dddd06a0a53958 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 13 Mar 2019 00:24:25 +0000 Subject: format: add support of new JDN-tokens (calendar JD `%EJ`, astronomical JD `%Ej`) with time fraction. --- generic/tclClockFmt.c | 69 +++++++++++++++++++++++++++++++++- tests/clock.test | 102 +++++++++++++++++++++++++------------------------- 2 files changed, 119 insertions(+), 52 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 4582190..d4e82ad 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -2665,6 +2665,67 @@ ClockFmtToken_WeekOfYear_Proc( return TCL_OK; } static int +ClockFmtToken_JDN_Proc( + ClockFmtScnCmdArgs *opts, + DateFormat *dateFmt, + ClockFormatToken *tok, + int *val) + { + Tcl_WideInt intJD = dateFmt->date.julianDay; + int fractJD; + + /* Convert to JDN parts (regarding start offset) and time fraction */ + fractJD = dateFmt->date.secondOfDay + - (int)tok->map->offs; /* 0 for calendar or 43200 for astro JD */ + if (fractJD < 0) { + intJD--; + fractJD += SECONDS_PER_DAY; + } + if (fractJD && intJD < 0) { /* avoid jump over 0, by negative JD's */ + intJD++; + if (intJD == 0) { + /* -0.0 / -0.9 has zero integer part, so append "-" extra */ + if (FrmResultAllocate(dateFmt, 1) != TCL_OK) { return TCL_ERROR; }; + *dateFmt->output++ = '-'; + } + /* and inverse seconds of day, -0(75) -> -0.25 as float */ + fractJD = SECONDS_PER_DAY - fractJD; + } + + /* 21 is max width of (negative) wide-int (rather smaller, but anyway a time fraction below) */ + if (FrmResultAllocate(dateFmt, 21) != TCL_OK) { return TCL_ERROR; }; + dateFmt->output = _witoaw(dateFmt->output, intJD, '0', 1); + /* simplest cases .0 and .5 */ + if (!fractJD || fractJD == (SECONDS_PER_DAY / 2)) { + /* point + 0 or 5 */ + if (FrmResultAllocate(dateFmt, 1+1) != TCL_OK) { return TCL_ERROR; }; + *dateFmt->output++ = '.'; + *dateFmt->output++ = !fractJD ? '0' : '5'; + *dateFmt->output = '\0'; + return TCL_OK; + } else { + /* wrap the time fraction */ + #define JDN_MAX_PRECISION 8 + #define JDN_MAX_PRECBOUND 100000000 /* 10**JDN_MAX_PRECISION */ + char *p; + + /* to float (part after floating point, + 0.5 to round it up) */ + fractJD = (int)( + (double)fractJD * JDN_MAX_PRECBOUND / SECONDS_PER_DAY + 0.5 + ); + /* point + integer (as time fraction after floating point) */ + if (FrmResultAllocate(dateFmt, 1+JDN_MAX_PRECISION) != TCL_OK) { return TCL_ERROR; }; + *dateFmt->output++ = '.'; + p = _itoaw(dateFmt->output, fractJD, '0', JDN_MAX_PRECISION); + /* remove trailing zero's */ + dateFmt->output++; + while (p > dateFmt->output && *(p-1) == '0') {p--;} + *p = '\0'; + dateFmt->output = p; + } + return TCL_OK; +} +static int ClockFmtToken_TimeZone_Proc( ClockFmtScnCmdArgs *opts, DateFormat *dateFmt, @@ -2900,11 +2961,17 @@ static const char *FmtSTokenMapAliasIndex[2] = { }; static const char *FmtETokenMapIndex = - "Eys"; + "EJjys"; static ClockFormatTokenMap FmtETokenMap[] = { /* %EE */ {CFMTT_PROC, NULL, 0, 0, 0, 0, 0, ClockFmtToken_LocaleERA_Proc, NULL}, + /* %EJ */ + {CFMTT_PROC, NULL, 0, 0, 0, 0, 0, /* calendar JDN starts at midnight */ + ClockFmtToken_JDN_Proc, NULL}, + /* %Ej */ + {CFMTT_PROC, NULL, 0, 0, 0, 0, (SECONDS_PER_DAY/2), /* astro JDN starts at noon */ + ClockFmtToken_JDN_Proc, NULL}, /* %Ey %EC */ {CTOKT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.year), ClockFmtToken_LocaleERAYear_Proc, NULL}, diff --git a/tests/clock.test b/tests/clock.test index fa21a26..9a949a9 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -15358,32 +15358,32 @@ test clock-4.96 { format time of day 23:59:59 } { -gmt true } {23 xxiii 11 xi 23 xxiii 11 xi 59 lix PM pm 11:59:59 pm 23:59 59 lix 23:59:59 23:59:59 xxiii h lix m lix s Thu Jan 1 23:59:59 GMT 1970} -test clock-4.97.1 { format julian day } { - clock format 0 -format {%J} -gmt true -} {2440588} -test clock-4.97.2 { format julian day } { - clock format 43200 -format {%J} -gmt true -} {2440588} -test clock-4.97.3 { format julian day } { - clock format 86399 -format {%J} -gmt true -} {2440588} -test clock-4.97.4 { format julian day } { - clock format 86400 -format {%J} -gmt true -} {2440589} -test clock-4.97.5 { format julian day } { - clock format 129599 -format {%J} -gmt true -} {2440589} -test clock-4.97.6 { format julian day } { - clock format 129600 -format {%J} -gmt true -} {2440589} -test clock-4.97.7 { format julian day } { +test clock-4.97.1 { format JDN/JD (calendar and astronomical) } { + clock format 0 -format {%J %EJ %Ej} -gmt true +} {2440588 2440588.0 2440587.5} +test clock-4.97.2 { format JDN/JD (calendar and astronomical) } { + clock format 43200 -format {%J %EJ %Ej} -gmt true +} {2440588 2440588.5 2440588.0} +test clock-4.97.3 { format JDN/JD (calendar and astronomical) } { + clock format 86399 -format {%J %EJ %Ej} -gmt true +} {2440588 2440588.99998843 2440588.49998843} +test clock-4.97.4 { format JDN/JD (calendar and astronomical) } { + clock format 86400 -format {%J %EJ %Ej} -gmt true +} {2440589 2440589.0 2440588.5} +test clock-4.97.5 { format JDN/JD (calendar and astronomical) } { + clock format 129599 -format {%J %EJ %Ej} -gmt true +} {2440589 2440589.49998843 2440588.99998843} +test clock-4.97.6 { format JDN/JD (calendar and astronomical) } { + clock format 129600 -format {%J %EJ %Ej} -gmt true +} {2440589 2440589.5 2440589.0} +test clock-4.97.7 { format JDN/JD (calendar and astronomical) } { set i 1548249092 list \ - [clock format $i -format {%J} -gmt true] \ - [clock format [incr i] -format {%J} -gmt true] \ - [clock format [incr i] -format {%J} -gmt true] -} {2458507 2458507 2458507} -test clock-4.97.8 { format julian day } { + [clock format $i -format {%J %EJ %Ej} -gmt true] \ + [clock format [incr i] -format {%J %EJ %Ej} -gmt true] \ + [clock format [incr i] -format {%J %EJ %Ej} -gmt true] +} {{2458507 2458507.54967593 2458507.04967593} {2458507 2458507.5496875 2458507.0496875} {2458507 2458507.54969907 2458507.04969907}} +test clock-4.97.8 { format JDN/JD (calendar and astronomical) } { set res {} foreach i { -172800 -129600 -86400 -43200 @@ -15391,26 +15391,26 @@ test clock-4.97.8 { format julian day } { 86400 86401 108000 129600 172800 } { lappend res $i [clock format [expr -210866803200 - $i] \ - -format {%EE %Y-%m-%d %T -- %J} -gmt true] + -format {%EE %Y-%m-%d %T -- %J %EJ %Ej} -gmt true] } set res } [list \ - -172800 {B.C.E. 4713-01-03 00:00:00 -- 0000002} \ - -129600 {B.C.E. 4713-01-02 12:00:00 -- 0000001} \ - -86400 {B.C.E. 4713-01-02 00:00:00 -- 0000001} \ - -43200 {B.C.E. 4713-01-01 12:00:00 -- 0000000} \ - -1 {B.C.E. 4713-01-01 00:00:01 -- 0000000} \ - 0 {B.C.E. 4713-01-01 00:00:00 -- 0000000} \ - 1 {B.C.E. 4714-12-31 23:59:59 -- -000001} \ - 21600 {B.C.E. 4714-12-31 18:00:00 -- -000001} \ - 43199 {B.C.E. 4714-12-31 12:00:01 -- -000001} \ - 43200 {B.C.E. 4714-12-31 12:00:00 -- -000001} \ - 86399 {B.C.E. 4714-12-31 00:00:01 -- -000001} \ - 86400 {B.C.E. 4714-12-31 00:00:00 -- -000001} \ - 86401 {B.C.E. 4714-12-30 23:59:59 -- -000002} \ - 108000 {B.C.E. 4714-12-30 18:00:00 -- -000002} \ - 129600 {B.C.E. 4714-12-30 12:00:00 -- -000002} \ - 172800 {B.C.E. 4714-12-30 00:00:00 -- -000002} \ + -172800 {B.C.E. 4713-01-03 00:00:00 -- 0000002 2.0 1.5} \ + -129600 {B.C.E. 4713-01-02 12:00:00 -- 0000001 1.5 1.0} \ + -86400 {B.C.E. 4713-01-02 00:00:00 -- 0000001 1.0 0.5} \ + -43200 {B.C.E. 4713-01-01 12:00:00 -- 0000000 0.5 0.0} \ + -1 {B.C.E. 4713-01-01 00:00:01 -- 0000000 0.00001157 -0.49998843} \ + 0 {B.C.E. 4713-01-01 00:00:00 -- 0000000 0.0 -0.5} \ + 1 {B.C.E. 4714-12-31 23:59:59 -- -000001 -0.00001157 -0.50001157} \ + 21600 {B.C.E. 4714-12-31 18:00:00 -- -000001 -0.25 -0.75} \ + 43199 {B.C.E. 4714-12-31 12:00:01 -- -000001 -0.49998843 -0.99998843} \ + 43200 {B.C.E. 4714-12-31 12:00:00 -- -000001 -0.5 -1.0} \ + 86399 {B.C.E. 4714-12-31 00:00:01 -- -000001 -0.99998843 -1.49998843} \ + 86400 {B.C.E. 4714-12-31 00:00:00 -- -000001 -1.0 -1.5} \ + 86401 {B.C.E. 4714-12-30 23:59:59 -- -000002 -1.00001157 -1.50001157} \ + 108000 {B.C.E. 4714-12-30 18:00:00 -- -000002 -1.25 -1.75} \ + 129600 {B.C.E. 4714-12-30 12:00:00 -- -000002 -1.5 -2.0} \ + 172800 {B.C.E. 4714-12-30 00:00:00 -- -000002 -2.0 -2.5} \ ] test clock-4.97.9 { format JDN/JD (calendar and astronomical) } { set res {} @@ -15420,19 +15420,19 @@ test clock-4.97.9 { format JDN/JD (calendar and astronomical) } { 43199 43200 43201 86400 } { lappend res $i [clock format [expr 653133196800 + $i] \ - -format {%Y-%m-%d %T -- %J} -gmt true] + -format {%Y-%m-%d %T -- %J %EJ %Ej} -gmt true] } set res } [list \ - -86400 {22666-12-19 00:00:00 -- 9999999} \ - -43200 {22666-12-19 12:00:00 -- 9999999} \ - -1 {22666-12-19 23:59:59 -- 9999999} \ - 0 {22666-12-20 00:00:00 -- 10000000} \ - 1 {22666-12-20 00:00:01 -- 10000000} \ - 43199 {22666-12-20 11:59:59 -- 10000000} \ - 43200 {22666-12-20 12:00:00 -- 10000000} \ - 43201 {22666-12-20 12:00:01 -- 10000000} \ - 86400 {22666-12-21 00:00:00 -- 10000001} \ + -86400 {22666-12-19 00:00:00 -- 9999999 9999999.0 9999998.5} \ + -43200 {22666-12-19 12:00:00 -- 9999999 9999999.5 9999999.0} \ + -1 {22666-12-19 23:59:59 -- 9999999 9999999.99998843 9999999.49998843} \ + 0 {22666-12-20 00:00:00 -- 10000000 10000000.0 9999999.5} \ + 1 {22666-12-20 00:00:01 -- 10000000 10000000.00001157 9999999.50001157} \ + 43199 {22666-12-20 11:59:59 -- 10000000 10000000.49998843 9999999.99998843} \ + 43200 {22666-12-20 12:00:00 -- 10000000 10000000.5 10000000.0} \ + 43201 {22666-12-20 12:00:01 -- 10000000 10000000.50001157 10000000.00001157} \ + 86400 {22666-12-21 00:00:00 -- 10000001 10000001.0 10000000.5} \ ] # END testcases4 -- cgit v0.12 From e9541d428e336896dbf1d2a0d128e81808fbc40e Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 13 Mar 2019 00:24:44 +0000 Subject: scan: all JDN/JD are signed, so allow parse negative Julian days --- generic/tclClockFmt.c | 12 ++++++------ tests/clock.test | 11 +++++++++++ 2 files changed, 17 insertions(+), 6 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index d4e82ad..8e14a7d 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -1596,12 +1596,12 @@ ClockScnToken_JDN_Proc(ClockFmtScnCmdArgs *opts, end = yyInput + maxLen; /* currently positive astronomic dates only */ - if (*p == '+') { p++; }; + if (*p == '+' || *p == '-') { p++; }; s = p; while (p < end && isdigit(UCHAR(*p))) { p++; } - if ( _str2wideInt(&intJD, s, p, 1) != TCL_OK) { + if ( _str2wideInt(&intJD, s, p, (*yyInput != '-' ? 1 : -1)) != TCL_OK) { return TCL_RETURN; }; yyInput = p; @@ -1644,7 +1644,7 @@ done: + ( SECONDS_PER_DAY * intJD ) + ( fractJD ); - info->flags |= CLF_POSIXSEC | CLF_SIGNED; + info->flags |= CLF_POSIXSEC; return TCL_OK; } @@ -1838,7 +1838,7 @@ static ClockScanTokenMap ScnSTokenMap[] = { {CTOKT_PARSER, 0, 0, 0, 0xffff, 0, ClockScnToken_amPmInd_Proc, NULL}, /* %J */ - {CTOKT_WIDE, CLF_JULIANDAY, 0, 1, 0xffff, TclOffset(DateInfo, date.julianDay), + {CTOKT_WIDE, CLF_JULIANDAY | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.julianDay), NULL}, /* %j */ {CTOKT_INT, CLF_DAYOFYEAR, 0, 1, 3, TclOffset(DateInfo, date.dayOfYear), @@ -1887,10 +1887,10 @@ static ClockScanTokenMap ScnETokenMap[] = { {CTOKT_PARSER, 0, 0, 0, 0xffff, TclOffset(DateInfo, date.year), ClockScnToken_LocaleERA_Proc, (void *)MCLIT_LOCALE_NUMERALS}, /* %EJ */ - {CTOKT_PARSER, CLF_JULIANDAY, 0, 1, 0xffff, 0, /* calendar JDN starts at midnight */ + {CTOKT_PARSER, CLF_JULIANDAY | CLF_SIGNED, 0, 1, 0xffff, 0, /* calendar JDN starts at midnight */ ClockScnToken_JDN_Proc, NULL}, /* %Ej */ - {CTOKT_PARSER, CLF_JULIANDAY, 0, 1, 0xffff, (SECONDS_PER_DAY/2), /* astro JDN starts at noon */ + {CTOKT_PARSER, CLF_JULIANDAY | CLF_SIGNED, 0, 1, 0xffff, (SECONDS_PER_DAY/2), /* astro JDN starts at noon */ ClockScnToken_JDN_Proc, NULL}, /* %Ey */ {CTOKT_PARSER, 0, 0, 0, 0xffff, 0, /* currently no capture, parse only token */ diff --git a/tests/clock.test b/tests/clock.test index 9a949a9..8a0ed13 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18974,6 +18974,17 @@ test clock-7.19 {Astronomical JDN/JD, two values} { clock scan {2440588 2440589} -format {%Ej %Ej} -gmt true } 129600 +test clock-7.20 {all JDN/JD are signed (and extended accept floats)} { + set res {} + foreach i {%J %EJ %Ej} { + lappend res [clock scan "-1" -format $i -gmt 1] + } + foreach i {%EJ %Ej} { + lappend res [clock scan "-1.5" -format $i -gmt 1] + } + set res +} {-210866889600 -210866889600 -210866846400 -210866846400 -210866803200} + # BEGIN testcases8 # Test parsing of ccyymmdd -- cgit v0.12 From c587280d004ba2c60c5b1ce29dfecd3b6dc12e6d Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 15 Jul 2019 12:12:05 +0000 Subject: **interim** try simplify info-structure (replace yyHave... with flags) --- generic/tclClock.c | 56 ++++++++++++++++++++++-------------------------- generic/tclDate.c | 60 +++++++++++++++++++++++++--------------------------- generic/tclDate.h | 26 ++++++++++------------- generic/tclGetDate.y | 46 +++++++++++++++++++--------------------- 4 files changed, 87 insertions(+), 101 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 7f31411..14aaf2a 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -3794,14 +3794,14 @@ ClockValidDate( } /* first year (used later in hath / daysInPriorMonths) */ - if ((info->flags & (CLF_YEAR|CLF_ISO8601YEAR)) || yyHaveDate) { + if ((info->flags & (CLF_YEAR|CLF_ISO8601YEAR))) { if ((info->flags & CLF_ISO8601YEAR)) { if ( yydate.iso8601Year < dataPtr->validMinYear || yydate.iso8601Year > dataPtr->validMaxYear ) { errMsg = "invalid iso year"; errCode = "iso year"; goto error; } } - if ((info->flags & CLF_YEAR) || yyHaveDate) { + if (info->flags & CLF_YEAR) { if ( yyYear < dataPtr->validMinYear || yyYear > dataPtr->validMaxYear ) { errMsg = "invalid year"; errCode = "year"; goto error; @@ -3817,14 +3817,14 @@ ClockValidDate( } } /* and month (used later in hath) */ - if ((info->flags & CLF_MONTH) || yyHaveDate) { + if (info->flags & (CLF_MONTH|CLF_DATE)) { info->flags |= CLF_MONTH; if ( yyMonth < 1 || yyMonth > 12 ) { errMsg = "invalid month"; errCode = "month"; goto error; } } /* day of month */ - if ((info->flags & CLF_DAYOFMONTH) || (yyHaveDate || yyHaveDay)) { + if (info->flags & (CLF_DAYOFMONTH|CLF_DAYOFWEEK)) { info->flags |= CLF_DAYOFMONTH; if ( yyDay < 1 || yyDay > 31 ) { errMsg = "invalid day"; errCode = "day"; goto error; @@ -3837,7 +3837,7 @@ ClockValidDate( } } } - if ((info->flags & CLF_DAYOFYEAR)) { + if (info->flags & CLF_DAYOFYEAR) { if ( yydate.dayOfYear < 1 || yydate.dayOfYear > daysInPriorMonths[IsGregorianLeapYear(&yydate)][12] ) { errMsg = "invalid day of year"; errCode = "day of year"; goto error; @@ -3857,7 +3857,7 @@ ClockValidDate( } } - if ((info->flags & CLF_TIME) || yyHaveTime) { + if (info->flags & CLF_TIME) { /* hour */ if ( yyHour < 0 || yyHour > ((yyMeridian == MER24) ? 23 : 12) ) { errMsg = "invalid time (hour)"; errCode = "hour"; goto error; @@ -3884,7 +3884,7 @@ ClockValidDate( /* time, regarding the modifications by the time-zone (looks for given time * in between DST-time hole, so does not exist in this time-zone) */ - if (((info->flags & CLF_TIME) || yyHaveTime)) { + if (info->flags & CLF_TIME) { /* * we don't need to do the backwards time-conversion (UTC to local) and * compare results, because the after conversion (local to UTC) we @@ -3971,7 +3971,7 @@ ClockFreeScan( * midnight. */ - if (yyHaveDate) { + if (info->flags & CLF_YEAR) { if (yyYear < 100) { if (yyYear >= dataPtr->yearOfCenturySwitch) { yyYear -= 100; @@ -3979,9 +3979,6 @@ ClockFreeScan( yyYear += dataPtr->currentYearCentury; } yydate.era = CE; - if (yyHaveTime == 0) { - yyHaveTime = -1; - } info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS; } @@ -3990,7 +3987,7 @@ ClockFreeScan( * zone indicator of +-hhmm and setup this time zone. */ - if (yyHaveZone) { + if (info->flags & CLF_ZONE) { Tcl_Obj *tzObjStor = NULL; int minEast = -yyTimezone; int dstFlag = 1 - yyDSTmode; @@ -4024,20 +4021,20 @@ ClockFreeScan( * Assemble date, time, zone into seconds-from-epoch */ - if (yyHaveTime == -1) { + if ((info->flags & (CLF_TIME|CLF_HAVEDATE)) == CLF_HAVEDATE) { yySecondOfDay = 0; info->flags |= CLF_ASSEMBLE_SECONDS; } else - if (yyHaveTime) { + if (info->flags & CLF_TIME) { yySecondOfDay = ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian); info->flags |= CLF_ASSEMBLE_SECONDS; } else - if ( (yyHaveDay && !yyHaveDate) - || yyHaveOrdinalMonth - || ( yyHaveRel + if ( (info->flags & (CLF_DAYOFWEEK|CLF_HAVEDATE)) == CLF_DAYOFWEEK + || (info->flags & CLF_ORDINALMONTH) + || ( (info->flags & CLF_RELCONV) && ( yyRelMonth != 0 || yyRelDay != 0 ) ) ) { @@ -4090,7 +4087,7 @@ ClockCalcRelTime( */ repeat_rel: - if (yyHaveRel) { + if (info->flags & CLF_RELCONV) { /* * Relative conversion normally possible in UTC time only, because @@ -4162,14 +4159,14 @@ repeat_rel: } } - yyHaveRel = 0; + info->flags &= ~CLF_RELCONV; } /* * Do relative (ordinal) month */ - if (yyHaveOrdinalMonth) { + if (info->flags & CLF_ORDINALMONTH) { int monthDiff; /* if needed extract year, month, etc. again */ @@ -4195,12 +4192,10 @@ repeat_rel: } /* process it further via relative times */ - yyHaveRel++; yyYear += yyMonthOrdinalIncr; yyRelMonth += monthDiff; - yyHaveOrdinalMonth = 0; - - info->flags |= CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS; + info->flags &= ~CLF_ORDINALMONTH; + info->flags |= CLF_RELCONV|CLF_ASSEMBLE_JULIANDAY|CLF_ASSEMBLE_SECONDS; goto repeat_rel; } @@ -4209,12 +4204,11 @@ repeat_rel: * Do relative weekday */ - if (yyHaveDay && !yyHaveDate) { + if ((info->flags & (CLF_DAYOFWEEK|CLF_HAVEDATE)) == CLF_DAYOFWEEK) { /* restore scanned day of week */ - if (info->flags & CLF_DAYOFWEEK) { - yyDayOfWeek = prevDayOfWeek; - } + yyDayOfWeek = prevDayOfWeek; + /* if needed assemble julianDay now */ if (info->flags & CLF_ASSEMBLE_JULIANDAY) { GetJulianDayFromEraYearMonthDay(&yydate, GREGORIAN_CHANGE_DATE); @@ -4420,7 +4414,7 @@ ClockAddObjCmd( * correct date info, because the date may be changed, * so refresh it now */ - if ( yyHaveRel + if ( (info->flags & CLF_RELCONV) && ( unitIndex == CLC_ADD_WEEKDAYS /* some months can be shorter as another */ || yyRelMonth || yyRelDay @@ -4435,7 +4429,7 @@ ClockAddObjCmd( } /* process increment by offset + unit */ - yyHaveRel++; + info->flags |= CLF_RELCONV; switch (unitIndex) { case CLC_ADD_YEARS: yyRelMonth += offs * 12; @@ -4472,7 +4466,7 @@ ClockAddObjCmd( * Do relative times (if not yet already processed interim): */ - if (yyHaveRel) { + if (info->flags & CLF_RELCONV) { if (ClockCalcRelTime(info, &opts) != TCL_OK) { goto done; } diff --git a/generic/tclDate.c b/generic/tclDate.c index 7badb1f..b0979cc 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -123,6 +123,13 @@ #define SECSPERDAY (24L * 60L * 60L) #define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0)) +#define yyIncrFlags(f) \ + do { \ + info->errFlags |= (info->flags & (f)); \ + if (info->errFlags) { YYABORT; } \ + info->flags |= (f); \ + } while (0); + /* * An entry in the lexical lookup table. */ @@ -551,13 +558,13 @@ static const yytype_uint8 yytranslate[] = /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_uint16 yyrline[] = { - 0, 160, 160, 161, 162, 165, 168, 171, 174, 177, - 180, 183, 187, 192, 195, 201, 207, 215, 219, 223, - 227, 231, 235, 241, 242, 245, 250, 255, 260, 265, - 270, 277, 281, 286, 291, 296, 301, 305, 310, 314, - 319, 326, 330, 336, 345, 353, 361, 370, 380, 394, - 399, 402, 405, 408, 411, 414, 417, 422, 425, 430, - 434, 438, 444, 447, 452, 470, 473 + 0, 167, 167, 168, 169, 172, 175, 178, 181, 184, + 187, 190, 193, 196, 199, 205, 211, 219, 223, 227, + 231, 235, 239, 245, 246, 249, 253, 257, 261, 265, + 269, 275, 279, 284, 289, 294, 299, 303, 308, 312, + 317, 324, 328, 334, 343, 351, 359, 368, 378, 392, + 397, 400, 403, 406, 409, 412, 415, 420, 423, 428, + 432, 436, 442, 445, 450, 468, 471 }; #endif @@ -1501,7 +1508,7 @@ yyreduce: case 5: { - yyHaveTime++; + yyIncrFlags(CLF_TIME); } break; @@ -1509,7 +1516,7 @@ yyreduce: case 6: { - yyHaveZone++; + yyIncrFlags(CLF_ZONE); } break; @@ -1517,7 +1524,7 @@ yyreduce: case 7: { - yyHaveDate++; + yyIncrFlags(CLF_HAVEDATE); } break; @@ -1525,7 +1532,7 @@ yyreduce: case 8: { - yyHaveOrdinalMonth++; + yyIncrFlags(CLF_ORDINALMONTH); } break; @@ -1533,7 +1540,7 @@ yyreduce: case 9: { - yyHaveDay++; + yyIncrFlags(CLF_DAYOFWEEK); } break; @@ -1541,7 +1548,7 @@ yyreduce: case 10: { - yyHaveRel++; + yyIncrFlags(CLF_RELCONV); } break; @@ -1549,8 +1556,7 @@ yyreduce: case 11: { - yyHaveTime++; - yyHaveDate++; + yyIncrFlags(CLF_TIME|CLF_HAVEDATE); } break; @@ -1558,9 +1564,7 @@ yyreduce: case 12: { - yyHaveTime++; - yyHaveDate++; - yyHaveRel++; + yyIncrFlags(CLF_TIME|CLF_HAVEDATE|CLF_RELCONV); } break; @@ -1657,7 +1661,6 @@ yyreduce: { yyDayOrdinal = 1; yyDayOfWeek = (yyvsp[0].Number); - info->flags |= CLF_DAYOFWEEK; } break; @@ -1667,7 +1670,6 @@ yyreduce: { yyDayOrdinal = 1; yyDayOfWeek = (yyvsp[-1].Number); - info->flags |= CLF_DAYOFWEEK; } break; @@ -1677,7 +1679,6 @@ yyreduce: { yyDayOrdinal = (yyvsp[-1].Number); yyDayOfWeek = (yyvsp[0].Number); - info->flags |= CLF_DAYOFWEEK; } break; @@ -1687,7 +1688,6 @@ yyreduce: { yyDayOrdinal = (yyvsp[-3].Number) * (yyvsp[-1].Number); yyDayOfWeek = (yyvsp[0].Number); - info->flags |= CLF_DAYOFWEEK; } break; @@ -1697,7 +1697,6 @@ yyreduce: { yyDayOrdinal = (yyvsp[-2].Number) * (yyvsp[-1].Number); yyDayOfWeek = (yyvsp[0].Number); - info->flags |= CLF_DAYOFWEEK; } break; @@ -1707,7 +1706,6 @@ yyreduce: { yyDayOrdinal = 2; yyDayOfWeek = (yyvsp[0].Number); - info->flags |= CLF_DAYOFWEEK; } break; @@ -2031,10 +2029,10 @@ yyreduce: case 64: { - if (yyHaveTime && yyHaveDate && !yyHaveRel) { + if ((info->flags & (CLF_TIME|CLF_HAVEDATE|CLF_RELCONV)) == (CLF_TIME|CLF_HAVEDATE)) { yyYear = (yyvsp[0].Number); } else { - yyHaveTime++; + yyIncrFlags(CLF_TIME); if (yyDigitCount <= 2) { yyHour = (yyvsp[0].Number); yyMinutes = 0; @@ -2855,31 +2853,31 @@ TclClockFreeScan( } Tcl_DecrRefCount(info->messages); - if (yyHaveDate > 1) { + if (info->errFlags & CLF_HAVEDATE) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one date in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } - if (yyHaveTime > 1) { + if (info->errFlags & CLF_TIME) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one time of day in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } - if (yyHaveZone > 1) { + if (info->errFlags & CLF_ZONE) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one time zone in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } - if (yyHaveDay > 1) { + if (info->errFlags & CLF_DAYOFWEEK) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one weekday in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } - if (yyHaveOrdinalMonth > 1) { + if (info->errFlags & CLF_ORDINALMONTH) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one ordinal month in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); diff --git a/generic/tclDate.h b/generic/tclDate.h index 568aef1..5616b13 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -37,6 +37,7 @@ #define CLF_LOCALSEC (1 << 2) #define CLF_JULIANDAY (1 << 3) #define CLF_TIME (1 << 4) +#define CLF_ZONE (1 << 5) #define CLF_CENTURY (1 << 6) #define CLF_DAYOFMONTH (1 << 7) #define CLF_DAYOFYEAR (1 << 8) @@ -46,12 +47,19 @@ #define CLF_ISO8601YEAR (1 << 12) #define CLF_ISO8601WEAK (1 << 13) #define CLF_ISO8601CENTURY (1 << 14) -#define CLF_SIGNED (1 << 15) + +#define CLF_SIGNED (1 << 16) + +/* extra flags used outside of scan/format-tokens too (int, not a short int) */ +#define CLF_RELCONV (1 << 17) +#define CLF_ORDINALMONTH (1 << 18) + /* On demand (lazy) assemble flags */ #define CLF_ASSEMBLE_DATE (1 << 28) /* assemble year, month, etc. using julianDay */ #define CLF_ASSEMBLE_JULIANDAY (1 << 29) /* assemble julianDay using year, month, etc. */ #define CLF_ASSEMBLE_SECONDS (1 << 30) /* assemble localSeconds (and seconds at end) */ +#define CLF_HAVEDATE (CLF_DAYOFMONTH|CLF_MONTH|CLF_YEAR|CLF_ISO8601YEAR) #define CLF_DATE (CLF_JULIANDAY | CLF_DAYOFMONTH | CLF_DAYOFYEAR | \ CLF_MONTH | CLF_YEAR | CLF_ISO8601YEAR | \ CLF_DAYOFWEEK | CLF_ISO8601WEAK) @@ -185,28 +193,22 @@ typedef struct DateInfo { TclDateFields date; - int flags; - - int dateHaveDate; + int flags; /* Signals parts of date/time get found */ + int errFlags; /* Signals error (part of date/time found twice) */ int dateMeridian; - int dateHaveTime; int dateTimezone; int dateDSTmode; - int dateHaveZone; int dateRelMonth; int dateRelDay; int dateRelSeconds; - int dateHaveRel; int dateMonthOrdinalIncr; int dateMonthOrdinal; - int dateHaveOrdinalMonth; int dateDayOrdinal; - int dateHaveDay; int *dateRelPointer; @@ -235,12 +237,6 @@ typedef struct DateInfo { #define yyDayOfWeek (info->date.dayOfWeek) #define yyMonthOrdinalIncr (info->dateMonthOrdinalIncr) #define yyMonthOrdinal (info->dateMonthOrdinal) -#define yyHaveDate (info->dateHaveDate) -#define yyHaveDay (info->dateHaveDay) -#define yyHaveOrdinalMonth (info->dateHaveOrdinalMonth) -#define yyHaveRel (info->dateHaveRel) -#define yyHaveTime (info->dateHaveTime) -#define yyHaveZone (info->dateHaveZone) #define yyTimezone (info->dateTimezone) #define yyMeridian (info->dateMeridian) #define yyRelMonth (info->dateRelMonth) diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 88432ec..cf1f674 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -75,6 +75,13 @@ #define SECSPERDAY (24L * 60L * 60L) #define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0)) +#define yyIncrFlags(f) \ + do { \ + info->errFlags |= (info->flags & (f)); \ + if (info->errFlags) { YYABORT; } \ + info->flags |= (f); \ + } while (0); + /* * An entry in the lexical lookup table. */ @@ -163,31 +170,28 @@ spec : /* NULL */ ; item : time { - yyHaveTime++; + yyIncrFlags(CLF_TIME); } | zone { - yyHaveZone++; + yyIncrFlags(CLF_ZONE); } | date { - yyHaveDate++; + yyIncrFlags(CLF_HAVEDATE); } | ordMonth { - yyHaveOrdinalMonth++; + yyIncrFlags(CLF_ORDINALMONTH); } | day { - yyHaveDay++; + yyIncrFlags(CLF_DAYOFWEEK); } | relspec { - yyHaveRel++; + yyIncrFlags(CLF_RELCONV); } | iso { - yyHaveTime++; - yyHaveDate++; + yyIncrFlags(CLF_TIME|CLF_HAVEDATE); } | trek { - yyHaveTime++; - yyHaveDate++; - yyHaveRel++; + yyIncrFlags(CLF_TIME|CLF_HAVEDATE|CLF_RELCONV); } | number ; @@ -245,32 +249,26 @@ comma : ',' day : tDAY { yyDayOrdinal = 1; yyDayOfWeek = $1; - info->flags |= CLF_DAYOFWEEK; } | tDAY comma { yyDayOrdinal = 1; yyDayOfWeek = $1; - info->flags |= CLF_DAYOFWEEK; } | tUNUMBER tDAY { yyDayOrdinal = $1; yyDayOfWeek = $2; - info->flags |= CLF_DAYOFWEEK; } | sign SP tUNUMBER tDAY { yyDayOrdinal = $1 * $3; yyDayOfWeek = $4; - info->flags |= CLF_DAYOFWEEK; } | sign tUNUMBER tDAY { yyDayOrdinal = $1 * $2; yyDayOfWeek = $3; - info->flags |= CLF_DAYOFWEEK; } | tNEXT tDAY { yyDayOrdinal = 2; yyDayOfWeek = $2; - info->flags |= CLF_DAYOFWEEK; } ; @@ -450,10 +448,10 @@ INTNUM : tUNUMBER { ; number : INTNUM { - if (yyHaveTime && yyHaveDate && !yyHaveRel) { + if ((info->flags & (CLF_TIME|CLF_HAVEDATE|CLF_RELCONV)) == (CLF_TIME|CLF_HAVEDATE)) { yyYear = $1; } else { - yyHaveTime++; + yyIncrFlags(CLF_TIME); if (yyDigitCount <= 2) { yyHour = $1; yyMinutes = 0; @@ -1029,31 +1027,31 @@ TclClockFreeScan( } Tcl_DecrRefCount(info->messages); - if (yyHaveDate > 1) { + if (info->errFlags & CLF_HAVEDATE) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one date in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } - if (yyHaveTime > 1) { + if (info->errFlags & CLF_TIME) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one time of day in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } - if (yyHaveZone > 1) { + if (info->errFlags & CLF_ZONE) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one time zone in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } - if (yyHaveDay > 1) { + if (info->errFlags & CLF_DAYOFWEEK) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one weekday in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); return TCL_ERROR; } - if (yyHaveOrdinalMonth > 1) { + if (info->errFlags & CLF_ORDINALMONTH) { Tcl_SetObjResult(interp, Tcl_NewStringObj("more than one ordinal month in string", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); -- cgit v0.12 From 9f872f5338b49bea2e8022380a50c2257e42f26d Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 15 Jul 2019 12:12:22 +0000 Subject: simplifying info-structure, usage of flags etc (normalizing in order to use same flags as by formatted scan instead of members like yyHave...); (additionally allocates info->messages object on demand, if free scan fails) --- generic/tclClock.c | 4 +-- generic/tclDate.c | 90 +++++++++++++++++++++++----------------------------- generic/tclDate.h | 4 +-- generic/tclGetDate.y | 78 +++++++++++++++++++-------------------------- 4 files changed, 75 insertions(+), 101 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 14aaf2a..828a2a6 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -3817,15 +3817,13 @@ ClockValidDate( } } /* and month (used later in hath) */ - if (info->flags & (CLF_MONTH|CLF_DATE)) { - info->flags |= CLF_MONTH; + if (info->flags & CLF_MONTH) { if ( yyMonth < 1 || yyMonth > 12 ) { errMsg = "invalid month"; errCode = "month"; goto error; } } /* day of month */ if (info->flags & (CLF_DAYOFMONTH|CLF_DAYOFWEEK)) { - info->flags |= CLF_DAYOFMONTH; if ( yyDay < 1 || yyDay > 31 ) { errMsg = "invalid day"; errCode = "day"; goto error; } diff --git a/generic/tclDate.c b/generic/tclDate.c index b0979cc..df8aeb5 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -559,12 +559,12 @@ static const yytype_uint8 yytranslate[] = static const yytype_uint16 yyrline[] = { 0, 167, 167, 168, 169, 172, 175, 178, 181, 184, - 187, 190, 193, 196, 199, 205, 211, 219, 223, 227, - 231, 235, 239, 245, 246, 249, 253, 257, 261, 265, - 269, 275, 279, 284, 289, 294, 299, 303, 308, 312, - 317, 324, 328, 334, 343, 351, 359, 368, 378, 392, - 397, 400, 403, 406, 409, 412, 415, 420, 423, 428, - 432, 436, 442, 445, 450, 468, 471 + 187, 190, 193, 197, 200, 206, 212, 220, 224, 228, + 232, 236, 240, 246, 247, 250, 254, 258, 262, 266, + 270, 276, 280, 285, 290, 295, 300, 304, 309, 313, + 318, 325, 329, 335, 344, 352, 360, 369, 379, 393, + 398, 401, 404, 407, 410, 413, 416, 421, 424, 429, + 433, 437, 443, 446, 451, 469, 472 }; #endif @@ -1548,7 +1548,7 @@ yyreduce: case 10: { - yyIncrFlags(CLF_RELCONV); + info->flags |= CLF_RELCONV; } break; @@ -1564,7 +1564,8 @@ yyreduce: case 12: { - yyIncrFlags(CLF_TIME|CLF_HAVEDATE|CLF_RELCONV); + yyIncrFlags(CLF_TIME|CLF_HAVEDATE); + info->flags |= CLF_RELCONV; } break; @@ -2524,6 +2525,9 @@ TclDateerror( const char *s) { Tcl_Obj* t; + if (!infoPtr->messages) { + infoPtr->messages = Tcl_NewObj(); + } Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1); Tcl_AppendToObj(infoPtr->messages, s, -1); Tcl_AppendToObj(infoPtr->messages, " (characters ", -1); @@ -2821,9 +2825,7 @@ TclClockFreeScan( yyDSTmode = DSTmaybe; - info->messages = Tcl_NewObj(); info->separatrix = ""; - Tcl_IncrRefCount(info->messages); info->dateStart = yyInput; @@ -2833,58 +2835,44 @@ TclClockFreeScan( /* parse */ status = yyparse(info); if (status == 1) { - Tcl_SetObjResult(interp, info->messages); - Tcl_DecrRefCount(info->messages); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL); - return TCL_ERROR; + const char *msg = NULL; + if (info->errFlags & CLF_HAVEDATE) { + msg = "more than one date in string"; + } else if (info->errFlags & CLF_TIME) { + msg = "more than one time of day in string"; + } else if (info->errFlags & CLF_ZONE) { + msg = "more than one time zone in string"; + } else if (info->errFlags & CLF_DAYOFWEEK) { + msg = "more than one weekday in string"; + } else if (info->errFlags & CLF_ORDINALMONTH) { + msg = "more than one ordinal month in string"; + } + if (msg) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); + } else { + Tcl_SetObjResult(interp, + info->messages ? info->messages : Tcl_NewObj()); + info->messages = NULL; + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL); + } + status = TCL_ERROR; } else if (status == 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1)); - Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); - return TCL_ERROR; + status = TCL_ERROR; } else if (status != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned " "from date parser. Please " "report this error as a " "bug in Tcl.", -1)); - Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "BUG", NULL); - return TCL_ERROR; + status = TCL_ERROR; } - Tcl_DecrRefCount(info->messages); - - if (info->errFlags & CLF_HAVEDATE) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("more than one date in string", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); - return TCL_ERROR; - } - if (info->errFlags & CLF_TIME) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("more than one time of day in string", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); - return TCL_ERROR; - } - if (info->errFlags & CLF_ZONE) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("more than one time zone in string", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); - return TCL_ERROR; - } - if (info->errFlags & CLF_DAYOFWEEK) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("more than one weekday in string", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); - return TCL_ERROR; - } - if (info->errFlags & CLF_ORDINALMONTH) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("more than one ordinal month in string", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); - return TCL_ERROR; + if (info->messages) { + Tcl_DecrRefCount(info->messages); } - - return TCL_OK; + return status; } /* diff --git a/generic/tclDate.h b/generic/tclDate.h index 5616b13..0c9f7c3 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -48,7 +48,7 @@ #define CLF_ISO8601WEAK (1 << 13) #define CLF_ISO8601CENTURY (1 << 14) -#define CLF_SIGNED (1 << 16) +#define CLF_SIGNED (1 << 15) /* extra flags used outside of scan/format-tokens too (int, not a short int) */ #define CLF_RELCONV (1 << 17) @@ -59,7 +59,7 @@ #define CLF_ASSEMBLE_JULIANDAY (1 << 29) /* assemble julianDay using year, month, etc. */ #define CLF_ASSEMBLE_SECONDS (1 << 30) /* assemble localSeconds (and seconds at end) */ -#define CLF_HAVEDATE (CLF_DAYOFMONTH|CLF_MONTH|CLF_YEAR|CLF_ISO8601YEAR) +#define CLF_HAVEDATE (CLF_DAYOFMONTH|CLF_MONTH|CLF_YEAR) #define CLF_DATE (CLF_JULIANDAY | CLF_DAYOFMONTH | CLF_DAYOFYEAR | \ CLF_MONTH | CLF_YEAR | CLF_ISO8601YEAR | \ CLF_DAYOFWEEK | CLF_ISO8601WEAK) diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index cf1f674..8594a3e 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -185,13 +185,14 @@ item : time { yyIncrFlags(CLF_DAYOFWEEK); } | relspec { - yyIncrFlags(CLF_RELCONV); + info->flags |= CLF_RELCONV; } | iso { yyIncrFlags(CLF_TIME|CLF_HAVEDATE); } | trek { - yyIncrFlags(CLF_TIME|CLF_HAVEDATE|CLF_RELCONV); + yyIncrFlags(CLF_TIME|CLF_HAVEDATE); + info->flags |= CLF_RELCONV; } | number ; @@ -698,6 +699,9 @@ TclDateerror( const char *s) { Tcl_Obj* t; + if (!infoPtr->messages) { + infoPtr->messages = Tcl_NewObj(); + } Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1); Tcl_AppendToObj(infoPtr->messages, s, -1); Tcl_AppendToObj(infoPtr->messages, " (characters ", -1); @@ -995,9 +999,7 @@ TclClockFreeScan( yyDSTmode = DSTmaybe; - info->messages = Tcl_NewObj(); info->separatrix = ""; - Tcl_IncrRefCount(info->messages); info->dateStart = yyInput; @@ -1007,58 +1009,44 @@ TclClockFreeScan( /* parse */ status = yyparse(info); if (status == 1) { - Tcl_SetObjResult(interp, info->messages); - Tcl_DecrRefCount(info->messages); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL); - return TCL_ERROR; + const char *msg = NULL; + if (info->errFlags & CLF_HAVEDATE) { + msg = "more than one date in string"; + } else if (info->errFlags & CLF_TIME) { + msg = "more than one time of day in string"; + } else if (info->errFlags & CLF_ZONE) { + msg = "more than one time zone in string"; + } else if (info->errFlags & CLF_DAYOFWEEK) { + msg = "more than one weekday in string"; + } else if (info->errFlags & CLF_ORDINALMONTH) { + msg = "more than one ordinal month in string"; + } + if (msg) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); + } else { + Tcl_SetObjResult(interp, + info->messages ? info->messages : Tcl_NewObj()); + info->messages = NULL; + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL); + } + status = TCL_ERROR; } else if (status == 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1)); - Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); - return TCL_ERROR; + status = TCL_ERROR; } else if (status != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned " "from date parser. Please " "report this error as a " "bug in Tcl.", -1)); - Tcl_DecrRefCount(info->messages); Tcl_SetErrorCode(interp, "TCL", "BUG", NULL); - return TCL_ERROR; + status = TCL_ERROR; } - Tcl_DecrRefCount(info->messages); - - if (info->errFlags & CLF_HAVEDATE) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("more than one date in string", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); - return TCL_ERROR; - } - if (info->errFlags & CLF_TIME) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("more than one time of day in string", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); - return TCL_ERROR; - } - if (info->errFlags & CLF_ZONE) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("more than one time zone in string", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); - return TCL_ERROR; - } - if (info->errFlags & CLF_DAYOFWEEK) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("more than one weekday in string", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); - return TCL_ERROR; - } - if (info->errFlags & CLF_ORDINALMONTH) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("more than one ordinal month in string", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); - return TCL_ERROR; + if (info->messages) { + Tcl_DecrRefCount(info->messages); } - - return TCL_OK; + return status; } /* -- cgit v0.12 From 8b9f762113baf4a70fff339bc583e8861c2a7e55 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 15 Jul 2019 12:18:52 +0000 Subject: Fixes sebres/tclclockmod#18 (Fails to parse short month name for June); The reason for that was the wrong length calculation by scanning through my string index tree, so the ambiguity check `j->(jan,ju->(jun,jul))` failed for 2nd element Ju(ne) with length 2. Simple fix and test-cases covering that, but it looks like this has a good potential for speedup (todo: move length calculation from search to build) --- generic/tclStrIdxTree.c | 2 +- tests/clock.test | 26 +++++++++++++++++++++++++- 2 files changed, 26 insertions(+), 2 deletions(-) diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c index 88a64c6..a54b548 100644 --- a/generic/tclStrIdxTree.c +++ b/generic/tclStrIdxTree.c @@ -96,7 +96,7 @@ TclStrIdxTreeSearch( /* search in tree */ do { cinf = cin = TclGetString(item->key) + offs; - f = TclUtfFindEqualNCInLwr(s, end, cin, cin + item->length, &cinf); + f = TclUtfFindEqualNCInLwr(s, end, cin, cin + item->length - offs, &cinf); /* if something was found */ if (f > s) { /* if whole string was found */ diff --git a/tests/clock.test b/tests/clock.test index f8654e9..4a70140 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18687,10 +18687,34 @@ test clock-6.11 {input of seconds - two values} { clock scan {1 2} -format {%s %s} -gmt true } 2 -test clock-6.12 {input of unambiguous short locale token (%b)} { +test clock-6.12.0 {input of unambiguous short locale token (%b)} { list [clock scan "12 Ja 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] \ [clock scan "12 Au 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] } {979257600 997574400} +test clock-6.12.1 {input of all forms of unambiguous short locale token (%b)} { + # find all unambiguous short forms and check it'll be scanned successful and correctly: + set months {January February March April May June July August September October November December} + set res {} + foreach mon $months { + set i 0 + while {[incr i] < [string length $mon]} { + # short month form: + set shm [string range $mon 0 $i] + # ignore ambiguous: + if {[llength [lsearch -all -glob $months "${shm}*"]] > 1} continue + set s "12 $shm 2001" + # scan and format with full month name: + set t [clock format \ + [clock scan $s -format "%d %b %Y" -locale en_US_roman -gmt 1] \ + -format "%d %B %Y" -locale en_US_roman -gmt 1] + # check it corresponds the full form: + if {$t ne "12 $mon 2001"} { + lappend res "unexpected result converting $s, expected \"12 $mon 2001\", got \"$t\"" + } + } + } + set res +} {} test clock-6.13 {input of lowercase locale token (%b)} { list [clock scan "12 ja 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] \ [clock scan "12 au 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] -- cgit v0.12 From b62e2e7fce5f6b1f7f4f5ff6ede624d5ee0522ae Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 15 Jul 2019 12:21:40 +0000 Subject: small amend to [3bec82b72c] (sebres/tclclockmod#18): test cases extended to cover error cases (on ambiguous short forms of month) too --- tests/clock.test | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index 4a70140..22ed2dd 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18687,7 +18687,7 @@ test clock-6.11 {input of seconds - two values} { clock scan {1 2} -format {%s %s} -gmt true } 2 -test clock-6.12.0 {input of unambiguous short locale token (%b)} { +test clock-6.12.0 {input of short forms of locale token (%b)} { list [clock scan "12 Ja 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] \ [clock scan "12 Au 2001" -format "%d %b %Y" -locale en_US_roman -gmt 1] } {979257600 997574400} @@ -18700,16 +18700,22 @@ test clock-6.12.1 {input of all forms of unambiguous short locale token (%b)} { while {[incr i] < [string length $mon]} { # short month form: set shm [string range $mon 0 $i] - # ignore ambiguous: - if {[llength [lsearch -all -glob $months "${shm}*"]] > 1} continue + # differentiate ambiguous: + if {[llength [lsearch -all -glob $months "${shm}*"]] <= 1} { + # unambiguous (expected date with wull month): + set e "12 $mon 2001" + } else { + # ambiguous (expected error): + set e "input string does not match supplied format" + } set s "12 $shm 2001" # scan and format with full month name: - set t [clock format \ + catch {clock format \ [clock scan $s -format "%d %b %Y" -locale en_US_roman -gmt 1] \ - -format "%d %B %Y" -locale en_US_roman -gmt 1] + -format "%d %B %Y" -locale en_US_roman -gmt 1} t # check it corresponds the full form: - if {$t ne "12 $mon 2001"} { - lappend res "unexpected result converting $s, expected \"12 $mon 2001\", got \"$t\"" + if {$t ne $e} { + lappend res "unexpected result converting $s, expected \"$e\", got \"$t\"" } } } -- cgit v0.12 From b8d9b4e99692ca26fba5686fd79fc8bfe0b65bdb Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 16:30:47 +0000 Subject: improve tests, since timerate supporting max-count too --- tests-perf/clock.perf.tcl | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index c0da0ab..3682387 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -2,18 +2,18 @@ # ------------------------------------------------------------------------ # # test-performance.tcl -- -# +# # This file provides common performance tests for comparison of tcl-speed # degradation by switching between branches. # (currently for clock ensemble only) # # ------------------------------------------------------------------------ -# +# # Copyright (c) 2014 Serg G. Brester (aka sebres) -# +# # See the file "license.terms" for information on usage and redistribution # of this file. -# +# array set in {-time 500} if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} { @@ -215,7 +215,7 @@ proc test-freescan {{reptime 1000}} { {clock scan "next January" -base 0 -gmt 1} # FreeScan : relative week {clock scan "next Fri" -base 0 -gmt 1} - # FreeScan : relative weekday and week offset + # FreeScan : relative weekday and week offset {clock scan "next January + 2 week" -base 0 -gmt 1} # FreeScan : time only with base {clock scan "19:18:30" -base 148863600 -gmt 1} @@ -300,7 +300,7 @@ proc test-convert {{reptime 1000}} { {clock format [clock scan "19:18:30 EST" -base 148863600] -format "%H:%M:%S %z" -timezone EST} # Format locale 1x: comparison values - {clock format 0 -gmt 1 -locale en} + {clock format 0 -gmt 1 -locale en} {clock format 0 -gmt 1 -locale de} {clock format 0 -gmt 1 -locale fr} # Format locale 2x: without switching locale (en, en) @@ -340,7 +340,7 @@ proc test-convert {{reptime 1000}} { {clock scan "19:18:30 MST" -base 148863600; clock scan "19:18:30 EST" -base 148863600} # FreeScan TZ 2x (+1 gmt, +1 system-default) {clock scan "19:18:30 MST" -base 148863600 -gmt 1; clock scan "19:18:30 EST" -base 148863600} - + # Scan TZ: comparison included in scan string vs. given {clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"} {clock scan "2009-06-30T18:30:00 CET" -format "%Y-%m-%dT%H:%M:%S %z"} @@ -356,10 +356,16 @@ proc test-other {{reptime 1000}} { # Scan : julian day (overflow) {catch {clock scan 5373485 -format %J}} + setup {set _(org-reptime) $_(reptime); lset _(reptime) 1 50} + # Scan : test rotate of GC objects (format is dynamic, so tcl-obj removed with last reference) - {set i 0; time { clock scan "[incr i] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50} + setup {set i -1} + {clock scan "[incr i] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1} # Scan : test reusability of GC objects (format is dynamic, so tcl-obj removed with last reference) - {set i 50; time { clock scan "[incr i -1] - 25.11.2015" -format "$i - %d.%m.%Y" -base 0 -gmt 1 } 50} + setup {incr i; set j $i} + {clock scan "[incr j -1] - 25.11.2015" -format "$j - %d.%m.%Y" -base 0 -gmt 1} + setup {set _(reptime) $_(org-reptime); set j $i} + {clock scan "[incr j -1] - 25.11.2015" -format "$j - %d.%m.%Y" -base 0 -gmt 1; if {!$j} {set j $i}} } } -- cgit v0.12 From d576bf5f4ae35a7f3f57fc76c1d8da2b9506ca2a Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 16:35:37 +0000 Subject: test case illustrating #19: some initialization of clock.tcl (locale/msgcat, etc) could overwrite interp state (errorInfo/errorCode) --- tests/clock.test | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/tests/clock.test b/tests/clock.test index 22ed2dd..d7e5796 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -300,6 +300,20 @@ test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" no_tclclo set ret } {ens:0 ens:1 stubs:0 stubs:1} +test clock-0.2 "initial: loading of format/locale does not overwrite interp state (errorInfo)" -setup { + # be sure - we have no cached locale/msgcat, etc: + if {[namespace which -command ::tcl::clock::ClearCaches] ne ""} { + ::tcl::clock::ClearCaches + } +} -body { + if {[catch { + return -level 0 -code error -errorcode {EXPERR TEST-ERROR} -errorinfo "ERROR expected error" test + }]} { + clock format -now -locale de; # should not overwrite error code/info + list $::errorCode $::errorInfo + } +} -result {{EXPERR TEST-ERROR} {ERROR expected error}} + # Test some of the basics of [clock format] set syntax "clock format clockval|-now ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?" -- cgit v0.12 From fb474e354f9db6e20c53eebac82db276b0212a9f Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 16:42:31 +0000 Subject: avoid change of interp state in ::tcl::clock::LocalizeFormat --- library/clock.tcl | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/library/clock.tcl b/library/clock.tcl index 330c185..1c0d898 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -822,14 +822,14 @@ proc ::tcl::clock::LocalizeFormat { locale format {fmtkey {}} } { variable LocaleFormats if { $fmtkey eq {} } { set fmtkey FMT_$format } - if { [catch { - set locfmt [dict get $LocaleFormats $locale $fmtkey] - }] } { + if {[dict exists $LocaleFormats $locale $fmtkey]} { + set locfmt [dict get $LocaleFormats $locale $fmtkey] + } else { - # get map list cached or build it: - if { [catch { + # get map list cached or build it: + if {[dict exists $LocaleFormats $locale MLST]} { set mlst [dict get $LocaleFormats $locale MLST] - }] } { + } else { # message catalog dictionary: set mcd [mcget $locale] -- cgit v0.12 From 1ccbe8c2d0611eb72c23c85593ef44b9c7c9f024 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 16:44:35 +0000 Subject: avoid overwrite of interp state by select and setup timezone --- generic/tclClock.c | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 828a2a6..1325f80 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -1261,6 +1261,7 @@ ClockGetSystemTimeZone( Tcl_Interp *interp) /* Tcl interpreter */ { ClockClientData *dataPtr = clientData; + Tcl_InterpState interpState; /* if known (cached and same epoch) - return now */ if (dataPtr->systemTimeZone != NULL @@ -1268,16 +1269,19 @@ ClockGetSystemTimeZone( return dataPtr->systemTimeZone; } + interpState = Tcl_SaveInterpState(interp, 0); + Tcl_UnsetObjRef(dataPtr->systemTimeZone); Tcl_UnsetObjRef(dataPtr->systemSetupTZData); if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETSYSTEMTIMEZONE], 0) != TCL_OK) { + Tcl_DiscardInterpState(interpState); return NULL; } if (dataPtr->systemTimeZone == NULL) { Tcl_SetObjRef(dataPtr->systemTimeZone, Tcl_GetObjResult(interp)); } - Tcl_ResetResult(interp); + (void) Tcl_RestoreInterpState(interp, interpState); return dataPtr->systemTimeZone; } @@ -1301,6 +1305,7 @@ ClockSetupTimeZone( Tcl_Obj *timezoneObj) { ClockClientData *dataPtr = clientData; + Tcl_InterpState interpState; int loaded; Tcl_Obj *callargs[2]; @@ -1338,11 +1343,14 @@ ClockSetupTimeZone( } /* setup now */ callargs[0] = dataPtr->literals[LIT_SETUPTIMEZONE]; + interpState = Tcl_SaveInterpState(interp, 0); if (Tcl_EvalObjv(interp, 2, callargs, 0) == TCL_OK) { /* save unnormalized last used */ Tcl_SetObjRef(dataPtr->lastSetupTimeZoneUnnorm, timezoneObj); + (void) Tcl_RestoreInterpState(interp, interpState); return callargs[1]; } + Tcl_DiscardInterpState(interpState); return NULL; } -- cgit v0.12 From 9ba7c4aa1c392193c454eda0aea6eff3afab8961 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 16:51:41 +0000 Subject: close #19: implements safe "catch" in clock NS - avoid overwrite of interp state by select and setup timezone (as well as in other "catched" blocks on lazy loading or initialization); windows: load registry package on demand only (if possible, using same safe "catch" command). --- generic/tclClock.c | 86 +++++++++++++++++++++++++++++++++++++++++++++++------- library/clock.tcl | 55 +++++++++++++++++++--------------- 2 files changed, 108 insertions(+), 33 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 1325f80..75ef831 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -143,6 +143,9 @@ static struct tm * ThreadSafeLocalTime(const time_t *); static size_t TzsetIfNecessary(void); static void ClockDeleteCmdProc(ClientData); +static int ClockSafeCatchCmd( + ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); /* * Structure containing description of "native" clock commands to create. */ @@ -175,6 +178,7 @@ static const struct ClockCommand clockCommands[] = { ClockGetjuliandayfromerayearmonthdayObjCmd, NULL, NULL}, {"GetJulianDayFromEraYearWeekDay", ClockGetjuliandayfromerayearweekdayObjCmd, NULL, NULL}, + {"catch", ClockSafeCatchCmd, TclCompileBasicMin1ArgCmd, NULL}, {NULL, NULL, NULL, NULL} }; @@ -1261,7 +1265,6 @@ ClockGetSystemTimeZone( Tcl_Interp *interp) /* Tcl interpreter */ { ClockClientData *dataPtr = clientData; - Tcl_InterpState interpState; /* if known (cached and same epoch) - return now */ if (dataPtr->systemTimeZone != NULL @@ -1269,19 +1272,16 @@ ClockGetSystemTimeZone( return dataPtr->systemTimeZone; } - interpState = Tcl_SaveInterpState(interp, 0); - Tcl_UnsetObjRef(dataPtr->systemTimeZone); Tcl_UnsetObjRef(dataPtr->systemSetupTZData); if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETSYSTEMTIMEZONE], 0) != TCL_OK) { - Tcl_DiscardInterpState(interpState); return NULL; } if (dataPtr->systemTimeZone == NULL) { Tcl_SetObjRef(dataPtr->systemTimeZone, Tcl_GetObjResult(interp)); } - (void) Tcl_RestoreInterpState(interp, interpState); + Tcl_ResetResult(interp); return dataPtr->systemTimeZone; } @@ -1305,7 +1305,6 @@ ClockSetupTimeZone( Tcl_Obj *timezoneObj) { ClockClientData *dataPtr = clientData; - Tcl_InterpState interpState; int loaded; Tcl_Obj *callargs[2]; @@ -1343,14 +1342,11 @@ ClockSetupTimeZone( } /* setup now */ callargs[0] = dataPtr->literals[LIT_SETUPTIMEZONE]; - interpState = Tcl_SaveInterpState(interp, 0); if (Tcl_EvalObjv(interp, 2, callargs, 0) == TCL_OK) { - /* save unnormalized last used */ + /* save unnormalized last used */ Tcl_SetObjRef(dataPtr->lastSetupTimeZoneUnnorm, timezoneObj); - (void) Tcl_RestoreInterpState(interp, interpState); return callargs[1]; } - Tcl_DiscardInterpState(interpState); return NULL; } @@ -4533,6 +4529,76 @@ ClockSecondsObjCmd( /* *---------------------------------------------------------------------- * + * ClockSafeCatchCmd -- + * + * Same as "::catch" command but avoids overwriting of interp state. + * + * See [554117edde] for more info (and proper solution). + * + *---------------------------------------------------------------------- + */ +int +ClockSafeCatchCmd( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + typedef struct InterpState { + int status; /* return code status */ + int flags; /* Each remaining field saves the */ + int returnLevel; /* corresponding field of the Interp */ + int returnCode; /* struct. These fields taken together are */ + Tcl_Obj *errorInfo; /* the "state" of the interp. */ + Tcl_Obj *errorCode; + Tcl_Obj *returnOpts; + Tcl_Obj *objResult; + Tcl_Obj *errorStack; + int resetErrorStack; + } InterpState; + + Interp *iPtr = (Interp *)interp; + int ret, flags = 0; + InterpState *statePtr; + + if (objc == 1) { + /* wrong # args : */ + return Tcl_CatchObjCmd(NULL, interp, objc, objv); + } + + statePtr = (InterpState *)Tcl_SaveInterpState(interp, 0); + if (!statePtr->errorInfo) { + /* todo: avoid traced get of errorInfo here */ + Tcl_InitObjRef(statePtr->errorInfo, + Tcl_ObjGetVar2(interp, iPtr->eiVar, NULL, 0)); + flags |= ERR_LEGACY_COPY; + } + if (!statePtr->errorCode) { + /* todo: avoid traced get of errorCode here */ + Tcl_InitObjRef(statePtr->errorCode, + Tcl_ObjGetVar2(interp, iPtr->ecVar, NULL, 0)); + flags |= ERR_LEGACY_COPY; + } + + /* original catch */ + ret = Tcl_CatchObjCmd(NULL, interp, objc, objv); + + if (ret == TCL_ERROR) { + Tcl_DiscardInterpState((Tcl_InterpState)statePtr); + return TCL_ERROR; + } + /* overwrite result in state with catch result */ + Tcl_SetObjRef(statePtr->objResult, Tcl_GetObjResult(interp)); + /* set result (together with restore state) to interpreter */ + (void) Tcl_RestoreInterpState(interp, (Tcl_InterpState)statePtr); + /* todo: unless ERR_LEGACY_COPY not set in restore (branch [bug-554117edde] not merged yet) */ + iPtr->flags |= (flags & ERR_LEGACY_COPY); + return ret; +} + +/* + *---------------------------------------------------------------------- + * * TzsetIfNecessary -- * * Calls the tzset() library function if the contents of the TZ diff --git a/library/clock.tcl b/library/clock.tcl index 1c0d898..4a16f7f 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -16,25 +16,9 @@ # #---------------------------------------------------------------------- -# We must have message catalogs that support the root locale, and we need -# access to the Registry on Windows systems. +# We must have message catalogs that support the root locale. -uplevel \#0 { - package require msgcat 1.6 - if { $::tcl_platform(platform) eq {windows} } { - if { [catch { package require registry 1.1 }] } { - # try to load registry directly from root (if uninstalled / development env): - if {![regexp {[/\\]library$} [info library]] || [catch { - load [lindex \ - [glob -tails -directory [file dirname [info nameofexecutable]] \ - tclreg*[expr {[::tcl::pkgconfig get debug] ? {g} : {}}].dll] 0 \ - ] registry - }]} { - namespace eval ::tcl::clock [list variable NoRegistry {}] - } - } - } -} +package require msgcat 1.6 # Put the library directory into the namespace for the ensemble so that the # library code can find message catalogs and time zone definition files. @@ -673,6 +657,33 @@ proc ::tcl::clock::EnterLocale { locale } { #---------------------------------------------------------------------- # +# _hasRegistry -- +# +# Helper that checks whether registry module is available (Windows only) +# and loads it on demand. +# +#---------------------------------------------------------------------- +proc ::tcl::clock::_hasRegistry {} { + if { $::tcl_platform(platform) eq {windows} } { + if { [catch { package require registry 1.1 }] } { + # try to load registry directly from root (if uninstalled / development env): + if {[regexp {[/\\]library$} [info library]]} {catch { + load [lindex \ + [glob -tails -directory [file dirname [info nameofexecutable]] \ + tclreg*[expr {[::tcl::pkgconfig get debug] ? {g} : {}}].dll] 0 \ + ] registry + }} + } + } + if { $::tcl_platform(platform) ne {windows} || [namespace which -command ::registry] eq "" } { + proc ::tcl::clock::_hasRegistry {} {return 0} + return 0 + } + return 1 +} + +#---------------------------------------------------------------------- +# # LoadWindowsDateTimeFormats -- # # Load the date/time formats from the Control Panel in Windows and @@ -696,8 +707,7 @@ proc ::tcl::clock::EnterLocale { locale } { proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } { # Bail out if we can't find the Registry - variable NoRegistry - if { [info exists NoRegistry] } return + if { ![_hasRegistry] } return if { ![catch { registry get "HKEY_CURRENT_USER\\Control Panel\\International" \ @@ -957,7 +967,7 @@ proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } { if {! [info exists TZData($timezone)] } { - variable TimeZoneBad + variable TimeZoneBad if { [dict exists $TimeZoneBad $timezone] } { return -code error \ -errorcode [list CLOCK badTimeZone $timezone] \ @@ -1078,10 +1088,9 @@ proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } { proc ::tcl::clock::GuessWindowsTimeZone {} { variable WinZoneInfo - variable NoRegistry variable TimeZoneBad - if { [info exists NoRegistry] } { + if { ![_hasRegistry] } { return :localtime } -- cgit v0.12 From 03e761f84241cf9f7934428a1180d54a7f4bfc6e Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 16:52:21 +0000 Subject: windows: small amend (speedup _hasRegistry in positive case) --- library/clock.tcl | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/library/clock.tcl b/library/clock.tcl index 4a16f7f..11deafe 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -664,6 +664,7 @@ proc ::tcl::clock::EnterLocale { locale } { # #---------------------------------------------------------------------- proc ::tcl::clock::_hasRegistry {} { + set res 0 if { $::tcl_platform(platform) eq {windows} } { if { [catch { package require registry 1.1 }] } { # try to load registry directly from root (if uninstalled / development env): @@ -674,12 +675,12 @@ proc ::tcl::clock::_hasRegistry {} { ] registry }} } + if { [namespace which -command ::registry] ne "" } { + set res 1 + } } - if { $::tcl_platform(platform) ne {windows} || [namespace which -command ::registry] eq "" } { - proc ::tcl::clock::_hasRegistry {} {return 0} - return 0 - } - return 1 + proc ::tcl::clock::_hasRegistry {} [list return $res] + return $res } #---------------------------------------------------------------------- -- cgit v0.12 From fdc6c737b407148b143c86ccf668699a9609e312 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 17:19:19 +0000 Subject: added test case illustrating bug #20 - wrong relative clock calculation on negative month offset over threshold of a year --- tests/clock.test | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/tests/clock.test b/tests/clock.test index d7e5796..9b1b06c 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -35510,6 +35510,24 @@ test clock-30.8 {clock add months, negative} { set x4 [clock format $f4 -format %Y-%m-%d -timezone :UTC] list $x1 $x2 $x3 $x4 } {2000-02-29 2000-01-31 1999-12-31 1999-11-30} +test clock-30.8a {clock add months, negative, over threshold of a year} { + set t [clock scan 2019-01-31 -format %Y-%m-%d -timezone :UTC] + list [clock format [clock add $t -1 month -timezone :UTC] -format %Y-%m-%d -timezone :UTC] \ + [clock format [clock add $t -2 month -timezone :UTC] -format %Y-%m-%d -timezone :UTC] \ + [clock format [clock add $t -3 month -timezone :UTC] -format %Y-%m-%d -timezone :UTC] \ + [clock format [clock add $t -4 month -timezone :UTC] -format %Y-%m-%d -timezone :UTC] +} {2018-12-31 2018-11-30 2018-10-31 2018-09-30} +test clock-30.8b {clock add months, negative, over threshold of a year} { + set t [clock scan 2000-01-28 -format %Y-%m-%d -timezone :UTC] + for {set i 1} {$i < 24} {incr i 1} { + set f1 [clock add $t -$i month -timezone :UTC] + set f2 [clock add $f1 $i month -timezone :UTC] + if {$f2 != $t} { + error "\[clock add $t -$i month -timezone :UTC\] does not consider\ + \[clock add $f1 $i month -timezone :UTC\] != $t" + } + } +} {} test clock-30.9 {clock add days} { set t [clock scan {2000-01-01 12:34:56} -format {%Y-%m-%d %H:%M:%S} \ -timezone :UTC] -- cgit v0.12 From 369a1d740465c776814cd9e9ebc451420b7da625 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 17:19:34 +0000 Subject: fixed relative clock calculation on negative month offset over threshold of a year: compiler/platform fix for negative offs if -1 % 12 results to -1 instead of 11 (removed by compilers where remainder is always positive) --- generic/tclClock.c | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/generic/tclClock.c b/generic/tclClock.c index 75ef831..8e93310 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -4115,6 +4115,11 @@ repeat_rel: yyMonth += yyRelMonth - 1; yyYear += yyMonth / 12; m = yyMonth % 12; + /* compiler fix for negative offs - wrap y, m = (0, -1) -> (-1, 11) */ + if (m < 0) { + yyYear--; + m = 12 + m; + } yyMonth = m + 1; /* if the day doesn't exist in the current month, repair it */ -- cgit v0.12 -- cgit v0.12 From 5551e41e7a45a5eb226fc42d25176b7f6d852bb8 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 17:28:38 +0000 Subject: simplification of new tests --- tests/clock.test | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index 9b1b06c..b218793 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -35511,20 +35511,20 @@ test clock-30.8 {clock add months, negative} { list $x1 $x2 $x3 $x4 } {2000-02-29 2000-01-31 1999-12-31 1999-11-30} test clock-30.8a {clock add months, negative, over threshold of a year} { - set t [clock scan 2019-01-31 -format %Y-%m-%d -timezone :UTC] - list [clock format [clock add $t -1 month -timezone :UTC] -format %Y-%m-%d -timezone :UTC] \ - [clock format [clock add $t -2 month -timezone :UTC] -format %Y-%m-%d -timezone :UTC] \ - [clock format [clock add $t -3 month -timezone :UTC] -format %Y-%m-%d -timezone :UTC] \ - [clock format [clock add $t -4 month -timezone :UTC] -format %Y-%m-%d -timezone :UTC] + set t [clock scan 2019-01-31 -format %Y-%m-%d -gmt 1] + list [clock format [clock add $t -1 month -gmt 1] -format %Y-%m-%d -gmt 1] \ + [clock format [clock add $t -2 month -gmt 1] -format %Y-%m-%d -gmt 1] \ + [clock format [clock add $t -3 month -gmt 1] -format %Y-%m-%d -gmt 1] \ + [clock format [clock add $t -4 month -gmt 1] -format %Y-%m-%d -gmt 1] } {2018-12-31 2018-11-30 2018-10-31 2018-09-30} test clock-30.8b {clock add months, negative, over threshold of a year} { - set t [clock scan 2000-01-28 -format %Y-%m-%d -timezone :UTC] + set t [clock scan 2000-01-28 -format %Y-%m-%d -gmt 1] for {set i 1} {$i < 24} {incr i 1} { - set f1 [clock add $t -$i month -timezone :UTC] - set f2 [clock add $f1 $i month -timezone :UTC] + set f1 [clock add $t -$i month -gmt 1] + set f2 [clock add $f1 $i month -gmt 1] if {$f2 != $t} { - error "\[clock add $t -$i month -timezone :UTC\] does not consider\ - \[clock add $f1 $i month -timezone :UTC\] != $t" + error "\[clock add $t -$i month -gmt 1\] does not consider\ + \[clock add $f1 $i month -gmt 1\] != $t" } } } {} -- cgit v0.12 From 32cb6e1608b379ff45355ddb8b5ff0b0ab426053 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 17:36:11 +0000 Subject: compatibility to future 8.6 version ([6596c4af31e29b5d] introduced new internals TclUtfPrev/TclUtfNext in tclInt.h), avoids conflict with own implementation for previous version --- generic/tclStrIdxTree.h | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/generic/tclStrIdxTree.h b/generic/tclStrIdxTree.h index 6ed5170..cd393af 100644 --- a/generic/tclStrIdxTree.h +++ b/generic/tclStrIdxTree.h @@ -111,19 +111,6 @@ TclUtfFindEqualNCInLwr( return ret; } -static inline const char * -TclUtfNext( - register const char *src) /* The current location in the string. */ -{ - if (((unsigned char) *(src)) < 0xC0) { - return ++src; - } else { - Tcl_UniChar ch; - return src + TclUtfToUniChar(src, &ch); - } -} - - /* * Primitives to safe set, reset and free references. */ -- cgit v0.12 From 584d98d7036b54df0f42ec52de8bb6d4c8db278a Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 18:19:14 +0000 Subject: more tests time-zone independent --- tests/clock.test | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index 01a99b1..cb68a92 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -36171,33 +36171,34 @@ test clock-34.11.3 {clock scan tests: same century switch} { set times [clock scan "1/1/39" -gmt true] } [clock scan "1/1/39" -format "%m/%d/%y" -gmt true] test clock-34.12 {clock scan, relative times} { - set time [clock scan "Oct 23, 1992 -1 day"] - clock format $time -format {%b %d, %Y} + set time [clock scan "Oct 23, 1992 -1 day" -gmt true] + clock format $time -format {%b %d, %Y} -gmt true } "Oct 22, 1992" test clock-34.13 {clock scan, ISO 8601 base date format} { - set time [clock scan "19921023"] - clock format $time -format {%b %d, %Y} + set time [clock scan "19921023" -gmt true] + clock format $time -format {%b %d, %Y} -gmt true } "Oct 23, 1992" test clock-34.14 {clock scan, ISO 8601 expanded date format} { - set time [clock scan "1992-10-23"] - clock format $time -format {%b %d, %Y} + set time [clock scan "1992-10-23" -gmt true] + clock format $time -format {%b %d, %Y} -gmt true } "Oct 23, 1992" test clock-34.15 {clock scan, DD-Mon-YYYY format} { - set time [clock scan "23-Oct-1992"] - clock format $time -format {%b %d, %Y} + set time [clock scan "23-Oct-1992" -gmt true] + clock format $time -format {%b %d, %Y} -gmt true } "Oct 23, 1992" test clock-34.16 {clock scan, ISO 8601 point in time format} { - set time [clock scan "19921023T235959"] - clock format $time -format {%b %d, %Y %H:%M:%S} + set time [clock scan "19921023T235959" -gmt true] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true } "Oct 23, 1992 23:59:59" test clock-34.17 {clock scan, ISO 8601 point in time format} { - set time [clock scan "19921023 235959"] - clock format $time -format {%b %d, %Y %H:%M:%S} + set time [clock scan "19921023 235959" -gmt true] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true } "Oct 23, 1992 23:59:59" test clock-34.18 {clock scan, ISO 8601 point in time format} { - set time [clock scan "19921023T000000"] - clock format $time -format {%b %d, %Y %H:%M:%S} + set time [clock scan "19921023T000000" -gmt true] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true } "Oct 23, 1992 00:00:00" + test clock-34.20.1 {clock scan tests (-TZ)} { set time [clock scan "31 Jan 14 23:59:59 -0100"] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true -- cgit v0.12 From ac6a529dff6ba534d6228be196ab56632e205104 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 18:21:14 +0000 Subject: added test-cases illustrating bug #21: literal may be mistakenly recognized as a time-zone (doesn't consider word-boundaries) --- tests/clock.test | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/tests/clock.test b/tests/clock.test index cb68a92..dd6356b 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -36174,6 +36174,7 @@ test clock-34.12 {clock scan, relative times} { set time [clock scan "Oct 23, 1992 -1 day" -gmt true] clock format $time -format {%b %d, %Y} -gmt true } "Oct 22, 1992" + test clock-34.13 {clock scan, ISO 8601 base date format} { set time [clock scan "19921023" -gmt true] clock format $time -format {%b %d, %Y} -gmt true @@ -36190,14 +36191,52 @@ test clock-34.16 {clock scan, ISO 8601 point in time format} { set time [clock scan "19921023T235959" -gmt true] clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true } "Oct 23, 1992 23:59:59" +test clock-34.16.2 {clock scan, ISO 8601 extended date time} { + set time [clock scan "1992-10-23T23:59:59" -gmt true] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true +} "Oct 23, 1992 23:59:59" test clock-34.17 {clock scan, ISO 8601 point in time format} { set time [clock scan "19921023 235959" -gmt true] clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true } "Oct 23, 1992 23:59:59" +test clock-34.17.2 {clock scan, ISO 8601 extended date time} { + set time [clock scan "1992-10-23 23:59:59" -gmt true] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true +} "Oct 23, 1992 23:59:59" +test clock-34.17.3 {clock scan, TZ-word boundaries - Z is not TZ here } -body { + set time [clock scan "1992-10-23Z23:59:59" -gmt true] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true +} -returnCodes error -match glob \ + -result {unable to convert date-time string*} +test clock-34.17.4 {clock scan, TZ-word boundaries - Z is TZ UTC here} { + set time [clock scan "1992-10-23 Z 23:59:59" -gmt true] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true +} "Oct 23, 1992 23:59:59" +test clock-34.17.5 {clock scan, ISO 8601 extended date time with UTC TZ} { + set time [clock scan "1992-10-23T23:59:59Z" -timezone :America/Detroit] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true +} "Oct 23, 1992 23:59:59" test clock-34.18 {clock scan, ISO 8601 point in time format} { set time [clock scan "19921023T000000" -gmt true] clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true } "Oct 23, 1992 00:00:00" +test clock-34.18.2 {clock scan, ISO 8601 extended date time} { + set time [clock scan "1992-10-23T00:00:00" -gmt true] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true +} "Oct 23, 1992 00:00:00" +test clock-34.18.3 {clock scan, TZ-word boundaries - Z is not TZ here } -body { + set time [clock scan "1992-10-23Z00:00:00" -gmt true] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true +} -returnCodes error -match glob \ + -result {unable to convert date-time string*} +test clock-34.18.4 {clock scan, TZ-word boundaries - Z is TZ UTC here} { + set time [clock scan "1992-10-23 Z 00:00:00" -gmt true] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true +} "Oct 23, 1992 00:00:00" +test clock-34.18.5 {clock scan, ISO 8601 extended date time with UTC TZ} { + set time [clock scan "1992-10-23T00:00:00Z" -timezone :America/Detroit] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true +} "Oct 23, 1992 00:00:00" test clock-34.20.1 {clock scan tests (-TZ)} { set time [clock scan "31 Jan 14 23:59:59 -0100"] -- cgit v0.12 From 207e44ee21ca10f2b770aa1e2f64921524af2c03 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 18:21:59 +0000 Subject: ISO 8601 timestamp format accepts extended date and time (YYYY-MM-DD and hh:mm:ss); implements more strict TZ recognition rules by word-lookup (lookahead considering word boundaries, see test-cases), so avoid several conflicts, also confusing literal T in ISO timestamp with military TZ; closes #21 --- generic/tclDate.c | 374 +++++++++++++++++++++++++-------------------------- generic/tclGetDate.y | 72 +++++----- 2 files changed, 216 insertions(+), 230 deletions(-) diff --git a/generic/tclDate.c b/generic/tclDate.c index df8aeb5..2ff30ac 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -501,16 +501,16 @@ union yyalloc /* YYFINAL -- State number of the termination state. */ #define YYFINAL 2 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 116 +#define YYLAST 114 /* YYNTOKENS -- Number of terminals. */ -#define YYNTOKENS 28 +#define YYNTOKENS 29 /* YYNNTS -- Number of nonterminals. */ -#define YYNNTS 18 +#define YYNNTS 21 /* YYNRULES -- Number of rules. */ -#define YYNRULES 66 +#define YYNRULES 70 /* YYNSTATES -- Number of states. */ -#define YYNSTATES 106 +#define YYNSTATES 105 /* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned by yylex, with out-of-bounds checking. */ @@ -528,11 +528,11 @@ static const yytype_uint8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 27, 23, 25, 26, 24, 2, 2, + 2, 2, 2, 28, 23, 24, 27, 25, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 22, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 26, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -559,12 +559,13 @@ static const yytype_uint8 yytranslate[] = static const yytype_uint16 yyrline[] = { 0, 167, 167, 168, 169, 172, 175, 178, 181, 184, - 187, 190, 193, 197, 200, 206, 212, 220, 224, 228, - 232, 236, 240, 246, 247, 250, 254, 258, 262, 266, - 270, 276, 280, 285, 290, 295, 300, 304, 309, 313, - 318, 325, 329, 335, 344, 352, 360, 369, 379, 393, - 398, 401, 404, 407, 410, 413, 416, 421, 424, 429, - 433, 437, 443, 446, 451, 469, 472 + 187, 190, 193, 197, 200, 206, 212, 218, 223, 227, + 231, 235, 239, 243, 249, 250, 253, 257, 261, 265, + 269, 273, 279, 285, 289, 294, 299, 304, 305, 309, + 314, 318, 323, 330, 334, 340, 340, 342, 350, 355, + 363, 364, 367, 381, 386, 389, 392, 395, 398, 401, + 404, 409, 412, 417, 421, 425, 431, 434, 439, 457, + 460 }; #endif @@ -576,10 +577,11 @@ static const char *const yytname[] = "$end", "error", "$undefined", "tAGO", "tDAY", "tDAYZONE", "tID", "tMERIDIAN", "tMONTH", "tMONTH_UNIT", "tSTARDATE", "tSEC_UNIT", "tUNUMBER", "tZONE", "tZONEwO4", "tZONEwO2", "tEPOCH", "tDST", - "tISOBASE", "tDAY_UNIT", "tNEXT", "SP", "':'", "','", "'/'", "'-'", - "'.'", "'+'", "$accept", "spec", "item", "time", "zone", "comma", "day", - "date", "ordMonth", "iso", "trek", "relspec", "relunits", "sign", "unit", - "INTNUM", "number", "o_merid", YY_NULLPTR + "tISOBASE", "tDAY_UNIT", "tNEXT", "SP", "':'", "','", "'-'", "'/'", + "'T'", "'.'", "'+'", "$accept", "spec", "item", "iextime", "time", + "zone", "comma", "day", "iexdate", "date", "ordMonth", "isosep", "iso", + "trek", "relspec", "relunits", "sign", "unit", "INTNUM", "number", + "o_merid", YY_NULLPTR }; #endif @@ -590,14 +592,14 @@ static const yytype_uint16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, - 275, 276, 58, 44, 47, 45, 46, 43 + 275, 276, 58, 44, 45, 47, 84, 46, 43 }; # endif -#define YYPACT_NINF -17 +#define YYPACT_NINF -25 #define yypact_value_is_default(Yystate) \ - (!!((Yystate) == (-17))) + (!!((Yystate) == (-25))) #define YYTABLE_NINF -1 @@ -608,17 +610,17 @@ static const yytype_uint16 yytoknum[] = STATE-NUM. */ static const yytype_int8 yypact[] = { - -17, 48, -17, -9, -17, 34, -17, 19, -17, -2, - 30, -10, -10, -17, 8, -17, 0, 72, -17, -17, - -17, -17, -17, -17, -17, -17, -17, -17, -17, 52, - 18, -17, 16, -17, 49, -17, -9, -17, -17, 25, - -17, -17, 59, 60, 62, -5, -17, 19, 19, 20, - -17, 31, -17, -17, 70, -17, 16, -17, -17, 75, - 32, 16, -17, -17, 77, 81, -17, 6, 71, 69, - 73, -17, -17, 74, -17, 78, -17, -17, -17, -17, - 97, 16, -17, -17, -17, -17, 90, -17, 91, 92, - 93, 94, 95, -17, -17, 101, -17, -17, -17, 87, - 88, -17, 99, 100, -17, -17 + -25, 46, -25, -19, -25, 4, -25, 21, -25, -1, + 20, 60, 60, -25, 10, -25, 1, 67, -25, -25, + -25, 42, -25, -25, -25, -4, -25, -25, -25, -25, + -25, 49, 14, -25, 6, -25, 68, -25, -19, -25, + -25, 63, -25, -25, 80, 81, 26, 82, -25, 21, + 21, -25, -25, -25, 29, -25, -25, 88, -25, 6, + -25, -25, -25, 75, 86, -25, -25, 95, 30, 6, + -25, -25, 89, 90, -25, 7, 76, 79, 83, -25, + -25, -25, -25, -25, -25, 92, -25, -25, 101, 6, + -25, -25, -25, 94, -25, 97, 98, 99, 85, -25, + -25, -25, -25, -25, -25 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -626,31 +628,33 @@ static const yytype_int8 yypact[] = means the default is an error. */ static const yytype_uint8 yydefact[] = { - 2, 0, 1, 25, 19, 0, 61, 0, 59, 62, - 18, 0, 0, 39, 33, 60, 0, 0, 57, 58, - 3, 5, 6, 9, 7, 8, 11, 12, 10, 50, - 0, 56, 64, 13, 23, 26, 36, 62, 63, 0, - 27, 14, 38, 0, 0, 0, 17, 0, 0, 0, - 44, 0, 30, 41, 62, 54, 0, 4, 49, 62, - 0, 22, 53, 24, 0, 0, 40, 65, 31, 0, - 0, 20, 21, 0, 43, 0, 47, 42, 55, 29, - 62, 0, 52, 37, 48, 66, 0, 15, 0, 0, - 0, 0, 0, 28, 51, 65, 32, 34, 35, 0, - 0, 16, 0, 0, 46, 45 + 2, 0, 1, 26, 20, 0, 65, 0, 63, 66, + 19, 0, 0, 41, 35, 64, 0, 0, 61, 62, + 3, 69, 5, 6, 9, 37, 7, 8, 11, 12, + 10, 54, 0, 60, 68, 13, 24, 27, 38, 66, + 67, 0, 28, 15, 40, 0, 0, 0, 18, 0, + 0, 49, 46, 45, 0, 31, 43, 66, 58, 0, + 4, 70, 17, 0, 0, 51, 53, 66, 0, 23, + 57, 25, 0, 0, 42, 69, 0, 0, 33, 21, + 22, 47, 48, 44, 59, 0, 50, 30, 66, 0, + 56, 39, 52, 0, 16, 0, 0, 0, 0, 29, + 55, 14, 36, 32, 34 }; /* YYPGOTO[NTERM-NUM]. */ static const yytype_int8 yypgoto[] = { - -17, -17, 96, -17, -17, 79, -17, -17, -17, -17, - -17, -17, -17, 22, -16, -6, -17, 21 + -25, -25, 96, -24, -25, -25, 74, -25, -25, -25, + -25, -25, -25, -25, -25, -25, 57, -16, -5, -25, + 39 }; /* YYDEFGOTO[NTERM-NUM]. */ static const yytype_int8 yydefgoto[] = { - -1, 1, 20, 21, 22, 35, 23, 24, 25, 26, - 27, 28, 29, 30, 31, 32, 33, 87 + -1, 1, 20, 21, 22, 23, 37, 24, 25, 26, + 27, 54, 28, 29, 30, 31, 32, 33, 34, 35, + 62 }; /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If @@ -658,75 +662,77 @@ static const yytype_int8 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_uint8 yytable[] = { - 55, 39, 40, 69, 52, 41, 42, 70, 53, 6, - 56, 8, 54, 85, 34, 18, 62, 19, 38, 15, - 43, 49, 44, 45, 61, 6, 50, 8, 86, 51, - 59, 37, 73, 47, 48, 15, 38, 38, 74, 60, - 78, 71, 72, 75, 80, 82, 36, 46, 2, 76, - 38, 65, 3, 4, 81, 58, 5, 6, 7, 8, - 9, 10, 11, 12, 13, 94, 14, 15, 16, 17, - 63, 66, 67, 18, 68, 19, 3, 4, 77, 79, - 5, 6, 7, 8, 9, 10, 11, 12, 13, 83, - 14, 15, 16, 84, 89, 88, 91, 18, 90, 19, - 92, 93, 95, 96, 97, 98, 99, 100, 85, 102, - 103, 104, 105, 57, 0, 64, 101 + 58, 65, 41, 42, 36, 55, 43, 44, 63, 56, + 6, 59, 8, 57, 61, 6, 38, 8, 70, 40, + 15, 45, 64, 46, 47, 15, 67, 69, 51, 93, + 82, 52, 40, 39, 76, 68, 53, 48, 77, 40, + 86, 63, 88, 84, 79, 80, 2, 81, 40, 61, + 3, 4, 66, 90, 5, 6, 7, 8, 9, 10, + 11, 12, 13, 89, 14, 15, 16, 17, 49, 50, + 18, 3, 4, 100, 19, 5, 6, 7, 8, 9, + 10, 11, 12, 13, 18, 14, 15, 16, 19, 71, + 73, 18, 74, 75, 78, 19, 83, 85, 63, 87, + 95, 91, 92, 96, 98, 99, 101, 93, 97, 102, + 103, 104, 72, 60, 94 }; -static const yytype_int8 yycheck[] = +static const yytype_uint8 yycheck[] = { - 16, 7, 4, 8, 4, 7, 8, 12, 8, 9, - 16, 11, 12, 7, 23, 25, 32, 27, 18, 19, - 22, 13, 24, 25, 30, 9, 18, 11, 22, 21, - 12, 12, 12, 11, 12, 19, 18, 18, 18, 21, - 56, 47, 48, 12, 12, 61, 12, 17, 0, 18, - 18, 26, 4, 5, 60, 3, 8, 9, 10, 11, - 12, 13, 14, 15, 16, 81, 18, 19, 20, 21, - 21, 12, 12, 25, 12, 27, 4, 5, 8, 4, - 8, 9, 10, 11, 12, 13, 14, 15, 16, 12, - 18, 19, 20, 12, 25, 24, 22, 25, 25, 27, - 22, 4, 12, 12, 12, 12, 12, 12, 7, 22, - 22, 12, 12, 17, -1, 36, 95 + 16, 25, 7, 4, 23, 4, 7, 8, 12, 8, + 9, 16, 11, 12, 7, 9, 12, 11, 34, 18, + 19, 22, 26, 24, 25, 19, 12, 32, 18, 22, + 54, 21, 18, 12, 8, 21, 26, 17, 12, 18, + 64, 12, 12, 59, 49, 50, 0, 18, 18, 7, + 4, 5, 3, 69, 8, 9, 10, 11, 12, 13, + 14, 15, 16, 68, 18, 19, 20, 21, 11, 12, + 24, 4, 5, 89, 28, 8, 9, 10, 11, 12, + 13, 14, 15, 16, 24, 18, 19, 20, 28, 21, + 27, 24, 12, 12, 12, 28, 8, 22, 12, 4, + 24, 12, 12, 24, 12, 4, 12, 22, 25, 12, + 12, 12, 38, 17, 75 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing symbol of state STATE-NUM. */ static const yytype_uint8 yystos[] = { - 0, 29, 0, 4, 5, 8, 9, 10, 11, 12, - 13, 14, 15, 16, 18, 19, 20, 21, 25, 27, - 30, 31, 32, 34, 35, 36, 37, 38, 39, 40, - 41, 42, 43, 44, 23, 33, 12, 12, 18, 43, - 4, 7, 8, 22, 24, 25, 17, 41, 41, 13, - 18, 21, 4, 8, 12, 42, 43, 30, 3, 12, - 21, 43, 42, 21, 33, 26, 12, 12, 12, 8, - 12, 43, 43, 12, 18, 12, 18, 8, 42, 4, - 12, 43, 42, 12, 12, 7, 22, 45, 24, 25, - 25, 22, 22, 4, 42, 12, 12, 12, 12, 12, - 12, 45, 22, 22, 12, 12 + 0, 30, 0, 4, 5, 8, 9, 10, 11, 12, + 13, 14, 15, 16, 18, 19, 20, 21, 24, 28, + 31, 32, 33, 34, 36, 37, 38, 39, 41, 42, + 43, 44, 45, 46, 47, 48, 23, 35, 12, 12, + 18, 47, 4, 7, 8, 22, 24, 25, 17, 45, + 45, 18, 21, 26, 40, 4, 8, 12, 46, 47, + 31, 7, 49, 12, 26, 32, 3, 12, 21, 47, + 46, 21, 35, 27, 12, 12, 8, 12, 12, 47, + 47, 18, 32, 8, 46, 22, 32, 4, 12, 47, + 46, 12, 12, 22, 49, 24, 24, 25, 12, 4, + 46, 12, 12, 12, 12 }; /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ static const yytype_uint8 yyr1[] = { - 0, 28, 29, 29, 29, 30, 30, 30, 30, 30, - 30, 30, 30, 30, 31, 31, 31, 32, 32, 32, - 32, 32, 32, 33, 33, 34, 34, 34, 34, 34, - 34, 35, 35, 35, 35, 35, 35, 35, 35, 35, - 35, 36, 36, 37, 37, 37, 37, 37, 38, 39, - 39, 40, 40, 40, 40, 40, 40, 41, 41, 42, - 42, 42, 43, 43, 44, 45, 45 + 0, 29, 30, 30, 30, 31, 31, 31, 31, 31, + 31, 31, 31, 31, 32, 33, 33, 33, 34, 34, + 34, 34, 34, 34, 35, 35, 36, 36, 36, 36, + 36, 36, 37, 38, 38, 38, 38, 38, 38, 38, + 38, 38, 38, 39, 39, 40, 40, 41, 41, 41, + 41, 41, 42, 43, 43, 44, 44, 44, 44, 44, + 44, 45, 45, 46, 46, 46, 47, 47, 48, 49, + 49 }; /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN. */ static const yytype_uint8 yyr2[] = { 0, 2, 0, 2, 3, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 2, 4, 6, 2, 1, 1, - 3, 3, 2, 1, 2, 1, 2, 2, 4, 3, - 2, 3, 5, 1, 5, 5, 2, 4, 2, 1, - 3, 2, 3, 3, 2, 7, 7, 3, 4, 2, - 1, 4, 3, 2, 2, 3, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 0, 1 + 1, 1, 1, 1, 5, 2, 4, 2, 2, 1, + 1, 3, 3, 2, 1, 2, 1, 2, 2, 4, + 3, 2, 5, 3, 5, 1, 5, 1, 2, 4, + 2, 1, 3, 2, 3, 1, 1, 3, 3, 2, + 3, 2, 4, 2, 1, 4, 3, 2, 2, 3, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, + 1 }; @@ -1573,6 +1579,16 @@ yyreduce: case 14: { + yyHour = (yyvsp[-4].Number); + yyMinutes = (yyvsp[-2].Number); + yySeconds = (yyvsp[0].Number); + } + + break; + + case 15: + + { yyHour = (yyvsp[-1].Number); yyMinutes = 0; yySeconds = 0; @@ -1581,7 +1597,7 @@ yyreduce: break; - case 15: + case 16: { yyHour = (yyvsp[-3].Number); @@ -1592,18 +1608,15 @@ yyreduce: break; - case 16: + case 17: { - yyHour = (yyvsp[-5].Number); - yyMinutes = (yyvsp[-3].Number); - yySeconds = (yyvsp[-1].Number); yyMeridian = (yyvsp[0].Meridian); } break; - case 17: + case 18: { yyTimezone = (yyvsp[-1].Number); @@ -1612,7 +1625,7 @@ yyreduce: break; - case 18: + case 19: { yyTimezone = (yyvsp[0].Number); @@ -1621,7 +1634,7 @@ yyreduce: break; - case 19: + case 20: { yyTimezone = (yyvsp[0].Number); @@ -1630,7 +1643,7 @@ yyreduce: break; - case 20: + case 21: { /* GMT+0100, GMT-1000, etc. */ yyTimezone = (yyvsp[-2].Number) - (yyvsp[-1].Number)*((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60); @@ -1639,7 +1652,7 @@ yyreduce: break; - case 21: + case 22: { /* GMT+1, GMT-10, etc. */ yyTimezone = (yyvsp[-2].Number) - (yyvsp[-1].Number)*((yyvsp[0].Number) * 60); @@ -1648,7 +1661,7 @@ yyreduce: break; - case 22: + case 23: { /* +0100, -0100 */ yyTimezone = -(yyvsp[-1].Number)*((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60); @@ -1657,7 +1670,7 @@ yyreduce: break; - case 25: + case 26: { yyDayOrdinal = 1; @@ -1666,7 +1679,7 @@ yyreduce: break; - case 26: + case 27: { yyDayOrdinal = 1; @@ -1675,7 +1688,7 @@ yyreduce: break; - case 27: + case 28: { yyDayOrdinal = (yyvsp[-1].Number); @@ -1684,7 +1697,7 @@ yyreduce: break; - case 28: + case 29: { yyDayOrdinal = (yyvsp[-3].Number) * (yyvsp[-1].Number); @@ -1693,7 +1706,7 @@ yyreduce: break; - case 29: + case 30: { yyDayOrdinal = (yyvsp[-2].Number) * (yyvsp[-1].Number); @@ -1702,7 +1715,7 @@ yyreduce: break; - case 30: + case 31: { yyDayOrdinal = 2; @@ -1711,16 +1724,26 @@ yyreduce: break; - case 31: + case 32: { yyMonth = (yyvsp[-2].Number); yyDay = (yyvsp[0].Number); + yyYear = (yyvsp[-4].Number); } break; - case 32: + case 33: + + { + yyMonth = (yyvsp[-2].Number); + yyDay = (yyvsp[0].Number); + } + + break; + + case 34: { yyMonth = (yyvsp[-4].Number); @@ -1730,7 +1753,7 @@ yyreduce: break; - case 33: + case 35: { yyYear = (yyvsp[0].Number) / 10000; @@ -1740,7 +1763,7 @@ yyreduce: break; - case 34: + case 36: { yyDay = (yyvsp[-4].Number); @@ -1750,17 +1773,7 @@ yyreduce: break; - case 35: - - { - yyMonth = (yyvsp[-2].Number); - yyDay = (yyvsp[0].Number); - yyYear = (yyvsp[-4].Number); - } - - break; - - case 36: + case 38: { yyMonth = (yyvsp[-1].Number); @@ -1769,7 +1782,7 @@ yyreduce: break; - case 37: + case 39: { yyMonth = (yyvsp[-3].Number); @@ -1779,7 +1792,7 @@ yyreduce: break; - case 38: + case 40: { yyMonth = (yyvsp[0].Number); @@ -1788,7 +1801,7 @@ yyreduce: break; - case 39: + case 41: { yyMonth = 1; @@ -1798,7 +1811,7 @@ yyreduce: break; - case 40: + case 42: { yyMonth = (yyvsp[-1].Number); @@ -1808,7 +1821,7 @@ yyreduce: break; - case 41: + case 43: { yyMonthOrdinalIncr = 1; @@ -1817,7 +1830,7 @@ yyreduce: break; - case 42: + case 44: { yyMonthOrdinalIncr = (yyvsp[-1].Number); @@ -1826,10 +1839,9 @@ yyreduce: break; - case 43: + case 47: { - if ((yyvsp[-1].Number) != HOUR( 7)) YYABORT; /* T */ yyYear = (yyvsp[-2].Number) / 10000; yyMonth = ((yyvsp[-2].Number) % 10000)/100; yyDay = (yyvsp[-2].Number) % 100; @@ -1840,52 +1852,22 @@ yyreduce: break; - case 44: - - { - yyYear = (yyvsp[-1].Number) / 10000; - yyMonth = ((yyvsp[-1].Number) % 10000)/100; - yyDay = (yyvsp[-1].Number) % 100; - yyHour = (yyvsp[0].Number) / 10000; - yyMinutes = ((yyvsp[0].Number) % 10000)/100; - yySeconds = (yyvsp[0].Number) % 100; - } - - break; - - case 45: - - { - yyYear = (yyvsp[-6].Number) / 10000; - yyMonth = ((yyvsp[-6].Number) % 10000)/100; - yyDay = (yyvsp[-6].Number) % 100; - yyHour = (yyvsp[-4].Number); - yyMinutes = (yyvsp[-2].Number); - yySeconds = (yyvsp[0].Number); - } - - break; - - case 46: + case 48: { - if ((yyvsp[-5].Number) != HOUR( 7)) YYABORT; /* T */ - yyYear = (yyvsp[-6].Number) / 10000; - yyMonth = ((yyvsp[-6].Number) % 10000)/100; - yyDay = (yyvsp[-6].Number) % 100; - yyHour = (yyvsp[-4].Number); - yyMinutes = (yyvsp[-2].Number); - yySeconds = (yyvsp[0].Number); + yyYear = (yyvsp[-2].Number) / 10000; + yyMonth = ((yyvsp[-2].Number) % 10000)/100; + yyDay = (yyvsp[-2].Number) % 100; } break; - case 47: + case 49: { - yyYear = (yyvsp[-2].Number) / 10000; - yyMonth = ((yyvsp[-2].Number) % 10000)/100; - yyDay = (yyvsp[-2].Number) % 100; + yyYear = (yyvsp[-1].Number) / 10000; + yyMonth = ((yyvsp[-1].Number) % 10000)/100; + yyDay = (yyvsp[-1].Number) % 100; yyHour = (yyvsp[0].Number) / 10000; yyMinutes = ((yyvsp[0].Number) % 10000)/100; yySeconds = (yyvsp[0].Number) % 100; @@ -1893,7 +1875,7 @@ yyreduce: break; - case 48: + case 52: { /* @@ -1910,7 +1892,7 @@ yyreduce: break; - case 49: + case 53: { yyRelSeconds *= -1; @@ -1920,7 +1902,7 @@ yyreduce: break; - case 51: + case 55: { *yyRelPointer += (yyvsp[-3].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number); @@ -1928,7 +1910,7 @@ yyreduce: break; - case 52: + case 56: { *yyRelPointer += (yyvsp[-2].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number); @@ -1936,7 +1918,7 @@ yyreduce: break; - case 53: + case 57: { *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number); @@ -1944,7 +1926,7 @@ yyreduce: break; - case 54: + case 58: { *yyRelPointer += (yyvsp[0].Number); @@ -1952,7 +1934,7 @@ yyreduce: break; - case 55: + case 59: { *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number); @@ -1960,7 +1942,7 @@ yyreduce: break; - case 56: + case 60: { *yyRelPointer += (yyvsp[0].Number); @@ -1968,7 +1950,7 @@ yyreduce: break; - case 57: + case 61: { (yyval.Number) = -1; @@ -1976,7 +1958,7 @@ yyreduce: break; - case 58: + case 62: { (yyval.Number) = 1; @@ -1984,7 +1966,7 @@ yyreduce: break; - case 59: + case 63: { (yyval.Number) = (yyvsp[0].Number); @@ -1993,7 +1975,7 @@ yyreduce: break; - case 60: + case 64: { (yyval.Number) = (yyvsp[0].Number); @@ -2002,7 +1984,7 @@ yyreduce: break; - case 61: + case 65: { (yyval.Number) = (yyvsp[0].Number); @@ -2011,7 +1993,7 @@ yyreduce: break; - case 62: + case 66: { (yyval.Number) = (yyvsp[0].Number); @@ -2019,7 +2001,7 @@ yyreduce: break; - case 63: + case 67: { (yyval.Number) = (yyvsp[0].Number); @@ -2027,7 +2009,7 @@ yyreduce: break; - case 64: + case 68: { if ((info->flags & (CLF_TIME|CLF_HAVEDATE|CLF_RELCONV)) == (CLF_TIME|CLF_HAVEDATE)) { @@ -2048,7 +2030,7 @@ yyreduce: break; - case 65: + case 69: { (yyval.Meridian) = MER24; @@ -2056,7 +2038,7 @@ yyreduce: break; - case 66: + case 70: { (yyval.Meridian) = (yyvsp[0].Meridian); @@ -2752,6 +2734,7 @@ TclDatelex( } if (!(c & 0x80) && isalpha(UCHAR(c))) { /* INTL: ISO only. */ int ret; + const char *litStart = yyInput; for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */ || c == '.'; ) { if (p < &buff[sizeof buff - 1]) { @@ -2763,12 +2746,19 @@ TclDatelex( location->last_column = yyInput - info->dateStart - 1; ret = LookupWord(yylvalPtr, buff); /* - * lookahead for +/- digit, to differentiate between "GMT+1000 day" and "GMT +1000 day", + * lookahead: + * for spaces to consider word boundaries (for instance + * literal T in isodateTisotimeZ is not a TZ, but Z is UTC); + * for +/- digit, to differentiate between "GMT+1000 day" and "GMT +1000 day"; * bypass spaces after token (but ignore by TZ+OFFS), because should * recognize next SP token, if TZ only. */ if (ret == tZONE || ret == tDAYZONE) { c = *yyInput; + if (isdigit(c)) { /* literal not a TZ */ + yyInput = litStart; + return *yyInput++; + } if ((c == '+' || c == '-') && isdigit(UCHAR(*(yyInput+1)))) { if ( !isdigit(UCHAR(*(yyInput+2))) || !isdigit(UCHAR(*(yyInput+3)))) { diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 8594a3e..761324b 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -197,6 +197,12 @@ item : time { | number ; +iextime : tUNUMBER ':' tUNUMBER ':' tUNUMBER { + yyHour = $1; + yyMinutes = $3; + yySeconds = $5; + } + ; time : tUNUMBER tMERIDIAN { yyHour = $1; yyMinutes = 0; @@ -209,11 +215,8 @@ time : tUNUMBER tMERIDIAN { yySeconds = 0; yyMeridian = $4; } - | tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid { - yyHour = $1; - yyMinutes = $3; - yySeconds = $5; - yyMeridian = $6; + | iextime o_merid { + yyMeridian = $2; } ; @@ -273,6 +276,12 @@ day : tDAY { } ; +iexdate : tUNUMBER '-' tUNUMBER '-' tUNUMBER { + yyMonth = $3; + yyDay = $5; + yyYear = $1; + } + ; date : tUNUMBER '/' tUNUMBER { yyMonth = $1; yyDay = $3; @@ -292,11 +301,7 @@ date : tUNUMBER '/' tUNUMBER { yyMonth = $3; yyYear = $5; } - | tUNUMBER '-' tUNUMBER '-' tUNUMBER { - yyMonth = $3; - yyDay = $5; - yyYear = $1; - } + | iexdate | tMONTH tUNUMBER { yyMonth = $1; yyDay = $2; @@ -332,8 +337,9 @@ ordMonth: tNEXT tMONTH { } ; -iso : tISOBASE tZONE tISOBASE { - if ($2 != HOUR( 7)) YYABORT; /* T */ +isosep : 'T'|SP + ; +iso : tISOBASE isosep tISOBASE { yyYear = $1 / 10000; yyMonth = ($1 % 10000)/100; yyDay = $1 % 100; @@ -341,39 +347,21 @@ iso : tISOBASE tZONE tISOBASE { yyMinutes = ($3 % 10000)/100; yySeconds = $3 % 100; } - | tISOBASE tISOBASE { + | tISOBASE isosep iextime { yyYear = $1 / 10000; yyMonth = ($1 % 10000)/100; yyDay = $1 % 100; - yyHour = $2 / 10000; - yyMinutes = ($2 % 10000)/100; - yySeconds = $2 % 100; - } - | tISOBASE SP tUNUMBER ':' tUNUMBER ':' tUNUMBER { - yyYear = $1 / 10000; - yyMonth = ($1 % 10000)/100; - yyDay = $1 % 100; - yyHour = $3; - yyMinutes = $5; - yySeconds = $7; } - | tISOBASE tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER { - if ($2 != HOUR( 7)) YYABORT; /* T */ - yyYear = $1 / 10000; - yyMonth = ($1 % 10000)/100; - yyDay = $1 % 100; - yyHour = $3; - yyMinutes = $5; - yySeconds = $7; - } - | tISOBASE SP tISOBASE { + | tISOBASE tISOBASE { yyYear = $1 / 10000; yyMonth = ($1 % 10000)/100; yyDay = $1 % 100; - yyHour = $3 / 10000; - yyMinutes = ($3 % 10000)/100; - yySeconds = $3 % 100; + yyHour = $2 / 10000; + yyMinutes = ($2 % 10000)/100; + yySeconds = $2 % 100; } + | iexdate 'T' iextime + | iexdate iextime ; trek : tSTARDATE INTNUM '.' tUNUMBER { @@ -926,6 +914,7 @@ TclDatelex( } if (!(c & 0x80) && isalpha(UCHAR(c))) { /* INTL: ISO only. */ int ret; + const char *litStart = yyInput; for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */ || c == '.'; ) { if (p < &buff[sizeof buff - 1]) { @@ -937,12 +926,19 @@ TclDatelex( location->last_column = yyInput - info->dateStart - 1; ret = LookupWord(yylvalPtr, buff); /* - * lookahead for +/- digit, to differentiate between "GMT+1000 day" and "GMT +1000 day", + * lookahead: + * for spaces to consider word boundaries (for instance + * literal T in isodateTisotimeZ is not a TZ, but Z is UTC); + * for +/- digit, to differentiate between "GMT+1000 day" and "GMT +1000 day"; * bypass spaces after token (but ignore by TZ+OFFS), because should * recognize next SP token, if TZ only. */ if (ret == tZONE || ret == tDAYZONE) { c = *yyInput; + if (isdigit(c)) { /* literal not a TZ */ + yyInput = litStart; + return *yyInput++; + } if ((c == '+' || c == '-') && isdigit(UCHAR(*(yyInput+1)))) { if ( !isdigit(UCHAR(*(yyInput+2))) || !isdigit(UCHAR(*(yyInput+3)))) { -- cgit v0.12 From 4a1bdef486f74a006c874f0faa7d32837b575ee9 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 18:22:09 +0000 Subject: optimized ISO 8601 timestamp (with extended formats, T literal is optional now, more tests); decreases conflicts (10 shift/reduce and 9 reduce/reduce only); --- generic/tclDate.c | 383 +++++++++++++++++++++++++++++---------------------- generic/tclGetDate.y | 101 +++++++++----- tests/clock.test | 8 ++ 3 files changed, 293 insertions(+), 199 deletions(-) diff --git a/generic/tclDate.c b/generic/tclDate.c index 2ff30ac..77961a2 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -196,10 +196,12 @@ extern int TclDatedebug; tZONEwO2 = 270, tEPOCH = 271, tDST = 272, - tISOBASE = 273, - tDAY_UNIT = 274, - tNEXT = 275, - SP = 276 + tISOBAS8 = 273, + tISOBAS6 = 274, + tISOBASL = 275, + tDAY_UNIT = 276, + tNEXT = 277, + SP = 278 }; #endif @@ -501,21 +503,21 @@ union yyalloc /* YYFINAL -- State number of the termination state. */ #define YYFINAL 2 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 114 +#define YYLAST 121 /* YYNTOKENS -- Number of terminals. */ -#define YYNTOKENS 29 +#define YYNTOKENS 31 /* YYNNTS -- Number of nonterminals. */ -#define YYNNTS 21 +#define YYNNTS 23 /* YYNRULES -- Number of rules. */ -#define YYNRULES 70 +#define YYNRULES 73 /* YYNSTATES -- Number of states. */ -#define YYNSTATES 105 +#define YYNSTATES 108 /* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned by yylex, with out-of-bounds checking. */ #define YYUNDEFTOK 2 -#define YYMAXUTOK 276 +#define YYMAXUTOK 278 #define YYTRANSLATE(YYX) \ ((unsigned) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) @@ -528,11 +530,11 @@ static const yytype_uint8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 28, 23, 24, 27, 25, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 22, 2, + 2, 2, 2, 30, 25, 26, 29, 27, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 24, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 26, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 28, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -551,21 +553,21 @@ static const yytype_uint8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, - 15, 16, 17, 18, 19, 20, 21 + 15, 16, 17, 18, 19, 20, 21, 22, 23 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_uint16 yyrline[] = { - 0, 167, 167, 168, 169, 172, 175, 178, 181, 184, - 187, 190, 193, 197, 200, 206, 212, 218, 223, 227, - 231, 235, 239, 243, 249, 250, 253, 257, 261, 265, - 269, 273, 279, 285, 289, 294, 299, 304, 305, 309, - 314, 318, 323, 330, 334, 340, 340, 342, 350, 355, - 363, 364, 367, 381, 386, 389, 392, 395, 398, 401, - 404, 409, 412, 417, 421, 425, 431, 434, 439, 457, - 460 + 0, 171, 171, 172, 173, 176, 179, 182, 185, 188, + 191, 194, 197, 201, 204, 210, 216, 222, 227, 231, + 235, 239, 243, 247, 253, 254, 257, 261, 265, 269, + 273, 277, 283, 289, 293, 298, 299, 304, 308, 313, + 317, 322, 329, 333, 339, 339, 341, 346, 351, 353, + 358, 360, 361, 369, 380, 394, 399, 402, 405, 408, + 411, 414, 417, 422, 425, 430, 434, 438, 444, 447, + 450, 455, 473, 476 }; #endif @@ -577,11 +579,11 @@ static const char *const yytname[] = "$end", "error", "$undefined", "tAGO", "tDAY", "tDAYZONE", "tID", "tMERIDIAN", "tMONTH", "tMONTH_UNIT", "tSTARDATE", "tSEC_UNIT", "tUNUMBER", "tZONE", "tZONEwO4", "tZONEwO2", "tEPOCH", "tDST", - "tISOBASE", "tDAY_UNIT", "tNEXT", "SP", "':'", "','", "'-'", "'/'", - "'T'", "'.'", "'+'", "$accept", "spec", "item", "iextime", "time", - "zone", "comma", "day", "iexdate", "date", "ordMonth", "isosep", "iso", - "trek", "relspec", "relunits", "sign", "unit", "INTNUM", "number", - "o_merid", YY_NULLPTR + "tISOBAS8", "tISOBAS6", "tISOBASL", "tDAY_UNIT", "tNEXT", "SP", "':'", + "','", "'-'", "'/'", "'T'", "'.'", "'+'", "$accept", "spec", "item", + "iextime", "time", "zone", "comma", "day", "iexdate", "date", "ordMonth", + "isosep", "isodate", "isotime", "iso", "trek", "relspec", "relunits", + "sign", "unit", "INTNUM", "numitem", "o_merid", YY_NULLPTR }; #endif @@ -592,16 +594,17 @@ static const yytype_uint16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, - 275, 276, 58, 44, 45, 47, 84, 46, 43 + 275, 276, 277, 278, 58, 44, 45, 47, 84, 46, + 43 }; # endif -#define YYPACT_NINF -25 +#define YYPACT_NINF -21 #define yypact_value_is_default(Yystate) \ - (!!((Yystate) == (-25))) + (!!((Yystate) == (-21))) -#define YYTABLE_NINF -1 +#define YYTABLE_NINF -69 #define yytable_value_is_error(Yytable_value) \ 0 @@ -610,17 +613,17 @@ static const yytype_uint16 yytoknum[] = STATE-NUM. */ static const yytype_int8 yypact[] = { - -25, 46, -25, -19, -25, 4, -25, 21, -25, -1, - 20, 60, 60, -25, 10, -25, 1, 67, -25, -25, - -25, 42, -25, -25, -25, -4, -25, -25, -25, -25, - -25, 49, 14, -25, 6, -25, 68, -25, -19, -25, - -25, 63, -25, -25, 80, 81, 26, 82, -25, 21, - 21, -25, -25, -25, 29, -25, -25, 88, -25, 6, - -25, -25, -25, 75, 86, -25, -25, 95, 30, 6, - -25, -25, 89, 90, -25, 7, 76, 79, 83, -25, - -25, -25, -25, -25, -25, 92, -25, -25, 101, 6, - -25, -25, -25, 94, -25, 97, 98, 99, 85, -25, - -25, -25, -25, -25, -25 + -21, 66, -21, -20, -21, -5, -21, -9, -21, 86, + 24, 10, 10, -21, -21, -21, -4, -21, 97, 12, + -21, -21, -21, 6, -21, -21, -21, -21, -21, -21, + -17, -21, -21, -21, 54, 27, -21, -7, -21, 36, + -21, -20, -21, -21, -21, 31, -21, -21, 49, 50, + 46, 51, -21, -9, -9, -21, -21, -21, -21, 57, + -21, -7, -21, -21, -21, -21, -21, 25, -21, 63, + 37, -7, -21, -21, 56, 60, -21, 11, 43, 65, + 71, -21, -21, -21, -21, 59, -21, -21, -21, -21, + 95, -7, -21, -21, -21, 88, -21, 90, 91, 92, + 99, -21, -21, -21, -21, -21, -21, 93 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -628,98 +631,100 @@ static const yytype_int8 yypact[] = means the default is an error. */ static const yytype_uint8 yydefact[] = { - 2, 0, 1, 26, 20, 0, 65, 0, 63, 66, - 19, 0, 0, 41, 35, 64, 0, 0, 61, 62, - 3, 69, 5, 6, 9, 37, 7, 8, 11, 12, - 10, 54, 0, 60, 68, 13, 24, 27, 38, 66, - 67, 0, 28, 15, 40, 0, 0, 0, 18, 0, - 0, 49, 46, 45, 0, 31, 43, 66, 58, 0, - 4, 70, 17, 0, 0, 51, 53, 66, 0, 23, - 57, 25, 0, 0, 42, 69, 0, 0, 33, 21, - 22, 47, 48, 44, 59, 0, 50, 30, 66, 0, - 56, 39, 52, 0, 16, 0, 0, 0, 0, 29, - 55, 14, 36, 32, 34 + 2, 0, 1, 26, 20, 0, 67, 0, 65, 71, + 19, 0, 0, 40, 46, 47, 0, 66, 0, 0, + 63, 64, 3, 72, 5, 6, 9, 48, 7, 8, + 35, 11, 12, 10, 56, 0, 62, 0, 13, 24, + 27, 37, 68, 70, 69, 0, 28, 15, 39, 0, + 0, 0, 18, 0, 0, 53, 52, 31, 42, 68, + 60, 0, 4, 73, 17, 45, 44, 0, 55, 68, + 0, 23, 59, 25, 0, 0, 41, 72, 0, 0, + 33, 21, 22, 43, 61, 0, 49, 50, 51, 30, + 68, 0, 58, 38, 54, 0, 16, 0, 0, 0, + 0, 29, 57, 14, 36, 32, 34, 0 }; /* YYPGOTO[NTERM-NUM]. */ static const yytype_int8 yypgoto[] = { - -25, -25, 96, -24, -25, -25, 74, -25, -25, -25, - -25, -25, -25, -25, -25, -25, 57, -16, -5, -25, - 39 + -21, -21, 100, 47, -21, -21, 79, -21, -21, -21, + -21, -21, -21, -21, -21, -21, -21, -21, 40, -18, + -6, -21, 44 }; /* YYDEFGOTO[NTERM-NUM]. */ static const yytype_int8 yydefgoto[] = { - -1, 1, 20, 21, 22, 23, 37, 24, 25, 26, - 27, 54, 28, 29, 30, 31, 32, 33, 34, 35, - 62 + -1, 1, 22, 23, 24, 25, 40, 26, 27, 28, + 29, 67, 30, 88, 31, 32, 33, 34, 35, 36, + 37, 38, 64 }; /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If positive, shift that token. If negative, reduce the rule whose number is the opposite. If YYTABLE_NINF, syntax error. */ -static const yytype_uint8 yytable[] = +static const yytype_int8 yytable[] = { - 58, 65, 41, 42, 36, 55, 43, 44, 63, 56, - 6, 59, 8, 57, 61, 6, 38, 8, 70, 40, - 15, 45, 64, 46, 47, 15, 67, 69, 51, 93, - 82, 52, 40, 39, 76, 68, 53, 48, 77, 40, - 86, 63, 88, 84, 79, 80, 2, 81, 40, 61, - 3, 4, 66, 90, 5, 6, 7, 8, 9, 10, - 11, 12, 13, 89, 14, 15, 16, 17, 49, 50, - 18, 3, 4, 100, 19, 5, 6, 7, 8, 9, - 10, 11, 12, 13, 18, 14, 15, 16, 19, 71, - 73, 18, 74, 75, 78, 19, 83, 85, 63, 87, - 95, 91, 92, 96, 98, 99, 101, 93, 97, 102, - 103, 104, 72, 60, 94 + 60, 45, 6, 42, 8, 39, 65, 41, 55, 43, + 44, 66, 61, 63, 17, 56, 3, 4, 63, 72, + 5, 6, 7, 8, 9, 10, 11, 12, 13, 71, + 14, 15, 16, 17, 18, 95, 20, 85, 20, 69, + 21, 52, 21, 84, 86, 43, 44, 81, 82, 90, + 70, 53, 54, 92, 78, 43, 44, 68, 79, 73, + 75, 76, 77, 80, 91, 83, 2, 89, 93, 97, + 3, 4, 94, 102, 5, 6, 7, 8, 9, 10, + 11, 12, 13, 100, 14, 15, 16, 17, 18, 19, + 46, 98, 20, 47, 48, -68, 21, -68, 99, 101, + 103, 57, 104, 105, 106, 58, 6, -68, 8, 59, + 49, 107, 50, 51, 87, 43, 44, 95, 17, 62, + 74, 96 }; static const yytype_uint8 yycheck[] = { - 16, 25, 7, 4, 23, 4, 7, 8, 12, 8, - 9, 16, 11, 12, 7, 9, 12, 11, 34, 18, - 19, 22, 26, 24, 25, 19, 12, 32, 18, 22, - 54, 21, 18, 12, 8, 21, 26, 17, 12, 18, - 64, 12, 12, 59, 49, 50, 0, 18, 18, 7, - 4, 5, 3, 69, 8, 9, 10, 11, 12, 13, - 14, 15, 16, 68, 18, 19, 20, 21, 11, 12, - 24, 4, 5, 89, 28, 8, 9, 10, 11, 12, - 13, 14, 15, 16, 24, 18, 19, 20, 28, 21, - 27, 24, 12, 12, 12, 28, 8, 22, 12, 4, - 24, 12, 12, 24, 12, 4, 12, 22, 25, 12, - 12, 12, 38, 17, 75 + 18, 7, 9, 12, 11, 25, 23, 12, 12, 18, + 19, 28, 18, 7, 21, 19, 4, 5, 7, 37, + 8, 9, 10, 11, 12, 13, 14, 15, 16, 35, + 18, 19, 20, 21, 22, 24, 26, 12, 26, 12, + 30, 17, 30, 61, 19, 18, 19, 53, 54, 12, + 23, 11, 12, 71, 8, 18, 19, 3, 12, 23, + 29, 12, 12, 12, 70, 8, 0, 4, 12, 26, + 4, 5, 12, 91, 8, 9, 10, 11, 12, 13, + 14, 15, 16, 24, 18, 19, 20, 21, 22, 23, + 4, 26, 26, 7, 8, 9, 30, 11, 27, 4, + 12, 4, 12, 12, 12, 8, 9, 21, 11, 12, + 24, 12, 26, 27, 67, 18, 19, 24, 21, 19, + 41, 77 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing symbol of state STATE-NUM. */ static const yytype_uint8 yystos[] = { - 0, 30, 0, 4, 5, 8, 9, 10, 11, 12, - 13, 14, 15, 16, 18, 19, 20, 21, 24, 28, - 31, 32, 33, 34, 36, 37, 38, 39, 41, 42, - 43, 44, 45, 46, 47, 48, 23, 35, 12, 12, - 18, 47, 4, 7, 8, 22, 24, 25, 17, 45, - 45, 18, 21, 26, 40, 4, 8, 12, 46, 47, - 31, 7, 49, 12, 26, 32, 3, 12, 21, 47, - 46, 21, 35, 27, 12, 12, 8, 12, 12, 47, - 47, 18, 32, 8, 46, 22, 32, 4, 12, 47, - 46, 12, 12, 22, 49, 24, 24, 25, 12, 4, - 46, 12, 12, 12, 12 + 0, 32, 0, 4, 5, 8, 9, 10, 11, 12, + 13, 14, 15, 16, 18, 19, 20, 21, 22, 23, + 26, 30, 33, 34, 35, 36, 38, 39, 40, 41, + 43, 45, 46, 47, 48, 49, 50, 51, 52, 25, + 37, 12, 12, 18, 19, 51, 4, 7, 8, 24, + 26, 27, 17, 49, 49, 12, 19, 4, 8, 12, + 50, 51, 33, 7, 53, 23, 28, 42, 3, 12, + 23, 51, 50, 23, 37, 29, 12, 12, 8, 12, + 12, 51, 51, 8, 50, 12, 19, 34, 44, 4, + 12, 51, 50, 12, 12, 24, 53, 26, 26, 27, + 24, 4, 50, 12, 12, 12, 12, 12 }; /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ static const yytype_uint8 yyr1[] = { - 0, 29, 30, 30, 30, 31, 31, 31, 31, 31, - 31, 31, 31, 31, 32, 33, 33, 33, 34, 34, - 34, 34, 34, 34, 35, 35, 36, 36, 36, 36, - 36, 36, 37, 38, 38, 38, 38, 38, 38, 38, - 38, 38, 38, 39, 39, 40, 40, 41, 41, 41, - 41, 41, 42, 43, 43, 44, 44, 44, 44, 44, - 44, 45, 45, 46, 46, 46, 47, 47, 48, 49, - 49 + 0, 31, 32, 32, 32, 33, 33, 33, 33, 33, + 33, 33, 33, 33, 34, 35, 35, 35, 36, 36, + 36, 36, 36, 36, 37, 37, 38, 38, 38, 38, + 38, 38, 39, 40, 40, 40, 40, 40, 40, 40, + 40, 40, 41, 41, 42, 42, 43, 43, 43, 44, + 44, 45, 45, 45, 46, 47, 47, 48, 48, 48, + 48, 48, 48, 49, 49, 50, 50, 50, 51, 51, + 51, 52, 53, 53 }; /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN. */ @@ -728,11 +733,11 @@ static const yytype_uint8 yyr2[] = 0, 2, 0, 2, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 5, 2, 4, 2, 2, 1, 1, 3, 3, 2, 1, 2, 1, 2, 2, 4, - 3, 2, 5, 3, 5, 1, 5, 1, 2, 4, - 2, 1, 3, 2, 3, 1, 1, 3, 3, 2, - 3, 2, 4, 2, 1, 4, 3, 2, 2, 3, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, - 1 + 3, 2, 5, 3, 5, 1, 5, 2, 4, 2, + 1, 3, 2, 3, 1, 1, 1, 1, 1, 1, + 1, 3, 2, 2, 4, 2, 1, 4, 3, 2, + 2, 3, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 0, 1 }; @@ -1753,16 +1758,6 @@ yyreduce: break; - case 35: - - { - yyYear = (yyvsp[0].Number) / 10000; - yyMonth = ((yyvsp[0].Number) % 10000)/100; - yyDay = (yyvsp[0].Number) % 100; - } - - break; - case 36: { @@ -1773,7 +1768,7 @@ yyreduce: break; - case 38: + case 37: { yyMonth = (yyvsp[-1].Number); @@ -1782,7 +1777,7 @@ yyreduce: break; - case 39: + case 38: { yyMonth = (yyvsp[-3].Number); @@ -1792,7 +1787,7 @@ yyreduce: break; - case 40: + case 39: { yyMonth = (yyvsp[0].Number); @@ -1801,7 +1796,7 @@ yyreduce: break; - case 41: + case 40: { yyMonth = 1; @@ -1811,7 +1806,7 @@ yyreduce: break; - case 42: + case 41: { yyMonth = (yyvsp[-1].Number); @@ -1821,7 +1816,7 @@ yyreduce: break; - case 43: + case 42: { yyMonthOrdinalIncr = 1; @@ -1830,7 +1825,7 @@ yyreduce: break; - case 44: + case 43: { yyMonthOrdinalIncr = (yyvsp[-1].Number); @@ -1839,25 +1834,22 @@ yyreduce: break; - case 47: + case 46: - { - yyYear = (yyvsp[-2].Number) / 10000; - yyMonth = ((yyvsp[-2].Number) % 10000)/100; - yyDay = (yyvsp[-2].Number) % 100; - yyHour = (yyvsp[0].Number) / 10000; - yyMinutes = ((yyvsp[0].Number) % 10000)/100; - yySeconds = (yyvsp[0].Number) % 100; + { /* YYYYMMDD */ + yyYear = (yyvsp[0].Number) / 10000; + yyMonth = ((yyvsp[0].Number) % 10000)/100; + yyDay = (yyvsp[0].Number) % 100; } break; - case 48: + case 47: - { - yyYear = (yyvsp[-2].Number) / 10000; - yyMonth = ((yyvsp[-2].Number) % 10000)/100; - yyDay = (yyvsp[-2].Number) % 100; + { /* YYMMDD */ + yyYear = (yyvsp[0].Number) / 10000; + yyMonth = ((yyvsp[0].Number) % 10000)/100; + yyDay = (yyvsp[0].Number) % 100; } break; @@ -1865,6 +1857,16 @@ yyreduce: case 49: { + yyHour = (yyvsp[0].Number) / 10000; + yyMinutes = ((yyvsp[0].Number) % 10000)/100; + yySeconds = (yyvsp[0].Number) % 100; + } + + break; + + case 52: + + { /* YYYYMMDDhhmmss */ yyYear = (yyvsp[-1].Number) / 10000; yyMonth = ((yyvsp[-1].Number) % 10000)/100; yyDay = (yyvsp[-1].Number) % 100; @@ -1875,7 +1877,21 @@ yyreduce: break; - case 52: + case 53: + + { /* YYYYMMDDhhmm */ + if (yyDigitCount != 4) YYABORT; /* normally unreached */ + yyYear = (yyvsp[-1].Number) / 10000; + yyMonth = ((yyvsp[-1].Number) % 10000)/100; + yyDay = (yyvsp[-1].Number) % 100; + yyHour = (yyvsp[0].Number) / 100; + yyMinutes = ((yyvsp[0].Number) % 100); + yySeconds = 0; + } + + break; + + case 54: { /* @@ -1892,7 +1908,7 @@ yyreduce: break; - case 53: + case 55: { yyRelSeconds *= -1; @@ -1902,7 +1918,7 @@ yyreduce: break; - case 55: + case 57: { *yyRelPointer += (yyvsp[-3].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number); @@ -1910,7 +1926,7 @@ yyreduce: break; - case 56: + case 58: { *yyRelPointer += (yyvsp[-2].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number); @@ -1918,7 +1934,7 @@ yyreduce: break; - case 57: + case 59: { *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number); @@ -1926,7 +1942,7 @@ yyreduce: break; - case 58: + case 60: { *yyRelPointer += (yyvsp[0].Number); @@ -1934,7 +1950,7 @@ yyreduce: break; - case 59: + case 61: { *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number); @@ -1942,7 +1958,7 @@ yyreduce: break; - case 60: + case 62: { *yyRelPointer += (yyvsp[0].Number); @@ -1950,7 +1966,7 @@ yyreduce: break; - case 61: + case 63: { (yyval.Number) = -1; @@ -1958,7 +1974,7 @@ yyreduce: break; - case 62: + case 64: { (yyval.Number) = 1; @@ -1966,7 +1982,7 @@ yyreduce: break; - case 63: + case 65: { (yyval.Number) = (yyvsp[0].Number); @@ -1975,7 +1991,7 @@ yyreduce: break; - case 64: + case 66: { (yyval.Number) = (yyvsp[0].Number); @@ -1984,7 +2000,7 @@ yyreduce: break; - case 65: + case 67: { (yyval.Number) = (yyvsp[0].Number); @@ -1993,7 +2009,7 @@ yyreduce: break; - case 66: + case 68: { (yyval.Number) = (yyvsp[0].Number); @@ -2001,7 +2017,7 @@ yyreduce: break; - case 67: + case 69: { (yyval.Number) = (yyvsp[0].Number); @@ -2009,7 +2025,15 @@ yyreduce: break; - case 68: + case 70: + + { + (yyval.Number) = (yyvsp[0].Number); + } + + break; + + case 71: { if ((info->flags & (CLF_TIME|CLF_HAVEDATE|CLF_RELCONV)) == (CLF_TIME|CLF_HAVEDATE)) { @@ -2030,7 +2054,7 @@ yyreduce: break; - case 69: + case 72: { (yyval.Meridian) = MER24; @@ -2038,7 +2062,7 @@ yyreduce: break; - case 70: + case 73: { (yyval.Meridian) = (yyvsp[0].Meridian); @@ -2690,6 +2714,7 @@ TclDatelex( register char *p; char buff[20]; int Count; + const char *tokStart; location->first_column = yyInput - info->dateStart; for ( ; ; ) { @@ -2702,6 +2727,7 @@ TclDatelex( return SP; } } + tokStart = yyInput; if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */ @@ -2711,30 +2737,51 @@ TclDatelex( register int num = c - '0'; p = (char *)yyInput; while (isdigit(UCHAR(c = *(++p)))) { - num *= 10; - num += c - '0'; - }; + if (num >= 0) { + num *= 10; num += c - '0'; + } + } yylvalPtr->Number = num; yyDigitCount = p - yyInput; yyInput = p; - /* ignore spaces after digits (optional) */ - yyInput = bypassSpaces(yyInput); /* * A number with 6 or more digits is considered an ISO 8601 base. */ + location->last_column = yyInput - info->dateStart - 1; if (yyDigitCount >= 6) { - location->last_column = yyInput - info->dateStart - 1; - return tISOBASE; - } else { - location->last_column = yyInput - info->dateStart - 1; - return tUNUMBER; + if (yyDigitCount == 14 || yyDigitCount == 12) { + /* long form of ISO 8601 (without separator), either + * YYYYMMDDhhmmss or YYYYMMDDhhmm, so reduce to date + * (8 chars is isodate) */ + p = (char *)tokStart; + num = *p++ - '0'; + do { + num *= 10; num += *p++ - '0'; + } while (p - tokStart < 8); + yylvalPtr->Number = num; + yyDigitCount = 8; + yyInput = p; + location->last_column = yyInput - info->dateStart - 1; + return tISOBASL; + } + if (num < 0) { /* overflow */ + return tID; + } + if (yyDigitCount == 8) { + return tISOBAS8; + } + if (yyDigitCount == 6) { + return tISOBAS6; + } } + /* ignore spaces after digits (optional) */ + yyInput = bypassSpaces(yyInput); + return tUNUMBER; } if (!(c & 0x80) && isalpha(UCHAR(c))) { /* INTL: ISO only. */ int ret; - const char *litStart = yyInput; for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */ || c == '.'; ) { if (p < &buff[sizeof buff - 1]) { @@ -2756,7 +2803,7 @@ TclDatelex( if (ret == tZONE || ret == tDAYZONE) { c = *yyInput; if (isdigit(c)) { /* literal not a TZ */ - yyInput = litStart; + yyInput = tokStart; return *yyInput++; } if ((c == '+' || c == '-') && isdigit(UCHAR(*(yyInput+1)))) { diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 761324b..c3df99e 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -137,7 +137,9 @@ MODULE_SCOPE int yyparse(DateInfo*); %token tZONEwO2 %token tEPOCH %token tDST -%token tISOBASE +%token tISOBAS8 +%token tISOBAS6 +%token tISOBASL %token tDAY_UNIT %token tNEXT %token SP @@ -153,7 +155,9 @@ MODULE_SCOPE int yyparse(DateInfo*); %type tZONE %type tZONEwO4 %type tZONEwO2 -%type tISOBASE +%type tISOBAS8 +%type tISOBAS6 +%type tISOBASL %type tDAY_UNIT %type unit %type sign @@ -194,7 +198,7 @@ item : time { yyIncrFlags(CLF_TIME|CLF_HAVEDATE); info->flags |= CLF_RELCONV; } - | number + | numitem ; iextime : tUNUMBER ':' tUNUMBER ':' tUNUMBER { @@ -291,17 +295,12 @@ date : tUNUMBER '/' tUNUMBER { yyDay = $3; yyYear = $5; } - | tISOBASE { - yyYear = $1 / 10000; - yyMonth = ($1 % 10000)/100; - yyDay = $1 % 100; - } + | isodate | tUNUMBER '-' tMONTH '-' tUNUMBER { yyDay = $1; yyMonth = $3; yyYear = $5; } - | iexdate | tMONTH tUNUMBER { yyMonth = $1; yyDay = $2; @@ -339,20 +338,27 @@ ordMonth: tNEXT tMONTH { isosep : 'T'|SP ; -iso : tISOBASE isosep tISOBASE { +isodate : tISOBAS8 { /* YYYYMMDD */ yyYear = $1 / 10000; yyMonth = ($1 % 10000)/100; yyDay = $1 % 100; - yyHour = $3 / 10000; - yyMinutes = ($3 % 10000)/100; - yySeconds = $3 % 100; } - | tISOBASE isosep iextime { + | tISOBAS6 { /* YYMMDD */ yyYear = $1 / 10000; yyMonth = ($1 % 10000)/100; yyDay = $1 % 100; } - | tISOBASE tISOBASE { + | iexdate + ; +isotime : tISOBAS6 { + yyHour = $1 / 10000; + yyMinutes = ($1 % 10000)/100; + yySeconds = $1 % 100; + } + | iextime + ; +iso : isodate isosep isotime + | tISOBASL tISOBAS6 { /* YYYYMMDDhhmmss */ yyYear = $1 / 10000; yyMonth = ($1 % 10000)/100; yyDay = $1 % 100; @@ -360,8 +366,15 @@ iso : tISOBASE isosep tISOBASE { yyMinutes = ($2 % 10000)/100; yySeconds = $2 % 100; } - | iexdate 'T' iextime - | iexdate iextime + | tISOBASL tUNUMBER { /* YYYYMMDDhhmm */ + if (yyDigitCount != 4) YYABORT; /* normally unreached */ + yyYear = $1 / 10000; + yyMonth = ($1 % 10000)/100; + yyDay = $1 % 100; + yyHour = $2 / 100; + yyMinutes = ($2 % 100); + yySeconds = 0; + } ; trek : tSTARDATE INTNUM '.' tUNUMBER { @@ -431,12 +444,15 @@ unit : tSEC_UNIT { INTNUM : tUNUMBER { $$ = $1; } - | tISOBASE { + | tISOBAS6 { + $$ = $1; + } + | tISOBAS8 { $$ = $1; } ; -number : INTNUM { +numitem : tUNUMBER { if ((info->flags & (CLF_TIME|CLF_HAVEDATE|CLF_RELCONV)) == (CLF_TIME|CLF_HAVEDATE)) { yyYear = $1; } else { @@ -870,6 +886,7 @@ TclDatelex( register char *p; char buff[20]; int Count; + const char *tokStart; location->first_column = yyInput - info->dateStart; for ( ; ; ) { @@ -882,6 +899,7 @@ TclDatelex( return SP; } } + tokStart = yyInput; if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */ @@ -891,30 +909,51 @@ TclDatelex( register int num = c - '0'; p = (char *)yyInput; while (isdigit(UCHAR(c = *(++p)))) { - num *= 10; - num += c - '0'; - }; + if (num >= 0) { + num *= 10; num += c - '0'; + } + } yylvalPtr->Number = num; yyDigitCount = p - yyInput; yyInput = p; - /* ignore spaces after digits (optional) */ - yyInput = bypassSpaces(yyInput); /* * A number with 6 or more digits is considered an ISO 8601 base. */ + location->last_column = yyInput - info->dateStart - 1; if (yyDigitCount >= 6) { - location->last_column = yyInput - info->dateStart - 1; - return tISOBASE; - } else { - location->last_column = yyInput - info->dateStart - 1; - return tUNUMBER; + if (yyDigitCount == 14 || yyDigitCount == 12) { + /* long form of ISO 8601 (without separator), either + * YYYYMMDDhhmmss or YYYYMMDDhhmm, so reduce to date + * (8 chars is isodate) */ + p = (char *)tokStart; + num = *p++ - '0'; + do { + num *= 10; num += *p++ - '0'; + } while (p - tokStart < 8); + yylvalPtr->Number = num; + yyDigitCount = 8; + yyInput = p; + location->last_column = yyInput - info->dateStart - 1; + return tISOBASL; + } + if (num < 0) { /* overflow */ + return tID; + } + if (yyDigitCount == 8) { + return tISOBAS8; + } + if (yyDigitCount == 6) { + return tISOBAS6; + } } + /* ignore spaces after digits (optional) */ + yyInput = bypassSpaces(yyInput); + return tUNUMBER; } if (!(c & 0x80) && isalpha(UCHAR(c))) { /* INTL: ISO only. */ int ret; - const char *litStart = yyInput; for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */ || c == '.'; ) { if (p < &buff[sizeof buff - 1]) { @@ -936,7 +975,7 @@ TclDatelex( if (ret == tZONE || ret == tDAYZONE) { c = *yyInput; if (isdigit(c)) { /* literal not a TZ */ - yyInput = litStart; + yyInput = tokStart; return *yyInput++; } if ((c == '+' || c == '-') && isdigit(UCHAR(*(yyInput+1)))) { diff --git a/tests/clock.test b/tests/clock.test index dd6356b..5f18bf3 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -36191,6 +36191,14 @@ test clock-34.16 {clock scan, ISO 8601 point in time format} { set time [clock scan "19921023T235959" -gmt true] clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true } "Oct 23, 1992 23:59:59" +test clock-34.16.1a {clock scan, ISO 8601 T literal optional (YYYYMMDDhhmmss)} { + set time [clock scan "19921023235959" -gmt true] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true +} "Oct 23, 1992 23:59:59" +test clock-34.16.1b {clock scan, ISO 8601 T literal optional (YYYYMMDDhhmm)} { + set time [clock scan "199210232359" -gmt true] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true +} "Oct 23, 1992 23:59:00" test clock-34.16.2 {clock scan, ISO 8601 extended date time} { set time [clock scan "1992-10-23T23:59:59" -gmt true] clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true -- cgit v0.12 From 65f65c4def78019de7475eeb66b9744ec60aa5ec Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 18:22:19 +0000 Subject: small amend to #21 allowing time without seconds part "hh:mm" as extended ISO time (with and without T literal) --- generic/tclDate.c | 119 +++++++++++++++++++++++++-------------------------- generic/tclGetDate.y | 11 +++-- tests/clock.test | 14 +++++- 3 files changed, 77 insertions(+), 67 deletions(-) diff --git a/generic/tclDate.c b/generic/tclDate.c index 77961a2..dd59d7e 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -512,7 +512,7 @@ union yyalloc /* YYNRULES -- Number of rules. */ #define YYNRULES 73 /* YYNSTATES -- Number of states. */ -#define YYNSTATES 108 +#define YYNSTATES 105 /* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned by yylex, with out-of-bounds checking. */ @@ -561,13 +561,13 @@ static const yytype_uint8 yytranslate[] = static const yytype_uint16 yyrline[] = { 0, 171, 171, 172, 173, 176, 179, 182, 185, 188, - 191, 194, 197, 201, 204, 210, 216, 222, 227, 231, - 235, 239, 243, 247, 253, 254, 257, 261, 265, 269, - 273, 277, 283, 289, 293, 298, 299, 304, 308, 313, - 317, 322, 329, 333, 339, 339, 341, 346, 351, 353, - 358, 360, 361, 369, 380, 394, 399, 402, 405, 408, - 411, 414, 417, 422, 425, 430, 434, 438, 444, 447, - 450, 455, 473, 476 + 191, 194, 197, 201, 204, 209, 215, 221, 226, 230, + 234, 238, 242, 246, 252, 253, 256, 260, 264, 268, + 272, 276, 282, 288, 292, 297, 298, 303, 307, 312, + 316, 321, 328, 332, 338, 338, 340, 345, 350, 352, + 357, 359, 360, 368, 379, 393, 398, 401, 404, 407, + 410, 413, 416, 421, 424, 429, 433, 437, 443, 446, + 449, 454, 472, 475 }; #endif @@ -613,17 +613,17 @@ static const yytype_uint16 yytoknum[] = STATE-NUM. */ static const yytype_int8 yypact[] = { - -21, 66, -21, -20, -21, -5, -21, -9, -21, 86, - 24, 10, 10, -21, -21, -21, -4, -21, 97, 12, - -21, -21, -21, 6, -21, -21, -21, -21, -21, -21, - -17, -21, -21, -21, 54, 27, -21, -7, -21, 36, - -21, -20, -21, -21, -21, 31, -21, -21, 49, 50, - 46, 51, -21, -9, -9, -21, -21, -21, -21, 57, - -21, -7, -21, -21, -21, -21, -21, 25, -21, 63, - 37, -7, -21, -21, 56, 60, -21, 11, 43, 65, - 71, -21, -21, -21, -21, 59, -21, -21, -21, -21, - 95, -7, -21, -21, -21, 88, -21, 90, 91, 92, - 99, -21, -21, -21, -21, -21, -21, 93 + -21, 66, -21, -20, -21, 1, -21, -9, -21, 86, + 18, 14, 14, -21, -21, -21, -4, -21, 97, 12, + -21, -21, -21, 30, -21, -21, -21, -21, -21, -21, + 13, -21, -21, -21, 48, 27, -21, -7, -21, 29, + -21, -20, -21, -21, -21, 28, -21, -21, 47, 49, + 46, 50, -21, -9, -9, -21, -21, -21, -21, 52, + -21, -7, -21, -21, -21, -21, -21, -1, -21, 59, + 37, -7, -21, -21, 53, 55, -21, 44, 43, 57, + 45, -21, -21, -21, -21, 67, -21, -21, -21, -21, + 94, -7, -21, -21, -21, 87, 88, 90, 91, -21, + -21, -21, -21, -21, -21 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -635,21 +635,21 @@ static const yytype_uint8 yydefact[] = 19, 0, 0, 40, 46, 47, 0, 66, 0, 0, 63, 64, 3, 72, 5, 6, 9, 48, 7, 8, 35, 11, 12, 10, 56, 0, 62, 0, 13, 24, - 27, 37, 68, 70, 69, 0, 28, 15, 39, 0, + 27, 37, 68, 70, 69, 0, 28, 16, 39, 0, 0, 0, 18, 0, 0, 53, 52, 31, 42, 68, 60, 0, 4, 73, 17, 45, 44, 0, 55, 68, - 0, 23, 59, 25, 0, 0, 41, 72, 0, 0, + 0, 23, 59, 25, 0, 0, 41, 15, 0, 0, 33, 21, 22, 43, 61, 0, 49, 50, 51, 30, - 68, 0, 58, 38, 54, 0, 16, 0, 0, 0, - 0, 29, 57, 14, 36, 32, 34, 0 + 68, 0, 58, 38, 54, 0, 0, 0, 0, 29, + 57, 14, 36, 32, 34 }; /* YYPGOTO[NTERM-NUM]. */ static const yytype_int8 yypgoto[] = { - -21, -21, 100, 47, -21, -21, 79, -21, -21, -21, - -21, -21, -21, -21, -21, -21, -21, -21, 40, -18, - -6, -21, 44 + -21, -21, 85, 54, -21, -21, 70, -21, -21, -21, + -21, -21, -21, -21, -21, -21, -21, -21, -5, -18, + -6, -21, -21 }; /* YYDEFGOTO[NTERM-NUM]. */ @@ -665,36 +665,36 @@ static const yytype_int8 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int8 yytable[] = { - 60, 45, 6, 42, 8, 39, 65, 41, 55, 43, - 44, 66, 61, 63, 17, 56, 3, 4, 63, 72, + 60, 45, 6, 42, 8, 39, 53, 54, 55, 43, + 44, 85, 61, 41, 17, 56, 3, 4, 86, 72, 5, 6, 7, 8, 9, 10, 11, 12, 13, 71, - 14, 15, 16, 17, 18, 95, 20, 85, 20, 69, - 21, 52, 21, 84, 86, 43, 44, 81, 82, 90, - 70, 53, 54, 92, 78, 43, 44, 68, 79, 73, - 75, 76, 77, 80, 91, 83, 2, 89, 93, 97, - 3, 4, 94, 102, 5, 6, 7, 8, 9, 10, - 11, 12, 13, 100, 14, 15, 16, 17, 18, 19, - 46, 98, 20, 47, 48, -68, 21, -68, 99, 101, - 103, 57, 104, 105, 106, 58, 6, -68, 8, 59, - 49, 107, 50, 51, 87, 43, 44, 95, 17, 62, - 74, 96 + 14, 15, 16, 17, 18, 52, 65, 63, 20, 69, + 20, 66, 21, 84, 21, 43, 44, 81, 82, 90, + 70, 68, 73, 92, 78, 43, 44, 75, 79, 76, + 83, 77, 80, 89, 91, 93, 2, 94, 95, 96, + 3, 4, 98, 100, 5, 6, 7, 8, 9, 10, + 11, 12, 13, 97, 14, 15, 16, 17, 18, 19, + 46, 49, 20, 47, 48, -68, 21, -68, 99, 101, + 102, 57, 103, 104, 62, 58, 6, -68, 8, 59, + 49, 74, 50, 51, 0, 43, 44, 0, 17, 0, + 0, 87 }; -static const yytype_uint8 yycheck[] = +static const yytype_int8 yycheck[] = { - 18, 7, 9, 12, 11, 25, 23, 12, 12, 18, - 19, 28, 18, 7, 21, 19, 4, 5, 7, 37, + 18, 7, 9, 12, 11, 25, 11, 12, 12, 18, + 19, 12, 18, 12, 21, 19, 4, 5, 19, 37, 8, 9, 10, 11, 12, 13, 14, 15, 16, 35, - 18, 19, 20, 21, 22, 24, 26, 12, 26, 12, - 30, 17, 30, 61, 19, 18, 19, 53, 54, 12, - 23, 11, 12, 71, 8, 18, 19, 3, 12, 23, - 29, 12, 12, 12, 70, 8, 0, 4, 12, 26, - 4, 5, 12, 91, 8, 9, 10, 11, 12, 13, - 14, 15, 16, 24, 18, 19, 20, 21, 22, 23, - 4, 26, 26, 7, 8, 9, 30, 11, 27, 4, - 12, 4, 12, 12, 12, 8, 9, 21, 11, 12, - 24, 12, 26, 27, 67, 18, 19, 24, 21, 19, - 41, 77 + 18, 19, 20, 21, 22, 17, 23, 7, 26, 12, + 26, 28, 30, 61, 30, 18, 19, 53, 54, 12, + 23, 3, 23, 71, 8, 18, 19, 29, 12, 12, + 8, 12, 12, 4, 70, 12, 0, 12, 24, 26, + 4, 5, 27, 91, 8, 9, 10, 11, 12, 13, + 14, 15, 16, 26, 18, 19, 20, 21, 22, 23, + 4, 24, 26, 7, 8, 9, 30, 11, 4, 12, + 12, 4, 12, 12, 19, 8, 9, 21, 11, 12, + 24, 41, 26, 27, -1, 18, 19, -1, 21, -1, + -1, 67 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -710,15 +710,15 @@ static const yytype_uint8 yystos[] = 50, 51, 33, 7, 53, 23, 28, 42, 3, 12, 23, 51, 50, 23, 37, 29, 12, 12, 8, 12, 12, 51, 51, 8, 50, 12, 19, 34, 44, 4, - 12, 51, 50, 12, 12, 24, 53, 26, 26, 27, - 24, 4, 50, 12, 12, 12, 12, 12 + 12, 51, 50, 12, 12, 24, 26, 26, 27, 4, + 50, 12, 12, 12, 12 }; /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ static const yytype_uint8 yyr1[] = { 0, 31, 32, 32, 32, 33, 33, 33, 33, 33, - 33, 33, 33, 33, 34, 35, 35, 35, 36, 36, + 33, 33, 33, 33, 34, 34, 35, 35, 36, 36, 36, 36, 36, 36, 37, 37, 38, 38, 38, 38, 38, 38, 39, 40, 40, 40, 40, 40, 40, 40, 40, 40, 41, 41, 42, 42, 43, 43, 43, 44, @@ -731,7 +731,7 @@ static const yytype_uint8 yyr1[] = static const yytype_uint8 yyr2[] = { 0, 2, 0, 2, 3, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 5, 2, 4, 2, 2, 1, + 1, 1, 1, 1, 5, 3, 2, 2, 2, 1, 1, 3, 3, 2, 1, 2, 1, 2, 2, 4, 3, 2, 5, 3, 5, 1, 5, 2, 4, 2, 1, 3, 2, 3, 1, 1, 1, 1, 1, 1, @@ -1594,10 +1594,9 @@ yyreduce: case 15: { - yyHour = (yyvsp[-1].Number); - yyMinutes = 0; + yyHour = (yyvsp[-2].Number); + yyMinutes = (yyvsp[0].Number); yySeconds = 0; - yyMeridian = (yyvsp[0].Meridian); } break; @@ -1605,8 +1604,8 @@ yyreduce: case 16: { - yyHour = (yyvsp[-3].Number); - yyMinutes = (yyvsp[-1].Number); + yyHour = (yyvsp[-1].Number); + yyMinutes = 0; yySeconds = 0; yyMeridian = (yyvsp[0].Meridian); } diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index c3df99e..0941d73 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -206,6 +206,11 @@ iextime : tUNUMBER ':' tUNUMBER ':' tUNUMBER { yyMinutes = $3; yySeconds = $5; } + | tUNUMBER ':' tUNUMBER { + yyHour = $1; + yyMinutes = $3; + yySeconds = 0; + } ; time : tUNUMBER tMERIDIAN { yyHour = $1; @@ -213,12 +218,6 @@ time : tUNUMBER tMERIDIAN { yySeconds = 0; yyMeridian = $2; } - | tUNUMBER ':' tUNUMBER o_merid { - yyHour = $1; - yyMinutes = $3; - yySeconds = 0; - yyMeridian = $4; - } | iextime o_merid { yyMeridian = $2; } diff --git a/tests/clock.test b/tests/clock.test index 5f18bf3..cffc803 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -36207,10 +36207,22 @@ test clock-34.17 {clock scan, ISO 8601 point in time format} { set time [clock scan "19921023 235959" -gmt true] clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true } "Oct 23, 1992 23:59:59" -test clock-34.17.2 {clock scan, ISO 8601 extended date time} { +test clock-34.17.2a {clock scan, ISO 8601 extended date time (YYYY-MM-DD hh:mm:ss)} { set time [clock scan "1992-10-23 23:59:59" -gmt true] clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true } "Oct 23, 1992 23:59:59" +test clock-34.17.2b {clock scan, ISO 8601 extended date time (YYYY-MM-DDThh:mm:ss)} { + set time [clock scan "1992-10-23T23:59:59" -gmt true] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true +} "Oct 23, 1992 23:59:59" +test clock-34.17.2c {clock scan, ISO 8601 extended date time (YYYY-MM-DD hh:mm)} { + set time [clock scan "1992-10-23 23:59" -gmt true] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true +} "Oct 23, 1992 23:59:00" +test clock-34.17.2d {clock scan, ISO 8601 extended date time (YYYY-MM-DDThh:mm)} { + set time [clock scan "1992-10-23T23:59" -gmt true] + clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true +} "Oct 23, 1992 23:59:00" test clock-34.17.3 {clock scan, TZ-word boundaries - Z is not TZ here } -body { set time [clock scan "1992-10-23Z23:59:59" -gmt true] clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true -- cgit v0.12 From 6e5bb624e6e80551a95eab130b1ee22a06dc90e6 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 18:26:46 +0000 Subject: resolves more shift/reduce conflicts (since SP token is expected by few items only, otherwise silently ignored) --- generic/tclDate.c | 286 +++++++++++++++++++++++++-------------------------- generic/tclGetDate.y | 2 +- 2 files changed, 142 insertions(+), 146 deletions(-) diff --git a/generic/tclDate.c b/generic/tclDate.c index df8aeb5..f9173c5 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -501,16 +501,16 @@ union yyalloc /* YYFINAL -- State number of the termination state. */ #define YYFINAL 2 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 116 +#define YYLAST 97 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 28 /* YYNNTS -- Number of nonterminals. */ #define YYNNTS 18 /* YYNRULES -- Number of rules. */ -#define YYNRULES 66 +#define YYNRULES 65 /* YYNSTATES -- Number of states. */ -#define YYNSTATES 106 +#define YYNSTATES 104 /* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned by yylex, with out-of-bounds checking. */ @@ -558,13 +558,13 @@ static const yytype_uint8 yytranslate[] = /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_uint16 yyrline[] = { - 0, 167, 167, 168, 169, 172, 175, 178, 181, 184, - 187, 190, 193, 197, 200, 206, 212, 220, 224, 228, - 232, 236, 240, 246, 247, 250, 254, 258, 262, 266, - 270, 276, 280, 285, 290, 295, 300, 304, 309, 313, - 318, 325, 329, 335, 344, 352, 360, 369, 379, 393, - 398, 401, 404, 407, 410, 413, 416, 421, 424, 429, - 433, 437, 443, 446, 451, 469, 472 + 0, 167, 167, 168, 172, 175, 178, 181, 184, 187, + 190, 193, 197, 200, 206, 212, 220, 224, 228, 232, + 236, 240, 246, 247, 250, 254, 258, 262, 266, 270, + 276, 280, 285, 290, 295, 300, 304, 309, 313, 318, + 325, 329, 335, 344, 352, 360, 369, 379, 393, 398, + 401, 404, 407, 410, 413, 416, 421, 424, 429, 433, + 437, 443, 446, 451, 469, 472 }; #endif @@ -594,10 +594,10 @@ static const yytype_uint16 yytoknum[] = }; # endif -#define YYPACT_NINF -17 +#define YYPACT_NINF -18 #define yypact_value_is_default(Yystate) \ - (!!((Yystate) == (-17))) + (!!((Yystate) == (-18))) #define YYTABLE_NINF -1 @@ -608,17 +608,17 @@ static const yytype_uint16 yytoknum[] = STATE-NUM. */ static const yytype_int8 yypact[] = { - -17, 48, -17, -9, -17, 34, -17, 19, -17, -2, - 30, -10, -10, -17, 8, -17, 0, 72, -17, -17, - -17, -17, -17, -17, -17, -17, -17, -17, -17, 52, - 18, -17, 16, -17, 49, -17, -9, -17, -17, 25, - -17, -17, 59, 60, 62, -5, -17, 19, 19, 20, - -17, 31, -17, -17, 70, -17, 16, -17, -17, 75, - 32, 16, -17, -17, 77, 81, -17, 6, 71, 69, - 73, -17, -17, 74, -17, 78, -17, -17, -17, -17, - 97, 16, -17, -17, -17, -17, 90, -17, 91, 92, - 93, 94, 95, -17, -17, 101, -17, -17, -17, 87, - 88, -17, 99, 100, -17, -17 + -18, 17, -18, -17, -18, 45, -18, -5, -18, 42, + 30, 44, 44, -18, 35, -18, 0, -18, -18, -18, + -18, -18, -18, -18, -18, -18, -18, -18, 55, 33, + -18, 5, -18, 39, -18, -17, -18, -18, 46, -18, + -18, 58, 61, 62, 26, -18, -5, -5, 43, -18, + 47, -18, -18, 67, -18, 5, -18, 72, 50, 5, + -18, -18, 65, 66, -18, -2, 56, 54, 57, -18, + -18, 59, -18, 63, -18, -18, -18, -18, 79, 5, + -18, -18, -18, -18, 74, -18, 75, 76, 77, 78, + 80, -18, -18, 84, -18, -18, -18, 71, 73, -18, + 82, 85, -18, -18 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -626,31 +626,31 @@ static const yytype_int8 yypact[] = means the default is an error. */ static const yytype_uint8 yydefact[] = { - 2, 0, 1, 25, 19, 0, 61, 0, 59, 62, - 18, 0, 0, 39, 33, 60, 0, 0, 57, 58, - 3, 5, 6, 9, 7, 8, 11, 12, 10, 50, - 0, 56, 64, 13, 23, 26, 36, 62, 63, 0, - 27, 14, 38, 0, 0, 0, 17, 0, 0, 0, - 44, 0, 30, 41, 62, 54, 0, 4, 49, 62, - 0, 22, 53, 24, 0, 0, 40, 65, 31, 0, - 0, 20, 21, 0, 43, 0, 47, 42, 55, 29, - 62, 0, 52, 37, 48, 66, 0, 15, 0, 0, - 0, 0, 0, 28, 51, 65, 32, 34, 35, 0, - 0, 16, 0, 0, 46, 45 + 2, 0, 1, 24, 18, 0, 60, 0, 58, 61, + 17, 0, 0, 38, 32, 59, 0, 56, 57, 3, + 4, 5, 8, 6, 7, 10, 11, 9, 49, 0, + 55, 63, 12, 22, 25, 35, 61, 62, 0, 26, + 13, 37, 0, 0, 0, 16, 0, 0, 0, 43, + 0, 29, 40, 61, 53, 0, 48, 61, 0, 21, + 52, 23, 0, 0, 39, 64, 30, 0, 0, 19, + 20, 0, 42, 0, 46, 41, 54, 28, 61, 0, + 51, 36, 47, 65, 0, 14, 0, 0, 0, 0, + 0, 27, 50, 64, 31, 33, 34, 0, 0, 15, + 0, 0, 45, 44 }; /* YYPGOTO[NTERM-NUM]. */ static const yytype_int8 yypgoto[] = { - -17, -17, 96, -17, -17, 79, -17, -17, -17, -17, - -17, -17, -17, 22, -16, -6, -17, 21 + -18, -18, -18, -18, -18, 49, -18, -18, -18, -18, + -18, -18, -18, -9, -16, -6, -18, 3 }; /* YYDEFGOTO[NTERM-NUM]. */ static const yytype_int8 yydefgoto[] = { - -1, 1, 20, 21, 22, 35, 23, 24, 25, 26, - 27, 28, 29, 30, 31, 32, 33, 87 + -1, 1, 19, 20, 21, 34, 22, 23, 24, 25, + 26, 27, 28, 29, 30, 31, 32, 85 }; /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If @@ -658,34 +658,30 @@ static const yytype_int8 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_uint8 yytable[] = { - 55, 39, 40, 69, 52, 41, 42, 70, 53, 6, - 56, 8, 54, 85, 34, 18, 62, 19, 38, 15, - 43, 49, 44, 45, 61, 6, 50, 8, 86, 51, - 59, 37, 73, 47, 48, 15, 38, 38, 74, 60, - 78, 71, 72, 75, 80, 82, 36, 46, 2, 76, - 38, 65, 3, 4, 81, 58, 5, 6, 7, 8, - 9, 10, 11, 12, 13, 94, 14, 15, 16, 17, - 63, 66, 67, 18, 68, 19, 3, 4, 77, 79, - 5, 6, 7, 8, 9, 10, 11, 12, 13, 83, - 14, 15, 16, 84, 89, 88, 91, 18, 90, 19, - 92, 93, 95, 96, 97, 98, 99, 100, 85, 102, - 103, 104, 105, 57, 0, 64, 101 + 54, 38, 46, 47, 51, 83, 33, 36, 52, 6, + 55, 8, 53, 37, 6, 60, 8, 2, 37, 15, + 84, 3, 4, 59, 15, 5, 6, 7, 8, 9, + 10, 11, 12, 13, 67, 14, 15, 16, 68, 76, + 69, 70, 17, 80, 18, 57, 39, 45, 48, 40, + 41, 37, 79, 49, 58, 71, 50, 35, 56, 73, + 61, 72, 78, 92, 42, 74, 43, 44, 37, 17, + 64, 18, 63, 65, 66, 75, 77, 81, 82, 87, + 86, 89, 88, 91, 62, 90, 93, 94, 95, 96, + 97, 83, 98, 100, 102, 101, 99, 103 }; -static const yytype_int8 yycheck[] = +static const yytype_uint8 yycheck[] = { - 16, 7, 4, 8, 4, 7, 8, 12, 8, 9, - 16, 11, 12, 7, 23, 25, 32, 27, 18, 19, - 22, 13, 24, 25, 30, 9, 18, 11, 22, 21, - 12, 12, 12, 11, 12, 19, 18, 18, 18, 21, - 56, 47, 48, 12, 12, 61, 12, 17, 0, 18, - 18, 26, 4, 5, 60, 3, 8, 9, 10, 11, - 12, 13, 14, 15, 16, 81, 18, 19, 20, 21, - 21, 12, 12, 25, 12, 27, 4, 5, 8, 4, - 8, 9, 10, 11, 12, 13, 14, 15, 16, 12, - 18, 19, 20, 12, 25, 24, 22, 25, 25, 27, - 22, 4, 12, 12, 12, 12, 12, 12, 7, 22, - 22, 12, 12, 17, -1, 36, 95 + 16, 7, 11, 12, 4, 7, 23, 12, 8, 9, + 16, 11, 12, 18, 9, 31, 11, 0, 18, 19, + 22, 4, 5, 29, 19, 8, 9, 10, 11, 12, + 13, 14, 15, 16, 8, 18, 19, 20, 12, 55, + 46, 47, 25, 59, 27, 12, 4, 17, 13, 7, + 8, 18, 58, 18, 21, 12, 21, 12, 3, 12, + 21, 18, 12, 79, 22, 18, 24, 25, 18, 25, + 12, 27, 26, 12, 12, 8, 4, 12, 12, 25, + 24, 22, 25, 4, 35, 22, 12, 12, 12, 12, + 12, 7, 12, 22, 12, 22, 93, 12 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -693,40 +689,40 @@ static const yytype_int8 yycheck[] = static const yytype_uint8 yystos[] = { 0, 29, 0, 4, 5, 8, 9, 10, 11, 12, - 13, 14, 15, 16, 18, 19, 20, 21, 25, 27, - 30, 31, 32, 34, 35, 36, 37, 38, 39, 40, - 41, 42, 43, 44, 23, 33, 12, 12, 18, 43, - 4, 7, 8, 22, 24, 25, 17, 41, 41, 13, - 18, 21, 4, 8, 12, 42, 43, 30, 3, 12, - 21, 43, 42, 21, 33, 26, 12, 12, 12, 8, - 12, 43, 43, 12, 18, 12, 18, 8, 42, 4, - 12, 43, 42, 12, 12, 7, 22, 45, 24, 25, - 25, 22, 22, 4, 42, 12, 12, 12, 12, 12, - 12, 45, 22, 22, 12, 12 + 13, 14, 15, 16, 18, 19, 20, 25, 27, 30, + 31, 32, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 23, 33, 12, 12, 18, 43, 4, + 7, 8, 22, 24, 25, 17, 41, 41, 13, 18, + 21, 4, 8, 12, 42, 43, 3, 12, 21, 43, + 42, 21, 33, 26, 12, 12, 12, 8, 12, 43, + 43, 12, 18, 12, 18, 8, 42, 4, 12, 43, + 42, 12, 12, 7, 22, 45, 24, 25, 25, 22, + 22, 4, 42, 12, 12, 12, 12, 12, 12, 45, + 22, 22, 12, 12 }; /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ static const yytype_uint8 yyr1[] = { - 0, 28, 29, 29, 29, 30, 30, 30, 30, 30, - 30, 30, 30, 30, 31, 31, 31, 32, 32, 32, - 32, 32, 32, 33, 33, 34, 34, 34, 34, 34, - 34, 35, 35, 35, 35, 35, 35, 35, 35, 35, - 35, 36, 36, 37, 37, 37, 37, 37, 38, 39, - 39, 40, 40, 40, 40, 40, 40, 41, 41, 42, - 42, 42, 43, 43, 44, 45, 45 + 0, 28, 29, 29, 30, 30, 30, 30, 30, 30, + 30, 30, 30, 31, 31, 31, 32, 32, 32, 32, + 32, 32, 33, 33, 34, 34, 34, 34, 34, 34, + 35, 35, 35, 35, 35, 35, 35, 35, 35, 35, + 36, 36, 37, 37, 37, 37, 37, 38, 39, 39, + 40, 40, 40, 40, 40, 40, 41, 41, 42, 42, + 42, 43, 43, 44, 45, 45 }; /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN. */ static const yytype_uint8 yyr2[] = { - 0, 2, 0, 2, 3, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 2, 4, 6, 2, 1, 1, - 3, 3, 2, 1, 2, 1, 2, 2, 4, 3, - 2, 3, 5, 1, 5, 5, 2, 4, 2, 1, - 3, 2, 3, 3, 2, 7, 7, 3, 4, 2, - 1, 4, 3, 2, 2, 3, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 0, 1 + 0, 2, 0, 2, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 2, 4, 6, 2, 1, 1, 3, + 3, 2, 1, 2, 1, 2, 2, 4, 3, 2, + 3, 5, 1, 5, 5, 2, 4, 2, 1, 3, + 2, 3, 3, 2, 7, 7, 3, 4, 2, 1, + 4, 3, 2, 2, 3, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 0, 1 }; @@ -1505,7 +1501,7 @@ yyreduce: YY_REDUCE_PRINT (yyn); switch (yyn) { - case 5: + case 4: { yyIncrFlags(CLF_TIME); @@ -1513,7 +1509,7 @@ yyreduce: break; - case 6: + case 5: { yyIncrFlags(CLF_ZONE); @@ -1521,7 +1517,7 @@ yyreduce: break; - case 7: + case 6: { yyIncrFlags(CLF_HAVEDATE); @@ -1529,7 +1525,7 @@ yyreduce: break; - case 8: + case 7: { yyIncrFlags(CLF_ORDINALMONTH); @@ -1537,7 +1533,7 @@ yyreduce: break; - case 9: + case 8: { yyIncrFlags(CLF_DAYOFWEEK); @@ -1545,7 +1541,7 @@ yyreduce: break; - case 10: + case 9: { info->flags |= CLF_RELCONV; @@ -1553,7 +1549,7 @@ yyreduce: break; - case 11: + case 10: { yyIncrFlags(CLF_TIME|CLF_HAVEDATE); @@ -1561,7 +1557,7 @@ yyreduce: break; - case 12: + case 11: { yyIncrFlags(CLF_TIME|CLF_HAVEDATE); @@ -1570,7 +1566,7 @@ yyreduce: break; - case 14: + case 13: { yyHour = (yyvsp[-1].Number); @@ -1581,7 +1577,7 @@ yyreduce: break; - case 15: + case 14: { yyHour = (yyvsp[-3].Number); @@ -1592,7 +1588,7 @@ yyreduce: break; - case 16: + case 15: { yyHour = (yyvsp[-5].Number); @@ -1603,7 +1599,7 @@ yyreduce: break; - case 17: + case 16: { yyTimezone = (yyvsp[-1].Number); @@ -1612,7 +1608,7 @@ yyreduce: break; - case 18: + case 17: { yyTimezone = (yyvsp[0].Number); @@ -1621,7 +1617,7 @@ yyreduce: break; - case 19: + case 18: { yyTimezone = (yyvsp[0].Number); @@ -1630,7 +1626,7 @@ yyreduce: break; - case 20: + case 19: { /* GMT+0100, GMT-1000, etc. */ yyTimezone = (yyvsp[-2].Number) - (yyvsp[-1].Number)*((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60); @@ -1639,7 +1635,7 @@ yyreduce: break; - case 21: + case 20: { /* GMT+1, GMT-10, etc. */ yyTimezone = (yyvsp[-2].Number) - (yyvsp[-1].Number)*((yyvsp[0].Number) * 60); @@ -1648,7 +1644,7 @@ yyreduce: break; - case 22: + case 21: { /* +0100, -0100 */ yyTimezone = -(yyvsp[-1].Number)*((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60); @@ -1657,7 +1653,7 @@ yyreduce: break; - case 25: + case 24: { yyDayOrdinal = 1; @@ -1666,7 +1662,7 @@ yyreduce: break; - case 26: + case 25: { yyDayOrdinal = 1; @@ -1675,7 +1671,7 @@ yyreduce: break; - case 27: + case 26: { yyDayOrdinal = (yyvsp[-1].Number); @@ -1684,7 +1680,7 @@ yyreduce: break; - case 28: + case 27: { yyDayOrdinal = (yyvsp[-3].Number) * (yyvsp[-1].Number); @@ -1693,7 +1689,7 @@ yyreduce: break; - case 29: + case 28: { yyDayOrdinal = (yyvsp[-2].Number) * (yyvsp[-1].Number); @@ -1702,7 +1698,7 @@ yyreduce: break; - case 30: + case 29: { yyDayOrdinal = 2; @@ -1711,7 +1707,7 @@ yyreduce: break; - case 31: + case 30: { yyMonth = (yyvsp[-2].Number); @@ -1720,7 +1716,7 @@ yyreduce: break; - case 32: + case 31: { yyMonth = (yyvsp[-4].Number); @@ -1730,7 +1726,7 @@ yyreduce: break; - case 33: + case 32: { yyYear = (yyvsp[0].Number) / 10000; @@ -1740,7 +1736,7 @@ yyreduce: break; - case 34: + case 33: { yyDay = (yyvsp[-4].Number); @@ -1750,7 +1746,7 @@ yyreduce: break; - case 35: + case 34: { yyMonth = (yyvsp[-2].Number); @@ -1760,7 +1756,7 @@ yyreduce: break; - case 36: + case 35: { yyMonth = (yyvsp[-1].Number); @@ -1769,7 +1765,7 @@ yyreduce: break; - case 37: + case 36: { yyMonth = (yyvsp[-3].Number); @@ -1779,7 +1775,7 @@ yyreduce: break; - case 38: + case 37: { yyMonth = (yyvsp[0].Number); @@ -1788,7 +1784,7 @@ yyreduce: break; - case 39: + case 38: { yyMonth = 1; @@ -1798,7 +1794,7 @@ yyreduce: break; - case 40: + case 39: { yyMonth = (yyvsp[-1].Number); @@ -1808,7 +1804,7 @@ yyreduce: break; - case 41: + case 40: { yyMonthOrdinalIncr = 1; @@ -1817,7 +1813,7 @@ yyreduce: break; - case 42: + case 41: { yyMonthOrdinalIncr = (yyvsp[-1].Number); @@ -1826,7 +1822,7 @@ yyreduce: break; - case 43: + case 42: { if ((yyvsp[-1].Number) != HOUR( 7)) YYABORT; /* T */ @@ -1840,7 +1836,7 @@ yyreduce: break; - case 44: + case 43: { yyYear = (yyvsp[-1].Number) / 10000; @@ -1853,7 +1849,7 @@ yyreduce: break; - case 45: + case 44: { yyYear = (yyvsp[-6].Number) / 10000; @@ -1866,7 +1862,7 @@ yyreduce: break; - case 46: + case 45: { if ((yyvsp[-5].Number) != HOUR( 7)) YYABORT; /* T */ @@ -1880,7 +1876,7 @@ yyreduce: break; - case 47: + case 46: { yyYear = (yyvsp[-2].Number) / 10000; @@ -1893,7 +1889,7 @@ yyreduce: break; - case 48: + case 47: { /* @@ -1910,7 +1906,7 @@ yyreduce: break; - case 49: + case 48: { yyRelSeconds *= -1; @@ -1920,7 +1916,7 @@ yyreduce: break; - case 51: + case 50: { *yyRelPointer += (yyvsp[-3].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number); @@ -1928,7 +1924,7 @@ yyreduce: break; - case 52: + case 51: { *yyRelPointer += (yyvsp[-2].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number); @@ -1936,7 +1932,7 @@ yyreduce: break; - case 53: + case 52: { *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number); @@ -1944,7 +1940,7 @@ yyreduce: break; - case 54: + case 53: { *yyRelPointer += (yyvsp[0].Number); @@ -1952,7 +1948,7 @@ yyreduce: break; - case 55: + case 54: { *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number); @@ -1960,7 +1956,7 @@ yyreduce: break; - case 56: + case 55: { *yyRelPointer += (yyvsp[0].Number); @@ -1968,7 +1964,7 @@ yyreduce: break; - case 57: + case 56: { (yyval.Number) = -1; @@ -1976,7 +1972,7 @@ yyreduce: break; - case 58: + case 57: { (yyval.Number) = 1; @@ -1984,7 +1980,7 @@ yyreduce: break; - case 59: + case 58: { (yyval.Number) = (yyvsp[0].Number); @@ -1993,7 +1989,7 @@ yyreduce: break; - case 60: + case 59: { (yyval.Number) = (yyvsp[0].Number); @@ -2002,7 +1998,7 @@ yyreduce: break; - case 61: + case 60: { (yyval.Number) = (yyvsp[0].Number); @@ -2011,7 +2007,7 @@ yyreduce: break; - case 62: + case 61: { (yyval.Number) = (yyvsp[0].Number); @@ -2019,7 +2015,7 @@ yyreduce: break; - case 63: + case 62: { (yyval.Number) = (yyvsp[0].Number); @@ -2027,7 +2023,7 @@ yyreduce: break; - case 64: + case 63: { if ((info->flags & (CLF_TIME|CLF_HAVEDATE|CLF_RELCONV)) == (CLF_TIME|CLF_HAVEDATE)) { @@ -2048,7 +2044,7 @@ yyreduce: break; - case 65: + case 64: { (yyval.Meridian) = MER24; @@ -2056,7 +2052,7 @@ yyreduce: break; - case 66: + case 65: { (yyval.Meridian) = (yyvsp[0].Meridian); diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 8594a3e..6e37e20 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -166,7 +166,7 @@ MODULE_SCOPE int yyparse(DateInfo*); spec : /* NULL */ | spec item - | spec SP item + /* | spec SP item */ ; item : time { -- cgit v0.12 From b716ab245a4d7dc88ee33112cd7f08d2625da25f Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 18:35:05 +0000 Subject: rebuilt with bison 3.5; replace deprecated `%pure-parser` with `%define api.pure` --- generic/tclDate.c | 715 +++++++++++++++++++++++++-------------------------- generic/tclGetDate.y | 2 +- 2 files changed, 347 insertions(+), 370 deletions(-) diff --git a/generic/tclDate.c b/generic/tclDate.c index 21e3960..625df6f 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -1,8 +1,9 @@ -/* A Bison parser, made by GNU Bison 3.1. */ +/* A Bison parser, made by GNU Bison 3.5.0. */ /* Bison implementation for Yacc-like parsers in C - Copyright (C) 1984, 1989-1990, 2000-2015, 2018 Free Software Foundation, Inc. + Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2019 Free Software Foundation, + Inc. This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -40,11 +41,14 @@ define necessary library symbols; they are noted "INFRINGES ON USER NAME SPACE" below. */ +/* Undocumented macros, especially those whose name start with YY_, + are private implementation details. Do not rely on them. */ + /* Identify Bison output. */ #define YYBISON 1 /* Bison version. */ -#define YYBISON_VERSION "3.1" +#define YYBISON_VERSION "3.5.0" /* Skeleton name. */ #define YYSKELETON_NAME "yacc.c" @@ -66,9 +70,7 @@ #define yydebug TclDatedebug #define yynerrs TclDatenerrs - -/* Copy the first part of user declarations. */ - +/* First part of user prologue. */ /* * tclDate.c -- @@ -150,12 +152,24 @@ typedef enum _DSTMODE { - +# ifndef YY_CAST +# ifdef __cplusplus +# define YY_CAST(Type, Val) static_cast (Val) +# define YY_REINTERPRET_CAST(Type, Val) reinterpret_cast (Val) +# else +# define YY_CAST(Type, Val) ((Type) (Val)) +# define YY_REINTERPRET_CAST(Type, Val) ((Type) (Val)) +# endif +# endif # ifndef YY_NULLPTR -# if defined __cplusplus && 201103L <= __cplusplus -# define YY_NULLPTR nullptr +# if defined __cplusplus +# if 201103L <= __cplusplus +# define YY_NULLPTR nullptr +# else +# define YY_NULLPTR 0 +# endif # else -# define YY_NULLPTR 0 +# define YY_NULLPTR ((void*)0) # endif # endif @@ -207,17 +221,14 @@ extern int TclDatedebug; /* Value type. */ #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED - union YYSTYPE { - time_t Number; enum _MERIDIAN Meridian; }; - typedef union YYSTYPE YYSTYPE; # define YYSTYPE_IS_TRIVIAL 1 # define YYSTYPE_IS_DECLARED 1 @@ -243,8 +254,7 @@ int TclDateparse (DateInfo* info); -/* Copy the second part of user declarations. */ - +/* Second part of user prologue. */ /* @@ -265,28 +275,75 @@ MODULE_SCOPE int yyparse(DateInfo*); # undef short #endif -#ifdef YYTYPE_UINT8 -typedef YYTYPE_UINT8 yytype_uint8; -#else -typedef unsigned char yytype_uint8; +/* On compilers that do not define __PTRDIFF_MAX__ etc., make sure + and (if available) are included + so that the code can choose integer types of a good width. */ + +#ifndef __PTRDIFF_MAX__ +# include /* INFRINGES ON USER NAME SPACE */ +# if defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__ +# include /* INFRINGES ON USER NAME SPACE */ +# define YY_STDINT_H +# endif #endif -#ifdef YYTYPE_INT8 -typedef YYTYPE_INT8 yytype_int8; +/* Narrow types that promote to a signed type and that can represent a + signed or unsigned integer of at least N bits. In tables they can + save space and decrease cache pressure. Promoting to a signed type + helps avoid bugs in integer arithmetic. */ + +#ifdef __INT_LEAST8_MAX__ +typedef __INT_LEAST8_TYPE__ yytype_int8; +#elif defined YY_STDINT_H +typedef int_least8_t yytype_int8; #else typedef signed char yytype_int8; #endif -#ifdef YYTYPE_UINT16 -typedef YYTYPE_UINT16 yytype_uint16; +#ifdef __INT_LEAST16_MAX__ +typedef __INT_LEAST16_TYPE__ yytype_int16; +#elif defined YY_STDINT_H +typedef int_least16_t yytype_int16; #else -typedef unsigned short yytype_uint16; +typedef short yytype_int16; #endif -#ifdef YYTYPE_INT16 -typedef YYTYPE_INT16 yytype_int16; +#if defined __UINT_LEAST8_MAX__ && __UINT_LEAST8_MAX__ <= __INT_MAX__ +typedef __UINT_LEAST8_TYPE__ yytype_uint8; +#elif (!defined __UINT_LEAST8_MAX__ && defined YY_STDINT_H \ + && UINT_LEAST8_MAX <= INT_MAX) +typedef uint_least8_t yytype_uint8; +#elif !defined __UINT_LEAST8_MAX__ && UCHAR_MAX <= INT_MAX +typedef unsigned char yytype_uint8; #else -typedef short yytype_int16; +typedef short yytype_uint8; +#endif + +#if defined __UINT_LEAST16_MAX__ && __UINT_LEAST16_MAX__ <= __INT_MAX__ +typedef __UINT_LEAST16_TYPE__ yytype_uint16; +#elif (!defined __UINT_LEAST16_MAX__ && defined YY_STDINT_H \ + && UINT_LEAST16_MAX <= INT_MAX) +typedef uint_least16_t yytype_uint16; +#elif !defined __UINT_LEAST16_MAX__ && USHRT_MAX <= INT_MAX +typedef unsigned short yytype_uint16; +#else +typedef int yytype_uint16; +#endif + +#ifndef YYPTRDIFF_T +# if defined __PTRDIFF_TYPE__ && defined __PTRDIFF_MAX__ +# define YYPTRDIFF_T __PTRDIFF_TYPE__ +# define YYPTRDIFF_MAXIMUM __PTRDIFF_MAX__ +# elif defined PTRDIFF_MAX +# ifndef ptrdiff_t +# include /* INFRINGES ON USER NAME SPACE */ +# endif +# define YYPTRDIFF_T ptrdiff_t +# define YYPTRDIFF_MAXIMUM PTRDIFF_MAX +# else +# define YYPTRDIFF_T long +# define YYPTRDIFF_MAXIMUM LONG_MAX +# endif #endif #ifndef YYSIZE_T @@ -294,7 +351,7 @@ typedef short yytype_int16; # define YYSIZE_T __SIZE_TYPE__ # elif defined size_t # define YYSIZE_T size_t -# elif ! defined YYSIZE_T +# elif defined __STDC_VERSION__ && 199901 <= __STDC_VERSION__ # include /* INFRINGES ON USER NAME SPACE */ # define YYSIZE_T size_t # else @@ -302,7 +359,19 @@ typedef short yytype_int16; # endif #endif -#define YYSIZE_MAXIMUM ((YYSIZE_T) -1) +#define YYSIZE_MAXIMUM \ + YY_CAST (YYPTRDIFF_T, \ + (YYPTRDIFF_MAXIMUM < YY_CAST (YYSIZE_T, -1) \ + ? YYPTRDIFF_MAXIMUM \ + : YY_CAST (YYSIZE_T, -1))) + +#define YYSIZEOF(X) YY_CAST (YYPTRDIFF_T, sizeof (X)) + +/* Stored state numbers (used for stacks). */ +typedef yytype_int8 yy_state_t; + +/* State numbers in computations. */ +typedef int yy_state_fast_t; #ifndef YY_ # if defined YYENABLE_NLS && YYENABLE_NLS @@ -316,30 +385,19 @@ typedef short yytype_int16; # endif #endif -#ifndef YY_ATTRIBUTE -# if (defined __GNUC__ \ - && (2 < __GNUC__ || (__GNUC__ == 2 && 96 <= __GNUC_MINOR__))) \ - || defined __SUNPRO_C && 0x5110 <= __SUNPRO_C -# define YY_ATTRIBUTE(Spec) __attribute__(Spec) +#ifndef YY_ATTRIBUTE_PURE +# if defined __GNUC__ && 2 < __GNUC__ + (96 <= __GNUC_MINOR__) +# define YY_ATTRIBUTE_PURE __attribute__ ((__pure__)) # else -# define YY_ATTRIBUTE(Spec) /* empty */ +# define YY_ATTRIBUTE_PURE # endif #endif -#ifndef YY_ATTRIBUTE_PURE -# define YY_ATTRIBUTE_PURE YY_ATTRIBUTE ((__pure__)) -#endif - #ifndef YY_ATTRIBUTE_UNUSED -# define YY_ATTRIBUTE_UNUSED YY_ATTRIBUTE ((__unused__)) -#endif - -#if !defined _Noreturn \ - && (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112) -# if defined _MSC_VER && 1200 <= _MSC_VER -# define _Noreturn __declspec (noreturn) +# if defined __GNUC__ && 2 < __GNUC__ + (7 <= __GNUC_MINOR__) +# define YY_ATTRIBUTE_UNUSED __attribute__ ((__unused__)) # else -# define _Noreturn YY_ATTRIBUTE ((__noreturn__)) +# define YY_ATTRIBUTE_UNUSED # endif #endif @@ -352,11 +410,11 @@ typedef short yytype_int16; #if defined __GNUC__ && ! defined __ICC && 407 <= __GNUC__ * 100 + __GNUC_MINOR__ /* Suppress an incorrect diagnostic about yylval being uninitialized. */ -# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ - _Pragma ("GCC diagnostic push") \ - _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"")\ +# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ + _Pragma ("GCC diagnostic push") \ + _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"") \ _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"") -# define YY_IGNORE_MAYBE_UNINITIALIZED_END \ +# define YY_IGNORE_MAYBE_UNINITIALIZED_END \ _Pragma ("GCC diagnostic pop") #else # define YY_INITIAL_VALUE(Value) Value @@ -369,6 +427,20 @@ typedef short yytype_int16; # define YY_INITIAL_VALUE(Value) /* Nothing. */ #endif +#if defined __cplusplus && defined __GNUC__ && ! defined __ICC && 6 <= __GNUC__ +# define YY_IGNORE_USELESS_CAST_BEGIN \ + _Pragma ("GCC diagnostic push") \ + _Pragma ("GCC diagnostic ignored \"-Wuseless-cast\"") +# define YY_IGNORE_USELESS_CAST_END \ + _Pragma ("GCC diagnostic pop") +#endif +#ifndef YY_IGNORE_USELESS_CAST_BEGIN +# define YY_IGNORE_USELESS_CAST_BEGIN +# define YY_IGNORE_USELESS_CAST_END +#endif + + +#define YY_ASSERT(E) ((void) (0 && (E))) #if ! defined yyoverflow || YYERROR_VERBOSE @@ -446,18 +518,19 @@ void free (void *); /* INFRINGES ON USER NAME SPACE */ /* A type that is properly aligned for any stack member. */ union yyalloc { - yytype_int16 yyss_alloc; + yy_state_t yyss_alloc; YYSTYPE yyvs_alloc; YYLTYPE yyls_alloc; }; /* The size of the maximum gap between one aligned stack and the next. */ -# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1) +# define YYSTACK_GAP_MAXIMUM (YYSIZEOF (union yyalloc) - 1) /* The size of an array large to enough to hold all stacks, each with N elements. */ # define YYSTACK_BYTES(N) \ - ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE) + sizeof (YYLTYPE)) \ + ((N) * (YYSIZEOF (yy_state_t) + YYSIZEOF (YYSTYPE) \ + + YYSIZEOF (YYLTYPE)) \ + 2 * YYSTACK_GAP_MAXIMUM) # define YYCOPY_NEEDED 1 @@ -470,11 +543,11 @@ union yyalloc # define YYSTACK_RELOCATE(Stack_alloc, Stack) \ do \ { \ - YYSIZE_T yynewbytes; \ + YYPTRDIFF_T yynewbytes; \ YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ Stack = &yyptr->Stack_alloc; \ - yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ - yyptr += yynewbytes / sizeof (*yyptr); \ + yynewbytes = yystacksize * YYSIZEOF (*Stack) + YYSTACK_GAP_MAXIMUM; \ + yyptr += yynewbytes / YYSIZEOF (*yyptr); \ } \ while (0) @@ -486,12 +559,12 @@ union yyalloc # ifndef YYCOPY # if defined __GNUC__ && 1 < __GNUC__ # define YYCOPY(Dst, Src, Count) \ - __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src))) + __builtin_memcpy (Dst, Src, YY_CAST (YYSIZE_T, (Count)) * sizeof (*(Src))) # else # define YYCOPY(Dst, Src, Count) \ do \ { \ - YYSIZE_T yyi; \ + YYPTRDIFF_T yyi; \ for (yyi = 0; yyi < (Count); yyi++) \ (Dst)[yyi] = (Src)[yyi]; \ } \ @@ -514,17 +587,18 @@ union yyalloc /* YYNSTATES -- Number of states. */ #define YYNSTATES 103 -/* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned - by yylex, with out-of-bounds checking. */ #define YYUNDEFTOK 2 #define YYMAXUTOK 278 + +/* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM + as returned by yylex, with out-of-bounds checking. */ #define YYTRANSLATE(YYX) \ - ((unsigned) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) + (0 <= (YYX) && (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) /* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM - as returned by yylex, without out-of-bounds checking. */ -static const yytype_uint8 yytranslate[] = + as returned by yylex. */ +static const yytype_int8 yytranslate[] = { 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -558,7 +632,7 @@ static const yytype_uint8 yytranslate[] = #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ -static const yytype_uint16 yyrline[] = +static const yytype_int16 yyrline[] = { 0, 171, 171, 172, 176, 179, 182, 185, 188, 191, 194, 197, 201, 204, 209, 215, 221, 226, 230, 234, @@ -590,7 +664,7 @@ static const char *const yytname[] = # ifdef YYPRINT /* YYTOKNUM[NUM] -- (External) token number corresponding to the (internal) symbol number NUM (which must be that of a token). */ -static const yytype_uint16 yytoknum[] = +static const yytype_int16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, @@ -599,14 +673,14 @@ static const yytype_uint16 yytoknum[] = }; # endif -#define YYPACT_NINF -21 +#define YYPACT_NINF (-21) -#define yypact_value_is_default(Yystate) \ - (!!((Yystate) == (-21))) +#define yypact_value_is_default(Yyn) \ + ((Yyn) == YYPACT_NINF) -#define YYTABLE_NINF -68 +#define YYTABLE_NINF (-68) -#define yytable_value_is_error(Yytable_value) \ +#define yytable_value_is_error(Yyn) \ 0 /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing @@ -629,7 +703,7 @@ static const yytype_int8 yypact[] = /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. Performed when YYTABLE does not specify something else to do. Zero means the default is an error. */ -static const yytype_uint8 yydefact[] = +static const yytype_int8 yydefact[] = { 2, 0, 1, 25, 19, 0, 66, 0, 64, 70, 18, 0, 0, 39, 45, 46, 0, 65, 0, 62, @@ -693,7 +767,7 @@ static const yytype_int8 yycheck[] = /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing symbol of state STATE-NUM. */ -static const yytype_uint8 yystos[] = +static const yytype_int8 yystos[] = { 0, 32, 0, 4, 5, 8, 9, 10, 11, 12, 13, 14, 15, 16, 18, 19, 20, 21, 22, 26, @@ -709,7 +783,7 @@ static const yytype_uint8 yystos[] = }; /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ -static const yytype_uint8 yyr1[] = +static const yytype_int8 yyr1[] = { 0, 31, 32, 32, 33, 33, 33, 33, 33, 33, 33, 33, 33, 34, 34, 35, 35, 36, 36, 36, @@ -722,7 +796,7 @@ static const yytype_uint8 yyr1[] = }; /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN. */ -static const yytype_uint8 yyr2[] = +static const yytype_int8 yyr2[] = { 0, 2, 0, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 5, 3, 2, 2, 2, 1, 1, @@ -747,22 +821,22 @@ static const yytype_uint8 yyr2[] = #define YYRECOVERING() (!!yyerrstatus) -#define YYBACKUP(Token, Value) \ -do \ - if (yychar == YYEMPTY) \ - { \ - yychar = (Token); \ - yylval = (Value); \ - YYPOPSTACK (yylen); \ - yystate = *yyssp; \ - goto yybackup; \ - } \ - else \ - { \ - yyerror (&yylloc, info, YY_("syntax error: cannot back up")); \ - YYERROR; \ - } \ -while (0) +#define YYBACKUP(Token, Value) \ + do \ + if (yychar == YYEMPTY) \ + { \ + yychar = (Token); \ + yylval = (Value); \ + YYPOPSTACK (yylen); \ + yystate = *yyssp; \ + goto yybackup; \ + } \ + else \ + { \ + yyerror (&yylloc, info, YY_("syntax error: cannot back up")); \ + YYERROR; \ + } \ + while (0) /* Error token number */ #define YYTERROR 1 @@ -821,10 +895,10 @@ do { \ /* Print *YYLOCP on YYO. Private, do not rely on its existence. */ YY_ATTRIBUTE_UNUSED -static unsigned +static int yy_location_print_ (FILE *yyo, YYLTYPE const * const yylocp) { - unsigned res = 0; + int res = 0; int end_col = 0 != yylocp->last_column ? yylocp->last_column - 1 : 0; if (0 <= yylocp->first_line) { @@ -867,41 +941,43 @@ do { \ } while (0) -/*----------------------------------------. -| Print this symbol's value on YYOUTPUT. | -`----------------------------------------*/ +/*-----------------------------------. +| Print this symbol's value on YYO. | +`-----------------------------------*/ static void -yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info) +yy_symbol_value_print (FILE *yyo, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info) { - FILE *yyo = yyoutput; - YYUSE (yyo); + FILE *yyoutput = yyo; + YYUSE (yyoutput); YYUSE (yylocationp); YYUSE (info); if (!yyvaluep) return; # ifdef YYPRINT if (yytype < YYNTOKENS) - YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); + YYPRINT (yyo, yytoknum[yytype], *yyvaluep); # endif + YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN YYUSE (yytype); + YY_IGNORE_MAYBE_UNINITIALIZED_END } -/*--------------------------------. -| Print this symbol on YYOUTPUT. | -`--------------------------------*/ +/*---------------------------. +| Print this symbol on YYO. | +`---------------------------*/ static void -yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info) +yy_symbol_print (FILE *yyo, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info) { - YYFPRINTF (yyoutput, "%s %s (", + YYFPRINTF (yyo, "%s %s (", yytype < YYNTOKENS ? "token" : "nterm", yytname[yytype]); - YY_LOCATION_PRINT (yyoutput, *yylocationp); - YYFPRINTF (yyoutput, ": "); - yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info); - YYFPRINTF (yyoutput, ")"); + YY_LOCATION_PRINT (yyo, *yylocationp); + YYFPRINTF (yyo, ": "); + yy_symbol_value_print (yyo, yytype, yyvaluep, yylocationp, info); + YYFPRINTF (yyo, ")"); } /*------------------------------------------------------------------. @@ -910,7 +986,7 @@ yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYL `------------------------------------------------------------------*/ static void -yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop) +yy_stack_print (yy_state_t *yybottom, yy_state_t *yytop) { YYFPRINTF (stderr, "Stack now"); for (; yybottom <= yytop; yybottom++) @@ -933,12 +1009,12 @@ do { \ `------------------------------------------------*/ static void -yy_reduce_print (yytype_int16 *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info) +yy_reduce_print (yy_state_t *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info) { - unsigned long yylno = yyrline[yyrule]; + int yylno = yyrline[yyrule]; int yynrhs = yyr2[yyrule]; int yyi; - YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n", + YYFPRINTF (stderr, "Reducing stack by rule %d (line %d):\n", yyrule - 1, yylno); /* The symbols being reduced. */ for (yyi = 0; yyi < yynrhs; yyi++) @@ -946,7 +1022,7 @@ yy_reduce_print (yytype_int16 *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule YYFPRINTF (stderr, " $%d = ", yyi + 1); yy_symbol_print (stderr, yystos[yyssp[yyi + 1 - yynrhs]], - &(yyvsp[(yyi + 1) - (yynrhs)]) + &yyvsp[(yyi + 1) - (yynrhs)] , &(yylsp[(yyi + 1) - (yynrhs)]) , info); YYFPRINTF (stderr, "\n"); } @@ -990,13 +1066,13 @@ int yydebug; # ifndef yystrlen # if defined __GLIBC__ && defined _STRING_H -# define yystrlen strlen +# define yystrlen(S) (YY_CAST (YYPTRDIFF_T, strlen (S))) # else /* Return the length of YYSTR. */ -static YYSIZE_T +static YYPTRDIFF_T yystrlen (const char *yystr) { - YYSIZE_T yylen; + YYPTRDIFF_T yylen; for (yylen = 0; yystr[yylen]; yylen++) continue; return yylen; @@ -1032,12 +1108,12 @@ yystpcpy (char *yydest, const char *yysrc) backslash-backslash). YYSTR is taken from yytname. If YYRES is null, do not copy; instead, return the length of what the result would have been. */ -static YYSIZE_T +static YYPTRDIFF_T yytnamerr (char *yyres, const char *yystr) { if (*yystr == '"') { - YYSIZE_T yyn = 0; + YYPTRDIFF_T yyn = 0; char const *yyp = yystr; for (;;) @@ -1050,7 +1126,10 @@ yytnamerr (char *yyres, const char *yystr) case '\\': if (*++yyp != '\\') goto do_not_strip_quotes; - /* Fall through. */ + else + goto append; + + append: default: if (yyres) yyres[yyn] = *yyp; @@ -1065,10 +1144,10 @@ yytnamerr (char *yyres, const char *yystr) do_not_strip_quotes: ; } - if (! yyres) + if (yyres) + return yystpcpy (yyres, yystr) - yyres; + else return yystrlen (yystr); - - return yystpcpy (yyres, yystr) - yyres; } # endif @@ -1081,19 +1160,19 @@ yytnamerr (char *yyres, const char *yystr) *YYMSG_ALLOC to the required number of bytes. Return 2 if the required number of bytes is too large to store. */ static int -yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg, - yytype_int16 *yyssp, int yytoken) +yysyntax_error (YYPTRDIFF_T *yymsg_alloc, char **yymsg, + yy_state_t *yyssp, int yytoken) { - YYSIZE_T yysize0 = yytnamerr (YY_NULLPTR, yytname[yytoken]); - YYSIZE_T yysize = yysize0; enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 }; /* Internationalized format string. */ const char *yyformat = YY_NULLPTR; - /* Arguments of yyformat. */ + /* Arguments of yyformat: reported tokens (one for the "unexpected", + one per "expected"). */ char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM]; - /* Number of reported tokens (one for the "unexpected", one per - "expected"). */ + /* Actual size of YYARG. */ int yycount = 0; + /* Cumulated lengths of YYARG. */ + YYPTRDIFF_T yysize = 0; /* There are many possibilities here to consider: - If this state is a consistent state with a default action, then @@ -1121,6 +1200,8 @@ yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg, if (yytoken != YYEMPTY) { int yyn = yypact[*yyssp]; + YYPTRDIFF_T yysize0 = yytnamerr (YY_NULLPTR, yytname[yytoken]); + yysize = yysize0; yyarg[yycount++] = yytname[yytoken]; if (!yypact_value_is_default (yyn)) { @@ -1145,11 +1226,12 @@ yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg, } yyarg[yycount++] = yytname[yyx]; { - YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyx]); - if (! (yysize <= yysize1 - && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) + YYPTRDIFF_T yysize1 + = yysize + yytnamerr (YY_NULLPTR, yytname[yyx]); + if (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM) + yysize = yysize1; + else return 2; - yysize = yysize1; } } } @@ -1172,10 +1254,13 @@ yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg, } { - YYSIZE_T yysize1 = yysize + yystrlen (yyformat); - if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) + /* Don't count the "%s"s in the final size, but reserve room for + the terminator. */ + YYPTRDIFF_T yysize1 = yysize + (yystrlen (yyformat) - 2 * yycount) + 1; + if (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM) + yysize = yysize1; + else return 2; - yysize = yysize1; } if (*yymsg_alloc < yysize) @@ -1201,8 +1286,8 @@ yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg, } else { - yyp++; - yyformat++; + ++yyp; + ++yyformat; } } return 0; @@ -1259,7 +1344,7 @@ YYLTYPE yylloc = yyloc_default; /* Number of syntax errors so far. */ int yynerrs; - int yystate; + yy_state_fast_t yystate; /* Number of tokens to shift before error messages enabled. */ int yyerrstatus; @@ -1272,9 +1357,9 @@ YYLTYPE yylloc = yyloc_default; to reallocate them elsewhere. */ /* The state stack. */ - yytype_int16 yyssa[YYINITDEPTH]; - yytype_int16 *yyss; - yytype_int16 *yyssp; + yy_state_t yyssa[YYINITDEPTH]; + yy_state_t *yyss; + yy_state_t *yyssp; /* The semantic value stack. */ YYSTYPE yyvsa[YYINITDEPTH]; @@ -1289,7 +1374,7 @@ YYLTYPE yylloc = yyloc_default; /* The locations where the error started and ended. */ YYLTYPE yyerror_range[3]; - YYSIZE_T yystacksize; + YYPTRDIFF_T yystacksize; int yyn; int yyresult; @@ -1304,7 +1389,7 @@ YYLTYPE yylloc = yyloc_default; /* Buffer for error messages, and its allocated size. */ char yymsgbuf[128]; char *yymsg = yymsgbuf; - YYSIZE_T yymsg_alloc = sizeof yymsgbuf; + YYPTRDIFF_T yymsg_alloc = sizeof yymsgbuf; #endif #define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N)) @@ -1327,29 +1412,41 @@ YYLTYPE yylloc = yyloc_default; yylsp[0] = yylloc; goto yysetstate; + /*------------------------------------------------------------. -| yynewstate -- Push a new state, which is found in yystate. | +| yynewstate -- push a new state, which is found in yystate. | `------------------------------------------------------------*/ - yynewstate: +yynewstate: /* In all cases, when you get here, the value and location stacks have just been pushed. So pushing a state here evens the stacks. */ yyssp++; - yysetstate: - *yyssp = yystate; + +/*--------------------------------------------------------------------. +| yysetstate -- set current state (the top of the stack) to yystate. | +`--------------------------------------------------------------------*/ +yysetstate: + YYDPRINTF ((stderr, "Entering state %d\n", yystate)); + YY_ASSERT (0 <= yystate && yystate < YYNSTATES); + YY_IGNORE_USELESS_CAST_BEGIN + *yyssp = YY_CAST (yy_state_t, yystate); + YY_IGNORE_USELESS_CAST_END if (yyss + yystacksize - 1 <= yyssp) +#if !defined yyoverflow && !defined YYSTACK_RELOCATE + goto yyexhaustedlab; +#else { /* Get the current used size of the three stacks, in elements. */ - YYSIZE_T yysize = yyssp - yyss + 1; + YYPTRDIFF_T yysize = yyssp - yyss + 1; -#ifdef yyoverflow +# if defined yyoverflow { /* Give user a chance to reallocate the stack. Use copies of these so that the &'s don't force the real ones into memory. */ + yy_state_t *yyss1 = yyss; YYSTYPE *yyvs1 = yyvs; - yytype_int16 *yyss1 = yyss; YYLTYPE *yyls1 = yyls; /* Each stack pointer address is followed by the size of the @@ -1357,19 +1454,15 @@ YYLTYPE yylloc = yyloc_default; conditional around just the two extra args, but that might be undefined if yyoverflow is a macro. */ yyoverflow (YY_("memory exhausted"), - &yyss1, yysize * sizeof (*yyssp), - &yyvs1, yysize * sizeof (*yyvsp), - &yyls1, yysize * sizeof (*yylsp), + &yyss1, yysize * YYSIZEOF (*yyssp), + &yyvs1, yysize * YYSIZEOF (*yyvsp), + &yyls1, yysize * YYSIZEOF (*yylsp), &yystacksize); - - yyls = yyls1; yyss = yyss1; yyvs = yyvs1; + yyls = yyls1; } -#else /* no yyoverflow */ -# ifndef YYSTACK_RELOCATE - goto yyexhaustedlab; -# else +# else /* defined YYSTACK_RELOCATE */ /* Extend the stack our own way. */ if (YYMAXDEPTH <= yystacksize) goto yyexhaustedlab; @@ -1378,44 +1471,45 @@ YYLTYPE yylloc = yyloc_default; yystacksize = YYMAXDEPTH; { - yytype_int16 *yyss1 = yyss; + yy_state_t *yyss1 = yyss; union yyalloc *yyptr = - (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); + YY_CAST (union yyalloc *, + YYSTACK_ALLOC (YY_CAST (YYSIZE_T, YYSTACK_BYTES (yystacksize)))); if (! yyptr) goto yyexhaustedlab; YYSTACK_RELOCATE (yyss_alloc, yyss); YYSTACK_RELOCATE (yyvs_alloc, yyvs); YYSTACK_RELOCATE (yyls_alloc, yyls); -# undef YYSTACK_RELOCATE +# undef YYSTACK_RELOCATE if (yyss1 != yyssa) YYSTACK_FREE (yyss1); } # endif -#endif /* no yyoverflow */ yyssp = yyss + yysize - 1; yyvsp = yyvs + yysize - 1; yylsp = yyls + yysize - 1; - YYDPRINTF ((stderr, "Stack size increased to %lu\n", - (unsigned long) yystacksize)); + YY_IGNORE_USELESS_CAST_BEGIN + YYDPRINTF ((stderr, "Stack size increased to %ld\n", + YY_CAST (long, yystacksize))); + YY_IGNORE_USELESS_CAST_END if (yyss + yystacksize - 1 <= yyssp) YYABORT; } - - YYDPRINTF ((stderr, "Entering state %d\n", yystate)); +#endif /* !defined yyoverflow && !defined YYSTACK_RELOCATE */ if (yystate == YYFINAL) YYACCEPT; goto yybackup; + /*-----------. | yybackup. | `-----------*/ yybackup: - /* Do appropriate processing given the current state. Read a lookahead token if we need one and don't already have one. */ @@ -1465,15 +1559,14 @@ yybackup: /* Shift the lookahead token. */ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); - - /* Discard the shifted token. */ - yychar = YYEMPTY; - yystate = yyn; YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN *++yyvsp = yylval; YY_IGNORE_MAYBE_UNINITIALIZED_END *++yylsp = yylloc; + + /* Discard the shifted token. */ + yychar = YYEMPTY; goto yynewstate; @@ -1488,7 +1581,7 @@ yydefault: /*-----------------------------. -| yyreduce -- Do a reduction. | +| yyreduce -- do a reduction. | `-----------------------------*/ yyreduce: /* yyn is the number of a rule to reduce with. */ @@ -1510,356 +1603,279 @@ yyreduce: YY_REDUCE_PRINT (yyn); switch (yyn) { - case 4: - - { + case 4: + { yyIncrFlags(CLF_TIME); } - break; case 5: - - { + { yyIncrFlags(CLF_ZONE); } - break; case 6: - - { + { yyIncrFlags(CLF_HAVEDATE); } - break; case 7: - - { + { yyIncrFlags(CLF_ORDINALMONTH); } - break; case 8: - - { + { yyIncrFlags(CLF_DAYOFWEEK); } - break; case 9: - - { + { info->flags |= CLF_RELCONV; } - break; case 10: - - { + { yyIncrFlags(CLF_TIME|CLF_HAVEDATE); } - break; case 11: - - { + { yyIncrFlags(CLF_TIME|CLF_HAVEDATE); info->flags |= CLF_RELCONV; } - break; case 13: - - { + { yyHour = (yyvsp[-4].Number); yyMinutes = (yyvsp[-2].Number); yySeconds = (yyvsp[0].Number); } - break; case 14: - - { + { yyHour = (yyvsp[-2].Number); yyMinutes = (yyvsp[0].Number); yySeconds = 0; } - break; case 15: - - { + { yyHour = (yyvsp[-1].Number); yyMinutes = 0; yySeconds = 0; yyMeridian = (yyvsp[0].Meridian); } - break; case 16: - - { + { yyMeridian = (yyvsp[0].Meridian); } - break; case 17: - - { + { yyTimezone = (yyvsp[-1].Number); yyDSTmode = DSTon; } - break; case 18: - - { + { yyTimezone = (yyvsp[0].Number); yyDSTmode = DSToff; } - break; case 19: - - { + { yyTimezone = (yyvsp[0].Number); yyDSTmode = DSTon; } - break; case 20: - - { /* GMT+0100, GMT-1000, etc. */ + { /* GMT+0100, GMT-1000, etc. */ yyTimezone = (yyvsp[-2].Number) - (yyvsp[-1].Number)*((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60); yyDSTmode = DSToff; } - break; case 21: - - { /* GMT+1, GMT-10, etc. */ + { /* GMT+1, GMT-10, etc. */ yyTimezone = (yyvsp[-2].Number) - (yyvsp[-1].Number)*((yyvsp[0].Number) * 60); yyDSTmode = DSToff; } - break; case 22: - - { /* +0100, -0100 */ + { /* +0100, -0100 */ yyTimezone = -(yyvsp[-1].Number)*((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60); yyDSTmode = DSToff; } - break; case 25: - - { + { yyDayOrdinal = 1; yyDayOfWeek = (yyvsp[0].Number); } - break; case 26: - - { + { yyDayOrdinal = 1; yyDayOfWeek = (yyvsp[-1].Number); } - break; case 27: - - { + { yyDayOrdinal = (yyvsp[-1].Number); yyDayOfWeek = (yyvsp[0].Number); } - break; case 28: - - { + { yyDayOrdinal = (yyvsp[-3].Number) * (yyvsp[-1].Number); yyDayOfWeek = (yyvsp[0].Number); } - break; case 29: - - { + { yyDayOrdinal = (yyvsp[-2].Number) * (yyvsp[-1].Number); yyDayOfWeek = (yyvsp[0].Number); } - break; case 30: - - { + { yyDayOrdinal = 2; yyDayOfWeek = (yyvsp[0].Number); } - break; case 31: - - { + { yyMonth = (yyvsp[-2].Number); yyDay = (yyvsp[0].Number); yyYear = (yyvsp[-4].Number); } - break; case 32: - - { + { yyMonth = (yyvsp[-2].Number); yyDay = (yyvsp[0].Number); } - break; case 33: - - { + { yyMonth = (yyvsp[-4].Number); yyDay = (yyvsp[-2].Number); yyYear = (yyvsp[0].Number); } - break; case 35: - - { + { yyDay = (yyvsp[-4].Number); yyMonth = (yyvsp[-2].Number); yyYear = (yyvsp[0].Number); } - break; case 36: - - { + { yyMonth = (yyvsp[-1].Number); yyDay = (yyvsp[0].Number); } - break; case 37: - - { + { yyMonth = (yyvsp[-3].Number); yyDay = (yyvsp[-2].Number); yyYear = (yyvsp[0].Number); } - break; case 38: - - { + { yyMonth = (yyvsp[0].Number); yyDay = (yyvsp[-1].Number); } - break; case 39: - - { + { yyMonth = 1; yyDay = 1; yyYear = EPOCH; } - break; case 40: - - { + { yyMonth = (yyvsp[-1].Number); yyDay = (yyvsp[-2].Number); yyYear = (yyvsp[0].Number); } - break; case 41: - - { + { yyMonthOrdinalIncr = 1; yyMonthOrdinal = (yyvsp[0].Number); } - break; case 42: - - { + { yyMonthOrdinalIncr = (yyvsp[-1].Number); yyMonthOrdinal = (yyvsp[0].Number); } - break; case 45: - - { /* YYYYMMDD */ + { /* YYYYMMDD */ yyYear = (yyvsp[0].Number) / 10000; yyMonth = ((yyvsp[0].Number) % 10000)/100; yyDay = (yyvsp[0].Number) % 100; } - break; case 46: - - { /* YYMMDD */ + { /* YYMMDD */ yyYear = (yyvsp[0].Number) / 10000; yyMonth = ((yyvsp[0].Number) % 10000)/100; yyDay = (yyvsp[0].Number) % 100; } - break; case 48: - - { + { yyHour = (yyvsp[0].Number) / 10000; yyMinutes = ((yyvsp[0].Number) % 10000)/100; yySeconds = (yyvsp[0].Number) % 100; } - break; case 51: - - { /* YYYYMMDDhhmmss */ + { /* YYYYMMDDhhmmss */ yyYear = (yyvsp[-1].Number) / 10000; yyMonth = ((yyvsp[-1].Number) % 10000)/100; yyDay = (yyvsp[-1].Number) % 100; @@ -1867,12 +1883,10 @@ yyreduce: yyMinutes = ((yyvsp[0].Number) % 10000)/100; yySeconds = (yyvsp[0].Number) % 100; } - break; case 52: - - { /* YYYYMMDDhhmm */ + { /* YYYYMMDDhhmm */ if (yyDigitCount != 4) YYABORT; /* normally unreached */ yyYear = (yyvsp[-1].Number) / 10000; yyMonth = ((yyvsp[-1].Number) % 10000)/100; @@ -1881,12 +1895,10 @@ yyreduce: yyMinutes = ((yyvsp[0].Number) % 100); yySeconds = 0; } - break; case 53: - - { + { /* * Offset computed year by -377 so that the returned years will be * in a range accessible with a 32 bit clock seconds value. @@ -1898,137 +1910,105 @@ yyreduce: yyRelDay += (((yyvsp[-2].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000; yyRelSeconds += (yyvsp[0].Number) * 144 * 60; } - break; case 54: - - { + { yyRelSeconds *= -1; yyRelMonth *= -1; yyRelDay *= -1; } - break; case 56: - - { + { *yyRelPointer += (yyvsp[-3].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number); } - break; case 57: - - { + { *yyRelPointer += (yyvsp[-2].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number); } - break; case 58: - - { + { *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number); } - break; case 59: - - { + { *yyRelPointer += (yyvsp[0].Number); } - break; case 60: - - { + { *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number); } - break; case 61: - - { + { *yyRelPointer += (yyvsp[0].Number); } - break; case 62: - - { + { (yyval.Number) = -1; } - break; case 63: - - { + { (yyval.Number) = 1; } - break; case 64: - - { + { (yyval.Number) = (yyvsp[0].Number); yyRelPointer = &yyRelSeconds; } - break; case 65: - - { + { (yyval.Number) = (yyvsp[0].Number); yyRelPointer = &yyRelDay; } - break; case 66: - - { + { (yyval.Number) = (yyvsp[0].Number); yyRelPointer = &yyRelMonth; } - break; case 67: - - { + { (yyval.Number) = (yyvsp[0].Number); } - break; case 68: - - { + { (yyval.Number) = (yyvsp[0].Number); } - break; case 69: - - { + { (yyval.Number) = (yyvsp[0].Number); } - break; case 70: - - { + { if ((info->flags & (CLF_TIME|CLF_HAVEDATE|CLF_RELCONV)) == (CLF_TIME|CLF_HAVEDATE)) { yyYear = (yyvsp[0].Number); } else { @@ -2044,23 +2024,18 @@ yyreduce: yyMeridian = MER24; } } - break; case 71: - - { + { (yyval.Meridian) = MER24; } - break; case 72: - - { + { (yyval.Meridian) = (yyvsp[0].Meridian); } - break; @@ -2090,14 +2065,13 @@ yyreduce: /* Now 'shift' the result of the reduction. Determine what state that goes to, based on the state we popped back to and the rule number reduced by. */ - - yyn = yyr1[yyn]; - - yystate = yypgoto[yyn - YYNTOKENS] + *yyssp; - if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp) - yystate = yytable[yystate]; - else - yystate = yydefgoto[yyn - YYNTOKENS]; + { + const int yylhs = yyr1[yyn] - YYNTOKENS; + const int yyi = yypgoto[yylhs] + *yyssp; + yystate = (0 <= yyi && yyi <= YYLAST && yycheck[yyi] == *yyssp + ? yytable[yyi] + : yydefgoto[yylhs]); + } goto yynewstate; @@ -2129,7 +2103,7 @@ yyerrlab: { if (yymsg != yymsgbuf) YYSTACK_FREE (yymsg); - yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc); + yymsg = YY_CAST (char *, YYSTACK_ALLOC (YY_CAST (YYSIZE_T, yymsg_alloc))); if (!yymsg) { yymsg = yymsgbuf; @@ -2180,12 +2154,10 @@ yyerrlab: | yyerrorlab -- error raised explicitly by YYERROR. | `---------------------------------------------------*/ yyerrorlab: - - /* Pacify compilers like GCC when the user code never invokes - YYERROR and the label yyerrorlab therefore never appears in user - code. */ - if (/*CONSTCOND*/ 0) - goto yyerrorlab; + /* Pacify compilers when the user code never invokes YYERROR and the + label yyerrorlab therefore never appears in user code. */ + if (0) + YYERROR; /* Do not reclaim the symbols of the rule whose action triggered this YYERROR. */ @@ -2252,6 +2224,7 @@ yyacceptlab: yyresult = 0; goto yyreturn; + /*-----------------------------------. | yyabortlab -- YYABORT comes here. | `-----------------------------------*/ @@ -2259,6 +2232,7 @@ yyabortlab: yyresult = 1; goto yyreturn; + #if !defined yyoverflow || YYERROR_VERBOSE /*-------------------------------------------------. | yyexhaustedlab -- memory exhaustion comes here. | @@ -2269,6 +2243,10 @@ yyexhaustedlab: /* Fall through. */ #endif + +/*-----------------------------------------------------. +| yyreturn -- parsing is finished, return the result. | +`-----------------------------------------------------*/ yyreturn: if (yychar != YYEMPTY) { @@ -2299,7 +2277,6 @@ yyreturn: return yyresult; } - /* * Month and day table. */ diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 2febd30..04334d3 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -17,7 +17,7 @@ %parse-param {DateInfo* info} %lex-param {DateInfo* info} -%pure-parser +%define api.pure /* %error-verbose would be nice, but our token names are meaningless */ %locations -- cgit v0.12 From b50d4cd9cf51684cc3d3f0c71067617f48229644 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 22 Jun 2020 18:37:29 +0000 Subject: switch internal numbers to long (size of time_t is depending by platform, compiler, stdlib and its directives, and long is enough now for every part of input-string recognized inside of free-scan); this can drastically speedup scan (especially 32-bit platforms) --- generic/tclDate.c | 4 ++-- generic/tclGetDate.y | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclDate.c b/generic/tclDate.c index 625df6f..bb94955 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -139,7 +139,7 @@ typedef struct _TABLE { const char *name; int type; - time_t value; + long value; } TABLE; /* @@ -224,7 +224,7 @@ extern int TclDatedebug; union YYSTYPE { - time_t Number; + long Number; enum _MERIDIAN Meridian; diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 04334d3..b21320b 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -89,7 +89,7 @@ typedef struct _TABLE { const char *name; int type; - time_t value; + long value; } TABLE; /* @@ -103,7 +103,7 @@ typedef enum _DSTMODE { %} %union { - time_t Number; + long Number; enum _MERIDIAN Meridian; } -- cgit v0.12 From 1a2f289ff654579945f09d5d494fcccdc193966e Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 23 Jun 2020 19:21:22 +0000 Subject: optimizes locale cache: locale is case-sensitive key; simplifying format localization routine (cached within locale mc-catalog in C); clock::mcget - be sure we don't overwrite catalog of (common) locale {} (as it's a base of other catalogs loaded later). --- generic/tclClock.c | 34 +++++++++++--------- generic/tclClockFmt.c | 17 +++++++--- library/clock.tcl | 88 ++++++++++++++++++++++++--------------------------- 3 files changed, 72 insertions(+), 67 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 9f6a959..d0e5214 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -642,7 +642,7 @@ NormLocaleObj( if ( dataPtr->currentLocale != NULL && ( localeObj == dataPtr->currentLocale || (localeObj->length == dataPtr->currentLocale->length - && strcmp(loc, TclGetString(dataPtr->currentLocale)) == 0 + && strcasecmp(loc, TclGetString(dataPtr->currentLocale)) == 0 ) ) ) { @@ -652,7 +652,7 @@ NormLocaleObj( if ( dataPtr->lastUsedLocale != NULL && ( localeObj == dataPtr->lastUsedLocale || (localeObj->length == dataPtr->lastUsedLocale->length - && strcmp(loc, TclGetString(dataPtr->lastUsedLocale)) == 0 + && strcasecmp(loc, TclGetString(dataPtr->lastUsedLocale)) == 0 ) ) ) { @@ -663,7 +663,7 @@ NormLocaleObj( if ( dataPtr->prevUsedLocale != NULL && ( localeObj == dataPtr->prevUsedLocale || (localeObj->length == dataPtr->prevUsedLocale->length - && strcmp(loc, TclGetString(dataPtr->prevUsedLocale)) == 0 + && strcasecmp(loc, TclGetString(dataPtr->prevUsedLocale)) == 0 ) ) ) { @@ -756,18 +756,21 @@ ClockMCDict(ClockFmtScnCmdArgs *opts) } } + /* check or obtain mcDictObj (be sure it's modifiable) */ if (opts->mcDictObj == NULL || opts->mcDictObj->refCount > 1) { - Tcl_Obj *callargs[2]; + int ref = 1; - /* first try to find it own catalog dict */ + /* first try to find locale catalog dict */ if (dataPtr->mcDicts == NULL) { Tcl_SetObjRef(dataPtr->mcDicts, Tcl_NewDictObj()); } Tcl_DictObjGet(NULL, dataPtr->mcDicts, opts->localeObj, &opts->mcDictObj); - if (opts->mcDictObj == NULL || opts->mcDictObj->refCount > 1) { + if (opts->mcDictObj == NULL) { /* get msgcat dictionary - ::tcl::clock::mcget locale */ + Tcl_Obj *callargs[2]; + callargs[0] = dataPtr->literals[LIT_MCGET]; callargs[1] = opts->localeObj; @@ -777,19 +780,20 @@ ClockMCDict(ClockFmtScnCmdArgs *opts) opts->mcDictObj = Tcl_GetObjResult(opts->interp); Tcl_ResetResult(opts->interp); + ref = 0; /* new object is not yet referenced */ + } - /* be sure that object reference not increases (dict changeable) */ - if (opts->mcDictObj->refCount > 0) { - /* smart reference (shared dict as object with no ref-counter) */ - opts->mcDictObj = Tcl_DictObjSmartRef(opts->interp, - opts->mcDictObj); - } - - /* create exactly one reference to catalog / make it searchable for future */ - Tcl_DictObjPut(NULL, dataPtr->mcDicts, opts->localeObj, + /* be sure that object reference doesn't increase (dict changeable) */ + if (opts->mcDictObj->refCount > ref) { + /* smart reference (shared dict as object with no ref-counter) */ + opts->mcDictObj = Tcl_DictObjSmartRef(opts->interp, opts->mcDictObj); } + /* create exactly one reference to catalog / make it searchable for future */ + Tcl_DictObjPut(NULL, dataPtr->mcDicts, opts->localeObj, + opts->mcDictObj); + if ( opts->localeObj == dataPtr->literals[LIT_C] || opts->localeObj == dataPtr->defaultLocale ) { diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 2e63008..faf091e 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -844,14 +844,21 @@ ClockLocalizeFormat( callargs[0] = dataPtr->literals[LIT_LOCALIZE_FORMAT]; callargs[1] = opts->localeObj; callargs[2] = opts->formatObj; - callargs[3] = keyObj; - if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) != TCL_OK + callargs[3] = opts->mcDictObj; + if (Tcl_EvalObjv(opts->interp, 4, callargs, 0) == TCL_OK ) { - goto done; + valObj = Tcl_GetObjResult(opts->interp); } - valObj = Tcl_GetObjResult(opts->interp); - + /* ensure mcDictObj remains unshared */ + if (opts->mcDictObj->refCount > 1) { + /* smart reference (shared dict as object with no ref-counter) */ + opts->mcDictObj = Tcl_DictObjSmartRef(opts->interp, + opts->mcDictObj); + } + if (!valObj) { + goto done; + } /* cache it inside mc-dictionary (this incr. ref count of keyObj/valObj) */ if (Tcl_DictObjPut(opts->interp, opts->mcDictObj, keyObj, valObj) != TCL_OK diff --git a/library/clock.tcl b/library/clock.tcl index 6638496..04d4777 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -477,8 +477,7 @@ proc ::tcl::clock::Initialize {} { # Caches - variable LocaleFormats \ - [dict create]; # Dictionary with localized formats + variable LocFmtMap [dict create]; # Dictionary with localized format maps variable TimeZoneBad [dict create]; # Dictionary whose keys are time zone # names and whose values are 1 if @@ -570,12 +569,18 @@ proc ::tcl::clock::mcMerge {locales} { set mrgcat [mcMerge [lrange $locales 1 end]] if {[dict exists $Msgs $ns $loc]} { set mrgcat [dict merge $mrgcat [dict get $Msgs $ns $loc]] + dict set mrgcat L $loc + } else { + # be sure a duplicate is created, don't overwrite {} (common) locale: + set mrgcat [dict merge $mrgcat [dict create L $loc]] } } else { if {[dict exists $Msgs $ns $loc]} { set mrgcat [dict get $Msgs $ns $loc] + dict set mrgcat L $loc } else { - set mrgcat [dict create] + # be sure a duplicate is created, don't overwrite {} (common) locale: + set mrgcat [dict create L $loc] } } dict set mcMergedCat $loc $mrgcat @@ -819,6 +824,8 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } { # locale -- Current [mclocale] locale, supplied to avoid # an extra call # format -- Format supplied to [clock scan] or [clock format] +# mcd -- Message catalog dictionary for current locale (read-only, +# don't store it to avoid shared references). # # Results: # Returns the string with locale-dependent composite format groups @@ -829,54 +836,41 @@ proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } { # #---------------------------------------------------------------------- -proc ::tcl::clock::LocalizeFormat { locale format {fmtkey {}} } { - variable LocaleFormats +proc ::tcl::clock::LocalizeFormat { locale format mcd } { + variable LocFmtMap - if { $fmtkey eq {} } { set fmtkey FMT_$format } - if {[dict exists $LocaleFormats $locale $fmtkey]} { - set locfmt [dict get $LocaleFormats $locale $fmtkey] + # get map list cached or build it: + if {[dict exists $LocFmtMap $locale]} { + set mlst [dict get $LocFmtMap $locale] } else { - - # get map list cached or build it: - if {[dict exists $LocaleFormats $locale MLST]} { - set mlst [dict get $LocaleFormats $locale MLST] - } else { - - # message catalog dictionary: - set mcd [mcget $locale] - - # Handle locale-dependent format groups by mapping them out of the format - # string. Note that the order of the [string map] operations is - # significant because later formats can refer to later ones; for example - # %c can refer to %X, which in turn can refer to %T. - - set mlst { - %% %% - %D %m/%d/%Y - %+ {%a %b %e %H:%M:%S %Z %Y} - } - lappend mlst %EY [string map $mlst [dict get $mcd LOCALE_YEAR_FORMAT]] - lappend mlst %T [string map $mlst [dict get $mcd TIME_FORMAT_24_SECS]] - lappend mlst %R [string map $mlst [dict get $mcd TIME_FORMAT_24]] - lappend mlst %r [string map $mlst [dict get $mcd TIME_FORMAT_12]] - lappend mlst %X [string map $mlst [dict get $mcd TIME_FORMAT]] - lappend mlst %EX [string map $mlst [dict get $mcd LOCALE_TIME_FORMAT]] - lappend mlst %x [string map $mlst [dict get $mcd DATE_FORMAT]] - lappend mlst %Ex [string map $mlst [dict get $mcd LOCALE_DATE_FORMAT]] - lappend mlst %c [string map $mlst [dict get $mcd DATE_TIME_FORMAT]] - lappend mlst %Ec [string map $mlst [dict get $mcd LOCALE_DATE_TIME_FORMAT]] - - dict set LocaleFormats $locale MLST $mlst + # Handle locale-dependent format groups by mapping them out of the format + # string. Note that the order of the [string map] operations is + # significant because later formats can refer to later ones; for example + # %c can refer to %X, which in turn can refer to %T. + + set mlst { + %% %% + %D %m/%d/%Y + %+ {%a %b %e %H:%M:%S %Z %Y} } + lappend mlst %EY [string map $mlst [dict get $mcd LOCALE_YEAR_FORMAT]] + lappend mlst %T [string map $mlst [dict get $mcd TIME_FORMAT_24_SECS]] + lappend mlst %R [string map $mlst [dict get $mcd TIME_FORMAT_24]] + lappend mlst %r [string map $mlst [dict get $mcd TIME_FORMAT_12]] + lappend mlst %X [string map $mlst [dict get $mcd TIME_FORMAT]] + lappend mlst %EX [string map $mlst [dict get $mcd LOCALE_TIME_FORMAT]] + lappend mlst %x [string map $mlst [dict get $mcd DATE_FORMAT]] + lappend mlst %Ex [string map $mlst [dict get $mcd LOCALE_DATE_FORMAT]] + lappend mlst %c [string map $mlst [dict get $mcd DATE_TIME_FORMAT]] + lappend mlst %Ec [string map $mlst [dict get $mcd LOCALE_DATE_TIME_FORMAT]] - # translate copy of format (don't use format object here, because otherwise - # it can lose its internal representation (string map - convert to unicode) - set locfmt [string map $mlst [string range " $format" 1 end]] - - # cache it: - dict set LocaleFormats $locale $fmtkey $locfmt + dict set LocFmtMap $locale $mlst } + # translate copy of format (don't use format object here, because otherwise + # it can lose its internal representation (string map - convert to unicode) + set locfmt [string map $mlst [string range " $format" 1 end]] + # Save original format as long as possible, because of internal # representation (performance). # Note that in this case such format will be never localized (also @@ -2077,7 +2071,7 @@ proc ::tcl::clock::ChangeCurrentLocale {args} { #---------------------------------------------------------------------- proc ::tcl::clock::ClearCaches {} { - variable LocaleFormats + variable LocFmtMap variable mcMergedCat variable TimeZoneBad @@ -2087,7 +2081,7 @@ proc ::tcl::clock::ClearCaches {} { # clear msgcat cache: set mcMergedCat [dict create] - set LocaleFormats {} + set LocFmtMap {} set TimeZoneBad {} InitTZData } -- cgit v0.12 From 85ffaea615ec6d98e247362d60fecef192e26e5f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 12 Oct 2020 16:47:09 +0000 Subject: Eliminate some eol-spacing, eliminate some gcc warnings (with -Wc++-compat) --- doc/clock.n | 6 +-- generic/tclClock.c | 40 +++++++-------- generic/tclClockFmt.c | 121 ++++++++++++++++++++++++---------------------- generic/tclDate.c | 6 +-- generic/tclDate.h | 8 +-- generic/tclGetDate.y | 6 +-- tests-perf/clock.perf.tcl | 14 +++--- 7 files changed, 104 insertions(+), 97 deletions(-) diff --git a/doc/clock.n b/doc/clock.n index 4440c4d..7f05127 100644 --- a/doc/clock.n +++ b/doc/clock.n @@ -581,7 +581,7 @@ The epoch time of 1 January 1970 corresponds to Astronomical JDN 2440588. \fB%Es\fR This affects similar to \fB%s\fR, but in opposition to \fB%s\fR it parses or formats local seconds (not the posix seconds). -Because \fB%s\fR has the same precedence as \fB%s\fR (uniquely determines +Because \fB%s\fR has the same precedence as \fB%s\fR (uniquely determines a point in time), it overrides all other input formats. .TP \fB%Ex\fR @@ -778,7 +778,7 @@ week number \fB%V\fR; programs should use \fB%G\fR for that purpose. On output, produces the current time zone, expressed in hours and minutes east (+hhmm) or west (\-hhmm) of Greenwich. On input, accepts a time zone specifier (see \fBTIME ZONES\fR below) that will be used to -determine the time zone (this token is optionally applicable on input, +determine the time zone (this token is optionally applicable on input, so the value is not mandatory and can be missing in input). .TP \fB%Z\fR @@ -994,7 +994,7 @@ precision of type of the token. In example below the second date-string contains "next January", therefore it results in next year but in January. And third date-string besides "January" contains also additionally "Fri", so it results in the nearest Friday. -Thus both win before "385 days" resp. make it more precise, because of higher +Thus both win before "385 days" resp. make it more precise, because of higher precision of this token types. .CS % clock format [clock scan "5 years 18 months 385 days" -base 0 -gmt 1] -gmt 1 diff --git a/generic/tclClock.c b/generic/tclClock.c index 8a64441..801d576 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -240,7 +240,7 @@ TclClockInit( data->validMinYear = INT_MIN; data->validMaxYear = INT_MAX; /* corresponds max of JDN in sqlite - 9999-12-31 23:59:59 per default */ - data->maxJDN = 5373484.499999994; + data->maxJDN = 5373484.499999994; data->systemTimeZone = NULL; data->systemSetupTZData = NULL; @@ -341,7 +341,7 @@ ClockConfigureClear( data->prevUsedLocaleDict = NULL; Tcl_UnsetObjRef(data->lastBase.timezoneObj); - + Tcl_UnsetObjRef(data->lastTZOffsCache[0].timezoneObj); Tcl_UnsetObjRef(data->lastTZOffsCache[0].tzName); Tcl_UnsetObjRef(data->lastTZOffsCache[1].timezoneObj); @@ -1950,7 +1950,7 @@ ConvertLocalToUTC( return TCL_OK; } else { - Tcl_WideInt rangesVal[2]; + Tcl_WideInt rangesVal[2]; if (ConvertLocalToUTCUsingTable(interp, fields, rowc, rowv, rangesVal) != TCL_OK) { @@ -1985,8 +1985,8 @@ ConvertLocalToUTC( dstHole: #if 0 printf("given local-time is outside the time-zone (in DST-hole): " - "%d - offs %d => %d <= %d < %d\n", - (int)fields->localSeconds, fields->tzOffset, + "%d - offs %d => %d <= %d < %d\n", + (int)fields->localSeconds, fields->tzOffset, (int)ltzoc->rangesVal[0], (int)seconds, (int)ltzoc->rangesVal[1]); #endif /* because we don't know real TZ (we're outsize), just invalidate local @@ -2246,7 +2246,7 @@ ConvertUTCToLocal( /* we cannot cache (ranges unknown yet) */ } else { - Tcl_WideInt rangesVal[2]; + Tcl_WideInt rangesVal[2]; if (ConvertUTCToLocalUsingTable(interp, fields, rowc, rowv, rangesVal) != TCL_OK) { @@ -2707,7 +2707,7 @@ GetMonthDay( int month; const int *dipm = daysInPriorMonths[IsGregorianLeapYear(fields)]; - /* + /* * Estimate month by calculating `dayOfYear / (365/12)` */ month = (day*12) / dipm[12]; @@ -3330,7 +3330,7 @@ ClockParseFmtScnArgs( } /* if already specified */ if (saw & (1 << optionIndex)) { - if ( !(flags & CLC_SCN_ARGS) + if ( !(flags & CLC_SCN_ARGS) && optionIndex == CLC_ARGS_BASE) { goto badOptionMsg; } @@ -3442,7 +3442,7 @@ ClockParseFmtScnArgs( } /* * Seconds could be an unsigned number that overflowed. Make sure - * that it isn't. Additionally it may be too complex to calculate + * that it isn't. Additionally it may be too complex to calculate * julianday etc (forwards/backwards) by too large/small values, thus * just let accept a bit shorter values to avoid overflow. * Note the year is currently an integer, thus avoid to overflow it also. @@ -3753,7 +3753,7 @@ ClockScanCommit( } if (info->flags & (CLF_ASSEMBLE_SECONDS|CLF_LOCALSEC)) { - if (ConvertLocalToUTC(opts->clientData, opts->interp, &yydate, + if (ConvertLocalToUTC(opts->clientData, opts->interp, &yydate, opts->timezoneObj, GREGORIAN_CHANGE_DATE) != TCL_OK) { return TCL_ERROR; } @@ -3796,7 +3796,7 @@ ClockValidDate( #if 0 printf("yyMonth %d, yyDay %d, yyDayOfYear %d, yyHour %d, yyMinutes %d, yySeconds %d, " "yySecondOfDay %d, sec %d, daySec %d, tzOffset %d\n", - yyMonth, yyDay, yydate.dayOfYear, yyHour, yyMinutes, yySeconds, + yyMonth, yyDay, yydate.dayOfYear, yyHour, yyMinutes, yySeconds, yySecondOfDay, (int)yydate.localSeconds, (int)(yydate.localSeconds % SECONDS_PER_DAY), yydate.tzOffset); #endif @@ -3814,7 +3814,7 @@ ClockValidDate( } } if (info->flags & CLF_YEAR) { - if ( yyYear < dataPtr->validMinYear + if ( yyYear < dataPtr->validMinYear || yyYear > dataPtr->validMaxYear ) { errMsg = "invalid year"; errCode = "year"; goto error; } @@ -3839,7 +3839,7 @@ ClockValidDate( if ( yyDay < 1 || yyDay > 31 ) { errMsg = "invalid day"; errCode = "day"; goto error; } - else + else if ( (info->flags & CLF_MONTH) ) { const int *h = hath[IsGregorianLeapYear(&yydate)]; if ( yyDay > h[yyMonth-1] ) { @@ -3886,7 +3886,7 @@ ClockValidDate( return TCL_OK; } - /* + /* * Further tests expected ready calculated julianDay (inclusive relative), * and time-zone conversion (local to UTC time). */ @@ -3895,14 +3895,14 @@ ClockValidDate( /* time, regarding the modifications by the time-zone (looks for given time * in between DST-time hole, so does not exist in this time-zone) */ if (info->flags & CLF_TIME) { - /* - * we don't need to do the backwards time-conversion (UTC to local) and - * compare results, because the after conversion (local to UTC) we + /* + * we don't need to do the backwards time-conversion (UTC to local) and + * compare results, because the after conversion (local to UTC) we * should have valid localSeconds (was not invalidated to TCL_INV_SECONDS), * so if it was invalidated - invalid time, outside the time-zone (in DST-hole) */ if ( yydate.localSeconds == TCL_INV_SECONDS ) { - errMsg = "invalid time (does not exist in this time-zone)"; + errMsg = "invalid time (does not exist in this time-zone)"; errCode = "out-of-time"; goto error; } } @@ -4017,7 +4017,7 @@ ClockFreeScan( info->flags |= CLF_ASSEMBLE_SECONDS; } - /* + /* * For freescan apply validation rules (stage 1) before mixed with * relative time (otherwise always valid recalculated date & time). */ @@ -4596,7 +4596,7 @@ ClockSafeCatchCmd( /* original catch */ ret = Tcl_CatchObjCmd(NULL, interp, objc, objv); - + if (ret == TCL_ERROR) { Tcl_DiscardInterpState((Tcl_InterpState)statePtr); return TCL_ERROR; diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index faf091e..18252d3 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -64,7 +64,7 @@ _str2int( const char *e, int sign) { - register int val = 0, prev = 0; + int val = 0, prev = 0; if (sign >= 0) { while (p < e) { val = val * 10 + (*p++ - '0'); @@ -94,7 +94,7 @@ _str2wideInt( const char *e, int sign) { - register Tcl_WideInt val = 0, prev = 0; + Tcl_WideInt val = 0, prev = 0; if (sign >= 0) { while (p < e) { val = val * 10 + (*p++ - '0'); @@ -135,11 +135,11 @@ _str2wideInt( static inline char * _itoaw( char *buf, - register int val, + int val, char padchar, unsigned short int width) { - register char *p; + char *p; static int wrange[] = {1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000}; /* positive integer */ @@ -154,7 +154,7 @@ _itoaw( p = buf + width; *p-- = '\0'; do { - register char c = (val % 10); val /= 10; + char c = (val % 10); val /= 10; *p-- = '0' + c; } while (val > 0); /* fulling with pad-char */ @@ -179,12 +179,12 @@ _itoaw( /* differentiate platforms with -1 % 10 == 1 and -1 % 10 == -1 */ if (-1 % 10 == -1) { do { - register char c = (val % 10); val /= 10; + char c = (val % 10); val /= 10; *p-- = '0' - c; } while (val < 0); } else { do { - register char c = (val % 10); val /= 10; + char c = (val % 10); val /= 10; *p-- = '0' + c; } while (val < 0); } @@ -203,11 +203,11 @@ _itoaw( static inline char * _witoaw( char *buf, - register Tcl_WideInt val, + Tcl_WideInt val, char padchar, unsigned short int width) { - register char *p; + char *p; static int wrange[] = {1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000}; /* positive integer */ @@ -231,7 +231,7 @@ _witoaw( p = buf + width; *p-- = '\0'; do { - register char c = (val % 10); val /= 10; + char c = (val % 10); val /= 10; *p-- = '0' + c; } while (val > 0); /* fulling with pad-char */ @@ -266,12 +266,12 @@ _witoaw( /* differentiate platforms with -1 % 10 == 1 and -1 % 10 == -1 */ if (-1 % 10 == -1) { do { - register char c = (val % 10); val /= 10; + char c = (val % 10); val /= 10; *p-- = '0' - c; } while (val < 0); } else { do { - register char c = (val % 10); val /= 10; + char c = (val % 10); val /= 10; *p-- = '0' + c; } while (val < 0); } @@ -419,18 +419,18 @@ ClockFmtScnStorageAllocProc( void *keyPtr) /* Key to store in the hash table entry. */ { ClockFmtScnStorage *fss; - const char *string = (const char *) keyPtr; Tcl_HashEntry *hPtr; unsigned int size, allocsize = sizeof(ClockFmtScnStorage) + sizeof(Tcl_HashEntry); + (void)tablePtr; allocsize += (size = strlen(string) + 1); if (size > sizeof(hPtr->key)) { allocsize -= sizeof(hPtr->key); } - fss = ckalloc(allocsize); + fss = (ClockFmtScnStorage *)ckalloc(allocsize); /* initialize */ memset(fss, 0, sizeof(*fss)); @@ -549,7 +549,7 @@ ClockFmtObj_DupInternalRep(srcPtr, copyPtr) /* if no format representation, dup string representation */ if (fss == NULL) { - copyPtr->bytes = ckalloc(srcPtr->length + 1); + copyPtr->bytes = (char *)ckalloc(srcPtr->length + 1); memcpy(copyPtr->bytes, srcPtr->bytes, srcPtr->length + 1); copyPtr->length = srcPtr->length; } @@ -588,10 +588,11 @@ ClockFmtObj_SetFromAny(interp, objPtr) Tcl_Interp *interp; Tcl_Obj *objPtr; { - /* validate string representation before free old internal represenation */ + /* validate string representation before free old internal representation */ + (void)interp; (void)TclGetString(objPtr); - /* free old internal represenation */ + /* free old internal representation */ if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) objPtr->typePtr->freeIntRepProc(objPtr); @@ -617,7 +618,7 @@ ClockFmtObj_UpdateString(objPtr) } len = strlen(name); objPtr->length = len, - objPtr->bytes = ckalloc((size_t)++len); + objPtr->bytes = (char *)ckalloc((size_t)++len); if (objPtr->bytes) memcpy(objPtr->bytes, name, len); } @@ -697,7 +698,7 @@ FindOrCreateFmtScnStorage( { const char *strFmt = TclGetString(objPtr); ClockFmtScnStorage *fss = NULL; - int new; + int isNew; Tcl_HashEntry *hPtr; Tcl_MutexLock(&ClockFmtMutex); @@ -718,14 +719,14 @@ FindOrCreateFmtScnStorage( } /* get or create entry (and alocate storage) */ - hPtr = Tcl_CreateHashEntry(&FmtScnHashTable, strFmt, &new); + hPtr = Tcl_CreateHashEntry(&FmtScnHashTable, strFmt, &isNew); if (hPtr != NULL) { fss = FmtScn4HashEntry(hPtr); #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 /* unlink if it is currently in GC */ - if (new == 0 && fss->objRefCount == 0) { + if (isNew == 0 && fss->objRefCount == 0) { ClockFmtScnStorage_GC_Out(fss); } #endif @@ -812,7 +813,7 @@ Tcl_Obj * ClockLocalizeFormat( ClockFmtScnCmdArgs *opts) { - ClockClientData *dataPtr = opts->clientData; + ClockClientData *dataPtr = (ClockClientData *)opts->clientData; Tcl_Obj *valObj = NULL, *keyObj; keyObj = ClockFrmObjGetLocFmtKey(opts->interp, opts->formatObj); @@ -903,8 +904,8 @@ done: static const char * FindTokenBegin( - register const char *p, - register const char *end, + const char *p, + const char *end, ClockScanToken *tok) { char c; @@ -958,9 +959,9 @@ DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok, int *minLenPtr, int *maxLenPtr) { - register int minLen = tok->map->minSize; - register int maxLen; - register const char *p = yyInput + minLen, + int minLen = tok->map->minSize; + int maxLen; + const char *p = yyInput + minLen, *end = info->dateEnd; /* if still tokens available, try to correct minimum length */ @@ -1348,9 +1349,9 @@ StaticListSearch(ClockFmtScnCmdArgs *opts, static inline const char * FindWordEnd( ClockScanToken *tok, - register const char * p, const char * end) + const char * p, const char * end) { - register const char *x = tok->tokWord.start; + const char *x = tok->tokWord.start; const char *pfnd = p; if (x == tok->tokWord.end - 1) { /* fast phase-out for single char word */ if (*p == *x) { @@ -1527,7 +1528,7 @@ static int ClockScnToken_LocaleERA_Proc(ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok) { - ClockClientData *dataPtr = opts->clientData; + ClockClientData *dataPtr = (ClockClientData *)opts->clientData; int ret, val; int minLen, maxLen; @@ -1595,7 +1596,7 @@ ClockScnToken_JDN_Proc(ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok) { int minLen, maxLen; - register const char *p = yyInput, *end; const char *s; + const char *p = yyInput, *end; const char *s; Tcl_WideInt intJD; int fractJD = 0, fractJDDiv = 1; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); @@ -1632,7 +1633,7 @@ ClockScnToken_JDN_Proc(ClockFmtScnCmdArgs *opts, yyInput = p; done: - /* + /* * Build a date from julian day (integer and fraction). * Note, astronomical JDN starts at noon in opposite to calendar julianday. */ @@ -1662,7 +1663,7 @@ ClockScnToken_TimeZone_Proc(ClockFmtScnCmdArgs *opts, { int minLen, maxLen; int len = 0; - register const char *p = yyInput; + const char *p = yyInput; Tcl_Obj *tzObjStor = NULL; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); @@ -1741,7 +1742,7 @@ ClockScnToken_StarDate_Proc(ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok) { int minLen, maxLen; - register const char *p = yyInput, *end; const char *s; + const char *p = yyInput, *end; const char *s; int year, fractYear, fractDayDiv, fractDay; static const char *stardatePref = "stardate "; @@ -1955,10 +1956,10 @@ static ClockScanTokenMap ScnWordTokenMap = { static inline unsigned int EstimateTokenCount( - register const char *fmt, - register const char *end) + const char *fmt, + const char *end) { - register const char *p = fmt; + const char *p = fmt; unsigned int tokcnt; /* estimate token count by % char and format length */ tokcnt = 0; @@ -2015,7 +2016,7 @@ ClockGetOrParseScanFormat( if (fss->scnTok == NULL) { ClockScanToken *tok, *scnTok; unsigned int tokCnt; - register const char *p, *e, *cp; + const char *p, *e, *cp; e = p = HashEntry4FmtScn(fss)->key.string; e += strlen(p); @@ -2025,7 +2026,7 @@ ClockGetOrParseScanFormat( fss->scnSpaceCount = 0; - scnTok = tok = ckalloc(sizeof(*tok) * fss->scnTokC); + scnTok = tok = (ClockScanToken *)ckalloc(sizeof(*tok) * fss->scnTokC); memset(tok, 0, sizeof(*(tok))); tokCnt = 1; while (p < e) { @@ -2168,7 +2169,7 @@ word_tok: /* correct count of real used tokens and free mem if desired * (1 is acceptable delta to prevent memory fragmentation) */ if (fss->scnTokC > tokCnt + (CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE / 2)) { - if ( (tok = ckrealloc(scnTok, tokCnt * sizeof(*tok))) != NULL ) { + if ( (tok = (ClockScanToken *)ckrealloc(scnTok, tokCnt * sizeof(*tok))) != NULL ) { scnTok = tok; } } @@ -2188,15 +2189,15 @@ done: */ int ClockScan( - register DateInfo *info, /* Date fields used for parsing & converting */ + DateInfo *info, /* Date fields used for parsing & converting */ Tcl_Obj *strObj, /* String containing the time to scan */ ClockFmtScnCmdArgs *opts) /* Command options */ { - ClockClientData *dataPtr = opts->clientData; + ClockClientData *dataPtr = (ClockClientData *)opts->clientData; ClockFmtScnStorage *fss; ClockScanToken *tok; ClockScanTokenMap *map; - register const char *p, *x, *end; + const char *p, *x, *end; unsigned short int flags = 0; int ret = TCL_ERROR; @@ -2342,7 +2343,7 @@ ClockScan( /* unmatched -> error */ goto not_match; } - /* don't decrement yySpaceCount by regular (first expected space), + /* don't decrement yySpaceCount by regular (first expected space), * already considered above with fss->scnSpaceCount */; p++; while (p < end && isspace(UCHAR(*p))) { @@ -2470,7 +2471,7 @@ ClockScan( yyYear += info->dateCentury * 100; } } - } + } if ( (flags & (CLF_ISO8601WEAK|CLF_ISO8601YEAR)) ) { if ((flags & (CLF_ISO8601YEAR|CLF_YEAR)) == CLF_YEAR) { /* for calculations expected iso year */ @@ -2536,7 +2537,7 @@ not_match: "input string \"%s\" does not match supplied format \"%s\"," " locale \"%s\" - token \"%s\"", info->dateStart, HashEntry4FmtScn(fss)->key.string, - Tcl_GetString(opts->localeObj), + Tcl_GetString(opts->localeObj), tok && tok->tokWord.start ? tok->tokWord.start : "NULL")); #endif Tcl_SetErrorCode(opts->interp, "CLOCK", "badInputString", NULL); @@ -2551,7 +2552,7 @@ done: static inline int FrmResultAllocate( - register DateFormat *dateFmt, + DateFormat *dateFmt, int len) { int needed = dateFmt->output + len - dateFmt->resEnd; @@ -2561,13 +2562,13 @@ FrmResultAllocate( char *newRes; /* differentiate between stack and memory */ if (!FrmResultIsAllocated(dateFmt)) { - newRes = ckalloc(newsize); + newRes = (char *)ckalloc(newsize); if (newRes == NULL) { return TCL_ERROR; } memcpy(newRes, dateFmt->resMem, dateFmt->output - dateFmt->resMem); } else { - newRes = ckrealloc(dateFmt->resMem, newsize); + newRes = (char *)ckrealloc(dateFmt->resMem, newsize); if (newRes == NULL) { return TCL_ERROR; } @@ -2682,7 +2683,7 @@ ClockFmtToken_JDN_Proc( int fractJD; /* Convert to JDN parts (regarding start offset) and time fraction */ - fractJD = dateFmt->date.secondOfDay + fractJD = dateFmt->date.secondOfDay - (int)tok->map->offs; /* 0 for calendar or 43200 for astro JD */ if (fractJD < 0) { intJD--; @@ -2739,9 +2740,12 @@ ClockFmtToken_TimeZone_Proc( ClockFormatToken *tok, int *val) { + (void)val; + if (*tok->tokWord.start == 'z') { int z = dateFmt->date.tzOffset; char sign = '+'; + if ( z < 0 ) { z = -z; sign = '-'; @@ -2784,6 +2788,8 @@ ClockFmtToken_LocaleERA_Proc( Tcl_Obj *mcObj; const char *s; int len; + (void)tok; + (void)val; if (dateFmt->date.era == BCE) { mcObj = ClockMCGet(opts, MCLIT_BCE); @@ -3056,7 +3062,7 @@ ClockGetOrParseFmtFormat( if (fss->fmtTok == NULL) { ClockFormatToken *tok, *fmtTok; unsigned int tokCnt; - register const char *p, *e, *cp; + const char *p, *e, *cp; e = p = HashEntry4FmtScn(fss)->key.string; e += strlen(p); @@ -3064,7 +3070,7 @@ ClockGetOrParseFmtFormat( /* estimate token count by % char and format length */ fss->fmtTokC = EstimateTokenCount(p, e); - fmtTok = tok = ckalloc(sizeof(*tok) * fss->fmtTokC); + fmtTok = tok = (ClockFormatToken *)ckalloc(sizeof(*tok) * fss->fmtTokC); memset(tok, 0, sizeof(*(tok))); tokCnt = 1; while (p < e) { @@ -3151,7 +3157,7 @@ word_tok: /* correct count of real used tokens and free mem if desired * (1 is acceptable delta to prevent memory fragmentation) */ if (fss->fmtTokC > tokCnt + (CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE / 2)) { - if ( (tok = ckrealloc(fmtTok, tokCnt * sizeof(*tok))) != NULL ) { + if ( (tok = (ClockFormatToken *)ckrealloc(fmtTok, tokCnt * sizeof(*tok))) != NULL ) { fmtTok = tok; } } @@ -3171,7 +3177,7 @@ done: */ int ClockFormat( - register DateFormat *dateFmt, /* Date fields used for parsing & converting */ + DateFormat *dateFmt, /* Date fields used for parsing & converting */ ClockFmtScnCmdArgs *opts) /* Command options */ { ClockFmtScnStorage *fss; @@ -3194,7 +3200,7 @@ ClockFormat( dateFmt->resMem = resMem; dateFmt->resEnd = dateFmt->resMem + sizeof(resMem); if (fss->fmtMinAlloc > sizeof(resMem)) { - dateFmt->resMem = ckalloc(fss->fmtMinAlloc); + dateFmt->resMem = (char *)ckalloc(fss->fmtMinAlloc); dateFmt->resEnd = dateFmt->resMem + fss->fmtMinAlloc; if (dateFmt->resMem == NULL) { return TCL_ERROR; @@ -3310,13 +3316,13 @@ done: result->length = dateFmt->output - dateFmt->resMem; size = result->length+1; if (dateFmt->resMem == resMem) { - result->bytes = ckalloc(size); + result->bytes = (char *)ckalloc(size); if (result->bytes == NULL) { return TCL_ERROR; } memcpy(result->bytes, dateFmt->resMem, size); } else if ((dateFmt->resEnd - dateFmt->resMem) / size > MAX_FMT_RESULT_THRESHOLD) { - result->bytes = ckrealloc(dateFmt->resMem, size); + result->bytes = (char *)ckrealloc(dateFmt->resMem, size); if (result->bytes == NULL) { result->bytes = dateFmt->resMem; } @@ -3350,6 +3356,7 @@ static void ClockFrmScnFinalize( ClientData clientData) /* Not used. */ { + (void)clientData; Tcl_MutexLock(&ClockFmtMutex); #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 /* clear GC */ diff --git a/generic/tclDate.c b/generic/tclDate.c index f9630e4..e077d94 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -2700,7 +2700,7 @@ TclDatelex( tokStart = yyInput; if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */ - + /* * Convert the string into a number; count the number of digits. */ @@ -2762,12 +2762,12 @@ TclDatelex( yyInput--; location->last_column = yyInput - info->dateStart - 1; ret = LookupWord(yylvalPtr, buff); - /* + /* * lookahead: * for spaces to consider word boundaries (for instance * literal T in isodateTisotimeZ is not a TZ, but Z is UTC); * for +/- digit, to differentiate between "GMT+1000 day" and "GMT +1000 day"; - * bypass spaces after token (but ignore by TZ+OFFS), because should + * bypass spaces after token (but ignore by TZ+OFFS), because should * recognize next SP token, if TZ only. */ if (ret == tZONE || ret == tDAYZONE) { diff --git a/generic/tclDate.h b/generic/tclDate.h index 0c9f7c3..ad0ca70 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -320,7 +320,7 @@ typedef struct ClockClientData { Tcl_Obj *prevSetupTimeZoneUnnorm; Tcl_Obj *prevSetupTimeZone; Tcl_Obj *prevSetupTZData; - + Tcl_Obj *defaultLocale; Tcl_Obj *defaultLocaleDict; Tcl_Obj *currentLocale; @@ -404,7 +404,7 @@ struct ClockScanToken { #define MIN_FMT_RESULT_BLOCK_ALLOC 80 #define MIN_FMT_RESULT_BLOCK_DELTA 0 -/* Maximal permitted threshold (buffer size > result size) in percent, +/* Maximal permitted threshold (buffer size > result size) in percent, * to directly return the buffer without reallocate */ #define MAX_FMT_RESULT_THRESHOLD 2 @@ -472,11 +472,11 @@ struct ClockFmtScnStorage { #endif }; -/* +/* * Clock macros. */ -/* +/* * Extracts Julian day and seconds of the day from posix seconds (tm). */ #define ClockExtractJDAndSODFromSeconds(jd, sod, tm) \ diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 485d54a..6588e0c 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -901,7 +901,7 @@ TclDatelex( tokStart = yyInput; if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */ - + /* * Convert the string into a number; count the number of digits. */ @@ -963,12 +963,12 @@ TclDatelex( yyInput--; location->last_column = yyInput - info->dateStart - 1; ret = LookupWord(yylvalPtr, buff); - /* + /* * lookahead: * for spaces to consider word boundaries (for instance * literal T in isodateTisotimeZ is not a TZ, but Z is UTC); * for +/- digit, to differentiate between "GMT+1000 day" and "GMT +1000 day"; - * bypass spaces after token (but ignore by TZ+OFFS), because should + * bypass spaces after token (but ignore by TZ+OFFS), because should * recognize next SP token, if TZ only. */ if (ret == tZONE || ret == tDAYZONE) { diff --git a/tests-perf/clock.perf.tcl b/tests-perf/clock.perf.tcl index 3682387..22b8d91 100644 --- a/tests-perf/clock.perf.tcl +++ b/tests-perf/clock.perf.tcl @@ -2,18 +2,18 @@ # ------------------------------------------------------------------------ # # test-performance.tcl -- -# +# # This file provides common performance tests for comparison of tcl-speed # degradation by switching between branches. # (currently for clock ensemble only) # # ------------------------------------------------------------------------ -# +# # Copyright (c) 2014 Serg G. Brester (aka sebres) -# +# # See the file "license.terms" for information on usage and redistribution # of this file. -# +# array set in {-time 500} if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} { @@ -215,7 +215,7 @@ proc test-freescan {{reptime 1000}} { {clock scan "next January" -base 0 -gmt 1} # FreeScan : relative week {clock scan "next Fri" -base 0 -gmt 1} - # FreeScan : relative weekday and week offset + # FreeScan : relative weekday and week offset {clock scan "next January + 2 week" -base 0 -gmt 1} # FreeScan : time only with base {clock scan "19:18:30" -base 148863600 -gmt 1} @@ -300,7 +300,7 @@ proc test-convert {{reptime 1000}} { {clock format [clock scan "19:18:30 EST" -base 148863600] -format "%H:%M:%S %z" -timezone EST} # Format locale 1x: comparison values - {clock format 0 -gmt 1 -locale en} + {clock format 0 -gmt 1 -locale en} {clock format 0 -gmt 1 -locale de} {clock format 0 -gmt 1 -locale fr} # Format locale 2x: without switching locale (en, en) @@ -340,7 +340,7 @@ proc test-convert {{reptime 1000}} { {clock scan "19:18:30 MST" -base 148863600; clock scan "19:18:30 EST" -base 148863600} # FreeScan TZ 2x (+1 gmt, +1 system-default) {clock scan "19:18:30 MST" -base 148863600 -gmt 1; clock scan "19:18:30 EST" -base 148863600} - + # Scan TZ: comparison included in scan string vs. given {clock scan "2009-06-30T18:30:00 CEST" -format "%Y-%m-%dT%H:%M:%S %z"} {clock scan "2009-06-30T18:30:00 CET" -format "%Y-%m-%dT%H:%M:%S %z"} -- cgit v0.12 From a68e4219149a933c804fbd0e1be9c2fb89fb2fdb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 18 Feb 2021 14:19:34 +0000 Subject: tweak error-messages --- generic/tclClock.c | 8 ++++---- generic/tclClockFmt.c | 2 +- tests/clock.test | 16 ++++++++-------- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 4a6f16e..237bdcd 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -3496,7 +3496,7 @@ baseNow: badOptionMsg: Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad option \"%s\": should be \"%s\"", + "bad option \"%s\": must be \"%s\"", TclGetString(objv[i]), syntax) ); @@ -3560,7 +3560,7 @@ ClockFormatObjCmd( ClockInitFmtScnArgs(clientData, interp, &opts); ret = ClockParseFmtScnArgs(&opts, &dateFmt.date, objc, objv, - CLC_FMT_ARGS, syntax); + CLC_FMT_ARGS, "-format, -gmt, -locale, or -timezone"); if (ret != TCL_OK) { goto done; } @@ -3637,7 +3637,7 @@ ClockScanObjCmd( ClockInitFmtScnArgs(clientData, interp, &opts); ret = ClockParseFmtScnArgs(&opts, &yy.date, objc, objv, - CLC_SCN_ARGS, syntax); + CLC_SCN_ARGS, "-base, -format, -gmt, -locale, -timezone or -validate"); if (ret != TCL_OK) { goto done; } @@ -3742,7 +3742,7 @@ ClockScanCommit( + ((double)yySecondOfDay - SECONDS_PER_DAY/2) / SECONDS_PER_DAY; if (curJDN > dataPtr->maxJDN) { Tcl_SetObjResult(opts->interp, Tcl_NewStringObj( - "requested date too large to represent", -1)); + "integer value too large to represent", -1)); Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL); return TCL_ERROR; } diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 207cdbf..58bd724 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -2521,7 +2521,7 @@ ClockScan( overflow: - Tcl_SetObjResult(opts->interp, Tcl_NewStringObj("requested date too large to represent", + Tcl_SetObjResult(opts->interp, Tcl_NewStringObj("integer value too large to represent", -1)); Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL); goto done; diff --git a/tests/clock.test b/tests/clock.test index f062c15..c5fb354 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -332,11 +332,11 @@ test clock-1.3 "clock format - empty val" { test clock-1.4 "clock format - bad flag" { # range error message for possible extensions: list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode -} [subst {1 {bad option "-oops": should be "$syntax"} {CLOCK badOption -oops}}] +} [subst {1 {bad option "-oops": must be "-format, -gmt, -locale, or -timezone"} {CLOCK badOption -oops}}] test clock-1.4.1 "clock format - unexpected option for this sub-command" { # range error message for possible extensions: list [catch {clock format 0 -base 0} msg] $msg $::errorCode -} [subst {1 {bad option "-base": should be "$syntax"} {CLOCK badOption -base}}] +} [subst {1 {bad option "-base": must be "-format, -gmt, -locale, or -timezone"} {CLOCK badOption -base}}] test clock-1.5 "clock format - bad timezone" { list [catch {clock format 0 -format "%s" -timezone :NOWHERE} msg] $msg $::errorCode @@ -18683,11 +18683,11 @@ test clock-6.8 {input of seconds} { test clock-6.9 {input of seconds - overflow} { list [catch {clock scan -9223372036854775809 -format %s -gmt true} result] $result $::errorCode -} {1 {requested date too large to represent} {CLOCK dateTooLarge}} +} {1 {integer value too large to represent} {CLOCK dateTooLarge}} test clock-6.10 {input of seconds - overflow} { list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result $::errorCode -} {1 {requested date too large to represent} {CLOCK dateTooLarge}} +} {1 {integer value too large to represent} {CLOCK dateTooLarge}} test clock-6.11 {input of seconds - two values} { clock scan {1 2} -format {%s %s} -gmt true @@ -18917,13 +18917,13 @@ test clock-7.6 {Julian Day, overflow} { list [catch { clock scan 5373485 -format %J } result] $result $errorCode -} {1 {requested date too large to represent} {CLOCK dateTooLarge}} +} {1 {integer value too large to represent} {CLOCK dateTooLarge}} test clock-7.7 {Julian Day, overflow} { list [catch { clock scan 2147483648 -format %J } result] $result $errorCode -} {1 {requested date too large to represent} {CLOCK dateTooLarge}} +} {1 {integer value too large to represent} {CLOCK dateTooLarge}} test clock-7.8 {Julian Day, precedence below seconds} { list [clock scan {2440588 86400} -format {%J %s} -gmt true] \ @@ -18997,7 +18997,7 @@ test clock-7.16 {Astronomical JDN/JD, overflow} { [catch { clock scan 2147483648.5 -format %Ej } result] $result $errorCode -} [lrepeat 4 1 {requested date too large to represent} {CLOCK dateTooLarge}] +} [lrepeat 4 1 {integer value too large to represent} {CLOCK dateTooLarge}] test clock-7.18 {Astronomical JDN/JD, same precedence as seconds (last wins} { list [clock scan {2440588 86400} -format {%Ej %s} -gmt true] \ @@ -36150,7 +36150,7 @@ test clock-34.8 {clock scan tests} { } {Oct 23,1992 15:00 GMT} test clock-34.9 {clock scan tests} { list [catch {clock scan "Jan 12" -bad arg} msg] $msg -} [subst {1 {bad option "-bad": should be "$syntax"}}] +} [subst {1 {bad option "-bad": must be "-base, -format, -gmt, -locale, -timezone or -validate"}}] # The following two two tests test the two year date policy test clock-34.10 {clock scan tests} { set time [clock scan "1/1/71" -gmt true] -- cgit v0.12 From 16cde18103eeee3ef09dae361facb5de33bc3acc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 18 Feb 2021 14:25:46 +0000 Subject: tweak error-messages a little more (no quotes here) --- generic/tclClock.c | 2 +- tests/clock.test | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 237bdcd..1f41b06 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -3496,7 +3496,7 @@ baseNow: badOptionMsg: Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad option \"%s\": must be \"%s\"", + "bad option \"%s\": must be %s", TclGetString(objv[i]), syntax) ); diff --git a/tests/clock.test b/tests/clock.test index c5fb354..5c788e7 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -332,11 +332,11 @@ test clock-1.3 "clock format - empty val" { test clock-1.4 "clock format - bad flag" { # range error message for possible extensions: list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode -} [subst {1 {bad option "-oops": must be "-format, -gmt, -locale, or -timezone"} {CLOCK badOption -oops}}] +} [subst {1 {bad option "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badOption -oops}}] test clock-1.4.1 "clock format - unexpected option for this sub-command" { # range error message for possible extensions: list [catch {clock format 0 -base 0} msg] $msg $::errorCode -} [subst {1 {bad option "-base": must be "-format, -gmt, -locale, or -timezone"} {CLOCK badOption -base}}] +} [subst {1 {bad option "-base": must be -format, -gmt, -locale, or -timezone} {CLOCK badOption -base}}] test clock-1.5 "clock format - bad timezone" { list [catch {clock format 0 -format "%s" -timezone :NOWHERE} msg] $msg $::errorCode @@ -36150,7 +36150,7 @@ test clock-34.8 {clock scan tests} { } {Oct 23,1992 15:00 GMT} test clock-34.9 {clock scan tests} { list [catch {clock scan "Jan 12" -bad arg} msg] $msg -} [subst {1 {bad option "-bad": must be "-base, -format, -gmt, -locale, -timezone or -validate"}}] +} [subst {1 {bad option "-bad": must be -base, -format, -gmt, -locale, -timezone or -validate}}] # The following two two tests test the two year date policy test clock-34.10 {clock scan tests} { set time [clock scan "1/1/71" -gmt true] -- cgit v0.12 From c723b685c95a53e925b3b55ff4de8a0793ec26e2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 18 Feb 2021 14:32:52 +0000 Subject: One more error-message tweak --- generic/tclClock.c | 2 +- tests/clock.test | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 1f41b06..6a046e2 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -3742,7 +3742,7 @@ ClockScanCommit( + ((double)yySecondOfDay - SECONDS_PER_DAY/2) / SECONDS_PER_DAY; if (curJDN > dataPtr->maxJDN) { Tcl_SetObjResult(opts->interp, Tcl_NewStringObj( - "integer value too large to represent", -1)); + "requested date too large to represent", -1)); Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL); return TCL_ERROR; } diff --git a/tests/clock.test b/tests/clock.test index 5c788e7..5183b28 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18917,13 +18917,13 @@ test clock-7.6 {Julian Day, overflow} { list [catch { clock scan 5373485 -format %J } result] $result $errorCode -} {1 {integer value too large to represent} {CLOCK dateTooLarge}} +} {1 {requested date too large to represent} {CLOCK dateTooLarge}} test clock-7.7 {Julian Day, overflow} { list [catch { clock scan 2147483648 -format %J } result] $result $errorCode -} {1 {integer value too large to represent} {CLOCK dateTooLarge}} +} {1 {requested date too large to represent} {CLOCK dateTooLarge}} test clock-7.8 {Julian Day, precedence below seconds} { list [clock scan {2440588 86400} -format {%J %s} -gmt true] \ @@ -18997,7 +18997,7 @@ test clock-7.16 {Astronomical JDN/JD, overflow} { [catch { clock scan 2147483648.5 -format %Ej } result] $result $errorCode -} [lrepeat 4 1 {integer value too large to represent} {CLOCK dateTooLarge}] +} [lrepeat 4 1 {requested date too large to represent} {CLOCK dateTooLarge}] test clock-7.18 {Astronomical JDN/JD, same precedence as seconds (last wins} { list [clock scan {2440588 86400} -format {%Ej %s} -gmt true] \ -- cgit v0.12 From 3596c610aa00c36454c971d84c8243f48f62fba4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 19 Feb 2021 09:25:40 +0000 Subject: Fix various compiler warnings --- generic/tclClock.c | 57 ++++++++++---------- generic/tclClockFmt.c | 135 ++++++++++++++++++++++++++---------------------- generic/tclStrIdxTree.c | 8 +-- tests/clock.test | 6 +-- 4 files changed, 107 insertions(+), 99 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 6a046e2..bc1c33c 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -126,19 +126,19 @@ static int ClockScanObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ClockScanCommit( - register DateInfo *info, - register ClockFmtScnCmdArgs *opts); + DateInfo *info, + ClockFmtScnCmdArgs *opts); static int ClockFreeScan( - register DateInfo *info, + DateInfo *info, Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts); static int ClockCalcRelTime( - register DateInfo *info, ClockFmtScnCmdArgs *opts); + DateInfo *info); static int ClockAddObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int ClockValidDate( - register DateInfo *, - register ClockFmtScnCmdArgs *, int stage); + DateInfo *, + ClockFmtScnCmdArgs *, int stage); static struct tm * ThreadSafeLocalTime(const time_t *); static size_t TzsetIfNecessary(void); static void ClockDeleteCmdProc(ClientData); @@ -3241,7 +3241,7 @@ ClockMicrosecondsObjCmd( { (void)clientData; if (objc != 1) { - Tcl_WrongNumArgs(interp, 0, NULL, "clock microseconds"); + Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds())); @@ -3283,7 +3283,6 @@ ClockInitFmtScnArgs( static int ClockParseFmtScnArgs( - register ClockFmtScnCmdArgs *opts, /* Result vector: format, locale, timezone... */ TclDateFields *date, /* Extracted date-time corresponding base * (by scan or add) resp. clockval (by format) */ @@ -3420,7 +3419,7 @@ ClockParseFmtScnArgs( /* Base (by scan or add) or clock value (by format) */ if (opts->baseObj != NULL) { - register Tcl_Obj *baseObj = opts->baseObj; + Tcl_Obj *baseObj = opts->baseObj; /* bypass integer recognition if looks like option "-now" */ if ( (baseObj->length == 4 && baseObj->bytes && *(baseObj->bytes+1) == 'n') || @@ -3537,7 +3536,7 @@ ClockFormatObjCmd( { ClockClientData *dataPtr = (ClockClientData *)clientData; - static const char *syntax = "clock format clockval|-now " + static const char *syntax = "clockval|-now " "?-format string? " "?-gmt boolean? " "?-locale LOCALE? ?-timezone ZONE?"; @@ -3547,7 +3546,7 @@ ClockFormatObjCmd( /* even number of arguments */ if ((objc & 1) == 1) { - Tcl_WrongNumArgs(interp, 0, NULL, syntax); + Tcl_WrongNumArgs(interp, 1, objv, syntax); Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); return TCL_ERROR; } @@ -3612,7 +3611,7 @@ ClockScanObjCmd( int objc, /* Parameter count */ Tcl_Obj *const objv[]) /* Parameter values */ { - static const char *syntax = "clock scan string " + static const char *syntax = "string " "?-base seconds? " "?-format string? " "?-gmt boolean? " @@ -3624,7 +3623,7 @@ ClockScanObjCmd( /* even number of arguments */ if ((objc & 1) == 1) { - Tcl_WrongNumArgs(interp, 0, NULL, syntax); + Tcl_WrongNumArgs(interp, 1, objv, syntax); Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); return TCL_ERROR; } @@ -3713,8 +3712,7 @@ done: static int ClockScanCommit( - register DateInfo *info, /* Clock scan info structure */ - register + DateInfo *info, /* Clock scan info structure */ ClockFmtScnCmdArgs *opts) /* Format, locale, timezone and base */ { /* If needed assemble julianDay using year, month, etc. */ @@ -3788,8 +3786,7 @@ ClockScanCommit( static int ClockValidDate( - register DateInfo *info, /* Clock scan info structure */ - register + DateInfo *info, /* Clock scan info structure */ ClockFmtScnCmdArgs *opts, /* Scan options */ int stage) /* Stage to validate (1, 2 or 3 for both) */ { @@ -3950,7 +3947,6 @@ ClockValidDate( int ClockFreeScan( - register DateInfo *info, /* Date fields used for parsing & converting * simultaneously a yy-parse structure of the * TclClockFreeScan */ @@ -4064,7 +4060,7 @@ ClockFreeScan( * Do relative times */ - ret = ClockCalcRelTime(info, opts); + ret = ClockCalcRelTime(info); /* Free scanning completed - date ready */ @@ -4089,9 +4085,7 @@ done: */ int ClockCalcRelTime( - register - DateInfo *info, /* Date fields used for converting */ - ClockFmtScnCmdArgs *opts) /* Command options */ + DateInfo *info) /* Date fields used for converting */ { int prevDayOfWeek = yyDayOfWeek; /* preserve unchanged day of week */ @@ -4264,10 +4258,10 @@ repeat_rel: static inline int ClockWeekdaysOffs( - register int dayOfWeek, - register int offs) + int dayOfWeek, + int offs) { - register int weeks, resDayOfWeek; + int weeks, resDayOfWeek; /* offset in days */ weeks = offs / 5; @@ -4281,7 +4275,7 @@ ClockWeekdaysOffs( /* resulting day of week */ { - register int day = (offs % 7); + int day = (offs % 7); /* compiler fix for negative offs - wrap (0, -1) -> (-1, 6) */ if (day < 0) { day = 7 + day; @@ -4354,7 +4348,7 @@ ClockAddObjCmd( int objc, /* Parameter count */ Tcl_Obj *const objv[]) /* Parameter values */ { - static const char *syntax = "clock add clockval|-now ?number units?..." + static const char *syntax = "clockval|-now ?number units?..." "?-gmt boolean? " "?-locale LOCALE? ?-timezone ZONE?"; ClockClientData *dataPtr = (ClockClientData *)clientData; @@ -4381,7 +4375,7 @@ ClockAddObjCmd( /* even number of arguments */ if ((objc & 1) == 1) { - Tcl_WrongNumArgs(interp, 0, NULL, syntax); + Tcl_WrongNumArgs(interp, 1, objv, syntax); Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); return TCL_ERROR; } @@ -4443,7 +4437,7 @@ ClockAddObjCmd( || yySeconds + yyRelSeconds < 0 ) ) { - if (ClockCalcRelTime(info, &opts) != TCL_OK) { + if (ClockCalcRelTime(info) != TCL_OK) { goto done; } } @@ -4487,7 +4481,7 @@ ClockAddObjCmd( */ if (info->flags & CLF_RELCONV) { - if (ClockCalcRelTime(info, &opts) != TCL_OK) { + if (ClockCalcRelTime(info) != TCL_OK) { goto done; } } @@ -4558,7 +4552,7 @@ ClockSecondsObjCmd( */ int ClockSafeCatchCmd( - ClientData clientData, + ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) @@ -4579,6 +4573,7 @@ ClockSafeCatchCmd( Interp *iPtr = (Interp *)interp; int ret, flags = 0; InterpState *statePtr; + (void)dummy; if (objc == 1) { /* wrong # args : */ diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 58bd724..9d66ad7 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -955,7 +955,7 @@ FindTokenBegin( */ static void -DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts, +DetermineGreedySearchLen( DateInfo *info, ClockScanToken *tok, int *minLenPtr, int *maxLenPtr) { @@ -1054,7 +1054,7 @@ DetermineGreedySearchLen(ClockFmtScnCmdArgs *opts, */ static inline int -ObjListSearch(ClockFmtScnCmdArgs *opts, +ObjListSearch( DateInfo *info, int *val, Tcl_Obj **lstv, int lstc, int minLen, int maxLen) @@ -1121,7 +1121,7 @@ LocaleListSearch(ClockFmtScnCmdArgs *opts, } /* search in list */ - return ObjListSearch(opts, info, val, lstv, lstc, + return ObjListSearch(info, val, lstv, lstc, minLen, maxLen); } #endif @@ -1294,7 +1294,7 @@ done: */ static inline int -ClockStrIdxTreeSearch(ClockFmtScnCmdArgs *opts, +ClockStrIdxTreeSearch( DateInfo *info, TclStrIdxTree *idxTree, int *val, int minLen, int maxLen) { @@ -1398,7 +1398,7 @@ ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts, int minLen, maxLen; TclStrIdxTree *idxTree; - DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + DetermineGreedySearchLen(info, tok, &minLen, &maxLen); /* get or create tree in msgcat dict */ @@ -1407,7 +1407,7 @@ ClockScnToken_Month_Proc(ClockFmtScnCmdArgs *opts, return TCL_ERROR; } - ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); + ret = ClockStrIdxTreeSearch(info, idxTree, &val, minLen, maxLen); if (ret != TCL_OK) { return ret; } @@ -1428,7 +1428,7 @@ ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts, char curTok = *tok->tokWord.start; TclStrIdxTree *idxTree; - DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + DetermineGreedySearchLen(info, tok, &minLen, &maxLen); /* %u %w %Ou %Ow */ if ( curTok != 'a' && curTok != 'A' @@ -1447,7 +1447,7 @@ ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts, return TCL_ERROR; } - ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); + ret = ClockStrIdxTreeSearch(info, idxTree, &val, minLen, maxLen); if (ret != TCL_OK) { return ret; } @@ -1478,7 +1478,7 @@ ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts, return TCL_ERROR; } - ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); + ret = ClockStrIdxTreeSearch(info, idxTree, &val, minLen, maxLen); if (ret != TCL_OK) { return ret; } @@ -1500,7 +1500,7 @@ ClockScnToken_amPmInd_Proc(ClockFmtScnCmdArgs *opts, int minLen, maxLen; Tcl_Obj *amPmObj[2]; - DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + DetermineGreedySearchLen(info, tok, &minLen, &maxLen); amPmObj[0] = ClockMCGet(opts, MCLIT_AM); amPmObj[1] = ClockMCGet(opts, MCLIT_PM); @@ -1509,7 +1509,7 @@ ClockScnToken_amPmInd_Proc(ClockFmtScnCmdArgs *opts, return TCL_ERROR; } - ret = ObjListSearch(opts, info, &val, amPmObj, 2, + ret = ObjListSearch(info, &val, amPmObj, 2, minLen, maxLen); if (ret != TCL_OK) { return ret; @@ -1534,7 +1534,7 @@ ClockScnToken_LocaleERA_Proc(ClockFmtScnCmdArgs *opts, int minLen, maxLen; Tcl_Obj *eraObj[6]; - DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + DetermineGreedySearchLen(info, tok, &minLen, &maxLen); eraObj[0] = ClockMCGet(opts, MCLIT_BCE); eraObj[1] = ClockMCGet(opts, MCLIT_CE); @@ -1547,7 +1547,7 @@ ClockScnToken_LocaleERA_Proc(ClockFmtScnCmdArgs *opts, return TCL_ERROR; } - ret = ObjListSearch(opts, info, &val, eraObj, 6, + ret = ObjListSearch(info, &val, eraObj, 6, minLen, maxLen); if (ret != TCL_OK) { return ret; @@ -1570,7 +1570,7 @@ ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, int minLen, maxLen; TclStrIdxTree *idxTree; - DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + DetermineGreedySearchLen(info, tok, &minLen, &maxLen); /* get or create tree in msgcat dict */ @@ -1579,7 +1579,7 @@ ClockScnToken_LocaleListMatcher_Proc(ClockFmtScnCmdArgs *opts, return TCL_ERROR; } - ret = ClockStrIdxTreeSearch(opts, info, idxTree, &val, minLen, maxLen); + ret = ClockStrIdxTreeSearch(info, idxTree, &val, minLen, maxLen); if (ret != TCL_OK) { return ret; } @@ -1598,8 +1598,9 @@ ClockScnToken_JDN_Proc(ClockFmtScnCmdArgs *opts, int minLen, maxLen; const char *p = yyInput, *end; const char *s; Tcl_WideInt intJD; int fractJD = 0, fractJDDiv = 1; + (void)opts; - DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + DetermineGreedySearchLen(info, tok, &minLen, &maxLen); end = yyInput + maxLen; @@ -1666,7 +1667,7 @@ ClockScnToken_TimeZone_Proc(ClockFmtScnCmdArgs *opts, const char *p = yyInput; Tcl_Obj *tzObjStor = NULL; - DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + DetermineGreedySearchLen(info, tok, &minLen, &maxLen); /* numeric timezone */ if (*p == '+' || *p == '-') { @@ -1745,8 +1746,9 @@ ClockScnToken_StarDate_Proc(ClockFmtScnCmdArgs *opts, const char *p = yyInput, *end; const char *s; int year, fractYear, fractDayDiv, fractDay; static const char *stardatePref = "stardate "; + (void)opts; - DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); + DetermineGreedySearchLen(info, tok, &minLen, &maxLen); end = yyInput + maxLen; @@ -1820,49 +1822,49 @@ static const char *ScnSTokenMapIndex = static ClockScanTokenMap ScnSTokenMap[] = { /* %d %e */ {CTOKT_INT, CLF_DAYOFMONTH, 0, 1, 2, TclOffset(DateInfo, date.dayOfMonth), - NULL}, + NULL, NULL}, /* %m %N */ {CTOKT_INT, CLF_MONTH, 0, 1, 2, TclOffset(DateInfo, date.month), - NULL}, + NULL, NULL}, /* %b %B %h */ {CTOKT_PARSER, CLF_MONTH, 0, 0, 0xffff, 0, - ClockScnToken_Month_Proc}, + ClockScnToken_Month_Proc, NULL}, /* %y */ {CTOKT_INT, CLF_YEAR, 0, 1, 2, TclOffset(DateInfo, date.year), - NULL}, + NULL, NULL}, /* %Y */ {CTOKT_INT, CLF_YEAR | CLF_CENTURY, 0, 4, 4, TclOffset(DateInfo, date.year), - NULL}, + NULL, NULL}, /* %H %k %I %l */ {CTOKT_INT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.hour), - NULL}, + NULL, NULL}, /* %M */ {CTOKT_INT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.minutes), - NULL}, + NULL, NULL}, /* %S */ {CTOKT_INT, CLF_TIME, 0, 1, 2, TclOffset(DateInfo, date.secondOfMin), - NULL}, + NULL, NULL}, /* %p %P */ {CTOKT_PARSER, 0, 0, 0, 0xffff, 0, ClockScnToken_amPmInd_Proc, NULL}, /* %J */ {CTOKT_WIDE, CLF_JULIANDAY | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.julianDay), - NULL}, + NULL, NULL}, /* %j */ {CTOKT_INT, CLF_DAYOFYEAR, 0, 1, 3, TclOffset(DateInfo, date.dayOfYear), - NULL}, + NULL, NULL}, /* %C */ {CTOKT_INT, CLF_CENTURY|CLF_ISO8601CENTURY, 0, 1, 2, TclOffset(DateInfo, dateCentury), - NULL}, + NULL, NULL}, /* %g */ {CTOKT_INT, CLF_ISO8601YEAR, 0, 2, 2, TclOffset(DateInfo, date.iso8601Year), - NULL}, + NULL, NULL}, /* %G */ {CTOKT_INT, CLF_ISO8601YEAR | CLF_ISO8601CENTURY, 0, 4, 4, TclOffset(DateInfo, date.iso8601Year), - NULL}, + NULL, NULL}, /* %V */ {CTOKT_INT, CLF_ISO8601WEAK, 0, 1, 2, TclOffset(DateInfo, date.iso8601Week), - NULL}, + NULL, NULL}, /* %a %A %u %w */ {CTOKT_PARSER, CLF_DAYOFWEEK, 0, 0, 0xffff, 0, ClockScnToken_DayOfWeek_Proc, NULL}, @@ -1871,10 +1873,10 @@ static ClockScanTokenMap ScnSTokenMap[] = { ClockScnToken_TimeZone_Proc, NULL}, /* %U %W */ {CTOKT_INT, CLF_OPTIONAL, 0, 1, 2, 0, /* currently no capture, parse only token */ - NULL}, + NULL, NULL}, /* %s */ {CTOKT_WIDE, CLF_POSIXSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.seconds), - NULL}, + NULL, NULL}, /* %n */ {CTOKT_CHAR, 0, 0, 1, 1, 0, NULL, "\n"}, /* %t */ @@ -1905,7 +1907,7 @@ static ClockScanTokenMap ScnETokenMap[] = { ClockScnToken_LocaleListMatcher_Proc, (void *)MCLIT_LOCALE_NUMERALS}, /* %Es */ {CTOKT_WIDE, CLF_LOCALSEC | CLF_SIGNED, 0, 1, 0xffff, TclOffset(DateInfo, date.localSeconds), - NULL}, + NULL, NULL}, }; static const char *ScnETokenMapAliasIndex[2] = { "", @@ -1945,12 +1947,12 @@ static const char *ScnOTokenMapAliasIndex[2] = { /* Token map reserved for CTOKT_SPACE */ static ClockScanTokenMap ScnSpaceTokenMap = { CTOKT_SPACE, 0, 0, 1, 1, 0, - NULL, + NULL, NULL }; static ClockScanTokenMap ScnWordTokenMap = { CTOKT_WORD, 0, 0, 1, 1, 0, - NULL + NULL, NULL }; @@ -2283,7 +2285,7 @@ ClockScan( if (*p == '-') { yyInput = ++p; sign = -1; }; } - DetermineGreedySearchLen(opts, info, tok, &minLen, &size); + DetermineGreedySearchLen(info, tok, &minLen, &size); if (size < map->minSize) { /* missing input -> error */ @@ -2587,6 +2589,10 @@ ClockFmtToken_HourAMPM_Proc( ClockFormatToken *tok, int *val) { + (void)opts; + (void)dateFmt; + (void)tok; + *val = ( ( *val + SECONDS_PER_DAY - 3600 ) / 3600 ) % 12 + 1; return TCL_OK; } @@ -2631,6 +2637,9 @@ ClockFmtToken_StarDate_Proc( int fractYear; /* Get day of year, zero based */ int v = dateFmt->date.dayOfYear - 1; + (void)opts; + (void)tok; + (void)val; /* Convert day of year to a fractional year */ if (IsGregorianLeapYear(&dateFmt->date)) { @@ -2663,6 +2672,8 @@ ClockFmtToken_WeekOfYear_Proc( int *val) { int dow = dateFmt->date.dayOfWeek; + (void)opts; + if (*tok->tokWord.start == 'U') { if (dow == 7) { dow = 0; @@ -2681,6 +2692,8 @@ ClockFmtToken_JDN_Proc( { Tcl_WideInt intJD = dateFmt->date.julianDay; int fractJD; + (void)opts; + (void)val; /* Convert to JDN parts (regarding start offset) and time fraction */ fractJD = dateFmt->date.secondOfDay @@ -2896,13 +2909,13 @@ static const char *FmtSTokenMapIndex = "demNbByYCHMSIklpaAuwUVzgGjJsntQ"; static ClockFormatTokenMap FmtSTokenMap[] = { /* %d */ - {CTOKT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL}, + {CTOKT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL, NULL}, /* %e */ - {CTOKT_INT, " ", 2, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL}, + {CTOKT_INT, " ", 2, 0, 0, 0, TclOffset(DateFormat, date.dayOfMonth), NULL, NULL}, /* %m */ - {CTOKT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.month), NULL}, + {CTOKT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.month), NULL, NULL}, /* %N */ - {CTOKT_INT, " ", 2, 0, 0, 0, TclOffset(DateFormat, date.month), NULL}, + {CTOKT_INT, " ", 2, 0, 0, 0, TclOffset(DateFormat, date.month), NULL, NULL}, /* %b %h */ {CTOKT_INT, NULL, 0, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month), NULL, (void *)MCLIT_MONTHS_ABBREV}, @@ -2910,22 +2923,22 @@ static ClockFormatTokenMap FmtSTokenMap[] = { {CTOKT_INT, NULL, 0, CLFMT_LOCALE_INDX | CLFMT_DECR, 0, 12, TclOffset(DateFormat, date.month), NULL, (void *)MCLIT_MONTHS_FULL}, /* %y */ - {CTOKT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.year), NULL}, + {CTOKT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.year), NULL, NULL}, /* %Y */ - {CTOKT_INT, "0", 4, 0, 0, 0, TclOffset(DateFormat, date.year), NULL}, + {CTOKT_INT, "0", 4, 0, 0, 0, TclOffset(DateFormat, date.year), NULL, NULL}, /* %C */ - {CTOKT_INT, "0", 2, 0, 100, 0, TclOffset(DateFormat, date.year), NULL}, + {CTOKT_INT, "0", 2, 0, 100, 0, TclOffset(DateFormat, date.year), NULL, NULL}, /* %H */ - {CTOKT_INT, "0", 2, 0, 3600, 24, TclOffset(DateFormat, date.secondOfDay), NULL}, + {CTOKT_INT, "0", 2, 0, 3600, 24, TclOffset(DateFormat, date.secondOfDay), NULL, NULL}, /* %M */ - {CTOKT_INT, "0", 2, 0, 60, 60, TclOffset(DateFormat, date.secondOfDay), NULL}, + {CTOKT_INT, "0", 2, 0, 60, 60, TclOffset(DateFormat, date.secondOfDay), NULL, NULL}, /* %S */ - {CTOKT_INT, "0", 2, 0, 0, 60, TclOffset(DateFormat, date.secondOfDay), NULL}, + {CTOKT_INT, "0", 2, 0, 0, 60, TclOffset(DateFormat, date.secondOfDay), NULL, NULL}, /* %I */ {CTOKT_INT, "0", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.secondOfDay), ClockFmtToken_HourAMPM_Proc, NULL}, /* %k */ - {CTOKT_INT, " ", 2, 0, 3600, 24, TclOffset(DateFormat, date.secondOfDay), NULL}, + {CTOKT_INT, " ", 2, 0, 3600, 24, TclOffset(DateFormat, date.secondOfDay), NULL, NULL}, /* %l */ {CTOKT_INT, " ", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.secondOfDay), ClockFmtToken_HourAMPM_Proc, NULL}, @@ -2939,31 +2952,31 @@ static ClockFormatTokenMap FmtSTokenMap[] = { {CTOKT_INT, NULL, 0, CLFMT_LOCALE_INDX, 0, 7, TclOffset(DateFormat, date.dayOfWeek), NULL, (void *)MCLIT_DAYS_OF_WEEK_FULL}, /* %u */ - {CTOKT_INT, " ", 1, 0, 0, 0, TclOffset(DateFormat, date.dayOfWeek), NULL}, + {CTOKT_INT, " ", 1, 0, 0, 0, TclOffset(DateFormat, date.dayOfWeek), NULL, NULL}, /* %w */ - {CTOKT_INT, " ", 1, 0, 0, 7, TclOffset(DateFormat, date.dayOfWeek), NULL}, + {CTOKT_INT, " ", 1, 0, 0, 7, TclOffset(DateFormat, date.dayOfWeek), NULL, NULL}, /* %U %W */ {CTOKT_INT, "0", 2, CLFMT_CALC, 0, 0, TclOffset(DateFormat, date.dayOfYear), ClockFmtToken_WeekOfYear_Proc, NULL}, /* %V */ - {CTOKT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.iso8601Week), NULL}, + {CTOKT_INT, "0", 2, 0, 0, 0, TclOffset(DateFormat, date.iso8601Week), NULL, NULL}, /* %z %Z */ {CFMTT_PROC, NULL, 0, 0, 0, 0, 0, ClockFmtToken_TimeZone_Proc, NULL}, /* %g */ - {CTOKT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.iso8601Year), NULL}, + {CTOKT_INT, "0", 2, 0, 0, 100, TclOffset(DateFormat, date.iso8601Year), NULL, NULL}, /* %G */ - {CTOKT_INT, "0", 4, 0, 0, 0, TclOffset(DateFormat, date.iso8601Year), NULL}, + {CTOKT_INT, "0", 4, 0, 0, 0, TclOffset(DateFormat, date.iso8601Year), NULL, NULL}, /* %j */ - {CTOKT_INT, "0", 3, 0, 0, 0, TclOffset(DateFormat, date.dayOfYear), NULL}, + {CTOKT_INT, "0", 3, 0, 0, 0, TclOffset(DateFormat, date.dayOfYear), NULL, NULL}, /* %J */ - {CTOKT_WIDE, "0", 7, 0, 0, 0, TclOffset(DateFormat, date.julianDay), NULL}, + {CTOKT_WIDE, "0", 7, 0, 0, 0, TclOffset(DateFormat, date.julianDay), NULL, NULL}, /* %s */ - {CTOKT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.seconds), NULL}, + {CTOKT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.seconds), NULL, NULL}, /* %n */ - {CTOKT_CHAR, "\n", 0, 0, 0, 0, 0, NULL}, + {CTOKT_CHAR, "\n", 0, 0, 0, 0, 0, NULL, NULL}, /* %t */ - {CTOKT_CHAR, "\t", 0, 0, 0, 0, 0, NULL}, + {CTOKT_CHAR, "\t", 0, 0, 0, 0, 0, NULL, NULL}, /* %Q */ {CFMTT_PROC, NULL, 0, 0, 0, 0, 0, ClockFmtToken_StarDate_Proc, NULL}, @@ -2989,7 +3002,7 @@ static ClockFormatTokenMap FmtETokenMap[] = { {CTOKT_INT, NULL, 0, 0, 0, 0, TclOffset(DateFormat, date.year), ClockFmtToken_LocaleERAYear_Proc, NULL}, /* %Es */ - {CTOKT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.localSeconds), NULL}, + {CTOKT_WIDE, "0", 1, 0, 0, 0, TclOffset(DateFormat, date.localSeconds), NULL, NULL}, }; static const char *FmtETokenMapAliasIndex[2] = { "C", @@ -3033,7 +3046,7 @@ static const char *FmtOTokenMapAliasIndex[2] = { }; static ClockFormatTokenMap FmtWordTokenMap = { - CTOKT_WORD, NULL, 0, 0, 0, 0, 0, NULL + CTOKT_WORD, NULL, 0, 0, 0, 0, 0, NULL, NULL }; /* diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c index 5736d64..4d76217 100644 --- a/generic/tclStrIdxTree.c +++ b/generic/tclStrIdxTree.c @@ -166,8 +166,8 @@ TclStrIdxTreeFree( static inline void TclStrIdxTreeInsertBranch( TclStrIdxTree *parent, - register TclStrIdx *item, - register TclStrIdx *child) + TclStrIdx *item, + TclStrIdx *child) { if (parent->firstPtr == child) parent->firstPtr = item; @@ -187,8 +187,8 @@ TclStrIdxTreeInsertBranch( static inline void TclStrIdxTreeAppend( - register TclStrIdxTree *parent, - register TclStrIdx *item) + TclStrIdxTree *parent, + TclStrIdx *item) { if (parent->lastPtr != NULL) { parent->lastPtr->nextPtr = item; diff --git a/tests/clock.test b/tests/clock.test index 5183b28..02bc9f7 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -308,14 +308,14 @@ test clock-0.2 "initial: loading of format/locale does not overwrite interp stat # Test some of the basics of [clock format] -set syntax "clock format clockval|-now ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?" +set syntax "clockval|-now ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?" test clock-1.0 "clock format - wrong # args" { list [catch {clock format} msg] $msg $::errorCode -} [subst {1 {wrong # args: should be "$syntax"} {CLOCK wrongNumArgs}}] +} [subst {1 {wrong # args: should be "clock format $syntax"} {CLOCK wrongNumArgs}}] test clock-1.0.1 "clock format - wrong # args (compiled ensemble with invalid syntax)" { list [catch {clock format 0 -too-few-options-4-test} msg] $msg $::errorCode -} [subst {1 {wrong # args: should be "$syntax"} {CLOCK wrongNumArgs}}] +} [subst {1 {wrong # args: should be "::tcl::clock::format $syntax"} {CLOCK wrongNumArgs}}] test clock-1.1 "clock format - bad time" { list [catch {clock format foo} msg] $msg -- cgit v0.12 From c15d68cbc421db2f14460026dae66f67276dfff5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 19 Feb 2021 18:00:48 +0000 Subject: Experiment: Remove the "::tcl::clock::getenv" function. --- generic/tclClock.c | 48 ------------------------------------------------ library/clock.tcl | 8 ++++---- 2 files changed, 4 insertions(+), 52 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index e4162ae..24232a2 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -107,9 +107,6 @@ static int ClockGetjuliandayfromerayearmonthdayObjCmd( static int ClockGetjuliandayfromerayearweekdayObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int ClockGetenvObjCmd( - ClientData clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]); static int ClockMicrosecondsObjCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -166,7 +163,6 @@ static const struct ClockCommand clockCommands[] = { {"add", ClockAddObjCmd, TclCompileBasicMin1ArgCmd, NULL}, {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL}, {"format", ClockFormatObjCmd, TclCompileBasicMin1ArgCmd, NULL}, - {"getenv", ClockGetenvObjCmd, TclCompileBasicMin1ArgCmd, NULL}, {"microseconds", ClockMicrosecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(1)}, {"milliseconds", ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(2)}, {"scan", ClockScanObjCmd, TclCompileBasicMin1ArgCmd, NULL}, @@ -3019,50 +3015,6 @@ WeekdayOnOrBefore( /* *---------------------------------------------------------------------- * - * ClockGetenvObjCmd -- - * - * Tcl command that reads an environment variable from the system - * - * Usage: - * ::tcl::clock::getEnv NAME - * - * Parameters: - * NAME - Name of the environment variable desired - * - * Results: - * Returns a standard Tcl result. Returns an error if the variable does - * not exist, with a message left in the interpreter. Returns TCL_OK and - * the value of the variable if the variable does exist, - * - *---------------------------------------------------------------------- - */ - -int -ClockGetenvObjCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - const char *varName; - const char *varValue; - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "name"); - return TCL_ERROR; - } - varName = TclGetString(objv[1]); - varValue = getenv(varName); - if (varValue == NULL) { - varValue = ""; - } - Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1)); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * ThreadSafeLocalTime -- * * Wrapper around the 'localtime' library function to make it thread diff --git a/library/clock.tcl b/library/clock.tcl index 9e340d0..7b492a9 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -905,10 +905,10 @@ proc ::tcl::clock::LocalizeFormat { locale format mcd } { proc ::tcl::clock::GetSystemTimeZone {} { variable TimeZoneBad - if {[set result [getenv TCL_TZ]] ne {}} { - set timezone $result - } elseif {[set result [getenv TZ]] ne {}} { - set timezone $result + if {[info exist ::env(TCL_TZ)]} { + set timezone $::env(TCL_TZ) + } elseif {[info exist ::env(TZ)]} { + set timezone $::env(TZ) } if {![info exists timezone]} { # ask engine for the cached timezone: -- cgit v0.12 From 80922e4b680e89f50b4c75e7e7ea1b891b54ebac Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 22 Feb 2021 08:02:27 +0000 Subject: Give TzsetIfNecessary "interp" argument. --- generic/tclClock.c | 16 ++++++++-------- tests/clock.test | 4 +--- 2 files changed, 9 insertions(+), 11 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index bc1c33c..6fffb31 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -140,7 +140,7 @@ static int ClockValidDate( DateInfo *, ClockFmtScnCmdArgs *, int stage); static struct tm * ThreadSafeLocalTime(const time_t *); -static size_t TzsetIfNecessary(void); +static size_t TzsetIfNecessary(Tcl_Interp *interp); static void ClockDeleteCmdProc(ClientData); static int ClockSafeCatchCmd( @@ -1014,7 +1014,7 @@ ClockConfigureObjCmd( case CLOCK_SYSTEM_TZ: if (1) { /* validate current tz-epoch */ - size_t lastTZEpoch = TzsetIfNecessary(); + size_t lastTZEpoch = TzsetIfNecessary(interp); if (i < objc) { if (dataPtr->systemTimeZone != objv[i]) { Tcl_SetObjRef(dataPtr->systemTimeZone, objv[i]); @@ -1272,7 +1272,7 @@ ClockGetSystemTimeZone( /* if known (cached and same epoch) - return now */ if (dataPtr->systemTimeZone != NULL - && dataPtr->lastTZEpoch == TzsetIfNecessary()) { + && dataPtr->lastTZEpoch == TzsetIfNecessary(interp)) { return dataPtr->systemTimeZone; } @@ -2137,7 +2137,7 @@ ConvertLocalToUTCUsingC( * platforms, so seize a mutex before attempting this. */ - TzsetIfNecessary(); + TzsetIfNecessary(interp); Tcl_MutexLock(&clockMutex); errno = 0; fields->seconds = (Tcl_WideInt) mktime(&timeVal); @@ -2373,7 +2373,7 @@ ConvertUTCToLocalUsingC( Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL); return TCL_ERROR; } - TzsetIfNecessary(); + TzsetIfNecessary(interp); timeVal = ThreadSafeLocalTime(&tock); if (timeVal == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -4628,7 +4628,7 @@ ClockSafeCatchCmd( */ static size_t -TzsetIfNecessary(void) +TzsetIfNecessary(Tcl_Interp *interp) { static char* tzWas = (char *)INT2PTR(-1); /* Previous value of TZ, protected by * clockMutex. */ @@ -4654,9 +4654,9 @@ TzsetIfNecessary(void) /* check in lock */ Tcl_MutexLock(&clockMutex); - tzIsNow = getenv("TCL_TZ"); + tzIsNow = Tcl_GetVar2(interp, "env", "TCL_TZ", TCL_GLOBAL_ONLY); if (tzIsNow == NULL) { - tzIsNow = getenv("TZ"); + tzIsNow = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY); } if (tzIsNow != NULL && (tzWas == NULL || tzWas == (char*)INT2PTR(-1) || strcmp(tzIsNow, tzWas) != 0)) { diff --git a/tests/clock.test b/tests/clock.test index 02bc9f7..641dbf6 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -31,8 +31,6 @@ testConstraint detroit \ [expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}] testConstraint y2038 \ [expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}] -testConstraint no_tclclockmod \ - [expr {[namespace which -command ::tcl::clock::configure] eq {}}] # Test with both validity modes - validate on / off: @@ -276,7 +274,7 @@ proc ::testClock::registry { cmd path key } { # Base test cases: -test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" no_tclclockmod { +test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" { set i [interp create]; # because clock can be used somewhere, test it in new interp: set ret [$i eval { -- cgit v0.12 From f6e9d201d539d7e38ef875e94133bc3708617574 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 22 Feb 2021 13:14:55 +0000 Subject: Fix regression in msvc OPTS=static,msvcrt build. I think I finally got it now. --- generic/tclClock.c | 9 ++++----- library/clock.tcl | 11 +++++------ 2 files changed, 9 insertions(+), 11 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 6fffb31..2cf9eb7 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -3045,7 +3045,7 @@ ClockGetenvObjCmd( Tcl_Obj *const objv[]) { const char *varName; - const char *varValue; + Tcl_Obj *varValue; (void)clientData; if (objc != 2) { @@ -3053,11 +3053,10 @@ ClockGetenvObjCmd( return TCL_ERROR; } varName = TclGetString(objv[1]); - varValue = getenv(varName); - if (varValue == NULL) { - varValue = ""; + varValue = Tcl_GetVar2Ex(interp, "env", varName, TCL_GLOBAL_ONLY); + if (varValue != NULL) { + Tcl_SetObjResult(interp, varValue); } - Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1)); return TCL_OK; } diff --git a/library/clock.tcl b/library/clock.tcl index f06e033..1f1571a 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -905,12 +905,11 @@ proc ::tcl::clock::LocalizeFormat { locale format mcd } { proc ::tcl::clock::GetSystemTimeZone {} { variable TimeZoneBad - if {[set result [getenv TCL_TZ]] ne {}} { - set timezone $result - } elseif {[set result [getenv TZ]] ne {}} { - set timezone $result - } - if {![info exists timezone]} { + if {[info exist ::env(TCL_TZ)]} { + set timezone $::env(TCL_TZ) + } elseif {[info exist ::env(TZ)]} { + set timezone $::env(TZ) + } elseif {![info exists timezone]} { # ask engine for the cached timezone: set timezone [configure -system-tz] if { $timezone ne "" } { -- cgit v0.12 From 3da138a42931159eb283ff3fae50444798c3e4f6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 22 Feb 2021 13:32:44 +0000 Subject: Unneeded if() --- library/clock.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/clock.tcl b/library/clock.tcl index 1f1571a..68dd1c4 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -909,7 +909,7 @@ proc ::tcl::clock::GetSystemTimeZone {} { set timezone $::env(TCL_TZ) } elseif {[info exist ::env(TZ)]} { set timezone $::env(TZ) - } elseif {![info exists timezone]} { + } else { # ask engine for the cached timezone: set timezone [configure -system-tz] if { $timezone ne "" } { -- cgit v0.12 From 6caf32205752b3ee1e08cc4c19db4818dcd38f68 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 22 Feb 2021 15:39:59 +0000 Subject: Better solution for msvc OPTS=static,msvcrt regression: On win32 we cannot thrust the getenv() function, so use _wgetenv() --- generic/tclBasic.c | 4 ++++ generic/tclClock.c | 67 ++++++++++++++++++++++++++++++++++++++---------------- library/clock.tcl | 8 +++---- 3 files changed, 55 insertions(+), 24 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 895d160..2f1819f 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -583,6 +583,10 @@ Tcl_CreateInterp(void) Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; +#ifdef _WIN32 +# define getenv(x) _wgetenv(L##x) /* On Windows, use _wgetenv below */ +#endif + /* TIP #268 */ if (getenv("TCL_PKG_PREFER_LATEST") == NULL) { iPtr->packagePrefer = PKG_PREFER_STABLE; diff --git a/generic/tclClock.c b/generic/tclClock.c index 2cf9eb7..9512b8d 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -140,7 +140,7 @@ static int ClockValidDate( DateInfo *, ClockFmtScnCmdArgs *, int stage); static struct tm * ThreadSafeLocalTime(const time_t *); -static size_t TzsetIfNecessary(Tcl_Interp *interp); +static size_t TzsetIfNecessary(void); static void ClockDeleteCmdProc(ClientData); static int ClockSafeCatchCmd( @@ -1014,7 +1014,7 @@ ClockConfigureObjCmd( case CLOCK_SYSTEM_TZ: if (1) { /* validate current tz-epoch */ - size_t lastTZEpoch = TzsetIfNecessary(interp); + size_t lastTZEpoch = TzsetIfNecessary(); if (i < objc) { if (dataPtr->systemTimeZone != objv[i]) { Tcl_SetObjRef(dataPtr->systemTimeZone, objv[i]); @@ -1272,7 +1272,7 @@ ClockGetSystemTimeZone( /* if known (cached and same epoch) - return now */ if (dataPtr->systemTimeZone != NULL - && dataPtr->lastTZEpoch == TzsetIfNecessary(interp)) { + && dataPtr->lastTZEpoch == TzsetIfNecessary()) { return dataPtr->systemTimeZone; } @@ -2137,7 +2137,7 @@ ConvertLocalToUTCUsingC( * platforms, so seize a mutex before attempting this. */ - TzsetIfNecessary(interp); + TzsetIfNecessary(); Tcl_MutexLock(&clockMutex); errno = 0; fields->seconds = (Tcl_WideInt) mktime(&timeVal); @@ -2373,7 +2373,7 @@ ConvertUTCToLocalUsingC( Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL); return TCL_ERROR; } - TzsetIfNecessary(interp); + TzsetIfNecessary(); timeVal = ThreadSafeLocalTime(&tock); if (timeVal == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -3044,19 +3044,37 @@ ClockGetenvObjCmd( int objc, Tcl_Obj *const objv[]) { +#ifdef _WIN32 + const WCHAR *varName; + const WCHAR *varValue; + Tcl_DString ds; +#else const char *varName; - Tcl_Obj *varValue; + const char *varValue; +#endif (void)clientData; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } +#ifdef _WIN32 + varName = (const WCHAR *)Tcl_WinUtfToTChar(TclGetString(objv[1]), -1, &ds); + varValue = _wgetenv(varName); + Tcl_DStringFree(&ds); + if (varValue == NULL) { + varValue = L""; + } + Tcl_WinTCharToUtf((TCHAR *)varValue, -1, &ds); + Tcl_DStringResult(interp, &ds); +#else varName = TclGetString(objv[1]); - varValue = Tcl_GetVar2Ex(interp, "env", varName, TCL_GLOBAL_ONLY); - if (varValue != NULL) { - Tcl_SetObjResult(interp, varValue); + varValue = getenv(varName); + if (varValue == NULL) { + varValue = ""; } + Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1)); +#endif return TCL_OK; } @@ -4626,16 +4644,25 @@ ClockSafeCatchCmd( *---------------------------------------------------------------------- */ +#ifdef _WIN32 +#define getenv(x) _wgetenv(L##x) +#else +#define WCHAR char +#define wcslen strlen +#define wcscmp strcmp +#define wcscpy strcpy +#endif + static size_t -TzsetIfNecessary(Tcl_Interp *interp) +TzsetIfNecessary(void) { - static char* tzWas = (char *)INT2PTR(-1); /* Previous value of TZ, protected by + static WCHAR* tzWas = (WCHAR *)INT2PTR(-1); /* Previous value of TZ, protected by * clockMutex. */ static long tzLastRefresh = 0; /* Used for latency before next refresh */ static size_t tzWasEpoch = 0; /* Epoch, signals that TZ changed */ static size_t tzEnvEpoch = 0; /* Last env epoch, for faster signaling, that TZ changed via TCL */ - const char *tzIsNow; /* Current value of TZ */ + const WCHAR *tzIsNow; /* Current value of TZ */ /* * Prevent performance regression on some platforms by resolving of system time zone: @@ -4653,22 +4680,22 @@ TzsetIfNecessary(Tcl_Interp *interp) /* check in lock */ Tcl_MutexLock(&clockMutex); - tzIsNow = Tcl_GetVar2(interp, "env", "TCL_TZ", TCL_GLOBAL_ONLY); + tzIsNow = getenv("TCL_TZ"); if (tzIsNow == NULL) { - tzIsNow = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY); + tzIsNow = getenv("TZ"); } - if (tzIsNow != NULL && (tzWas == NULL || tzWas == (char*)INT2PTR(-1) - || strcmp(tzIsNow, tzWas) != 0)) { + if (tzIsNow != NULL && (tzWas == NULL || tzWas == (WCHAR *)INT2PTR(-1) + || wcscmp(tzIsNow, tzWas) != 0)) { tzset(); - if (tzWas != NULL && tzWas != (char*)INT2PTR(-1)) { + if (tzWas != NULL && tzWas != (WCHAR *)INT2PTR(-1)) { ckfree(tzWas); } - tzWas = (char *)ckalloc(strlen(tzIsNow) + 1); - strcpy(tzWas, tzIsNow); + tzWas = (WCHAR *)ckalloc(sizeof(WCHAR) * (wcslen(tzIsNow) + 1)); + wcscpy(tzWas, tzIsNow); tzWasEpoch++; } else if (tzIsNow == NULL && tzWas != NULL) { tzset(); - if (tzWas != (char*)INT2PTR(-1)) ckfree(tzWas); + if (tzWas != (WCHAR *)INT2PTR(-1)) ckfree(tzWas); tzWas = NULL; tzWasEpoch++; } diff --git a/library/clock.tcl b/library/clock.tcl index 68dd1c4..529a4f9 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -905,10 +905,10 @@ proc ::tcl::clock::LocalizeFormat { locale format mcd } { proc ::tcl::clock::GetSystemTimeZone {} { variable TimeZoneBad - if {[info exist ::env(TCL_TZ)]} { - set timezone $::env(TCL_TZ) - } elseif {[info exist ::env(TZ)]} { - set timezone $::env(TZ) + if {[set result [getenv TCL_TZ]] ne {}} { + set timezone $result + } elseif {[set result [getenv TZ]] ne {}} { + set timezone $result } else { # ask engine for the cached timezone: set timezone [configure -system-tz] -- cgit v0.12 From 888ce88c144ed91f566873e6b29cda26ac71e8db Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 22 Feb 2021 15:45:09 +0000 Subject: Fix one more usage of getenv() on Windows --- generic/tclIOUtil.c | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 5566f3e..312fd08 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -3158,6 +3158,13 @@ Tcl_FSLoadFile( * present and set to true (any integer > 0) then the unlink is skipped. */ +#ifdef _WIN32 +#define getenv(x) _wgetenv(L##x) +#define atoi(x) _wtoi(x) +#else +#define WCHAR char +#endif + static int skipUnlink (Tcl_Obj* shlibFile) { @@ -3178,9 +3185,9 @@ skipUnlink (Tcl_Obj* shlibFile) #ifdef hpux return 1; #else - char* skipstr; + WCHAR *skipstr; - skipstr = getenv ("TCL_TEMPLOAD_NO_UNLINK"); + skipstr = getenv("TCL_TEMPLOAD_NO_UNLINK"); if (skipstr && (skipstr[0] != '\0')) { return atoi(skipstr); } -- cgit v0.12 From 984ff0cfb4b0ad7c1e2575bb02542a2905cea389 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 5 Jul 2022 11:09:11 +0000 Subject: re-generate tclDate.c --- generic/tclDate.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclDate.c b/generic/tclDate.c index 7357a61..6ca14ea 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -121,9 +121,9 @@ #define TM_YEAR_BASE 1900 -#define HOUR(x) ((int) (60 * x)) +#define HOUR(x) ((int) (60 * (x))) #define SECSPERDAY (24L * 60L * 60L) -#define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0)) +#define IsLeapYear(x) (((x) % 4 == 0) && ((x) % 100 != 0 || (x) % 400 == 0)) #define yyIncrFlags(f) \ do { \ -- cgit v0.12 From 494c117a0184ec3576a60a26e3425c2f89bea499 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 29 Jan 2024 15:39:29 +0000 Subject: small amend (type change) --- generic/tclInt.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 73e1915..4da08f9 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3092,7 +3092,7 @@ MODULE_SCOPE void TclAdvanceLines(Tcl_Size *line, const char *start, MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, const unsigned char *bytes, Tcl_Size len); MODULE_SCOPE void TclAppendUtfToUtf(Tcl_Obj *objPtr, - const char *bytes, int numBytes); + const char *bytes, Tcl_Size numBytes); MODULE_SCOPE void TclArgumentEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, CmdFrame *cf); MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, -- cgit v0.12 From cbd4f2d22bacb8fe295c4c38eb67188335be2dab Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 29 Jan 2024 21:04:23 +0000 Subject: re-build win64/zlib1.dll for UCRT --- compat/zlib/win64/zlib1.dll | Bin 134144 -> 102912 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/compat/zlib/win64/zlib1.dll b/compat/zlib/win64/zlib1.dll index 06eead4..66289fb 100755 Binary files a/compat/zlib/win64/zlib1.dll and b/compat/zlib/win64/zlib1.dll differ -- cgit v0.12 From 1ceaeddc08dcec61c7cf00678b693be43ca61535 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 31 Jan 2024 12:42:32 +0000 Subject: Remove private characters from regexp control table, but add them back in [:cntrl:] class (so no change in regexp handling). Eliminated (size_t) type-casts. This makes implementing more character-classes easier. --- generic/regc_locale.c | 80 +++++++++++++++++++++++++-------------------------- tools/uniClass.tcl | 10 +++++-- 2 files changed, 47 insertions(+), 43 deletions(-) diff --git a/generic/regc_locale.c b/generic/regc_locale.c index 9a984f5..e8f9381 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -254,7 +254,7 @@ static const crange alphaRangeTable[] = { #endif }; -#define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange)) +#define NUM_ALPHA_RANGE ((int)(sizeof(alphaRangeTable)/sizeof(crange))) static const chr alphaCharTable[] = { 0xAA, 0xB5, 0xBA, 0x2EC, 0x2EE, 0x376, 0x377, 0x37F, 0x386, @@ -291,7 +291,7 @@ static const chr alphaCharTable[] = { #endif }; -#define NUM_ALPHA_CHAR (sizeof(alphaCharTable)/sizeof(chr)) +#define NUM_ALPHA_CHAR ((int)(sizeof(alphaCharTable)/sizeof(chr))) /* * Unicode: control characters. @@ -299,14 +299,13 @@ static const chr alphaCharTable[] = { static const crange controlRangeTable[] = { {0x0, 0x1F}, {0x7F, 0x9F}, {0x600, 0x605}, {0x200B, 0x200F}, - {0x202A, 0x202E}, {0x2060, 0x2064}, {0x2066, 0x206F}, {0xE000, 0xF8FF}, - {0xFFF9, 0xFFFB} + {0x202A, 0x202E}, {0x2060, 0x2064}, {0x2066, 0x206F}, {0xFFF9, 0xFFFB} #if CHRBITS > 16 ,{0x13430, 0x1343F}, {0x1BCA0, 0x1BCA3}, {0x1D173, 0x1D17A}, {0xE0020, 0xE007F} #endif }; -#define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange)) +#define NUM_CONTROL_RANGE ((int)(sizeof(controlRangeTable)/sizeof(crange))) static const chr controlCharTable[] = { 0xAD, 0x61C, 0x6DD, 0x70F, 0x890, 0x891, 0x8E2, 0x180E, 0xFEFF @@ -315,7 +314,7 @@ static const chr controlCharTable[] = { #endif }; -#define NUM_CONTROL_CHAR (sizeof(controlCharTable)/sizeof(chr)) +#define NUM_CONTROL_CHAR ((int)(sizeof(controlCharTable)/sizeof(chr))) /* * Unicode: decimal digit characters. @@ -343,7 +342,7 @@ static const crange digitRangeTable[] = { #endif }; -#define NUM_DIGIT_RANGE (sizeof(digitRangeTable)/sizeof(crange)) +#define NUM_DIGIT_RANGE ((int)(sizeof(digitRangeTable)/sizeof(crange))) /* * no singletons of digit characters. @@ -380,7 +379,7 @@ static const crange punctRangeTable[] = { #endif }; -#define NUM_PUNCT_RANGE (sizeof(punctRangeTable)/sizeof(crange)) +#define NUM_PUNCT_RANGE ((int)(sizeof(punctRangeTable)/sizeof(crange))) static const chr punctCharTable[] = { 0x3A, 0x3B, 0x3F, 0x40, 0x5F, 0x7B, 0x7D, 0xA1, 0xA7, @@ -405,7 +404,7 @@ static const chr punctCharTable[] = { #endif }; -#define NUM_PUNCT_CHAR (sizeof(punctCharTable)/sizeof(chr)) +#define NUM_PUNCT_CHAR ((int)(sizeof(punctCharTable)/sizeof(chr))) /* * Unicode: white space characters. @@ -415,14 +414,14 @@ static const crange spaceRangeTable[] = { {0x9, 0xD}, {0x2000, 0x200B} }; -#define NUM_SPACE_RANGE (sizeof(spaceRangeTable)/sizeof(crange)) +#define NUM_SPACE_RANGE ((int)(sizeof(spaceRangeTable)/sizeof(crange))) static const chr spaceCharTable[] = { 0x20, 0x85, 0xA0, 0x1680, 0x180E, 0x2028, 0x2029, 0x202F, 0x205F, 0x2060, 0x3000, 0xFEFF }; -#define NUM_SPACE_CHAR (sizeof(spaceCharTable)/sizeof(chr)) +#define NUM_SPACE_CHAR ((int)(sizeof(spaceCharTable)/sizeof(chr))) /* * Unicode: lowercase characters. @@ -456,7 +455,7 @@ static const crange lowerRangeTable[] = { #endif }; -#define NUM_LOWER_RANGE (sizeof(lowerRangeTable)/sizeof(crange)) +#define NUM_LOWER_RANGE ((int)(sizeof(lowerRangeTable)/sizeof(crange))) static const chr lowerCharTable[] = { 0xB5, 0x101, 0x103, 0x105, 0x107, 0x109, 0x10B, 0x10D, 0x10F, @@ -529,7 +528,7 @@ static const chr lowerCharTable[] = { #endif }; -#define NUM_LOWER_CHAR (sizeof(lowerCharTable)/sizeof(chr)) +#define NUM_LOWER_CHAR ((int)(sizeof(lowerCharTable)/sizeof(chr))) /* * Unicode: uppercase characters. @@ -559,7 +558,7 @@ static const crange upperRangeTable[] = { #endif }; -#define NUM_UPPER_RANGE (sizeof(upperRangeTable)/sizeof(crange)) +#define NUM_UPPER_RANGE ((int)(sizeof(upperRangeTable)/sizeof(crange))) static const chr upperCharTable[] = { 0x100, 0x102, 0x104, 0x106, 0x108, 0x10A, 0x10C, 0x10E, 0x110, @@ -633,7 +632,7 @@ static const chr upperCharTable[] = { #endif }; -#define NUM_UPPER_CHAR (sizeof(upperCharTable)/sizeof(chr)) +#define NUM_UPPER_CHAR ((int)(sizeof(upperCharTable)/sizeof(chr))) /* * Unicode: unicode print characters excluding space. @@ -792,7 +791,7 @@ static const crange graphRangeTable[] = { #endif }; -#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange)) +#define NUM_GRAPH_RANGE ((int)(sizeof(graphRangeTable)/sizeof(crange))) static const chr graphCharTable[] = { 0x38C, 0x85E, 0x98F, 0x990, 0x9B2, 0x9C7, 0x9C8, 0x9D7, 0x9DC, @@ -820,7 +819,7 @@ static const chr graphCharTable[] = { #endif }; -#define NUM_GRAPH_CHAR (sizeof(graphCharTable)/sizeof(chr)) +#define NUM_GRAPH_CHAR ((int)(sizeof(graphCharTable)/sizeof(chr))) /* * End of auto-generated Unicode character ranges declarations. @@ -1067,14 +1066,14 @@ cclass( case CC_ALNUM: cv = getcvec(v, NUM_ALPHA_CHAR, NUM_DIGIT_RANGE + NUM_ALPHA_RANGE); if (cv) { - for (i=0 ; (size_t)i Date: Wed, 31 Jan 2024 13:57:37 +0000 Subject: Eliminate (now unnecessary) type-casts --- generic/regc_locale.c | 46 ++++++++++++++++++++++------------------------ 1 file changed, 22 insertions(+), 24 deletions(-) diff --git a/generic/regc_locale.c b/generic/regc_locale.c index e8f9381..177c2b9 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -110,7 +110,7 @@ static const struct cname { {"right-brace", '}'}, {"right-curly-bracket", '}'}, {"tilde", '~'}, - {"DEL", '\177'}, + {"DEL", '\x7F'}, {NULL, 0} }; @@ -824,8 +824,6 @@ static const chr graphCharTable[] = { /* * End of auto-generated Unicode character ranges declarations. */ - -#define CH NOCELT /* - element - map collating-element name to celt @@ -918,9 +916,9 @@ range( for (c=a; c<=b; c++) { addchr(cv, c); - lc = Tcl_UniCharToLower((chr)c); - uc = Tcl_UniCharToUpper((chr)c); - tc = Tcl_UniCharToTitle((chr)c); + lc = Tcl_UniCharToLower(c); + uc = Tcl_UniCharToUpper(c); + tc = Tcl_UniCharToTitle(c); if (c != lc) { addchr(cv, lc); } @@ -969,11 +967,11 @@ eclass( if ((v->cflags®_FAKE) && c == 'x') { cv = getcvec(v, 4, 0); - addchr(cv, (chr)'x'); - addchr(cv, (chr)'y'); + addchr(cv, 'x'); + addchr(cv, 'y'); if (cases) { - addchr(cv, (chr)'X'); - addchr(cv, (chr)'Y'); + addchr(cv, 'X'); + addchr(cv, 'Y'); } return cv; } @@ -987,7 +985,7 @@ eclass( } cv = getcvec(v, 1, 0); assert(cv != NULL); - addchr(cv, (chr)c); + addchr(cv, c); return cv; } @@ -1008,7 +1006,7 @@ cclass( Tcl_DString ds; const char *np; const char *const *namePtr; - int i, index; + int i; /* * The following arrays define the valid character class names. @@ -1020,9 +1018,10 @@ cclass( }; enum classes { + CC_NULL = -1, CC_ALNUM, CC_ALPHA, CC_ASCII, CC_BLANK, CC_CNTRL, CC_DIGIT, CC_GRAPH, CC_LOWER, CC_PRINT, CC_PUNCT, CC_SPACE, CC_UPPER, CC_XDIGIT - }; + } index; /* @@ -1031,24 +1030,20 @@ cclass( len = endp - startp; Tcl_DStringInit(&ds); - np = Tcl_UniCharToUtfDString(startp, (int)len, &ds); + np = Tcl_UniCharToUtfDString(startp, len, &ds); /* * Map the name to the corresponding enumerated value. */ - index = -1; + index = CC_NULL; for (namePtr=classNames,i=0 ; *namePtr!=NULL ; namePtr++,i++) { if ((strlen(*namePtr) == len) && (strncmp(*namePtr, np, len) == 0)) { - index = i; + index = (enum classes)i; break; } } Tcl_DStringFree(&ds); - if (index == -1) { - ERR(REG_ECTYPE); - return NULL; - } /* * Remap lower and upper to alpha if the match is case insensitive. @@ -1062,7 +1057,10 @@ cclass( * Now compute the character class contents. */ - switch((enum classes) index) { + switch (index) { + case CC_NULL: + ERR(REG_ECTYPE); + return NULL; case CC_ALNUM: cv = getcvec(v, NUM_ALPHA_CHAR, NUM_DIGIT_RANGE + NUM_ALPHA_RANGE); if (cv) { @@ -1242,9 +1240,9 @@ allcases( chr c = (chr)pc; chr lc, uc, tc; - lc = Tcl_UniCharToLower((chr)c); - uc = Tcl_UniCharToUpper((chr)c); - tc = Tcl_UniCharToTitle((chr)c); + lc = Tcl_UniCharToLower(c); + uc = Tcl_UniCharToUpper(c); + tc = Tcl_UniCharToTitle(c); if (tc != uc) { cv = getcvec(v, 3, 0); -- cgit v0.12 From 72aa915bf03b468164570523d07c19917a956b4f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 31 Jan 2024 21:08:38 +0000 Subject: More TCL_SIZE_MODIFIER usage --- generic/tclHash.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tclHash.c b/generic/tclHash.c index ea1b20e..385b9e4 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -649,15 +649,15 @@ Tcl_HashStats( */ result = (char *)ckalloc((NUM_COUNTERS * 60) + 300); - snprintf(result, 60, "%u entries in table, %u buckets\n", + snprintf(result, 60, "%" TCL_SIZE_MODIFIER "u entries in table, %" TCL_SIZE_MODIFIER "u buckets\n", tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); for (i = 0; i < NUM_COUNTERS; i++) { - snprintf(p, 60, "number of buckets with %u entries: %u\n", + snprintf(p, 60, "number of buckets with %" TCL_SIZE_MODIFIER "u entries: %" TCL_SIZE_MODIFIER "u\n", i, count[i]); p += strlen(p); } - snprintf(p, 60, "number of buckets with %u or more entries: %u\n", + snprintf(p, 60, "number of buckets with %d or more entries: %" TCL_SIZE_MODIFIER "u\n", NUM_COUNTERS, overflow); p += strlen(p); snprintf(p, 60, "average search distance for entry: %.1f", average); -- cgit v0.12 From 7f43fd669135216c7d1133dd450b7378a970a6c5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 1 Feb 2024 09:42:36 +0000 Subject: Forgot that long doubles are supported in Tcl_ObjPrintf() --- doc/StringObj.3 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/StringObj.3 b/doc/StringObj.3 index 65216d3..02fda8b 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -323,8 +323,8 @@ core formatting engine used by \fBTcl_Format\fR. This means the set of supported conversion specifiers is that of the \fBformat\fR command but the behavior is as similar as possible to \fBsprintf\fR. The "hh" and (Microsoft-specific) "w" format specifiers are not supported. The "L" -format specifier means that an "mp_int *" argument is expected (in combination -with "d"/"i"/"u"/"o"/"x"/"X", it cannot be used for long doubles). When a +format specifier means that an "mp_int *" argument is expected (or a +"long double" in combination with \fB[aAeEgGaA]\fR). When a conversion specifier passed to \fBTcl_ObjPrintf\fR includes a precision, the value is taken as a number of bytes, as \fBsprintf\fR does, and not as a number of characters, as \fBformat\fR does. This is done on the -- cgit v0.12 From 8ed053109c53a157e121884d50c693ac35df4f5e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 1 Feb 2024 21:44:49 +0000 Subject: Fix [0d78177f20]: unsigned use of Tcl_ObjPrintf() doesn't work as expected. With testcases. --- generic/tclStringObj.c | 30 ++++++++++++++++++++++++++---- generic/tclTest.c | 11 ++++++----- tests/util.test | 9 +++++++++ 3 files changed, 41 insertions(+), 9 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index bc2d4e9..3ce22f0 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -2079,7 +2079,7 @@ AppendUtfToUtfRep( /* *---------------------------------------------------------------------- * - * TclAppendUtfToUtf -- + * TclAppendUtfToUtf -- * * This function appends "numBytes" bytes of "bytes" to the UTF string * rep of "objPtr" (objPtr's internal rep converted to string on demand). @@ -3017,6 +3017,28 @@ Tcl_Format( *--------------------------------------------------------------------------- */ +static Tcl_Obj * +NewIntObj( + char c, + Tcl_WideUInt max, + Tcl_WideInt value) +{ + if (!((max+1) & (Tcl_WideUInt)value)) { + /* sign-bit is not set, so handle the positive value */ + return Tcl_NewWideIntObj(value & (Tcl_WideInt)max); + } + + if (strchr("puoxX", c) && (max == WIDE_MAX)) { + /* Value > WIDE_MAX, so we need to use bignum */ + mp_int bignumValue; + if (mp_init_u64(&bignumValue, (uint64_t)value) != MP_OKAY) { + Tcl_Panic("%s: memory overflow", "AppendPrintfToObjVA"); + } + return Tcl_NewBignumObj(&bignumValue); + } + return Tcl_NewWideIntObj(value | ~(Tcl_WideInt)max); +} + static void AppendPrintfToObjVA( Tcl_Obj *objPtr, @@ -3100,15 +3122,15 @@ AppendPrintfToObjVA( switch (size) { case -1: case 0: - Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj( + Tcl_ListObjAppendElement(NULL, list, NewIntObj(*p, INT_MAX, va_arg(argList, int))); break; case 1: - Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj( + Tcl_ListObjAppendElement(NULL, list, NewIntObj(*p, LONG_MAX, va_arg(argList, long))); break; case 2: - Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj( + Tcl_ListObjAppendElement(NULL, list, NewIntObj(*p, WIDE_MAX, va_arg(argList, Tcl_WideInt))); break; case 3: diff --git a/generic/tclTest.c b/generic/tclTest.c index 08b3306..e656985 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -4396,16 +4396,17 @@ TestprintObjCmd( { Tcl_WideInt argv1 = 0; size_t argv2; + long argv3; - if (objc < 2 || objc > 3) { + if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "format wideint"); + return TCL_OK; } - if (objc > 1) { - Tcl_GetWideIntFromObj(interp, objv[2], &argv1); - } + Tcl_GetWideIntFromObj(interp, objv[2], &argv1); argv2 = (size_t)argv1; - Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv2)); + argv3 = (long)argv1; + Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv3, argv3)); return TCL_OK; } diff --git a/tests/util.test b/tests/util.test index c3b9f2d..b643b13 100644 --- a/tests/util.test +++ b/tests/util.test @@ -23,6 +23,7 @@ testConstraint testdoubledigits [llength [info commands testdoubledigits]] testConstraint testprint [llength [info commands testprint]] testConstraint precision [expr {![catch {set saved_precision $::tcl_precision}]}] +testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}] # Big test for correct ordering of data in [expr] @@ -4178,6 +4179,14 @@ test util-18.12 {Tcl_ObjPrintf} {testprint} { testprint "%I64d %Id" 65537 } {65537 65537} +test util-18.13 {Tcl_ObjPrintf} -constraints {testprint pointerIs64bit} -body { + testprint "%llu %ju %lu" -1 +} -result {18446744073709551615 18446744073709551615 18446744073709551615} + +test util-18.14 {Tcl_ObjPrintf} -constraints {testprint pointerIs64bit} -body { + testprint "%llu %zu %lu" -1 +} -result {18446744073709551615 18446744073709551615 18446744073709551615} + if {[catch {set ::tcl_precision $saved_precision}]} { unset ::tcl_precision } -- cgit v0.12 From 07e94bea99230a585a50de7ec548831e13bf79f7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 6 Feb 2024 09:41:13 +0000 Subject: Fix util-18.13/util-18.14 constraint, which masked the wrong result on 64-bit windows. Fixed that as well. --- generic/tclStringObj.c | 38 +++++++++++++++++++++----------------- tests/util.test | 6 +++--- 2 files changed, 24 insertions(+), 20 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 25f8a61..54060c0 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -3018,25 +3018,29 @@ Tcl_Format( */ static Tcl_Obj * -NewIntObj( +NewLongObj( char c, - Tcl_WideUInt max, - Tcl_WideInt value) + long value) { - if (!((max+1) & (Tcl_WideUInt)value)) { - /* sign-bit is not set, so handle the positive value */ - return Tcl_NewWideIntObj(value & (Tcl_WideInt)max); + if ((value < 0) && strchr("puoxX", c)) { + Tcl_Obj *obj; + TclNewUIntObj(obj, (unsigned long)value); + return obj; } + return Tcl_NewWideIntObj((long)value); +} - if (strchr("puoxX", c) && (max == WIDE_MAX)) { - /* Value > WIDE_MAX, so we need to use bignum */ - mp_int bignumValue; - if (mp_init_u64(&bignumValue, (uint64_t)value) != MP_OKAY) { - Tcl_Panic("%s: memory overflow", "AppendPrintfToObjVA"); - } - return Tcl_NewBignumObj(&bignumValue); +static Tcl_Obj * +NewWideIntObj( + char c, + Tcl_WideInt value) +{ + if ((value < 0) && strchr("puoxX", c)) { + Tcl_Obj *obj; + TclNewUIntObj(obj, (Tcl_WideUInt)value); + return obj; } - return Tcl_NewWideIntObj(value | ~(Tcl_WideInt)max); + return Tcl_NewWideIntObj(value); } static void @@ -3122,15 +3126,15 @@ AppendPrintfToObjVA( switch (size) { case -1: case 0: - Tcl_ListObjAppendElement(NULL, list, NewIntObj(*p, INT_MAX, + Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj( va_arg(argList, int))); break; case 1: - Tcl_ListObjAppendElement(NULL, list, NewIntObj(*p, LONG_MAX, + Tcl_ListObjAppendElement(NULL, list, NewLongObj(*p, va_arg(argList, long))); break; case 2: - Tcl_ListObjAppendElement(NULL, list, NewIntObj(*p, WIDE_MAX, + Tcl_ListObjAppendElement(NULL, list, NewWideIntObj(*p, va_arg(argList, Tcl_WideInt))); break; case 3: diff --git a/tests/util.test b/tests/util.test index b643b13..04ee73d 100644 --- a/tests/util.test +++ b/tests/util.test @@ -23,7 +23,7 @@ testConstraint testdoubledigits [llength [info commands testdoubledigits]] testConstraint testprint [llength [info commands testprint]] testConstraint precision [expr {![catch {set saved_precision $::tcl_precision}]}] -testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}] +testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}] # Big test for correct ordering of data in [expr] @@ -4179,11 +4179,11 @@ test util-18.12 {Tcl_ObjPrintf} {testprint} { testprint "%I64d %Id" 65537 } {65537 65537} -test util-18.13 {Tcl_ObjPrintf} -constraints {testprint pointerIs64bit} -body { +test util-18.13 {Tcl_ObjPrintf} -constraints {testprint longIs64bit} -body { testprint "%llu %ju %lu" -1 } -result {18446744073709551615 18446744073709551615 18446744073709551615} -test util-18.14 {Tcl_ObjPrintf} -constraints {testprint pointerIs64bit} -body { +test util-18.14 {Tcl_ObjPrintf} -constraints {testprint longIs64bit} -body { testprint "%llu %zu %lu" -1 } -result {18446744073709551615 18446744073709551615 18446744073709551615} -- cgit v0.12 From 667d40ea7d58b8be65eafdda5c019f96ec05d635 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 6 Feb 2024 12:33:35 +0000 Subject: Minor code simplification --- generic/tclEncoding.c | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 2d1c983..727ed89 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2668,16 +2668,8 @@ cesu8: dst += Tcl_UniCharToUtf(ch, dst); ch = low; } - } else if (PROFILE_STRICT(profile) && - (!(flags & ENCODING_INPUT)) && - SURROGATE(ch)) { - result = TCL_CONVERT_UNKNOWN; - src = saveSrc; - break; - } else if (PROFILE_STRICT(profile) && - (flags & ENCODING_INPUT) && - SURROGATE(ch)) { - result = TCL_CONVERT_SYNTAX; + } else if (PROFILE_STRICT(profile) && SURROGATE(ch)) { + result = (flags & ENCODING_INPUT) ? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN; src = saveSrc; break; } -- cgit v0.12 From 2fa0ec4d0bb7959063e94a0bd03962d40aeac38d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 6 Feb 2024 13:01:11 +0000 Subject: Proposed fix for [80d4c1c7e5]: Isolated surrogates are not replaced when encoding to / from utf-8 --- generic/tclEncoding.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index d780299..63ebdf4 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2485,7 +2485,6 @@ UtfToUtfProc( flags |= PTR2INT(clientData); dstEnd = dst + dstLen - ((flags & ENCODING_UTF) ? TCL_UTF_MAX : 6); - profile = ENCODING_PROFILE_GET(flags); for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { @@ -2596,6 +2595,8 @@ UtfToUtfProc( result = (flags & ENCODING_INPUT) ? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN; src = saveSrc; break; + } else if (PROFILE_REPLACE(profile) && SURROGATE(ch)) { + ch = UNICODE_REPLACE_CHAR; } dst += Tcl_UniCharToUtf(ch, dst); } -- cgit v0.12 From 565b4174663b7628ce7208539b5508c1d7ba77a3 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Wed, 7 Feb 2024 03:06:05 +0000 Subject: Add test cases for [80d4c1c7e5] --- tests/encoding.test | 6 ++++-- tests/encodingVectors.tcl | 6 ++++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/tests/encoding.test b/tests/encoding.test index 8bc096c..c27fcd3 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -881,8 +881,8 @@ test encoding-24.37 {Parse invalid utf-8 with -profile tcl8} -body { test encoding-24.38.1 {Try to generate invalid utf-8} -body { encoding convertto -profile tcl8 utf-8 \uD800 } -result \xED\xA0\x80 -test encoding-24.38.2 {Try to generate invalid utf-8} -body { - encoding convertto -profile strict utf-8 \uD800 +test encoding-24.38.2 {Try to generate invalid utf-8 - default profile} -body { + encoding convertto utf-8 \uD800 } -returnCodes 1 -result {unexpected character at index 0: 'U+00D800'} test encoding-24.39 {Try to generate invalid utf-8 with -profile strict} -body { encoding convertto -profile strict utf-8 \uD800 @@ -1176,6 +1176,8 @@ test encoding-bug-66ffafd309-2-replace {Bug [66ffafd309] - invalid DBCS} -body { encoding convertfrom -profile replace jis0208 \x78\x79 } -result \uFFFD\uFFFD + + # cleanup namespace delete ::tcl::test::encoding ::tcltest::cleanupTests diff --git a/tests/encodingVectors.tcl b/tests/encodingVectors.tcl index 8bd6b87..6583473 100644 --- a/tests/encodingVectors.tcl +++ b/tests/encodingVectors.tcl @@ -641,10 +641,12 @@ lappend encUnencodableStrings {*}{ iso8859-1 \u0141 tcl8 3f -1 {} unencodable iso8859-1 \u0141 strict {} 0 {} unencodable - utf-8 \uD800 tcl8 eda080 -1 {} High-surrogate - utf-8 \uD800 strict {} 0 {} High-surrogate + utf-8 \uD800 tcl8 eda080 -1 {} Low-surrogate + utf-8 \uD800 replace efbfbd -1 {} Low-surrogate + utf-8 \uD800 strict {} 0 {} Low-surrogate utf-8 \uDC00 tcl8 edb080 -1 {} High-surrogate utf-8 \uDC00 strict {} 0 {} High-surrogate + utf-8 \uDC00 replace efbfbd -1 {} High-surrogate } -- cgit v0.12 From bfef5356ccdd4f45675e70d218940fccfebe17a5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 7 Feb 2024 08:50:01 +0000 Subject: (cherry-pick): Add test cases for [80d4c1c7e5] --- tests/encodingVectors.tcl | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/tests/encodingVectors.tcl b/tests/encodingVectors.tcl index 3961917..e6faf56 100644 --- a/tests/encodingVectors.tcl +++ b/tests/encodingVectors.tcl @@ -112,7 +112,7 @@ lappend encInvalidBytes {*}{ ascii 80 tcl8 \u20AC -1 {knownBug} {map to cp1252} ascii 80 replace \uFFFD -1 {} {Smallest invalid byte} ascii 80 strict {} 0 {} {Smallest invalid byte} - ascii 81 tcl8 \u0081 -1 {knownBug} {map to cp1252} + ascii 81 tcl8 \u0081 -1 {} {map to cp1252} ascii 82 tcl8 \u201A -1 {knownBug} {map to cp1252} ascii 83 tcl8 \u0192 -1 {knownBug} {map to cp1252} ascii 84 tcl8 \u201E -1 {knownBug} {map to cp1252} @@ -124,10 +124,10 @@ lappend encInvalidBytes {*}{ ascii 8A tcl8 \u0160 -1 {knownBug} {map to cp1252} ascii 8B tcl8 \u2039 -1 {knownBug} {map to cp1252} ascii 8C tcl8 \u0152 -1 {knownBug} {map to cp1252} - ascii 8D tcl8 \u008D -1 {knownBug} {map to cp1252} + ascii 8D tcl8 \u008D -1 {} {map to cp1252} ascii 8E tcl8 \u017D -1 {knownBug} {map to cp1252} - ascii 8F tcl8 \u008F -1 {knownBug} {map to cp1252} - ascii 90 tcl8 \u0090 -1 {knownBug} {map to cp1252} + ascii 8F tcl8 \u008F -1 {} {map to cp1252} + ascii 90 tcl8 \u0090 -1 {} {map to cp1252} ascii 91 tcl8 \u2018 -1 {knownBug} {map to cp1252} ascii 92 tcl8 \u2019 -1 {knownBug} {map to cp1252} ascii 93 tcl8 \u201C -1 {knownBug} {map to cp1252} @@ -140,7 +140,7 @@ lappend encInvalidBytes {*}{ ascii 9A tcl8 \u0161 -1 {knownBug} {map to cp1252} ascii 9B tcl8 \u203A -1 {knownBug} {map to cp1252} ascii 9C tcl8 \u0153 -1 {knownBug} {map to cp1252} - ascii 9D tcl8 \u009D -1 {knownBug} {map to cp1252} + ascii 9D tcl8 \u009D -1 {} {map to cp1252} ascii 9E tcl8 \u017E -1 {knownBug} {map to cp1252} ascii 9F tcl8 \u0178 -1 {knownBug} {map to cp1252} @@ -554,20 +554,20 @@ lappend encInvalidBytes {*}{ utf-16le 41 strict {} 0 {solo tail} {Truncated} utf-16le 00D8 tcl8 \uD800 -1 {} {Missing low surrogate} utf-16le 00D8 replace \uFFFD -1 {knownBug} {Missing low surrogate} - utf-16le 00D8 strict {} 0 {knownBug} {Missing low surrogate} + utf-16le 00D8 strict {} 0 {} {Missing low surrogate} utf-16le 00DC tcl8 \uDC00 -1 {} {Missing high surrogate} utf-16le 00DC replace \uFFFD -1 {knownBug} {Missing high surrogate} - utf-16le 00DC strict {} 0 {knownBug} {Missing high surrogate} + utf-16le 00DC strict {} 0 {} {Missing high surrogate} utf-16be 41 tcl8 \uFFFD -1 {solo tail} {Truncated} utf-16be 41 replace \uFFFD -1 {solo tail} {Truncated} utf-16be 41 strict {} 0 {solo tail} {Truncated} utf-16be D800 tcl8 \uD800 -1 {} {Missing low surrogate} utf-16be D800 replace \uFFFD -1 {knownBug} {Missing low surrogate} - utf-16be D800 strict {} 0 {knownBug} {Missing low surrogate} + utf-16be D800 strict {} 0 {} {Missing low surrogate} utf-16be DC00 tcl8 \uDC00 -1 {} {Missing high surrogate} utf-16be DC00 replace \uFFFD -1 {knownBug} {Missing high surrogate} - utf-16be DC00 strict {} 0 {knownBug} {Missing high surrogate} + utf-16be DC00 strict {} 0 {} {Missing high surrogate} } # utf32-le and utf32-be test cases. Note utf32 cases are automatically generated @@ -641,10 +641,12 @@ lappend encUnencodableStrings {*}{ iso8859-1 \u0141 tcl8 3f -1 {} unencodable iso8859-1 \u0141 strict {} 0 {} unencodable - utf-8 \uD800 tcl8 eda080 -1 {} High-surrogate - utf-8 \uD800 strict {} 0 {} High-surrogate + utf-8 \uD800 tcl8 eda080 -1 {} Low-surrogate + utf-8 \uD800 replace efbfbd -1 {} Low-surrogate + utf-8 \uD800 strict {} 0 {} Low-surrogate utf-8 \uDC00 tcl8 edb080 -1 {} High-surrogate utf-8 \uDC00 strict {} 0 {} High-surrogate + utf-8 \uDC00 replace efbfbd -1 {} High-surrogate } -- cgit v0.12 From f3bd8e0942b5615008a1aaa74bb24151eaa1ed19 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 7 Feb 2024 10:00:13 +0000 Subject: Fix all 'ascii' testcases in encodingVectors.tcl --- generic/tclEncoding.c | 8 +++++-- tests/encodingVectors.tcl | 54 +++++++++++++++++++++++------------------------ 2 files changed, 33 insertions(+), 29 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 727ed89..d03d4f8 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -3387,7 +3387,9 @@ TableToUtfProc( } else if (PROFILE_REPLACE(flags)) { ch = UNICODE_REPLACE_CHAR; } else { - ch = (Tcl_UniChar)byte; + char chbuf[2]; + chbuf[0] = byte; chbuf[1] = 0; + Tcl_UtfToUniChar(chbuf, &ch); } } else { ch = toUnicode[byte][*((unsigned char *)++src)]; @@ -3407,7 +3409,9 @@ TableToUtfProc( if (PROFILE_REPLACE(flags)) { ch = UNICODE_REPLACE_CHAR; } else { - ch = (Tcl_UniChar)byte; + char chbuf[2]; + chbuf[0] = byte; chbuf[1] = 0; + Tcl_UtfToUniChar(chbuf, &ch); } } diff --git a/tests/encodingVectors.tcl b/tests/encodingVectors.tcl index e6faf56..dfceab4 100644 --- a/tests/encodingVectors.tcl +++ b/tests/encodingVectors.tcl @@ -109,40 +109,40 @@ set encInvalidBytes {}; # Reset the table # 80-9F which is treated as cp1252. # This tests the TableToUtfProc code path. lappend encInvalidBytes {*}{ - ascii 80 tcl8 \u20AC -1 {knownBug} {map to cp1252} + ascii 80 tcl8 \u20AC -1 {} {map to cp1252} ascii 80 replace \uFFFD -1 {} {Smallest invalid byte} ascii 80 strict {} 0 {} {Smallest invalid byte} ascii 81 tcl8 \u0081 -1 {} {map to cp1252} - ascii 82 tcl8 \u201A -1 {knownBug} {map to cp1252} - ascii 83 tcl8 \u0192 -1 {knownBug} {map to cp1252} - ascii 84 tcl8 \u201E -1 {knownBug} {map to cp1252} - ascii 85 tcl8 \u2026 -1 {knownBug} {map to cp1252} - ascii 86 tcl8 \u2020 -1 {knownBug} {map to cp1252} - ascii 87 tcl8 \u2021 -1 {knownBug} {map to cp1252} - ascii 88 tcl8 \u0276 -1 {knownBug} {map to cp1252} - ascii 89 tcl8 \u2030 -1 {knownBug} {map to cp1252} - ascii 8A tcl8 \u0160 -1 {knownBug} {map to cp1252} - ascii 8B tcl8 \u2039 -1 {knownBug} {map to cp1252} - ascii 8C tcl8 \u0152 -1 {knownBug} {map to cp1252} + ascii 82 tcl8 \u201A -1 {} {map to cp1252} + ascii 83 tcl8 \u0192 -1 {} {map to cp1252} + ascii 84 tcl8 \u201E -1 {} {map to cp1252} + ascii 85 tcl8 \u2026 -1 {} {map to cp1252} + ascii 86 tcl8 \u2020 -1 {} {map to cp1252} + ascii 87 tcl8 \u2021 -1 {} {map to cp1252} + ascii 88 tcl8 \u02C6 -1 {} {map to cp1252} + ascii 89 tcl8 \u2030 -1 {} {map to cp1252} + ascii 8A tcl8 \u0160 -1 {} {map to cp1252} + ascii 8B tcl8 \u2039 -1 {} {map to cp1252} + ascii 8C tcl8 \u0152 -1 {} {map to cp1252} ascii 8D tcl8 \u008D -1 {} {map to cp1252} - ascii 8E tcl8 \u017D -1 {knownBug} {map to cp1252} + ascii 8E tcl8 \u017D -1 {} {map to cp1252} ascii 8F tcl8 \u008F -1 {} {map to cp1252} ascii 90 tcl8 \u0090 -1 {} {map to cp1252} - ascii 91 tcl8 \u2018 -1 {knownBug} {map to cp1252} - ascii 92 tcl8 \u2019 -1 {knownBug} {map to cp1252} - ascii 93 tcl8 \u201C -1 {knownBug} {map to cp1252} - ascii 94 tcl8 \u201D -1 {knownBug} {map to cp1252} - ascii 95 tcl8 \u2022 -1 {knownBug} {map to cp1252} - ascii 96 tcl8 \u2013 -1 {knownBug} {map to cp1252} - ascii 97 tcl8 \u2014 -1 {knownBug} {map to cp1252} - ascii 98 tcl8 \u02DC -1 {knownBug} {map to cp1252} - ascii 99 tcl8 \u2122 -1 {knownBug} {map to cp1252} - ascii 9A tcl8 \u0161 -1 {knownBug} {map to cp1252} - ascii 9B tcl8 \u203A -1 {knownBug} {map to cp1252} - ascii 9C tcl8 \u0153 -1 {knownBug} {map to cp1252} + ascii 91 tcl8 \u2018 -1 {} {map to cp1252} + ascii 92 tcl8 \u2019 -1 {} {map to cp1252} + ascii 93 tcl8 \u201C -1 {} {map to cp1252} + ascii 94 tcl8 \u201D -1 {} {map to cp1252} + ascii 95 tcl8 \u2022 -1 {} {map to cp1252} + ascii 96 tcl8 \u2013 -1 {} {map to cp1252} + ascii 97 tcl8 \u2014 -1 {} {map to cp1252} + ascii 98 tcl8 \u02DC -1 {} {map to cp1252} + ascii 99 tcl8 \u2122 -1 {} {map to cp1252} + ascii 9A tcl8 \u0161 -1 {} {map to cp1252} + ascii 9B tcl8 \u203A -1 {} {map to cp1252} + ascii 9C tcl8 \u0153 -1 {} {map to cp1252} ascii 9D tcl8 \u009D -1 {} {map to cp1252} - ascii 9E tcl8 \u017E -1 {knownBug} {map to cp1252} - ascii 9F tcl8 \u0178 -1 {knownBug} {map to cp1252} + ascii 9E tcl8 \u017E -1 {} {map to cp1252} + ascii 9F tcl8 \u0178 -1 {} {map to cp1252} ascii FF tcl8 \u00FF -1 {} {Largest invalid byte} ascii FF replace \uFFFD -1 {} {Largest invalid byte} -- cgit v0.12 From 5453dcb1334838ab5dd3ed3b11cdb4aad81a1128 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Wed, 7 Feb 2024 14:47:07 +0000 Subject: Implementation of TIP 652. --- doc/UniCharIsAlpha.3 | 8 +------- generic/tcl.decls | 8 +++++--- generic/tclCmdMZ.c | 7 ++----- generic/tclCompCmdsSZ.c | 8 ++------ generic/tclCompile.h | 1 - generic/tclStubInit.c | 2 +- generic/tclUtf.c | 30 ------------------------------ tests/string.test | 25 ++----------------------- 8 files changed, 13 insertions(+), 76 deletions(-) diff --git a/doc/UniCharIsAlpha.3 b/doc/UniCharIsAlpha.3 index 4ae4612..2b8c0d7 100644 --- a/doc/UniCharIsAlpha.3 +++ b/doc/UniCharIsAlpha.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha, Tcl_UniCharIsControl, Tcl_UniCharIsDigit, Tcl_UniCharIsGraph, Tcl_UniCharIsLower, Tcl_UniCharIsPrint, Tcl_UniCharIsPunct, Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsUnicode, Tcl_UniCharIsWordChar \- routines for classification of Tcl_UniChar characters +Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha, Tcl_UniCharIsControl, Tcl_UniCharIsDigit, Tcl_UniCharIsGraph, Tcl_UniCharIsLower, Tcl_UniCharIsPrint, Tcl_UniCharIsPunct, Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar \- routines for classification of Tcl_UniChar characters .SH SYNOPSIS .nf \fB#include \fR @@ -44,9 +44,6 @@ int \fBTcl_UniCharIsUpper\fR(\fIch\fR) .sp int -\fBTcl_UniCharIsUnicode\fR(\fIch\fR) -.sp -int \fBTcl_UniCharIsWordChar\fR(\fIch\fR) .fi .SH ARGUMENTS @@ -91,9 +88,6 @@ character. \fBTcl_UniCharIsUpper\fR tests if the character is an uppercase Unicode character. .PP -\fBTcl_UniCharIsUnicode\fR tests if the character is a Unicode character, -not being a surrogate or noncharacter. -.PP \fBTcl_UniCharIsWordChar\fR tests if the character is alphanumeric or a connector punctuation mark. diff --git a/generic/tcl.decls b/generic/tcl.decls index 8e047d0..b8e1e1f 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2499,9 +2499,11 @@ declare 655 { declare 656 { const char *Tcl_UtfPrev(const char *src, const char *start) } -declare 657 { - int Tcl_UniCharIsUnicode(int ch) -} +# Removed by TIP #652 +# +#declare 657 { +# int Tcl_UniCharIsUnicode(int ch) +#} # TIP 656 declare 658 { diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 38e04cb..2660ff1 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1534,7 +1534,7 @@ StringIsCmd( "boolean", "dict", "digit", "double", "entier", "false", "graph", "integer", "list", "lower", "print", "punct", - "space", "true", "upper", "unicode", + "space", "true", "upper", "wideinteger", "wordchar", "xdigit", NULL }; enum isClassesEnum { @@ -1542,7 +1542,7 @@ StringIsCmd( STR_IS_BOOL, STR_IS_DICT, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_ENTIER, STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT, STR_IS_LIST, STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT, - STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER, STR_IS_UNICODE, + STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER, STR_IS_WIDE, STR_IS_WORD, STR_IS_XDIGIT } index; static const char *const isOptions[] = { @@ -1871,9 +1871,6 @@ StringIsCmd( case STR_IS_UPPER: chcomp = Tcl_UniCharIsUpper; break; - case STR_IS_UNICODE: - chcomp = Tcl_UniCharIsUnicode; - break; case STR_IS_WORD: chcomp = Tcl_UniCharIsWordChar; break; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 0a21226..d79b7b9 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -508,7 +508,7 @@ TclCompileStringIsCmd( "boolean", "dict", "digit", "double", "entier", "false", "graph", "integer", "list", "lower", "print", "punct", - "space", "true", "upper", "unicode", + "space", "true", "upper", "wideinteger", "wordchar", "xdigit", NULL }; enum isClassesEnum { @@ -516,7 +516,7 @@ TclCompileStringIsCmd( STR_IS_BOOL, STR_IS_DICT, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_ENTIER, STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT, STR_IS_LIST, STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT, - STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER, STR_IS_UNICODE, + STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER, STR_IS_WIDE, STR_IS_WORD, STR_IS_XDIGIT } t; int range, allowEmpty = 0, end; @@ -609,9 +609,6 @@ TclCompileStringIsCmd( case STR_IS_UPPER: strClassType = STR_CLASS_UPPER; goto compileStrClass; - case STR_IS_UNICODE: - strClassType = STR_CLASS_UNICODE; - goto compileStrClass; case STR_IS_WORD: strClassType = STR_CLASS_WORD; goto compileStrClass; @@ -1423,7 +1420,6 @@ StringClassDesc const tclStringClassTable[] = { {"upper", Tcl_UniCharIsUpper}, {"word", Tcl_UniCharIsWordChar}, {"xdigit", UniCharIsHexDigit}, - {"unicode", Tcl_UniCharIsUnicode}, {"", NULL} }; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 2ea2565..5bbbb8f 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -918,7 +918,6 @@ typedef enum InstStringClassType { * punctuation) characters. */ STR_CLASS_XDIGIT, /* Characters that can be used as digits in * hexadecimal numbers ([0-9A-Fa-f]). */ - STR_CLASS_UNICODE /* Unicode characters. */ } InstStringClassType; typedef struct StringClassDesc { diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 34e8c27..9072796 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1452,7 +1452,7 @@ const TclStubs tclStubs = { Tcl_UtfCharComplete, /* 654 */ Tcl_UtfNext, /* 655 */ Tcl_UtfPrev, /* 656 */ - Tcl_UniCharIsUnicode, /* 657 */ + 0, /* 657 */ Tcl_ExternalToUtfDStringEx, /* 658 */ Tcl_UtfToExternalDStringEx, /* 659 */ Tcl_AsyncMarkFromSignal, /* 660 */ diff --git a/generic/tclUtf.c b/generic/tclUtf.c index ca4a166..9888772 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -2283,36 +2283,6 @@ Tcl_UniCharIsUpper( /* *---------------------------------------------------------------------- * - * Tcl_UniCharIsUnicode -- - * - * Test if a character is a Unicode character. - * - * Results: - * Returns non-zero if character belongs to the Unicode set. - * - * Excluded are: - * 1) All characters > U+10FFFF - * 2) Surrogates U+D800 - U+DFFF - * 3) Last 2 characters of each plane, so U+??FFFE and U+??FFFF - * 4) The characters in the range U+FDD0 - U+FDEF - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_UniCharIsUnicode( - int ch) /* Unicode character to test. */ -{ - return ((unsigned int)ch <= 0x10FFFF) && ((ch & 0xFFF800) != 0xD800) - && ((ch & 0xFFFE) != 0xFFFE) && ((unsigned int)(ch - 0xFDD0) >= 32); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_UniCharIsWordChar -- * * Test if a character is alphanumeric or a connector punctuation mark. diff --git a/tests/string.test b/tests/string.test index a232f1e..26cd8a7 100644 --- a/tests/string.test +++ b/tests/string.test @@ -537,10 +537,10 @@ test string-6.4.$noComp {string is, too many args} { } {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}} test string-6.5.$noComp {string is, class check} { list [catch {run {string is bogus str}} msg] $msg -} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, unicode, wideinteger, wordchar, or xdigit}} +} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}} test string-6.6.$noComp {string is, ambiguous class} { list [catch {run {string is al str}} msg] $msg -} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, unicode, wideinteger, wordchar, or xdigit}} +} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}} test string-6.7.$noComp {string is alpha, all ok} { run {string is alpha -strict -failindex var abc} } 1 @@ -973,27 +973,6 @@ test string-6.130.1.$noComp {string is entier, false on bad octal} { test string-6.131.$noComp {string is entier, false on bad hex} { list [run {string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ}] $var } {0 88} -test string-6.132.$noComp {string is unicode} { - run {string is unicode \U10FFFD\uD7FF\uE000\uFDCF\uFDF0} -} 1 -test string-6.133.$noComp {string is unicode, upper surrogate} { - run {string is unicode \uD800} -} 0 -test string-6.134.$noComp {string is unicode, lower surrogate} { - run {string is unicode \uDFFF} -} 0 -test string-6.135.$noComp {string is unicode, noncharacter} { - run {string is unicode \uFFFE} -} 0 -test string-6.136.$noComp {string is unicode, noncharacter} { - run {string is unicode \uFFFF} -} 0 -test string-6.137.$noComp {string is unicode, noncharacter} { - run {string is unicode \uFDD0} -} 0 -test string-6.138.$noComp {string is unicode, noncharacter} { - run {string is unicode \uFDEF} -} 0 test string-6.139.$noComp {string is integer, bug [76ad7aeba3]} { run {string is integer 18446744073709551615} } 1 -- cgit v0.12 From 81129bcf9881a7799920003595662dd6c6ec03a0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 7 Feb 2024 16:19:19 +0000 Subject: Those testcases are not a bug, but actually correct. See TIP #619: Starting with Tcl 9.0, surrogates are no longer combined automatically. This has no relation with -profile, which only specifies whether to throw an exception or use a replacement character. --- tests/encodingVectors.tcl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/encodingVectors.tcl b/tests/encodingVectors.tcl index a0bd552..c73b7f7 100644 --- a/tests/encodingVectors.tcl +++ b/tests/encodingVectors.tcl @@ -343,10 +343,10 @@ lappend encInvalidBytes {*}{ utf-8 EDBFBF tcl8 \uDFFF -1 {} {Low surrogate} utf-8 EDBFBF replace \uFFFD -1 {} {Low surrogate} utf-8 EDBFBF strict {} 0 {} {Low surrogate} - utf-8 EDA080EDB080 tcl8 \U00010000 -1 {knownBug} {High low surrogate pair} + utf-8 EDA080EDB080 tcl8 \uD800\uDC00 -1 {} {High low surrogate pair} utf-8 EDA080EDB080 replace \uFFFD\uFFFD -1 {} {High low surrogate pair} utf-8 EDA080EDB080 strict {} 0 {} {High low surrogate pair} - utf-8 EDAFBFEDBFBF tcl8 \U0010FFFF -1 {knownBug} {High low surrogate pair} + utf-8 EDAFBFEDBFBF tcl8 \uDBFF\uDFFF -1 {} {High low surrogate pair} utf-8 EDAFBFEDBFBF replace \uFFFD\uFFFD -1 {} {High low surrogate pair} utf-8 EDAFBFEDBFBF strict {} 0 {} {High low surrogate pair} -- cgit v0.12 From 6b0a2258a776aa502a25b2e6e568439296cd8ec8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 7 Feb 2024 20:52:03 +0000 Subject: Backout [c63ef66f0d], back to the drawing table. --- generic/tclEncoding.c | 8 ++----- tests/encodingVectors.tcl | 54 +++++++++++++++++++++++------------------------ 2 files changed, 29 insertions(+), 33 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index d03d4f8..727ed89 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -3387,9 +3387,7 @@ TableToUtfProc( } else if (PROFILE_REPLACE(flags)) { ch = UNICODE_REPLACE_CHAR; } else { - char chbuf[2]; - chbuf[0] = byte; chbuf[1] = 0; - Tcl_UtfToUniChar(chbuf, &ch); + ch = (Tcl_UniChar)byte; } } else { ch = toUnicode[byte][*((unsigned char *)++src)]; @@ -3409,9 +3407,7 @@ TableToUtfProc( if (PROFILE_REPLACE(flags)) { ch = UNICODE_REPLACE_CHAR; } else { - char chbuf[2]; - chbuf[0] = byte; chbuf[1] = 0; - Tcl_UtfToUniChar(chbuf, &ch); + ch = (Tcl_UniChar)byte; } } diff --git a/tests/encodingVectors.tcl b/tests/encodingVectors.tcl index dfceab4..4265b26 100644 --- a/tests/encodingVectors.tcl +++ b/tests/encodingVectors.tcl @@ -109,40 +109,40 @@ set encInvalidBytes {}; # Reset the table # 80-9F which is treated as cp1252. # This tests the TableToUtfProc code path. lappend encInvalidBytes {*}{ - ascii 80 tcl8 \u20AC -1 {} {map to cp1252} + ascii 80 tcl8 \u20AC -1 {knownBug} {map to cp1252} ascii 80 replace \uFFFD -1 {} {Smallest invalid byte} ascii 80 strict {} 0 {} {Smallest invalid byte} ascii 81 tcl8 \u0081 -1 {} {map to cp1252} - ascii 82 tcl8 \u201A -1 {} {map to cp1252} - ascii 83 tcl8 \u0192 -1 {} {map to cp1252} - ascii 84 tcl8 \u201E -1 {} {map to cp1252} - ascii 85 tcl8 \u2026 -1 {} {map to cp1252} - ascii 86 tcl8 \u2020 -1 {} {map to cp1252} - ascii 87 tcl8 \u2021 -1 {} {map to cp1252} - ascii 88 tcl8 \u02C6 -1 {} {map to cp1252} - ascii 89 tcl8 \u2030 -1 {} {map to cp1252} - ascii 8A tcl8 \u0160 -1 {} {map to cp1252} - ascii 8B tcl8 \u2039 -1 {} {map to cp1252} - ascii 8C tcl8 \u0152 -1 {} {map to cp1252} + ascii 82 tcl8 \u201A -1 {knownBug} {map to cp1252} + ascii 83 tcl8 \u0192 -1 {knownBug} {map to cp1252} + ascii 84 tcl8 \u201E -1 {knownBug} {map to cp1252} + ascii 85 tcl8 \u2026 -1 {knownBug} {map to cp1252} + ascii 86 tcl8 \u2020 -1 {knownBug} {map to cp1252} + ascii 87 tcl8 \u2021 -1 {knownBug} {map to cp1252} + ascii 88 tcl8 \u02C6 -1 {knownBug} {map to cp1252} + ascii 89 tcl8 \u2030 -1 {knownBug} {map to cp1252} + ascii 8A tcl8 \u0160 -1 {knownBug} {map to cp1252} + ascii 8B tcl8 \u2039 -1 {knownBug} {map to cp1252} + ascii 8C tcl8 \u0152 -1 {knownBug} {map to cp1252} ascii 8D tcl8 \u008D -1 {} {map to cp1252} - ascii 8E tcl8 \u017D -1 {} {map to cp1252} + ascii 8E tcl8 \u017D -1 {knownBug} {map to cp1252} ascii 8F tcl8 \u008F -1 {} {map to cp1252} ascii 90 tcl8 \u0090 -1 {} {map to cp1252} - ascii 91 tcl8 \u2018 -1 {} {map to cp1252} - ascii 92 tcl8 \u2019 -1 {} {map to cp1252} - ascii 93 tcl8 \u201C -1 {} {map to cp1252} - ascii 94 tcl8 \u201D -1 {} {map to cp1252} - ascii 95 tcl8 \u2022 -1 {} {map to cp1252} - ascii 96 tcl8 \u2013 -1 {} {map to cp1252} - ascii 97 tcl8 \u2014 -1 {} {map to cp1252} - ascii 98 tcl8 \u02DC -1 {} {map to cp1252} - ascii 99 tcl8 \u2122 -1 {} {map to cp1252} - ascii 9A tcl8 \u0161 -1 {} {map to cp1252} - ascii 9B tcl8 \u203A -1 {} {map to cp1252} - ascii 9C tcl8 \u0153 -1 {} {map to cp1252} + ascii 91 tcl8 \u2018 -1 {knownBug} {map to cp1252} + ascii 92 tcl8 \u2019 -1 {knownBug} {map to cp1252} + ascii 93 tcl8 \u201C -1 {knownBug} {map to cp1252} + ascii 94 tcl8 \u201D -1 {knownBug} {map to cp1252} + ascii 95 tcl8 \u2022 -1 {knownBug} {map to cp1252} + ascii 96 tcl8 \u2013 -1 {knownBug} {map to cp1252} + ascii 97 tcl8 \u2014 -1 {knownBug} {map to cp1252} + ascii 98 tcl8 \u02DC -1 {knownBug} {map to cp1252} + ascii 99 tcl8 \u2122 -1 {knownBug} {map to cp1252} + ascii 9A tcl8 \u0161 -1 {knownBug} {map to cp1252} + ascii 9B tcl8 \u203A -1 {knownBug} {map to cp1252} + ascii 9C tcl8 \u0153 -1 {knownBug} {map to cp1252} ascii 9D tcl8 \u009D -1 {} {map to cp1252} - ascii 9E tcl8 \u017E -1 {} {map to cp1252} - ascii 9F tcl8 \u0178 -1 {} {map to cp1252} + ascii 9E tcl8 \u017E -1 {knownBug} {map to cp1252} + ascii 9F tcl8 \u0178 -1 {knownBug} {map to cp1252} ascii FF tcl8 \u00FF -1 {} {Largest invalid byte} ascii FF replace \uFFFD -1 {} {Largest invalid byte} -- cgit v0.12 From b7e2e794e72acbe13ed5473043fb769d2e6f2322 Mon Sep 17 00:00:00 2001 From: Torsten Date: Thu, 8 Feb 2024 08:09:00 +0000 Subject: Fixed wrongly placed punctuation in .QW macro of clock.n manual page --- doc/clock.n | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/clock.n b/doc/clock.n index 871a942..4affb05 100644 --- a/doc/clock.n +++ b/doc/clock.n @@ -889,13 +889,13 @@ an error may result if these years are used. \fIISO 8601 point-in-time\fR . An ISO 8601 point-in-time specification, such as -.QW "\fICCyymmdd\fBT\fIhhmmss\fR", +.QW "\fICCyymmdd\fBT\fIhhmmss\fR" , where \fBT\fR is the literal .QW T , .QW "\fICCyymmdd hhmmss\fR" , .QW "\fICCyymmdd\fBT\fIhh:mm:ss\fR" , or -.QW "\fICCyy-mm-dd\fBT\fIhh\fB:\fImm\fB:\fIss\fR". +.QW "\fICCyy-mm-dd\fBT\fIhh\fB:\fImm\fB:\fIss\fR" . Note that only these four formats are accepted. The command does \fInot\fR accept the full range of point-in-time specifications specified in ISO8601. Other formats can be recognized by -- cgit v0.12 From 2bbfa984bed378c2a095da5dd62f049e3cce793a Mon Sep 17 00:00:00 2001 From: Torsten Date: Thu, 8 Feb 2024 09:57:42 +0000 Subject: re-introduced an already fixed formatting error - now correct again --- doc/clock.n | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/clock.n b/doc/clock.n index 4affb05..e1253aa 100644 --- a/doc/clock.n +++ b/doc/clock.n @@ -895,7 +895,7 @@ where \fBT\fR is the literal .QW "\fICCyymmdd hhmmss\fR" , .QW "\fICCyymmdd\fBT\fIhh:mm:ss\fR" , or -.QW "\fICCyy-mm-dd\fBT\fIhh\fB:\fImm\fB:\fIss\fR" . +.QW "\fICCyy-mm-dd\fBT\fIhh:mm:ss\fR" . Note that only these four formats are accepted. The command does \fInot\fR accept the full range of point-in-time specifications specified in ISO8601. Other formats can be recognized by -- cgit v0.12 From 72b48ad09d29a1b9d10b27d083476beb73b985b1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 8 Feb 2024 13:21:02 +0000 Subject: Fix all 'ascii' testcases in encodingVectors.tcl, another try. See [1355b9a874]. --- generic/tclEncoding.c | 5 ++++- tests/encodingVectors.tcl | 54 +++++++++++++++++++++++------------------------ 2 files changed, 31 insertions(+), 28 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 727ed89..ba36f55 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -3387,6 +3387,7 @@ TableToUtfProc( } else if (PROFILE_REPLACE(flags)) { ch = UNICODE_REPLACE_CHAR; } else { + /* For prefix bytes, we don't fallback to cp1252, see [1355b9a874] */ ch = (Tcl_UniChar)byte; } } else { @@ -3407,7 +3408,9 @@ TableToUtfProc( if (PROFILE_REPLACE(flags)) { ch = UNICODE_REPLACE_CHAR; } else { - ch = (Tcl_UniChar)byte; + char chbuf[2]; + chbuf[0] = byte; chbuf[1] = 0; + Tcl_UtfToUniChar(chbuf, &ch); } } diff --git a/tests/encodingVectors.tcl b/tests/encodingVectors.tcl index 4265b26..dfceab4 100644 --- a/tests/encodingVectors.tcl +++ b/tests/encodingVectors.tcl @@ -109,40 +109,40 @@ set encInvalidBytes {}; # Reset the table # 80-9F which is treated as cp1252. # This tests the TableToUtfProc code path. lappend encInvalidBytes {*}{ - ascii 80 tcl8 \u20AC -1 {knownBug} {map to cp1252} + ascii 80 tcl8 \u20AC -1 {} {map to cp1252} ascii 80 replace \uFFFD -1 {} {Smallest invalid byte} ascii 80 strict {} 0 {} {Smallest invalid byte} ascii 81 tcl8 \u0081 -1 {} {map to cp1252} - ascii 82 tcl8 \u201A -1 {knownBug} {map to cp1252} - ascii 83 tcl8 \u0192 -1 {knownBug} {map to cp1252} - ascii 84 tcl8 \u201E -1 {knownBug} {map to cp1252} - ascii 85 tcl8 \u2026 -1 {knownBug} {map to cp1252} - ascii 86 tcl8 \u2020 -1 {knownBug} {map to cp1252} - ascii 87 tcl8 \u2021 -1 {knownBug} {map to cp1252} - ascii 88 tcl8 \u02C6 -1 {knownBug} {map to cp1252} - ascii 89 tcl8 \u2030 -1 {knownBug} {map to cp1252} - ascii 8A tcl8 \u0160 -1 {knownBug} {map to cp1252} - ascii 8B tcl8 \u2039 -1 {knownBug} {map to cp1252} - ascii 8C tcl8 \u0152 -1 {knownBug} {map to cp1252} + ascii 82 tcl8 \u201A -1 {} {map to cp1252} + ascii 83 tcl8 \u0192 -1 {} {map to cp1252} + ascii 84 tcl8 \u201E -1 {} {map to cp1252} + ascii 85 tcl8 \u2026 -1 {} {map to cp1252} + ascii 86 tcl8 \u2020 -1 {} {map to cp1252} + ascii 87 tcl8 \u2021 -1 {} {map to cp1252} + ascii 88 tcl8 \u02C6 -1 {} {map to cp1252} + ascii 89 tcl8 \u2030 -1 {} {map to cp1252} + ascii 8A tcl8 \u0160 -1 {} {map to cp1252} + ascii 8B tcl8 \u2039 -1 {} {map to cp1252} + ascii 8C tcl8 \u0152 -1 {} {map to cp1252} ascii 8D tcl8 \u008D -1 {} {map to cp1252} - ascii 8E tcl8 \u017D -1 {knownBug} {map to cp1252} + ascii 8E tcl8 \u017D -1 {} {map to cp1252} ascii 8F tcl8 \u008F -1 {} {map to cp1252} ascii 90 tcl8 \u0090 -1 {} {map to cp1252} - ascii 91 tcl8 \u2018 -1 {knownBug} {map to cp1252} - ascii 92 tcl8 \u2019 -1 {knownBug} {map to cp1252} - ascii 93 tcl8 \u201C -1 {knownBug} {map to cp1252} - ascii 94 tcl8 \u201D -1 {knownBug} {map to cp1252} - ascii 95 tcl8 \u2022 -1 {knownBug} {map to cp1252} - ascii 96 tcl8 \u2013 -1 {knownBug} {map to cp1252} - ascii 97 tcl8 \u2014 -1 {knownBug} {map to cp1252} - ascii 98 tcl8 \u02DC -1 {knownBug} {map to cp1252} - ascii 99 tcl8 \u2122 -1 {knownBug} {map to cp1252} - ascii 9A tcl8 \u0161 -1 {knownBug} {map to cp1252} - ascii 9B tcl8 \u203A -1 {knownBug} {map to cp1252} - ascii 9C tcl8 \u0153 -1 {knownBug} {map to cp1252} + ascii 91 tcl8 \u2018 -1 {} {map to cp1252} + ascii 92 tcl8 \u2019 -1 {} {map to cp1252} + ascii 93 tcl8 \u201C -1 {} {map to cp1252} + ascii 94 tcl8 \u201D -1 {} {map to cp1252} + ascii 95 tcl8 \u2022 -1 {} {map to cp1252} + ascii 96 tcl8 \u2013 -1 {} {map to cp1252} + ascii 97 tcl8 \u2014 -1 {} {map to cp1252} + ascii 98 tcl8 \u02DC -1 {} {map to cp1252} + ascii 99 tcl8 \u2122 -1 {} {map to cp1252} + ascii 9A tcl8 \u0161 -1 {} {map to cp1252} + ascii 9B tcl8 \u203A -1 {} {map to cp1252} + ascii 9C tcl8 \u0153 -1 {} {map to cp1252} ascii 9D tcl8 \u009D -1 {} {map to cp1252} - ascii 9E tcl8 \u017E -1 {knownBug} {map to cp1252} - ascii 9F tcl8 \u0178 -1 {knownBug} {map to cp1252} + ascii 9E tcl8 \u017E -1 {} {map to cp1252} + ascii 9F tcl8 \u0178 -1 {} {map to cp1252} ascii FF tcl8 \u00FF -1 {} {Largest invalid byte} ascii FF replace \uFFFD -1 {} {Largest invalid byte} -- cgit v0.12 From 74369168bd4a7415853d54c37c55a4df56148952 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 9 Feb 2024 14:17:42 +0000 Subject: This should be removed too --- doc/string.n | 7 ------- 1 file changed, 7 deletions(-) diff --git a/doc/string.n b/doc/string.n index 3b9af03..f07a591 100644 --- a/doc/string.n +++ b/doc/string.n @@ -181,13 +181,6 @@ zero width no-break space (U+feff) (=BOM). .IP \fBtrue\fR 12 Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is true. -.IP \fBunicode\fR 12 -Any Unicode character, except surrogates and noncharacters. -.RS -.PP -\fIWarning: this option is under discussion and may be renamed or replaced -by another solution within the Tcl 9.0 series.\fR -.RE .IP \fBupper\fR 12 Any upper case alphabet character in the Unicode character set. .IP \fBwideinteger\fR 12 -- cgit v0.12 From 30fc8b220de8bcb39eb70aafb65f021f32f47f60 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 12 Feb 2024 14:43:01 +0000 Subject: Fix last "knownBug" in UTF-16 encoder (backported from 9.0) --- generic/tclEncoding.c | 41 +++++++++++++++++++++++++++++++++-------- tests/encodingVectors.tcl | 8 ++++---- 2 files changed, 37 insertions(+), 12 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index ba36f55..78d613d 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -200,12 +200,16 @@ static const struct TclEncodingProfiles { {"strict", TCL_ENCODING_PROFILE_STRICT}, {"tcl8", TCL_ENCODING_PROFILE_TCL8}, }; + #define PROFILE_STRICT(flags_) \ ((flags_) & TCL_ENCODING_PROFILE_STRICT) #define PROFILE_REPLACE(flags_) \ ((ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) && !PROFILE_STRICT(flags_)) +#define PROFILE_TCL8(flags_) \ + ((ENCODING_PROFILE_GET(flags_) != TCL_ENCODING_PROFILE_REPLACE) && !PROFILE_STRICT(flags_)) + #define UNICODE_REPLACE_CHAR ((Tcl_UniChar)0xFFFD) #define SURROGATE(c_) (((c_) & ~0x7FF) == 0xD800) #define HIGH_SURROGATE(c_) (((c_) & ~0x3FF) == 0xD800) @@ -3012,7 +3016,7 @@ Utf16ToUtfProc( dstStart = dst; dstEnd = dst + dstLen - TCL_UTF_MAX; - for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { + for (numChars = 0; src < srcEnd && numChars <= charLimit; src += 2, numChars++) { if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; break; @@ -3031,9 +3035,23 @@ Utf16ToUtfProc( dst--; /* Also undo writing a single byte too much */ numChars--; break; - } + } else if (PROFILE_REPLACE(flags)) { + /* + * Previous loop wrote a single byte to mark the high surrogate. + * Replace it with the replacement character. Further, restart + * current loop iteration since need to recheck destination space + * and reset processing of current character. + */ + ch = UNICODE_REPLACE_CHAR; + dst--; + dst += Tcl_UniCharToUtf(ch, dst); + src -= 2; + numChars--; + continue; + } else { /* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */ - dst += Tcl_UniCharToUtf(-1, dst); + dst += Tcl_UniCharToUtf(-1, dst); + } } /* @@ -3045,15 +3063,19 @@ Utf16ToUtfProc( *dst++ = (ch & 0xFF); } else if (HIGH_SURROGATE(prev) || HIGH_SURROGATE(ch)) { dst += Tcl_UniCharToUtf(ch, dst); - } else if (LOW_SURROGATE(ch) && PROFILE_STRICT(flags)) { - /* Lo surrogate not preceded by Hi surrogate */ - result = TCL_CONVERT_SYNTAX; - break; + } else if (LOW_SURROGATE(ch) && !PROFILE_TCL8(flags)) { + /* Lo surrogate not preceded by Hi surrogate and not tcl8 profile */ + if (PROFILE_STRICT(flags)) { + result = TCL_CONVERT_SYNTAX; + break; + } else { + /* PROFILE_REPLACE */ + dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst); + } } else { *dst = 0; /* In case of lower surrogate, don't try to combine */ dst += Tcl_UniCharToUtf(ch, dst); } - src += sizeof(unsigned short); } if (HIGH_SURROGATE(ch)) { @@ -3062,6 +3084,9 @@ Utf16ToUtfProc( src -= 2; dst--; numChars--; + } else if (PROFILE_REPLACE(flags)) { + dst--; + dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst); } else { /* Bug [10c2c17c32]. If Hi surrogate, finish 3-byte UTF-8 */ dst += Tcl_UniCharToUtf(-1, dst); diff --git a/tests/encodingVectors.tcl b/tests/encodingVectors.tcl index dfceab4..9b62f84 100644 --- a/tests/encodingVectors.tcl +++ b/tests/encodingVectors.tcl @@ -553,20 +553,20 @@ lappend encInvalidBytes {*}{ utf-16le 41 replace \uFFFD -1 {solo tail} {Truncated} utf-16le 41 strict {} 0 {solo tail} {Truncated} utf-16le 00D8 tcl8 \uD800 -1 {} {Missing low surrogate} - utf-16le 00D8 replace \uFFFD -1 {knownBug} {Missing low surrogate} + utf-16le 00D8 replace \uFFFD -1 {} {Missing low surrogate} utf-16le 00D8 strict {} 0 {} {Missing low surrogate} utf-16le 00DC tcl8 \uDC00 -1 {} {Missing high surrogate} - utf-16le 00DC replace \uFFFD -1 {knownBug} {Missing high surrogate} + utf-16le 00DC replace \uFFFD -1 {} {Missing high surrogate} utf-16le 00DC strict {} 0 {} {Missing high surrogate} utf-16be 41 tcl8 \uFFFD -1 {solo tail} {Truncated} utf-16be 41 replace \uFFFD -1 {solo tail} {Truncated} utf-16be 41 strict {} 0 {solo tail} {Truncated} utf-16be D800 tcl8 \uD800 -1 {} {Missing low surrogate} - utf-16be D800 replace \uFFFD -1 {knownBug} {Missing low surrogate} + utf-16be D800 replace \uFFFD -1 {} {Missing low surrogate} utf-16be D800 strict {} 0 {} {Missing low surrogate} utf-16be DC00 tcl8 \uDC00 -1 {} {Missing high surrogate} - utf-16be DC00 replace \uFFFD -1 {knownBug} {Missing high surrogate} + utf-16be DC00 replace \uFFFD -1 {} {Missing high surrogate} utf-16be DC00 strict {} 0 {} {Missing high surrogate} } -- cgit v0.12 From 07181fbe1e09709ceec52380ea7ead77692bf8c8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 12 Feb 2024 15:26:23 +0000 Subject: Code cleanup (also backported from 9.0) --- generic/tclEncoding.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 78d613d..1cba87e 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2044,7 +2044,7 @@ LoadTableEncoding( }; Tcl_DStringInit(&lineString); - if (Tcl_Gets(chan, &lineString) == TCL_IO_FAILURE) { + if (Tcl_Gets(chan, &lineString) < 0) { return NULL; } line = Tcl_DStringValue(&lineString); @@ -2583,10 +2583,10 @@ UtfToUtfProc( } else if (!Tcl_UtfCharComplete(src, srcEnd - src)) { /* * Incomplete byte sequence. - * Always check before using Tcl_UtfToUniChar. Not doing can so - * cause it run beyond the end of the buffer! If we happen such an - * incomplete char its bytes are made to represent themselves - * unless the user has explicitly asked to be told. + * Always check before using Tcl_UtfToUniChar. Not doing so can cause + * it to run beyond the end of the buffer! If we happen on such an + * incomplete char its bytes are made to represent themselves unless + * the user has explicitly asked to be told. */ if (flags & ENCODING_INPUT) { @@ -3536,8 +3536,9 @@ TableFromUtfProc( /* Unicode chars > +U0FFFF cannot be represented in any table encoding */ if (ch & 0xFFFF0000) { word = 0; - } else + } else { word = fromUnicode[(ch >> 8)][ch & 0xFF]; + } if ((word == 0) && (ch != 0)) { if (PROFILE_STRICT(flags)) { @@ -3723,8 +3724,7 @@ Iso88591FromUtfProc( * Check for illegal characters. */ - if (ch > 0xFF - ) { + if (ch > 0xFF) { if (PROFILE_STRICT(flags)) { result = TCL_CONVERT_UNKNOWN; break; -- cgit v0.12 From a868b5be5e91ce4137cce12a45b36007f18d1707 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 12 Feb 2024 21:55:57 +0000 Subject: More code cleanup --- generic/tclEncoding.c | 38 +++++++++++++++++--------------------- 1 file changed, 17 insertions(+), 21 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 1cba87e..0658d21 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -210,7 +210,7 @@ static const struct TclEncodingProfiles { #define PROFILE_TCL8(flags_) \ ((ENCODING_PROFILE_GET(flags_) != TCL_ENCODING_PROFILE_REPLACE) && !PROFILE_STRICT(flags_)) -#define UNICODE_REPLACE_CHAR ((Tcl_UniChar)0xFFFD) +#define UNICODE_REPLACE_CHAR 0xFFFD #define SURROGATE(c_) (((c_) & ~0x7FF) == 0xD800) #define HIGH_SURROGATE(c_) (((c_) & ~0x3FF) == 0xD800) #define LOW_SURROGATE(c_) (((c_) & ~0x3FF) == 0xDC00) @@ -2559,10 +2559,9 @@ UtfToUtfProc( *dst++ = *src++; } else if ((UCHAR(*src) == 0xC0) && (src + 1 < srcEnd) && (UCHAR(src[1]) == 0x80) && - (!(flags & ENCODING_INPUT) || PROFILE_STRICT(profile) || - PROFILE_REPLACE(profile))) { + (!(flags & ENCODING_INPUT) || !PROFILE_TCL8(profile))) { /* Special sequence \xC0\x80 */ - if ((PROFILE_STRICT(profile) || PROFILE_REPLACE(profile)) && (flags & ENCODING_INPUT)) { + if (!PROFILE_TCL8(profile) && (flags & ENCODING_INPUT)) { if (PROFILE_REPLACE(profile)) { dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst); src += 2; @@ -2610,15 +2609,9 @@ UtfToUtfProc( dst += Tcl_UniCharToUtf(ch, dst); } else { int low; - int isInvalid = 0; size_t len = Tcl_UtfToUniChar(src, &ch); if (flags & ENCODING_INPUT) { - if ((len < 2) && (ch != 0)) { - isInvalid = 1; - } else if ((ch > 0xFFFF) && !(flags & ENCODING_UTF)) { - isInvalid = 1; - } - if (isInvalid) { + if (((len < 2) && (ch != 0)) || ((ch > 0xFFFF) && !(flags & ENCODING_UTF))) { if (PROFILE_STRICT(profile)) { result = TCL_CONVERT_SYNTAX; break; @@ -2672,7 +2665,7 @@ cesu8: dst += Tcl_UniCharToUtf(ch, dst); ch = low; } - } else if (PROFILE_STRICT(profile) && SURROGATE(ch)) { + } else if (SURROGATE(ch) && PROFILE_STRICT(profile)) { result = (flags & ENCODING_INPUT) ? TCL_CONVERT_SYNTAX : TCL_CONVERT_UNKNOWN; src = saveSrc; break; @@ -2783,17 +2776,20 @@ Utf32ToUtfProc( } if ((unsigned)ch > 0x10FFFF) { - ch = UNICODE_REPLACE_CHAR; if (PROFILE_STRICT(flags)) { result = TCL_CONVERT_SYNTAX; break; } - } else if (PROFILE_STRICT(flags) && SURROGATE(ch)) { - result = TCL_CONVERT_SYNTAX; - ch = 0; - break; - } else if (PROFILE_REPLACE(flags) && SURROGATE(ch)) { ch = UNICODE_REPLACE_CHAR; + } else if (SURROGATE(ch)) { + if (PROFILE_STRICT(flags)) { + result = TCL_CONVERT_SYNTAX; + ch = 0; + break; + } + if (PROFILE_REPLACE(flags)) { + ch = UNICODE_REPLACE_CHAR; + } } /* @@ -3413,7 +3409,7 @@ TableToUtfProc( ch = UNICODE_REPLACE_CHAR; } else { /* For prefix bytes, we don't fallback to cp1252, see [1355b9a874] */ - ch = (Tcl_UniChar)byte; + ch = byte; } } else { ch = toUnicode[byte][*((unsigned char *)++src)]; @@ -3632,7 +3628,7 @@ Iso88591ToUtfProc( result = TCL_CONVERT_NOSPACE; break; } - ch = (Tcl_UniChar) *((unsigned char *) src); + ch = *((unsigned char *) src); /* * Special case for 1-byte utf chars for speed. @@ -3733,7 +3729,7 @@ Iso88591FromUtfProc( * Plunge on, using '?' as a fallback character. */ - ch = (Tcl_UniChar) '?'; /* Profiles TCL8 and REPLACE */ + ch = '?'; /* Profiles TCL8 and REPLACE */ } if (dst > dstEnd) { -- cgit v0.12 From b4dd924630f9b57f975bfbc821af407a51f1a87e Mon Sep 17 00:00:00 2001 From: griffin Date: Thu, 15 Feb 2024 01:50:53 +0000 Subject: Fix bug 578b7e273c03. -- Round computed end value to match precision of given arguments. --- generic/tclArithSeries.c | 6 +++++- tests/lseq.test | 19 +++++++++++++++++++ 2 files changed, 24 insertions(+), 1 deletion(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 1a244db..4ab0087 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -553,8 +553,12 @@ TclNewArithSeriesObj( if (!endObj) { if (useDoubles) { + // Compute precision based on given command argument values + int precision = maxPrecision(dstart,len,dstep); dend = dstart + (dstep * (len-1)); - end = dend; + // Make computed end value match argument(s) precision + dend = ArithRound(dend, precision); + end = dend; } else { end = start + (step * (len-1)); dend = end; diff --git a/tests/lseq.test b/tests/lseq.test index 7e25654..02e5e38 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -773,6 +773,25 @@ test lseq-bug-54329e39c7 {does not cause memory bloat} -constraints { expr {[string match *purify* [tcl::build-info]] || ($postmem - $premem < 10) ? 1 : ($postmem - $premem)} } -result 1 +test lseq-bug-578b7e273c03-1 {Arithmetic Series Objects get wrong precision when end value is not specified} -body { + set bl [expr {2.8 in [lseq 0 count 100 by .1]}] + lappend bl [expr {2.8 in [lseq 0 count 200 by .1]}] + lappend bl [expr {0.28 in [lseq 0 count 100 by .01]}] + lappend bl [expr {0.28 in [lseq 0 count 200 by .01]}] + lappend bl [expr {0.286 in [lseq 0 count 100 by .011]}] + lappend bl [expr {0.286 in [lseq 0 count 200 by .011]}] +} -result {1 1 1 1 1 1} + +test lseq-bug-578b7e273c03-2 {Arithmetic Series Objects get wrong precision when end value is not specified} -body { + set ll [llength [lseq 0 count 100 by .1]] + lappend ll [llength [lseq 0 count 200 by .1]] + lappend ll [llength [lseq 0 count 100 by .01]] + lappend ll [llength [lseq 0 count 200 by .01]] + lappend ll [llength [lseq 0 count 100 by .011]] + lappend ll [llength [lseq 0 count 200 by .011]] +} -result {100 200 100 200 100 200} + + # cleanup ::tcltest::cleanupTests -- cgit v0.12 From 15b428af9487d181a0628252f83e1ba260410808 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 15 Feb 2024 20:33:17 +0000 Subject: Fix [578b7e273c03]: Round computed end value to match precision of given arguments --- generic/tclArithSeries.c | 13 +++++++++---- tests/lseq.test | 19 +++++++++++++++++++ 2 files changed, 28 insertions(+), 4 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 34fd635..a29b589 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -245,7 +245,7 @@ DupArithSeriesInternalRep( ArithSeriesDbl *srcArithSeriesDblRepPtr = (ArithSeriesDbl *)srcArithSeriesRepPtr; ArithSeriesDbl *copyArithSeriesDblRepPtr = - (ArithSeriesDbl *) ckalloc(sizeof(ArithSeriesDbl)); + (ArithSeriesDbl *)ckalloc(sizeof(ArithSeriesDbl)); *copyArithSeriesDblRepPtr = *srcArithSeriesDblRepPtr; copyArithSeriesDblRepPtr->elements = NULL; copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesDblRepPtr; @@ -327,7 +327,7 @@ NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_Wide return arithSeriesObj; } - arithSeriesRepPtr = (ArithSeries*) ckalloc(sizeof (ArithSeries)); + arithSeriesRepPtr = (ArithSeries*)ckalloc(sizeof (ArithSeries)); arithSeriesRepPtr->isDouble = 0; arithSeriesRepPtr->start = start; arithSeriesRepPtr->end = end; @@ -381,7 +381,7 @@ NewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len) return arithSeriesObj; } - arithSeriesRepPtr = (ArithSeriesDbl*) ckalloc(sizeof (ArithSeriesDbl)); + arithSeriesRepPtr = (ArithSeriesDbl*)ckalloc(sizeof (ArithSeriesDbl)); arithSeriesRepPtr->isDouble = 1; arithSeriesRepPtr->start = start; arithSeriesRepPtr->end = end; @@ -533,7 +533,11 @@ TclNewArithSeriesObj( if (!endObj) { if (useDoubles) { + // Compute precision based on given command argument values + int precision = maxPrecision(dstart,len,dstep); dend = dstart + (dstep * (len-1)); + // Make computed end value match argument(s) precision + dend = ArithRound(dend, precision); end = dend; } else { end = start + (step * (len-1)); @@ -642,6 +646,7 @@ Tcl_Size TclArithSeriesObjLength(Tcl_Obj *arithSeriesObj) * None. *---------------------------------------------------------------------- */ + Tcl_Obj * ArithSeriesObjStep( Tcl_Obj *arithSeriesObj) @@ -1094,7 +1099,7 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr) if (length > 0) arithSeriesObjPtr->bytes[length-1] = '\0'; arithSeriesObjPtr->length = length-1; } - + /* * Local Variables: * mode: c diff --git a/tests/lseq.test b/tests/lseq.test index 4c1f14b..2a7de67 100644 --- a/tests/lseq.test +++ b/tests/lseq.test @@ -692,6 +692,25 @@ test lseq-bug-54329e39c7 {does not cause memory bloat} -constraints { expr {($postmem - $premem) < 10} } -result 1 +test lseq-bug-578b7e273c03-1 {Arithmetic Series Objects get wrong precision when end value is not specified} -body { + set bl [expr {2.8 in [lseq 0 count 100 by .1]}] + lappend bl [expr {2.8 in [lseq 0 count 200 by .1]}] + lappend bl [expr {0.28 in [lseq 0 count 100 by .01]}] + lappend bl [expr {0.28 in [lseq 0 count 200 by .01]}] + lappend bl [expr {0.286 in [lseq 0 count 100 by .011]}] + lappend bl [expr {0.286 in [lseq 0 count 200 by .011]}] +} -result {1 1 1 1 1 1} + +test lseq-bug-578b7e273c03-2 {Arithmetic Series Objects get wrong precision when end value is not specified} -body { + set ll [llength [lseq 0 count 100 by .1]] + lappend ll [llength [lseq 0 count 200 by .1]] + lappend ll [llength [lseq 0 count 100 by .01]] + lappend ll [llength [lseq 0 count 200 by .01]] + lappend ll [llength [lseq 0 count 100 by .011]] + lappend ll [llength [lseq 0 count 200 by .011]] +} -result {100 200 100 200 100 200} + + # cleanup ::tcltest::cleanupTests -- cgit v0.12 From 251a6ca09376a5e45959689bc19ec37aae374b4a Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 16 Feb 2024 14:17:09 +0000 Subject: Reduce the number of warnings on Windows: channel names generated in one place --- win/tclWinChan.c | 33 ++++++++++++++++++++++++++++++--- win/tclWinConsole.c | 2 +- win/tclWinInt.h | 3 ++- win/tclWinPipe.c | 2 +- win/tclWinSerial.c | 3 +-- win/tclWinSock.c | 19 +++++++++---------- 6 files changed, 44 insertions(+), 18 deletions(-) diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 8743afe..5f03138 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -145,6 +145,33 @@ static const Tcl_ChannelType fileChannelType = { /* *---------------------------------------------------------------------- * + * TclWinGenerateChannelName -- + * + * This function generates names for channels. + * + * Results: + * None. + * + * Side effects: + * Creates a new window and creates an exit handler. + * + *---------------------------------------------------------------------- + */ +void +TclWinGenerateChannelName( + char channelName[], /* Buffer to accept the name. */ + const char *channelTypeName,/* Name of type of channel. */ + void *channelImpl) /* Pointer to channel implementation + * structure, used to generate a unique + * ID. */ +{ + snprintf(channelName, 16 + TCL_INTEGER_SPACE, "%s%" TCL_Z_MODIFIER "x", + channelTypeName, (size_t) channelImpl); +} + +/* + *---------------------------------------------------------------------- + * * FileInit -- * * This function creates the window used to simulate file events. @@ -1488,7 +1515,8 @@ OpenFileChannel( for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->handle == (HANDLE) handle) { - return ((permissions & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION))==infoPtr->validMask) ? infoPtr->channel : NULL; + return ((permissions & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION))==infoPtr->validMask) + ? infoPtr->channel : NULL; } } @@ -1506,8 +1534,7 @@ OpenFileChannel( infoPtr->flags = appendMode; infoPtr->handle = handle; infoPtr->dirty = 0; - snprintf(channelName, 16 + TCL_INTEGER_SPACE, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr); - + TclWinGenerateChannelName(channelName, "file", infoPtr); infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName, infoPtr, permissions); diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 5b30fc4..eb81370 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -2116,7 +2116,7 @@ TclWinOpenConsoleChannel( * for instance). */ - snprintf(channelName, 16 + TCL_INTEGER_SPACE, "file%" TCL_Z_MODIFIER "x", (size_t) chanInfoPtr); + TclWinGenerateChannelName(channelName, "file", chanInfoPtr); if (permissions & TCL_READABLE) { /* diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 1267f3f..6de1432 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -52,7 +52,8 @@ MODULE_SCOPE int TclWinSymLinkCopyDirectory(const WCHAR *LinkOriginal, MODULE_SCOPE int TclWinSymLinkDelete(const WCHAR *LinkOriginal, int linkOnly); MODULE_SCOPE int TclWinFileOwned(Tcl_Obj *); - +MODULE_SCOPE void TclWinGenerateChannelName(char channelName[], + const char *channelTypeName, void *channelImpl); MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr); /* Needed by tclWinFile.c and tclWinFCmd.c */ diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 5a18ee3..60764e6 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1837,7 +1837,7 @@ TclpCreateCommandChannel( * unique, in case channels share handles (stdin/stdout). */ - snprintf(channelName, sizeof(channelName), "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr); + TclWinGenerateChannelName(channelName, "file", infoPtr); infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName, infoPtr, infoPtr->validMask); diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 48a0ffc..14f36fd 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -1476,8 +1476,7 @@ TclWinOpenSerialChannel( * are shared between multiple channels (stdin/stdout). */ - snprintf(channelName, 16 + TCL_INTEGER_SPACE, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr); - + TclWinGenerateChannelName(channelName, "file", infoPtr); infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, infoPtr, permissions); diff --git a/win/tclWinSock.c b/win/tclWinSock.c index f54d8a1..3fab851 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -265,7 +265,7 @@ static Tcl_DriverGetHandleProc TcpGetHandleProc; static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Close proc. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -2022,8 +2022,7 @@ Tcl_OpenTcpClient( return NULL; } - snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, statePtr); - + TclWinGenerateChannelName(channelName, "sock", statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, (TCL_READABLE | TCL_WRITABLE)); if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel, @@ -2056,7 +2055,7 @@ Tcl_OpenTcpClient( Tcl_Channel Tcl_MakeTcpClientChannel( - void *sock) /* The socket to wrap up into a channel. */ + void *sock) /* The socket to wrap up into a channel. */ { TcpState *statePtr; char channelName[SOCK_CHAN_LENGTH]; @@ -2081,7 +2080,7 @@ Tcl_MakeTcpClientChannel( statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE; SendSelectMessage(tsdPtr, SELECT, statePtr); - snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, statePtr); + TclWinGenerateChannelName(channelName, "sock", statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, (TCL_READABLE | TCL_WRITABLE)); Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf"); @@ -2253,7 +2252,7 @@ Tcl_OpenTcpServerEx( statePtr->acceptProc = acceptProc; statePtr->acceptProcData = acceptProcData; - snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, statePtr); + TclWinGenerateChannelName(channelName, "sock", statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, 0); /* @@ -2307,9 +2306,9 @@ Tcl_OpenTcpServerEx( static void TcpAccept( - TcpFdList *fds, /* Server socket that accepted newSocket. */ - SOCKET newSocket, /* Newly accepted socket. */ - address addr) /* Address of new socket. */ + TcpFdList *fds, /* Server socket that accepted newSocket. */ + SOCKET newSocket, /* Newly accepted socket. */ + address addr) /* Address of new socket. */ { TcpState *newInfoPtr; TcpState *statePtr = fds->statePtr; @@ -2338,7 +2337,7 @@ TcpAccept( newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE); SendSelectMessage(tsdPtr, SELECT, newInfoPtr); - snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, newInfoPtr); + TclWinGenerateChannelName(channelName, "sock", statePtr); newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation", -- cgit v0.12 From e398bf9e9b2eda4004f052c76003536c5dd74ad4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 16 Feb 2024 14:43:11 +0000 Subject: (cherry-pick) Reduce the number of warnings on Windows: channel names generated in one place --- win/tclWinChan.c | 33 ++++++++++++++++++++++++++++++--- win/tclWinConsole.c | 2 +- win/tclWinInt.h | 3 ++- win/tclWinPipe.c | 2 +- win/tclWinSerial.c | 3 +-- win/tclWinSock.c | 17 ++++++++--------- 6 files changed, 43 insertions(+), 17 deletions(-) diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 3be06c3..a8a757d 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -153,6 +153,33 @@ static const Tcl_ChannelType fileChannelType = { /* *---------------------------------------------------------------------- * + * TclWinGenerateChannelName -- + * + * This function generates names for channels. + * + * Results: + * None. + * + * Side effects: + * Creates a new window and creates an exit handler. + * + *---------------------------------------------------------------------- + */ +void +TclWinGenerateChannelName( + char channelName[], /* Buffer to accept the name. */ + const char *channelTypeName,/* Name of type of channel. */ + void *channelImpl) /* Pointer to channel implementation + * structure, used to generate a unique + * ID. */ +{ + snprintf(channelName, 16 + TCL_INTEGER_SPACE, "%s%" TCL_Z_MODIFIER "x", + channelTypeName, (size_t) channelImpl); +} + +/* + *---------------------------------------------------------------------- + * * FileInit -- * * This function creates the window used to simulate file events. @@ -1576,7 +1603,8 @@ OpenFileChannel( for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { if (infoPtr->handle == (HANDLE) handle) { - return ((permissions & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION))==infoPtr->validMask) ? infoPtr->channel : NULL; + return ((permissions & (TCL_READABLE|TCL_WRITABLE|TCL_EXCEPTION))==infoPtr->validMask) + ? infoPtr->channel : NULL; } } @@ -1594,8 +1622,7 @@ OpenFileChannel( infoPtr->flags = appendMode; infoPtr->handle = handle; infoPtr->dirty = 0; - snprintf(channelName, 16 + TCL_INTEGER_SPACE, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr); - + TclWinGenerateChannelName(channelName, "file", infoPtr); infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName, infoPtr, permissions); diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index e1ca46a..25c4065 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -2115,7 +2115,7 @@ TclWinOpenConsoleChannel( * for instance). */ - snprintf(channelName, 16 + TCL_INTEGER_SPACE, "file%" TCL_Z_MODIFIER "x", (size_t) chanInfoPtr); + TclWinGenerateChannelName(channelName, "file", chanInfoPtr); if (permissions & TCL_READABLE) { /* diff --git a/win/tclWinInt.h b/win/tclWinInt.h index d5cf7b0..dfe4d10 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -52,7 +52,8 @@ MODULE_SCOPE int TclWinSymLinkCopyDirectory(const WCHAR *LinkOriginal, MODULE_SCOPE int TclWinSymLinkDelete(const WCHAR *LinkOriginal, int linkOnly); MODULE_SCOPE int TclWinFileOwned(Tcl_Obj *); - +MODULE_SCOPE void TclWinGenerateChannelName(char channelName[], + const char *channelTypeName, void *channelImpl); MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr); /* Needed by tclWinFile.c and tclWinFCmd.c */ diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 9cf8271..5c0f95e 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1832,7 +1832,7 @@ TclpCreateCommandChannel( * unique, in case channels share handles (stdin/stdout). */ - snprintf(channelName, sizeof(channelName), "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr); + TclWinGenerateChannelName(channelName, "file", infoPtr); infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName, infoPtr, infoPtr->validMask); diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index cc72762..7e6b76a 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -1476,8 +1476,7 @@ TclWinOpenSerialChannel( * are shared between multiple channels (stdin/stdout). */ - snprintf(channelName, 16 + TCL_INTEGER_SPACE, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr); - + TclWinGenerateChannelName(channelName, "file", infoPtr); infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, infoPtr, permissions); diff --git a/win/tclWinSock.c b/win/tclWinSock.c index c34835b..4480170 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -2026,8 +2026,7 @@ Tcl_OpenTcpClient( return NULL; } - snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, statePtr); - + TclWinGenerateChannelName(channelName, "sock", statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, (TCL_READABLE | TCL_WRITABLE)); if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel, @@ -2060,7 +2059,7 @@ Tcl_OpenTcpClient( Tcl_Channel Tcl_MakeTcpClientChannel( - void *sock) /* The socket to wrap up into a channel. */ + void *sock) /* The socket to wrap up into a channel. */ { TcpState *statePtr; char channelName[SOCK_CHAN_LENGTH]; @@ -2085,7 +2084,7 @@ Tcl_MakeTcpClientChannel( statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE; SendSelectMessage(tsdPtr, SELECT, statePtr); - snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, statePtr); + TclWinGenerateChannelName(channelName, "sock", statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, (TCL_READABLE | TCL_WRITABLE)); Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf"); @@ -2257,7 +2256,7 @@ Tcl_OpenTcpServerEx( statePtr->acceptProc = acceptProc; statePtr->acceptProcData = acceptProcData; - snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, statePtr); + TclWinGenerateChannelName(channelName, "sock", statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, 0); /* @@ -2311,9 +2310,9 @@ Tcl_OpenTcpServerEx( static void TcpAccept( - TcpFdList *fds, /* Server socket that accepted newSocket. */ - SOCKET newSocket, /* Newly accepted socket. */ - address addr) /* Address of new socket. */ + TcpFdList *fds, /* Server socket that accepted newSocket. */ + SOCKET newSocket, /* Newly accepted socket. */ + address addr) /* Address of new socket. */ { TcpState *newInfoPtr; TcpState *statePtr = fds->statePtr; @@ -2342,7 +2341,7 @@ TcpAccept( newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE); SendSelectMessage(tsdPtr, SELECT, newInfoPtr); - snprintf(channelName, sizeof(channelName), SOCK_TEMPLATE, newInfoPtr); + TclWinGenerateChannelName(channelName, "sock", statePtr); newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation", -- cgit v0.12 From 686ba2e1639a26ca34c484b93ab918fe1ea6f0c2 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 16 Feb 2024 16:23:28 +0000 Subject: Derpfix... --- win/tclWinSock.c | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 3fab851..d600f1f 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -65,8 +65,7 @@ #define GOT_BITS(var, bits) (((var) & (bits)) != 0) /* "sock" + a pointer in hex + \0 */ -#define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1) -#define SOCK_TEMPLATE "sock%p" +#define SOCK_CHAN_LENGTH (16 + TCL_INTEGER_SPACE) /* * The following variable is used to tell whether this module has been @@ -2337,7 +2336,7 @@ TcpAccept( newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE); SendSelectMessage(tsdPtr, SELECT, newInfoPtr); - TclWinGenerateChannelName(channelName, "sock", statePtr); + TclWinGenerateChannelName(channelName, "sock", newInfoPtr); newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation", -- cgit v0.12 From 0dac17801b9a5233f25fd0d2a77fe1ff900a0341 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 16 Feb 2024 16:59:53 +0000 Subject: (Cherry-pick): Derpfix... --- win/tclWinSock.c | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 4480170..9a3b127 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -65,8 +65,7 @@ #define GOT_BITS(var, bits) (((var) & (bits)) != 0) /* "sock" + a pointer in hex + \0 */ -#define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1) -#define SOCK_TEMPLATE "sock%p" +#define SOCK_CHAN_LENGTH (16 + TCL_INTEGER_SPACE) /* * The following variable is used to tell whether this module has been @@ -2341,7 +2340,7 @@ TcpAccept( newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE); SendSelectMessage(tsdPtr, SELECT, newInfoPtr); - TclWinGenerateChannelName(channelName, "sock", statePtr); + TclWinGenerateChannelName(channelName, "sock", newInfoPtr); newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, newInfoPtr, (TCL_READABLE | TCL_WRITABLE)); if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation", -- cgit v0.12 From 94dfdc0521d6fef11b46b25fef9aefae34d0d5e5 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Mon, 19 Feb 2024 16:58:48 +0000 Subject: Starton [bda99f2393]. --- win/tclWinConsole.c | 45 ++++++++++++++++++++++++++++++--------------- 1 file changed, 30 insertions(+), 15 deletions(-) diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index eb81370..811577d 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -1630,9 +1630,16 @@ ConsoleReaderThread( { ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg; ConsoleHandleInfo **iterator; - char inputChars[200]; /* Temporary buffer */ Tcl_Size inputLen = 0; Tcl_Size inputOffset = 0; + Tcl_Size lastReadSize = 0; + DWORD sleepTime; + /* + * ReadConsole will limit input to the greater of 256 characters + * and the size of the input buffer. 8.6 used 8192 (4096 chars) + * and so do we. + */ + char inputChars[8192]; /* * Keep looping until one of the following happens. @@ -1666,7 +1673,6 @@ ConsoleReaderThread( Tcl_Size nStored; assert((inputLen - inputOffset) > 0); - nStored = RingBufferIn(&handleInfoPtr->buffer, inputOffset + inputChars, inputLen - inputOffset, @@ -1713,21 +1719,27 @@ ConsoleReaderThread( continue; } + assert(inputLen == 0); + /* - * Both shared buffer and private buffer are empty. Need to go get - * data from console but do not want to read ahead because the - * interp thread might change the read mode, e.g. turning off echo - * for password input. So only do so if at least one interpreter has - * requested data. + * Read more data in two cases: + * 1. The previous read filled the buffer and there could be more + * data in the console internal *text* buffer. Note + * ConsolePendingInput (checked in ConsoleDataAvailable) will NOT + * show this. It holds input events not yet translated to text. + * 2. Tcl threads want more data AND there is data in the + * ConsolePendingInput buffer. The latter check necessary because + * we do not want to read ahead because the interp thread might + * change the read mode, e.g. turning off echo for password + * input. So only do so if at least one interpreter has requested + * data. */ - if ((handleInfoPtr->flags & CONSOLE_DATA_AWAITED) - && ConsoleDataAvailable(handleInfoPtr->console)) { + if (lastReadSize == sizeof(inputChars) + || ((handleInfoPtr->flags & CONSOLE_DATA_AWAITED) + && ConsoleDataAvailable(handleInfoPtr->console))) { DWORD error; /* Do not hold the lock while blocked in console */ ReleaseSRWLockExclusive(&handleInfoPtr->lock); - /* - * Note - the temporary buffer serves two purposes. It - */ error = ReadConsoleChars(handleInfoPtr->console, (WCHAR *)inputChars, sizeof(inputChars) / sizeof(WCHAR), @@ -1735,17 +1747,21 @@ ConsoleReaderThread( AcquireSRWLockExclusive(&handleInfoPtr->lock); if (error == 0) { inputLen *= sizeof(WCHAR); - } else { + lastReadSize = inputLen; + } + else { /* * We only store the last error. It is up to channel * handlers whether to close or not in case of errors. */ + lastReadSize = 0; handleInfoPtr->lastError = error; if (handleInfoPtr->lastError == ERROR_INVALID_HANDLE) { handleInfoPtr->console = INVALID_HANDLE_VALUE; } } - } else { + } + else { /* * Either no one was asking for data, or no data was available. * In the former case, wait until someone wakes us asking for @@ -1753,7 +1769,6 @@ ConsoleReaderThread( * poll since ReadConsole does not support async operation. * So sleep for a short while and loop back to retry. */ - DWORD sleepTime; sleepTime = handleInfoPtr->flags & CONSOLE_DATA_AWAITED ? 50 : INFINITE; SleepConditionVariableSRW(&handleInfoPtr->consoleThreadCV, -- cgit v0.12 From c36be265ae1d7788bc9a20c4bd733de2e548b387 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Tue, 20 Feb 2024 05:47:19 +0000 Subject: Fix EOF test for TIP 646. Add tests for Bug [bda99f2393]. Remove Scriptics copyright (none of their code remains). --- tests/winConsole.test | 61 +++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 54 insertions(+), 7 deletions(-) diff --git a/tests/winConsole.test b/tests/winConsole.test index 5aa130b..3597fe3 100644 --- a/tests/winConsole.test +++ b/tests/winConsole.test @@ -4,18 +4,17 @@ # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # -# Copyright © 1999 Scriptics Corporation. +# NOTE THIS CANNOT BE RUN VIA nmake/make test since stdin is connected to +# nmake in that case. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {"::tcltest" ni [namespace children]} { - package require tcltest 2.5 - namespace import -force ::tcltest::* -} +package require tcltest +namespace import ::tcltest::test -catch {package require twapi} ;# Only to bring window to foreground. Not critical +catch {package require twapi} ;# Only to bring window to foreground. Not critical ::tcltest::ConstraintInitializer haveThread { expr {![catch {package require Thread}]} } # Prompt user for a yes/no response @@ -155,6 +154,54 @@ test console-input-2.1 {Console file channel: non-blocking read} -constraints { set result } -result abc +test console-input-3.0 {Console gets blocking - long lines bug-bda99f2393} -constraints { + win interactive bug-bda99f2393 +} -body { + prompt "Try typing a line of at least 256 characters. Hit ENTER exactly once unless you don't see another prompt.\n" + gets stdin line + set len [string length $line] + list [yesno "Did you hit ENTER only once?"] [expr {$len > 256}] [yesno "Line length was $len characters. Is this correct?"] +} -result {1 1 1} + +test console-input-3.1 {Console gets blocking, small channel buffer size - long lines bug-bda99f2393} -constraints { + win interactive bug-bda99f2393 +} -body { + prompt "Try typing a line of at least 256 characters. Hit ENTER exactly once unless you don't see another prompt.\n" + set bufSize [fconfigure stdin -buffersize] + fconfigure stdin -buffersize 10 + gets stdin line + fconfigure stdin -buffersize $bufSize + set len [string length $line] + list [yesno "Did you hit ENTER only once?"] [expr {$len > 256}] [yesno "Line length was $len characters. Is this correct?"] +} -result {1 1 1} + +test console-input-3.2 {Console gets nonblocking - long lines bug-bda99f2393} -constraints { + win interactive bug-bda99f2393 +} -body { + prompt "Try typing a line of at least 256 characters. Hit ENTER exactly once unless you don't see another prompt.\n" + fconfigure stdin -blocking 0 + while {[gets stdin line] < 0} { + after 1000 + } + fconfigure stdin -blocking 1 + set len [string length $line] + list [yesno "Did you hit ENTER only once?"] [expr {$len > 256}] [yesno "Line length was $len characters. Is this correct?"] +} -result {1 1 1} + +test console-input-3.3 {Console gets nonblocking small channel buffer size - long lines bug-bda99f2393} -constraints { + win interactive bug-bda99f2393 +} -body { + prompt "Try typing a line of at least 256 characters. Hit ENTER exactly once unless you don't see another prompt.\n" + set bufSize [fconfigure stdin -buffersize] + fconfigure stdin -blocking 0 -buffersize 10 + while {[gets stdin line] < 0} { + after 1000 + } + fconfigure stdin -blocking 1 -buffersize $bufSize + set len [string length $line] + list [yesno "Did you hit ENTER only once?"] [expr {$len > 256}] [yesno "Line length was $len characters. Is this correct?"] +} -result {1 1 1} + # Output tests test console-output-1.0 {Console blocking puts stdout} -constraints {win interactive} -body { @@ -218,7 +265,7 @@ test console-fconfigure-get-1.[incr testnum] { Console get stdin option -eofchar } -constraints {win interactive} -body { fconfigure stdin -eofchar -} -result \x1A +} -result "" test console-fconfigure-get-1.[incr testnum] { fconfigure -winsize -- cgit v0.12 From 3fcdde4cd85e844e30444cba2cbd2708b80e78be Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Tue, 20 Feb 2024 05:49:14 +0000 Subject: Bump blocking read buffer size to 8192 irrespective of Tcl channel buffer size --- win/tclWinConsole.c | 41 ++++++++++++++++++++++++++--------------- 1 file changed, 26 insertions(+), 15 deletions(-) diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 811577d..acd5851 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -70,14 +70,23 @@ static int gInitialized = 0; /* - * Permit CONSOLE_BUFFER_SIZE to be defined on build command for stress test. - * + * INPUT_BUFFER_SIZE is size of buffer passed to ReadConsole in bytes. + * Note that ReadConsole will only allow reading of line lengths up to the + * max of 256 and buffer size passed to it. So dropping this below 512 + * means user can type at most 256 chars. + */ +#ifndef INPUT_BUFFER_SIZE +#define INPUT_BUFFER_SIZE 8192 /* In bytes, so 4096 chars */ +#endif + +/* + * CONSOLE_BUFFER_SIZE is size of storage used in ring buffers. * In theory, at least sizeof(WCHAR) but note the Tcl channel bug * https://core.tcl-lang.org/tcl/tktview/b3977d199b08e3979a8da970553d5209b3042e9c * will cause failures in test suite if close to max input line in the suite. */ #ifndef CONSOLE_BUFFER_SIZE -#define CONSOLE_BUFFER_SIZE 8000 /* In bytes */ +#define CONSOLE_BUFFER_SIZE 8192 /* In bytes */ #endif /* @@ -1143,15 +1152,22 @@ ConsoleInputProc( /* * Blocking read. Just get data from directly from console. There - * is a small complication in that we can only read even number - * of bytes (wide-character API) and the destination buffer should be - * WCHAR aligned. If either condition is not met, we defer to the - * reader thread which handles these case rather than dealing with + * is a small complication in that + * 1. The destination buffer should be WCHAR aligned. + * 2. We can only read even number of bytes (wide-character API). + * 3. Caller has large enough buffer (else length of line user can + * enter will be limited) + * If any condition is not met, we defer to the + * reader thread which handles these cases rather than dealing with * them here (which is a little trickier than it might sound.) + * + * TODO - not clear this block is a useful optimization. bufSize by + * default is 4K which is < INPUT_BUFFER_SIZE and will rarely be + * increased on stdin. */ if ((1 & (size_t)bufPtr) == 0 /* aligned buffer */ - && bufSize > 1 /* Not single byte read */ - ) { + && (1 & bufSize) == 0 /* Even number of bytes */ + && bufSize > INPUT_BUFFER_SIZE) { DWORD lastError; Tcl_Size numChars; ReleaseSRWLockExclusive(&handleInfoPtr->lock); @@ -1634,12 +1650,7 @@ ConsoleReaderThread( Tcl_Size inputOffset = 0; Tcl_Size lastReadSize = 0; DWORD sleepTime; - /* - * ReadConsole will limit input to the greater of 256 characters - * and the size of the input buffer. 8.6 used 8192 (4096 chars) - * and so do we. - */ - char inputChars[8192]; + char inputChars[INPUT_BUFFER_SIZE]; /* * Keep looping until one of the following happens. -- cgit v0.12 From b6a43c5f6623eaf2f481a3c2163487758fcf5701 Mon Sep 17 00:00:00 2001 From: oehhar Date: Tue, 20 Feb 2024 16:47:28 +0000 Subject: Ticket [2f4b495427]: document TIP 445 API functions. --- doc/ObjectType.3 | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 61 insertions(+), 1 deletion(-) diff --git a/doc/ObjectType.3 b/doc/ObjectType.3 index 7e3cc12..aeaac5c 100644 --- a/doc/ObjectType.3 +++ b/doc/ObjectType.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_RegisterObjType, Tcl_GetObjType, Tcl_AppendAllObjTypes, Tcl_ConvertToType \- manipulate Tcl value types +Tcl_RegisterObjType, Tcl_GetObjType, Tcl_AppendAllObjTypes, Tcl_ConvertToType, Tcl_FreeInternalRep, Tcl_InitStringRep, Tcl_HasStringRep, Tcl_StoreInternalRep, Tcl_FetchInternalRep \- manipulate Tcl value types .SH SYNOPSIS .nf \fB#include \fR @@ -23,6 +23,21 @@ int .sp int \fBTcl_ConvertToType\fR(\fIinterp, objPtr, typePtr\fR) +.sp +void +\fBTcl_FreeInternalRep\fR(\fIobjPtr\fR) +.sp +char * +\fBTcl_InitStringRep\fR(\fIobjPtr, bytes, numBytes\fR) +.sp +int +\fBTcl_HasStringRep\fR(\fIobjPtr\fR) +.sp +void +\fBTcl_StoreInternalRep\fR(\fIobjPtr, typePtr, irPtr\fR) +.sp +Tcl_ObjInternalRep * +\fBTcl_FetchInternalRep\fR(\fIobjPtr, typePtr\fR) .SH ARGUMENTS .AS "const char" *typeName .AP "const Tcl_ObjType" *typePtr in @@ -38,6 +53,14 @@ For \fBTcl_AppendAllObjTypes\fR, this points to the value onto which it appends the name of each value type as a list element. For \fBTcl_ConvertToType\fR, this points to a value that must have been the result of a previous call to \fBTcl_NewObj\fR. +.AP "const char*" bytes in +String representation. +.AP "unsigned int" numBytes in +Length of the string representation in bytes. +.AP "const Tcl_ObjInternalRep*" irPtr in +Internal object representation. +.AP "const Tcl_ObjType*" typePtr in +Requested internal representation type. .BE .SH DESCRIPTION @@ -91,6 +114,43 @@ set \fIobjPtr->typePtr\fR to the argument value \fItypePtr\fR, but that is no longer guaranteed. The \fIsetFromAnyProc\fR is free to set the internal representation for \fIobjPtr\fR to make use of another related Tcl_ObjType, if it sees fit. +.PP +\fBTcl_FreeInternalRep\fR performs the function of the existing internal +macro \fBTclInitStringRep\fR, but is extended to return a pointer to the +string rep, and to accept \fINULL\fR as a value for bytes. +When bytes is \fINULL\fR and \fIobjPtr\fR has no string rep, an uninitialzed +buffer of \fInumBytes\fR bytes is created for filling by the caller. +When \fIbytes\fR is \fINULL\fR and \fIobjPtr\fR has a string rep, +the string rep will be truncated to a length of \fInumBytes\fR bytes. +When \fInumBytes\fR is greater than zero, and the returned pointer is +\fINULL\fR, that indicates a failure to allocate memory for the string +representation. +The caller may then choose whether to raise an error or panic. +.PP +\fBTcl_HasStringRep\fR returns a boolean indicating whether or not a string +rep is currently stored in \fIobjPtr\fR. +This is used when the caller wants to act on \fIobjPtr\fR differently +depending on whether or not it is a pure value. +Typically this only makes sense in an extension if it is already known that +\fIobjPtr\fR possesses an internal type that is managed by the extension. +.PP +\fBTcl_StoreInternalRep\fR stores in \fIobjPtr\fR a copy of the internal +representation pointed to by \fIirPtr\fR and sets its type to \fItypePtr\fR. +When \fIirPtr\fR is \fINULL\fR, this leaves \fIobjPtr\fR without a +representation for type \fItypePtr\fR. +.PP +\fBTcl_FetchInternalRep\fR returns a pointer to the internal representation +stored in \fIobjPtr\fR that matches the requested type \fItypePtr\fR. +If no such internal representation is in \fIobjPtr\fR, return \fINULL\fR. +.PP +This returns a public type +.CS +typedef union Tcl_ObjInternalRep {...} Tcl_ObjInternalRep +.CE +where the contents are exactly the existing contents of the union in the +\fIinternalRep\fR field of the \fITcl_Obj\fR struct. +This definition permits us to pass internal representations and pointers to +them as arguments and results in public routines. .SH "THE TCL_OBJTYPE STRUCTURE" .PP Extension writers can define new value types by defining four -- cgit v0.12 From a280f399f801146a2efd6cabc35a4a76bd49342d Mon Sep 17 00:00:00 2001 From: oehhar Date: Wed, 21 Feb 2024 17:04:22 +0000 Subject: Backport missing .fi from main branch in file doc/ObjectType.3 --- doc/ObjectType.3 | 1 + 1 file changed, 1 insertion(+) diff --git a/doc/ObjectType.3 b/doc/ObjectType.3 index aeaac5c..4a4ca13 100644 --- a/doc/ObjectType.3 +++ b/doc/ObjectType.3 @@ -38,6 +38,7 @@ void .sp Tcl_ObjInternalRep * \fBTcl_FetchInternalRep\fR(\fIobjPtr, typePtr\fR) +.fi .SH ARGUMENTS .AS "const char" *typeName .AP "const Tcl_ObjType" *typePtr in -- cgit v0.12 From d54d94e147c61e81dacfacdc12c6559b9e1a1df0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 21 Feb 2024 23:14:16 +0000 Subject: Remove some dead code --- generic/tclCmdIL.c | 48 +----------------------------------------------- generic/tclIO.c | 15 +++------------ 2 files changed, 4 insertions(+), 59 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index c759a54..0079167 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -1839,9 +1839,6 @@ InfoProcsCmd( const char *cmdName, *pattern; const char *simplePattern; Namespace *nsPtr; -#ifdef INFO_PROCS_SEARCH_GLOBAL_NS - Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); -#endif Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ @@ -1893,7 +1890,6 @@ InfoProcsCmd( */ listPtr = Tcl_NewListObj(0, NULL); -#ifndef INFO_PROCS_SEARCH_GLOBAL_NS if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) { entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); if (entryPtr != NULL) { @@ -1917,9 +1913,7 @@ InfoProcsCmd( Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } } - } else -#endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */ - { + } else { entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); @@ -1947,46 +1941,6 @@ InfoProcsCmd( } entryPtr = Tcl_NextHashEntry(&search); } - - /* - * If the effective namespace isn't the global :: namespace, and a - * specific namespace wasn't requested in the pattern, then add in all - * global :: procs that match the simple pattern. Of course, we add in - * only those procs that aren't hidden by a proc in the effective - * namespace. - */ - -#ifdef INFO_PROCS_SEARCH_GLOBAL_NS - /* - * If "info procs" worked like "info commands", returning the commands - * also seen in the global namespace, then you would include this - * code. As this could break backwards compatibility with 8.0-8.2, we - * decided not to "fix" it in 8.3, leaving the behavior slightly - * different. - */ - - if ((nsPtr != globalNsPtr) && !specificNsInPattern) { - entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search); - while (entryPtr != NULL) { - cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); - if ((simplePattern == NULL) - || Tcl_StringMatch(cmdName, simplePattern)) { - if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) { - cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); - realCmdPtr = (Command *) TclGetOriginalCommand( - (Tcl_Command) cmdPtr); - - if (TclIsProc(cmdPtr) || ((realCmdPtr != NULL) - && TclIsProc(realCmdPtr))) { - Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(cmdName, -1)); - } - } - } - entryPtr = Tcl_NextHashEntry(&search); - } - } -#endif } Tcl_SetObjResult(interp, listPtr); diff --git a/generic/tclIO.c b/generic/tclIO.c index 852bb9b..c44329e 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -1609,18 +1609,9 @@ Tcl_CreateChannel( char *tmp; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - /* - * With the change of the Tcl_ChannelType structure to use a version in - * 8.3.2+, we have to make sure that our assumption that the structure - * remains a binary compatible size is true. - * - * If this assertion fails on some system, then it can be removed only if - * the user recompiles code with older channel drivers in the new system - * as well. - */ - - assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *)); - assert(typePtr->typeName != NULL); + if (typePtr->typeName == NULL) { + Tcl_Panic("channel does not have a type name"); + } if (Tcl_ChannelVersion(typePtr) != TCL_CHANNEL_VERSION_5) { Tcl_Panic("channel type %s must be version TCL_CHANNEL_VERSION_5", typePtr->typeName); } -- cgit v0.12 From 26ca71e634244e86c5edc5516994a4618a6f3a2e Mon Sep 17 00:00:00 2001 From: bch Date: Fri, 23 Feb 2024 16:24:01 +0000 Subject: speeling --- generic/tclVar.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclVar.c b/generic/tclVar.c index 125091a..1bd5107 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -6713,7 +6713,7 @@ AppendLocals( * * TclInfoConstantCmd -- * - * Called to implement the "info constant" command that wests whether a + * Called to implement the "info constant" command that tests whether a * specific variable is a constant. Handles the following syntax: * * info constant varName -- cgit v0.12 From 0a9924439f7d792c39f4d4da390716830721230e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 26 Feb 2024 13:04:02 +0000 Subject: More tweaks --- generic/tclClock.c | 40 +++++++++++++++++++--------------------- generic/tclClockFmt.c | 13 ++++++------- generic/tclDate.c | 8 ++++---- generic/tclGetDate.y | 8 ++++---- 4 files changed, 33 insertions(+), 36 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index b1caa01..e156cf3 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -740,7 +740,7 @@ ClockMCDict(ClockFmtScnCmdArgs *opts) if (opts->localeObj == NULL) { Tcl_SetObjResult(opts->interp, Tcl_NewStringObj("locale not specified and no default locale set", -1)); - Tcl_SetErrorCode(opts->interp, "CLOCK", "badOption", NULL); + Tcl_SetErrorCode(opts->interp, "CLOCK", "badOption", (char *)NULL); return NULL; } opts->flags |= CLF_LOCALE_USED; @@ -1007,7 +1007,7 @@ ClockConfigureObjCmd( if (Tcl_GetIndexFromObj(interp, objv[i++], options, "option", 0, &optionIndex) != TCL_OK) { Tcl_SetErrorCode(interp, "CLOCK", "badOption", - Tcl_GetString(objv[i-1]), NULL); + Tcl_GetString(objv[i-1]), (char *)NULL); return TCL_ERROR; } switch (optionIndex) { @@ -2370,7 +2370,7 @@ ConvertUTCToLocalUsingC( if ((Tcl_WideInt) tock != fields->seconds) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "number too large to represent as a Posix time", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL); + Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", (char *)NULL); return TCL_ERROR; } TzsetIfNecessary(); @@ -2379,7 +2379,7 @@ ConvertUTCToLocalUsingC( Tcl_SetObjResult(interp, Tcl_NewStringObj( "localtime failed (clock value may be too " "large/small to represent)", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL); + Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", (char *)NULL); return TCL_ERROR; } @@ -3062,18 +3062,16 @@ ClockGetenvObjCmd( varName = (const WCHAR *)Tcl_WinUtfToTChar(TclGetString(objv[1]), -1, &ds); varValue = _wgetenv(varName); Tcl_DStringFree(&ds); - if (varValue == NULL) { - varValue = L""; + if (varValue != NULL) { + Tcl_WinTCharToUtf((TCHAR *)varValue, -1, &ds); + Tcl_DStringResult(interp, &ds); } - Tcl_WinTCharToUtf((TCHAR *)varValue, -1, &ds); - Tcl_DStringResult(interp, &ds); #else varName = TclGetString(objv[1]); varValue = getenv(varName); - if (varValue == NULL) { - varValue = ""; + if (varValue != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1)); } - Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1)); #endif return TCL_OK; } @@ -3408,7 +3406,7 @@ ClockParseFmtScnArgs( if ((saw & (1 << CLC_ARGS_GMT)) && (saw & (1 << CLC_ARGS_TIMEZONE))) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot use -gmt and -timezone in same call", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL); + Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", (char *)NULL); return TCL_ERROR; } if (gmtFlag) { @@ -3457,7 +3455,7 @@ ClockParseFmtScnArgs( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", Tcl_GetString(baseObj))); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL); i = 1; goto badOption; } @@ -3519,7 +3517,7 @@ badOptionMsg: badOption: Tcl_SetErrorCode(interp, "CLOCK", "badOption", - i < objc ? Tcl_GetString(objv[i]) : NULL, NULL); + (i < objc) ? Tcl_GetString(objv[i]) : (char *)NULL, (char *)NULL); return TCL_ERROR; } @@ -3564,7 +3562,7 @@ ClockFormatObjCmd( /* even number of arguments */ if ((objc & 1) == 1) { Tcl_WrongNumArgs(interp, 1, objv, syntax); - Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", (char *)NULL); return TCL_ERROR; } @@ -3641,7 +3639,7 @@ ClockScanObjCmd( /* even number of arguments */ if ((objc & 1) == 1) { Tcl_WrongNumArgs(interp, 1, objv, syntax); - Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", (char *)NULL); return TCL_ERROR; } @@ -3669,7 +3667,7 @@ ClockScanObjCmd( if (opts.localeObj != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("legacy [clock scan] does not support -locale", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL); + Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", (char *)NULL); ret = TCL_ERROR; goto done; } @@ -3758,7 +3756,7 @@ ClockScanCommit( if (curJDN > dataPtr->maxJDN) { Tcl_SetObjResult(opts->interp, Tcl_NewStringObj( "requested date too large to represent", -1)); - Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL); + Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", (char *)NULL); return TCL_ERROR; } } @@ -3943,7 +3941,7 @@ ClockValidDate( error: Tcl_SetObjResult(opts->interp, Tcl_ObjPrintf("unable to convert input string: %s", errMsg)); - Tcl_SetErrorCode(opts->interp, "CLOCK", "invInpStr", errCode, NULL); + Tcl_SetErrorCode(opts->interp, "CLOCK", "invInpStr", errCode, (char *)NULL); return TCL_ERROR; } @@ -4393,7 +4391,7 @@ ClockAddObjCmd( /* even number of arguments */ if ((objc & 1) == 1) { Tcl_WrongNumArgs(interp, 1, objv, syntax); - Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", (char *)NULL); return TCL_ERROR; } @@ -4574,7 +4572,7 @@ ClockSafeCatchCmd( int objc, Tcl_Obj *const objv[]) { - typedef struct InterpState { + typedef struct { int status; /* return code status */ int flags; /* Each remaining field saves the */ int returnLevel; /* corresponding field of the Interp */ diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 29869d6..a25be83 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -59,7 +59,6 @@ static void ClockFrmScnFinalize(ClientData clientData); static inline int _str2int( int *out, - register const char *p, const char *e, int sign) @@ -89,7 +88,6 @@ _str2int( static inline int _str2wideInt( Tcl_WideInt *out, - register const char *p, const char *e, int sign) @@ -510,7 +508,7 @@ static Tcl_HashKeyType ClockFmtScnStorageHashKeyType; * Type definition of clock-format tcl object type. */ -Tcl_ObjType ClockFmtObjType = { +static const Tcl_ObjType ClockFmtObjType = { "clock-format", /* name */ ClockFmtObj_FreeInternalRep, /* freeIntRepProc */ ClockFmtObj_DupInternalRep, /* dupIntRepProc */ @@ -742,7 +740,7 @@ FindOrCreateFmtScnStorage( if (fss == NULL && interp != NULL) { Tcl_AppendResult(interp, "retrieve clock format failed \"", strFmt ? strFmt : "", "\"", NULL); - Tcl_SetErrorCode(interp, "TCL", "EINVAL", NULL); + Tcl_SetErrorCode(interp, "TCL", "EINVAL", (char *)NULL); } return fss; @@ -1460,7 +1458,7 @@ ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts, } if (val > 7) { Tcl_SetObjResult(opts->interp, Tcl_NewStringObj("day of week is greater than 7", -1)); - Tcl_SetErrorCode(opts->interp, "CLOCK", "badDayOfWeek", NULL); + Tcl_SetErrorCode(opts->interp, "CLOCK", "badDayOfWeek", (char *)NULL); return TCL_ERROR; } info->date.dayOfWeek = val; @@ -2420,6 +2418,7 @@ ClockScan( case (CLF_DAYOFYEAR|CLF_DAYOFMONTH): /* miss month: ddd over dd (without month) */ flags &= ~CLF_DAYOFMONTH; + /* fallthrough */ case (CLF_DAYOFYEAR): /* ddd over naked weekday */ if (!(flags & CLF_ISO8601YEAR)) { @@ -2525,7 +2524,7 @@ overflow: Tcl_SetObjResult(opts->interp, Tcl_NewStringObj("integer value too large to represent", -1)); - Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL); + Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", (char *)NULL); goto done; not_match: @@ -2542,7 +2541,7 @@ not_match: Tcl_GetString(opts->localeObj), tok && tok->tokWord.start ? tok->tokWord.start : "NULL")); #endif - Tcl_SetErrorCode(opts->interp, "CLOCK", "badInputString", NULL); + Tcl_SetErrorCode(opts->interp, "CLOCK", "badInputString", (char *)NULL); done: diff --git a/generic/tclDate.c b/generic/tclDate.c index 0f9b3b9..fa4cf4f 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -2850,24 +2850,24 @@ TclClockFreeScan( } if (msg) { Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL); } else { Tcl_SetObjResult(interp, info->messages ? info->messages : Tcl_NewObj()); info->messages = NULL; - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", (char *)NULL); } status = TCL_ERROR; } else if (status == 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); status = TCL_ERROR; } else if (status != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned " "from date parser. Please " "report this error as a " "bug in Tcl.", -1)); - Tcl_SetErrorCode(interp, "TCL", "BUG", NULL); + Tcl_SetErrorCode(interp, "TCL", "BUG", (char *)NULL); status = TCL_ERROR; } if (info->messages) { diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 45eae1d..25802d8 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -1057,24 +1057,24 @@ TclClockFreeScan( } if (msg) { Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL); } else { Tcl_SetObjResult(interp, info->messages ? info->messages : Tcl_NewObj()); info->messages = NULL; - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", (char *)NULL); } status = TCL_ERROR; } else if (status == 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); status = TCL_ERROR; } else if (status != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned " "from date parser. Please " "report this error as a " "bug in Tcl.", -1)); - Tcl_SetErrorCode(interp, "TCL", "BUG", NULL); + Tcl_SetErrorCode(interp, "TCL", "BUG", (char *)NULL); status = TCL_ERROR; } if (info->messages) { -- cgit v0.12 From adaf81827a4a5fddf49a40020403683e16301c32 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 26 Feb 2024 13:20:40 +0000 Subject: (cherry-pick) More tweaks --- generic/tclClock.c | 38 +++++++++++++++++++------------------- generic/tclClockFmt.c | 8 ++++---- generic/tclDate.c | 8 ++++---- generic/tclGetDate.y | 8 ++++---- generic/tclStrIdxTree.c | 2 +- 5 files changed, 32 insertions(+), 32 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index c16ae74..042b7e5 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -740,7 +740,7 @@ ClockMCDict(ClockFmtScnCmdArgs *opts) if (opts->localeObj == NULL) { Tcl_SetObjResult(opts->interp, Tcl_NewStringObj("locale not specified and no default locale set", -1)); - Tcl_SetErrorCode(opts->interp, "CLOCK", "badOption", NULL); + Tcl_SetErrorCode(opts->interp, "CLOCK", "badOption", (char *)NULL); return NULL; } opts->flags |= CLF_LOCALE_USED; @@ -1007,7 +1007,7 @@ ClockConfigureObjCmd( if (Tcl_GetIndexFromObj(interp, objv[i++], options, "option", 0, &optionIndex) != TCL_OK) { Tcl_SetErrorCode(interp, "CLOCK", "badOption", - Tcl_GetString(objv[i-1]), NULL); + Tcl_GetString(objv[i-1]), (char *)NULL); return TCL_ERROR; } switch (optionIndex) { @@ -2141,7 +2141,7 @@ ConvertLocalToUTCUsingC( Tcl_MutexLock(&clockMutex); errno = 0; fields->seconds = (Tcl_WideInt) mktime(&timeVal); - localErrno = errno; + localErrno = (fields->seconds == -1) ? errno : 0; Tcl_MutexUnlock(&clockMutex); /* @@ -2370,7 +2370,7 @@ ConvertUTCToLocalUsingC( if ((Tcl_WideInt) tock != fields->seconds) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "number too large to represent as a Posix time", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL); + Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", (char *)NULL); return TCL_ERROR; } TzsetIfNecessary(); @@ -2379,7 +2379,7 @@ ConvertUTCToLocalUsingC( Tcl_SetObjResult(interp, Tcl_NewStringObj( "localtime failed (clock value may be too " "large/small to represent)", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL); + Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", (char *)NULL); return TCL_ERROR; } @@ -2413,12 +2413,12 @@ ConvertUTCToLocalUsingC( } else { *buffer = '+'; } - sprintf(buffer+1, "%02d", diff / 3600); + snprintf(buffer+1, sizeof(buffer) - 1, "%02d", diff / 3600); diff %= 3600; - sprintf(buffer+3, "%02d", diff / 60); + snprintf(buffer+3, sizeof(buffer) - 3, "%02d", diff / 60); diff %= 60; if (diff > 0) { - sprintf(buffer+5, "%02d", diff); + snprintf(buffer+5, sizeof(buffer) - 5, "%02d", diff); } Tcl_SetObjRef(fields->tzName, Tcl_NewStringObj(buffer, -1)); return TCL_OK; @@ -2859,9 +2859,9 @@ GetJulianDayFromEraYearMonthDay( * Have to make sure quotient is truncated towards 0 when negative. * See above bug for details. The casts are necessary. */ - if (ym1 >= 0) + if (ym1 >= 0) { ym1o4 = ym1 / 4; - else { + } else { ym1o4 = - (int) (((unsigned int) -ym1) / 4); } #endif @@ -3405,7 +3405,7 @@ ClockParseFmtScnArgs( if ((saw & (1 << CLC_ARGS_GMT)) && (saw & (1 << CLC_ARGS_TIMEZONE))) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot use -gmt and -timezone in same call", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL); + Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", (char *)NULL); return TCL_ERROR; } if (gmtFlag) { @@ -3454,7 +3454,7 @@ ClockParseFmtScnArgs( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected integer but got \"%s\"", Tcl_GetString(baseObj))); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", (char *)NULL); i = 1; goto badOption; } @@ -3516,7 +3516,7 @@ badOptionMsg: badOption: Tcl_SetErrorCode(interp, "CLOCK", "badOption", - i < objc ? Tcl_GetString(objv[i]) : NULL, NULL); + (i < objc) ? Tcl_GetString(objv[i]) : (char *)NULL, (char *)NULL); return TCL_ERROR; } @@ -3561,7 +3561,7 @@ ClockFormatObjCmd( /* even number of arguments */ if ((objc & 1) == 1) { Tcl_WrongNumArgs(interp, 1, objv, syntax); - Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", (char *)NULL); return TCL_ERROR; } @@ -3638,7 +3638,7 @@ ClockScanObjCmd( /* even number of arguments */ if ((objc & 1) == 1) { Tcl_WrongNumArgs(interp, 1, objv, syntax); - Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", (char *)NULL); return TCL_ERROR; } @@ -3666,7 +3666,7 @@ ClockScanObjCmd( if (opts.localeObj != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("legacy [clock scan] does not support -locale", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", NULL); + Tcl_SetErrorCode(interp, "CLOCK", "flagWithLegacyFormat", (char *)NULL); ret = TCL_ERROR; goto done; } @@ -3755,7 +3755,7 @@ ClockScanCommit( if (curJDN > dataPtr->maxJDN) { Tcl_SetObjResult(opts->interp, Tcl_NewStringObj( "requested date too large to represent", -1)); - Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL); + Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", (char *)NULL); return TCL_ERROR; } } @@ -3940,7 +3940,7 @@ ClockValidDate( error: Tcl_SetObjResult(opts->interp, Tcl_ObjPrintf("unable to convert input string: %s", errMsg)); - Tcl_SetErrorCode(opts->interp, "CLOCK", "invInpStr", errCode, NULL); + Tcl_SetErrorCode(opts->interp, "CLOCK", "invInpStr", errCode, (char *)NULL); return TCL_ERROR; } @@ -4390,7 +4390,7 @@ ClockAddObjCmd( /* even number of arguments */ if ((objc & 1) == 1) { Tcl_WrongNumArgs(interp, 1, objv, syntax); - Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", (char *)NULL); return TCL_ERROR; } diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 35a7de2..3982c15 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -739,7 +739,7 @@ FindOrCreateFmtScnStorage( if (fss == NULL && interp != NULL) { Tcl_AppendResult(interp, "retrieve clock format failed \"", strFmt ? strFmt : "", "\"", NULL); - Tcl_SetErrorCode(interp, "TCL", "EINVAL", NULL); + Tcl_SetErrorCode(interp, "TCL", "EINVAL", (char *)NULL); } return fss; @@ -1457,7 +1457,7 @@ ClockScnToken_DayOfWeek_Proc(ClockFmtScnCmdArgs *opts, } if (val > 7) { Tcl_SetObjResult(opts->interp, Tcl_NewStringObj("day of week is greater than 7", -1)); - Tcl_SetErrorCode(opts->interp, "CLOCK", "badDayOfWeek", NULL); + Tcl_SetErrorCode(opts->interp, "CLOCK", "badDayOfWeek", (char *)NULL); return TCL_ERROR; } info->date.dayOfWeek = val; @@ -2521,7 +2521,7 @@ overflow: Tcl_SetObjResult(opts->interp, Tcl_NewStringObj("integer value too large to represent", -1)); - Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", NULL); + Tcl_SetErrorCode(opts->interp, "CLOCK", "dateTooLarge", (char *)NULL); goto done; not_match: @@ -2538,7 +2538,7 @@ not_match: Tcl_GetString(opts->localeObj), tok && tok->tokWord.start ? tok->tokWord.start : "NULL")); #endif - Tcl_SetErrorCode(opts->interp, "CLOCK", "badInputString", NULL); + Tcl_SetErrorCode(opts->interp, "CLOCK", "badInputString", (char *)NULL); done: diff --git a/generic/tclDate.c b/generic/tclDate.c index 1045e3a..28878e4 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -2849,24 +2849,24 @@ TclClockFreeScan( } if (msg) { Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL); } else { Tcl_SetObjResult(interp, info->messages ? info->messages : Tcl_NewObj()); info->messages = NULL; - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", (char *)NULL); } status = TCL_ERROR; } else if (status == 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); status = TCL_ERROR; } else if (status != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned " "from date parser. Please " "report this error as a " "bug in Tcl.", -1)); - Tcl_SetErrorCode(interp, "TCL", "BUG", NULL); + Tcl_SetErrorCode(interp, "TCL", "BUG", (char *)NULL); status = TCL_ERROR; } if (info->messages) { diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index c7631c8..270a3a8 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -1057,24 +1057,24 @@ TclClockFreeScan( } if (msg) { Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", (char *)NULL); } else { Tcl_SetObjResult(interp, info->messages ? info->messages : Tcl_NewObj()); info->messages = NULL; - Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", (char *)NULL); } status = TCL_ERROR; } else if (status == 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1)); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", (char *)NULL); status = TCL_ERROR; } else if (status != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned " "from date parser. Please " "report this error as a " "bug in Tcl.", -1)); - Tcl_SetErrorCode(interp, "TCL", "BUG", NULL); + Tcl_SetErrorCode(interp, "TCL", "BUG", (char *)NULL); status = TCL_ERROR; } if (info->messages) { diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c index 21b5e71..d52f0ff 100644 --- a/generic/tclStrIdxTree.c +++ b/generic/tclStrIdxTree.c @@ -477,7 +477,7 @@ TclStrIdxTreeTestObjCmd( if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &optionIndex) != TCL_OK) { Tcl_SetErrorCode(interp, "CLOCK", "badOption", - Tcl_GetString(objv[1]), NULL); + Tcl_GetString(objv[1]), (char *)NULL); return TCL_ERROR; } switch (optionIndex) { -- cgit v0.12 From 5759ba5e513a810990fe8801c4e4f5ea5a45dfd6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 26 Feb 2024 13:25:20 +0000 Subject: One more little tweak missing --- generic/tclClock.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 042b7e5..76f9af1 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -3116,7 +3116,7 @@ ThreadSafeLocalTime( Tcl_MutexUnlock(&clockMutex); return NULL; } - memcpy(tmPtr, localtime(timePtr), sizeof(struct tm)); + memcpy(tmPtr, sysTmPtr, sizeof(struct tm)); Tcl_MutexUnlock(&clockMutex); #endif return tmPtr; -- cgit v0.12 From 37e722b41c01a2376799344765ea92a4c06330db Mon Sep 17 00:00:00 2001 From: oehhar Date: Tue, 27 Feb 2024 07:08:15 +0000 Subject: clock requires msgcat 1.7, not 1.6 as minimum --- library/clock.tcl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/library/clock.tcl b/library/clock.tcl index d1a76e7..706bc98 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -15,11 +15,11 @@ # #---------------------------------------------------------------------- -# We must have message catalogs that support the root locale, and we need -# access to the Registry on Windows systems. +# msgcat 1.7 features are used. We need access to the Registry on Windows +# systems. uplevel \#0 { - package require msgcat 1.6 + package require msgcat 1.7 if { $::tcl_platform(platform) eq {windows} } { if { [catch { package require registry 1.1 }] } { namespace eval ::tcl::clock [list variable NoRegistry {}] -- cgit v0.12 From f7f56c16205e96290244b1a7b5e0b82c42ab6797 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 27 Feb 2024 12:10:04 +0000 Subject: TclWinGetPlatformId is defined twice. Re-generate tclDecls.h --- generic/tclDecls.h | 8 +++----- generic/tclStubInit.c | 1 - 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 447bd9a..be2412a 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1944,8 +1944,7 @@ EXTERN int Tcl_UtfCharComplete(const char *src, Tcl_Size length); EXTERN const char * Tcl_UtfNext(const char *src); /* 656 */ EXTERN const char * Tcl_UtfPrev(const char *src, const char *start); -/* 657 */ -EXTERN int Tcl_UniCharIsUnicode(int ch); +/* Slot 657 is reserved */ /* 658 */ EXTERN int Tcl_ExternalToUtfDStringEx(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, @@ -2708,7 +2707,7 @@ typedef struct TclStubs { int (*tcl_UtfCharComplete) (const char *src, Tcl_Size length); /* 654 */ const char * (*tcl_UtfNext) (const char *src); /* 655 */ const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 656 */ - int (*tcl_UniCharIsUnicode) (int ch); /* 657 */ + void (*reserved657)(void); int (*tcl_ExternalToUtfDStringEx) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr, Tcl_Size *errorLocationPtr); /* 658 */ int (*tcl_UtfToExternalDStringEx) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr, Tcl_Size *errorLocationPtr); /* 659 */ int (*tcl_AsyncMarkFromSignal) (Tcl_AsyncHandler async, int sigNumber); /* 660 */ @@ -4080,8 +4079,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UtfNext) /* 655 */ #define Tcl_UtfPrev \ (tclStubsPtr->tcl_UtfPrev) /* 656 */ -#define Tcl_UniCharIsUnicode \ - (tclStubsPtr->tcl_UniCharIsUnicode) /* 657 */ +/* Slot 657 is reserved */ #define Tcl_ExternalToUtfDStringEx \ (tclStubsPtr->tcl_ExternalToUtfDStringEx) /* 658 */ #define Tcl_UtfToExternalDStringEx \ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index e250033..975e3ab 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -290,7 +290,6 @@ mp_err TclBN_mp_mul_d(const mp_int *a, unsigned int b, mp_int *c) { # define TclWinGetPlatformId 0 # define TclWinResetInterfaces 0 # define TclWinSetInterfaces 0 -# define TclWinGetPlatformId 0 # define Tcl_Backslash 0 # define Tcl_GetDefaultEncodingDir 0 # define Tcl_SetDefaultEncodingDir 0 -- cgit v0.12 From 208e868b60981ad970dca74d009df9ebfd2b56ff Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 27 Feb 2024 13:53:01 +0000 Subject: Some more int -> Tcl_Size --- generic/tcl.decls | 59 ++++++++++++++--------------- generic/tclBinary.c | 63 ++++++++++++++++--------------- generic/tclDecls.h | 54 ++++++++++++++------------- generic/tclIOUtil.c | 104 ++++++++++++++++++++++++++-------------------------- 4 files changed, 143 insertions(+), 137 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index e1873a0..f3e2dca 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -170,7 +170,7 @@ declare 40 { CONST86 Tcl_ObjType *Tcl_GetObjType(const char *typeName) } declare 41 { - char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr) + char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, Tcl_Size *lengthPtr) } declare 42 { void Tcl_InvalidateStringRep(Tcl_Obj *objPtr) @@ -185,7 +185,7 @@ declare 44 { } declare 45 { int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, - int *objcPtr, Tcl_Obj ***objvPtr) + Tcl_Size *objcPtr, Tcl_Obj ***objvPtr) } declare 46 { int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index, @@ -193,7 +193,7 @@ declare 46 { } declare 47 { int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, - int *lengthPtr) + Tcl_Size *lengthPtr) } declare 48 { int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first, @@ -854,12 +854,12 @@ declare 241 { void Tcl_SourceRCFile(Tcl_Interp *interp) } declare 242 { - int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, + int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, Tcl_Size *argcPtr, const char ***argvPtr) } # Obsolete, use Tcl_FSSplitPath declare 243 { - void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr) + void Tcl_SplitPath(const char *path, Tcl_Size *argcPtr, const char ***argvPtr) } declare 244 {nostub {Don't use this function in a stub-enabled extension}} { void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix, @@ -1493,10 +1493,10 @@ declare 420 {deprecated {Use Tcl_StringCaseMatch}} { int Tcl_UniCharCaseMatch(const unsigned short *uniStr, const unsigned short *uniPattern, int nocase) } -declare 421 { +declare 421 {deprecated {}} { Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key) } -declare 422 { +declare 422 {deprecated {}} { Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, const void *key, int *newPtr) } @@ -1544,7 +1544,7 @@ declare 433 { # introduced in 8.4a3 declare 434 { - unsigned short *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr) + unsigned short *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, Tcl_Size *lengthPtr) } # TIP#15 (math function introspection) dkf @@ -1643,7 +1643,7 @@ declare 460 { Tcl_Obj *Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements) } declare 461 { - Tcl_Obj *Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr) + Tcl_Obj *Tcl_FSSplitPath(Tcl_Obj *pathPtr, Tcl_Size *lenPtr) } declare 462 { int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr) @@ -1782,7 +1782,7 @@ declare 496 { Tcl_Obj *keyPtr) } declare 497 { - int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr) + int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size *sizePtr) } declare 498 { int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr, @@ -2211,7 +2211,7 @@ declare 603 { # TIP#265 (option parser) dkf for Sam Bromley declare 604 { int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, - int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) + Tcl_Size *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) } # TIP#336 (manipulate the error line) dgp @@ -2409,7 +2409,7 @@ declare 648 { # TIP #568 declare 649 { unsigned char *Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - int *numBytesPtr) + Tcl_Size *numBytesPtr) } # TIP #575 @@ -2422,11 +2422,6 @@ declare 655 { declare 656 { const char *Tcl_UtfPrev(const char *src, const char *start) } -# Removed by TIP #652 -# -#declare 657 { -# int Tcl_UniCharIsUnicode(int ch) -#} # TIP 656 declare 658 { @@ -2529,21 +2524,6 @@ interface tclPlat # (none) ################################ -# Windows specific functions - -# Added in Tcl 8.1 - -declare 0 win { - TCHAR *Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr) -} -declare 1 win { - char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr) -} -declare 3 win { - void Tcl_WinConvertError(unsigned errCode) -} - -################################ # Mac OS X specific functions declare 0 macosx { @@ -2560,6 +2540,21 @@ declare 2 macosx { void Tcl_MacOSXNotifierAddRunLoopMode(const void *runLoopMode) } +################################ +# Windows specific functions + +# Added in Tcl 8.1 + +declare 0 win { + TCHAR *Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr) +} +declare 1 win { + char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr) +} +declare 3 win { + void Tcl_WinConvertError(unsigned errCode) +} + ############################################################################## # Public functions that are not accessible via the stubs table. diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 9b59ee7..8b282f3 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -278,7 +278,7 @@ Tcl_Obj * Tcl_NewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ - int numBytes) /* Number of bytes in the array, + Tcl_Size numBytes) /* Number of bytes in the array, * must be >= 0. */ { #ifdef TCL_MEM_DEBUG @@ -322,7 +322,7 @@ Tcl_Obj * Tcl_DbNewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ - int numBytes, /* Number of bytes in the array, + Tcl_Size numBytes, /* Number of bytes in the array, * must be >= 0. */ const char *file, /* The name of the source file calling this * procedure; used for debugging. */ @@ -372,8 +372,8 @@ Tcl_SetByteArrayObj( Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */ const unsigned char *bytes, /* The array of bytes to use as the new value. * May be NULL even if numBytes > 0. */ - int numBytes) /* Number of bytes in the array, - * must be >= 0. */ + Tcl_Size numBytes) /* Number of bytes in the array, + * must be >= 0 */ { ByteArray *byteArrayPtr; Tcl_ObjInternalRep ir; @@ -418,11 +418,12 @@ unsigned char * Tcl_GetBytesFromObj( Tcl_Interp *interp, /* For error reporting */ Tcl_Obj *objPtr, /* Value to extract from */ - int *numBytesPtr) /* If non-NULL, write the number of bytes + Tcl_Size *numBytesPtr) /* If non-NULL, write the number of bytes * in the array here */ { ByteArray *baPtr; - const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); + const Tcl_ObjInternalRep *irPtr + = TclFetchInternalRep(objPtr, &properByteArrayType); if (irPtr == NULL) { SetByteArrayFromAny(NULL, objPtr); @@ -521,7 +522,7 @@ Tcl_GetByteArrayFromObj( unsigned char * Tcl_SetByteArrayLength( Tcl_Obj *objPtr, /* The ByteArray object. */ - int numBytes) /* Number of bytes in resized array */ + Tcl_Size numBytes) /* Number of bytes in resized array */ { ByteArray *byteArrayPtr; unsigned newLength; @@ -798,7 +799,7 @@ void TclAppendBytesToByteArray( Tcl_Obj *objPtr, const unsigned char *bytes, - int len) + Tcl_Size len) { ByteArray *byteArrayPtr; unsigned int length, needed; @@ -944,7 +945,7 @@ BinaryFormatCmd( int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ - int count; /* Count associated with current format + Tcl_Size count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format @@ -956,7 +957,7 @@ BinaryFormatCmd( * cursor has visited.*/ const char *errorString; const char *errorValue, *str; - int offset, size, length; + Tcl_Size offset, size, length; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?"); @@ -1052,7 +1053,7 @@ BinaryFormatCmd( arg++; count = 1; } else { - int listc; + Tcl_Size listc; Tcl_Obj **listv; /* @@ -1332,7 +1333,7 @@ BinaryFormatCmd( case 'q': case 'Q': case 'f': { - int listc, i; + Tcl_Size listc, i; Tcl_Obj **listv; if (count == BINARY_NOCOUNT) { @@ -1453,7 +1454,7 @@ BinaryScanCmd( int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ - int count; /* Count associated with current format + Tcl_Size count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format @@ -1462,7 +1463,7 @@ BinaryScanCmd( unsigned char *buffer; /* Start of result buffer. */ const char *errorString; const char *str; - int offset, size, length, i; + Tcl_Size offset, size, length, i; Tcl_Obj *valuePtr, *elementPtr; Tcl_HashTable numberCacheHash; @@ -1699,7 +1700,7 @@ BinaryScanCmd( goto badIndex; } if (count == BINARY_NOCOUNT) { - if ((length - offset) < size) { + if (length < (size + offset)) { goto done; } valuePtr = ScanNumber(buffer+offset, cmd, flags, @@ -1829,7 +1830,7 @@ static int GetFormatSpec( const char **formatPtr, /* Pointer to format string. */ char *cmdPtr, /* Pointer to location of command char. */ - int *countPtr, /* Pointer to repeat count value. */ + Tcl_Size *countPtr, /* Pointer to repeat count value. */ int *flagsPtr) /* Pointer to field flags */ { /* @@ -2340,9 +2341,9 @@ ScanNumber( if (flags & BINARY_UNSIGNED) { return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value); } - if ((value & (((unsigned) 1) << 31)) && (value > 0)) { - value -= (((unsigned) 1) << 31); - value -= (((unsigned) 1) << 31); + if ((value & (1U << 31)) && (value > 0)) { + value -= (1U << 31); + value -= (1U << 31); } returnNumericObject: @@ -2533,7 +2534,7 @@ BinaryEncodeHex( Tcl_Obj *resultObj = NULL; unsigned char *data = NULL; unsigned char *cursor = NULL; - int offset = 0, count = 0; + Tcl_Size offset = 0, count = 0; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "data"); @@ -2577,7 +2578,8 @@ BinaryDecodeHex( Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor, c; - int i, index, value, size, pure = 1, count = 0, cut = 0, strict = 0; + int i, index, value, pure = 1, strict = 0; + Tcl_Size size, cut = 0, count = 0; int ucs4; enum {OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; @@ -2702,8 +2704,9 @@ BinaryEncode64( unsigned char *data, *limit; Tcl_WideInt maxlen = 0; const char *wrapchar = "\n"; - int wrapcharlen = 1; - int offset, i, index, size, outindex = 0, count = 0, purewrap = 1; + Tcl_Size wrapcharlen = 1; + int index, purewrap = 1; + Tcl_Size i, offset, size, outindex = 0, count = 0; enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; @@ -2822,12 +2825,12 @@ BinaryEncodeUu( { Tcl_Obj *resultObj; unsigned char *data, *start, *cursor; - int offset, count, rawLength, i, j, bits, index; + int i, bits, index; unsigned int n; int lineLength = 61; const unsigned char SingleNewline[] = { UCHAR('\n') }; const unsigned char *wrapchar = SingleNewline; - int wrapcharlen = sizeof(SingleNewline); + Tcl_Size j, rawLength, offset, count, wrapcharlen = sizeof(SingleNewline); enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; @@ -2861,7 +2864,7 @@ BinaryEncodeUu( objv[i + 1], &wrapcharlen); { const unsigned char *p = wrapchar; - int numBytes = wrapcharlen; + Tcl_Size numBytes = wrapcharlen; while (numBytes) { switch (*p) { @@ -2914,7 +2917,7 @@ BinaryEncodeUu( */ while (offset < count) { - int lineLen = count - offset; + Tcl_Size lineLen = count - offset; if (lineLen > rawLength) { lineLen = rawLength; @@ -2972,7 +2975,8 @@ BinaryDecodeUu( Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor; - int i, index, size, pure = 1, count = 0, strict = 0, lineLen; + int i, index, pure = 1, strict = 0, lineLen; + Tcl_Size size, count = 0; unsigned char c; int ucs4; enum { OPT_STRICT }; @@ -3147,7 +3151,8 @@ BinaryDecode64( unsigned char *begin = NULL; unsigned char *cursor = NULL; int pure = 1, strict = 0; - int i, index, size, cut = 0, count = 0; + int i, index, cut = 0; + Tcl_Size size, count = 0; int ucs4; enum { OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; diff --git a/generic/tclDecls.h b/generic/tclDecls.h index be2412a..4f9ed7c 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -183,7 +183,8 @@ EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp, /* 40 */ EXTERN CONST86 Tcl_ObjType * Tcl_GetObjType(const char *typeName); /* 41 */ -EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr); +EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, + Tcl_Size *lengthPtr); /* 42 */ EXTERN void Tcl_InvalidateStringRep(Tcl_Obj *objPtr); /* 43 */ @@ -194,7 +195,7 @@ EXTERN int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 45 */ EXTERN int Tcl_ListObjGetElements(Tcl_Interp *interp, - Tcl_Obj *listPtr, int *objcPtr, + Tcl_Obj *listPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 46 */ EXTERN int Tcl_ListObjIndex(Tcl_Interp *interp, @@ -202,7 +203,7 @@ EXTERN int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj **objPtrPtr); /* 47 */ EXTERN int Tcl_ListObjLength(Tcl_Interp *interp, - Tcl_Obj *listPtr, int *lengthPtr); + Tcl_Obj *listPtr, Tcl_Size *lengthPtr); /* 48 */ EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first, @@ -753,10 +754,10 @@ EXTERN const char * Tcl_SignalMsg(int sig); EXTERN void Tcl_SourceRCFile(Tcl_Interp *interp); /* 242 */ EXTERN int Tcl_SplitList(Tcl_Interp *interp, - const char *listStr, int *argcPtr, + const char *listStr, Tcl_Size *argcPtr, const char ***argvPtr); /* 243 */ -EXTERN void Tcl_SplitPath(const char *path, int *argcPtr, +EXTERN void Tcl_SplitPath(const char *path, Tcl_Size *argcPtr, const char ***argvPtr); /* 244 */ EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp, @@ -1277,10 +1278,12 @@ TCL_DEPRECATED("Use Tcl_StringCaseMatch") int Tcl_UniCharCaseMatch(const unsigned short *uniStr, const unsigned short *uniPattern, int nocase); /* 421 */ -EXTERN Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr, +TCL_DEPRECATED("") +Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key); /* 422 */ -EXTERN Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, +TCL_DEPRECATED("") +Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 423 */ EXTERN void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, @@ -1317,7 +1320,7 @@ EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); /* 434 */ EXTERN unsigned short * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, - int *lengthPtr); + Tcl_Size *lengthPtr); /* 435 */ TCL_DEPRECATED("") int Tcl_GetMathFuncInfo(Tcl_Interp *interp, @@ -1397,7 +1400,7 @@ EXTERN int Tcl_FSConvertToPathType(Tcl_Interp *interp, /* 460 */ EXTERN Tcl_Obj * Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements); /* 461 */ -EXTERN Tcl_Obj * Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr); +EXTERN Tcl_Obj * Tcl_FSSplitPath(Tcl_Obj *pathPtr, Tcl_Size *lenPtr); /* 462 */ EXTERN int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); @@ -1494,7 +1497,7 @@ EXTERN int Tcl_DictObjRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 497 */ EXTERN int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, - int *sizePtr); + Tcl_Size *sizePtr); /* 498 */ EXTERN int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, @@ -1801,8 +1804,9 @@ EXTERN int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 604 */ EXTERN int Tcl_ParseArgsObjv(Tcl_Interp *interp, - const Tcl_ArgvInfo *argTable, int *objcPtr, - Tcl_Obj *const *objv, Tcl_Obj ***remObjv); + const Tcl_ArgvInfo *argTable, + Tcl_Size *objcPtr, Tcl_Obj *const *objv, + Tcl_Obj ***remObjv); /* 605 */ EXTERN int Tcl_GetErrorLine(Tcl_Interp *interp); /* 606 */ @@ -1933,7 +1937,7 @@ EXTERN int * Tcl_UtfToUniCharDString(const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 649 */ EXTERN unsigned char * Tcl_GetBytesFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, int *numBytesPtr); + Tcl_Obj *objPtr, Tcl_Size *numBytesPtr); /* Slot 650 is reserved */ /* Slot 651 is reserved */ /* Slot 652 is reserved */ @@ -2083,13 +2087,13 @@ typedef struct TclStubs { int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */ int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */ CONST86 Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */ - char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */ + char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, Tcl_Size *lengthPtr); /* 41 */ void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */ int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */ int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */ - int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */ + int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 45 */ int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index, Tcl_Obj **objPtrPtr); /* 46 */ - int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */ + int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size *lengthPtr); /* 47 */ int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first, Tcl_Size count, Tcl_Size objc, Tcl_Obj *const objv[]); /* 48 */ TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewBooleanObj) (int intValue); /* 49 */ Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, Tcl_Size numBytes); /* 50 */ @@ -2292,8 +2296,8 @@ typedef struct TclStubs { const char * (*tcl_SignalId) (int sig); /* 239 */ const char * (*tcl_SignalMsg) (int sig); /* 240 */ void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */ - int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */ - void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */ + int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, Tcl_Size *argcPtr, const char ***argvPtr); /* 242 */ + void (*tcl_SplitPath) (const char *path, Tcl_Size *argcPtr, const char ***argvPtr); /* 243 */ TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_StaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 244 */ TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */ TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */ @@ -2471,8 +2475,8 @@ typedef struct TclStubs { int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */ TCL_DEPRECATED_API("Use Tcl_UtfNcasecmp") int (*tcl_UniCharNcasecmp) (const unsigned short *ucs, const unsigned short *uct, unsigned long numChars); /* 419 */ TCL_DEPRECATED_API("Use Tcl_StringCaseMatch") int (*tcl_UniCharCaseMatch) (const unsigned short *uniStr, const unsigned short *uniPattern, int nocase); /* 420 */ - Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */ - Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */ + TCL_DEPRECATED_API("") Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */ + TCL_DEPRECATED_API("") Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */ void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */ void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */ void * (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, void *prevClientData); /* 425 */ @@ -2484,7 +2488,7 @@ typedef struct TclStubs { char * (*tcl_AttemptDbCkrealloc) (char *ptr, TCL_HASH_TYPE size, const char *file, int line); /* 431 */ int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, Tcl_Size length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ - unsigned short * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */ + unsigned short * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, Tcl_Size *lengthPtr); /* 434 */ TCL_DEPRECATED_API("") int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, void **clientDataPtr); /* 435 */ TCL_DEPRECATED_API("") Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */ Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */ @@ -2511,7 +2515,7 @@ typedef struct TclStubs { int (*tcl_FSChdir) (Tcl_Obj *pathPtr); /* 458 */ int (*tcl_FSConvertToPathType) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 459 */ Tcl_Obj * (*tcl_FSJoinPath) (Tcl_Obj *listObj, Tcl_Size elements); /* 460 */ - Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, int *lenPtr); /* 461 */ + Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, Tcl_Size *lenPtr); /* 461 */ int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */ Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */ Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, Tcl_Size objc, Tcl_Obj *const objv[]); /* 464 */ @@ -2547,7 +2551,7 @@ typedef struct TclStubs { int (*tcl_DictObjPut) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 494 */ int (*tcl_DictObjGet) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 495 */ int (*tcl_DictObjRemove) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 496 */ - int (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 497 */ + int (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size *sizePtr); /* 497 */ int (*tcl_DictObjFirst) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 498 */ void (*tcl_DictObjNext) (Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */ void (*tcl_DictObjDone) (Tcl_DictSearch *searchPtr); /* 500 */ @@ -2654,7 +2658,7 @@ typedef struct TclStubs { unsigned (*tcl_GetBlockSizeFromStat) (const Tcl_StatBuf *statPtr); /* 601 */ int (*tcl_SetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 602 */ int (*tcl_GetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 603 */ - int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */ + int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, Tcl_Size *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */ int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */ void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */ void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int code, Tcl_Interp *targetInterp); /* 607 */ @@ -2699,7 +2703,7 @@ typedef struct TclStubs { Tcl_Size (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */ char * (*tcl_UniCharToUtfDString) (const int *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); /* 647 */ int * (*tcl_UtfToUniCharDString) (const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 648 */ - unsigned char * (*tcl_GetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* 649 */ + unsigned char * (*tcl_GetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *numBytesPtr); /* 649 */ void (*reserved650)(void); void (*reserved651)(void); void (*reserved652)(void); diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 7719f35..28fed76 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -34,7 +34,7 @@ */ typedef struct FilesystemRecord { - ClientData clientData; /* Client-specific data for the filesystem + void *clientData; /* Client-specific data for the filesystem * (can be NULL) */ const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */ struct FilesystemRecord *nextPtr; @@ -58,7 +58,7 @@ typedef struct { * the value is accessed and cwdPathEpoch has * changed. */ - ClientData cwdClientData; + void *cwdClientData; FilesystemRecord *filesystemList; size_t claims; } ThreadSpecificData; @@ -69,12 +69,12 @@ typedef struct { static Tcl_NRPostProc EvalFileCallback; static FilesystemRecord*FsGetFirstFilesystem(void); -static void FsThrExitProc(ClientData cd); +static void FsThrExitProc(void *cd); static Tcl_Obj * FsListMounts(Tcl_Obj *pathPtr, const char *pattern); static void FsAddMountsToGlobResult(Tcl_Obj *resultPtr, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); -static void FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData); +static void FsUpdateCwd(Tcl_Obj *cwdObj, void *clientData); static void FsRecacheFilesystemList(void); static void Claim(void); static void Disclaim(void); @@ -212,7 +212,7 @@ TCL_DECLARE_MUTEX(filesystemMutex) static Tcl_Obj *cwdPathPtr = NULL; static size_t cwdPathEpoch = 0; /* The pathname of the current directory */ -static ClientData cwdClientData = NULL; +static void *cwdClientData = NULL; TCL_DECLARE_MUTEX(cwdMutex) static Tcl_ThreadDataKey fsDataKey; @@ -230,7 +230,7 @@ typedef struct { Tcl_FSUnloadFileProc *unloadProcPtr; Tcl_Obj *divertedFile; const Tcl_Filesystem *divertedFilesystem; - ClientData divertedFileNativeRep; + void *divertedFileNativeRep; } FsDivertLoad; /* @@ -414,7 +414,7 @@ Tcl_EvalFile( static void FsThrExitProc( - ClientData cd) + void *cd) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *)cd; FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL; @@ -521,7 +521,7 @@ TclFSCwdPointerEquals( if (tsdPtr->cwdPathPtr == *pathPtrPtr) { return 1; } else { - int len1, len2; + Tcl_Size len1, len2; const char *str1, *str2; str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1); @@ -661,9 +661,9 @@ TclFSEpoch(void) static void FsUpdateCwd( Tcl_Obj *cwdObj, - ClientData clientData) + void *clientData) { - int len; + Tcl_Size len; const char *str = NULL; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); @@ -844,7 +844,7 @@ TclResetFilesystem(void) int Tcl_FSRegister( - ClientData clientData, /* Client-specific data for this filesystem. */ + void *clientData, /* Client-specific data for this filesystem. */ const Tcl_Filesystem *fsPtr)/* The filesystem record for the new fs. */ { FilesystemRecord *newFilesystemPtr; @@ -990,7 +990,8 @@ Tcl_FSMatchInDirectory( { const Tcl_Filesystem *fsPtr; Tcl_Obj *cwd, *tmpResultPtr, **elemsPtr; - int resLength, i, ret = -1; + Tcl_Size resLength, i; + int ret = -1; if (types != NULL && (types->type & TCL_GLOB_TYPE_MOUNT)) { /* @@ -1106,7 +1107,7 @@ FsAddMountsToGlobResult( * directory flag is particularly significant. */ { - int mLength, gLength, i; + Tcl_Size mLength, gLength, i; int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR)); Tcl_Obj *mounts = FsListMounts(pathPtr, pattern); @@ -1122,7 +1123,7 @@ FsAddMountsToGlobResult( } for (i=0 ; i limit); @@ -2479,7 +2482,7 @@ TclFSFileAttrIndex( * It's a non-constant attribute list, so do a literal search. */ - int i, objc; + Tcl_Size i, objc; Tcl_Obj **objv; if (TclListObjGetElementsM(NULL, listObj, &objc, &objv) != TCL_OK) { @@ -2626,7 +2629,7 @@ Tcl_FSGetCwd( Claim(); for (; (retVal == NULL) && (fsRecPtr != NULL); fsRecPtr = fsRecPtr->nextPtr) { - ClientData retCd; + void *retCd; TclFSGetCwdProc2 *proc2; if (fsRecPtr->fsPtr->getCwdProc == NULL) { @@ -2727,7 +2730,7 @@ Tcl_FSGetCwd( const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr); - ClientData retCd = NULL; + void *retCd = NULL; Tcl_Obj *retVal, *norm; if (fsPtr == NULL || fsPtr->getCwdProc == NULL) { @@ -2800,7 +2803,7 @@ Tcl_FSGetCwd( * infinite loop bug when trying to normalize tsdPtr->cwdPathPtr. */ - int len1, len2; + Tcl_Size len1, len2; const char *str1, *str2; str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1); @@ -2929,8 +2932,8 @@ Tcl_FSChdir( } if (fsPtr == &tclNativeFilesystem) { - ClientData cd; - ClientData oldcd = tsdPtr->cwdClientData; + void *cd; + void *oldcd = tsdPtr->cwdClientData; /* * Assume that the native filesystem has a getCwdProc and that it @@ -3797,17 +3800,16 @@ FsListMounts( *--------------------------------------------------------------------------- */ -#undef Tcl_FSSplitPath Tcl_Obj * Tcl_FSSplitPath( Tcl_Obj *pathPtr, /* The pathname to split. */ - int *lenPtr) /* A place to hold the number of pathname + Tcl_Size *lenPtr) /* A place to hold the number of pathname * elements. */ { Tcl_Obj *result = NULL; /* Just to squelch gcc warnings. */ const Tcl_Filesystem *fsPtr; char separator = '/'; - int driveNameLength; + Tcl_Size driveNameLength; const char *p; /* @@ -3853,7 +3855,7 @@ Tcl_FSSplitPath( for (;;) { const char *elementStart = p; - int length; + Tcl_Size length; while ((*p != '\0') && (*p != separator)) { p++; @@ -3904,14 +3906,14 @@ TclGetPathType( /* If not NULL, a place in which to store a * pointer to the filesystem for this pathname * if it is absolute. */ - int *driveNameLengthPtr, /* If not NULL, a place in which to store the + Tcl_Size *driveNameLengthPtr, /* If not NULL, a place in which to store the * length of the volume name. */ Tcl_Obj **driveNameRef) /* If not NULL, for an absolute pathname, a * place to store a pointer to an object with a * refCount of 1, and whose value is the name * of the volume. */ { - int pathLen; + Tcl_Size pathLen; const char *path = TclGetStringFromObj(pathPtr, &pathLen); Tcl_PathType type; @@ -3953,12 +3955,12 @@ TclGetPathType( Tcl_PathType TclFSNonnativePathType( const char *path, /* Pathname to determine the type of. */ - int pathLen, /* Length of the pathname. */ + Tcl_Size pathLen, /* Length of the pathname. */ const Tcl_Filesystem **filesystemPtrPtr, /* If not NULL, a place to store a pointer to * the filesystem for this pathname when it is * an absolute pathname. */ - int *driveNameLengthPtr, /* If not NULL, a place to store the length of + Tcl_Size *driveNameLengthPtr,/* If not NULL, a place to store the length of * the volume name if the pathname is absolute. */ Tcl_Obj **driveNameRef) /* If not NULL, a place to store a pointer to @@ -3995,7 +3997,7 @@ TclFSNonnativePathType( if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (fsRecPtr->fsPtr->listVolumesProc != NULL)) { - int numVolumes; + Tcl_Size numVolumes; Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc(); if (thisFsVolumes != NULL) { @@ -4010,11 +4012,11 @@ TclFSNonnativePathType( * Tcl_Panic seems a bit excessive. */ - numVolumes = -1; + numVolumes = TCL_INDEX_NONE; } while (numVolumes > 0) { Tcl_Obj *vol; - int len; + Tcl_Size len; const char *strVol; numVolumes--; @@ -4377,14 +4379,14 @@ Tcl_FSRemoveDirectory( Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL); if (cwdPtr != NULL) { const char *cwdStr, *normPathStr; - int cwdLen, normLen; + Tcl_Size cwdLen, normLen; Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPath != NULL) { normPathStr = TclGetStringFromObj(normPath, &normLen); cwdStr = TclGetStringFromObj(cwdPtr, &cwdLen); if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr, - (size_t) normLen) == 0)) { + normLen) == 0)) { /* * The cwd is inside the directory to be removed. Change * the cwd to [file dirname $path]. @@ -4465,7 +4467,7 @@ Tcl_FSGetFileSystemForPath( * corresponding filesystem is found. */ for (; fsRecPtr!=NULL ; fsRecPtr=fsRecPtr->nextPtr) { - ClientData clientData = NULL; + void *clientData = NULL; if (fsRecPtr->fsPtr->pathInFilesystemProc == NULL) { continue; @@ -4522,7 +4524,7 @@ Tcl_FSGetNativePath( static void NativeFreeInternalRep( - ClientData clientData) + void *clientData) { ckfree(clientData); } -- cgit v0.12 From eb58d1f40937d22c6b2e5ec394b6a6184c67b523 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 27 Feb 2024 15:58:23 +0000 Subject: fixes [e02798626d]: close regression introduced by TIP#490 causing too slow eval of mc command for non-class namespaces (probably by shimmering of something NS-related across ::msgcat::PackageNamespaceGet) --- library/msgcat/msgcat.tcl | 45 +++++++++++++++++++++++++-------------------- 1 file changed, 25 insertions(+), 20 deletions(-) diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index fa21685..0c7f515 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -1220,27 +1220,32 @@ proc msgcat::mcutil::ConvertLocale {value} { # - called from an class defined oo object # - called from a classless oo object proc ::msgcat::PackageNamespaceGet {} { - uplevel 2 { - # Check self namespace to determine environment - switch -exact -- [namespace which self] { - {::oo::define::self} { - # We are within a class definition - return [namespace qualifiers [self]] - } - {::oo::Helpers::self} { - # We are within an object - set Class [info object class [self]] - # Check for classless defined object - if {$Class eq {::oo::object}} { - return [namespace qualifiers [self]] - } - # Class defined object - return [namespace qualifiers $Class] - } - default { - # Not in object environment - return [namespace current] + set ns [uplevel 2 { namespace current }] + + if {![regexp -- {^::oo::} $ns]} { + # Not in object environment + return $ns + } + + # Check self namespace to determine environment + switch -exact -- [uplevel 2 { namespace which -command self }] { + {::oo::define::self} { + # We are within a class definition + return [namespace qualifiers [uplevel 2 { self }]] + } + {::oo::Helpers::self} { + # We are within an object + set Class [info object class [uplevel 2 { self }]] + # Check for classless defined object + if {$Class eq {::oo::object}} { + return [namespace qualifiers [uplevel 2 { self }]] } + # Class defined object + return [namespace qualifiers $Class] + } + default { + # Not in object environment + return $ns } } } -- cgit v0.12 From f86e271b7d1326187702c8208213b14c92058bd7 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 27 Feb 2024 16:07:20 +0000 Subject: amend to [e02798626dfbcd7b]: speed-up ::tcl::clock::mc a little bit (uses msgcat::mcn internally instead of msgcat::mc) --- library/clock.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/clock.tcl b/library/clock.tcl index 706bc98..9d41b80 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -60,7 +60,7 @@ namespace eval ::tcl::clock { namespace import ::msgcat::mcload namespace import ::msgcat::mclocale - namespace import ::msgcat::mc + proc mc {args} { tailcall ::msgcat::mcn [namespace current] {*}$args } namespace import ::msgcat::mcpackagelocale } -- cgit v0.12 From d6aa043a18b1a1bef907fbdc70d9e4afd20f85c2 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 27 Feb 2024 18:21:33 +0000 Subject: small amend for better readability (no RE needed, faster utf prefix compare) --- library/msgcat/msgcat.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 0c7f515..589da7a 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -1222,7 +1222,7 @@ proc msgcat::mcutil::ConvertLocale {value} { proc ::msgcat::PackageNamespaceGet {} { set ns [uplevel 2 { namespace current }] - if {![regexp -- {^::oo::} $ns]} { + if {![string match {::oo::*} $ns]} { # Not in object environment return $ns } -- cgit v0.12 From 6919574006c1327ddc3daac32561c30167da9840 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 2 Mar 2024 16:23:38 +0000 Subject: Add missing Tcl_NextHashEntry --- generic/tclCompCmdsSZ.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index d79b7b9..0281465 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -2563,7 +2563,7 @@ DupJumptableInfo( Tcl_InitHashTable(&newJtPtr->hashTable, TCL_STRING_KEYS); hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); - while (hPtr != NULL) { + for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { newHPtr = Tcl_CreateHashEntry(&newJtPtr->hashTable, Tcl_GetHashKey(&jtPtr->hashTable, hPtr), &isNew); Tcl_SetHashValue(newHPtr, Tcl_GetHashValue(hPtr)); -- cgit v0.12 From df26529a9835ef1853b20e51ddd98ef884cd48b0 Mon Sep 17 00:00:00 2001 From: oehhar Date: Mon, 4 Mar 2024 11:09:49 +0000 Subject: Minimize diff to main branch by comment correction --- tests/http.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/http.test b/tests/http.test index cd61b7b..f7bb723 100644 --- a/tests/http.test +++ b/tests/http.test @@ -759,7 +759,7 @@ test http-idna-1.1.$ThreadLevel {IDNA package: basics} -returnCodes error -body } -result {wrong # args: should be "::tcl::idna subcommand ?arg ...?"} test http-idna-1.2.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna ? -} -result {unknown subcommand "?": must be decode, encode, puny, or version} +} -result {unknown or ambiguous subcommand "?": must be decode, encode, puny, or version} test http-idna-1.3.$ThreadLevel {IDNA package: basics} -body { ::tcl::idna version } -result 1.0.1 @@ -771,7 +771,7 @@ test http-idna-1.5.$ThreadLevel {IDNA package: basics} -returnCodes error -body } -result {wrong # args: should be "::tcl::idna puny subcommand ?arg ...?"} test http-idna-1.6.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny ? -} -result {unknown subcommand "?": must be decode, or encode} +} -result {unknown or ambiguous subcommand "?": must be decode, or encode} test http-idna-1.7.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny encode } -result {wrong # args: should be "::tcl::idna puny encode string ?case?"} -- cgit v0.12 From 90b9964cc1fbfce0612065027cc8881f6e6ef6e5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 4 Mar 2024 14:47:35 +0000 Subject: Tweak error-message. Remove pre-7.5 Tcl code. --- library/clock.tcl | 6 +++--- library/init.tcl | 4 ---- tests/clock.test | 2 +- 3 files changed, 4 insertions(+), 8 deletions(-) diff --git a/library/clock.tcl b/library/clock.tcl index 9d41b80..ee84b83 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -1230,8 +1230,8 @@ proc ::tcl::clock::scan { args } { default { return -code error \ -errorcode [list CLOCK badOption $flag] \ - "bad option \"$flag\",\ - must be -base, -format, -gmt, -locale or -timezone" + "bad option \"$flag\":\ + must be -base, -format, -gmt, -locale, or -timezone" } } } @@ -4277,7 +4277,7 @@ proc ::tcl::clock::add { clockval args } { } default { throw [list CLOCK badOption $a] \ - "bad option \"$a\",\ + "bad option \"$a\":\ must be -gmt, -locale or -timezone" } } diff --git a/library/init.tcl b/library/init.tcl index cffe951..6ef0ac1 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -15,10 +15,6 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# This test intentionally written in pre-7.5 Tcl -if {[info commands package] == ""} { - error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" -} package require -exact tcl 8.7a6 # Compute the auto path to use in this interpreter. diff --git a/tests/clock.test b/tests/clock.test index 7bcc002..189b83a 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -35634,7 +35634,7 @@ test clock-34.8 {clock scan tests} { } {Oct 23,1992 15:00 GMT} test clock-34.9 {clock scan tests} { list [catch {clock scan "Jan 12" -bad arg} msg] $msg -} {1 {bad option "-bad", must be -base, -format, -gmt, -locale or -timezone}} +} {1 {bad option "-bad": must be -base, -format, -gmt, -locale, or -timezone}} # The following two two tests test the two year date policy test clock-34.10 {clock scan tests} { set time [clock scan "1/1/71" -gmt true] -- cgit v0.12 From bf6b50b610cbcbdd9ef1b887f10d742df4f1b07c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 5 Mar 2024 16:12:04 +0000 Subject: b1 -> b2 (preparation for release) --- README.md | 2 +- generic/tcl.h | 4 ++-- library/init.tcl | 2 +- unix/configure | 2 +- unix/configure.ac | 2 +- unix/tcl.spec | 2 +- win/configure | 2 +- win/configure.ac | 2 +- 8 files changed, 9 insertions(+), 9 deletions(-) diff --git a/README.md b/README.md index ba29fad..2edde12 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # README: Tcl -This is the **Tcl 9.0b1** source distribution. +This is the **Tcl 9.0b2** source distribution. You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). diff --git a/generic/tcl.h b/generic/tcl.h index 0f53228..a4480a7 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -53,10 +53,10 @@ extern "C" { #if TCL_MAJOR_VERSION == 9 # define TCL_MINOR_VERSION 0 # define TCL_RELEASE_LEVEL TCL_BETA_RELEASE -# define TCL_RELEASE_SERIAL 1 +# define TCL_RELEASE_SERIAL 2 # define TCL_VERSION "9.0" -# define TCL_PATCH_LEVEL "9.0b1" +# define TCL_PATCH_LEVEL "9.0b2" #endif /* TCL_MAJOR_VERSION */ #if defined(RC_INVOKED) diff --git a/library/init.tcl b/library/init.tcl index 95081ec..6500d8e 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -15,7 +15,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -package require -exact tcl 9.0b1 +package require -exact tcl 9.0b2 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/unix/configure b/unix/configure index 946e512..fe3be30 100755 --- a/unix/configure +++ b/unix/configure @@ -2710,7 +2710,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="b1" +TCL_PATCH_LEVEL="b2" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} diff --git a/unix/configure.ac b/unix/configure.ac index 03d7e5a..df38377 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -26,7 +26,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="b1" +TCL_PATCH_LEVEL="b2" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} diff --git a/unix/tcl.spec b/unix/tcl.spec index d56cee3..65194f6 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 9.0b1 +Version: 9.0b2 Release: 2 License: BSD Group: Development/Languages diff --git a/win/configure b/win/configure index a0529b0..103e114 100755 --- a/win/configure +++ b/win/configure @@ -2411,7 +2411,7 @@ SHELL=/bin/sh TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="b1" +TCL_PATCH_LEVEL="b2" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 diff --git a/win/configure.ac b/win/configure.ac index f40871d..9f6e21a 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -15,7 +15,7 @@ SHELL=/bin/sh TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="b1" +TCL_PATCH_LEVEL="b2" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 -- cgit v0.12 From 0175377f5e1c38829cb31dfa14ee9d28714e9a57 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 5 Mar 2024 16:38:57 +0000 Subject: fix for [910d67a229fe7f65]: search of `namespace unknown` handler fixed: first try to find namespace unknown handler of the namespace of executed command if available; this elementary fixes following bug (additionally prevents to call slowly global "::unknown" for known/loaded namespaces with registered unknown handler) --- generic/tclBasic.c | 29 +++++++++++++++++++++++++---- tests/namespace.test | 9 +++++++++ 2 files changed, 34 insertions(+), 4 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 8dde621..93c3b43 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4726,12 +4726,33 @@ TEOV_NotFound( * unknown command handler for the current * namespace (TIP 181). */ Namespace *savedNsPtr = NULL; + + int qualLen; + const char *qualName = TclGetStringFromObj(objv[0], &qualLen); currNsPtr = varFramePtr->nsPtr; - if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) { - currNsPtr = iPtr->globalNsPtr; - if (currNsPtr == NULL) { - Tcl_Panic("Tcl_EvalObjv: NULL global namespace pointer"); + if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL) || + (qualLen > 2 && (*qualName == ':') && (*(qualName+1) == ':')) + ) { + /* + * first try to find namespace unknown handler of the namespace + * of executed command if available: + */ + Namespace *dummyNsPtr; + const char *simpleName; + + (void) TclGetNamespaceForQualName(interp, qualName, currNsPtr, + TCL_NAMESPACE_ONLY, &currNsPtr, &dummyNsPtr, &dummyNsPtr, + &simpleName); + if ((currNsPtr == NULL) || (simpleName == NULL) || + currNsPtr->unknownHandlerPtr == NULL || + (currNsPtr->flags & (NS_DYING | NS_DEAD)) + ) { + /* fallback to the global unknown */ + currNsPtr = iPtr->globalNsPtr; + if (currNsPtr == NULL) { + Tcl_Panic("TEOV_NotFound: NULL global namespace pointer"); + } } } diff --git a/tests/namespace.test b/tests/namespace.test index 08531e4..74cd6a9 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -3047,6 +3047,15 @@ test namespace-52.12 {unknown: error case must not reset handler} -body { } -cleanup { namespace delete foo } -result ok +test namespace-52.13 {unknown: invocation outside of NS doesn't evade namespace unknown, bug 910d67a229fe7f65} -body { + namespace eval ::foo::bar { + proc _unknown args {list ::foo:bar:_unknown [uplevel {namespace current}] $args} + namespace unknown [namespace current]::_unknown + } + list [namespace inscope ::foo::bar {xxx}] [namespace inscope ::foo {bar::xxx}] [::foo::bar::xxx] +} -cleanup { + namespace delete ::foo +} -result {{::foo:bar:_unknown ::foo::bar xxx} {::foo:bar:_unknown ::foo bar::xxx} {::foo:bar:_unknown :: ::foo::bar::xxx}} # TIP 314 - ensembles with parameters test namespace-53.1 {ensembles: parameters} { -- cgit v0.12 From 160adebaec1f2ed12ae196b61d7b103bf925d1bb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 6 Mar 2024 10:04:47 +0000 Subject: a6 -> b1, as preparation for possible release (hopefully, one day) --- README.md | 2 +- generic/tcl.h | 6 +++--- library/init.tcl | 2 +- unix/configure | 2 +- unix/configure.ac | 2 +- unix/tcl.spec | 2 +- win/configure | 2 +- win/configure.ac | 2 +- 8 files changed, 10 insertions(+), 10 deletions(-) diff --git a/README.md b/README.md index 8b84860..c97ab73 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # README: Tcl -This is the **Tcl 8.7a6** source distribution. +This is the **Tcl 8.7b1** source distribution. You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). diff --git a/generic/tcl.h b/generic/tcl.h index 80be1a5..da94b47 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -54,11 +54,11 @@ extern "C" { # error "This header-file is for Tcl 8 only" #endif #define TCL_MINOR_VERSION 7 -#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE -#define TCL_RELEASE_SERIAL 6 +#define TCL_RELEASE_LEVEL TCL_BETA_RELEASE +#define TCL_RELEASE_SERIAL 1 #define TCL_VERSION "8.7" -#define TCL_PATCH_LEVEL "8.7a6" +#define TCL_PATCH_LEVEL "8.7b1" #if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED) /* diff --git a/library/init.tcl b/library/init.tcl index 6ef0ac1..09c3418 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -15,7 +15,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -package require -exact tcl 8.7a6 +package require -exact tcl 8.7b1 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/unix/configure b/unix/configure index b2410d1..092f19c 100755 --- a/unix/configure +++ b/unix/configure @@ -2710,7 +2710,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=8.7 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a6" +TCL_PATCH_LEVEL="b1" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} diff --git a/unix/configure.ac b/unix/configure.ac index 3152942..a74d494 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -26,7 +26,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=8.7 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a6" +TCL_PATCH_LEVEL="b1" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} diff --git a/unix/tcl.spec b/unix/tcl.spec index 3956126..1351b38 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.7a6 +Version: 8.7b1 Release: 2 License: BSD Group: Development/Languages diff --git a/win/configure b/win/configure index 8dc75ff..94e04f5 100755 --- a/win/configure +++ b/win/configure @@ -2417,7 +2417,7 @@ SHELL=/bin/sh TCL_VERSION=8.7 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a6" +TCL_PATCH_LEVEL="b1" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 diff --git a/win/configure.ac b/win/configure.ac index 2761cfd..25fa29f 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -15,7 +15,7 @@ SHELL=/bin/sh TCL_VERSION=8.7 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=7 -TCL_PATCH_LEVEL="a6" +TCL_PATCH_LEVEL="b1" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 -- cgit v0.12 From 5a74f345ac466a0a61b8c46bdcb3576848e6f987 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 6 Mar 2024 12:05:31 +0000 Subject: small amend to [910d67a229fe7f65]: additional corner case (see the test namespace-52.13) --- generic/tclBasic.c | 2 +- tests/namespace.test | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 93c3b43..ffd69c4 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4732,7 +4732,7 @@ TEOV_NotFound( currNsPtr = varFramePtr->nsPtr; if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL) || - (qualLen > 2 && (*qualName == ':') && (*(qualName+1) == ':')) + (qualLen > 2 && memchr(qualName, ':', qualLen)) /* fast check for NS:: */ ) { /* * first try to find namespace unknown handler of the namespace diff --git a/tests/namespace.test b/tests/namespace.test index 74cd6a9..c8c1992 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -3052,10 +3052,10 @@ test namespace-52.13 {unknown: invocation outside of NS doesn't evade namespace proc _unknown args {list ::foo:bar:_unknown [uplevel {namespace current}] $args} namespace unknown [namespace current]::_unknown } - list [namespace inscope ::foo::bar {xxx}] [namespace inscope ::foo {bar::xxx}] [::foo::bar::xxx] + list [namespace inscope ::foo::bar {xxx}] [namespace inscope ::foo {bar::xxx}] [::foo::bar::xxx] [namespace inscope :: {foo::bar::xxx}] } -cleanup { namespace delete ::foo -} -result {{::foo:bar:_unknown ::foo::bar xxx} {::foo:bar:_unknown ::foo bar::xxx} {::foo:bar:_unknown :: ::foo::bar::xxx}} +} -result {{::foo:bar:_unknown ::foo::bar xxx} {::foo:bar:_unknown ::foo bar::xxx} {::foo:bar:_unknown :: ::foo::bar::xxx} {::foo:bar:_unknown :: foo::bar::xxx}} # TIP 314 - ensembles with parameters test namespace-53.1 {ensembles: parameters} { -- cgit v0.12 From ea30fa77faf70296eb26e071f149f8a935a8bc30 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 6 Mar 2024 19:22:10 +0000 Subject: better variant of fix for [910d67a229fe7f65] with improved search for NS::command (find NS even if command is not simple name), additionally it'd invoke handler of parent NS if child NS doesn't have unknown handler (see test namespace-52.14) --- generic/tclBasic.c | 14 ++++++++++++-- generic/tclInt.h | 3 +++ generic/tclNamesp.c | 20 ++++++++++++-------- tests/namespace.test | 16 ++++++++++++++++ 4 files changed, 43 insertions(+), 10 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index ffd69c4..78685f0 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4741,13 +4741,23 @@ TEOV_NotFound( Namespace *dummyNsPtr; const char *simpleName; + tryParentNS: (void) TclGetNamespaceForQualName(interp, qualName, currNsPtr, - TCL_NAMESPACE_ONLY, &currNsPtr, &dummyNsPtr, &dummyNsPtr, - &simpleName); + TCL_NAMESPACE_ONLY | TCL_FIND_IF_NOT_SIMPLE, &currNsPtr, + &dummyNsPtr, &dummyNsPtr, &simpleName); if ((currNsPtr == NULL) || (simpleName == NULL) || currNsPtr->unknownHandlerPtr == NULL || (currNsPtr->flags & (NS_DYING | NS_DEAD)) ) { + /* traverse to alive parent namespace containing handler */ + if (currNsPtr) { + qualName = currNsPtr->fullName; + qualLen = strlen(qualName); + if (qualLen > 2 && memchr(qualName, ':', qualLen)) { + currNsPtr = iPtr->globalNsPtr; + goto tryParentNS; + } + } /* fallback to the global unknown */ currNsPtr = iPtr->globalNsPtr; if (currNsPtr == NULL) { diff --git a/generic/tclInt.h b/generic/tclInt.h index 68c07f2..de92a7d 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -400,10 +400,13 @@ struct NamespacePathEntry { * TCL_NAMESPACE_ONLY - (see tcl.h) Look only in the context ns. * TCL_CREATE_NS_IF_UNKNOWN - Create unknown namespaces. * TCL_FIND_ONLY_NS - The name sought is a namespace name. + * TCL_FIND_IF_NOT_SIMPLE - Retrieve last namespace even if the rest of + * name is not simple name (contains ::). */ #define TCL_CREATE_NS_IF_UNKNOWN 0x800 #define TCL_FIND_ONLY_NS 0x1000 +#define TCL_FIND_IF_NOT_SIMPLE 0x2000 /* * The client data for an ensemble command. This consists of the table of diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 290dcea..37092fe 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -2280,11 +2280,8 @@ TclGetNamespaceForQualName( if (flags & TCL_FIND_ONLY_NS) { nsName = start; } else { - *nsPtrPtr = nsPtr; - *altNsPtrPtr = altNsPtr; *simpleNamePtr = start; - Tcl_DStringFree(&buffer); - return TCL_OK; + goto done; } } else { /* @@ -2334,6 +2331,15 @@ TclGetNamespaceForQualName( } } else { /* Namespace not found and was not * created. */ + if (flags & TCL_FIND_IF_NOT_SIMPLE) { + /* + * return last found NS and not simple name relative it, + * e. g. ::A::B::C::D -> ::A::B and C::D, if + * namespace C cannot be found in ::A::B + */ + *simpleNamePtr = start; + goto done; + } nsPtr = NULL; } } @@ -2364,11 +2370,8 @@ TclGetNamespaceForQualName( */ if ((nsPtr == NULL) && (altNsPtr == NULL)) { - *nsPtrPtr = NULL; - *altNsPtrPtr = NULL; *simpleNamePtr = NULL; - Tcl_DStringFree(&buffer); - return TCL_OK; + goto done; } start = end; @@ -2398,6 +2401,7 @@ TclGetNamespaceForQualName( nsPtr = NULL; } +done: *nsPtrPtr = nsPtr; *altNsPtrPtr = altNsPtr; Tcl_DStringFree(&buffer); diff --git a/tests/namespace.test b/tests/namespace.test index c8c1992..5a8f6f4 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -3056,6 +3056,22 @@ test namespace-52.13 {unknown: invocation outside of NS doesn't evade namespace } -cleanup { namespace delete ::foo } -result {{::foo:bar:_unknown ::foo::bar xxx} {::foo:bar:_unknown ::foo bar::xxx} {::foo:bar:_unknown :: ::foo::bar::xxx} {::foo:bar:_unknown :: foo::bar::xxx}} +test namespace-52.14 {unknown: invocation outside of NS doesn't evade namespace unknown for command with sub-NS, bug 910d67a229fe7f65} -body { + namespace eval ::foo::bar { + proc _unknown args {list ::foo:bar:_unknown [uplevel {namespace current}] $args} + namespace unknown [namespace current]::_unknown + } + set res {} + lappend res [namespace inscope ::foo::bar {xxx::yyy}] [namespace inscope ::foo {bar::xxx::yyy}] [::foo::bar::xxx::yyy] [namespace inscope :: {foo::bar::xxx::yyy}] + # now with existsing ::foo::bar::xxx, but without unknown handler inside (only parent ::foo::bar has a handler): + namespace eval ::foo::bar::xxx {} + lappend res [namespace inscope ::foo::bar {xxx::yyy}] [namespace inscope ::foo {bar::xxx::yyy}] [::foo::bar::xxx::yyy] [namespace inscope :: {foo::bar::xxx::yyy}] +} -cleanup { + namespace delete ::foo + unset -nocomplain res +} -result [lrepeat 2 \ + {::foo:bar:_unknown ::foo::bar xxx::yyy} {::foo:bar:_unknown ::foo bar::xxx::yyy} {::foo:bar:_unknown :: ::foo::bar::xxx::yyy} {::foo:bar:_unknown :: foo::bar::xxx::yyy} +] # TIP 314 - ensembles with parameters test namespace-53.1 {ensembles: parameters} { -- cgit v0.12 From 19e464fbe00deec5ce205e39dbd61107b00a7a80 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 6 Mar 2024 21:29:40 +0000 Subject: small amend: simpler traversing using ns->parentPtr --- generic/tclBasic.c | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 78685f0..f8baf1c 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4741,27 +4741,21 @@ TEOV_NotFound( Namespace *dummyNsPtr; const char *simpleName; - tryParentNS: (void) TclGetNamespaceForQualName(interp, qualName, currNsPtr, TCL_NAMESPACE_ONLY | TCL_FIND_IF_NOT_SIMPLE, &currNsPtr, &dummyNsPtr, &dummyNsPtr, &simpleName); - if ((currNsPtr == NULL) || (simpleName == NULL) || + while ((currNsPtr == NULL) || (simpleName == NULL) || currNsPtr->unknownHandlerPtr == NULL || (currNsPtr->flags & (NS_DYING | NS_DEAD)) ) { /* traverse to alive parent namespace containing handler */ - if (currNsPtr) { - qualName = currNsPtr->fullName; - qualLen = strlen(qualName); - if (qualLen > 2 && memchr(qualName, ':', qualLen)) { - currNsPtr = iPtr->globalNsPtr; - goto tryParentNS; + if (!currNsPtr || !(currNsPtr = currNsPtr->parentPtr)) { + /* fallback to the global unknown */ + currNsPtr = iPtr->globalNsPtr; + if (currNsPtr == NULL) { + Tcl_Panic("TEOV_NotFound: NULL global namespace pointer"); } - } - /* fallback to the global unknown */ - currNsPtr = iPtr->globalNsPtr; - if (currNsPtr == NULL) { - Tcl_Panic("TEOV_NotFound: NULL global namespace pointer"); + break; } } } -- cgit v0.12 From 4fbee3712ec9b889a1f6f5a5e1bd1386a661edc7 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 6 Mar 2024 21:44:10 +0000 Subject: core review --- generic/tclBasic.c | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index f8baf1c..41dbee2 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4744,12 +4744,15 @@ TEOV_NotFound( (void) TclGetNamespaceForQualName(interp, qualName, currNsPtr, TCL_NAMESPACE_ONLY | TCL_FIND_IF_NOT_SIMPLE, &currNsPtr, &dummyNsPtr, &dummyNsPtr, &simpleName); - while ((currNsPtr == NULL) || (simpleName == NULL) || - currNsPtr->unknownHandlerPtr == NULL || + if ((currNsPtr == NULL) || (simpleName == NULL)) { + goto globNS; + } + while (currNsPtr->unknownHandlerPtr == NULL || (currNsPtr->flags & (NS_DYING | NS_DEAD)) ) { /* traverse to alive parent namespace containing handler */ - if (!currNsPtr || !(currNsPtr = currNsPtr->parentPtr)) { + if (!(currNsPtr = currNsPtr->parentPtr)) { + globNS: /* fallback to the global unknown */ currNsPtr = iPtr->globalNsPtr; if (currNsPtr == NULL) { -- cgit v0.12 From 7996ffa7cb2fb66a81b2115bdd49b6b7c7b4d88e Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 7 Mar 2024 11:21:03 +0000 Subject: fixes segfault [a9625d1f53554f9d]: elemObj used uninitialized, lindex on lseq wo args must return whole list --- generic/tclListObj.c | 2 +- tests/lseq.test | 7 +++++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 94322f2..6c7f128 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -2637,7 +2637,7 @@ TclLindexFlat( if (TclHasInternalRep(listObj,&tclArithSeriesType)) { Tcl_Size listLen = TclArithSeriesObjLength(listObj); Tcl_Size index; - Tcl_Obj *elemObj = NULL; + Tcl_Obj *elemObj = listObj; /* for lindex without indices return list */ for (i=0 ; i Date: Fri, 8 Mar 2024 10:04:57 +0000 Subject: Remove dead code --- unix/configure | 14 +++++--------- unix/tcl.m4 | 11 +++++------ 2 files changed, 10 insertions(+), 15 deletions(-) diff --git a/unix/configure b/unix/configure index fe3be30..c8e5bdc 100755 --- a/unix/configure +++ b/unix/configure @@ -6402,16 +6402,12 @@ fi case $system in DragonFly-*|FreeBSD-*) - if test "${TCL_THREADS}" = "1" -then : - - # The -pthread needs to go in the LDFLAGS, not LIBS - LIBS=`echo $LIBS | sed s/-pthread//` - CFLAGS="$CFLAGS $PTHREAD_CFLAGS" - LDFLAGS="$LDFLAGS $PTHREAD_LIBS" -fi + # The -pthread needs to go in the LDFLAGS, not LIBS + LIBS=`echo $LIBS | sed s/-pthread//` + CFLAGS="$CFLAGS $PTHREAD_CFLAGS" + LDFLAGS="$LDFLAGS $PTHREAD_LIBS" ;; - esac + esac if test $doRpath = yes then : diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 4a9fe40..7b84923 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -1276,13 +1276,12 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ case $system in DragonFly-*|FreeBSD-*) - AS_IF([test "${TCL_THREADS}" = "1"], [ - # The -pthread needs to go in the LDFLAGS, not LIBS - LIBS=`echo $LIBS | sed s/-pthread//` - CFLAGS="$CFLAGS $PTHREAD_CFLAGS" - LDFLAGS="$LDFLAGS $PTHREAD_LIBS"]) + # The -pthread needs to go in the LDFLAGS, not LIBS + LIBS=`echo $LIBS | sed s/-pthread//` + CFLAGS="$CFLAGS $PTHREAD_CFLAGS" + LDFLAGS="$LDFLAGS $PTHREAD_LIBS" ;; - esac + esac AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"']) -- cgit v0.12 From d3ed53e89b8c0cb708d5d21ce0045144e7d081e3 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 8 Mar 2024 11:31:50 +0000 Subject: typo's --- win/tclWinThrd.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index da9133f..e468d7a 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -38,7 +38,7 @@ static CRITICAL_SECTION initLock; /* * allocLock is used by Tcl's version of malloc for synchronization. For - * obvious reasons, cannot use any dyamically allocated storage. + * obvious reasons, cannot use any dynamically allocated storage. */ #if TCL_THREADS @@ -458,7 +458,7 @@ TclpGlobalUnlock(void) * Tcl_GetAllocMutex * * This procedure returns a pointer to a statically initialized mutex for - * use by the memory allocator. The alloctor must use this lock, because + * use by the memory allocator. The allocator must use this lock, because * all other locks are allocated... * * Results: -- cgit v0.12 From e649d3487899b2a23aad3169224a161891e6ae33 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 8 Mar 2024 13:40:57 +0000 Subject: namespace unknown considers also alternate search path (relative global NS), see namespace-52.14 --- generic/tclBasic.c | 27 +++++++++++++++++++++------ tests/namespace.test | 17 +++++++++++++++++ 2 files changed, 38 insertions(+), 6 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index d87fea6..9b4161a 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4816,20 +4816,35 @@ TEOV_NotFound( * first try to find namespace unknown handler of the namespace * of executed command if available: */ - Namespace *dummyNsPtr; + Namespace *altNsPtr, *dummyNsPtr; const char *simpleName; (void) TclGetNamespaceForQualName(interp, qualName, currNsPtr, - TCL_NAMESPACE_ONLY | TCL_FIND_IF_NOT_SIMPLE, &currNsPtr, - &dummyNsPtr, &dummyNsPtr, &simpleName); - if ((currNsPtr == NULL) || (simpleName == NULL)) { - goto globNS; + TCL_FIND_IF_NOT_SIMPLE, &currNsPtr, &altNsPtr, + &dummyNsPtr, &simpleName); + if (!simpleName) { + goto globNS; + } + if (!currNsPtr || (currNsPtr == iPtr->globalNsPtr)) { + if (!altNsPtr || (altNsPtr == iPtr->globalNsPtr)) { + goto globNS; + } + currNsPtr = altNsPtr; } while (currNsPtr->unknownHandlerPtr == NULL || (currNsPtr->flags & (NS_DYING | NS_DEAD)) ) { /* traverse to alive parent namespace containing handler */ - if (!(currNsPtr = currNsPtr->parentPtr)) { + if (!(currNsPtr = currNsPtr->parentPtr) || + (currNsPtr == iPtr->globalNsPtr) + ) { + /* continue from alternate NS if available */ + if (!altNsPtr || (altNsPtr == iPtr->globalNsPtr)) { + goto globNS; + } + currNsPtr = altNsPtr; + altNsPtr = NULL; + continue; globNS: /* fallback to the global unknown */ currNsPtr = iPtr->globalNsPtr; diff --git a/tests/namespace.test b/tests/namespace.test index 9976cf3..abe642e 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -3149,6 +3149,23 @@ test namespace-52.14 {unknown: invocation outside of NS doesn't evade namespace } -result [lrepeat 2 \ {::foo:bar:_unknown ::foo::bar xxx::yyy} {::foo:bar:_unknown ::foo bar::xxx::yyy} {::foo:bar:_unknown :: ::foo::bar::xxx::yyy} {::foo:bar:_unknown :: foo::bar::xxx::yyy} ] +test namespace-52.14 {unknown: it must consider alternate search path (relative global NS), bug 910d67a229fe7f65} -body { + namespace eval ::foo::bar {} + namespace eval ::xxx::yyy { + proc _unknown args {list ::xxx:yyy:_unknown [uplevel {namespace current}] $args} + namespace unknown [namespace current]::_unknown + } + set res {} + lappend res [namespace inscope ::foo::bar {xxx::yyy::cmd}] [namespace inscope ::foo {xxx::yyy::cmd}] + namespace eval ::foo::bar::xxx {} + lappend res [namespace inscope ::foo::bar {xxx::yyy::cmd}] [namespace inscope ::foo {xxx::yyy::cmd}] + namespace eval ::foo::bar::xxx::yyy {} + lappend res [namespace inscope ::foo::bar {xxx::yyy::cmd}] [namespace inscope ::foo {xxx::yyy::cmd}] +} -cleanup { + namespace delete ::foo + namespace delete ::xxx + unset -nocomplain res +} -result [lrepeat 3 {::xxx:yyy:_unknown ::foo::bar xxx::yyy::cmd} {::xxx:yyy:_unknown ::foo xxx::yyy::cmd}] # TIP 314 - ensembles with parameters test namespace-53.1 {ensembles: parameters} { -- cgit v0.12 From c45f07dc1df8005a25169017d34547b307a5fc14 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 8 Mar 2024 15:32:58 +0000 Subject: Corrections to TclOO errorcodes from scripted parts --- tools/tclOOScript.tcl | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/tools/tclOOScript.tcl b/tools/tclOOScript.tcl index 4591a1b..0b75882 100644 --- a/tools/tclOOScript.tcl +++ b/tools/tclOOScript.tcl @@ -88,7 +88,7 @@ lassign $link src set dst $src } else { - return -code error -errorcode {TCLOO CMDLINK FORMAT} \ + return -code error -errorcode {TCL OO CMDLINK_FORMAT} \ "bad link description; must only have one or two elements" } if {![string match ::* $src]} { @@ -258,7 +258,7 @@ # ------------------------------------------------------------------ method Get -unexport {} { - return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented" + return -code error -errorcode {TCL OO ABSTRACT_SLOT} "unimplemented" } # ------------------------------------------------------------------ @@ -271,7 +271,7 @@ # ------------------------------------------------------------------ method Set -unexport list { - return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented" + return -code error -errorcode {TCL OO ABSTRACT_SLOT} "unimplemented" } # ------------------------------------------------------------------ @@ -431,11 +431,11 @@ set object [next {*}$args] ::oo::objdefine $object { method destroy {} { - ::return -code error -errorcode {TCLOO SINGLETON} \ + ::return -code error -errorcode {TCL OO SINGLETON} \ "may not destroy a singleton object" } method -unexport {originObject} { - ::return -code error -errorcode {TCLOO SINGLETON} \ + ::return -code error -errorcode {TCL OO SINGLETON} \ "may not clone a singleton object" } } @@ -492,22 +492,22 @@ set prop [lindex $args $i] if {[string match "-*" $prop]} { return -code error -level 2 \ - -errorcode {TCLOO PROPERTY_FORMAT} \ + -errorcode {TCL OO PROPERTY_FORMAT} \ "bad property name \"$prop\": must not begin with -" } if {$prop ne [list $prop]} { return -code error -level 2 \ - -errorcode {TCLOO PROPERTY_FORMAT} \ + -errorcode {TCL OO PROPERTY_FORMAT} \ "bad property name \"$prop\": must be a simple word" } if {[string first "::" $prop] != -1} { return -code error -level 2 \ - -errorcode {TCLOO PROPERTY_FORMAT} \ + -errorcode {TCL OO PROPERTY_FORMAT} \ "bad property name \"$prop\": must not contain namespace separators" } if {[string match {*[()]*} $prop]} { return -code error -level 2 \ - -errorcode {TCLOO PROPERTY_FORMAT} \ + -errorcode {TCL OO PROPERTY_FORMAT} \ "bad property name \"$prop\": must not contain parentheses" } set realprop [string cat "-" $prop] @@ -630,10 +630,10 @@ dict incr opt -level 2 return -options $opt $msg } on break {} { - return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \ + return -code error -level 2 -errorcode {TCL OO SHENANIGANS} \ "property getter for $prop did a break" } on continue {} { - return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \ + return -code error -level 2 -errorcode {TCL OO SHENANIGANS} \ "property getter for $prop did a continue" } } @@ -671,10 +671,10 @@ dict incr opt -level 2 return -options $opt $msg } on break {} { - return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \ + return -code error -level 2 -errorcode {TCL OO SHENANIGANS} \ "property getter for $prop did a break" } on continue {} { - return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \ + return -code error -level 2 -errorcode {TCL OO SHENANIGANS} \ "property getter for $prop did a continue" } return $value @@ -711,10 +711,10 @@ dict incr opt -level 2 return -options $opt $msg } on break {} { - return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \ + return -code error -level 2 -errorcode {TCL OO SHENANIGANS} \ "property setter for $prop did a break" } on continue {} { - return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \ + return -code error -level 2 -errorcode {TCL OO SHENANIGANS} \ "property setter for $prop did a continue" } } -- cgit v0.12 From 01db06ec6a69c53b70382ddce89a2d193f682eee Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 9 Mar 2024 22:56:44 +0000 Subject: (backport): Corrections to TclOO errorcodes from scripted parts --- generic/tclNamesp.c | 4 ++-- generic/tclOOScript.h | 30 +++++++++++++++--------------- tools/tclOOScript.tcl | 30 +++++++++++++++--------------- 3 files changed, 32 insertions(+), 32 deletions(-) diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 0648b25..5d129df 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -2379,7 +2379,7 @@ TclGetNamespaceForQualName( Tcl_Panic("Could not create namespace '%s'", nsName); } } else { - /* + /* * Namespace not found and was not created. * Remember last found namespace for TCL_FIND_IF_NOT_SIMPLE. */ @@ -2417,7 +2417,7 @@ TclGetNamespaceForQualName( if ((nsPtr == NULL) && (altNsPtr == NULL)) { if (flags & TCL_FIND_IF_NOT_SIMPLE) { - /* + /* * return last found NS, regardless simple name or not, * e. g. ::A::B::C::D -> ::A::B and C::D, if namespace C * cannot be found in ::A::B diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h index eb6a96e..a763092 100644 --- a/generic/tclOOScript.h +++ b/generic/tclOOScript.h @@ -64,7 +64,7 @@ static const char *tclOOSetupScript = "\t\t\t\t\tlassign $link src\n" "\t\t\t\t\tset dst $src\n" "\t\t\t\t} else {\n" -"\t\t\t\t\treturn -code error -errorcode {TCLOO CMDLINK FORMAT} \\\n" +"\t\t\t\t\treturn -code error -errorcode {TCL OO CMDLINK_FORMAT} \\\n" "\t\t\t\t\t\t\"bad link description; must only have one or two elements\"\n" "\t\t\t\t}\n" "\t\t\t\tif {![string match ::* $src]} {\n" @@ -142,10 +142,10 @@ static const char *tclOOSetupScript = "\t}\n" "\tdefine Slot {\n" "\t\tmethod Get -unexport {} {\n" -"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n" +"\t\t\treturn -code error -errorcode {TCL OO ABSTRACT_SLOT} \"unimplemented\"\n" "\t\t}\n" "\t\tmethod Set -unexport list {\n" -"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n" +"\t\t\treturn -code error -errorcode {TCL OO ABSTRACT_SLOT} \"unimplemented\"\n" "\t\t}\n" "\t\tmethod Resolve -unexport list {\n" "\t\t\treturn $list\n" @@ -242,11 +242,11 @@ static const char *tclOOSetupScript = "\t\t\t\tset object [next {*}$args]\n" "\t\t\t\t::oo::objdefine $object {\n" "\t\t\t\t\tmethod destroy {} {\n" -"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n" +"\t\t\t\t\t\t::return -code error -errorcode {TCL OO SINGLETON} \\\n" "\t\t\t\t\t\t\t\"may not destroy a singleton object\"\n" "\t\t\t\t\t}\n" "\t\t\t\t\tmethod -unexport {originObject} {\n" -"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n" +"\t\t\t\t\t\t::return -code error -errorcode {TCL OO SINGLETON} \\\n" "\t\t\t\t\t\t\t\"may not clone a singleton object\"\n" "\t\t\t\t\t}\n" "\t\t\t\t}\n" @@ -265,22 +265,22 @@ static const char *tclOOSetupScript = "\t\t\t\tset prop [lindex $args $i]\n" "\t\t\t\tif {[string match \"-*\" $prop]} {\n" "\t\t\t\t\treturn -code error -level 2 \\\n" -"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n" +"\t\t\t\t\t\t-errorcode {TCL OO PROPERTY_FORMAT} \\\n" "\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must not begin with -\"\n" "\t\t\t\t}\n" "\t\t\t\tif {$prop ne [list $prop]} {\n" "\t\t\t\t\treturn -code error -level 2 \\\n" -"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n" +"\t\t\t\t\t\t-errorcode {TCL OO PROPERTY_FORMAT} \\\n" "\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must be a simple word\"\n" "\t\t\t\t}\n" "\t\t\t\tif {[string first \"::\" $prop] != -1} {\n" "\t\t\t\t\treturn -code error -level 2 \\\n" -"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n" +"\t\t\t\t\t\t-errorcode {TCL OO PROPERTY_FORMAT} \\\n" "\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must not contain namespace separators\"\n" "\t\t\t\t}\n" "\t\t\t\tif {[string match {*[()]*} $prop]} {\n" "\t\t\t\t\treturn -code error -level 2 \\\n" -"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n" +"\t\t\t\t\t\t-errorcode {TCL OO PROPERTY_FORMAT} \\\n" "\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must not contain parentheses\"\n" "\t\t\t\t}\n" "\t\t\t\tset realprop [string cat \"-\" $prop]\n" @@ -376,10 +376,10 @@ static const char *tclOOSetupScript = "\t\t\t\t\tdict incr opt -level 2\n" "\t\t\t\t\treturn -options $opt $msg\n" "\t\t\t\t} on break {} {\n" -"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n" +"\t\t\t\t\treturn -code error -level 2 -errorcode {TCL OO SHENANIGANS} \\\n" "\t\t\t\t\t\t\"property getter for $prop did a break\"\n" "\t\t\t\t} on continue {} {\n" -"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n" +"\t\t\t\t\treturn -code error -level 2 -errorcode {TCL OO SHENANIGANS} \\\n" "\t\t\t\t\t\t\"property getter for $prop did a continue\"\n" "\t\t\t\t}\n" "\t\t\t}\n" @@ -407,10 +407,10 @@ static const char *tclOOSetupScript = "\t\t\t\tdict incr opt -level 2\n" "\t\t\t\treturn -options $opt $msg\n" "\t\t\t} on break {} {\n" -"\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n" +"\t\t\t\treturn -code error -level 2 -errorcode {TCL OO SHENANIGANS} \\\n" "\t\t\t\t\t\"property getter for $prop did a break\"\n" "\t\t\t} on continue {} {\n" -"\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n" +"\t\t\t\treturn -code error -level 2 -errorcode {TCL OO SHENANIGANS} \\\n" "\t\t\t\t\t\"property getter for $prop did a continue\"\n" "\t\t\t}\n" "\t\t\treturn $value\n" @@ -438,10 +438,10 @@ static const char *tclOOSetupScript = "\t\t\t\t\tdict incr opt -level 2\n" "\t\t\t\t\treturn -options $opt $msg\n" "\t\t\t\t} on break {} {\n" -"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n" +"\t\t\t\t\treturn -code error -level 2 -errorcode {TCL OO SHENANIGANS} \\\n" "\t\t\t\t\t\t\"property setter for $prop did a break\"\n" "\t\t\t\t} on continue {} {\n" -"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n" +"\t\t\t\t\treturn -code error -level 2 -errorcode {TCL OO SHENANIGANS} \\\n" "\t\t\t\t\t\t\"property setter for $prop did a continue\"\n" "\t\t\t\t}\n" "\t\t\t}\n" diff --git a/tools/tclOOScript.tcl b/tools/tclOOScript.tcl index 4591a1b..0b75882 100644 --- a/tools/tclOOScript.tcl +++ b/tools/tclOOScript.tcl @@ -88,7 +88,7 @@ lassign $link src set dst $src } else { - return -code error -errorcode {TCLOO CMDLINK FORMAT} \ + return -code error -errorcode {TCL OO CMDLINK_FORMAT} \ "bad link description; must only have one or two elements" } if {![string match ::* $src]} { @@ -258,7 +258,7 @@ # ------------------------------------------------------------------ method Get -unexport {} { - return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented" + return -code error -errorcode {TCL OO ABSTRACT_SLOT} "unimplemented" } # ------------------------------------------------------------------ @@ -271,7 +271,7 @@ # ------------------------------------------------------------------ method Set -unexport list { - return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented" + return -code error -errorcode {TCL OO ABSTRACT_SLOT} "unimplemented" } # ------------------------------------------------------------------ @@ -431,11 +431,11 @@ set object [next {*}$args] ::oo::objdefine $object { method destroy {} { - ::return -code error -errorcode {TCLOO SINGLETON} \ + ::return -code error -errorcode {TCL OO SINGLETON} \ "may not destroy a singleton object" } method -unexport {originObject} { - ::return -code error -errorcode {TCLOO SINGLETON} \ + ::return -code error -errorcode {TCL OO SINGLETON} \ "may not clone a singleton object" } } @@ -492,22 +492,22 @@ set prop [lindex $args $i] if {[string match "-*" $prop]} { return -code error -level 2 \ - -errorcode {TCLOO PROPERTY_FORMAT} \ + -errorcode {TCL OO PROPERTY_FORMAT} \ "bad property name \"$prop\": must not begin with -" } if {$prop ne [list $prop]} { return -code error -level 2 \ - -errorcode {TCLOO PROPERTY_FORMAT} \ + -errorcode {TCL OO PROPERTY_FORMAT} \ "bad property name \"$prop\": must be a simple word" } if {[string first "::" $prop] != -1} { return -code error -level 2 \ - -errorcode {TCLOO PROPERTY_FORMAT} \ + -errorcode {TCL OO PROPERTY_FORMAT} \ "bad property name \"$prop\": must not contain namespace separators" } if {[string match {*[()]*} $prop]} { return -code error -level 2 \ - -errorcode {TCLOO PROPERTY_FORMAT} \ + -errorcode {TCL OO PROPERTY_FORMAT} \ "bad property name \"$prop\": must not contain parentheses" } set realprop [string cat "-" $prop] @@ -630,10 +630,10 @@ dict incr opt -level 2 return -options $opt $msg } on break {} { - return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \ + return -code error -level 2 -errorcode {TCL OO SHENANIGANS} \ "property getter for $prop did a break" } on continue {} { - return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \ + return -code error -level 2 -errorcode {TCL OO SHENANIGANS} \ "property getter for $prop did a continue" } } @@ -671,10 +671,10 @@ dict incr opt -level 2 return -options $opt $msg } on break {} { - return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \ + return -code error -level 2 -errorcode {TCL OO SHENANIGANS} \ "property getter for $prop did a break" } on continue {} { - return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \ + return -code error -level 2 -errorcode {TCL OO SHENANIGANS} \ "property getter for $prop did a continue" } return $value @@ -711,10 +711,10 @@ dict incr opt -level 2 return -options $opt $msg } on break {} { - return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \ + return -code error -level 2 -errorcode {TCL OO SHENANIGANS} \ "property setter for $prop did a break" } on continue {} { - return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \ + return -code error -level 2 -errorcode {TCL OO SHENANIGANS} \ "property setter for $prop did a continue" } } -- cgit v0.12 From 7ce44f26ec53ad8711bafd772e7381f9a3034452 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 9 Mar 2024 23:47:52 +0000 Subject: fix testcase --- tests/ooProp.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/ooProp.test b/tests/ooProp.test index 8120f88..fa3b1e7 100644 --- a/tests/ooProp.test +++ b/tests/ooProp.test @@ -768,7 +768,7 @@ test ooProp-4.1 {TIP 558: properties: error details} -setup { "property -x" (in definition script for class "::Point" line 1) invoked from within -"oo::define Point {property -x}"} {TCLOO PROPERTY_FORMAT}} +"oo::define Point {property -x}"} {TCL OO PROPERTY_FORMAT}} test ooProp-4.2 {TIP 558: properties: error details} -setup { oo::class create parent unset -nocomplain msg opt -- cgit v0.12 From 55a9fbd791934460be24a93185740c610f768e31 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 10 Mar 2024 21:12:11 +0000 Subject: GetMonthDay() improvements (from sebres-9-0-clock-speedup-cr2 branch). Some int -> TclWideInt or int -> Tcl_Size --- generic/tclClock.c | 115 +++++++++++++++++++++++++++++------------------------ 1 file changed, 63 insertions(+), 52 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 228937e..0b17c55 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -43,10 +43,6 @@ * Table of the days in each month, leap and common years */ -static const int hath[2][12] = { - {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}, - {31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31} -}; static const int daysInPriorMonths[2][13] = { {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365}, {0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366} @@ -101,7 +97,7 @@ typedef struct { * Structure containing the fields used in [clock format] and [clock scan] */ -typedef struct TclDateFields { +typedef struct { Tcl_WideInt seconds; /* Time expressed in seconds from the Posix * epoch */ Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds @@ -143,24 +139,24 @@ TCL_DECLARE_MUTEX(clockMutex) static int ConvertUTCToLocal(Tcl_Interp *, TclDateFields *, Tcl_Obj *, int); static int ConvertUTCToLocalUsingTable(Tcl_Interp *, - TclDateFields *, int, Tcl_Obj *const[]); + TclDateFields *, Tcl_Size, Tcl_Obj *const[]); static int ConvertUTCToLocalUsingC(Tcl_Interp *, TclDateFields *, int); static int ConvertLocalToUTC(Tcl_Interp *, TclDateFields *, Tcl_Obj *, int); static int ConvertLocalToUTCUsingTable(Tcl_Interp *, - TclDateFields *, int, Tcl_Obj *const[]); + TclDateFields *, Tcl_Size, Tcl_Obj *const[]); static int ConvertLocalToUTCUsingC(Tcl_Interp *, TclDateFields *, int); static Tcl_Obj * LookupLastTransition(Tcl_Interp *, Tcl_WideInt, - int, Tcl_Obj *const *); + Tcl_Size, Tcl_Obj *const *); static void GetYearWeekDay(TclDateFields *, int); static void GetGregorianEraYearDay(TclDateFields *, int); static void GetMonthDay(TclDateFields *); static void GetJulianDayFromEraYearWeekDay(TclDateFields *, int); static void GetJulianDayFromEraYearMonthDay(TclDateFields *, int); static int IsGregorianLeapYear(TclDateFields *); -static int WeekdayOnOrBefore(int, int); +static Tcl_WideInt WeekdayOnOrBefore(int, Tcl_WideInt); static Tcl_ObjCmdProc ClockClicksObjCmd; static Tcl_ObjCmdProc ClockConvertlocaltoutcObjCmd; static Tcl_ObjCmdProc ClockGetdatefieldsObjCmd; @@ -189,16 +185,16 @@ struct ClockCommand { }; static const struct ClockCommand clockCommands[] = { - { "getenv", ClockGetenvObjCmd }, - { "Oldscan", TclClockOldscanObjCmd }, - { "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd }, - { "GetDateFields", ClockGetdatefieldsObjCmd }, - { "GetJulianDayFromEraYearMonthDay", - ClockGetjuliandayfromerayearmonthdayObjCmd }, - { "GetJulianDayFromEraYearWeekDay", - ClockGetjuliandayfromerayearweekdayObjCmd }, - { "ParseFormatArgs", ClockParseformatargsObjCmd }, - { NULL, NULL } + {"getenv", ClockGetenvObjCmd}, + {"Oldscan", TclClockOldscanObjCmd}, + {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd}, + {"GetDateFields", ClockGetdatefieldsObjCmd}, + {"GetJulianDayFromEraYearMonthDay", + ClockGetjuliandayfromerayearmonthdayObjCmd}, + {"GetJulianDayFromEraYearWeekDay", + ClockGetjuliandayfromerayearweekdayObjCmd}, + {"ParseFormatArgs", ClockParseformatargsObjCmd}, + {NULL, NULL} }; /* @@ -318,7 +314,6 @@ ClockConvertlocaltoutcObjCmd( Tcl_Obj *const *objv) /* Parameter vector */ { ClockClientData *data = (ClockClientData *)clientData; - Tcl_Obj *const *lit = data->literals; Tcl_Obj *secondsObj; Tcl_Obj *dict; int changeover; @@ -335,7 +330,7 @@ ClockConvertlocaltoutcObjCmd( return TCL_ERROR; } dict = objv[1]; - if (Tcl_DictObjGet(interp, dict, lit[LIT_LOCALSECONDS], + if (Tcl_DictObjGet(interp, dict, data->literals[LIT_LOCALSECONDS], &secondsObj)!= TCL_OK) { return TCL_ERROR; } @@ -361,7 +356,7 @@ ClockConvertlocaltoutcObjCmd( created = 1; Tcl_IncrRefCount(dict); } - status = Tcl_DictObjPut(interp, dict, lit[LIT_SECONDS], + status = Tcl_DictObjPut(interp, dict, data->literals[LIT_SECONDS], Tcl_NewWideIntObj(fields.seconds)); if (status == TCL_OK) { Tcl_SetObjResult(interp, dict); @@ -730,7 +725,7 @@ ConvertLocalToUTC( Tcl_Obj *tzdata, /* Time zone data */ int changeover) /* Julian Day of the Gregorian transition */ { - int rowc; /* Number of rows in tzdata */ + Tcl_Size rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ /* @@ -775,11 +770,11 @@ static int ConvertLocalToUTCUsingTable( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Time to convert, with 'seconds' filled in */ - int rowc, /* Number of points at which time changes */ + Tcl_Size rowc, /* Number of points at which time changes */ Tcl_Obj *const rowv[]) /* Points at which time changes */ { Tcl_Obj *row; - int cellc; + Tcl_Size cellc; Tcl_Obj **cellv; int have[8]; int nHave = 0; @@ -933,7 +928,7 @@ ConvertUTCToLocal( Tcl_Obj *tzdata, /* Time zone data */ int changeover) /* Julian Day of the Gregorian transition */ { - int rowc; /* Number of rows in tzdata */ + Tcl_Size rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ /* @@ -978,12 +973,12 @@ static int ConvertUTCToLocalUsingTable( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the date */ - int rowc, /* Number of rows in the conversion table + Tcl_Size rowc, /* Number of rows in the conversion table * (>= 1) */ Tcl_Obj *const rowv[]) /* Rows of the conversion table */ { Tcl_Obj *row; /* Row containing the current information */ - int cellc; /* Count of cells in the row (must be 4) */ + Tcl_Size cellc; /* Count of cells in the row (must be 4) */ Tcl_Obj **cellv; /* Pointers to the cells */ /* @@ -1045,7 +1040,7 @@ ConvertUTCToLocalUsingC( if ((Tcl_WideInt) tock != fields->seconds) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "number too large to represent as a Posix time", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", (void *)NULL); + Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", (char *)NULL); return TCL_ERROR; } TzsetIfNecessary(); @@ -1054,7 +1049,7 @@ ConvertUTCToLocalUsingC( Tcl_SetObjResult(interp, Tcl_NewStringObj( "localtime failed (clock value may be too " "large/small to represent)", -1)); - Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", (void *)NULL); + Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", (char *)NULL); return TCL_ERROR; } @@ -1118,11 +1113,10 @@ static Tcl_Obj * LookupLastTransition( Tcl_Interp *interp, /* Interpreter for error messages */ Tcl_WideInt tick, /* Time from the epoch */ - int rowc, /* Number of rows of tzdata */ + Tcl_Size rowc, /* Number of rows of tzdata */ Tcl_Obj *const *rowv) /* Rows in tzdata */ { - int l; - int u; + Tcl_Size l, u; Tcl_Obj *compObj; Tcl_WideInt compVal; @@ -1151,7 +1145,7 @@ LookupLastTransition( l = 0; u = rowc-1; while (l < u) { - int m = (l + u + 1) / 2; + Tcl_Size m = (l + u + 1) / 2; if (Tcl_ListObjIndex(interp, rowv[m], 0, &compObj) != TCL_OK || TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { @@ -1256,10 +1250,10 @@ GetGregorianEraYearDay( TclDateFields *fields, /* Date fields containing 'julianDay' */ int changeover) /* Gregorian transition date */ { - int jday = fields->julianDay; - int day; - int year; - int n; + Tcl_WideInt jday = fields->julianDay; + Tcl_WideInt day; + Tcl_WideInt year; + Tcl_WideInt n; if (jday >= changeover) { /* @@ -1373,11 +1367,27 @@ GetMonthDay( { int day = fields->dayOfYear; int month; - const int *h = hath[IsGregorianLeapYear(fields)]; + const int *dipm = daysInPriorMonths[IsGregorianLeapYear(fields)]; - for (month = 0; month < 12 && day > h[month]; ++month) { - day -= h[month]; + /* + * Estimate month by calculating `dayOfYear / (365/12)` + */ + month = (day*12) / dipm[12]; + /* then do forwards backwards correction */ + while (1) { + if (day > dipm[month]) { + if (month >= 11 || day <= dipm[month+1]) { + break; + } + month++; + } else { + if (month == 0) { + break; + } + month--; + } } + day -= dipm[month]; fields->month = month+1; fields->dayOfMonth = day; } @@ -1405,7 +1415,7 @@ GetJulianDayFromEraYearWeekDay( int changeover) /* Julian Day Number of the Gregorian * transition */ { - int firstMonday; /* Julian day number of week 1, day 1 in the + Tcl_WideInt firstMonday; /* Julian day number of week 1, day 1 in the * given year */ TclDateFields firstWeek; @@ -1455,7 +1465,8 @@ GetJulianDayFromEraYearMonthDay( TclDateFields *fields, /* Date to convert */ int changeover) /* Gregorian transition date as a Julian Day */ { - int year, ym1, month, mm1, q, r, ym1o4, ym1o100, ym1o400; + Tcl_WideInt year, ym1, ym1o4, ym1o100, ym1o400; + int month, mm1, q, r; if (fields->isBce) { year = 1 - fields->year; @@ -1561,7 +1572,7 @@ static int IsGregorianLeapYear( TclDateFields *fields) /* Date to test */ { - int year = fields->year; + Tcl_WideInt year = fields->year; if (fields->isBce) { year = 1 - year; @@ -1593,10 +1604,10 @@ IsGregorianLeapYear( *---------------------------------------------------------------------- */ -static int +static Tcl_WideInt WeekdayOnOrBefore( int dayOfWeek, /* Day of week; Sunday == 0 or 7 */ - int julianDay) /* Reference date */ + Tcl_WideInt julianDay) /* Reference date */ { int k = (dayOfWeek + 6) % 7; if (k < 0) { @@ -1763,13 +1774,13 @@ ClockClicksObjCmd( switch (index) { case CLICKS_MILLIS: Tcl_GetTime(&now); - clicks = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000; + clicks = (Tcl_WideInt)now.sec * 1000 + now.usec / 1000; break; case CLICKS_NATIVE: #ifdef TCL_WIDE_CLICKS clicks = TclpGetWideClicks(); #else - clicks = (Tcl_WideInt) TclpGetClicks(); + clicks = (Tcl_WideInt)TclpGetClicks(); #endif break; case CLICKS_MICROS: @@ -1905,7 +1916,7 @@ ClockParseformatargsObjCmd( Tcl_WrongNumArgs(interp, 0, objv, "clock format clockval ?-format string? " "?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"); - Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", (void *)NULL); + Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", (char *)NULL); return TCL_ERROR; } @@ -1920,7 +1931,7 @@ ClockParseformatargsObjCmd( if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &optionIndex) != TCL_OK) { Tcl_SetErrorCode(interp, "CLOCK", "badOption", - TclGetString(objv[i]), (void *)NULL); + TclGetString(objv[i]), (char *)NULL); return TCL_ERROR; } switch (optionIndex) { @@ -1952,7 +1963,7 @@ ClockParseformatargsObjCmd( if ((saw & (1 << CLOCK_FORMAT_GMT)) && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) { Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]); - Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", (void *)NULL); + Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", (char *)NULL); return TCL_ERROR; } if (gmtFlag) { @@ -2041,7 +2052,7 @@ TzsetIfNecessary(void) { static WCHAR* tzWas = (WCHAR *)INT2PTR(-1); /* Previous value of TZ, protected by * clockMutex. */ - static long tzLastRefresh = 0; /* Used for latency before next refresh */ + static long tzLastRefresh = 0; /* Used for latency before next refresh */ static size_t tzEnvEpoch = 0; /* Last env epoch, for faster signaling, that TZ changed via TCL */ const WCHAR *tzIsNow; /* Current value of TZ */ -- cgit v0.12 From 5cd2c38d5a77262f720db03d5b2cb139eab0c447 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 11 Mar 2024 11:02:19 +0000 Subject: Fix [1acd172c424b57c9] (by just reverting the change causing this). Not crucial for TIP #688. Also, make it compile/run using -DTCL_NO_DEPRECATED=1 --- generic/tcl.h | 2 +- generic/tclClock.c | 2 +- generic/tclClockFmt.c | 21 ++++++++++----------- generic/tclDate.h | 6 +++--- generic/tclEnsemble.c | 8 -------- generic/tclStrIdxTree.c | 9 +++++---- generic/tclStrIdxTree.h | 7 +++---- tests/clock.test | 2 +- tests/http.test | 4 ++-- 9 files changed, 26 insertions(+), 35 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index a4480a7..0d3da74 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -230,7 +230,7 @@ extern "C" { * Miscellaneous declarations. */ -typedef void *ClientData; +// typedef void *ClientData; /* * Darwin specific configure overrides (to support fat compiles, where diff --git a/generic/tclClock.c b/generic/tclClock.c index c0be910..cf5b7d5 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -2164,7 +2164,7 @@ ConvertUTCToLocal( if (dataPtr->gmtTZName == NULL) { Tcl_Obj *tzName; tzdata = ClockGetTZData(clientData, interp, timezoneObj); - if ( TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK + if ( TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK || Tcl_ListObjIndex(interp, rowv[0], 3, &tzName) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index bf566ff..9bf10ed 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -32,7 +32,7 @@ TCL_DECLARE_MUTEX(ClockFmtMutex); /* Serializes access to common format list. */ static void ClockFmtScnStorageDelete(ClockFmtScnStorage *fss); -static void ClockFrmScnFinalize(ClientData clientData); +static void ClockFrmScnFinalize(void *clientData); /* * Clock scan and format facilities. @@ -1103,7 +1103,7 @@ LocaleListSearch(ClockFmtScnCmdArgs *opts, int minLen, int maxLen) { Tcl_Obj **lstv; - int lstc; + Tcl_Size lstc; Tcl_Obj *valObj; /* get msgcat value */ @@ -1113,7 +1113,7 @@ LocaleListSearch(ClockFmtScnCmdArgs *opts, } /* is a list */ - if (TclListObjGetElements(opts->interp, valObj, &lstc, &lstv) != TCL_OK) { + if (TclListObjGetElementsM(opts->interp, valObj, &lstc, &lstv) != TCL_OK) { return TCL_ERROR; } @@ -1159,7 +1159,7 @@ ClockMCGetListIdxTree( /* build new index */ Tcl_Obj **lstv; - int lstc; + Tcl_Size lstc; Tcl_Obj *valObj; objPtr = TclStrIdxTreeNewObj(); @@ -1172,7 +1172,7 @@ ClockMCGetListIdxTree( goto done; } - if (TclListObjGetElements(opts->interp, valObj, + if (TclListObjGetElementsM(opts->interp, valObj, &lstc, &lstv) != TCL_OK) { goto done; }; @@ -1232,7 +1232,7 @@ ClockMCGetMultiListIdxTree( /* build new index */ Tcl_Obj **lstv; - int lstc; + Tcl_Size lstc; Tcl_Obj *valObj; objPtr = TclStrIdxTreeNewObj(); @@ -1247,7 +1247,7 @@ ClockMCGetMultiListIdxTree( goto done; } - if (TclListObjGetElements(opts->interp, valObj, + if (TclListObjGetElementsM(opts->interp, valObj, &lstc, &lstv) != TCL_OK) { goto done; }; @@ -2809,7 +2809,7 @@ ClockFmtToken_LocaleERAYear_Proc( ClockFormatToken *tok, int *val) { - int rowc; + Tcl_Size rowc; Tcl_Obj **rowv; if (dateFmt->localeEra == NULL) { @@ -2817,7 +2817,7 @@ ClockFmtToken_LocaleERAYear_Proc( if (mcObj == NULL) { return TCL_ERROR; } - if (TclListObjGetElements(opts->interp, mcObj, &rowc, &rowv) != TCL_OK) { + if (TclListObjGetElementsM(opts->interp, mcObj, &rowc, &rowv) != TCL_OK) { return TCL_ERROR; } if (rowc != 0) { @@ -3349,9 +3349,8 @@ ClockFrmScnClearCaches(void) static void ClockFrmScnFinalize( - ClientData clientData) /* Not used. */ + TCL_UNUSED(void *)) { - (void)clientData; Tcl_MutexLock(&ClockFmtMutex); #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 /* clear GC */ diff --git a/generic/tclDate.h b/generic/tclDate.h index 6369e14..911e285 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -270,7 +270,7 @@ ClockInitDateInfo(DateInfo *info) { #define CLF_LOCALE_USED (1 << 15) typedef struct ClockFmtScnCmdArgs { - ClientData clientData; /* Opaque pointer to literal pool, etc. */ + void *clientData; /* Opaque pointer to literal pool, etc. */ Tcl_Interp *interp; /* Tcl interpreter */ Tcl_Obj *formatObj; /* Format */ @@ -513,7 +513,7 @@ MODULE_SCOPE void MODULE_SCOPE void GetJulianDayFromEraYearDay( TclDateFields *fields, int changeover); -MODULE_SCOPE int ConvertUTCToLocal(ClientData clientData, Tcl_Interp *, +MODULE_SCOPE int ConvertUTCToLocal(void *clientData, Tcl_Interp *, TclDateFields *, Tcl_Obj *timezoneObj, int); MODULE_SCOPE Tcl_Obj * LookupLastTransition(Tcl_Interp *, Tcl_WideInt, @@ -524,7 +524,7 @@ MODULE_SCOPE int TclClockFreeScan(Tcl_Interp *interp, DateInfo *info); /* tclClock.c module declarations */ MODULE_SCOPE Tcl_Obj * - ClockSetupTimeZone(ClientData clientData, + ClockSetupTimeZone(void *clientData, Tcl_Interp *interp, Tcl_Obj *timezoneObj); MODULE_SCOPE Tcl_Obj * diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 1bab757..8614171 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -369,14 +369,6 @@ TclNamespaceEnsembleCmd( Tcl_SetEnsembleMappingDict(interp, token, mapObj); Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj); Tcl_SetEnsembleParameterList(interp, token, paramObj); - /* - * Ensemble should be compiled if it has map (performance purposes) - * Currently only for internal using namespace (like ::tcl::clock). - * (An enhancement for completelly compile-feature is in work.) - */ - if (mapObj != NULL && strncmp("::tcl::", nsPtr->fullName, 7) == 0) { - Tcl_SetEnsembleFlags(interp, token, ENSEMBLE_COMPILE); - } /* * Tricky! Must ensure that the result is not shared (command delete diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c index d52f0ff..bdb16f2 100644 --- a/generic/tclStrIdxTree.c +++ b/generic/tclStrIdxTree.c @@ -226,13 +226,14 @@ TclStrIdxTreeAppend( int TclStrIdxTreeBuildFromList( TclStrIdxTree *idxTree, - int lstc, + Tcl_Size lstc, Tcl_Obj **lstv, - ClientData *values) + void **values) { Tcl_Obj **lwrv; - int i, ret = TCL_ERROR; - ClientData val; + Tcl_Size i; + int ret = TCL_ERROR; + void *val; const char *s, *e, *f; TclStrIdx *item; diff --git a/generic/tclStrIdxTree.h b/generic/tclStrIdxTree.h index 37931ed..19e7624 100644 --- a/generic/tclStrIdxTree.h +++ b/generic/tclStrIdxTree.h @@ -29,7 +29,7 @@ typedef struct TclStrIdx { struct TclStrIdx *prevPtr; Tcl_Obj *key; int length; - ClientData value; + void *value; } TclStrIdx; @@ -139,7 +139,7 @@ MODULE_SCOPE const char* const char *start, const char *end); MODULE_SCOPE int TclStrIdxTreeBuildFromList(TclStrIdxTree *idxTree, - int lstc, Tcl_Obj **lstv, ClientData *values); + Tcl_Size lstc, Tcl_Obj **lstv, void **values); MODULE_SCOPE Tcl_Obj* TclStrIdxTreeNewObj(); @@ -149,8 +149,7 @@ MODULE_SCOPE TclStrIdxTree* #if 1 -MODULE_SCOPE int TclStrIdxTreeTestObjCmd(ClientData, Tcl_Interp *, - int, Tcl_Obj *const objv[]); +MODULE_SCOPE Tcl_ObjCmdProc TclStrIdxTreeTestObjCmd; #endif #endif /* _TCLSTRIDXTREE_H */ diff --git a/tests/clock.test b/tests/clock.test index 8a2218c..8f82b00 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -315,7 +315,7 @@ test clock-1.0 "clock format - wrong # args" { test clock-1.0.1 "clock format - wrong # args (compiled ensemble with invalid syntax)" { list [catch {clock format 0 -too-few-options-4-test} msg] $msg $::errorCode -} [subst {1 {wrong # args: should be "::tcl::clock::format $syntax"} {CLOCK wrongNumArgs}}] +} [subst {1 {wrong # args: should be "clock format $syntax"} {CLOCK wrongNumArgs}}] test clock-1.1 "clock format - bad time" { list [catch {clock format foo} msg] $msg diff --git a/tests/http.test b/tests/http.test index cd61b7b..f7bb723 100644 --- a/tests/http.test +++ b/tests/http.test @@ -759,7 +759,7 @@ test http-idna-1.1.$ThreadLevel {IDNA package: basics} -returnCodes error -body } -result {wrong # args: should be "::tcl::idna subcommand ?arg ...?"} test http-idna-1.2.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna ? -} -result {unknown subcommand "?": must be decode, encode, puny, or version} +} -result {unknown or ambiguous subcommand "?": must be decode, encode, puny, or version} test http-idna-1.3.$ThreadLevel {IDNA package: basics} -body { ::tcl::idna version } -result 1.0.1 @@ -771,7 +771,7 @@ test http-idna-1.5.$ThreadLevel {IDNA package: basics} -returnCodes error -body } -result {wrong # args: should be "::tcl::idna puny subcommand ?arg ...?"} test http-idna-1.6.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny ? -} -result {unknown subcommand "?": must be decode, or encode} +} -result {unknown or ambiguous subcommand "?": must be decode, or encode} test http-idna-1.7.$ThreadLevel {IDNA package: basics} -returnCodes error -body { ::tcl::idna puny encode } -result {wrong # args: should be "::tcl::idna puny encode string ?case?"} -- cgit v0.12 From 5422e87e6dbc6b15d1a1517289763e1ecd1393b1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 11 Mar 2024 11:55:58 +0000 Subject: Use {} in expr. Enable no_tclclockmod testcase --- tests/clock.test | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index 8f82b00..f74b58b 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -31,8 +31,6 @@ testConstraint detroit \ [expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}] testConstraint y2038 \ [expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}] -testConstraint no_tclclockmod \ - [expr {[namespace which -command ::tcl::clock::configure] eq {}}] # Test with both validity modes - validate on / off: @@ -276,7 +274,7 @@ proc ::testClock::registry { cmd path key } { # Base test cases: -test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" no_tclclockmod { +test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" { set i [interp create]; # because clock can be used somewhere, test it in new interp: set ret [$i eval { @@ -15396,7 +15394,7 @@ test clock-4.97.8 { format JDN/JD (calendar and astronomical) } { -1 0 1 21600 43199 43200 86399 86400 86401 108000 129600 172800 } { - lappend res $i [clock format [expr -210866803200 - $i] \ + lappend res $i [clock format [expr {-210866803200 - $i}] \ -format {%EE %Y-%m-%d %T -- %J %EJ %Ej} -gmt true] } set res @@ -15425,7 +15423,7 @@ test clock-4.97.9 { format JDN/JD (calendar and astronomical) } { -1 0 1 43199 43200 43201 86400 } { - lappend res $i [clock format [expr 653133196800 + $i] \ + lappend res $i [clock format [expr {653133196800 + $i}] \ -format {%Y-%m-%d %T -- %J %EJ %Ej} -gmt true] } set res @@ -36013,7 +36011,7 @@ test clock-33.5 {clock clicks tests, millisecond timing test} { expr { ($end > $start) && (($end - $start) <= 60) ? "ok" : - "test should have taken 0-60 ms, actually took [expr $end - $start]"} + "test should have taken 0-60 ms, actually took [expr {$end - $start}]"} } {ok} test clock-33.5a {clock tests, millisecond timing test} { # This test can fail on a system that is so heavily loaded that @@ -36029,7 +36027,7 @@ test clock-33.5a {clock tests, millisecond timing test} { expr { ($end > $start) && (($end - $start) <= 60) ? "ok" : - "test should have taken 0-60 ms, actually took [expr $end - $start]"} + "test should have taken 0-60 ms, actually took [expr {$end - $start}]"} } {ok} test clock-33.6 {clock clicks, milli with too much abbreviation} { list [catch { clock clicks ? } msg] $msg -- cgit v0.12 From 3759ee87e2c5f578c394d7bb730c83f210c640b6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 11 Mar 2024 13:31:46 +0000 Subject: more int -> Tcl_Size --- generic/tclClock.c | 15 ++++++++------- generic/tclClockFmt.c | 43 +++++++++++++++++++++---------------------- generic/tclDate.h | 2 +- 3 files changed, 30 insertions(+), 30 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index cf5b7d5..1c91578 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -2412,12 +2412,11 @@ Tcl_Obj * LookupLastTransition( Tcl_Interp *interp, /* Interpreter for error messages */ Tcl_WideInt tick, /* Time from the epoch */ - int rowc, /* Number of rows of tzdata */ + Tcl_Size rowc, /* Number of rows of tzdata */ Tcl_Obj *const *rowv, /* Rows in tzdata */ Tcl_WideInt *rangesVal) /* Return bounds for time period */ { - int l = 0; - int u; + Tcl_Size l, u; Tcl_Obj *compObj; Tcl_WideInt compVal, fromVal = LLONG_MIN, toVal = LLONG_MAX; @@ -2447,9 +2446,10 @@ LookupLastTransition( * Binary-search to find the transition. */ + l = 0; u = rowc-1; while (l < u) { - int m = (l + u + 1) / 2; + Tcl_Size m = (l + u + 1) / 2; if (Tcl_ListObjIndex(interp, rowv[m], 0, &compObj) != TCL_OK || TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) { @@ -3955,7 +3955,8 @@ ClockFreeScan( yyInput = Tcl_GetString(strObj); if (TclClockFreeScan(interp, info) != TCL_OK) { - Tcl_Obj *msg = Tcl_NewObj(); + Tcl_Obj *msg; + TclNewObj(msg); Tcl_AppendPrintfToObj(msg, "unable to convert date-time string \"%s\": %s", Tcl_GetString(strObj), TclGetString(Tcl_GetObjResult(interp))); Tcl_SetObjResult(interp, msg); @@ -4628,7 +4629,7 @@ TzsetIfNecessary(void) { static WCHAR* tzWas = (WCHAR *)INT2PTR(-1); /* Previous value of TZ, protected by * clockMutex. */ - static long tzLastRefresh = 0; /* Used for latency before next refresh */ + static long long tzLastRefresh = 0; /* Used for latency before next refresh */ static size_t tzWasEpoch = 0; /* Epoch, signals that TZ changed */ static size_t tzEnvEpoch = 0; /* Last env epoch, for faster signaling, that TZ changed via TCL */ @@ -4637,7 +4638,7 @@ TzsetIfNecessary(void) /* * Prevent performance regression on some platforms by resolving of system time zone: * small latency for check whether environment was changed (once per second) - * no latency if environment was chaned with tcl-env (compare both epoch values) + * no latency if environment was changed with tcl-env (compare both epoch values) */ Tcl_Time now; Tcl_GetTime(&now); diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 9bf10ed..f79a863 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -606,7 +606,7 @@ ClockFmtObj_UpdateString( Tcl_Obj *objPtr) { const char *name = "UNKNOWN"; - int len; + size_t len; ClockFmtScnStorage *fss = ObjClockFmtScn(objPtr); if (fss != NULL) { @@ -614,10 +614,11 @@ ClockFmtObj_UpdateString( name = hPtr->key.string; } len = strlen(name); - objPtr->length = len, - objPtr->bytes = (char *)Tcl_Alloc((size_t)++len); - if (objPtr->bytes) + objPtr->length = len++, + objPtr->bytes = (char *)Tcl_Alloc(len); + if (objPtr->bytes) { memcpy(objPtr->bytes, name, len); + } } /* @@ -1053,15 +1054,14 @@ DetermineGreedySearchLen( static inline int ObjListSearch( DateInfo *info, int *val, - Tcl_Obj **lstv, int lstc, + Tcl_Obj **lstv, Tcl_Size lstc, int minLen, int maxLen) { - int i, l, lf = -1; + Tcl_Size i, l, lf = -1; const char *s, *f, *sf; /* search in list */ for (i = 0; i < lstc; i++) { - s = TclGetString(lstv[i]); - l = lstv[i]->length; + s = Tcl_GetStringFromObj(lstv[i], &l); if ( l >= minLen && (f = TclUtfFindEqualNC(yyInput, yyInput + maxLen, s, s + l, &sf)) > yyInput @@ -1323,7 +1323,7 @@ static int StaticListSearch(ClockFmtScnCmdArgs *opts, DateInfo *info, const char **lst, int *val) { - int len; + size_t len; const char **s = lst; while (*s != NULL) { len = strlen(*s); @@ -2598,7 +2598,7 @@ ClockFmtToken_AMPM_Proc( { Tcl_Obj *mcObj; const char *s; - int len; + Tcl_Size len; if (*val < (SECONDS_PER_DAY / 2)) { mcObj = ClockMCGet(opts, MCLIT_AM); @@ -2608,7 +2608,7 @@ ClockFmtToken_AMPM_Proc( if (mcObj == NULL) { return TCL_ERROR; } - s = TclGetString(mcObj); len = mcObj->length; + s = Tcl_GetStringFromObj(mcObj, &len); if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; memcpy(dateFmt->output, s, len + 1); if (*tok->tokWord.start == 'p') { @@ -2758,7 +2758,7 @@ ClockFmtToken_TimeZone_Proc( } } else { Tcl_Obj * objPtr; - const char *s; int len; + const char *s; Tcl_Size len; /* convert seconds to local seconds to obtain tzName object */ if (ConvertUTCToLocal(opts->clientData, opts->interp, &dateFmt->date, opts->timezoneObj, @@ -2766,8 +2766,7 @@ ClockFmtToken_TimeZone_Proc( return TCL_ERROR; }; objPtr = dateFmt->date.tzName; - s = TclGetString(objPtr); - len = objPtr->length; + s = Tcl_GetStringFromObj(objPtr, &len); if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; memcpy(dateFmt->output, s, len + 1); dateFmt->output += len; @@ -2784,7 +2783,7 @@ ClockFmtToken_LocaleERA_Proc( { Tcl_Obj *mcObj; const char *s; - int len; + Tcl_Size len; if (dateFmt->date.isBce) { mcObj = ClockMCGet(opts, MCLIT_BCE); @@ -2794,7 +2793,7 @@ ClockFmtToken_LocaleERA_Proc( if (mcObj == NULL) { return TCL_ERROR; } - s = TclGetString(mcObj); len = mcObj->length; + s = Tcl_GetStringFromObj(mcObj, &len); if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; memcpy(dateFmt->output, s, len + 1); dateFmt->output += len; @@ -2844,7 +2843,7 @@ ClockFmtToken_LocaleERAYear_Proc( } else { Tcl_Obj *objPtr; const char *s; - int len; + Tcl_Size len; if (*tok->tokWord.start == 'C') { /* %EC */ if (Tcl_ListObjIndex(opts->interp, dateFmt->localeEra, 1, &objPtr) != TCL_OK ) { @@ -2877,8 +2876,7 @@ ClockFmtToken_LocaleERAYear_Proc( return TCL_OK; } } - s = TclGetString(objPtr); - len = objPtr->length; + s = Tcl_GetStringFromObj(objPtr, &len); if (FrmResultAllocate(dateFmt, len) != TCL_OK) { return TCL_ERROR; }; memcpy(dateFmt->output, s, len + 1); dateFmt->output += len; @@ -3281,7 +3279,7 @@ ClockFormat( break; case CTOKT_WORD: if (1) { - int len = tok->tokWord.end - tok->tokWord.start; + Tcl_Size len = tok->tokWord.end - tok->tokWord.start; if (FrmResultAllocate(dateFmt, len) != TCL_OK) { goto error; }; if (len == 1) { *dateFmt->output++ = *tok->tokWord.start; @@ -3306,8 +3304,9 @@ error: done: if (dateFmt->resMem) { - size_t size; - Tcl_Obj * result = Tcl_NewObj(); + size_t size; + Tcl_Obj *result; + TclNewObj(result); result->length = dateFmt->output - dateFmt->resMem; size = result->length+1; if (dateFmt->resMem == resMem) { diff --git a/generic/tclDate.h b/generic/tclDate.h index 911e285..5033018 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -517,7 +517,7 @@ MODULE_SCOPE int ConvertUTCToLocal(void *clientData, Tcl_Interp *, TclDateFields *, Tcl_Obj *timezoneObj, int); MODULE_SCOPE Tcl_Obj * LookupLastTransition(Tcl_Interp *, Tcl_WideInt, - int, Tcl_Obj *const *, Tcl_WideInt *rangesVal); + Tcl_Size, Tcl_Obj *const *, Tcl_WideInt *rangesVal); MODULE_SCOPE int TclClockFreeScan(Tcl_Interp *interp, DateInfo *info); -- cgit v0.12 From a5ad5a6b6721b7b97684841920a08a345faa346e Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 11 Mar 2024 15:14:51 +0000 Subject: load clock-stubs dynamically with namespace unknown (no auto-index needed) --- library/init.tcl | 11 +++++++++++ library/tclIndex | 24 ------------------------ win/Makefile.in | 6 +++--- 3 files changed, 14 insertions(+), 27 deletions(-) diff --git a/library/init.tcl b/library/init.tcl index 2a2391d..5eb5dfc 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -120,6 +120,17 @@ if {[interp issafe]} { uplevel 1 [info level 0] } + + # Auto-loading stubs for 'clock.tcl' + + namespace eval ::tcl::clock { + proc _load_stubs args { + namespace unknown {} + ::source -encoding utf-8 [::file join [info library] clock.tcl] + tailcall {*}$args + } + namespace unknown ::tcl::clock::_load_stubs + } } # Conditionalize for presence of exec. diff --git a/library/tclIndex b/library/tclIndex index 438aaa7..04f6d41 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -19,30 +19,6 @@ set auto_index(::auto_mkindex_parser::command) [list ::tcl::Pkg::source [file jo set auto_index(::auto_mkindex_parser::commandInit) [list ::tcl::Pkg::source [file join $dir auto.tcl]] set auto_index(::auto_mkindex_parser::fullname) [list ::tcl::Pkg::source [file join $dir auto.tcl]] set auto_index(::auto_mkindex_parser::indexEntry) [list ::tcl::Pkg::source [file join $dir auto.tcl]] -set auto_index(::tcl::clock::mc) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::Initialize) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::mcget) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::mcMerge) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::GetSystemLocale) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::EnterLocale) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::_hasRegistry) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::LoadWindowsDateTimeFormats) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::LocalizeFormat) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::GetSystemTimeZone) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::SetupTimeZone) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::GuessWindowsTimeZone) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::LoadTimeZoneFile) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::LoadZoneinfoFile) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::ReadZoneinfoFile) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::ParsePosixTimeZone) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::ProcessPosixTimeZone) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::DeterminePosixDSTTime) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::GetJulianDayFromEraYearDay) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::GetJulianDayFromEraYearMonthWeekDay) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::IsGregorianLeapYear) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::WeekdayOnOrBefore) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::ChangeCurrentLocale) [list ::tcl::Pkg::source [file join $dir clock.tcl]] -set auto_index(::tcl::clock::ClearCaches) [list ::tcl::Pkg::source [file join $dir clock.tcl]] set auto_index(foreachLine) [list ::tcl::Pkg::source [file join $dir foreachline.tcl]] set auto_index(::tcl::history) [list ::tcl::Pkg::source [file join $dir history.tcl]] set auto_index(history) [list ::tcl::Pkg::source [file join $dir history.tcl]] diff --git a/win/Makefile.in b/win/Makefile.in index e4f6b8b..960f02f 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -155,9 +155,9 @@ TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX} TEST_EXE_FILE = tcltest${EXESUFFIX} TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX} TEST_LOAD_PRMS = lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\ - package ifneeded dde 1.4.5 [list load [file normalize ${DDE_DLL_FILE}]];\ - package ifneeded registry 1.3.7 [list load [file normalize ${REG_DLL_FILE}]] -TEST_LOAD_FACILITIES = package ifneeded tcl::test ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest];\ + package ifneeded dde 1.4.5 [list load ${DDE_DLL_FILE}];\ + package ifneeded registry 1.3.7 [list load ${REG_DLL_FILE}] +TEST_LOAD_FACILITIES = package ifneeded tcl::test ${VERSION}@TCL_PATCH_LEVEL@ [list load ${TEST_DLL_FILE} Tcltest];\ $(TEST_LOAD_PRMS) ZLIB_DLL_FILE = zlib1.dll TOMMATH_DLL_FILE = libtommath.dll -- cgit v0.12 From 153aa0f93e5ce4107422a86fa1b3bd41bfe43c6b Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 12 Mar 2024 01:21:47 +0000 Subject: tests to ensure cache of base is correct for :localtime if TZ-env changing --- tests/clock.test | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/tests/clock.test b/tests/clock.test index 9b9bc52..f4492b6 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -36828,6 +36828,52 @@ test clock-38.2 {make sure TZ is not cached after unset} \ } \ -result 1 +test clock-38.3sc {ensure cache of base is correct for :localtime if TZ-env changing / scan} \ + -setup { + if { [info exists env(TZ)] } { + set oldTZ $env(TZ) + } + } \ + -body { + set res {} + foreach env(TZ) {GMT-11:30 GMT-07:30 GMT-03:30 GMT} \ + i {{07:30:00} {03:30:00} {23:30:00} {20:00:00}} \ + { + lappend res [clock scan $i -format "%H:%M:%S" -base [expr {20*60*60}] -timezone :localtime] + } + set res + } \ + -cleanup { + if { [info exists oldTZ] } { + set env(TZ) $oldTZ + unset oldTZ + } else { + unset env(TZ) + } + } \ + -result [lrepeat 4 [expr {20*60*60}]] +test clock-38.3fm {ensure cache of base is correct for :localtime if TZ-env changing / format} \ + -setup { + if { [info exists env(TZ)] } { + set oldTZ $env(TZ) + } + } \ + -body { + set res {} + foreach env(TZ) {GMT-11:30 GMT-07:30 GMT-03:30 GMT} { + lappend res [clock format [expr {20*60*60}] -format "%Y-%m-%dT%H:%M:%S %Z" -timezone :localtime] + } + set res + } \ + -cleanup { + if { [info exists oldTZ] } { + set env(TZ) $oldTZ + unset oldTZ + } else { + unset env(TZ) + } + } \ + -result {{1970-01-02T07:30:00 +1130} {1970-01-02T03:30:00 +0730} {1970-01-01T23:30:00 +0330} {1970-01-01T20:00:00 +0000}} test clock-39.1 {regression - synonym timezones} { clock format 0 -format {%H:%M:%S} -timezone :US/Eastern -- cgit v0.12 From 808b40df5983aaa85d4ff48af940b7e310e08060 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 12 Mar 2024 01:33:38 +0000 Subject: consider TZ-epoch in base-cache (ensure cache of base is correct for :localtime if TZ changing) --- generic/tclClock.c | 11 ++++++++++- generic/tclDate.h | 4 ++++ library/clock.tcl | 5 +---- 3 files changed, 15 insertions(+), 5 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index e156cf3..1c9f77e 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -2249,6 +2249,9 @@ ConvertUTCToLocal( return TCL_ERROR; } + /* signal we need to revalidate TZ epoch next time fields gets used. */ + fields->flags |= CLF_CTZ; + /* we cannot cache (ranges unknown yet) */ } else { Tcl_WideInt rangesVal[2]; @@ -2258,6 +2261,9 @@ ConvertUTCToLocal( return TCL_ERROR; } + /* converted using table (TZ isn't :localtime) */ + fields->flags &= ~CLF_CTZ; + /* Cache the last conversion */ if (ltzoc != NULL) { /* slot was found above */ /* timezoneObj and changeover are the same */ @@ -3491,7 +3497,10 @@ baseNow: /* check base fields already cached (by TZ, last-second cache) */ if ( dataPtr->lastBase.timezoneObj == opts->timezoneObj - && dataPtr->lastBase.date.seconds == baseVal) { + && dataPtr->lastBase.date.seconds == baseVal + && (!(dataPtr->lastBase.date.flags & CLF_CTZ) + || dataPtr->lastTZEpoch == TzsetIfNecessary()) + ) { memcpy(date, &dataPtr->lastBase.date, ClockCacheableDateFieldsSize); } else { /* extact fields from base */ diff --git a/generic/tclDate.h b/generic/tclDate.h index 6e82a3f..0fd0fef 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -150,6 +150,8 @@ typedef enum ClockMsgCtLiteral { typedef enum {BCE=1, CE=0} ERA_ENUM; +#define CLF_CTZ (1 << 4) + typedef struct TclDateFields { /* Cacheable fields: */ @@ -175,6 +177,8 @@ typedef struct TclDateFields { int secondOfMin; /* Seconds of minute (in-between time only calculation) */ int secondOfDay; /* Seconds of day (in-between time only calculation) */ + int flags; /* 0 or CLF_CTZ */ + /* Non cacheable fields: */ Tcl_Obj *tzName; /* Name (or corresponding DST-abbreviation) of the diff --git a/library/clock.tcl b/library/clock.tcl index 529a4f9..504ba0b 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -968,10 +968,7 @@ proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } { "time zone \"$timezone\" not found" } variable MINWIDE - if { $timezone eq {:localtime} } { - # Nothing to do, we'll convert using the localtime function - - } elseif { + if { [regexp {^([-+])(\d\d)(?::?(\d\d)(?::?(\d\d))?)?} $timezone \ -> s hh mm ss] } then { -- cgit v0.12 From 8ddac401cc0f338f29c785a18222fa49a9b03b8e Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 12 Mar 2024 01:36:28 +0000 Subject: optimize simplest case if numeric timezone is 0000 (so GMT/UTC) --- generic/tclClock.c | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 1c9f77e..5872ad1 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -4023,16 +4023,23 @@ ClockFreeScan( */ if (info->flags & CLF_ZONE) { - Tcl_Obj *tzObjStor = NULL; - int minEast = -yyTimezone; - int dstFlag = 1 - yyDSTmode; - tzObjStor = ClockFormatNumericTimeZone( - 60 * minEast + 3600 * dstFlag); - Tcl_IncrRefCount(tzObjStor); - - opts->timezoneObj = ClockSetupTimeZone(dataPtr, interp, tzObjStor); - - Tcl_DecrRefCount(tzObjStor); + if (yyTimezone || !yyDSTmode) { + /* Real time zone from numeric zone */ + Tcl_Obj *tzObjStor = NULL; + int minEast = -yyTimezone; + int dstFlag = 1 - yyDSTmode; + tzObjStor = ClockFormatNumericTimeZone( + 60 * minEast + 3600 * dstFlag); + Tcl_IncrRefCount(tzObjStor); + + opts->timezoneObj = ClockSetupTimeZone(dataPtr, interp, tzObjStor); + + Tcl_DecrRefCount(tzObjStor); + } else { + /* simplest case - GMT / UTC */ + opts->timezoneObj = ClockSetupTimeZone(dataPtr, interp, + dataPtr->literals[LIT_GMT]); + } if (opts->timezoneObj == NULL) { goto done; } -- cgit v0.12 From 47d0b856a69fd22ba49aac4c422e512d167eedb5 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 12 Mar 2024 01:37:39 +0000 Subject: more optimizations of numeric to regular TZ conversion (for non GMT offsets) --- generic/tclClock.c | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 5872ad1..052184c 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -1375,20 +1375,24 @@ ClockSetupTimeZone( Tcl_Obj * ClockFormatNumericTimeZone(int z) { - char sign = '+'; + char buf[12+1]; int h, m; + + *buf = '+'; if ( z < 0 ) { z = -z; - sign = '-'; + *buf = '-'; } h = z / 3600; z %= 3600; m = z / 60; z %= 60; if (z != 0) { - return Tcl_ObjPrintf("%c%02d%02d%02d", sign, h, m, z); + sprintf(&buf[1], "%02d%02d%02d", h, m, z); + } else { + sprintf(&buf[1], "%02d%02d", h, m); } - return Tcl_ObjPrintf("%c%02d%02d", sign, h, m); + return Tcl_NewStringObj(buf, -1); } /* -- cgit v0.12 From c79fd28a6e6d708fa152d99c83892441d2fd8303 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 12 Mar 2024 01:43:03 +0000 Subject: replace sprintf with itoaw --- generic/tclClock.c | 32 +++++++++++++------------------- generic/tclClockFmt.c | 9 +++++++++ generic/tclDate.h | 4 ++++ 3 files changed, 26 insertions(+), 19 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 052184c..571052f 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -1375,24 +1375,20 @@ ClockSetupTimeZone( Tcl_Obj * ClockFormatNumericTimeZone(int z) { - char buf[12+1]; - int h, m; + char buf[12+1], *p; - *buf = '+'; if ( z < 0 ) { z = -z; *buf = '-'; + } else { + *buf = '+'; } - h = z / 3600; - z %= 3600; - m = z / 60; - z %= 60; + TclItoAw(buf+1, z / 3600, '0', 2); z %= 3600; + p = TclItoAw(buf+3, z / 60, '0', 2); z %= 60; if (z != 0) { - sprintf(&buf[1], "%02d%02d%02d", h, m, z); - } else { - sprintf(&buf[1], "%02d%02d", h, m); + p = TclItoAw(buf+5, z, '0', 2); } - return Tcl_NewStringObj(buf, -1); + return Tcl_NewStringObj(buf, p - buf); } /* @@ -2370,7 +2366,7 @@ ConvertUTCToLocalUsingC( time_t tock; struct tm *timeVal; /* Time after conversion */ int diff; /* Time zone diff local-Greenwich */ - char buffer[16]; /* Buffer for time zone name */ + char buffer[16], *p; /* Buffer for time zone name */ /* * Use 'localtime' to determine local year, month, day, time of day. @@ -2423,14 +2419,12 @@ ConvertUTCToLocalUsingC( } else { *buffer = '+'; } - snprintf(buffer+1, sizeof(buffer) - 1, "%02d", diff / 3600); - diff %= 3600; - snprintf(buffer+3, sizeof(buffer) - 3, "%02d", diff / 60); - diff %= 60; - if (diff > 0) { - snprintf(buffer+5, sizeof(buffer) - 5, "%02d", diff); + TclItoAw(buffer+1, diff / 3600, '0', 2); diff %= 3600; + p = TclItoAw(buffer+3, diff / 60, '0', 2); diff %= 60; + if (diff != 0) { + p = TclItoAw(buffer+5, diff, '0', 2); } - Tcl_SetObjRef(fields->tzName, Tcl_NewStringObj(buffer, -1)); + Tcl_SetObjRef(fields->tzName, Tcl_NewStringObj(buffer, p - buffer)); return TCL_OK; } diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index a25be83..811996f 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -197,6 +197,15 @@ _itoaw( return buf + width; } +char * +TclItoAw( + char *buf, + int val, + char padchar, + unsigned short int width) +{ + return _itoaw(buf, val, padchar, width); +} static inline char * _witoaw( diff --git a/generic/tclDate.h b/generic/tclDate.h index 0fd0fef..465473f 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -544,6 +544,10 @@ MODULE_SCOPE int ClockMCSetIdx(ClockFmtScnCmdArgs *opts, int mcKey, /* tclClockFmt.c module declarations */ + +MODULE_SCOPE char * + TclItoAw(char *buf, int val, char padchar, unsigned short int width); + MODULE_SCOPE Tcl_Obj* ClockFrmObjGetLocFmtKey(Tcl_Interp *interp, Tcl_Obj *objPtr); -- cgit v0.12 From 0bb3d0da5049d35032862204529cc888aadae670 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 12 Mar 2024 01:43:30 +0000 Subject: test cases covering #23: `clock add` regression (due to integer overflow) --- tests/clock.test | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/tests/clock.test b/tests/clock.test index f4492b6..7c1f756 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -35753,6 +35753,26 @@ test clock-30.30 {clock add weekdays and back} -body { } return "OK" } -result {OK} +test clock-30.31 {regression test - add with int overflow} { + list \ + [list \ + [clock add 0 1600000000 seconds 24856 days -gmt 1] \ + [clock add 0 1600000000 seconds 815 months -gmt 1] \ + [clock add 0 1600000000 seconds 69 years -gmt 1] \ + [clock add 0 1600000000 seconds 596524 hours -gmt 1] \ + [clock add 0 1600000000 seconds 35791395 minutes -gmt 1] \ + [clock add 0 1600000000 seconds 0x7fffffff seconds -gmt 1] + ] \ + [list \ + [clock add 1600000000 24856 days -gmt 1] \ + [clock add 1600000000 815 months -gmt 1] \ + [clock add 1600000000 69 years -gmt 1] \ + [clock add 1600000000 596524 hours -gmt 1] \ + [clock add 1600000000 35791395 minutes -gmt 1] \ + [clock add 1600000000 0x7fffffff seconds -gmt 1] + ] +} [lrepeat 2 {3747558400 3743238400 3777452800 3747486400 3747483700 3747483647}] + # END testcases30 -- cgit v0.12 From 2dde22f4f1701b5ac4c52d93f8f8303cee856c7a Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 12 Mar 2024 01:48:02 +0000 Subject: fixes #23: `clock add` regression (integer overflow in time part) --- generic/tclClock.c | 15 +++++++++------ generic/tclDate.h | 12 ++++++------ 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 571052f..76f14da 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -4189,7 +4189,7 @@ repeat_rel: /* relative time (seconds), if exceeds current date, do the day conversion and * leave rest of the increment in yyRelSeconds to add it hereafter in UTC seconds */ if (yyRelSeconds) { - int newSecs = yySecondOfDay + yyRelSeconds; + Tcl_WideInt newSecs = yySecondOfDay + yyRelSeconds; /* if seconds increment outside of current date, increment day */ if (newSecs / SECONDS_PER_DAY != yySecondOfDay / SECONDS_PER_DAY) { @@ -4434,19 +4434,22 @@ ClockAddObjCmd( */ for (i = 2; i < objc; i+=2) { - /* bypass not integers (options, allready processed above) */ + /* bypass not integers (options, allready processed above in ClockParseFmtScnArgs) */ if (TclGetWideIntFromObj(NULL, objv[i], &offs) != TCL_OK) { continue; } - if (objv[i]->typePtr == &tclBignumType) { - Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); - goto done; - } /* get unit */ if (Tcl_GetIndexFromObj(interp, objv[i+1], units, "unit", 0, &unitIndex) != TCL_OK) { goto done; } + if (objv[i]->typePtr == &tclBignumType + || offs > (unitIndex < CLC_ADD_HOURS ? 0x7fffffff : TCL_MAX_SECONDS) + || offs < (unitIndex < CLC_ADD_HOURS ? -0x7fffffff : TCL_MIN_SECONDS) + ) { + Tcl_SetObjResult(interp, dataPtr->literals[LIT_INTEGER_VALUE_TOO_LARGE]); + goto done; + } /* nothing to do if zero quantity */ if (!offs) { diff --git a/generic/tclDate.h b/generic/tclDate.h index 465473f..10e6473 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -174,8 +174,8 @@ typedef struct TclDateFields { int dayOfWeek; /* Day of the week */ int hour; /* Hours of day (in-between time only calculation) */ int minutes; /* Minutes of hour (in-between time only calculation) */ - int secondOfMin; /* Seconds of minute (in-between time only calculation) */ - int secondOfDay; /* Seconds of day (in-between time only calculation) */ + Tcl_WideInt secondOfMin; /* Seconds of minute (in-between time only calculation) */ + Tcl_WideInt secondOfDay; /* Seconds of day (in-between time only calculation) */ int flags; /* 0 or CLF_CTZ */ @@ -215,16 +215,16 @@ typedef struct DateInfo { int dateTimezone; int dateDSTmode; - int dateRelMonth; - int dateRelDay; - int dateRelSeconds; + Tcl_WideInt dateRelMonth; + Tcl_WideInt dateRelDay; + Tcl_WideInt dateRelSeconds; int dateMonthOrdinalIncr; int dateMonthOrdinal; int dateDayOrdinal; - int *dateRelPointer; + Tcl_WideInt *dateRelPointer; int dateSpaceCount; int dateDigitCount; -- cgit v0.12 From 6ba098356a7185d715a94c0e283cb3e8af3024ba Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 12 Mar 2024 01:50:32 +0000 Subject: fixes similar issue by free scan + more tests --- generic/tclDate.c | 4 ++-- generic/tclGetDate.y | 4 ++-- tests/clock.test | 44 ++++++++++++++++++++++++++++++++++++++++++-- 3 files changed, 46 insertions(+), 6 deletions(-) diff --git a/generic/tclDate.c b/generic/tclDate.c index fa4cf4f..7d6ddac 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -138,7 +138,7 @@ typedef struct _TABLE { const char *name; int type; - long value; + Tcl_WideInt value; } TABLE; /* @@ -223,7 +223,7 @@ extern int TclDatedebug; union YYSTYPE { - long Number; + Tcl_WideInt Number; enum _MERIDIAN Meridian; diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 25802d8..b5f2efb 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -89,7 +89,7 @@ typedef struct _TABLE { const char *name; int type; - long value; + Tcl_WideInt value; } TABLE; /* @@ -103,7 +103,7 @@ typedef enum _DSTMODE { %} %union { - long Number; + Tcl_WideInt Number; enum _MERIDIAN Meridian; } diff --git a/tests/clock.test b/tests/clock.test index 7c1f756..65d3ce9 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -35753,7 +35753,7 @@ test clock-30.30 {clock add weekdays and back} -body { } return "OK" } -result {OK} -test clock-30.31 {regression test - add with int overflow} { +test clock-30.31 {regression test - add no int overflow} { list \ [list \ [clock add 0 1600000000 seconds 24856 days -gmt 1] \ @@ -35772,7 +35772,25 @@ test clock-30.31 {regression test - add with int overflow} { [clock add 1600000000 0x7fffffff seconds -gmt 1] ] } [lrepeat 2 {3747558400 3743238400 3777452800 3747486400 3747483700 3747483647}] - +test clock-30.32 {regression test - add no int overflow} { + list \ + [list \ + [clock add 3777452800 -1600000000 seconds -24856 days -gmt 1] \ + [clock add 3777452800 -1600000000 seconds -815 months -gmt 1] \ + [clock add 3777452800 -1600000000 seconds -69 years -gmt 1] \ + [clock add 3777452800 -1600000000 seconds -596524 hours -gmt 1] \ + [clock add 3777452800 -1600000000 seconds -35791395 minutes -gmt 1] \ + [clock add 3777452800 -1600000000 seconds -0x7fffffff seconds -gmt 1] + ] \ + [list \ + [clock add 2177452800 -24856 days -gmt 1] \ + [clock add 2177452800 -815 months -gmt 1] \ + [clock add 2177452800 -69 years -gmt 1] \ + [clock add 2177452800 -596524 hours -gmt 1] \ + [clock add 2177452800 -35791395 minutes -gmt 1] \ + [clock add 2177452800 -0x7fffffff seconds -gmt 1] + ] +} [lrepeat 2 {29894400 34214400 0 29966400 29969100 29969153}] # END testcases30 @@ -37012,6 +37030,28 @@ test clock-45.4 {compat: scan regression on spaces (mandatory leading/trailing s [catch {clock scan "11 1 120" -format " %y%m%d %H%M%S" -gmt 1} ret] $ret \ [catch {clock scan "11 1 120" -format " %y%m%d %H%M%S " -gmt 1} ret] $ret } -result [lrepeat 3 1 "input string does not match supplied format"] +test clock-45.5 {regression test - freescan no int overflow} { + # note that the relative date changes currently reset the time to 00:00, + # this can be changed later (simply achievable by adding 00:00 if expected): + list \ + [clock scan "+24856 days" -base 1600000000 -gmt 1] \ + [clock scan "+815 months" -base 1600000000 -gmt 1] \ + [clock scan "+69 years" -base 1600000000 -gmt 1] \ + [clock scan "+596524 hours" -base 1600000000 -gmt 1] \ + [clock scan "+35791395 minutes" -base 1600000000 -gmt 1] \ + [clock scan "+2147483647 seconds" -base 1600000000 -gmt 1] +} {3747513600 3743193600 3777408000 3747486400 3747483700 3747483647} +test clock-45.6 {regression test - freescan no int overflow} { + # note that the relative date changes currently reset the time to 00:00, + # this can be changed later (simply achievable by adding 00:00 if expected): + list \ + [clock scan "-24856 days" -base 2177452800 -gmt 1] \ + [clock scan "-815 months" -base 2177452800 -gmt 1] \ + [clock scan "-69 years" -base 2177452800 -gmt 1] \ + [clock scan "-596524 hours" -base 2177452800 -gmt 1] \ + [clock scan "-35791395 minutes" -base 2177452800 -gmt 1] \ + [clock scan "-2147483647 seconds" -base 2177452800 -gmt 1] +} {29894400 34214400 0 29966400 29969100 29969153} test clock-46.1 {regression test - month zero} -constraints valid_off \ -body { -- cgit v0.12 From 13caf4c498dbf7656147c39b2f3626321b257829 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 12 Mar 2024 08:56:08 +0000 Subject: Restore the TclGetStringFromObj() macro in tclInt.h as it was in 8.6/8.7 --- generic/tclDecls.h | 26 ++++++++++++-------------- generic/tclInt.h | 7 ++++++- generic/tclObj.c | 1 + generic/tclStubInit.c | 4 +--- 4 files changed, 20 insertions(+), 18 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index a2b0ec1..2acbb38 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4158,19 +4158,17 @@ extern const TclStubs *tclStubsPtr; # define Tcl_GetMaster Tcl_GetParent #endif -#ifdef USE_TCL_STUBS - /* Protect those 10 functions, make them useless through the stub table */ -# undef TclGetStringFromObj -# undef TclGetBytesFromObj -# undef TclGetUnicodeFromObj -# undef TclListObjGetElements -# undef TclListObjLength -# undef TclDictObjSize -# undef TclSplitList -# undef TclSplitPath -# undef TclFSSplitPath -# undef TclParseArgsObjv -#endif +/* Protect those 10 functions, make them useless through the stub table */ +#undef TclGetStringFromObj +#undef TclGetBytesFromObj +#undef TclGetUnicodeFromObj +#undef TclListObjGetElements +#undef TclListObjLength +#undef TclDictObjSize +#undef TclSplitList +#undef TclSplitPath +#undef TclFSSplitPath +#undef TclParseArgsObjv #if TCL_MAJOR_VERSION < 9 /* TIP #627 for 8.7 */ @@ -4236,7 +4234,7 @@ extern const TclStubs *tclStubsPtr; TclGetBytesFromObj((interp), (objPtr), (sizePtr)) : \ (Tcl_GetBytesFromObj)((interp), (objPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetStringFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ - TclGetStringFromObj((objPtr), (sizePtr)) : \ + (TclGetStringFromObj)((objPtr), (sizePtr)) : \ (Tcl_GetStringFromObj)((objPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetUnicodeFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetUnicodeFromObj((objPtr), (sizePtr)) : \ diff --git a/generic/tclInt.h b/generic/tclInt.h index 14662b7..1fa6786 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4396,6 +4396,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, #define TclGetString(objPtr) \ ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr)) +#define TclGetStringFromObj(objPtr, lenPtr) \ + ((objPtr)->bytes \ + ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ + : (Tcl_GetStringFromObj)((objPtr), (lenPtr))) + /* *---------------------------------------------------------------- * Macro used by the Tcl core to clean out an object's internal @@ -4587,7 +4592,7 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; #define TclNumUtfCharsM(numChars, bytes, numBytes) \ do { \ - Tcl_Size _count = 0, _i = (numBytes); \ + Tcl_Size _count, _i = (numBytes); \ unsigned char *_str = (unsigned char *) (bytes); \ while (_i > 0 && (*_str < 0xC0)) { _i--; _str++; } \ _count = (numBytes) - _i; \ diff --git a/generic/tclObj.c b/generic/tclObj.c index 17cb6a4..5dd4545 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -1660,6 +1660,7 @@ Tcl_GetString( */ #if !defined(TCL_NO_DEPRECATED) +#undef TclGetStringFromObj char * TclGetStringFromObj( Tcl_Obj *objPtr, /* Object whose string rep byte pointer should diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 9072796..b48ec1b 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -73,10 +73,8 @@ # undef Tcl_WinConvertError # define Tcl_WinConvertError 0 #endif +#undef TclGetStringFromObj #if defined(TCL_NO_DEPRECATED) -# undef TclGetStringFromObj -# undef TclGetBytesFromObj -# undef TclGetUnicodeFromObj # define TclGetStringFromObj 0 # define TclGetBytesFromObj 0 # define TclGetUnicodeFromObj 0 -- cgit v0.12 From 29b5db9e2cd306c8a0fb7ae2b1fd6d2515cee68f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 12 Mar 2024 21:24:14 +0000 Subject: Restore TclListObjGetElements()/TclListObjLength() as they were in 8.6 too. --- generic/tcl.h | 2 +- generic/tclAssembly.c | 4 ++-- generic/tclBasic.c | 14 +++++++------- generic/tclBinary.c | 6 +++--- generic/tclClock.c | 8 ++++---- generic/tclCmdAH.c | 6 +++--- generic/tclCmdIL.c | 42 +++++++++++++++++++++--------------------- generic/tclCmdMZ.c | 28 ++++++++++++++-------------- generic/tclCompCmds.c | 6 +++--- generic/tclCompCmdsSZ.c | 12 ++++++------ generic/tclCompExpr.c | 4 ++-- generic/tclDecls.h | 4 ++-- generic/tclDictObj.c | 18 +++++++++--------- generic/tclDisassemble.c | 2 +- generic/tclEncoding.c | 10 +++++----- generic/tclEnsemble.c | 40 ++++++++++++++++++++-------------------- generic/tclEvent.c | 2 +- generic/tclExecute.c | 38 +++++++++++++++++++------------------- generic/tclFCmd.c | 2 +- generic/tclFileName.c | 14 +++++++------- generic/tclIO.c | 2 +- generic/tclIOGT.c | 2 +- generic/tclIORChan.c | 10 +++++----- generic/tclIORTrans.c | 6 +++--- generic/tclIOUtil.c | 12 ++++++------ generic/tclIndexObj.c | 10 +++++----- generic/tclInt.h | 4 ++-- generic/tclInterp.c | 6 +++--- generic/tclLink.c | 2 +- generic/tclListObj.c | 12 ++++++------ generic/tclNamesp.c | 8 ++++---- generic/tclOODefineCmds.c | 16 ++++++++-------- generic/tclOOMethod.c | 10 +++++----- generic/tclObj.c | 2 +- generic/tclPathObj.c | 4 ++-- generic/tclPkg.c | 4 ++-- generic/tclProc.c | 10 +++++----- generic/tclProcess.c | 4 ++-- generic/tclResult.c | 10 +++++----- generic/tclStrToD.c | 2 +- generic/tclStringObj.c | 4 ++-- generic/tclStubInit.c | 14 ++++++++------ generic/tclTrace.c | 16 ++++++++-------- generic/tclUtil.c | 2 +- generic/tclVar.c | 14 +++++++------- generic/tclZipfs.c | 4 ++-- generic/tclZlib.c | 8 ++++---- 47 files changed, 231 insertions(+), 229 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index a4480a7..059b7a4 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -327,7 +327,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; # define TCL_SIZE_MODIFIER "" #else typedef ptrdiff_t Tcl_Size; -# define TCL_SIZE_MAX ((ptrdiff_t)(((size_t)-1)>>1)) +# define TCL_SIZE_MAX ((Tcl_Size)(((size_t)-1)>>1)) # define TCL_SIZE_MODIFIER TCL_T_MODIFIER #endif /* TCL_MAJOR_VERSION */ diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index ce5ced6..ba2e5a7 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -1984,7 +1984,7 @@ CreateMirrorJumpTable( * table. */ Tcl_Size i; - if (TclListObjLengthM(interp, jumps, &objc) != TCL_OK) { + if (TclListObjLength(interp, jumps, &objc) != TCL_OK) { return TCL_ERROR; } if (objc % 2 != 0) { @@ -1996,7 +1996,7 @@ CreateMirrorJumpTable( } return TCL_ERROR; } - if (TclListObjGetElementsM(interp, jumps, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 592529f..50806e3 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4872,7 +4872,7 @@ TEOV_NotFound( * itself. */ - TclListObjGetElementsM(NULL, currNsPtr->unknownHandlerPtr, + TclListObjGetElements(NULL, currNsPtr->unknownHandlerPtr, &handlerObjc, &handlerObjv); newObjc = objc + handlerObjc; newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc); @@ -5383,7 +5383,7 @@ TclEvalEx( if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { Tcl_Size numElements; - code = TclListObjLengthM(interp, objv[objectsUsed], + code = TclListObjLength(interp, objv[objectsUsed], &numElements); if (code == TCL_ERROR) { /* @@ -5445,7 +5445,7 @@ TclEvalEx( Tcl_Size numElements; Tcl_Obj **elements, *temp = copy[wordIdx]; - TclListObjGetElementsM(NULL, temp, &numElements, + TclListObjGetElements(NULL, temp, &numElements, &elements); objectsUsed += numElements; while (numElements--) { @@ -6208,7 +6208,7 @@ TclNREvalObjEx( TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, objPtr, NULL); - TclListObjGetElementsM(NULL, listPtr, &objc, &objv); + TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, flags, NULL); } @@ -8894,7 +8894,7 @@ TclNRTailcallEval( Tcl_Size objc; Tcl_Obj **objv; - TclListObjGetElementsM(interp, listPtr, &objc, &objv); + TclListObjGetElements(interp, listPtr, &objc, &objv); nsObjPtr = objv[0]; if (result == TCL_OK) { @@ -9324,7 +9324,7 @@ TclNREvalList( TclMarkTailcall(interp); TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); - TclListObjGetElementsM(NULL, listPtr, &objc, &objv); + TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } @@ -9611,7 +9611,7 @@ InjectHandler( TclMarkTailcall(interp); TclNRAddCallback(interp, InjectHandlerPostCall, corPtr, listPtr, INT2PTR(nargs), isProbe); - TclListObjGetElementsM(NULL, listPtr, &objc, &objv); + TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 314e9fd..152b21e 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -961,7 +961,7 @@ BinaryFormatCmd( * The macro evals its args more than once: avoid arg++ */ - if (TclListObjLengthM(interp, objv[arg], &listc + if (TclListObjLength(interp, objv[arg], &listc ) != TCL_OK) { return TCL_ERROR; } @@ -974,7 +974,7 @@ BinaryFormatCmd( -1)); return TCL_ERROR; } - if (TclListObjGetElementsM(interp, objv[arg], &listc, + if (TclListObjGetElements(interp, objv[arg], &listc, &listv) != TCL_OK) { return TCL_ERROR; } @@ -1249,7 +1249,7 @@ BinaryFormatCmd( listc = 1; count = 1; } else { - TclListObjGetElementsM(interp, objv[arg], &listc, &listv); + TclListObjGetElements(interp, objv[arg], &listc, &listv); if (count == BINARY_ALL) { count = listc; } diff --git a/generic/tclClock.c b/generic/tclClock.c index 4bd9ad2..83da0ef 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -732,7 +732,7 @@ ConvertLocalToUTC( * Unpack the tz data. */ - if (TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK) { + if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) { return TCL_ERROR; } @@ -797,7 +797,7 @@ ConvertLocalToUTCUsingTable( while (!found) { row = LookupLastTransition(interp, fields->seconds, rowc, rowv); if ((row == NULL) - || TclListObjGetElementsM(interp, row, &cellc, + || TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK || TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) { @@ -935,7 +935,7 @@ ConvertUTCToLocal( * Unpack the tz data. */ - if (TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK) { + if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) { return TCL_ERROR; } @@ -987,7 +987,7 @@ ConvertUTCToLocalUsingTable( row = LookupLastTransition(interp, fields->seconds, rowc, rowv); if (row == NULL || - TclListObjGetElementsM(interp, row, &cellc, &cellv) != TCL_OK || + TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK || TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index e3f3698..1268751 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -2825,7 +2825,7 @@ EachloopCmd( result = TCL_ERROR; goto done; } - result = TclListObjLengthM(interp, statePtr->vCopyList[i], + result = TclListObjLength(interp, statePtr->vCopyList[i], &statePtr->varcList[i]); if (result != TCL_OK) { result = TCL_ERROR; @@ -2841,7 +2841,7 @@ EachloopCmd( result = TCL_ERROR; goto done; } - TclListObjGetElementsM(NULL, statePtr->vCopyList[i], + TclListObjGetElements(NULL, statePtr->vCopyList[i], &statePtr->varcList[i], &statePtr->varvList[i]); /* Values */ @@ -2861,7 +2861,7 @@ EachloopCmd( result = TCL_ERROR; goto done; } - result = TclListObjGetElementsM(interp, statePtr->aCopyList[i], + result = TclListObjGetElements(interp, statePtr->aCopyList[i], &statePtr->argcList[i], &statePtr->argvList[i]); if (result != TCL_OK) { goto done; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 0079167..fec8fcf 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2179,7 +2179,7 @@ Tcl_JoinObjCmd( != TCL_OK) { return TCL_ERROR; } - } else if (TclListObjGetElementsM(interp, objv[1], &listLen, + } else if (TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs) != TCL_OK) { return TCL_ERROR; } @@ -2280,7 +2280,7 @@ Tcl_LassignObjCmd( */ listPtr = objv[1]; - if (TclListObjLengthM(interp, listPtr, &listObjc) != TCL_OK) { + if (TclListObjLength(interp, listPtr, &listObjc) != TCL_OK) { return TCL_ERROR; } origListObjc = listObjc; @@ -2439,7 +2439,7 @@ Tcl_LinsertObjCmd( return TCL_ERROR; } - result = TclListObjLengthM(interp, objv[1], &len); + result = TclListObjLength(interp, objv[1], &len); if (result != TCL_OK) { return result; } @@ -2569,7 +2569,7 @@ Tcl_LlengthObjCmd( return TCL_ERROR; } - result = TclListObjLengthM(interp, objv[1], &listLen); + result = TclListObjLength(interp, objv[1], &listLen); if (result != TCL_OK) { return result; } @@ -2624,7 +2624,7 @@ Tcl_LpopObjCmd( return TCL_ERROR; } - result = TclListObjLengthM(interp, listPtr, &listLen); + result = TclListObjLength(interp, listPtr, &listLen); if (result != TCL_OK) { return result; } @@ -2736,7 +2736,7 @@ Tcl_LrangeObjCmd( return TCL_ERROR; } - result = TclListObjLengthM(interp, objv[1], &listLen); + result = TclListObjLength(interp, objv[1], &listLen); if (result != TCL_OK) { return result; } @@ -2825,7 +2825,7 @@ Tcl_LremoveObjCmd( } listObj = objv[1]; - if (TclListObjLengthM(interp, listObj, &listLen) != TCL_OK) { + if (TclListObjLength(interp, listObj, &listLen) != TCL_OK) { return TCL_ERROR; } @@ -3066,7 +3066,7 @@ Tcl_LreplaceObjCmd( return TCL_ERROR; } - result = TclListObjLengthM(interp, objv[1], &listLen); + result = TclListObjLength(interp, objv[1], &listLen); if (result != TCL_OK) { return result; } @@ -3179,7 +3179,7 @@ Tcl_LreverseObjCmd( } } /* end Abstract List */ - if (TclListObjLengthM(interp, objv[1], &elemc) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &elemc) != TCL_OK) { return TCL_ERROR; } @@ -3191,7 +3191,7 @@ Tcl_LreverseObjCmd( Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } - if (TclListObjGetElementsM(interp, objv[1], &elemc, &elemv) != TCL_OK) { + if (TclListObjGetElements(interp, objv[1], &elemc, &elemv) != TCL_OK) { return TCL_ERROR; } @@ -3463,7 +3463,7 @@ Tcl_LsearchObjCmd( */ i++; - if (TclListObjGetElementsM(interp, objv[i], + if (TclListObjGetElements(interp, objv[i], &sortInfo.indexc, &indices) != TCL_OK) { result = TCL_ERROR; goto done; @@ -3569,7 +3569,7 @@ Tcl_LsearchObjCmd( * pointer to its array of element pointers. */ - result = TclListObjGetElementsM(interp, objv[objc - 2], &listc, &listv); + result = TclListObjGetElements(interp, objv[objc - 2], &listc, &listv); if (result != TCL_OK) { goto done; } @@ -3674,7 +3674,7 @@ Tcl_LsearchObjCmd( * 1844789] */ - TclListObjGetElementsM(NULL, objv[objc - 2], &listc, &listv); + TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv); break; case REAL: result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble); @@ -3687,7 +3687,7 @@ Tcl_LsearchObjCmd( * 1844789] */ - TclListObjGetElementsM(NULL, objv[objc - 2], &listc, &listv); + TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv); break; } } else { @@ -4616,7 +4616,7 @@ Tcl_LsortObjCmd( sortInfo.resultCode = TCL_ERROR; goto done; } - if (TclListObjGetElementsM(interp, objv[i+1], &sortindex, + if (TclListObjGetElements(interp, objv[i+1], &sortindex, &indexv) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done; @@ -4709,7 +4709,7 @@ Tcl_LsortObjCmd( if (indexPtr) { Tcl_Obj **indexv; - TclListObjGetElementsM(interp, indexPtr, &sortInfo.indexc, &indexv); + TclListObjGetElements(interp, indexPtr, &sortInfo.indexc, &indexv); switch (sortInfo.indexc) { case 0: sortInfo.indexv = NULL; @@ -4771,7 +4771,7 @@ Tcl_LsortObjCmd( sortInfo.resultCode = TclObjTypeGetElements(interp, listObj, &length, &listObjPtrs); } else { - sortInfo.resultCode = TclListObjGetElementsM(interp, listObj, + sortInfo.resultCode = TclListObjGetElements(interp, listObj, &length, &listObjPtrs); } if (sortInfo.resultCode != TCL_OK || length <= 0) { @@ -5066,7 +5066,7 @@ Tcl_LeditObjCmd( * by Tcl_{Lrange,Lreplace,Ledit}ObjCmd */ - result = TclListObjLengthM(interp, listPtr, &listLen); + result = TclListObjLength(interp, listPtr, &listLen); if (result != TCL_OK) { return result; } @@ -5302,10 +5302,10 @@ SortCompare( * Replace them and evaluate the result. */ - TclListObjLengthM(infoPtr->interp, infoPtr->compareCmdPtr, &objc); + TclListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc); Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2, 2, 2, paramObjv); - TclListObjGetElementsM(infoPtr->interp, infoPtr->compareCmdPtr, + TclListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr, &objc, &objv); infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0); @@ -5516,7 +5516,7 @@ SelectObjFromSublist( int index; Tcl_Obj *currentObj, *lastObj=NULL; - if (TclListObjLengthM(infoPtr->interp, objPtr, &listLen) != TCL_OK) { + if (TclListObjLength(infoPtr->interp, objPtr, &listLen) != TCL_OK) { infoPtr->resultCode = TCL_ERROR; return NULL; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 2660ff1..a887aaf 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -677,7 +677,7 @@ Tcl_RegsubObjCmd( * object. (If they aren't, that's cheap to do.) */ - if (TclListObjLengthM(interp, objv[2], &numParts) != TCL_OK) { + if (TclListObjLength(interp, objv[2], &numParts) != TCL_OK) { return TCL_ERROR; } if (numParts < 1) { @@ -779,7 +779,7 @@ Tcl_RegsubObjCmd( Tcl_Obj **args = NULL, **parts; Tcl_Size numArgs; - TclListObjGetElementsM(interp, subPtr, &numParts, &parts); + TclListObjGetElements(interp, subPtr, &numParts, &parts); numArgs = numParts + info.nsubs + 1; args = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*) * numArgs); memcpy(args, parts, sizeof(Tcl_Obj*) * numParts); @@ -1809,7 +1809,7 @@ StringIsCmd( * well-formed lists. */ - if (TCL_OK == TclListObjLengthM(NULL, objPtr, &length3)) { + if (TCL_OK == TclListObjLength(NULL, objPtr, &length3)) { break; } @@ -2023,7 +2023,7 @@ StringMapCmd( Tcl_DictObjDone(&search); } else { Tcl_Size i; - if (TclListObjGetElementsM(interp, objv[objc-2], &i, + if (TclListObjGetElements(interp, objv[objc-2], &i, &mapElemv) != TCL_OK) { return TCL_ERROR; } @@ -3587,7 +3587,7 @@ TclNRSwitchObjCmd( Tcl_Size listc; blist = objv[0]; - if (TclListObjLengthM(interp, objv[0], &listc) != TCL_OK) { + if (TclListObjLength(interp, objv[0], &listc) != TCL_OK) { return TCL_ERROR; } @@ -3600,7 +3600,7 @@ TclNRSwitchObjCmd( "?-option ...? string {?pattern body ...? ?default body?}"); return TCL_ERROR; } - if (TclListObjGetElementsM(interp, objv[0], &listc, &listv) != TCL_OK) { + if (TclListObjGetElements(interp, objv[0], &listc, &listv) != TCL_OK) { return TCL_ERROR; } objc = listc; @@ -3980,7 +3980,7 @@ Tcl_ThrowObjCmd( * The type must be a list of at least length 1. */ - if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { return TCL_ERROR; } else if (len < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -4770,7 +4770,7 @@ TclNRTryObjCmd( return TCL_ERROR; } code = 1; - if (TclListObjLengthM(NULL, objv[i+1], &dummy) != TCL_OK) { + if (TclListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad prefix '%s': must be a list", TclGetString(objv[i+1]))); @@ -4782,7 +4782,7 @@ TclNRTryObjCmd( info[2] = objv[i+1]; commonHandler: - if (TclListObjLengthM(interp, objv[i+2], &dummy) != TCL_OK) { + if (TclListObjLength(interp, objv[i+2], &dummy) != TCL_OK) { Tcl_DecrRefCount(handlersObj); return TCL_ERROR; } @@ -4932,12 +4932,12 @@ TryPostBody( int found = 0; Tcl_Obj **handlers, **info; - TclListObjGetElementsM(NULL, handlersObj, &numHandlers, &handlers); + TclListObjGetElements(NULL, handlersObj, &numHandlers, &handlers); for (i=0 ; i 0) { Tcl_Obj *varName; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 495c307..818b96b 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -302,7 +302,7 @@ TclCompileArraySetCmd( TclNewObj(literalObj); isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj); isDataValid = (isDataLiteral - && TclListObjLengthM(NULL, literalObj, &len) == TCL_OK); + && TclListObjLength(NULL, literalObj, &len) == TCL_OK); isDataEven = (isDataValid && (len & 1) == 0); /* @@ -893,7 +893,7 @@ TclCompileConcatCmd( const char *bytes; Tcl_Size len, slen; - TclListObjGetElementsM(NULL, listObj, &len, &objs); + TclListObjGetElements(NULL, listObj, &len, &objs); objPtr = Tcl_ConcatObj(len, objs); Tcl_DecrRefCount(listObj); bytes = Tcl_GetStringFromObj(objPtr, &slen); @@ -2833,7 +2833,7 @@ CompileEachloopCmd( */ if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) || - TCL_OK != TclListObjLengthM(NULL, varListObj, &numVars) || + TCL_OK != TclListObjLength(NULL, varListObj, &numVars) || numVars == 0) { code = TCL_ERROR; goto done; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 0281465..b25862f 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -940,7 +940,7 @@ TclCompileStringMapCmd( if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) { Tcl_DecrRefCount(mapObj); return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); - } else if (TclListObjGetElementsM(NULL, mapObj, &len, &objv) != TCL_OK) { + } else if (TclListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) { Tcl_DecrRefCount(mapObj); return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } else if (len != 2) { @@ -2736,7 +2736,7 @@ TclCompileThrowCmd( CompileWord(envPtr, msgToken, interp, 2); codeIsList = codeKnown && (TCL_OK == - TclListObjLengthM(interp, objPtr, &len)); + TclListObjLength(interp, objPtr, &len)); codeIsValid = codeIsList && (len != 0); if (codeIsValid) { @@ -2869,7 +2869,7 @@ TclCompileTryCmd( TclNewObj(tmpObj); Tcl_IncrRefCount(tmpObj); if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj) - || TclListObjLengthM(NULL, tmpObj, &objc) != TCL_OK + || TclListObjLength(NULL, tmpObj, &objc) != TCL_OK || (objc == 0)) { TclDecrRefCount(tmpObj); goto failedToCompile; @@ -2912,7 +2912,7 @@ TclCompileTryCmd( TclDecrRefCount(tmpObj); goto failedToCompile; } - if (TclListObjGetElementsM(NULL, tmpObj, &objc, &objv) != TCL_OK + if (TclListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK || (objc > 2)) { TclDecrRefCount(tmpObj); goto failedToCompile; @@ -3127,7 +3127,7 @@ IssueTryClausesInstructions( JUMP4( JUMP_FALSE, notCodeJumpSource); if (matchClauses[i]) { const char *p; - TclListObjLengthM(NULL, matchClauses[i], &len); + TclListObjLength(NULL, matchClauses[i], &len); /* * Match the errorcode according to try/trap rules. @@ -3339,7 +3339,7 @@ IssueTryClausesFinallyInstructions( OP( EQ); JUMP4( JUMP_FALSE, notCodeJumpSource); if (matchClauses[i]) { - TclListObjLengthM(NULL, matchClauses[i], &len); + TclListObjLength(NULL, matchClauses[i], &len); /* * Match the errorcode according to try/trap rules. diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 41b8b65..85f475e 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2226,8 +2226,8 @@ TclCompileExpr( TclAdvanceLines(&envPtr->line, script, script + TclParseAllWhiteSpace(script, numBytes)); - TclListObjGetElementsM(NULL, litList, &objc, (Tcl_Obj ***)&litObjv); - TclListObjGetElementsM(NULL, funcList, &objc, &funcObjv); + TclListObjGetElements(NULL, litList, &objc, (Tcl_Obj ***)&litObjv); + TclListObjGetElements(NULL, funcList, &objc, &funcObjv); CompileExprTree(interp, opTree, 0, &litObjv, funcObjv, parsePtr->tokenPtr, envPtr, optimize); } else { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 2acbb38..0d5bfe5 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4240,10 +4240,10 @@ extern const TclStubs *tclStubsPtr; TclGetUnicodeFromObj((objPtr), (sizePtr)) : \ (Tcl_GetUnicodeFromObj)((objPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) <= sizeof(int) ? \ - TclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) : \ + (TclListObjGetElements)((interp), (listPtr), (objcPtr), (objvPtr)) : \ (Tcl_ListObjGetElements)((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr))) # define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) <= sizeof(int) ? \ - TclListObjLength((interp), (listPtr), (lengthPtr)) : \ + (TclListObjLength)((interp), (listPtr), (lengthPtr)) : \ (Tcl_ListObjLength)((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr))) # define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclDictObjSize((interp), (dictPtr), (sizePtr)) : \ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 7c56c49..43f003b 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -621,7 +621,7 @@ SetDictFromAny( Tcl_Obj **objv; /* Cannot fail, we already know the Tcl_ObjType is "list". */ - TclListObjGetElementsM(NULL, objPtr, &objc, &objv); + TclListObjGetElements(NULL, objPtr, &objc, &objv); if (objc & 1) { goto missingValue; } @@ -2509,7 +2509,7 @@ DictForNRCmd( * Parse arguments. */ - if (TclListObjGetElementsM(interp, objv[1], &varc, &varv) != TCL_OK) { + if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { @@ -2528,7 +2528,7 @@ DictForNRCmd( TclStackFree(interp, searchPtr); return TCL_OK; } - TclListObjGetElementsM(NULL, objv[1], &varc, &varv); + TclListObjGetElements(NULL, objv[1], &varc, &varv); keyVarObj = varv[0]; valueVarObj = varv[1]; scriptObj = objv[3]; @@ -2704,7 +2704,7 @@ DictMapNRCmd( * Parse arguments. */ - if (TclListObjGetElementsM(interp, objv[1], &varc, &varv) != TCL_OK) { + if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { @@ -2730,7 +2730,7 @@ DictMapNRCmd( return TCL_OK; } TclNewObj(storagePtr->accumulatorObj); - TclListObjGetElementsM(NULL, objv[1], &varc, &varv); + TclListObjGetElements(NULL, objv[1], &varc, &varv); storagePtr->keyVarObj = varv[0]; storagePtr->valueVarObj = varv[1]; storagePtr->scriptObj = objv[3]; @@ -3144,7 +3144,7 @@ DictFilterCmd( * copying from the "dict for" implementation has occurred! */ - if (TclListObjGetElementsM(interp, objv[3], &varc, &varv) != TCL_OK) { + if (TclListObjGetElements(interp, objv[3], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { @@ -3406,7 +3406,7 @@ FinalizeDictUpdate( * an instruction to remove the key. */ - TclListObjGetElementsM(NULL, argsObj, &objc, &objv); + TclListObjGetElements(NULL, argsObj, &objc, &objv); for (i=0 ; i 0 ? objv[1] : NULL); continue; case CRT_PARAM: - if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } @@ -275,7 +275,7 @@ TclNamespaceEnsembleCmd( Tcl_Obj **listv; const char *cmd; - if (TclListObjGetElementsM(interp, listObj, &len, + if (TclListObjGetElements(interp, listObj, &len, &listv) != TCL_OK) { Tcl_DictObjDone(&search); if (patchedDict) { @@ -340,7 +340,7 @@ TclNamespaceEnsembleCmd( } continue; case CRT_UNKNOWN: - if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } @@ -538,13 +538,13 @@ TclNamespaceEnsembleCmd( } switch (idx) { case CONF_SUBCMDS: - if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { goto freeMapAndError; } subcmdObj = (len > 0 ? objv[1] : NULL); continue; case CONF_PARAM: - if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { goto freeMapAndError; } paramObj = (len > 0 ? objv[1] : NULL); @@ -566,7 +566,7 @@ TclNamespaceEnsembleCmd( continue; } do { - if (TclListObjLengthM(interp, listObj, &len + if (TclListObjLength(interp, listObj, &len ) != TCL_OK) { Tcl_DictObjDone(&search); if (patchedDict) { @@ -586,7 +586,7 @@ TclNamespaceEnsembleCmd( } goto freeMapAndError; } - if (TclListObjGetElementsM(interp, listObj, &len, + if (TclListObjGetElements(interp, listObj, &len, &listv) != TCL_OK) { Tcl_DictObjDone(&search); if (patchedDict) { @@ -636,7 +636,7 @@ TclNamespaceEnsembleCmd( } continue; case CONF_UNKNOWN: - if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { goto freeMapAndError; } unknownObj = (len > 0 ? objv[1] : NULL); @@ -805,7 +805,7 @@ Tcl_SetEnsembleSubcommandList( if (subcmdList != NULL) { Tcl_Size length; - if (TclListObjLengthM(interp, subcmdList, &length) != TCL_OK) { + if (TclListObjLength(interp, subcmdList, &length) != TCL_OK) { return TCL_ERROR; } if (length < 1) { @@ -881,7 +881,7 @@ Tcl_SetEnsembleParameterList( if (paramList == NULL) { length = 0; } else { - if (TclListObjLengthM(interp, paramList, &length) != TCL_OK) { + if (TclListObjLength(interp, paramList, &length) != TCL_OK) { return TCL_ERROR; } if (length < 1) { @@ -1057,7 +1057,7 @@ Tcl_SetEnsembleUnknownHandler( if (unknownList != NULL) { Tcl_Size length; - if (TclListObjLengthM(interp, unknownList, &length) != TCL_OK) { + if (TclListObjLength(interp, unknownList, &length) != TCL_OK) { return TCL_ERROR; } if (length < 1) { @@ -1901,7 +1901,7 @@ NsEnsembleImplementationCmdNR( Tcl_Obj **copyObjv; Tcl_Size copyObjc, prefixObjc; - TclListObjLengthM(NULL, prefixObj, &prefixObjc); + TclListObjLength(NULL, prefixObj, &prefixObjc); if (objc == 2) { copyPtr = TclListObjCopy(NULL, prefixObj); @@ -1935,7 +1935,7 @@ NsEnsembleImplementationCmdNR( */ TclSkipTailcall(interp); - TclListObjGetElementsM(NULL, copyPtr, ©Objc, ©Objv); + TclListObjGetElements(NULL, copyPtr, ©Objc, ©Objv); ((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr; return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL); } @@ -2311,7 +2311,7 @@ EnsembleUnknownCallback( for (i = 1 ; i < objc ; i++) { Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]); } - TclListObjGetElementsM(NULL, unknownCmd, ¶mc, ¶mv); + TclListObjGetElements(NULL, unknownCmd, ¶mc, ¶mv); Tcl_IncrRefCount(unknownCmd); /* @@ -2348,7 +2348,7 @@ EnsembleUnknownCallback( /* A non-empty list is the replacement command. */ - if (TclListObjLengthM(interp, *prefixObjPtr, &prefixObjc) != TCL_OK) { + if (TclListObjLength(interp, *prefixObjPtr, &prefixObjc) != TCL_OK) { TclDecrRefCount(*prefixObjPtr); Tcl_AddErrorInfo(interp, "\n while parsing result of " "ensemble unknown subcommand handler"); @@ -2605,7 +2605,7 @@ BuildEnsembleConfig( * Determine the target for each. */ - TclListObjGetElementsM(NULL, subList, &subc, &subv); + TclListObjGetElements(NULL, subList, &subc, &subv); if (subList == mapDict) { /* * Unusual case where explicit list of subcommands is same value @@ -3002,7 +3002,7 @@ TclCompileEnsemble( const char *str; Tcl_Obj *matchObj = NULL; - if (TclListObjGetElementsM(NULL, listObj, &len, &elems) != TCL_OK) { + if (TclListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) { goto failed; } for (i=0 ; itokenPtr; i < parsePtr->numWords; i++, tokPtr = TokenAfter(tokPtr)) { if (i > 0 && i <= numWords) { diff --git a/generic/tclEvent.c b/generic/tclEvent.c index af76051..54fe8dc 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -238,7 +238,7 @@ HandleBgErrors( errPtr = assocPtr->firstBgPtr; - TclListObjGetElementsM(NULL, copyObj, &prefixObjc, &prefixObjv); + TclListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv); tempObjv = (Tcl_Obj**)Tcl_Alloc((prefixObjc+2) * sizeof(Tcl_Obj *)); memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *)); tempObjv[prefixObjc] = errPtr->errorMsg; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 225cc53..fddceb5 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2676,7 +2676,7 @@ TEBCresume( objPtr = OBJ_AT_TOS; TRACE(("\"%.30s\" => ", O2S(objPtr))); - if (TclListObjGetElementsM(interp, objPtr, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -2892,7 +2892,7 @@ TEBCresume( TclMarkTailcall(interp); TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); - TclListObjGetElementsM(NULL, objPtr, &objc, &objv); + TclListObjGetElements(NULL, objPtr, &objc, &objv); TclNRAddCallback(interp, TclNRReleaseValues, objPtr, NULL, NULL, NULL); return TclNREvalObjv(interp, objc, objv, TCL_EVAL_INVOKE, NULL); @@ -3304,7 +3304,7 @@ TEBCresume( varPtr = varPtr->value.linkPtr; } TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr))); - if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) + if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; @@ -3330,7 +3330,7 @@ TEBCresume( } TRACE(("%u \"%.30s\" \"%.30s\" => ", opnd, O2S(part2Ptr), O2S(valuePtr))); - if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) + if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; @@ -3372,7 +3372,7 @@ TEBCresume( lappendListDirect: objResultPtr = varPtr->value.objPtr; - if (TclListObjLengthM(interp, objResultPtr, &len) != TCL_OK) { + if (TclListObjLength(interp, objResultPtr, &len) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -3393,7 +3393,7 @@ TEBCresume( lappendList: opnd = -1; - if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) + if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; @@ -3431,7 +3431,7 @@ TEBCresume( if (!objResultPtr) { valueToAssign = valuePtr; - } else if (TclListObjLengthM(interp, objResultPtr, &len)!=TCL_OK) { + } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) { TRACE_ERROR(interp); goto gotError; } else { @@ -4720,7 +4720,7 @@ TEBCresume( case INST_LIST_LENGTH: TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); - if (TclListObjLengthM(interp, OBJ_AT_TOS, &length) != TCL_OK) { + if (TclListObjLength(interp, OBJ_AT_TOS, &length) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -4763,7 +4763,7 @@ TEBCresume( { Tcl_Size value2Length; Tcl_Obj *indexListPtr = value2Ptr; - if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK) + if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK) && ( !TclHasInternalRep(value2Ptr, &tclListType) || @@ -4853,7 +4853,7 @@ TEBCresume( } /* List case */ - if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -5002,7 +5002,7 @@ TEBCresume( * in the process. */ - if (TclListObjLengthM(interp, valuePtr, &objc) != TCL_OK) { + if (TclListObjLength(interp, valuePtr, &objc) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -5089,7 +5089,7 @@ TEBCresume( } } else { - if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) { + if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -6527,7 +6527,7 @@ TEBCresume( numVars = varListPtr->numVars; listPtr = OBJ_AT_DEPTH(listTmpDepth); DECACHE_STACK_INFO(); - if (TclListObjLengthM(interp, listPtr, &listLen) != TCL_OK) { + if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) { CACHE_STACK_INFO(); TRACE_APPEND(("ERROR converting list %" TCL_Z_MODIFIER "d, \"%s\": %s", i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)))); @@ -6617,7 +6617,7 @@ TEBCresume( status = Tcl_ListObjLength(interp, listPtr, &listLen); elements = NULL; } else { - status = TclListObjGetElementsM( + status = TclListObjGetElements( interp, listPtr, &listLen, &elements); } if (status != TCL_OK) { @@ -7256,7 +7256,7 @@ TEBCresume( } } Tcl_IncrRefCount(dictPtr); - if (TclListObjGetElementsM(interp, OBJ_AT_TOS, &length, + if (TclListObjGetElements(interp, OBJ_AT_TOS, &length, &keyPtrPtr) != TCL_OK) { TRACE_ERROR(interp); goto gotError; @@ -7316,7 +7316,7 @@ TEBCresume( NEXT_INST_F(9, 1, 0); } if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK - || TclListObjGetElementsM(interp, OBJ_AT_TOS, &length, + || TclListObjGetElements(interp, OBJ_AT_TOS, &length, &keyPtrPtr) != TCL_OK) { TRACE_ERROR(interp); goto gotError; @@ -7375,7 +7375,7 @@ TEBCresume( dictPtr = OBJ_UNDER_TOS; listPtr = OBJ_AT_TOS; TRACE(("\"%.30s\" \"%.30s\" =>", O2S(dictPtr), O2S(listPtr))); - if (TclListObjGetElementsM(interp, listPtr, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -7393,7 +7393,7 @@ TEBCresume( listPtr = OBJ_AT_TOS; TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ", O2S(varNamePtr), O2S(valuePtr), O2S(keysPtr))); - if (TclListObjGetElementsM(interp, listPtr, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); TclDecrRefCount(keysPtr); goto gotError; @@ -7424,7 +7424,7 @@ TEBCresume( varPtr = LOCAL(opnd); TRACE(("%u <- \"%.30s\" \"%.30s\" => ", opnd, O2S(valuePtr), O2S(keysPtr))); - if (TclListObjGetElementsM(interp, listPtr, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index 4cea92e..c97997d 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -1041,7 +1041,7 @@ TclFileAttrsCmd( * Use objStrings as a list object. */ - if (TclListObjLengthM(interp, objStrings, &numObjStrings) != TCL_OK) { + if (TclListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) { goto end; } attributeStringsAllocated = (const char **) diff --git a/generic/tclFileName.c b/generic/tclFileName.c index b7ac0fa..5e167c7 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -488,7 +488,7 @@ TclpNativeSplitPath( */ if (lenPtr != NULL) { - TclListObjLengthM(NULL, resultPtr, lenPtr); + TclListObjLength(NULL, resultPtr, lenPtr); } return resultPtr; } @@ -1225,7 +1225,7 @@ Tcl_GlobObjCmd( return TCL_ERROR; } typePtr = objv[i+1]; - if (TclListObjLengthM(interp, typePtr, &length) != TCL_OK) { + if (TclListObjLength(interp, typePtr, &length) != TCL_OK) { return TCL_ERROR; } i++; @@ -1351,7 +1351,7 @@ Tcl_GlobObjCmd( * platform. */ - TclListObjLengthM(interp, typePtr, &length); + TclListObjLength(interp, typePtr, &length); if (length == 0) { goto skipTypes; } @@ -1422,7 +1422,7 @@ Tcl_GlobObjCmd( Tcl_Obj *item; Tcl_Size llen; - if ((TclListObjLengthM(NULL, look, &llen) == TCL_OK) + if ((TclListObjLength(NULL, look, &llen) == TCL_OK) && (llen == 3)) { Tcl_ListObjIndex(interp, look, 0, &item); if (!strcmp("macintosh", TclGetString(item))) { @@ -1825,7 +1825,7 @@ TclGlob( } } - TclListObjGetElementsM(NULL, filenamesObj, &objc, &objv); + TclListObjGetElements(NULL, filenamesObj, &objc, &objv); for (i = 0; i< objc; i++) { Tcl_Size len; const char *oldStr = Tcl_GetStringFromObj(objv[i], &len); @@ -2152,7 +2152,7 @@ DoGlob( Tcl_Size i, subdirc, repair = -1; Tcl_Obj **subdirv; - result = TclListObjGetElementsM(interp, subdirsPtr, + result = TclListObjGetElements(interp, subdirsPtr, &subdirc, &subdirv); for (i=0; result==TCL_OK && ifsPtr->listVolumesProc(); if (thisFsVolumes != NULL) { - if (TclListObjLengthM(NULL, thisFsVolumes, &numVolumes) + if (TclListObjLength(NULL, thisFsVolumes, &numVolumes) != TCL_OK) { /* * This is VERY bad; the listVolumesProc didn't return a diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index a60093a..e76cca3 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -117,7 +117,7 @@ GetIndexFromObjList( * of the code there. This is a bit inefficient but simpler. */ - result = TclListObjGetElementsM(interp, tableObjPtr, &objc, &objv); + result = TclListObjGetElements(interp, tableObjPtr, &objc, &objv); if (result != TCL_OK) { return result; } @@ -552,7 +552,7 @@ PrefixMatchObjCmd( return TCL_ERROR; } i++; - result = TclListObjLengthM(interp, objv[i], &errorLength); + result = TclListObjLength(interp, objv[i], &errorLength); if (result != TCL_OK) { return TCL_ERROR; } @@ -576,7 +576,7 @@ PrefixMatchObjCmd( * error case regardless of level. */ - result = TclListObjLengthM(interp, tablePtr, &i); + result = TclListObjLength(interp, tablePtr, &i); if (result != TCL_OK) { return result; } @@ -642,7 +642,7 @@ PrefixAllObjCmd( return TCL_ERROR; } - result = TclListObjGetElementsM(interp, objv[1], &tableObjc, &tableObjv); + result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv); if (result != TCL_OK) { return result; } @@ -700,7 +700,7 @@ PrefixLongestObjCmd( return TCL_ERROR; } - result = TclListObjGetElementsM(interp, objv[1], &tableObjc, &tableObjv); + result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv); if (result != TCL_OK) { return result; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 1fa6786..73d7d48 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2709,7 +2709,7 @@ typedef struct ListRep { * Return TCL_OK on success or TCL_ERROR if the Tcl_Obj cannot be * converted to a list. */ -#define TclListObjGetElementsM(interp_, listObj_, objcPtr_, objvPtr_) \ +#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ (((listObj_)->typePtr == &tclListType) \ ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \ TCL_OK) \ @@ -2721,7 +2721,7 @@ typedef struct ListRep { * count in lenPtr_. Returns TCL_OK on success or TCL_ERROR if the * Tcl_Obj cannot be converted to a list. */ -#define TclListObjLengthM(interp_, listObj_, lenPtr_) \ +#define TclListObjLength(interp_, listObj_, lenPtr_) \ (((listObj_)->typePtr == &tclListType) \ ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) diff --git a/generic/tclInterp.c b/generic/tclInterp.c index fa6cf80..67583b8 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -2328,7 +2328,7 @@ GetInterp( Tcl_Interp *searchInterp; /* Interim storage for interp. to find. */ InterpInfo *parentInfoPtr; - if (TclListObjGetElementsM(interp, pathPtr, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) { return NULL; } @@ -2384,7 +2384,7 @@ ChildBgerror( if (objc) { Tcl_Size length; - if (TCL_ERROR == TclListObjLengthM(NULL, objv[0], &length) + if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length) || (length < 1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cmdPrefix must be list of length >= 1", -1)); @@ -2432,7 +2432,7 @@ ChildCreate( Tcl_Size objc; Tcl_Obj **objv; - if (TclListObjGetElementsM(interp, pathPtr, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) { return NULL; } if (objc < 2) { diff --git a/generic/tclLink.c b/generic/tclLink.c index bb7b6ba..dffee68 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -876,7 +876,7 @@ LinkTraceProc( */ if (linkPtr->flags & LINK_ALLOC_LAST) { - if (TclListObjGetElementsM(NULL, (valueObj), &objc, &objv) == TCL_ERROR + if (TclListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR || objc != linkPtr->numElems) { return (char *) "wrong dimension"; } diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 3318152..47273d8 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1711,7 +1711,7 @@ Tcl_ListObjAppendList( Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList"); } - if (TclListObjGetElementsM(interp, fromObj, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, fromObj, &objc, &objv) != TCL_OK) { return TCL_ERROR; } @@ -1963,7 +1963,7 @@ Tcl_ListObjIndex( return TclObjTypeIndex(interp, listObj, index, objPtrPtr); } - if (TclListObjGetElementsM(interp, listObj, &numElems, &elemObjs) + if (TclListObjGetElements(interp, listObj, &numElems, &elemObjs) != TCL_OK) { return TCL_ERROR; } @@ -2609,7 +2609,7 @@ TclLindexList( */ return TclLindexFlat(interp, listObj, 1, &argObj); } - TclListObjGetElementsM(interp, indexListCopy, &numIndexObjs, &indexObjs); + TclListObjGetElements(interp, indexListCopy, &numIndexObjs, &indexObjs); listObj = TclLindexFlat(interp, listObj, numIndexObjs, indexObjs); Tcl_DecrRefCount(indexListCopy); return listObj; @@ -2809,7 +2809,7 @@ TclLsetList( */ retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj); } else { - if (TCL_OK != TclListObjGetElementsM( + if (TCL_OK != TclListObjGetElements( interp, indexListCopy, &indexCount, &indices)) { Tcl_DecrRefCount(indexListCopy); /* @@ -2940,7 +2940,7 @@ TclLsetFlat( * Check for the possible error conditions... */ - if (TclListObjGetElementsM(interp, subListObj, &elemCount, &elemPtrs) + if (TclListObjGetElements(interp, subListObj, &elemCount, &elemPtrs) != TCL_OK) { /* ...the sublist we're indexing into isn't a list at all. */ result = TCL_ERROR; @@ -3098,7 +3098,7 @@ TclLsetFlat( */ len = -1; - TclListObjLengthM(NULL, subListObj, &len); + TclListObjLength(NULL, subListObj, &len); if (valueObj == NULL) { /* T:listrep-1.{4.2,5.4,6.1,7.1,8.3},2.{4,5}.4 */ Tcl_ListObjReplace(NULL, subListObj, index, 1, 0, NULL); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 1e9b182..2268609 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -4083,7 +4083,7 @@ NamespacePathCmd( * There is a path given, so parse it into an array of namespace pointers. */ - if (TclListObjGetElementsM(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) { + if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) { goto badNamespace; } if (nsObjc != 0) { @@ -4451,7 +4451,7 @@ Tcl_SetNamespaceUnknownHandler( */ if (handlerPtr != NULL) { - if (TclListObjLengthM(interp, handlerPtr, &lstlen) != TCL_OK) { + if (TclListObjLength(interp, handlerPtr, &lstlen) != TCL_OK) { /* * Not a list. */ @@ -5027,7 +5027,7 @@ TclLogCommandInfo( Tcl_Size len; iPtr->resetErrorStack = 0; - TclListObjLengthM(interp, iPtr->errorStack, &len); + TclListObjLength(interp, iPtr->errorStack, &len); /* * Reset while keeping the list internalrep as much as possible. @@ -5112,7 +5112,7 @@ TclErrorStackResetIf( Tcl_Size len; iPtr->resetErrorStack = 0; - TclListObjLengthM(interp, iPtr->errorStack, &len); + TclListObjLength(interp, iPtr->errorStack, &len); /* * Reset while keeping the list internalrep as much as possible. diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 1a0bb43..c7298bf 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -1121,7 +1121,7 @@ MagicDefinitionInvoke( Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr); /* TODO: overflow? */ Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc - offset, objv + offset); - TclListObjGetElementsM(NULL, objPtr, &dummy, &objs); + TclListObjGetElements(NULL, objPtr, &dummy, &objs); result = Tcl_EvalObjv(interp, objc - cmdIndex, objs, TCL_EVAL_INVOKE); if (isRoot) { @@ -2428,7 +2428,7 @@ ClassFilterSet( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (void *)NULL); return TCL_ERROR; - } else if (TclListObjGetElementsM(interp, objv[0], &filterc, + } else if (TclListObjGetElements(interp, objv[0], &filterc, &filterv) != TCL_OK) { return TCL_ERROR; } @@ -2517,7 +2517,7 @@ ClassMixinSet( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (void *)NULL); return TCL_ERROR; - } else if (TclListObjGetElementsM(interp, objv[0], &mixinc, + } else if (TclListObjGetElements(interp, objv[0], &mixinc, &mixinv) != TCL_OK) { return TCL_ERROR; } @@ -2638,7 +2638,7 @@ ClassSuperSet( "may not modify the superclass of the root object", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (void *)NULL); return TCL_ERROR; - } else if (TclListObjGetElementsM(interp, objv[0], &superc, + } else if (TclListObjGetElements(interp, objv[0], &superc, &superv) != TCL_OK) { return TCL_ERROR; } @@ -2808,7 +2808,7 @@ ClassVarsSet( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (void *)NULL); return TCL_ERROR; - } else if (TclListObjGetElementsM(interp, objv[0], &varc, + } else if (TclListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; } @@ -2900,7 +2900,7 @@ ObjFilterSet( return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); - if (TclListObjGetElementsM(interp, objv[0], &filterc, + if (TclListObjGetElements(interp, objv[0], &filterc, &filterv) != TCL_OK) { return TCL_ERROR; } @@ -2978,7 +2978,7 @@ ObjMixinSet( return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); - if (TclListObjGetElementsM(interp, objv[0], &mixinc, + if (TclListObjGetElements(interp, objv[0], &mixinc, &mixinv) != TCL_OK) { return TCL_ERROR; } @@ -3081,7 +3081,7 @@ ObjVarsSet( return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); - if (TclListObjGetElementsM(interp, objv[0], &varc, + if (TclListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 4711695..b03bbdb 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -425,7 +425,7 @@ TclOONewProcInstanceMethod( ProcedureMethod *pmPtr; Tcl_Method method; - if (TclListObjLengthM(interp, argsObj, &argsLen) != TCL_OK) { + if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } pmPtr = (ProcedureMethod *)Tcl_Alloc(sizeof(ProcedureMethod)); @@ -483,7 +483,7 @@ TclOONewProcMethod( TclNewObj(argsObj); Tcl_IncrRefCount(argsObj); procName = ""; - } else if (TclListObjLengthM(interp, argsObj, &argsLen) != TCL_OK) { + } else if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } else { procName = (nameObj==NULL ? "" : TclGetString(nameObj)); @@ -1476,7 +1476,7 @@ TclOONewForwardInstanceMethod( Tcl_Size prefixLen; ForwardMethod *fmPtr; - if (TclListObjLengthM(interp, prefixObj, &prefixLen) != TCL_OK) { + if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { @@ -1515,7 +1515,7 @@ TclOONewForwardMethod( Tcl_Size prefixLen; ForwardMethod *fmPtr; - if (TclListObjLengthM(interp, prefixObj, &prefixLen) != TCL_OK) { + if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { @@ -1564,7 +1564,7 @@ InvokeForwardMethod( * can ignore here. */ - TclListObjGetElementsM(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs); + TclListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs); argObjs = InitEnsembleRewrite(interp, objc, objv, skip, numPrefixes, prefixObjs, &len); Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL); diff --git a/generic/tclObj.c b/generic/tclObj.c index 5dd4545..2be7bca 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -858,7 +858,7 @@ Tcl_AppendAllObjTypes( * Get the test for a valid list out of the way first. */ - if (TclListObjLengthM(interp, objPtr, &numElems) != TCL_OK) { + if (TclListObjLength(interp, objPtr, &numElems) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index fbd7879..249e399 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -826,12 +826,12 @@ Tcl_FSJoinPath( Tcl_Size objc; Tcl_Obj **objv; - if (TclListObjLengthM(NULL, listObj, &objc) != TCL_OK) { + if (TclListObjLength(NULL, listObj, &objc) != TCL_OK) { return NULL; } elements = ((elements >= 0) && (elements <= objc)) ? elements : objc; - TclListObjGetElementsM(NULL, listObj, &objc, &objv); + TclListObjGetElements(NULL, listObj, &objc, &objv); res = TclJoinPath(elements, objv, 0); return res; } diff --git a/generic/tclPkg.c b/generic/tclPkg.c index f58293c..fe76cc7 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -1362,7 +1362,7 @@ TclNRPackageObjCmd( objvListPtr = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(objvListPtr); Tcl_ListObjAppendElement(interp, objvListPtr, ov); - TclListObjGetElementsM(interp, objvListPtr, &newobjc, &newObjvPtr); + TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL,NULL); @@ -1389,7 +1389,7 @@ TclNRPackageObjCmd( Tcl_ListObjAppendElement(interp, objvListPtr, Tcl_DuplicateObj(newobjv[i])); } - TclListObjGetElementsM(interp, objvListPtr, &newobjc, &newObjvPtr); + TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL,NULL); Tcl_NRAddCallback(interp, diff --git a/generic/tclProc.c b/generic/tclProc.c index 01c7611..2e424fa 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -488,7 +488,7 @@ TclCreateProc( * in the Proc. */ - result = TclListObjGetElementsM(interp, argsPtr, &numArgs, &argArray); + result = TclListObjGetElements(interp, argsPtr, &numArgs, &argArray); if (result != TCL_OK) { goto procError; } @@ -518,7 +518,7 @@ TclCreateProc( * Now divide the specifier up into name and default. */ - result = TclListObjGetElementsM(interp, argArray[i], &fieldCount, + result = TclListObjGetElements(interp, argArray[i], &fieldCount, &fieldValues); if (result != TCL_OK) { goto procError; @@ -924,7 +924,7 @@ TclNRUplevelObjCmd( } else if (!TclHasStringRep(objv[1]) && objc == 2) { int status; Tcl_Size llength; - status = TclListObjLengthM(interp, objv[1], &llength); + status = TclListObjLength(interp, objv[1], &llength); if (status == TCL_OK && llength > 1) { /* the first argument can't interpreted as a level. Avoid * generating a string representation of the script. */ @@ -2457,7 +2457,7 @@ SetLambdaFromAny( * length is not 2, then it cannot be converted to lambdaType. */ - result = TclListObjLengthM(NULL, objPtr, &objc); + result = TclListObjLength(NULL, objPtr, &objc); if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't interpret \"%s\" as a lambda expression", @@ -2465,7 +2465,7 @@ SetLambdaFromAny( Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (void *)NULL); return TCL_ERROR; } - result = TclListObjGetElementsM(NULL, objPtr, &objc, &objv); + result = TclListObjGetElements(NULL, objPtr, &objc, &objv); if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't interpret \"%s\" as a lambda expression", diff --git a/generic/tclProcess.c b/generic/tclProcess.c index b16c73d..719f2e9 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -524,7 +524,7 @@ ProcessStatusObjCmd( * Only return statuses of provided processes. */ - result = TclListObjGetElementsM(interp, objv[1], &numPids, &pidObjs); + result = TclListObjGetElements(interp, objv[1], &numPids, &pidObjs); if (result != TCL_OK) { return result; } @@ -637,7 +637,7 @@ ProcessPurgeObjCmd( * Purge only provided processes. */ - result = TclListObjGetElementsM(interp, objv[1], &numPids, &pidObjs); + result = TclListObjGetElements(interp, objv[1], &numPids, &pidObjs); if (result != TCL_OK) { return result; } diff --git a/generic/tclResult.c b/generic/tclResult.c index 8ab66ae..9e5d8a2 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -747,12 +747,12 @@ TclProcessReturn( * if someone does [return -errorstack [info errorstack]] */ - if (TclListObjGetElementsM(interp, valuePtr, &valueObjc, + if (TclListObjGetElements(interp, valuePtr, &valueObjc, &valueObjv) == TCL_ERROR) { return TCL_ERROR; } iPtr->resetErrorStack = 0; - TclListObjLengthM(interp, iPtr->errorStack, &len); + TclListObjLength(interp, iPtr->errorStack, &len); /* * Reset while keeping the list internalrep as much as possible. @@ -909,7 +909,7 @@ TclMergeReturnOptions( if (valuePtr != NULL) { Tcl_Size length; - if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length )) { + if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length )) { /* * Value is not a list, which is illegal for -errorcode. */ @@ -931,7 +931,7 @@ TclMergeReturnOptions( if (valuePtr != NULL) { Tcl_Size length; - if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length)) { + if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length)) { /* * Value is not a list, which is illegal for -errorstack. */ @@ -1102,7 +1102,7 @@ Tcl_SetReturnOptions( Tcl_Obj **objv, *mergedOpts; Tcl_IncrRefCount(options); - if (TCL_ERROR == TclListObjGetElementsM(interp, options, &objc, &objv) + if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv) || (objc % 2)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected dict but got \"%s\"", TclGetString(options))); diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index a3bc2d4..4ea590a 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -556,7 +556,7 @@ TclParseNumber( if (TclHasInternalRep(objPtr, &tclListType)) { Tcl_Size length; /* A list can only be a (single) number if its length == 1 */ - TclListObjLengthM(NULL, objPtr, &length); + TclListObjLength(NULL, objPtr, &length); if (length != 1) { return TCL_ERROR; } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index d77a56b..42eaa8d 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -495,7 +495,7 @@ TclCheckEmptyString( } if (TclListObjIsCanonical(objPtr)) { - TclListObjLengthM(NULL, objPtr, &length); + TclListObjLength(NULL, objPtr, &length); return length == 0; } @@ -2862,7 +2862,7 @@ AppendPrintfToObjVA( } } while (seekingConversion); } - TclListObjGetElementsM(NULL, list, &objc, &objv); + TclListObjGetElements(NULL, list, &objc, &objv); code = Tcl_AppendFormatToObj(NULL, objPtr, format, objc, objv); if (code != TCL_OK) { Tcl_AppendPrintfToObj(objPtr, diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index b48ec1b..78c2607 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -87,6 +87,8 @@ #define TclUtfCharComplete Tcl_UtfCharComplete #define TclUtfNext Tcl_UtfNext #define TclUtfPrev Tcl_UtfPrev +#undef TclListObjGetElements +#undef TclListObjLength #if defined(TCL_NO_DEPRECATED) # define TclListObjGetElements 0 @@ -102,7 +104,7 @@ int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr); if (objcPtr) { - if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) { + if ((sizeof(int) != sizeof(Tcl_Size)) && (result == TCL_OK) && (n > INT_MAX)) { if (interp) { Tcl_AppendResult(interp, "List too large to be processed", (void *)NULL); } @@ -117,7 +119,7 @@ int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_ListObjLength(interp, listPtr, &n); if (lengthPtr) { - if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) { + if ((sizeof(int) != sizeof(Tcl_Size)) && (result == TCL_OK) && (n > INT_MAX)) { if (interp) { Tcl_AppendResult(interp, "List too large to be processed", (void *)NULL); } @@ -132,7 +134,7 @@ int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_DictObjSize(interp, dictPtr, &n); if (sizePtr) { - if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) { + if ((sizeof(int) != sizeof(Tcl_Size)) && (result == TCL_OK) && (n > INT_MAX)) { if (interp) { Tcl_AppendResult(interp, "Dict too large to be processed", (void *)NULL); } @@ -147,7 +149,7 @@ int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr, Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_SplitList(interp, listStr, &n, argvPtr); if (argcPtr) { - if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) { + if ((sizeof(int) != sizeof(Tcl_Size)) && (result == TCL_OK) && (n > INT_MAX)) { if (interp) { Tcl_AppendResult(interp, "List too large to be processed", (void *)NULL); } @@ -162,7 +164,7 @@ void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr) { Tcl_Size n = TCL_INDEX_NONE; Tcl_SplitPath(path, &n, argvPtr); if (argcPtr) { - if ((sizeof(int) != sizeof(size_t)) && (n > INT_MAX)) { + if ((sizeof(int) != sizeof(Tcl_Size)) && (n > INT_MAX)) { n = TCL_INDEX_NONE; /* No other way to return an error-situation */ Tcl_Free((void *)*argvPtr); *argvPtr = NULL; @@ -174,7 +176,7 @@ Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr) { Tcl_Size n = TCL_INDEX_NONE; Tcl_Obj *result = Tcl_FSSplitPath(pathPtr, &n); if (lenPtr) { - if ((sizeof(int) != sizeof(size_t)) && result && (n > INT_MAX)) { + if ((sizeof(int) != sizeof(Tcl_Size)) && result && (n > INT_MAX)) { Tcl_DecrRefCount(result); return NULL; } diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 15da56e..0a9e47a 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -310,7 +310,7 @@ TraceExecutionObjCmd( * pointer to its array of element pointers. */ - result = TclListObjLengthM(interp, objv[4], &listLen); + result = TclListObjLength(interp, objv[4], &listLen); if (result != TCL_OK) { return result; } @@ -322,7 +322,7 @@ TraceExecutionObjCmd( (void *)NULL); return TCL_ERROR; } - result = TclListObjGetElementsM(interp, objv[4], &listLen, &elemPtrs); + result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } @@ -483,7 +483,7 @@ TraceExecutionObjCmd( TclNewLiteralStringObj(opObj, "leavestep"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } - TclListObjLengthM(NULL, elemObjPtr, &numOps); + TclListObjLength(NULL, elemObjPtr, &numOps); if (0 == numOps) { Tcl_DecrRefCount(elemObjPtr); continue; @@ -552,7 +552,7 @@ TraceCommandObjCmd( * pointer to its array of element pointers. */ - result = TclListObjLengthM(interp, objv[4], &listLen); + result = TclListObjLength(interp, objv[4], &listLen); if (result != TCL_OK) { return result; } @@ -564,7 +564,7 @@ TraceCommandObjCmd( (void *)NULL); return TCL_ERROR; } - result = TclListObjGetElementsM(interp, objv[4], &listLen, &elemPtrs); + result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } @@ -678,7 +678,7 @@ TraceCommandObjCmd( TclNewLiteralStringObj(opObj, "delete"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } - TclListObjLengthM(NULL, elemObjPtr, &numOps); + TclListObjLength(NULL, elemObjPtr, &numOps); if (0 == numOps) { Tcl_DecrRefCount(elemObjPtr); continue; @@ -751,7 +751,7 @@ TraceVariableObjCmd( * pointer to its array of element pointers. */ - result = TclListObjLengthM(interp, objv[4], &listLen); + result = TclListObjLength(interp, objv[4], &listLen); if (result != TCL_OK) { return result; } @@ -763,7 +763,7 @@ TraceVariableObjCmd( (void *)NULL); return TCL_ERROR; } - result = TclListObjGetElementsM(interp, objv[4], &listLen, &elemPtrs); + result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 05b0599..99d1010 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3533,7 +3533,7 @@ GetEndOffsetFromObj( if ((TclMaxListLength(bytes, TCL_INDEX_NONE, NULL) > 1) /* If it's possible, do the full list parse. */ - && (TCL_OK == TclListObjLengthM(NULL, objPtr, &length)) + && (TCL_OK == TclListObjLength(NULL, objPtr, &length)) && (length > 1)) { goto parseError; } diff --git a/generic/tclVar.c b/generic/tclVar.c index 1bd5107..9f1fbbf 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -2891,7 +2891,7 @@ Tcl_LappendObjCmd( return TCL_ERROR; } } else { - result = TclListObjLengthM(interp, newValuePtr, &numElems); + result = TclListObjLength(interp, newValuePtr, &numElems); if (result != TCL_OK) { return result; } @@ -2949,7 +2949,7 @@ Tcl_LappendObjCmd( createdNewObj = 1; } - result = TclListObjLengthM(interp, varValuePtr, &numElems); + result = TclListObjLength(interp, varValuePtr, &numElems); if (result == TCL_OK) { result = Tcl_ListObjReplace(interp, varValuePtr, numElems, 0, (objc-2), (objv+2)); @@ -3102,7 +3102,7 @@ ArrayForNRCmd( * Parse arguments. */ - if (TclListObjLengthM(interp, objv[1], &numVars) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &numVars) != TCL_OK) { return TCL_ERROR; } @@ -3217,7 +3217,7 @@ ArrayForLoopCallback( goto arrayfordone; } - result = TclListObjGetElementsM(NULL, varListObj, &varc, &varv); + result = TclListObjGetElements(NULL, varListObj, &varc, &varv); if (result != TCL_OK) { goto arrayfordone; } @@ -3761,7 +3761,7 @@ ArrayGetCmd( */ TclNewObj(tmpResObj); - result = TclListObjGetElementsM(interp, nameLstObj, &count, &nameObjPtr); + result = TclListObjGetElements(interp, nameLstObj, &count, &nameObjPtr); if (result != TCL_OK) { goto errorInArrayGet; } @@ -4086,7 +4086,7 @@ ArraySetCmd( Tcl_Obj **elemPtrs, *copyListObj; Tcl_Size i; - result = TclListObjLengthM(interp, arrayElemObj, &elemLen); + result = TclListObjLength(interp, arrayElemObj, &elemLen); if (result != TCL_OK) { return result; } @@ -4099,7 +4099,7 @@ ArraySetCmd( if (elemLen == 0) { goto ensureArray; } - result = TclListObjGetElementsM(interp, arrayElemObj, + result = TclListObjGetElements(interp, arrayElemObj, &elemLen, &elemPtrs); if (result != TCL_OK) { return result; diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 8f91703..d9e6299 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -3383,7 +3383,7 @@ ZipFSMkZipOrImg( } } Tcl_IncrRefCount(list); - if (TclListObjLengthM(interp, list, &lobjc) != TCL_OK) { + if (TclListObjLength(interp, list, &lobjc) != TCL_OK) { Tcl_DecrRefCount(list); return TCL_ERROR; } @@ -3399,7 +3399,7 @@ ZipFSMkZipOrImg( ZIPFS_ERROR_CODE(interp, "EMPTY"); return TCL_ERROR; } - if (TclListObjGetElementsM(interp, list, &lobjc, &lobjv) != TCL_OK) { + if (TclListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) { Tcl_DecrRefCount(list); return TCL_ERROR; } diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 8ec9303..0afe9ea 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -1410,7 +1410,7 @@ Tcl_ZlibStreamGet( Tcl_DecrRefCount(zshPtr->currentInput); zshPtr->currentInput = NULL; } - TclListObjLengthM(NULL, zshPtr->inData, &listLen); + TclListObjLength(NULL, zshPtr->inData, &listLen); if (listLen > 0) { /* * There is more input available, get it from the list and @@ -1459,7 +1459,7 @@ Tcl_ZlibStreamGet( e = inflate(&zshPtr->stream, zshPtr->flush); } }; - TclListObjLengthM(NULL, zshPtr->inData, &listLen); + TclListObjLength(NULL, zshPtr->inData, &listLen); while ((zshPtr->stream.avail_out > 0) && (e == Z_OK || e == Z_BUF_ERROR) && (listLen > 0)) { @@ -1539,7 +1539,7 @@ Tcl_ZlibStreamGet( inflateEnd(&zshPtr->stream); } } else { - TclListObjLengthM(NULL, zshPtr->outData, &listLen); + TclListObjLength(NULL, zshPtr->outData, &listLen); if (count < 0) { count = 0; for (i=0; i dataPos) && - (TclListObjLengthM(NULL, zshPtr->outData, &listLen) == TCL_OK) + (TclListObjLength(NULL, zshPtr->outData, &listLen) == TCL_OK) && (listLen > 0)) { /* * Get the next chunk off our list of chunks and grab the data out -- cgit v0.12 From cca3bf7b4ee172de172d1bf91a147f3fe8aa9b2c Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 12 Mar 2024 21:39:39 +0000 Subject: small amend (forgotten TclListObjGetElementsM -> TclListObjGetElements) --- generic/tclClock.c | 2 +- generic/tclClockFmt.c | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 9b3e60e..1ba93b5 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -2164,7 +2164,7 @@ ConvertUTCToLocal( if (dataPtr->gmtTZName == NULL) { Tcl_Obj *tzName; tzdata = ClockGetTZData(clientData, interp, timezoneObj); - if ( TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK + if ( TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK || Tcl_ListObjIndex(interp, rowv[0], 3, &tzName) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index e46043a..c216d34 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -1122,7 +1122,7 @@ LocaleListSearch(ClockFmtScnCmdArgs *opts, } /* is a list */ - if (TclListObjGetElementsM(opts->interp, valObj, &lstc, &lstv) != TCL_OK) { + if (TclListObjGetElements(opts->interp, valObj, &lstc, &lstv) != TCL_OK) { return TCL_ERROR; } @@ -1181,7 +1181,7 @@ ClockMCGetListIdxTree( goto done; } - if (TclListObjGetElementsM(opts->interp, valObj, + if (TclListObjGetElements(opts->interp, valObj, &lstc, &lstv) != TCL_OK) { goto done; }; @@ -1256,7 +1256,7 @@ ClockMCGetMultiListIdxTree( goto done; } - if (TclListObjGetElementsM(opts->interp, valObj, + if (TclListObjGetElements(opts->interp, valObj, &lstc, &lstv) != TCL_OK) { goto done; }; @@ -2825,7 +2825,7 @@ ClockFmtToken_LocaleERAYear_Proc( if (mcObj == NULL) { return TCL_ERROR; } - if (TclListObjGetElementsM(opts->interp, mcObj, &rowc, &rowv) != TCL_OK) { + if (TclListObjGetElements(opts->interp, mcObj, &rowc, &rowv) != TCL_OK) { return TCL_ERROR; } if (rowc != 0) { -- cgit v0.12 From 13c4e8ff8799b70ec0364f10cc23946f3fc160a7 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 12 Mar 2024 21:44:21 +0000 Subject: fixes [1acd172c424b57c9]: restored ensemble compilation, fixed TCL_ENSEMBLE_PREFIX (restores default), fixed compiled INST_INVOKE_REPLACE for ensembles by CMD_COMPILE_TO_INVOKED flag --- generic/tclClock.c | 48 ++++++++++++++++++++++++++++++++---------------- generic/tclEnsemble.c | 48 ++++++++++++++++++++++++++++++++---------------- generic/tclInt.h | 3 +++ 3 files changed, 67 insertions(+), 32 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 1ba93b5..b7ca81c 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -133,28 +133,43 @@ struct ClockCommand { * will always have the ClockClientData sent * to it, but may well ignore this data. */ CompileProc *compileProc; /* The compiler for the command. */ - void *clientData; /* Any clientData to give the command (if NULL + void *clientData; /* Any clientData to give the command (if NULL * a reference to ClockClientData will be sent) */ + int compFlags; /* Command compile flags */ }; static const struct ClockCommand clockCommands[] = { - {"add", ClockAddObjCmd, TclCompileBasicMin1ArgCmd, NULL}, - {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL}, - {"format", ClockFormatObjCmd, TclCompileBasicMin1ArgCmd, NULL}, - {"getenv", ClockGetenvObjCmd, TclCompileBasicMin1ArgCmd, NULL}, - {"microseconds", ClockMicrosecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(1)}, - {"milliseconds", ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(2)}, - {"scan", ClockScanObjCmd, TclCompileBasicMin1ArgCmd, NULL}, - {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, INT2PTR(3)}, - {"configure", ClockConfigureObjCmd, NULL, NULL}, - {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd, NULL, NULL}, - {"GetDateFields", ClockGetdatefieldsObjCmd, NULL, NULL}, + {"add", ClockAddObjCmd, TclCompileBasicMin1ArgCmd, NULL, + CMD_COMPILE_TO_INVOKED}, + {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL, + 0}, + {"format", ClockFormatObjCmd, TclCompileBasicMin1ArgCmd, NULL, + CMD_COMPILE_TO_INVOKED}, + {"getenv", ClockGetenvObjCmd, TclCompileBasicMin1ArgCmd, NULL, + 0}, + {"microseconds", ClockMicrosecondsObjCmd,TclCompileClockReadingCmd,INT2PTR(1), + 0}, + {"milliseconds", ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(2), + 0}, + {"scan", ClockScanObjCmd, TclCompileBasicMin1ArgCmd, NULL, + CMD_COMPILE_TO_INVOKED}, + {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, INT2PTR(3), + 0}, + {"configure", ClockConfigureObjCmd, NULL, NULL, + CMD_COMPILE_TO_INVOKED}, + {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd, NULL, NULL, + 0}, + {"GetDateFields", ClockGetdatefieldsObjCmd, NULL, NULL, + 0}, {"GetJulianDayFromEraYearMonthDay", - ClockGetjuliandayfromerayearmonthdayObjCmd, NULL, NULL}, + ClockGetjuliandayfromerayearmonthdayObjCmd, NULL, NULL, + 0}, {"GetJulianDayFromEraYearWeekDay", - ClockGetjuliandayfromerayearweekdayObjCmd, NULL, NULL}, - {"catch", ClockSafeCatchCmd, TclCompileBasicMin1ArgCmd, NULL}, - {NULL, NULL, NULL, NULL} + ClockGetjuliandayfromerayearweekdayObjCmd, NULL, NULL, + 0}, + {"catch", ClockSafeCatchCmd, TclCompileBasicMin1ArgCmd, NULL, + 0}, + {NULL, NULL, NULL, NULL, 0} }; /* @@ -266,6 +281,7 @@ TclClockInit( clockCmdPtr->clientData ? NULL : ClockDeleteCmdProc); cmdPtr->compileProc = clockCmdPtr->compileProc ? clockCmdPtr->compileProc : TclCompileBasicMin0ArgCmd; + cmdPtr->flags |= clockCmdPtr->compFlags; } } diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index ad6ced3..2ae966f 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -196,7 +196,7 @@ TclNamespaceEnsembleCmd( */ Tcl_Obj *subcmdObj = NULL; Tcl_Obj *mapObj = NULL; - int permitPrefix = 1; + int ensFlags = TCL_ENSEMBLE_PREFIX; Tcl_Obj *unknownObj = NULL; Tcl_Obj *paramObj = NULL; @@ -330,7 +330,8 @@ TclNamespaceEnsembleCmd( } continue; } - case CRT_PREFIX: + case CRT_PREFIX: { + int permitPrefix; if (Tcl_GetBooleanFromObj(interp, objv[1], &permitPrefix) != TCL_OK) { if (allocatedMapFlag) { @@ -338,7 +339,10 @@ TclNamespaceEnsembleCmd( } return TCL_ERROR; } + ensFlags &= ~TCL_ENSEMBLE_PREFIX; + ensFlags |= permitPrefix ? TCL_ENSEMBLE_PREFIX : 0; continue; + } case CRT_UNKNOWN: if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { if (allocatedMapFlag) { @@ -356,6 +360,15 @@ TclNamespaceEnsembleCmd( &actualCxtPtr, &simpleName); /* + * Ensemble should be compiled if it has map (performance purposes) + * Currently only for internal using namespace (like ::tcl::clock). + * (An enhancement for completelly compile-feature is in work.) + */ + if (mapObj != NULL && strncmp("::tcl::", nsPtr->fullName, 7) == 0) { + ensFlags |= ENSEMBLE_COMPILE; + } + + /* * Create the ensemble. Note that this might delete another ensemble * linked to the same namespace, so we must be careful. However, we * should be OK because we only link the namespace into the list once @@ -364,7 +377,7 @@ TclNamespaceEnsembleCmd( token = TclCreateEnsembleInNs(interp, simpleName, (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, - (permitPrefix ? TCL_ENSEMBLE_PREFIX : 0)); + ensFlags); Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj); Tcl_SetEnsembleMappingDict(interp, token, mapObj); Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj); @@ -2934,14 +2947,14 @@ TclCompileEnsemble( TclNewObj(replaced); Tcl_IncrRefCount(replaced); if (parsePtr->numWords <= depth) { - goto failed; + goto tryCompileToInv; } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { /* * Too hard. */ - goto failed; + goto tryCompileToInv; } /* @@ -2966,7 +2979,7 @@ TclCompileEnsemble( * to proceed. */ - goto failed; + goto tryCompileToInv; } /* @@ -2980,7 +2993,7 @@ TclCompileEnsemble( * Figuring out how to compile this has become too much. Bail out. */ - goto failed; + goto tryCompileToInv; } /* @@ -3003,7 +3016,7 @@ TclCompileEnsemble( Tcl_Obj *matchObj = NULL; if (TclListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) { - goto failed; + goto tryCompileToInv; } for (i=0 ; iflags & CMD_COMPILE_TO_INVOKED) { + goto tryCompileToInv; + } /* * See whether we have a nested ensemble. If we do, we can go round the * mulberry bush again, consuming the next word. @@ -3211,7 +3227,7 @@ TclCompileEnsemble( * instead of going through the ensemble lookup process again. */ - failed: + tryCompileToInv: if (depth < 250) { if (depth > 1) { if (!invokeAnyway) { diff --git a/generic/tclInt.h b/generic/tclInt.h index d3e8989..d218a20 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1850,6 +1850,8 @@ typedef struct Command { * CMD_COMPILES_EXPANDED - If 1 this command has a compiler that * can handle expansion (provided it is not the * first word). + * CMD_COMPILE_TO_INVOKED - If 1 this command prefers a compilation with + * INST_INVOKE_REPLACE (in ensemble only). * TCL_TRACE_RENAME - A rename trace is in progress. Further * recursive renames will not be traced. * TCL_TRACE_DELETE - A delete trace is in progress. Further @@ -1864,6 +1866,7 @@ typedef struct Command { #define CMD_REDEF_IN_PROGRESS 0x10 #define CMD_VIA_RESOLVER 0x20 #define CMD_DEAD 0x40 +#define CMD_COMPILE_TO_INVOKED 0x80 /* -- cgit v0.12 From 0deff67df490658e3baa4f2098562de0538b61a6 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 13 Mar 2024 00:01:26 +0000 Subject: partially revert f665afd65ee7a5f9 (INST_INVOKE_REPLACE/CMD_COMPILE_TO_INVOKED), ensemble compiled in configure -init-complete (only for clock) --- generic/tclClock.c | 95 +++++++++++++++++++++++++++------------------------ generic/tclEnsemble.c | 48 +++++++++----------------- generic/tclInt.h | 3 -- library/init.tcl | 21 ++++++------ 4 files changed, 78 insertions(+), 89 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index b7ca81c..cc990a6 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -133,43 +133,28 @@ struct ClockCommand { * will always have the ClockClientData sent * to it, but may well ignore this data. */ CompileProc *compileProc; /* The compiler for the command. */ - void *clientData; /* Any clientData to give the command (if NULL + void *clientData; /* Any clientData to give the command (if NULL * a reference to ClockClientData will be sent) */ - int compFlags; /* Command compile flags */ }; static const struct ClockCommand clockCommands[] = { - {"add", ClockAddObjCmd, TclCompileBasicMin1ArgCmd, NULL, - CMD_COMPILE_TO_INVOKED}, - {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL, - 0}, - {"format", ClockFormatObjCmd, TclCompileBasicMin1ArgCmd, NULL, - CMD_COMPILE_TO_INVOKED}, - {"getenv", ClockGetenvObjCmd, TclCompileBasicMin1ArgCmd, NULL, - 0}, - {"microseconds", ClockMicrosecondsObjCmd,TclCompileClockReadingCmd,INT2PTR(1), - 0}, - {"milliseconds", ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(2), - 0}, - {"scan", ClockScanObjCmd, TclCompileBasicMin1ArgCmd, NULL, - CMD_COMPILE_TO_INVOKED}, - {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, INT2PTR(3), - 0}, - {"configure", ClockConfigureObjCmd, NULL, NULL, - CMD_COMPILE_TO_INVOKED}, - {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd, NULL, NULL, - 0}, - {"GetDateFields", ClockGetdatefieldsObjCmd, NULL, NULL, - 0}, + {"add", ClockAddObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL}, + {"format", ClockFormatObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"getenv", ClockGetenvObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"microseconds", ClockMicrosecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(1)}, + {"milliseconds", ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(2)}, + {"scan", ClockScanObjCmd, TclCompileBasicMin1ArgCmd, NULL}, + {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, INT2PTR(3)}, + {"configure", ClockConfigureObjCmd, NULL, NULL}, + {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd, NULL, NULL}, + {"GetDateFields", ClockGetdatefieldsObjCmd, NULL, NULL}, {"GetJulianDayFromEraYearMonthDay", - ClockGetjuliandayfromerayearmonthdayObjCmd, NULL, NULL, - 0}, + ClockGetjuliandayfromerayearmonthdayObjCmd, NULL, NULL}, {"GetJulianDayFromEraYearWeekDay", - ClockGetjuliandayfromerayearweekdayObjCmd, NULL, NULL, - 0}, - {"catch", ClockSafeCatchCmd, TclCompileBasicMin1ArgCmd, NULL, - 0}, - {NULL, NULL, NULL, NULL, 0} + ClockGetjuliandayfromerayearweekdayObjCmd, NULL, NULL}, + {"catch", ClockSafeCatchCmd, TclCompileBasicMin1ArgCmd, NULL}, + {NULL, NULL, NULL, NULL} }; /* @@ -281,7 +266,6 @@ TclClockInit( clockCmdPtr->clientData ? NULL : ClockDeleteCmdProc); cmdPtr->compileProc = clockCmdPtr->compileProc ? clockCmdPtr->compileProc : TclCompileBasicMin0ArgCmd; - cmdPtr->flags |= clockCmdPtr->compFlags; } } @@ -983,13 +967,15 @@ ClockConfigureObjCmd( "-clear", "-year-century", "-century-switch", "-min-year", "-max-year", "-max-jdn", "-validate", + "-init-complete", NULL }; enum optionInd { CLOCK_SYSTEM_TZ, CLOCK_SETUP_TZ, CLOCK_DEFAULT_LOCALE, CLOCK_CURRENT_LOCALE, CLOCK_CLEAR_CACHE, CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH, - CLOCK_MIN_YEAR, CLOCK_MAX_YEAR, CLOCK_MAX_JDN, CLOCK_VALIDATE + CLOCK_MIN_YEAR, CLOCK_MAX_YEAR, CLOCK_MAX_JDN, CLOCK_VALIDATE, + CLOCK_INIT_COMPLETE }; int optionIndex; /* Index of an option. */ int i; @@ -1153,6 +1139,27 @@ ClockConfigureObjCmd( case CLOCK_CLEAR_CACHE: ClockConfigureClear(dataPtr); break; + case CLOCK_INIT_COMPLETE: + { + /* + * Init completed. + * Compile clock ensemble (performance purposes). + */ + Tcl_Command token = Tcl_FindCommand(interp, "::clock", + NULL, TCL_GLOBAL_ONLY); + if (!token) { + return TCL_ERROR; + } + int ensFlags = 0; + if (Tcl_GetEnsembleFlags(interp, token, &ensFlags) != TCL_OK) { + return TCL_ERROR; + } + ensFlags |= ENSEMBLE_COMPILE; + if (Tcl_SetEnsembleFlags(interp, token, ensFlags) != TCL_OK) { + return TCL_ERROR; + } + } + break; } } @@ -3157,7 +3164,7 @@ ClockClicksObjCmd( } break; default: - Tcl_WrongNumArgs(interp, 1, objv, "?-switch?"); + Tcl_WrongNumArgs(interp, 0, objv, "clock clicks ?-switch?"); return TCL_ERROR; } @@ -3211,7 +3218,7 @@ ClockMillisecondsObjCmd( Tcl_Obj *timeObj; if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, NULL); + Tcl_WrongNumArgs(interp, 0, objv, "clock milliseconds"); return TCL_ERROR; } Tcl_GetTime(&now); @@ -3247,7 +3254,7 @@ ClockMicrosecondsObjCmd( Tcl_Obj *const *objv) /* Parameter values */ { if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, NULL); + Tcl_WrongNumArgs(interp, 0, objv, "clock microseconds"); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds())); @@ -3545,7 +3552,7 @@ ClockFormatObjCmd( { ClockClientData *dataPtr = (ClockClientData *)clientData; - static const char *syntax = "clockval|-now " + static const char *syntax = "clock format clockval|-now " "?-format string? " "?-gmt boolean? " "?-locale LOCALE? ?-timezone ZONE?"; @@ -3555,7 +3562,7 @@ ClockFormatObjCmd( /* even number of arguments */ if ((objc & 1) == 1) { - Tcl_WrongNumArgs(interp, 1, objv, syntax); + Tcl_WrongNumArgs(interp, 0, objv, syntax); Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", (char *)NULL); return TCL_ERROR; } @@ -3620,7 +3627,7 @@ ClockScanObjCmd( int objc, /* Parameter count */ Tcl_Obj *const objv[]) /* Parameter values */ { - static const char *syntax = "string " + static const char *syntax = "clock scan string " "?-base seconds? " "?-format string? " "?-gmt boolean? " @@ -3632,7 +3639,7 @@ ClockScanObjCmd( /* even number of arguments */ if ((objc & 1) == 1) { - Tcl_WrongNumArgs(interp, 1, objv, syntax); + Tcl_WrongNumArgs(interp, 0, objv, syntax); Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", (char *)NULL); return TCL_ERROR; } @@ -4365,7 +4372,7 @@ ClockAddObjCmd( int objc, /* Parameter count */ Tcl_Obj *const objv[]) /* Parameter values */ { - static const char *syntax = "clockval|-now ?number units?..." + static const char *syntax = "clock add clockval|-now ?number units?..." "?-gmt boolean? " "?-locale LOCALE? ?-timezone ZONE?"; ClockClientData *dataPtr = (ClockClientData *)clientData; @@ -4392,7 +4399,7 @@ ClockAddObjCmd( /* even number of arguments */ if ((objc & 1) == 1) { - Tcl_WrongNumArgs(interp, 1, objv, syntax); + Tcl_WrongNumArgs(interp, 0, objv, syntax); Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", (char *)NULL); return TCL_ERROR; } @@ -4405,7 +4412,7 @@ ClockAddObjCmd( ClockInitFmtScnArgs(clientData, interp, &opts); ret = ClockParseFmtScnArgs(&opts, &yy.date, objc, objv, - CLC_ADD_ARGS, syntax); + CLC_ADD_ARGS, "-gmt, -locale, or -timezone"); if (ret != TCL_OK) { goto done; } @@ -4551,7 +4558,7 @@ ClockSecondsObjCmd( Tcl_Obj *timeObj; if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, NULL); + Tcl_WrongNumArgs(interp, 0, objv, "clock seconds"); return TCL_ERROR; } Tcl_GetTime(&now); diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 2ae966f..ad6ced3 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -196,7 +196,7 @@ TclNamespaceEnsembleCmd( */ Tcl_Obj *subcmdObj = NULL; Tcl_Obj *mapObj = NULL; - int ensFlags = TCL_ENSEMBLE_PREFIX; + int permitPrefix = 1; Tcl_Obj *unknownObj = NULL; Tcl_Obj *paramObj = NULL; @@ -330,8 +330,7 @@ TclNamespaceEnsembleCmd( } continue; } - case CRT_PREFIX: { - int permitPrefix; + case CRT_PREFIX: if (Tcl_GetBooleanFromObj(interp, objv[1], &permitPrefix) != TCL_OK) { if (allocatedMapFlag) { @@ -339,10 +338,7 @@ TclNamespaceEnsembleCmd( } return TCL_ERROR; } - ensFlags &= ~TCL_ENSEMBLE_PREFIX; - ensFlags |= permitPrefix ? TCL_ENSEMBLE_PREFIX : 0; continue; - } case CRT_UNKNOWN: if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { if (allocatedMapFlag) { @@ -360,15 +356,6 @@ TclNamespaceEnsembleCmd( &actualCxtPtr, &simpleName); /* - * Ensemble should be compiled if it has map (performance purposes) - * Currently only for internal using namespace (like ::tcl::clock). - * (An enhancement for completelly compile-feature is in work.) - */ - if (mapObj != NULL && strncmp("::tcl::", nsPtr->fullName, 7) == 0) { - ensFlags |= ENSEMBLE_COMPILE; - } - - /* * Create the ensemble. Note that this might delete another ensemble * linked to the same namespace, so we must be careful. However, we * should be OK because we only link the namespace into the list once @@ -377,7 +364,7 @@ TclNamespaceEnsembleCmd( token = TclCreateEnsembleInNs(interp, simpleName, (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, - ensFlags); + (permitPrefix ? TCL_ENSEMBLE_PREFIX : 0)); Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj); Tcl_SetEnsembleMappingDict(interp, token, mapObj); Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj); @@ -2947,14 +2934,14 @@ TclCompileEnsemble( TclNewObj(replaced); Tcl_IncrRefCount(replaced); if (parsePtr->numWords <= depth) { - goto tryCompileToInv; + goto failed; } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { /* * Too hard. */ - goto tryCompileToInv; + goto failed; } /* @@ -2979,7 +2966,7 @@ TclCompileEnsemble( * to proceed. */ - goto tryCompileToInv; + goto failed; } /* @@ -2993,7 +2980,7 @@ TclCompileEnsemble( * Figuring out how to compile this has become too much. Bail out. */ - goto tryCompileToInv; + goto failed; } /* @@ -3016,7 +3003,7 @@ TclCompileEnsemble( Tcl_Obj *matchObj = NULL; if (TclListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) { - goto tryCompileToInv; + goto failed; } for (i=0 ; iflags & CMD_COMPILE_TO_INVOKED) { - goto tryCompileToInv; - } /* * See whether we have a nested ensemble. If we do, we can go round the * mulberry bush again, consuming the next word. @@ -3227,7 +3211,7 @@ TclCompileEnsemble( * instead of going through the ensemble lookup process again. */ - tryCompileToInv: + failed: if (depth < 250) { if (depth > 1) { if (!invokeAnyway) { diff --git a/generic/tclInt.h b/generic/tclInt.h index d218a20..d3e8989 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1850,8 +1850,6 @@ typedef struct Command { * CMD_COMPILES_EXPANDED - If 1 this command has a compiler that * can handle expansion (provided it is not the * first word). - * CMD_COMPILE_TO_INVOKED - If 1 this command prefers a compilation with - * INST_INVOKE_REPLACE (in ensemble only). * TCL_TRACE_RENAME - A rename trace is in progress. Further * recursive renames will not be traced. * TCL_TRACE_DELETE - A delete trace is in progress. Further @@ -1866,7 +1864,6 @@ typedef struct Command { #define CMD_REDEF_IN_PROGRESS 0x10 #define CMD_VIA_RESOLVER 0x20 #define CMD_DEAD 0x40 -#define CMD_COMPILE_TO_INVOKED 0x80 /* diff --git a/library/init.tcl b/library/init.tcl index 5eb5dfc..9306986 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -117,19 +117,20 @@ if {[interp issafe]} { namespace inscope ::tcl::clock [list namespace ensemble create -command \ [uplevel 1 [list ::namespace origin [::lindex [info level 0] 0]]] \ -map $cmdmap] + ::tcl::clock::configure -init-complete - uplevel 1 [info level 0] - } - - # Auto-loading stubs for 'clock.tcl' + # Auto-loading stubs for 'clock.tcl' - namespace eval ::tcl::clock { - proc _load_stubs args { - namespace unknown {} - ::source -encoding utf-8 [::file join [info library] clock.tcl] - tailcall {*}$args + namespace inscope ::tcl::clock { + proc _load_stubs args { + namespace unknown {} + ::source -encoding utf-8 [::file join [info library] clock.tcl] + tailcall {*}$args + } + namespace unknown ::tcl::clock::_load_stubs } - namespace unknown ::tcl::clock::_load_stubs + + uplevel 1 [info level 0] } } -- cgit v0.12 From be7af4fdd8c735a96be158ce3eb605c6e76038f2 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 13 Mar 2024 01:03:10 +0000 Subject: compat regression test: original clock ensemble supports prefixes --- tests/clock.test | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/clock.test b/tests/clock.test index 3cfba06..d283e16 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -348,6 +348,10 @@ test clock-1.7 "clock format - option abbreviations" { clock format 0 -g true -f "%Y-%m-%d" } 1970-01-01 +test clock-1.7.1 "clock format - command abbreviations (compat regression test)" { + clock f 0 -g 1 -f "%Y-%m-%d" +} 1970-01-01 + test clock-1.8 "clock format -now" { # give one second more for test (if on boundary of the current second): set n [clock format [clock seconds] -g 1 -f "%s"] -- cgit v0.12 From e7db5a264a6b3e96499e10110efa0d95f1ab062d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 13 Mar 2024 09:45:57 +0000 Subject: Restore TclListObjLength()/TclListObjGetElements() macro's, as they were in 8.6 --- generic/tclAssembly.c | 4 +-- generic/tclBasic.c | 14 ++++---- generic/tclBinary.c | 6 ++-- generic/tclClock.c | 8 ++--- generic/tclCmdAH.c | 8 ++--- generic/tclCmdIL.c | 42 +++++++++++----------- generic/tclCmdMZ.c | 28 +++++++-------- generic/tclCompCmds.c | 6 ++-- generic/tclCompCmdsSZ.c | 12 +++---- generic/tclCompExpr.c | 4 +-- generic/tclDictObj.c | 18 +++++----- generic/tclDisassemble.c | 2 +- generic/tclEncoding.c | 14 ++++---- generic/tclEnsemble.c | 40 ++++++++++----------- generic/tclEvent.c | 2 +- generic/tclExecute.c | 42 +++++++++++----------- generic/tclFCmd.c | 2 +- generic/tclFileName.c | 18 +++++----- generic/tclIO.c | 2 +- generic/tclIOGT.c | 2 +- generic/tclIORChan.c | 10 +++--- generic/tclIORTrans.c | 6 ++-- generic/tclIOUtil.c | 12 +++---- generic/tclIndexObj.c | 10 +++--- generic/tclInt.h | 8 ++--- generic/tclInterp.c | 6 ++-- generic/tclLink.c | 2 +- generic/tclListObj.c | 12 +++---- generic/tclNamesp.c | 8 ++--- generic/tclOODefineCmds.c | 16 ++++----- generic/tclOOMethod.c | 10 +++--- generic/tclObj.c | 2 +- generic/tclPathObj.c | 6 ++-- generic/tclPkg.c | 4 +-- generic/tclProc.c | 10 +++--- generic/tclProcess.c | 4 +-- generic/tclResult.c | 10 +++--- generic/tclStrToD.c | 2 +- generic/tclStringObj.c | 4 +-- generic/tclTrace.c | 16 ++++----- generic/tclUtil.c | 2 +- generic/tclVar.c | 14 ++++---- generic/tclZipfs.c | 89 ++++++++++++++++++++++++----------------------- generic/tclZlib.c | 67 ++++++++++++++++++++--------------- 44 files changed, 307 insertions(+), 297 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index e7ce6e6..61eb319 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -1985,7 +1985,7 @@ CreateMirrorJumpTable( * table. */ int i; - if (TclListObjLengthM(interp, jumps, &objc) != TCL_OK) { + if (TclListObjLength(interp, jumps, &objc) != TCL_OK) { return TCL_ERROR; } if (objc % 2 != 0) { @@ -1997,7 +1997,7 @@ CreateMirrorJumpTable( } return TCL_ERROR; } - if (TclListObjGetElementsM(interp, jumps, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 509e63c..09839d7 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -5250,7 +5250,7 @@ TEOV_NotFound( * itself. */ - TclListObjGetElementsM(NULL, currNsPtr->unknownHandlerPtr, + TclListObjGetElements(NULL, currNsPtr->unknownHandlerPtr, &handlerObjc, &handlerObjv); newObjc = objc + handlerObjc; newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc); @@ -5809,7 +5809,7 @@ TclEvalEx( if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { Tcl_Size numElements; - code = TclListObjLengthM(interp, objv[objectsUsed], + code = TclListObjLength(interp, objv[objectsUsed], &numElements); if (code == TCL_ERROR) { /* @@ -5861,7 +5861,7 @@ TclEvalEx( Tcl_Size numElements; Tcl_Obj **elements, *temp = copy[wordIdx]; - TclListObjGetElementsM(NULL, temp, &numElements, + TclListObjGetElements(NULL, temp, &numElements, &elements); objectsUsed += numElements; while (numElements--) { @@ -6702,7 +6702,7 @@ TclNREvalObjEx( TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, objPtr, NULL); - TclListObjGetElementsM(NULL, listPtr, &objc, &objv); + TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, flags, NULL); } @@ -9473,7 +9473,7 @@ TclNRTailcallEval( Tcl_Size objc; Tcl_Obj **objv; - TclListObjGetElementsM(interp, listPtr, &objc, &objv); + TclListObjGetElements(interp, listPtr, &objc, &objv); nsObjPtr = objv[0]; if (result == TCL_OK) { @@ -9903,7 +9903,7 @@ TclNREvalList( TclMarkTailcall(interp); TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); - TclListObjGetElementsM(NULL, listPtr, &objc, &objv); + TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } @@ -10190,7 +10190,7 @@ InjectHandler( TclMarkTailcall(interp); TclNRAddCallback(interp, InjectHandlerPostCall, corPtr, listPtr, INT2PTR(nargs), isProbe); - TclListObjGetElementsM(NULL, listPtr, &objc, &objv); + TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 8b282f3..8be4b75 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -1060,7 +1060,7 @@ BinaryFormatCmd( * The macro evals its args more than once: avoid arg++ */ - if (TclListObjLengthM(interp, objv[arg], &listc + if (TclListObjLength(interp, objv[arg], &listc ) != TCL_OK) { return TCL_ERROR; } @@ -1073,7 +1073,7 @@ BinaryFormatCmd( -1)); return TCL_ERROR; } - if (TclListObjGetElementsM(interp, objv[arg], &listc, + if (TclListObjGetElements(interp, objv[arg], &listc, &listv) != TCL_OK) { return TCL_ERROR; } @@ -1346,7 +1346,7 @@ BinaryFormatCmd( listc = 1; count = 1; } else { - TclListObjGetElementsM(interp, objv[arg], &listc, &listv); + TclListObjGetElements(interp, objv[arg], &listc, &listv); if (count == BINARY_ALL) { count = listc; } diff --git a/generic/tclClock.c b/generic/tclClock.c index 0b17c55..dee6253 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -732,7 +732,7 @@ ConvertLocalToUTC( * Unpack the tz data. */ - if (TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK) { + if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) { return TCL_ERROR; } @@ -797,7 +797,7 @@ ConvertLocalToUTCUsingTable( while (!found) { row = LookupLastTransition(interp, fields->seconds, rowc, rowv); if ((row == NULL) - || TclListObjGetElementsM(interp, row, &cellc, + || TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK || TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) { @@ -935,7 +935,7 @@ ConvertUTCToLocal( * Unpack the tz data. */ - if (TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK) { + if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) { return TCL_ERROR; } @@ -987,7 +987,7 @@ ConvertUTCToLocalUsingTable( row = LookupLastTransition(interp, fields->seconds, rowc, rowv); if (row == NULL || - TclListObjGetElementsM(interp, row, &cellc, &cellv) != TCL_OK || + TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK || TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index e7e929f..e29fed7 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -190,7 +190,7 @@ Tcl_CaseObjCmd( if (caseObjc == 1) { Tcl_Obj **newObjv; - TclListObjGetElementsM(interp, caseObjv[0], &caseObjc, &newObjv); + TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv); caseObjv = newObjv; } @@ -2949,7 +2949,7 @@ EachloopCmd( result = TCL_ERROR; goto done; } - result = TclListObjLengthM(interp, statePtr->vCopyList[i], + result = TclListObjLength(interp, statePtr->vCopyList[i], &statePtr->varcList[i]); if (result != TCL_OK) { result = TCL_ERROR; @@ -2965,7 +2965,7 @@ EachloopCmd( result = TCL_ERROR; goto done; } - TclListObjGetElementsM(NULL, statePtr->vCopyList[i], + TclListObjGetElements(NULL, statePtr->vCopyList[i], &statePtr->varcList[i], &statePtr->varvList[i]); /* Values */ @@ -2985,7 +2985,7 @@ EachloopCmd( result = TCL_ERROR; goto done; } - result = TclListObjGetElementsM(interp, statePtr->aCopyList[i], + result = TclListObjGetElements(interp, statePtr->aCopyList[i], &statePtr->argcList[i], &statePtr->argvList[i]); if (result != TCL_OK) { goto done; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 8f7cbe6..116dbbf 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2218,7 +2218,7 @@ Tcl_JoinObjCmd( isArithSeries = 1; listLen = TclArithSeriesObjLength(objv[1]); } else { - if (TclListObjGetElementsM(interp, objv[1], &listLen, + if (TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs) != TCL_OK) { return TCL_ERROR; } @@ -2339,7 +2339,7 @@ Tcl_LassignObjCmd( } Tcl_IncrRefCount(listCopyPtr); /* Important! fs */ - TclListObjGetElementsM(NULL, listCopyPtr, &listObjc, &listObjv); + TclListObjGetElements(NULL, listCopyPtr, &listObjc, &listObjv); origListObjc = listObjc; objc -= 2; @@ -2472,7 +2472,7 @@ Tcl_LinsertObjCmd( return TCL_ERROR; } - result = TclListObjLengthM(interp, objv[1], &len); + result = TclListObjLength(interp, objv[1], &len); if (result != TCL_OK) { return result; } @@ -2592,7 +2592,7 @@ Tcl_LlengthObjCmd( return TCL_ERROR; } - result = TclListObjLengthM(interp, objv[1], &listLen); + result = TclListObjLength(interp, objv[1], &listLen); if (result != TCL_OK) { return result; } @@ -2647,7 +2647,7 @@ Tcl_LpopObjCmd( return TCL_ERROR; } - result = TclListObjGetElementsM(interp, listPtr, &listLen, &elemPtrs); + result = TclListObjGetElements(interp, listPtr, &listLen, &elemPtrs); if (result != TCL_OK) { return result; } @@ -2741,7 +2741,7 @@ Tcl_LrangeObjCmd( return TCL_ERROR; } - result = TclListObjLengthM(interp, objv[1], &listLen); + result = TclListObjLength(interp, objv[1], &listLen); if (result != TCL_OK) { return result; } @@ -2830,7 +2830,7 @@ Tcl_LremoveObjCmd( } listObj = objv[1]; - if (TclListObjLengthM(interp, listObj, &listLen) != TCL_OK) { + if (TclListObjLength(interp, listObj, &listLen) != TCL_OK) { return TCL_ERROR; } @@ -3071,7 +3071,7 @@ Tcl_LreplaceObjCmd( return TCL_ERROR; } - result = TclListObjLengthM(interp, objv[1], &listLen); + result = TclListObjLength(interp, objv[1], &listLen); if (result != TCL_OK) { return result; } @@ -3185,7 +3185,7 @@ Tcl_LreverseObjCmd( } /* end ArithSeries */ /* True List */ - if (TclListObjLengthM(interp, objv[1], &elemc) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &elemc) != TCL_OK) { return TCL_ERROR; } @@ -3197,7 +3197,7 @@ Tcl_LreverseObjCmd( Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } - if (TclListObjGetElementsM(interp, objv[1], &elemc, &elemv) != TCL_OK) { + if (TclListObjGetElements(interp, objv[1], &elemc, &elemv) != TCL_OK) { return TCL_ERROR; } @@ -3468,7 +3468,7 @@ Tcl_LsearchObjCmd( */ i++; - if (TclListObjGetElementsM(interp, objv[i], + if (TclListObjGetElements(interp, objv[i], &sortInfo.indexc, &indices) != TCL_OK) { result = TCL_ERROR; goto done; @@ -3574,7 +3574,7 @@ Tcl_LsearchObjCmd( * pointer to its array of element pointers. */ - result = TclListObjGetElementsM(interp, objv[objc - 2], &listc, &listv); + result = TclListObjGetElements(interp, objv[objc - 2], &listc, &listv); if (result != TCL_OK) { goto done; } @@ -3679,7 +3679,7 @@ Tcl_LsearchObjCmd( * 1844789] */ - TclListObjGetElementsM(NULL, objv[objc - 2], &listc, &listv); + TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv); break; case REAL: result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble); @@ -3692,7 +3692,7 @@ Tcl_LsearchObjCmd( * 1844789] */ - TclListObjGetElementsM(NULL, objv[objc - 2], &listc, &listv); + TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv); break; } } else { @@ -4604,7 +4604,7 @@ Tcl_LsortObjCmd( sortInfo.resultCode = TCL_ERROR; goto done; } - if (TclListObjGetElementsM(interp, objv[i+1], &sortindex, + if (TclListObjGetElements(interp, objv[i+1], &sortindex, &indexv) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done; @@ -4697,7 +4697,7 @@ Tcl_LsortObjCmd( if (indexPtr) { Tcl_Obj **indexv; - TclListObjGetElementsM(interp, indexPtr, &sortInfo.indexc, &indexv); + TclListObjGetElements(interp, indexPtr, &sortInfo.indexc, &indexv); switch (sortInfo.indexc) { case 0: sortInfo.indexv = NULL; @@ -4762,7 +4762,7 @@ Tcl_LsortObjCmd( sortInfo.resultCode = TclArithSeriesGetElements(interp, listObj, &length, &listObjPtrs); } else { - sortInfo.resultCode = TclListObjGetElementsM(interp, listObj, + sortInfo.resultCode = TclListObjGetElements(interp, listObj, &length, &listObjPtrs); } if (sortInfo.resultCode != TCL_OK || length <= 0) { @@ -5057,7 +5057,7 @@ Tcl_LeditObjCmd( * by Tcl_{Lrange,Lreplace,Ledit}ObjCmd */ - result = TclListObjLengthM(interp, listPtr, &listLen); + result = TclListObjLength(interp, listPtr, &listLen); if (result != TCL_OK) { return result; } @@ -5301,10 +5301,10 @@ SortCompare( * Replace them and evaluate the result. */ - TclListObjLengthM(infoPtr->interp, infoPtr->compareCmdPtr, &objc); + TclListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc); Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2, 2, 2, paramObjv); - TclListObjGetElementsM(infoPtr->interp, infoPtr->compareCmdPtr, + TclListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr, &objc, &objv); infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0); @@ -5515,7 +5515,7 @@ SelectObjFromSublist( int index; Tcl_Obj *currentObj; - if (TclListObjLengthM(infoPtr->interp, objPtr, &listLen) != TCL_OK) { + if (TclListObjLength(infoPtr->interp, objPtr, &listLen) != TCL_OK) { infoPtr->resultCode = TCL_ERROR; return NULL; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index bf25b32..c6176a6 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -679,7 +679,7 @@ Tcl_RegsubObjCmd( * object. (If they aren't, that's cheap to do.) */ - if (TclListObjLengthM(interp, objv[2], &numParts) != TCL_OK) { + if (TclListObjLength(interp, objv[2], &numParts) != TCL_OK) { return TCL_ERROR; } if (numParts < 1) { @@ -781,7 +781,7 @@ Tcl_RegsubObjCmd( Tcl_Obj **args = NULL, **parts; Tcl_Size numArgs; - TclListObjGetElementsM(interp, subPtr, &numParts, &parts); + TclListObjGetElements(interp, subPtr, &numParts, &parts); numArgs = numParts + info.nsubs + 1; args = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*) * numArgs); memcpy(args, parts, sizeof(Tcl_Obj*) * numParts); @@ -1817,7 +1817,7 @@ StringIsCmd( * well-formed lists. */ - if (TCL_OK == TclListObjLengthM(NULL, objPtr, &length2)) { + if (TCL_OK == TclListObjLength(NULL, objPtr, &length2)) { break; } @@ -2028,7 +2028,7 @@ StringMapCmd( } Tcl_DictObjDone(&search); } else { - if (TclListObjGetElementsM(interp, objv[objc-2], &mapElemc, + if (TclListObjGetElements(interp, objv[objc-2], &mapElemc, &mapElemv) != TCL_OK) { return TCL_ERROR; } @@ -3632,7 +3632,7 @@ TclNRSwitchObjCmd( Tcl_Obj **listv; blist = objv[0]; - if (TclListObjLengthM(interp, objv[0], &objc) != TCL_OK) { + if (TclListObjLength(interp, objv[0], &objc) != TCL_OK) { return TCL_ERROR; } @@ -3645,7 +3645,7 @@ TclNRSwitchObjCmd( "?-option ...? string {?pattern body ...? ?default body?}"); return TCL_ERROR; } - if (TclListObjGetElementsM(interp, objv[0], &objc, &listv) != TCL_OK) { + if (TclListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK) { return TCL_ERROR; } objv = listv; @@ -4024,7 +4024,7 @@ Tcl_ThrowObjCmd( * The type must be a list of at least length 1. */ - if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { return TCL_ERROR; } else if (len < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -4813,7 +4813,7 @@ TclNRTryObjCmd( return TCL_ERROR; } code = 1; - if (TclListObjLengthM(NULL, objv[i+1], &dummy) != TCL_OK) { + if (TclListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad prefix '%s': must be a list", TclGetString(objv[i+1]))); @@ -4825,7 +4825,7 @@ TclNRTryObjCmd( info[2] = objv[i+1]; commonHandler: - if (TclListObjLengthM(interp, objv[i+2], &dummy) != TCL_OK) { + if (TclListObjLength(interp, objv[i+2], &dummy) != TCL_OK) { Tcl_DecrRefCount(handlersObj); return TCL_ERROR; } @@ -4975,12 +4975,12 @@ TryPostBody( int found = 0; Tcl_Obj **handlers, **info; - TclListObjGetElementsM(NULL, handlersObj, &numHandlers, &handlers); + TclListObjGetElements(NULL, handlersObj, &numHandlers, &handlers); for (i=0 ; i 0) { Tcl_Obj *varName; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 0104285..2fdc22d 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -301,7 +301,7 @@ TclCompileArraySetCmd( TclNewObj(literalObj); isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj); isDataValid = (isDataLiteral - && TclListObjLengthM(NULL, literalObj, &len) == TCL_OK); + && TclListObjLength(NULL, literalObj, &len) == TCL_OK); isDataEven = (isDataValid && (len & 1) == 0); /* @@ -892,7 +892,7 @@ TclCompileConcatCmd( const char *bytes; int len; - TclListObjGetElementsM(NULL, listObj, &len, &objs); + TclListObjGetElements(NULL, listObj, &len, &objs); objPtr = Tcl_ConcatObj(len, objs); Tcl_DecrRefCount(listObj); bytes = TclGetStringFromObj(objPtr, &len); @@ -2750,7 +2750,7 @@ CompileEachloopCmd( */ if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) || - TCL_OK != TclListObjLengthM(NULL, varListObj, &numVars) || + TCL_OK != TclListObjLength(NULL, varListObj, &numVars) || numVars == 0) { code = TCL_ERROR; goto done; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index f738303..c3aba1e 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -935,7 +935,7 @@ TclCompileStringMapCmd( if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) { Tcl_DecrRefCount(mapObj); return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); - } else if (TclListObjGetElementsM(NULL, mapObj, &len, &objv) != TCL_OK) { + } else if (TclListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) { Tcl_DecrRefCount(mapObj); return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } else if (len != 2) { @@ -2727,7 +2727,7 @@ TclCompileThrowCmd( CompileWord(envPtr, msgToken, interp, 2); codeIsList = codeKnown && (TCL_OK == - TclListObjLengthM(interp, objPtr, &len)); + TclListObjLength(interp, objPtr, &len)); codeIsValid = codeIsList && (len != 0); if (codeIsValid) { @@ -2860,7 +2860,7 @@ TclCompileTryCmd( TclNewObj(tmpObj); Tcl_IncrRefCount(tmpObj); if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj) - || TclListObjLengthM(NULL, tmpObj, &objc) != TCL_OK + || TclListObjLength(NULL, tmpObj, &objc) != TCL_OK || (objc == 0)) { TclDecrRefCount(tmpObj); goto failedToCompile; @@ -2903,7 +2903,7 @@ TclCompileTryCmd( TclDecrRefCount(tmpObj); goto failedToCompile; } - if (TclListObjGetElementsM(NULL, tmpObj, &objc, &objv) != TCL_OK + if (TclListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK || (objc > 2)) { TclDecrRefCount(tmpObj); goto failedToCompile; @@ -3117,7 +3117,7 @@ IssueTryClausesInstructions( JUMP4( JUMP_FALSE, notCodeJumpSource); if (matchClauses[i]) { const char *p; - TclListObjLengthM(NULL, matchClauses[i], &len); + TclListObjLength(NULL, matchClauses[i], &len); /* * Match the errorcode according to try/trap rules. @@ -3328,7 +3328,7 @@ IssueTryClausesFinallyInstructions( OP( EQ); JUMP4( JUMP_FALSE, notCodeJumpSource); if (matchClauses[i]) { - TclListObjLengthM(NULL, matchClauses[i], &len); + TclListObjLength(NULL, matchClauses[i], &len); /* * Match the errorcode according to try/trap rules. diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index e97c552..187c25c 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2223,8 +2223,8 @@ TclCompileExpr( TclAdvanceLines(&envPtr->line, script, script + TclParseAllWhiteSpace(script, numBytes)); - TclListObjGetElementsM(NULL, litList, &objc, (Tcl_Obj ***)&litObjv); - TclListObjGetElementsM(NULL, funcList, &objc, &funcObjv); + TclListObjGetElements(NULL, litList, &objc, (Tcl_Obj ***)&litObjv); + TclListObjGetElements(NULL, funcList, &objc, &funcObjv); CompileExprTree(interp, opTree, 0, &litObjv, funcObjv, parsePtr->tokenPtr, envPtr, optimize); } else { diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 9e0baea..c7e2c86 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -617,7 +617,7 @@ SetDictFromAny( Tcl_Obj **objv; /* Cannot fail, we already know the Tcl_ObjType is "list". */ - TclListObjGetElementsM(NULL, objPtr, &objc, &objv); + TclListObjGetElements(NULL, objPtr, &objc, &objv); if (objc & 1) { goto missingValue; } @@ -2485,7 +2485,7 @@ DictForNRCmd( * Parse arguments. */ - if (TclListObjGetElementsM(interp, objv[1], &varc, &varv) != TCL_OK) { + if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { @@ -2504,7 +2504,7 @@ DictForNRCmd( TclStackFree(interp, searchPtr); return TCL_OK; } - TclListObjGetElementsM(NULL, objv[1], &varc, &varv); + TclListObjGetElements(NULL, objv[1], &varc, &varv); keyVarObj = varv[0]; valueVarObj = varv[1]; scriptObj = objv[3]; @@ -2680,7 +2680,7 @@ DictMapNRCmd( * Parse arguments. */ - if (TclListObjGetElementsM(interp, objv[1], &varc, &varv) != TCL_OK) { + if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { @@ -2706,7 +2706,7 @@ DictMapNRCmd( return TCL_OK; } TclNewObj(storagePtr->accumulatorObj); - TclListObjGetElementsM(NULL, objv[1], &varc, &varv); + TclListObjGetElements(NULL, objv[1], &varc, &varv); storagePtr->keyVarObj = varv[0]; storagePtr->valueVarObj = varv[1]; storagePtr->scriptObj = objv[3]; @@ -3120,7 +3120,7 @@ DictFilterCmd( * copying from the "dict for" implementation has occurred! */ - if (TclListObjGetElementsM(interp, objv[3], &varc, &varv) != TCL_OK) { + if (TclListObjGetElements(interp, objv[3], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { @@ -3382,7 +3382,7 @@ FinalizeDictUpdate( * an instruction to remove the key. */ - TclListObjGetElementsM(NULL, argsObj, &objc, &objv); + TclListObjGetElements(NULL, argsObj, &objc, &objv); for (i=0 ; i 0 ? objv[1] : NULL); continue; case CRT_PARAM: - if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } @@ -273,7 +273,7 @@ TclNamespaceEnsembleCmd( Tcl_Obj **listv; const char *cmd; - if (TclListObjGetElementsM(interp, listObj, &len, + if (TclListObjGetElements(interp, listObj, &len, &listv) != TCL_OK) { Tcl_DictObjDone(&search); if (patchedDict) { @@ -339,7 +339,7 @@ TclNamespaceEnsembleCmd( continue; } case CRT_UNKNOWN: - if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } @@ -535,13 +535,13 @@ TclNamespaceEnsembleCmd( } switch ((enum EnsConfigOpts) index) { case CONF_SUBCMDS: - if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { goto freeMapAndError; } subcmdObj = (len > 0 ? objv[1] : NULL); continue; case CONF_PARAM: - if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { goto freeMapAndError; } paramObj = (len > 0 ? objv[1] : NULL); @@ -563,7 +563,7 @@ TclNamespaceEnsembleCmd( continue; } do { - if (TclListObjLengthM(interp, listObj, &len + if (TclListObjLength(interp, listObj, &len ) != TCL_OK) { Tcl_DictObjDone(&search); if (patchedDict) { @@ -583,7 +583,7 @@ TclNamespaceEnsembleCmd( } goto freeMapAndError; } - if (TclListObjGetElementsM(interp, listObj, &len, + if (TclListObjGetElements(interp, listObj, &len, &listv) != TCL_OK) { Tcl_DictObjDone(&search); if (patchedDict) { @@ -633,7 +633,7 @@ TclNamespaceEnsembleCmd( } continue; case CONF_UNKNOWN: - if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { goto freeMapAndError; } unknownObj = (len > 0 ? objv[1] : NULL); @@ -802,7 +802,7 @@ Tcl_SetEnsembleSubcommandList( if (subcmdList != NULL) { Tcl_Size length; - if (TclListObjLengthM(interp, subcmdList, &length) != TCL_OK) { + if (TclListObjLength(interp, subcmdList, &length) != TCL_OK) { return TCL_ERROR; } if (length < 1) { @@ -878,7 +878,7 @@ Tcl_SetEnsembleParameterList( if (paramList == NULL) { length = 0; } else { - if (TclListObjLengthM(interp, paramList, &length) != TCL_OK) { + if (TclListObjLength(interp, paramList, &length) != TCL_OK) { return TCL_ERROR; } if (length < 1) { @@ -1054,7 +1054,7 @@ Tcl_SetEnsembleUnknownHandler( if (unknownList != NULL) { Tcl_Size length; - if (TclListObjLengthM(interp, unknownList, &length) != TCL_OK) { + if (TclListObjLength(interp, unknownList, &length) != TCL_OK) { return TCL_ERROR; } if (length < 1) { @@ -1898,7 +1898,7 @@ NsEnsembleImplementationCmdNR( Tcl_Obj **copyObjv; Tcl_Size copyObjc, prefixObjc; - TclListObjLengthM(NULL, prefixObj, &prefixObjc); + TclListObjLength(NULL, prefixObj, &prefixObjc); if (objc == 2) { copyPtr = TclListObjCopy(NULL, prefixObj); @@ -1932,7 +1932,7 @@ NsEnsembleImplementationCmdNR( */ TclSkipTailcall(interp); - TclListObjGetElementsM(NULL, copyPtr, ©Objc, ©Objv); + TclListObjGetElements(NULL, copyPtr, ©Objc, ©Objv); ((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr; return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL); } @@ -2308,7 +2308,7 @@ EnsembleUnknownCallback( for (i = 1 ; i < objc ; i++) { Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]); } - TclListObjGetElementsM(NULL, unknownCmd, ¶mc, ¶mv); + TclListObjGetElements(NULL, unknownCmd, ¶mc, ¶mv); Tcl_IncrRefCount(unknownCmd); /* @@ -2345,7 +2345,7 @@ EnsembleUnknownCallback( /* A non-empty list is the replacement command. */ - if (TclListObjLengthM(interp, *prefixObjPtr, &prefixObjc) != TCL_OK) { + if (TclListObjLength(interp, *prefixObjPtr, &prefixObjc) != TCL_OK) { TclDecrRefCount(*prefixObjPtr); Tcl_AddErrorInfo(interp, "\n while parsing result of " "ensemble unknown subcommand handler"); @@ -2602,7 +2602,7 @@ BuildEnsembleConfig( * Determine the target for each. */ - TclListObjGetElementsM(NULL, subList, &subc, &subv); + TclListObjGetElements(NULL, subList, &subc, &subv); if (subList == mapDict) { /* * Unusual case where explicit list of subcommands is same value @@ -3000,7 +3000,7 @@ TclCompileEnsemble( const char *str; Tcl_Obj *matchObj = NULL; - if (TclListObjGetElementsM(NULL, listObj, &len, &elems) != TCL_OK) { + if (TclListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) { goto tryCompileToInv; } for (i=0 ; itokenPtr; i < parsePtr->numWords; i++, tokPtr = TokenAfter(tokPtr)) { if (i > 0 && i <= numWords) { diff --git a/generic/tclEvent.c b/generic/tclEvent.c index ef87c47..1a2f8ca 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -249,7 +249,7 @@ HandleBgErrors( errPtr = assocPtr->firstBgPtr; - TclListObjGetElementsM(NULL, copyObj, &prefixObjc, &prefixObjv); + TclListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv); tempObjv = (Tcl_Obj**)ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *)); memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *)); tempObjv[prefixObjc] = errPtr->errorMsg; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index fd955f5..de57fc5 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2728,7 +2728,7 @@ TEBCresume( objPtr = OBJ_AT_TOS; TRACE(("\"%.30s\" => ", O2S(objPtr))); - if (TclListObjGetElementsM(interp, objPtr, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -3025,7 +3025,7 @@ TEBCresume( TclMarkTailcall(interp); TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); - TclListObjGetElementsM(NULL, objPtr, &objc, &objv); + TclListObjGetElements(NULL, objPtr, &objc, &objv); TclNRAddCallback(interp, TclNRReleaseValues, objPtr, NULL, NULL, NULL); return TclNREvalObjv(interp, objc, objv, TCL_EVAL_INVOKE, NULL); @@ -3437,7 +3437,7 @@ TEBCresume( varPtr = varPtr->value.linkPtr; } TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr))); - if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) + if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; @@ -3463,7 +3463,7 @@ TEBCresume( } TRACE(("%u \"%.30s\" \"%.30s\" => ", opnd, O2S(part2Ptr), O2S(valuePtr))); - if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) + if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; @@ -3505,7 +3505,7 @@ TEBCresume( lappendListDirect: objResultPtr = varPtr->value.objPtr; - if (TclListObjLengthM(interp, objResultPtr, &len) != TCL_OK) { + if (TclListObjLength(interp, objResultPtr, &len) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -3526,7 +3526,7 @@ TEBCresume( lappendList: opnd = -1; - if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) + if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; @@ -3564,7 +3564,7 @@ TEBCresume( if (!objResultPtr) { valueToAssign = valuePtr; - } else if (TclListObjLengthM(interp, objResultPtr, &len)!=TCL_OK) { + } else if (TclListObjLength(interp, objResultPtr, &len)!=TCL_OK) { TRACE_ERROR(interp); goto gotError; } else { @@ -4846,7 +4846,7 @@ TEBCresume( case INST_LIST_LENGTH: TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); - if (TclListObjLengthM(interp, OBJ_AT_TOS, &length) != TCL_OK) { + if (TclListObjLength(interp, OBJ_AT_TOS, &length) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -4882,7 +4882,7 @@ TEBCresume( * Extract the desired list element. */ - if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK) + if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK) && !TclHasInternalRep(value2Ptr, &tclListType)) { int code; @@ -4954,7 +4954,7 @@ TEBCresume( * in the process. */ - if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -5095,7 +5095,7 @@ TEBCresume( * in the process. */ - if (TclListObjLengthM(interp, valuePtr, &objc) != TCL_OK) { + if (TclListObjLength(interp, valuePtr, &objc) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -5168,7 +5168,7 @@ TEBCresume( s1 = TclGetStringFromObj(valuePtr, &s1len); TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); - if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) { + if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -6660,7 +6660,7 @@ TEBCresume( listVarPtr = LOCAL(listTmpIndex); listPtr = listVarPtr->value.objPtr; - if (TclListObjLengthM(interp, listPtr, &listLen) != TCL_OK) { + if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) { TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n", i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; @@ -6689,7 +6689,7 @@ TEBCresume( listVarPtr = LOCAL(listTmpIndex); /* Do not use TclListObjCopy here - shimmers arithseries to list */ listPtr = Tcl_DuplicateObj(listVarPtr->value.objPtr); - TclListObjGetElementsM(interp, listPtr, &listLen, &elements); + TclListObjGetElements(interp, listPtr, &listLen, &elements); valIndex = (iterNum * numVars); for (j = 0; j < numVars; j++) { @@ -6779,7 +6779,7 @@ TEBCresume( varListPtr = infoPtr->varLists[i]; numVars = varListPtr->numVars; listPtr = OBJ_AT_DEPTH(listTmpDepth); - if (TclListObjLengthM(interp, listPtr, &listLen) != TCL_OK) { + if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) { TRACE_APPEND(("ERROR converting list %ld, \"%s\": %s", i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; @@ -6873,7 +6873,7 @@ TEBCresume( status = Tcl_ListObjLength(interp, listPtr, &listLen); elements = NULL; } else { - status = TclListObjGetElementsM( + status = TclListObjGetElements( interp, listPtr, &listLen, &elements); } if (status != TCL_OK) { @@ -7503,7 +7503,7 @@ TEBCresume( } } Tcl_IncrRefCount(dictPtr); - if (TclListObjGetElementsM(interp, OBJ_AT_TOS, &length, + if (TclListObjGetElements(interp, OBJ_AT_TOS, &length, &keyPtrPtr) != TCL_OK) { TRACE_ERROR(interp); goto gotError; @@ -7563,7 +7563,7 @@ TEBCresume( NEXT_INST_F(9, 1, 0); } if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK - || TclListObjGetElementsM(interp, OBJ_AT_TOS, &length, + || TclListObjGetElements(interp, OBJ_AT_TOS, &length, &keyPtrPtr) != TCL_OK) { TRACE_ERROR(interp); goto gotError; @@ -7622,7 +7622,7 @@ TEBCresume( dictPtr = OBJ_UNDER_TOS; listPtr = OBJ_AT_TOS; TRACE(("\"%.30s\" \"%.30s\" =>", O2S(dictPtr), O2S(listPtr))); - if (TclListObjGetElementsM(interp, listPtr, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -7640,7 +7640,7 @@ TEBCresume( listPtr = OBJ_AT_TOS; TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ", O2S(varNamePtr), O2S(valuePtr), O2S(keysPtr))); - if (TclListObjGetElementsM(interp, listPtr, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); TclDecrRefCount(keysPtr); goto gotError; @@ -7671,7 +7671,7 @@ TEBCresume( varPtr = LOCAL(opnd); TRACE(("%u <- \"%.30s\" \"%.30s\" => ", opnd, O2S(valuePtr), O2S(keysPtr))); - if (TclListObjGetElementsM(interp, listPtr, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index 8ca0c88..42f4c5a 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -1006,7 +1006,7 @@ TclFileAttrsCmd( * Use objStrings as a list object. */ - if (TclListObjLengthM(interp, objStrings, &numObjStrings) != TCL_OK) { + if (TclListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) { goto end; } attributeStringsAllocated = (const char **) diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 7f4f1cc..9b9d283 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -515,7 +515,7 @@ TclpNativeSplitPath( */ if (lenPtr != NULL) { - TclListObjLengthM(NULL, resultPtr, lenPtr); + TclListObjLength(NULL, resultPtr, lenPtr); } return resultPtr; } @@ -1318,7 +1318,7 @@ Tcl_GlobObjCmd( return TCL_ERROR; } typePtr = objv[i+1]; - if (TclListObjLengthM(interp, typePtr, &length) != TCL_OK) { + if (TclListObjLength(interp, typePtr, &length) != TCL_OK) { return TCL_ERROR; } i++; @@ -1444,7 +1444,7 @@ Tcl_GlobObjCmd( * platform. */ - TclListObjLengthM(interp, typePtr, &length); + TclListObjLength(interp, typePtr, &length); if (length <= 0) { goto skipTypes; } @@ -1514,7 +1514,7 @@ Tcl_GlobObjCmd( } else { Tcl_Obj *item; - if ((TclListObjLengthM(NULL, look, &len) == TCL_OK) + if ((TclListObjLength(NULL, look, &len) == TCL_OK) && (len == 3)) { Tcl_ListObjIndex(interp, look, 0, &item); if (!strcmp("macintosh", Tcl_GetString(item))) { @@ -1621,7 +1621,7 @@ Tcl_GlobObjCmd( } if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) { - if (TclListObjLengthM(interp, Tcl_GetObjResult(interp), + if (TclListObjLength(interp, Tcl_GetObjResult(interp), &length) != TCL_OK) { /* * This should never happen. Maybe we should be more dramatic. @@ -2004,7 +2004,7 @@ TclGlob( } } - TclListObjGetElementsM(NULL, filenamesObj, &objc, &objv); + TclListObjGetElements(NULL, filenamesObj, &objc, &objv); for (i = 0; i< objc; i++) { int len; const char *oldStr = TclGetStringFromObj(objv[i], &len); @@ -2331,13 +2331,13 @@ DoGlob( int subdirc, i, repair = -1; Tcl_Obj **subdirv; - result = TclListObjGetElementsM(interp, subdirsPtr, + result = TclListObjGetElements(interp, subdirsPtr, &subdirc, &subdirv); for (i=0; result==TCL_OK && ifsPtr->listVolumesProc(); if (thisFsVolumes != NULL) { - if (TclListObjLengthM(NULL, thisFsVolumes, &numVolumes) + if (TclListObjLength(NULL, thisFsVolumes, &numVolumes) != TCL_OK) { /* * This is VERY bad; the listVolumesProc didn't return a diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 01d3c94..d999cc9 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -185,7 +185,7 @@ GetIndexFromObjList( * of the code there. This is a bit inefficient but simpler. */ - result = TclListObjGetElementsM(interp, tableObjPtr, &objc, &objv); + result = TclListObjGetElements(interp, tableObjPtr, &objc, &objv); if (result != TCL_OK) { return result; } @@ -616,7 +616,7 @@ PrefixMatchObjCmd( return TCL_ERROR; } i++; - result = TclListObjLengthM(interp, objv[i], &errorLength); + result = TclListObjLength(interp, objv[i], &errorLength); if (result != TCL_OK) { return TCL_ERROR; } @@ -640,7 +640,7 @@ PrefixMatchObjCmd( * error case regardless of level. */ - result = TclListObjLengthM(interp, tablePtr, &i); + result = TclListObjLength(interp, tablePtr, &i); if (result != TCL_OK) { return result; } @@ -706,7 +706,7 @@ PrefixAllObjCmd( return TCL_ERROR; } - result = TclListObjGetElementsM(interp, objv[1], &tableObjc, &tableObjv); + result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv); if (result != TCL_OK) { return result; } @@ -764,7 +764,7 @@ PrefixLongestObjCmd( return TCL_ERROR; } - result = TclListObjGetElementsM(interp, objv[1], &tableObjc, &tableObjv); + result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv); if (result != TCL_OK) { return result; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 008980a..13e1c57 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2627,7 +2627,7 @@ typedef struct ListRep { * Return TCL_OK on success or TCL_ERROR if the Tcl_Obj cannot be * converted to a list. */ -#define TclListObjGetElementsM(interp_, listObj_, objcPtr_, objvPtr_) \ +#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ (((listObj_)->typePtr == &tclListType) \ ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \ TCL_OK) \ @@ -2639,7 +2639,7 @@ typedef struct ListRep { * count in lenPtr_. Returns TCL_OK on success or TCL_ERROR if the * Tcl_Obj cannot be converted to a list. */ -#define TclListObjLengthM(interp_, listObj_, lenPtr_) \ +#define TclListObjLength(interp_, listObj_, lenPtr_) \ (((listObj_)->typePtr == &tclListType) \ ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) @@ -4374,13 +4374,13 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; #define TCL_MAX_TOKENS (int)(UINT_MAX / sizeof(Tcl_Token)) #define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr) \ do { \ - int _needed = (used) + (append); \ + Tcl_Size _needed = (used) + (append); \ if (_needed > TCL_MAX_TOKENS) { \ Tcl_Panic("max # of tokens for a Tcl parse (%d) exceeded", \ TCL_MAX_TOKENS); \ } \ if (_needed > (available)) { \ - int allocated = 2 * _needed; \ + Tcl_Size allocated = 2 * _needed; \ Tcl_Token *oldPtr = (tokenPtr); \ Tcl_Token *newPtr; \ if (oldPtr == (staticPtr)) { \ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 3d2c009..5abda57 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -2321,7 +2321,7 @@ GetInterp( Tcl_Interp *searchInterp; /* Interim storage for interp. to find. */ InterpInfo *parentInfoPtr; - if (TclListObjGetElementsM(interp, pathPtr, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) { return NULL; } @@ -2377,7 +2377,7 @@ ChildBgerror( if (objc) { Tcl_Size length; - if (TCL_ERROR == TclListObjLengthM(NULL, objv[0], &length) + if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length) || (length < 1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cmdPrefix must be list of length >= 1", -1)); @@ -2425,7 +2425,7 @@ ChildCreate( Tcl_Size objc; Tcl_Obj **objv; - if (TclListObjGetElementsM(interp, pathPtr, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) { return NULL; } if (objc < 2) { diff --git a/generic/tclLink.c b/generic/tclLink.c index 9443db4..6a5e73a 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -907,7 +907,7 @@ LinkTraceProc( */ if (linkPtr->flags & LINK_ALLOC_LAST) { - if (TclListObjGetElementsM(NULL, (valueObj), &objc, &objv) == TCL_ERROR + if (TclListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR || objc != linkPtr->numElems) { return (char *) "wrong dimension"; } diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 6c7f128..181ae6b 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1712,7 +1712,7 @@ Tcl_ListObjAppendList( Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList"); } - if (TclListObjGetElementsM(interp, fromObj, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, fromObj, &objc, &objv) != TCL_OK) { return TCL_ERROR; } @@ -1959,7 +1959,7 @@ Tcl_ListObjIndex( return TCL_OK; } - if (TclListObjGetElementsM(interp, listObj, &numElems, &elemObjs) + if (TclListObjGetElements(interp, listObj, &numElems, &elemObjs) != TCL_OK) { return TCL_ERROR; } @@ -2591,7 +2591,7 @@ TclLindexList( */ return TclLindexFlat(interp, listObj, 1, &argObj); } - TclListObjGetElementsM(interp, indexListCopy, &numIndexObjs, &indexObjs); + TclListObjGetElements(interp, indexListCopy, &numIndexObjs, &indexObjs); listObj = TclLindexFlat(interp, listObj, numIndexObjs, indexObjs); Tcl_DecrRefCount(indexListCopy); return listObj; @@ -2782,7 +2782,7 @@ TclLsetList( */ retValueObj = TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj); } else { - if (TCL_OK != TclListObjGetElementsM( + if (TCL_OK != TclListObjGetElements( interp, indexListCopy, &indexCount, &indices)) { Tcl_DecrRefCount(indexListCopy); /* @@ -2912,7 +2912,7 @@ TclLsetFlat( * Check for the possible error conditions... */ - if (TclListObjGetElementsM(interp, subListObj, &elemCount, &elemPtrs) + if (TclListObjGetElements(interp, subListObj, &elemCount, &elemPtrs) != TCL_OK) { /* ...the sublist we're indexing into isn't a list at all. */ result = TCL_ERROR; @@ -3070,7 +3070,7 @@ TclLsetFlat( */ len = -1; - TclListObjLengthM(NULL, subListObj, &len); + TclListObjLength(NULL, subListObj, &len); if (valueObj == NULL) { /* T:listrep-1.{4.2,5.4,6.1,7.1,8.3},2.{4,5}.4 */ Tcl_ListObjReplace(NULL, subListObj, index, 1, 0, NULL); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 9aea2b6..781e125 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -4086,7 +4086,7 @@ NamespacePathCmd( * There is a path given, so parse it into an array of namespace pointers. */ - if (TclListObjGetElementsM(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) { + if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) { goto badNamespace; } if (nsObjc != 0) { @@ -4454,7 +4454,7 @@ Tcl_SetNamespaceUnknownHandler( */ if (handlerPtr != NULL) { - if (TclListObjLengthM(interp, handlerPtr, &lstlen) != TCL_OK) { + if (TclListObjLength(interp, handlerPtr, &lstlen) != TCL_OK) { /* * Not a list. */ @@ -5030,7 +5030,7 @@ TclLogCommandInfo( Tcl_Size len; iPtr->resetErrorStack = 0; - TclListObjLengthM(interp, iPtr->errorStack, &len); + TclListObjLength(interp, iPtr->errorStack, &len); /* * Reset while keeping the list internalrep as much as possible. @@ -5115,7 +5115,7 @@ TclErrorStackResetIf( Tcl_Size len; iPtr->resetErrorStack = 0; - TclListObjLengthM(interp, iPtr->errorStack, &len); + TclListObjLength(interp, iPtr->errorStack, &len); /* * Reset while keeping the list internalrep as much as possible. diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 5f10475..32bd940 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -1082,7 +1082,7 @@ MagicDefinitionInvoke( Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr); /* TODO: overflow? */ Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc - offset, objv + offset); - TclListObjGetElementsM(NULL, objPtr, &dummy, &objs); + TclListObjGetElements(NULL, objPtr, &dummy, &objs); result = Tcl_EvalObjv(interp, objc - cmdIndex, objs, TCL_EVAL_INVOKE); if (isRoot) { @@ -2389,7 +2389,7 @@ ClassFilterSet( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (void *)NULL); return TCL_ERROR; - } else if (TclListObjGetElementsM(interp, objv[0], &filterc, + } else if (TclListObjGetElements(interp, objv[0], &filterc, &filterv) != TCL_OK) { return TCL_ERROR; } @@ -2477,7 +2477,7 @@ ClassMixinSet( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (void *)NULL); return TCL_ERROR; - } else if (TclListObjGetElementsM(interp, objv[0], &mixinc, + } else if (TclListObjGetElements(interp, objv[0], &mixinc, &mixinv) != TCL_OK) { return TCL_ERROR; } @@ -2597,7 +2597,7 @@ ClassSuperSet( "may not modify the superclass of the root object", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (void *)NULL); return TCL_ERROR; - } else if (TclListObjGetElementsM(interp, objv[0], &superc, + } else if (TclListObjGetElements(interp, objv[0], &superc, &superv) != TCL_OK) { return TCL_ERROR; } @@ -2767,7 +2767,7 @@ ClassVarsSet( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", (void *)NULL); return TCL_ERROR; - } else if (TclListObjGetElementsM(interp, objv[0], &varc, + } else if (TclListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; } @@ -2859,7 +2859,7 @@ ObjFilterSet( return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); - if (TclListObjGetElementsM(interp, objv[0], &filterc, + if (TclListObjGetElements(interp, objv[0], &filterc, &filterv) != TCL_OK) { return TCL_ERROR; } @@ -2936,7 +2936,7 @@ ObjMixinSet( return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); - if (TclListObjGetElementsM(interp, objv[0], &mixinc, + if (TclListObjGetElements(interp, objv[0], &mixinc, &mixinv) != TCL_OK) { return TCL_ERROR; } @@ -3039,7 +3039,7 @@ ObjVarsSet( return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); - if (TclListObjGetElementsM(interp, objv[0], &varc, + if (TclListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 893c05e..264cbe8 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -339,7 +339,7 @@ TclOONewProcInstanceMethod( ProcedureMethod *pmPtr; Tcl_Method method; - if (TclListObjLengthM(interp, argsObj, &argsLen) != TCL_OK) { + if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod)); @@ -397,7 +397,7 @@ TclOONewProcMethod( TclNewObj(argsObj); Tcl_IncrRefCount(argsObj); procName = ""; - } else if (TclListObjLengthM(interp, argsObj, &argsLen) != TCL_OK) { + } else if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } else { procName = (nameObj==NULL ? "" : TclGetString(nameObj)); @@ -1389,7 +1389,7 @@ TclOONewForwardInstanceMethod( int prefixLen; ForwardMethod *fmPtr; - if (TclListObjLengthM(interp, prefixObj, &prefixLen) != TCL_OK) { + if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { @@ -1428,7 +1428,7 @@ TclOONewForwardMethod( int prefixLen; ForwardMethod *fmPtr; - if (TclListObjLengthM(interp, prefixObj, &prefixLen) != TCL_OK) { + if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { @@ -1476,7 +1476,7 @@ InvokeForwardMethod( * can ignore here. */ - TclListObjGetElementsM(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs); + TclListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs); argObjs = InitEnsembleRewrite(interp, objc, objv, skip, numPrefixes, prefixObjs, &len); Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL); diff --git a/generic/tclObj.c b/generic/tclObj.c index a7080d1..f321399 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -881,7 +881,7 @@ Tcl_AppendAllObjTypes( * Get the test for a valid list out of the way first. */ - if (TclListObjLengthM(interp, objPtr, &numElems) != TCL_OK) { + if (TclListObjLength(interp, objPtr, &numElems) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 7282709..d448fbc 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -837,12 +837,12 @@ Tcl_FSJoinPath( int objc; Tcl_Obj **objv; - if (TclListObjLengthM(NULL, listObj, &objc) != TCL_OK) { + if (TclListObjLength(NULL, listObj, &objc) != TCL_OK) { return NULL; } elements = ((elements >= 0) && (elements <= objc)) ? elements : objc; - TclListObjGetElementsM(NULL, listObj, &objc, &objv); + TclListObjGetElements(NULL, listObj, &objc, &objv); res = TclJoinPath(elements, objv, 0); return res; } @@ -2338,7 +2338,7 @@ SetFsPathFromAny( Tcl_Obj **objv; Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL); - TclListObjGetElementsM(NULL, parts, &objc, &objv); + TclListObjGetElements(NULL, parts, &objc, &objv); /* * Skip '~'. It's replaced by its expansion. diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 55e09a2..82860a6 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -1359,7 +1359,7 @@ TclNRPackageObjCmd( objvListPtr = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(objvListPtr); Tcl_ListObjAppendElement(interp, objvListPtr, ov); - TclListObjGetElementsM(interp, objvListPtr, &newobjc, &newObjvPtr); + TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL,NULL); @@ -1386,7 +1386,7 @@ TclNRPackageObjCmd( Tcl_ListObjAppendElement(interp, objvListPtr, Tcl_DuplicateObj(newobjv[i])); } - TclListObjGetElementsM(interp, objvListPtr, &newobjc, &newObjvPtr); + TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL,NULL); Tcl_NRAddCallback(interp, diff --git a/generic/tclProc.c b/generic/tclProc.c index 4ea10ad..25a32ba 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -485,7 +485,7 @@ TclCreateProc( * in the Proc. */ - result = TclListObjGetElementsM(interp, argsPtr, &numArgs, &argArray); + result = TclListObjGetElements(interp, argsPtr, &numArgs, &argArray); if (result != TCL_OK) { goto procError; } @@ -515,7 +515,7 @@ TclCreateProc( * Now divide the specifier up into name and default. */ - result = TclListObjGetElementsM(interp, argArray[i], &fieldCount, + result = TclListObjGetElements(interp, argArray[i], &fieldCount, &fieldValues); if (result != TCL_OK) { goto procError; @@ -921,7 +921,7 @@ TclNRUplevelObjCmd( } else if (!TclHasStringRep(objv[1]) && objc == 2) { int status; Tcl_Size llength; - status = TclListObjLengthM(interp, objv[1], &llength); + status = TclListObjLength(interp, objv[1], &llength); if (status == TCL_OK && llength > 1) { /* the first argument can't interpreted as a level. Avoid * generating a string representation of the script. */ @@ -2465,7 +2465,7 @@ SetLambdaFromAny( * length is not 2, then it cannot be converted to lambdaType. */ - result = TclListObjLengthM(NULL, objPtr, &objc); + result = TclListObjLength(NULL, objPtr, &objc); if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't interpret \"%s\" as a lambda expression", @@ -2473,7 +2473,7 @@ SetLambdaFromAny( Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", (void *)NULL); return TCL_ERROR; } - result = TclListObjGetElementsM(NULL, objPtr, &objc, &objv); + result = TclListObjGetElements(NULL, objPtr, &objc, &objv); if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can't interpret \"%s\" as a lambda expression", diff --git a/generic/tclProcess.c b/generic/tclProcess.c index d55a1fd..1a4bf8c 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -526,7 +526,7 @@ ProcessStatusObjCmd( * Only return statuses of provided processes. */ - result = TclListObjGetElementsM(interp, objv[1], &numPids, &pidObjs); + result = TclListObjGetElements(interp, objv[1], &numPids, &pidObjs); if (result != TCL_OK) { return result; } @@ -641,7 +641,7 @@ ProcessPurgeObjCmd( * Purge only provided processes. */ - result = TclListObjGetElementsM(interp, objv[1], &numPids, &pidObjs); + result = TclListObjGetElements(interp, objv[1], &numPids, &pidObjs); if (result != TCL_OK) { return result; } diff --git a/generic/tclResult.c b/generic/tclResult.c index 91ddc6e..b35aee0 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -1328,12 +1328,12 @@ TclProcessReturn( * if someone does [return -errorstack [info errorstack]] */ - if (TclListObjGetElementsM(interp, valuePtr, &valueObjc, + if (TclListObjGetElements(interp, valuePtr, &valueObjc, &valueObjv) == TCL_ERROR) { return TCL_ERROR; } iPtr->resetErrorStack = 0; - TclListObjLengthM(interp, iPtr->errorStack, &len); + TclListObjLength(interp, iPtr->errorStack, &len); /* * Reset while keeping the list internalrep as much as possible. @@ -1490,7 +1490,7 @@ TclMergeReturnOptions( if (valuePtr != NULL) { int length; - if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length )) { + if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length )) { /* * Value is not a list, which is illegal for -errorcode. */ @@ -1512,7 +1512,7 @@ TclMergeReturnOptions( if (valuePtr != NULL) { int length; - if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length )) { + if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length )) { /* * Value is not a list, which is illegal for -errorstack. */ @@ -1682,7 +1682,7 @@ Tcl_SetReturnOptions( Tcl_Obj **objv, *mergedOpts; Tcl_IncrRefCount(options); - if (TCL_ERROR == TclListObjGetElementsM(interp, options, &objc, &objv) + if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv) || (objc % 2)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected dict but got \"%s\"", TclGetString(options))); diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index f23b23b..09fd1f3 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -557,7 +557,7 @@ TclParseNumber( if (TclHasInternalRep(objPtr, &tclListType)) { int length; /* A list can only be a (single) number if its length == 1 */ - TclListObjLengthM(NULL, objPtr, &length); + TclListObjLength(NULL, objPtr, &length); if (length != 1) { return TCL_ERROR; } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 54060c0..bcab176 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -700,7 +700,7 @@ TclCheckEmptyString( } if (TclListObjIsCanonical(objPtr)) { - TclListObjLengthM(NULL, objPtr, &length); + TclListObjLength(NULL, objPtr, &length); return length == 0; } @@ -3215,7 +3215,7 @@ AppendPrintfToObjVA( } } while (seekingConversion); } - TclListObjGetElementsM(NULL, list, &objc, &objv); + TclListObjGetElements(NULL, list, &objc, &objv); code = Tcl_AppendFormatToObj(NULL, objPtr, format, objc, objv); if (code != TCL_OK) { Tcl_AppendPrintfToObj(objPtr, diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 6adc724..2ef358c 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -443,7 +443,7 @@ TraceExecutionObjCmd( * pointer to its array of element pointers. */ - result = TclListObjLengthM(interp, objv[4], &listLen); + result = TclListObjLength(interp, objv[4], &listLen); if (result != TCL_OK) { return result; } @@ -455,7 +455,7 @@ TraceExecutionObjCmd( (void *)NULL); return TCL_ERROR; } - result = TclListObjGetElementsM(interp, objv[4], &listLen, &elemPtrs); + result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } @@ -616,7 +616,7 @@ TraceExecutionObjCmd( TclNewLiteralStringObj(opObj, "leavestep"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } - TclListObjLengthM(NULL, elemObjPtr, &numOps); + TclListObjLength(NULL, elemObjPtr, &numOps); if (0 == numOps) { Tcl_DecrRefCount(elemObjPtr); continue; @@ -690,7 +690,7 @@ TraceCommandObjCmd( * pointer to its array of element pointers. */ - result = TclListObjLengthM(interp, objv[4], &listLen); + result = TclListObjLength(interp, objv[4], &listLen); if (result != TCL_OK) { return result; } @@ -702,7 +702,7 @@ TraceCommandObjCmd( (void *)NULL); return TCL_ERROR; } - result = TclListObjGetElementsM(interp, objv[4], &listLen, &elemPtrs); + result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } @@ -816,7 +816,7 @@ TraceCommandObjCmd( TclNewLiteralStringObj(opObj, "delete"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } - TclListObjLengthM(NULL, elemObjPtr, &numOps); + TclListObjLength(NULL, elemObjPtr, &numOps); if (0 == numOps) { Tcl_DecrRefCount(elemObjPtr); continue; @@ -894,7 +894,7 @@ TraceVariableObjCmd( * pointer to its array of element pointers. */ - result = TclListObjLengthM(interp, objv[4], &listLen); + result = TclListObjLength(interp, objv[4], &listLen); if (result != TCL_OK) { return result; } @@ -906,7 +906,7 @@ TraceVariableObjCmd( (void *)NULL); return TCL_ERROR; } - result = TclListObjGetElementsM(interp, objv[4], &listLen, &elemPtrs); + result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 30fb89d..25f84e4 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3807,7 +3807,7 @@ GetEndOffsetFromObj( if ((TclMaxListLength(bytes, TCL_INDEX_NONE, NULL) > 1) /* If it's possible, do the full list parse. */ - && (TCL_OK == TclListObjLengthM(NULL, objPtr, &length)) + && (TCL_OK == TclListObjLength(NULL, objPtr, &length)) && (length > 1)) { goto parseError; } diff --git a/generic/tclVar.c b/generic/tclVar.c index 3007296..48e8cc3 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -2977,7 +2977,7 @@ Tcl_LappendObjCmd( return TCL_ERROR; } } else { - result = TclListObjLengthM(interp, newValuePtr, &numElems); + result = TclListObjLength(interp, newValuePtr, &numElems); if (result != TCL_OK) { return result; } @@ -3035,7 +3035,7 @@ Tcl_LappendObjCmd( createdNewObj = 1; } - result = TclListObjLengthM(interp, varValuePtr, &numElems); + result = TclListObjLength(interp, varValuePtr, &numElems); if (result == TCL_OK) { result = Tcl_ListObjReplace(interp, varValuePtr, numElems, 0, (objc-2), (objv+2)); @@ -3188,7 +3188,7 @@ ArrayForNRCmd( * Parse arguments. */ - if (TclListObjLengthM(interp, objv[1], &numVars) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &numVars) != TCL_OK) { return TCL_ERROR; } @@ -3304,7 +3304,7 @@ ArrayForLoopCallback( goto arrayfordone; } - result = TclListObjGetElementsM(NULL, varListObj, &varc, &varv); + result = TclListObjGetElements(NULL, varListObj, &varc, &varv); if (result != TCL_OK) { goto arrayfordone; } @@ -3848,7 +3848,7 @@ ArrayGetCmd( */ TclNewObj(tmpResObj); - result = TclListObjGetElementsM(interp, nameLstObj, &count, &nameObjPtr); + result = TclListObjGetElements(interp, nameLstObj, &count, &nameObjPtr); if (result != TCL_OK) { goto errorInArrayGet; } @@ -4172,7 +4172,7 @@ ArraySetCmd( Tcl_Obj **elemPtrs, *copyListObj; Tcl_Size i; - result = TclListObjLengthM(interp, arrayElemObj, &elemLen); + result = TclListObjLength(interp, arrayElemObj, &elemLen); if (result != TCL_OK) { return result; } @@ -4185,7 +4185,7 @@ ArraySetCmd( if (elemLen == 0) { goto ensureArray; } - result = TclListObjGetElementsM(interp, arrayElemObj, + result = TclListObjGetElements(interp, arrayElemObj, &elemLen, &elemPtrs); if (result != TCL_OK) { return result; diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 6f014eb..d902ad8 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -738,11 +738,11 @@ ToDosDate( *------------------------------------------------------------------------- */ -static inline int +static inline size_t CountSlashes( const char *string) { - int count = 0; + size_t count = 0; const char *p = string; while (*p != '\0') { @@ -1036,7 +1036,7 @@ NormalizeMountPoint(Tcl_Interp *interp, Tcl_DecrRefCount(unnormalizedObj); /* normalizedObj owned by Tcl!! Do NOT DecrRef without an IncrRef */ - normalizedPath = Tcl_GetStringFromObj(normalizedObj, &normalizedLen); + normalizedPath = TclGetStringFromObj(normalizedObj, &normalizedLen); Tcl_DStringFree(&dsJoin); Tcl_DStringAppend(dsPtr, normalizedPath, normalizedLen); Tcl_DecrRefCount(normalizedObj); @@ -1122,7 +1122,7 @@ MapPathToZipfs(Tcl_Interp *interp, Tcl_DecrRefCount(unnormalizedObj); /* normalizedObj owned by Tcl!! Do NOT DecrRef without an IncrRef */ - normalizedPath = Tcl_GetStringFromObj(normalizedObj, &normalizedLen); + normalizedPath = TclGetStringFromObj(normalizedObj, &normalizedLen); Tcl_DStringAppend(dsPtr, normalizedPath, normalizedLen); Tcl_DecrRefCount(normalizedObj); return Tcl_DStringValue(dsPtr); @@ -1813,7 +1813,7 @@ static inline int IsPasswordValid( Tcl_Interp *interp, const char *passwd, - int pwlen) + size_t pwlen) { if ((pwlen > 255) || strchr(passwd, 0xff)) { ZIPFS_ERROR(interp, "illegal password"); @@ -1850,8 +1850,8 @@ ZipFSCatalogFilesystem( * the ZIP is unprotected. */ const char *zipname) /* Path to ZIP file to build a catalog of. */ { - int pwlen, isNew; - size_t i; + int isNew; + size_t i, pwlen; ZipFile *zf0; ZipEntry *z; Tcl_HashEntry *hPtr; @@ -2366,7 +2366,7 @@ TclZipfs_Mount( ret = TCL_ERROR; } else { Tcl_IncrRefCount(normZipPathObj); - const char *normPath = Tcl_GetString(normZipPathObj); + const char *normPath = TclGetString(normZipPathObj); if (passwd == NULL || (ret = IsPasswordValid(interp, passwd, strlen(passwd))) == TCL_OK) { @@ -2616,13 +2616,13 @@ ZipFSMountObjCmd( */ if (objc > 1) { if (objc == 2) { - mountPoint = Tcl_GetString(objv[1]); + mountPoint = TclGetString(objv[1]); } else { /* 2 < objc < 4 */ - zipFile = Tcl_GetString(objv[1]); - mountPoint = Tcl_GetString(objv[2]); + zipFile = TclGetString(objv[1]); + mountPoint = TclGetString(objv[2]); if (objc > 3) { - password = Tcl_GetString(objv[3]); + password = TclGetString(objv[3]); } } } @@ -2663,7 +2663,7 @@ ZipFSMountBufferObjCmd( return TCL_ERROR; } data = Tcl_GetBytesFromObj(interp, objv[1], &length); - mountPoint = Tcl_GetString(objv[2]); + mountPoint = TclGetString(objv[2]); if (data == NULL) { return TCL_ERROR; } @@ -2728,7 +2728,7 @@ ZipFSUnmountObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "mountpoint"); return TCL_ERROR; } - return TclZipfs_Unmount(interp, Tcl_GetString(objv[1])); + return TclZipfs_Unmount(interp, TclGetString(objv[1])); } /* @@ -2908,7 +2908,7 @@ ZipAddFile( zpathlen = strlen(zpathExt); if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "path too long for \"%s\"", Tcl_GetString(pathObj))); + "path too long for \"%s\"", TclGetString(pathObj))); ZIPFS_ERROR_CODE(interp, "PATH_LEN"); Tcl_DStringFree(&zpathDs); return TCL_ERROR; @@ -2950,7 +2950,7 @@ ZipAddFile( } readErrorWithChannelOpen: Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s", - Tcl_GetString(pathObj), Tcl_PosixError(interp))); + TclGetString(pathObj), Tcl_PosixError(interp))); Tcl_Close(interp, in); return TCL_ERROR; } @@ -2962,7 +2962,7 @@ ZipAddFile( } if (Tcl_Seek(in, 0, SEEK_SET) == -1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("seek error on \"%s\": %s", - Tcl_GetString(pathObj), Tcl_PosixError(interp))); + TclGetString(pathObj), Tcl_PosixError(interp))); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); return TCL_ERROR; @@ -2987,7 +2987,7 @@ ZipAddFile( writeErrorWithChannelOpen: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error on \"%s\": %s", - Tcl_GetString(pathObj), Tcl_PosixError(interp))); + TclGetString(pathObj), Tcl_PosixError(interp))); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); return TCL_ERROR; @@ -3063,7 +3063,7 @@ ZipAddFile( if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY) != Z_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "compression init error on \"%s\"", Tcl_GetString(pathObj))); + "compression init error on \"%s\"", TclGetString(pathObj))); ZIPFS_ERROR_CODE(interp, "DEFLATE_INIT"); Tcl_Close(interp, in); Tcl_DStringFree(&zpathDs); @@ -3085,7 +3085,7 @@ ZipAddFile( len = deflate(&stream, flush); if (len == (size_t) Z_STREAM_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "deflate error on \"%s\"", Tcl_GetString(pathObj))); + "deflate error on \"%s\"", TclGetString(pathObj))); ZIPFS_ERROR_CODE(interp, "DEFLATE"); deflateEnd(&stream); Tcl_Close(interp, in); @@ -3172,7 +3172,7 @@ ZipAddFile( hPtr = Tcl_CreateHashEntry(fileHash, zpathTcl, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "non-unique path name \"%s\"", Tcl_GetString(pathObj))); + "non-unique path name \"%s\"", TclGetString(pathObj))); ZIPFS_ERROR_CODE(interp, "DUPLICATE_PATH"); return TCL_ERROR; } @@ -3289,7 +3289,7 @@ ComputeNameInArchive( Tcl_Size len; if (directNameObj) { - name = Tcl_GetString(directNameObj); + name = TclGetString(directNameObj); } else { name = TclGetStringFromObj(pathObj, &len); if (slen > 0) { @@ -3354,11 +3354,12 @@ ZipFSMkZipOrImg( * there's no password protection. */ { Tcl_Channel out; - int pwlen = 0, slen = 0, count, ret = TCL_ERROR, lobjc; + int count, ret = TCL_ERROR; + int pwlen = 0, slen = 0, lobjc; size_t len, i = 0; long long directoryStartOffset; - /* The overall file offset of the start of the - * central directory. */ + /* The overall file offset of the start of the + * central directory. */ long long suffixStartOffset;/* The overall file offset of the start of the * suffix of the central directory (i.e., * where this data will be written). */ @@ -3393,7 +3394,7 @@ ZipFSMkZipOrImg( } } Tcl_IncrRefCount(list); - if (TclListObjLengthM(interp, list, &lobjc) != TCL_OK) { + if (TclListObjLength(interp, list, &lobjc) != TCL_OK) { Tcl_DecrRefCount(list); return TCL_ERROR; } @@ -3409,7 +3410,7 @@ ZipFSMkZipOrImg( ZIPFS_ERROR_CODE(interp, "EMPTY"); return TCL_ERROR; } - if (TclListObjGetElementsM(interp, list, &lobjc, &lobjv) != TCL_OK) { + if (TclListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) { Tcl_DecrRefCount(list); return TCL_ERROR; } @@ -3431,7 +3432,7 @@ ZipFSMkZipOrImg( const char *imgName; // TODO: normalize the origin file name - imgName = (originFile != NULL) ? Tcl_GetString(originFile) : + imgName = (originFile != NULL) ? TclGetString(originFile) : Tcl_GetNameOfExecutable(); if (pwlen) { i = 0; @@ -3676,8 +3677,8 @@ CopyImageFile( for (k = 0; k < i; k += m) { m = i - k; - if (m > (int) sizeof(buf)) { - m = (int) sizeof(buf); + if (m > (Tcl_Size) sizeof(buf)) { + m = sizeof(buf); } n = Tcl_Read(in, buf, m); if (n == -1) { @@ -3980,14 +3981,14 @@ ZipFSCanonicalObjCmd( if (objc == 2) { mntPoint = ZIPFS_VOLUME; } else { - if (NormalizeMountPoint(interp, Tcl_GetString(objv[1]), &dsMount) != TCL_OK) { + if (NormalizeMountPoint(interp, TclGetString(objv[1]), &dsMount) != TCL_OK) { return TCL_ERROR; } mntPoint = Tcl_DStringValue(&dsMount); } (void)MapPathToZipfs(interp, mntPoint, - Tcl_GetString(objv[objc - 1]), + TclGetString(objv[objc - 1]), &dsPath); Tcl_SetObjResult(interp, Tcl_DStringToObj(&dsPath)); return TCL_OK; @@ -4026,7 +4027,7 @@ ZipFSExistsObjCmd( return TCL_ERROR; } - filename = Tcl_GetString(objv[1]); + filename = TclGetString(objv[1]); ReadLock(); exists = ZipFSLookup(filename) != NULL; @@ -4075,7 +4076,7 @@ ZipFSInfoObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "filename"); return TCL_ERROR; } - filename = Tcl_GetString(objv[1]); + filename = TclGetString(objv[1]); ReadLock(); z = ZipFSLookup(filename); if (z) { @@ -4153,17 +4154,17 @@ ZipFSListObjCmd( } switch (idx) { case OPT_GLOB: - pattern = Tcl_GetString(objv[2]); + pattern = TclGetString(objv[2]); break; case OPT_REGEXP: - regexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2])); + regexp = Tcl_RegExpCompile(interp, TclGetString(objv[2])); if (!regexp) { return TCL_ERROR; } break; } } else if (objc == 2) { - pattern = Tcl_GetString(objv[1]); + pattern = TclGetString(objv[1]); } /* @@ -5394,7 +5395,7 @@ ZipFSOpenFileChannelProc( return NULL; } - return ZipChannelOpen(interp, Tcl_GetString(pathPtr), mode); + return ZipChannelOpen(interp, TclGetString(pathPtr), mode); } /* @@ -5423,7 +5424,7 @@ ZipFSStatProc( if (!pathPtr) { return -1; } - return ZipEntryStat(Tcl_GetString(pathPtr), buf); + return ZipEntryStat(TclGetString(pathPtr), buf); } /* @@ -5452,7 +5453,7 @@ ZipFSAccessProc( if (!pathPtr) { return -1; } - return ZipEntryAccess(Tcl_GetString(pathPtr), mode); + return ZipEntryAccess(TclGetString(pathPtr), mode); } /* @@ -5498,11 +5499,11 @@ AppendWithPrefix( Tcl_DString *prefix, /* The prefix to add to the element, or NULL * for don't do that. */ const char *name, /* The name to append. */ - int nameLen) /* The length of the name. May be -1 for + Tcl_Size nameLen) /* The length of the name. May be < 0 for * append-up-to-NUL-byte. */ { if (prefix) { - int prefixLength = Tcl_DStringLength(prefix); + Tcl_Size prefixLength = Tcl_DStringLength(prefix); Tcl_DStringAppend(prefix, name, nameLen); Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj( @@ -5761,10 +5762,10 @@ ZipFSMatchMountPoints( { Tcl_HashEntry *hPtr; Tcl_HashSearch search; - int l; + size_t l; Tcl_Size normLength; const char *path = TclGetStringFromObj(normPathPtr, &normLength); - Tcl_Size len = (size_t) normLength; + Tcl_Size len = normLength; if (len < 1) { /* diff --git a/generic/tclZlib.c b/generic/tclZlib.c index e951060..29d5c81 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -517,7 +517,7 @@ GenerateHeader( if (GetValue(interp, dictObj, "time", &value) != TCL_OK) { goto error; - } else if (value != NULL && Tcl_GetWideIntFromObj(interp, value, + } else if (value != NULL && TclGetWideIntFromObj(interp, value, &wideValue) != TCL_OK) { goto error; } @@ -623,7 +623,7 @@ SetInflateDictionary( Tcl_Obj *compDictObj) { if (compDictObj != NULL) { - int length; + Tcl_Size length; unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); return inflateSetDictionary(strm, bytes, length); @@ -637,7 +637,7 @@ SetDeflateDictionary( Tcl_Obj *compDictObj) { if (compDictObj != NULL) { - int length; + Tcl_Size length; unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); return deflateSetDictionary(strm, bytes, length); @@ -1227,7 +1227,8 @@ Tcl_ZlibStreamPut( ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; char *dataTmp = NULL; int e; - int size, outSize, toStore; + Tcl_Size size; + int outSize, toStore; unsigned char *bytes; if (zshPtr->streamEnd) { @@ -1352,7 +1353,7 @@ int Tcl_ZlibStreamGet( Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */ Tcl_Obj *data, /* A place to append the data. */ - int count) /* Number of bytes to grab as a maximum, you + Tcl_Size count) /* Number of bytes to grab as a maximum, you * may get less! */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; @@ -1402,7 +1403,7 @@ Tcl_ZlibStreamGet( Tcl_DecrRefCount(zshPtr->currentInput); zshPtr->currentInput = NULL; } - TclListObjLengthM(NULL, zshPtr->inData, &listLen); + TclListObjLength(NULL, zshPtr->inData, &listLen); if (listLen > 0) { /* * There is more input available, get it from the list and @@ -1451,7 +1452,7 @@ Tcl_ZlibStreamGet( e = inflate(&zshPtr->stream, zshPtr->flush); } }; - TclListObjLengthM(NULL, zshPtr->inData, &listLen); + TclListObjLength(NULL, zshPtr->inData, &listLen); while ((zshPtr->stream.avail_out > 0) && (e == Z_OK || e == Z_BUF_ERROR) && (listLen > 0)) { @@ -1531,7 +1532,7 @@ Tcl_ZlibStreamGet( inflateEnd(&zshPtr->stream); } } else { - TclListObjLengthM(NULL, zshPtr->outData, &listLen); + TclListObjLength(NULL, zshPtr->outData, &listLen); if (count == -1) { count = 0; for (i=0; i dataPos) && - (TclListObjLengthM(NULL, zshPtr->outData, &listLen) == TCL_OK) + (TclListObjLength(NULL, zshPtr->outData, &listLen) == TCL_OK) && (listLen > 0)) { /* * Get the next chunk off our list of chunks and grab the data out @@ -1675,7 +1676,7 @@ Tcl_ZlibDeflate( TclNewObj(obj); memset(&stream, 0, sizeof(z_stream)); - stream.avail_in = (uInt) inLen; + stream.avail_in = inLen; stream.next_in = inData; /* @@ -1834,7 +1835,7 @@ Tcl_ZlibInflate( TclNewObj(obj); outData = Tcl_SetByteArrayLength(obj, bufferSize); memset(&stream, 0, sizeof(z_stream)); - stream.avail_in = (uInt) inLen+1; /* +1 because zlib can "over-request" + stream.avail_in = inLen+1; /* +1 because zlib can "over-request" * input (but ignore it!) */ stream.next_in = inData; stream.avail_out = bufferSize; @@ -1981,8 +1982,11 @@ ZlibCmd( int objc, Tcl_Obj *const objv[]) { - int command, dlen, i, option, level = -1; - unsigned start, buffersize = 0; + int command, i, option, level = -1; + unsigned buffersize = 0; + Tcl_Size dlen; + unsigned start; + Tcl_WideInt wideLen; Byte *data; Tcl_Obj *headerDictObj; const char *extraInfoStr = NULL; @@ -2135,14 +2139,15 @@ ZlibCmd( return TCL_ERROR; } if (objc > 3) { - if (Tcl_GetIntFromObj(interp, objv[3], - (int *) &buffersize) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[3], + &wideLen) != TCL_OK) { return TCL_ERROR; } - if (buffersize < MIN_NONSTREAM_BUFFER_SIZE - || buffersize > MAX_BUFFER_SIZE) { + if (wideLen < MIN_NONSTREAM_BUFFER_SIZE + || wideLen > MAX_BUFFER_SIZE) { goto badBuffer; } + buffersize = wideLen; } return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], buffersize, NULL); @@ -2154,14 +2159,15 @@ ZlibCmd( return TCL_ERROR; } if (objc > 3) { - if (Tcl_GetIntFromObj(interp, objv[3], - (int *) &buffersize) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[3], + &wideLen) != TCL_OK) { return TCL_ERROR; } - if (buffersize < MIN_NONSTREAM_BUFFER_SIZE - || buffersize > MAX_BUFFER_SIZE) { + if (wideLen < MIN_NONSTREAM_BUFFER_SIZE + || wideLen > MAX_BUFFER_SIZE) { goto badBuffer; } + buffersize = wideLen; } return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], buffersize, NULL); @@ -2185,14 +2191,15 @@ ZlibCmd( } switch (option) { case 0: - if (Tcl_GetIntFromObj(interp, objv[i+1], - (int *) &buffersize) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[i+1], + &wideLen) != TCL_OK) { return TCL_ERROR; } - if (buffersize < MIN_NONSTREAM_BUFFER_SIZE - || buffersize > MAX_BUFFER_SIZE) { + if (wideLen < MIN_NONSTREAM_BUFFER_SIZE + || wideLen > MAX_BUFFER_SIZE) { goto badBuffer; } + buffersize = wideLen; break; case 1: headerVarObj = objv[i+1]; @@ -3220,7 +3227,8 @@ ZlibTransformOutput( ZlibChannelData *cd = (ZlibChannelData *)instanceData; Tcl_DriverOutputProc *outProc = Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent)); - int e, produced; + int e; + int produced; Tcl_Obj *errObj; if (cd->mode == TCL_ZLIB_STREAM_INFLATE) { @@ -3282,7 +3290,8 @@ ZlibTransformFlush( ZlibChannelData *cd, int flushType) { - int e, len; + int e; + int len; cd->outStream.avail_in = 0; do { @@ -3498,7 +3507,7 @@ ZlibTransformGetOption( Tcl_DStringAppendElement(dsPtr, "-dictionary"); if (cd->compDictObj) { Tcl_DStringAppendElement(dsPtr, - Tcl_GetString(cd->compDictObj)); + TclGetString(cd->compDictObj)); } else { Tcl_DStringAppendElement(dsPtr, ""); } @@ -3526,7 +3535,7 @@ ZlibTransformGetOption( ExtractHeader(&cd->inHeader.header, tmpObj); if (optionName == NULL) { Tcl_DStringAppendElement(dsPtr, "-header"); - Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj)); + Tcl_DStringAppendElement(dsPtr, TclGetString(tmpObj)); Tcl_DecrRefCount(tmpObj); } else { TclDStringAppendObj(dsPtr, tmpObj); -- cgit v0.12 From 106663837fcd779ecbb5632ce108aa344b64587c Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 13 Mar 2024 14:13:57 +0000 Subject: better test-mockup, don't disclose artificially skipped test for valid mode --- tests/clock.test | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index d283e16..5a4b72f 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -37,11 +37,10 @@ testConstraint y2038 \ set valid_mode [clock configure -valid] # Wrapper to show validity mode in the test-case name (for possible errors): -rename test __test proc test {args} { variable valid_mode lset args 0 [lindex $args 0].vm:$valid_mode - uplevel [linsert $args [set args 0] __test] + tailcall ::tcltest::test {*}$args } puts [outputChannel] " Validity default mode: [expr {$valid_mode ? "on": "off"}]" @@ -38260,9 +38259,16 @@ test clock-67.5 {Change scan %x output on global locale change [Bug 4a0c163d24]} ::tcl::clock::ClearCaches rename test {} -rename __test test +namespace import -force ::tcltest::* +# adjust expected skipped (valid_off is an artificial constraint): +if {$valid_mode && [info exists ::tcltest::skippedBecause(valid_off)]} { + incr ::tcltest::numTests(Total) -$::tcltest::skippedBecause(valid_off) + incr ::tcltest::numTests(Skipped) -$::tcltest::skippedBecause(valid_off) + unset ::tcltest::skippedBecause(valid_off) +} ::tcltest::cleanupTests namespace delete ::testClock +unset valid_mode return -- cgit v0.12 From ac6aee3987018f33e9455fec6a2fe74f5fc8ee56 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 14 Mar 2024 20:55:49 +0000 Subject: validation check: fixed time point of first stage - it must work TZ independently (the conversion of local time to UTC may adjust date/time tokens); --- generic/tclClock.c | 26 ++++++++-- generic/tclDate.h | 4 +- tests/clock.test | 139 +++++++++++++++++++++++++++++------------------------ 3 files changed, 99 insertions(+), 70 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index cd66713..bde903e 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -3684,6 +3684,20 @@ ClockScanObjCmd( goto done; } + /* + * If no GMT and not free-scan (where valid stage 1 is done in-between), + * validate with stage 1 before local time conversion, otherwise it may + * adjust date/time tokens to valid values + */ + if ( (opts.flags & CLF_VALIDATE_S1) && + info->flags & (CLF_ASSEMBLE_SECONDS|CLF_LOCALSEC) + ) { + ret = ClockValidDate(&yy, &opts, CLF_VALIDATE_S1); + if (ret != TCL_OK) { + goto done; + } + } + /* Convert date info structure into UTC seconds */ ret = ClockScanCommit(&yy, &opts); @@ -3691,9 +3705,9 @@ ClockScanObjCmd( goto done; } - /* Apply validation rules, if expected */ + /* Apply remaining validation rules, if expected */ if ( (opts.flags & CLF_VALIDATE) ) { - ret = ClockValidDate(&yy, &opts, opts.formatObj == NULL ? 2 : 3); + ret = ClockValidDate(&yy, &opts, opts.flags & CLF_VALIDATE); if (ret != TCL_OK) { goto done; } @@ -3819,9 +3833,10 @@ ClockValidDate( yydate.tzOffset); #endif - if (!(stage & 1)) { + if (!(stage & CLF_VALIDATE_S1) || !(opts->flags & CLF_VALIDATE_S1)) { goto stage_2; } + opts->flags &= ~CLF_VALIDATE_S1; /* stage 1 is done */ /* first year (used later in hath / daysInPriorMonths) */ if ((info->flags & (CLF_YEAR|CLF_ISO8601YEAR))) { @@ -3900,9 +3915,10 @@ ClockValidDate( } } - if (!(stage & 2)) { + if (!(stage & CLF_VALIDATE_S2) || !(opts->flags & CLF_VALIDATE_S2)) { return TCL_OK; } + opts->flags &= ~CLF_VALIDATE_S2; /* stage 2 is done */ /* * Further tests expected ready calculated julianDay (inclusive relative), @@ -4047,7 +4063,7 @@ ClockFreeScan( * relative time (otherwise always valid recalculated date & time). */ if ( (opts->flags & CLF_VALIDATE) ) { - if (ClockValidDate(info, opts, 1) != TCL_OK) { + if (ClockValidDate(info, opts, CLF_VALIDATE_S1) != TCL_OK) { goto done; } } diff --git a/generic/tclDate.h b/generic/tclDate.h index 3544dee..81910ff 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -268,7 +268,9 @@ ClockInitDateInfo(DateInfo *info) { * Structure containing the command arguments supplied to [clock format] and [clock scan] */ -#define CLF_VALIDATE (1 << 2) +#define CLF_VALIDATE_S1 (1 << 0) +#define CLF_VALIDATE_S2 (1 << 1) +#define CLF_VALIDATE (CLF_VALIDATE_S1|CLF_VALIDATE_S2) #define CLF_EXTENDED (1 << 4) #define CLF_STRICT (1 << 8) #define CLF_LOCALE_USED (1 << 15) diff --git a/tests/clock.test b/tests/clock.test index 5a4b72f..5fbef7b 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -37086,60 +37086,68 @@ test clock-46.6 {freescan: regression test - bad time} -constraints valid_off \ [clock scan "13:00 pm" -base 0 -gmt 1] } -result {-1 -1} +proc _invalid_test {args} { + global valid_mode + # ensure validation works TZ independently, since the conversion + # of local time to UTC may adjust date/time tokens, depending on TZ: + set res {} + foreach tz {:GMT :CET {} :Europe/Berlin :localtime} { + foreach {v} $args { + if {$valid_mode} { # globally -valid 1 + lappend res [catch {clock scan $v -timezone $tz} msg] $msg + } else { + lappend res [catch {clock scan $v -valid 1 -timezone $tz} msg] $msg + } + } + } + set res +} # test without and with relative offsets: foreach {idx relstr} {"" "" "+rel" "+ 15 month + 40 days + 30 hours + 80 minutes +9999 seconds"} { test clock-46.10$idx {freescan: validation rules: invalid time} \ -body { # 13:00 am/pm are invalid input strings... - list [catch {clock scan "13:00 am$relstr" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "13:00 pm$relstr" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: invalid time (hour)} 1 {unable to convert input string: invalid time (hour)}} + _invalid_test "13:00 am$relstr" "13:00 pm$relstr" + } -result [lrepeat 10 1 {unable to convert input string: invalid time (hour)}] test clock-46.11$idx {freescan: validation rules: invalid time} \ -body { # invalid minutes in input strings... - list [catch {clock scan "23:70$relstr" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "11:80 pm$relstr" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: invalid time (minutes)} 1 {unable to convert input string: invalid time (minutes)}} + _invalid_test "23:70$relstr" "11:80 pm$relstr" + } -result [lrepeat 10 1 {unable to convert input string: invalid time (minutes)}] test clock-46.12$idx {freescan: validation rules: invalid time} \ -body { # invalid seconds in input strings... - list [catch {clock scan "23:00:70$relstr" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "11:00:80 pm$relstr" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: invalid time} 1 {unable to convert input string: invalid time}} + _invalid_test "23:00:70$relstr" "11:00:80 pm$relstr" + } -result [lrepeat 10 1 {unable to convert input string: invalid time}] test clock-46.13$idx {freescan: validation rules: invalid day} \ -body { - list [catch {clock scan "29 Feb 2017$relstr" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "30 Feb 2016$relstr" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: invalid day} 1 {unable to convert input string: invalid day}} + _invalid_test "29 Feb 2017$relstr" "30 Feb 2016$relstr" + } -result [lrepeat 10 1 {unable to convert input string: invalid day}] test clock-46.14$idx {freescan: validation rules: invalid day} \ -body { - list [catch {clock scan "0 Feb 2017$relstr" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "00 Feb 2017$relstr" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: invalid day} 1 {unable to convert input string: invalid day}} + _invalid_test "0 Feb 2017$relstr" "00 Feb 2017$relstr" + } -result [lrepeat 10 1 {unable to convert input string: invalid day}] test clock-46.15$idx {freescan: validation rules: invalid month} \ -body { - list [catch {clock scan "13/13/2017$relstr" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "00/00/2017$relstr" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: invalid month} 1 {unable to convert input string: invalid month}} + _invalid_test "13/13/2017$relstr" "00/00/2017$relstr" + } -result [lrepeat 10 1 {unable to convert input string: invalid month}] test clock-46.16$idx {freescan: validation rules: invalid day of week} \ -body { - list [catch {clock scan "Sat Jan 01 00:00:00 1970$relstr" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "Thu Jan 03 00:00:00 1970$relstr" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: invalid day of week} 1 {unable to convert input string: invalid day of week}} + _invalid_test "Sat Jan 02 00:00:00 1970$relstr" "Thu Jan 04 00:00:00 1970$relstr" + } -result [lrepeat 10 1 {unable to convert input string: invalid day of week}] test clock-46.17$idx {scan: validation rules: invalid year} -setup { set orgcfg [list -min-year [clock configure -min-year] -max-year [clock configure -max-year] \ -year-century [clock configure -year-century] -century-switch [clock configure -century-switch]] clock configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38 } -body { - list [catch {clock scan "70-01-01$relstr" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "1870-01-01$relstr" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "9570-01-01$relstr" -valid 1 -gmt 1} msg] $msg \ - } -result [lrepeat 3 1 {unable to convert input string: invalid year}] -cleanup { + _invalid_test "70-01-01$relstr" "1870-01-01$relstr" "9570-01-01$relstr" + } -result [lrepeat 15 1 {unable to convert input string: invalid year}] -cleanup { clock configure {*}$orgcfg unset -nocomplain orgcfg } }; # foreach +rename _invalid_test {} unset -nocomplain idx relstr set dst_hole_check { @@ -37204,60 +37212,66 @@ test clock-46.19-4 {scan: validation rules regression: all scans successful, if } -result [lrepeat 4 {*}[if {$valid_mode} {list 0 1 1 0 0 0} else {list 0 0 0 0 0 0}]] unset -nocomplain dst_hole_check +proc _invalid_test {args} { + global valid_mode + # ensure validation works TZ independently, since the conversion + # of local time to UTC may adjust date/time tokens, depending on TZ: + set res {} + foreach tz {:GMT :CET {} :Europe/Berlin :localtime} { + foreach {v fmt} $args { + if {$valid_mode} { # globally -valid 1 + lappend res [catch {clock scan $v -format $fmt -timezone $tz} msg] $msg + } else { + lappend res [catch {clock scan $v -format $fmt -valid 1 -timezone $tz} msg] $msg + } + + } + } + set res +} test clock-46.20 {scan: validation rules: invalid time} \ -body { # 13:00 am/pm are invalid input strings... - list [catch {clock scan "13:00 am" -format "%H:%M %p" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "13:00 pm" -format "%H:%M %p" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: invalid time (hour)} 1 {unable to convert input string: invalid time (hour)}} + _invalid_test "13:00 am" "%H:%M %p" "13:00 pm" "%H:%M %p" + } -result [lrepeat 10 1 {unable to convert input string: invalid time (hour)}] test clock-46.21 {scan: validation rules: invalid time} \ -body { # invalid minutes in input strings... - list [catch {clock scan "23:70" -format "%H:%M" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "11:80 pm" -format "%H:%M %p" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: invalid time (minutes)} 1 {unable to convert input string: invalid time (minutes)}} + _invalid_test "23:70" "%H:%M" "11:80 pm" "%H:%M %p" + } -result [lrepeat 10 1 {unable to convert input string: invalid time (minutes)}] test clock-46.22 {scan: validation rules: invalid time} \ -body { # invalid seconds in input strings... - list [catch {clock scan "23:00:70" -format "%H:%M:%S" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "11:00:80 pm" -format "%H:%M:%S %p" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: invalid time} 1 {unable to convert input string: invalid time}} + _invalid_test "23:00:70" "%H:%M:%S" "11:00:80 pm" "%H:%M:%S %p" + } -result [lrepeat 10 1 {unable to convert input string: invalid time}] test clock-46.23 {scan: validation rules: invalid day} \ -body { - list [catch {clock scan "29 Feb 2017" -format "%d %b %Y" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "30 Feb 2016" -format "%d %b %Y" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: invalid day} 1 {unable to convert input string: invalid day}} + _invalid_test "29 Feb 2017" "%d %b %Y" "30 Feb 2016" "%d %b %Y" + } -result [lrepeat 10 1 {unable to convert input string: invalid day}] test clock-46.24 {scan: validation rules: invalid day} \ -body { - list [catch {clock scan "0 Feb 2017" -format "%d %b %Y" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "00 Feb 2017" -format "%d %b %Y" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: invalid day} 1 {unable to convert input string: invalid day}} + _invalid_test "0 Feb 2017" "%d %b %Y" "00 Feb 2017" "%d %b %Y" + } -result [lrepeat 10 1 {unable to convert input string: invalid day}] test clock-46.25 {scan: validation rules: invalid month} \ -body { - list [catch {clock scan "13/13/2017" -format "%m/%d/%Y" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "00/00/2017" -format "%m/%d/%Y" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: invalid month} 1 {unable to convert input string: invalid month}} + _invalid_test "13/13/2017" "%m/%d/%Y" "00/01/2017" "%m/%d/%Y" + } -result [lrepeat 10 1 {unable to convert input string: invalid month}] test clock-46.26 {scan: validation rules: ambiguous day} \ -body { - list [catch {clock scan "1970-01-01--002" -format "%Y-%m-%d--%j" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "70-01-01--002" -format "%y-%m-%d--%j" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: ambiguous day} 1 {unable to convert input string: ambiguous day}} + _invalid_test "1970-01-02--004" "%Y-%m-%d--%j" "70-01-02--004" "%y-%m-%d--%j" + } -result [lrepeat 10 1 {unable to convert input string: ambiguous day}] test clock-46.27 {scan: validation rules: ambiguous year} \ -body { - list [catch {clock scan "19700101 00W014" -format "%Y%m%d %gW%V%u" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "1970001 00W014" -format "%Y%j %gW%V%u" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: ambiguous year} 1 {unable to convert input string: ambiguous year}} + _invalid_test "19700106 00W014" "%Y%m%d %gW%V%u" "1970006 00W014" "%Y%j %gW%V%u" + } -result [lrepeat 10 1 {unable to convert input string: ambiguous year}] test clock-46.28 {scan: validation rules: invalid day of week} \ -body { - list [catch {clock scan "Sat Jan 01 00:00:00 1970" -format "%a %b %d %H:%M:%S %Y" -valid 1 -gmt 1} msg] $msg - } -result {1 {unable to convert input string: invalid day of week}} + _invalid_test "Sat Jan 02 00:00:00 1970" "%a %b %d %H:%M:%S %Y" + } -result [lrepeat 5 1 {unable to convert input string: invalid day of week}] test clock-46.29-1 {scan: validation rules: invalid day of year} \ -body { - list [catch {clock scan "000-2017" -format "%j-%Y" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "366-2017" -format "%j-%Y" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "000-2017" -format "%j-%G" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "366-2017" -format "%j-%G" -valid 1 -gmt 1} msg] $msg - } -result [lrepeat 4 1 {unable to convert input string: invalid day of year}] + _invalid_test "000-2017" "%j-%Y" "366-2017" "%j-%Y" "000-2017" "%j-%G" "366-2017" "%j-%G" + } -result [lrepeat 20 1 {unable to convert input string: invalid day of year}] test clock-46.29-2 {scan: validation rules: valid day of leap/not leap year} \ -body { list [clock format [clock scan "366-2016" -format "%j-%Y" -valid 1 -gmt 1] -format "%d-%m-%Y"] \ @@ -37270,10 +37284,8 @@ test clock-46.30 {scan: validation rules: invalid year} -setup { -year-century [clock configure -year-century] -century-switch [clock configure -century-switch]] clock configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38 } -body { - list [catch {clock scan "01-01-70" -format "%d-%m-%y" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "01-01-1870" -format "%d-%m-%C%y" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "01-01-1970" -format "%d-%m-%Y" -valid 1 -gmt 1} msg] $msg \ - } -result [lrepeat 3 1 {unable to convert input string: invalid year}] -cleanup { + _invalid_test "01-01-70" "%d-%m-%y" "01-01-1870" "%d-%m-%C%y" "01-01-1970" "%d-%m-%Y" + } -result [lrepeat 15 1 {unable to convert input string: invalid year}] -cleanup { clock configure {*}$orgcfg unset -nocomplain orgcfg } @@ -37282,13 +37294,12 @@ test clock-46.31 {scan: validation rules: invalid iso year} -setup { -year-century [clock configure -year-century] -century-switch [clock configure -century-switch]] clock configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38 } -body { - list [catch {clock scan "01-01-70" -format "%d-%m-%g" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "01-01-9870" -format "%d-%m-%C%g" -valid 1 -gmt 1} msg] $msg \ - [catch {clock scan "01-01-9870" -format "%d-%m-%G" -valid 1 -gmt 1} msg] $msg \ - } -result [lrepeat 3 1 {unable to convert input string: invalid iso year}] -cleanup { + _invalid_test "01-01-70" "%d-%m-%g" "01-01-9870" "%d-%m-%C%g" "01-01-9870" "%d-%m-%G" + } -result [lrepeat 15 1 {unable to convert input string: invalid iso year}] -cleanup { clock configure {*}$orgcfg unset -nocomplain orgcfg } +rename _invalid_test {} test clock-47.1 {regression test - four-digit time} { clock scan 0012 -- cgit v0.12 From 066af093f9ab086c280669f67f942aab1f7a0eeb Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 14 Mar 2024 21:41:31 +0000 Subject: make clock tests system-TZ independent --- tests/clock.test | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index 5fbef7b..bd38cc1 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -36311,27 +36311,27 @@ test clock-34.18.5 {clock scan, ISO 8601 extended date time with UTC TZ} { } "Oct 23, 1992 00:00:00" test clock-34.20.1 {clock scan tests (-TZ)} { - set time [clock scan "31 Jan 14 23:59:59 -0100"] + set time [clock scan "31 Jan 14 23:59:59 -0100" -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Feb 01,2014 00:59:59 GMT} test clock-34.20.2 {clock scan tests (+TZ)} { - set time [clock scan "31 Jan 14 23:59:59 +0100"] + set time [clock scan "31 Jan 14 23:59:59 +0100" -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 31,2014 22:59:59 GMT} test clock-34.20.3 {clock scan tests (-TZ)} { - set time [clock scan "23:59:59 -0100" -base 0] + set time [clock scan "23:59:59 -0100" -base 0 -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 02,1970 00:59:59 GMT} test clock-34.20.4 {clock scan tests (+TZ)} { - set time [clock scan "23:59:59 +0100" -base 0] + set time [clock scan "23:59:59 +0100" -base 0 -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 01,1970 22:59:59 GMT} test clock-34.20.5 {clock scan tests (TZ)} { - set time [clock scan "Mon, 30 Jun 2014 23:59:59 CEST"] + set time [clock scan "Mon, 30 Jun 2014 23:59:59 CEST" -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jun 30,2014 21:59:59 GMT} test clock-34.20.6 {clock scan tests (TZ)} { - set time [clock scan "Fri, 31 Jan 2014 23:59:59 CET"] + set time [clock scan "Fri, 31 Jan 2014 23:59:59 CET" -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 31,2014 22:59:59 GMT} test clock-34.20.7 {clock scan tests (relspec, day unit not TZ)} { @@ -36343,11 +36343,11 @@ test clock-34.20.8 {clock scan tests (relspec, day unit not TZ)} { clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 09,1970 23:59:59 GMT} test clock-34.20.9 {clock scan tests (merid and TZ)} { - set time [clock scan "10:59 pm CET" -base 2000000] + set time [clock scan "10:59 pm CET" -base 2000000 -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 24,1970 21:59:00 GMT} test clock-34.20.10 {clock scan tests (merid and TZ)} { - set time [clock scan "10:59 pm +0100" -base 2000000] + set time [clock scan "10:59 pm +0100" -base 2000000 -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 24,1970 21:59:00 GMT} test clock-34.20.11 {clock scan tests (complex TZ)} { @@ -36403,6 +36403,12 @@ test clock-34.20.19 {clock scan tests (no TZ)} { test clock-34.20.20 {clock scan tests (TZ, TZ + 1day)} { clock scan "00:00 GMT+1000 day" -base 100000000 -gmt 1 } 100015200 +test clock-34.20.21 {clock scan tests (local date of base depends on given TZ, time apllied to different day)} { + list [clock scan "23:59:59 -0100" -base 0 -timezone :CET] \ + [clock scan "23:59:59 -0100" -base 0 -gmt 1] \ + [clock scan "23:59:59 -0100" -base 0 -timezone -1400] \ + [clock scan "23:59:59 -0100" -base 0 -timezone :Pacific/Apia] +} {89999 89999 3599 3599} # CLOCK SCAN REAL TESTS -- cgit v0.12 From fed5e03ac4de1d87e5e4a76cc31e6936bbf831ae Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 14 Mar 2024 23:30:34 +0000 Subject: clock.test: tests renumeration, solve inaesthetic results of merges --- tests/clock.test | 57 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 28 insertions(+), 29 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index bd38cc1..2a3557c 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18936,7 +18936,22 @@ test clock-7.8 {Julian Day, precedence below seconds} { test clock-7.9 {Julian Day, two values} { clock scan {2440588 2440589} -format {%J %J} -gmt true } 86400 -test clock-7.10 {Calendar vs Astronomical Julian Day (without and with time fraction)} { + +test clock-7.10 {Julian Day, negative amount} { + # Note: %J does not accept negative input; + # add negative amounts to Julian day 0 instead + set s0 [clock scan 0 -format %J -gmt true] + set J0 [scan [clock format $s0 -format %J -gmt true] %lld] + set s0m1d [clock add $s0 -1 days -timezone :UTC] + set s0m24h [clock add $s0 -24 hours -timezone :UTC] + set J0m24h [scan [clock format $s0m24h -format %J -gmt true] %lld] + set s0m1s [clock add $s0 -1 seconds -timezone :UTC] + set J0m1s [scan [clock format $s0m1s -format %J -gmt true] %lld] + list $s0m1d $s0m24h $J0m24h $s0m1s $J0m1s $s0 $J0 \ + [::tcl::mathop::== $s0m1d $s0m24h] [::tcl::mathop::== $J0m24h $J0m1s] +} [list -210866889600 -210866889600 -1 -210866803201 -1 -210866803200 0 1 1] + +test clock-7.11.1 {Calendar vs Astronomical Julian Day (without and with time fraction)} { list \ [clock scan {2440588} -format {%J} -gmt true] \ [clock scan {2440588} -format {%EJ} -gmt true] \ @@ -18945,8 +18960,7 @@ test clock-7.10 {Calendar vs Astronomical Julian Day (without and with time frac [clock scan {2440588.5} -format {%Ej} -gmt true] \ } {0 0 43200 43200 86400} - -test clock-7.11 {Astronomical JDN/JD} { +test clock-7.11.2 {Astronomical JDN/JD} { clock scan 0 -format %Ej -gmt true } -210866760000 @@ -19022,20 +19036,6 @@ test clock-7.20 {all JDN/JD are signed (and extended accept floats)} { set res } {-210866889600 -210866889600 -210866846400 -210866846400 -210866803200} -test clock-7.10 {Julian Day, negative amount} { - # Note: %J does not accept negative input; - # add negative amounts to Julian day 0 instead - set s0 [clock scan 0 -format %J -gmt true] - set J0 [scan [clock format $s0 -format %J -gmt true] %lld] - set s0m1d [clock add $s0 -1 days -timezone :UTC] - set s0m24h [clock add $s0 -24 hours -timezone :UTC] - set J0m24h [scan [clock format $s0m24h -format %J -gmt true] %lld] - set s0m1s [clock add $s0 -1 seconds -timezone :UTC] - set J0m1s [scan [clock format $s0m1s -format %J -gmt true] %lld] - list $s0m1d $s0m24h $J0m24h $s0m1s $J0m1s $s0 $J0 \ - [::tcl::mathop::== $s0m1d $s0m24h] [::tcl::mathop::== $J0m24h $J0m1s] -} [list -210866889600 -210866889600 -1 -210866803201 -1 -210866803200 0 1 1] - # BEGIN testcases8 # Test parsing of ccyymmdd @@ -36611,13 +36611,6 @@ test clock-34.52 {more than one ordinal month} {*}{ -returnCodes error -result {unable to convert date-time string "next January next March": more than one ordinal month in string} } - -test clock-34.53.1 {relative from base, date switch} { - set base [clock scan "12/31/2016 23:59:59" -gmt 1] - clock format [clock scan "+1 second" \ - -base $base -gmt 1] -gmt 1 -format {%Y-%m-%d %H:%M:%S} -} {2017-01-01 00:00:00} - test clock-34.53 {clock scan, ISO 8601 point in time format} { set time [clock scan "19921023T00:00:00"] clock format $time -format {%b %d, %Y %H:%M:%S} @@ -36682,7 +36675,13 @@ test clock-34.68 {clock scan tests (merid and TZ)} { set time [clock scan "10:59 pm +0100" -base 2000000 -gmt true] clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true } {Jan 24,1970 21:59:00 GMT} -test clock-34.53.2 {relative time, daylight switch} { + +test clock-34.69.1 {relative from base, date switch} { + set base [clock scan "12/31/2016 23:59:59" -gmt 1] + clock format [clock scan "+1 second" \ + -base $base -gmt 1] -gmt 1 -format {%Y-%m-%d %H:%M:%S} +} {2017-01-01 00:00:00} +test clock-34.69.2 {relative time, daylight switch} { set base [clock scan "03/27/2016" -timezone CET] set res {} lappend res [clock format [clock scan "+1 hour" \ @@ -36691,7 +36690,7 @@ test clock-34.53.2 {relative time, daylight switch} { -base $base -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}] } {{2016-03-27 01:00:00 CET} {2016-03-27 03:00:00 CEST}} -test clock-34.53.3 {relative time with day increment / daylight switch} { +test clock-34.69.3 {relative time with day increment / daylight switch} { set base [clock scan "03/27/2016" -timezone CET] set res {} lappend res [clock format [clock scan "+5 day +25 hour" \ @@ -36700,7 +36699,7 @@ test clock-34.53.3 {relative time with day increment / daylight switch} { -base [expr {$base - 6*24*60*60}] -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}] } {{2016-03-27 01:00:00 CET} {2016-03-27 03:00:00 CEST}} -test clock-34.53.4 {relative time with month & day increment / daylight switch} { +test clock-34.69.4 {relative time with month & day increment / daylight switch} { set base [clock scan "03/27/2016" -timezone CET] set res {} lappend res [clock format [clock scan "next Mar +5 day +25 hour" \ @@ -36709,7 +36708,7 @@ test clock-34.53.4 {relative time with month & day increment / daylight switch} -base [expr {$base - 35*24*60*60}] -timezone CET] -timezone CET -format {%Y-%m-%d %H:%M:%S %Z}] } {{2016-03-27 01:00:00 CET} {2016-03-27 03:00:00 CEST}} -test clock-34.54.1 {check date in DST-hole: daylight switch CET -> CEST} { +test clock-34.70.1 {check date in DST-hole: daylight switch CET -> CEST} { set res {} # forwards set base 1459033200 @@ -36737,7 +36736,7 @@ test clock-34.54.1 {check date in DST-hole: daylight switch CET -> CEST} { 1459033200 = 2016-03-27 00:00:00 CET } {}] \n] -test clock-34.54.2 {check date in DST-hole: daylight switch CEST -> CET} { +test clock-34.70.2 {check date in DST-hole: daylight switch CEST -> CET} { set res {} # forwards set base 1477782000 -- cgit v0.12 From 0fe0da24f07924c27666ecf3e73070ab954b6eb4 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 15 Mar 2024 02:05:18 +0000 Subject: don't overwrite last setup-tz cache via gmt-tz (special case) --- generic/tclClock.c | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index bde903e..a4d2ab7 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -918,6 +918,17 @@ TimezoneLoaded( Tcl_Obj *timezoneObj, /* Name of zone was loaded */ Tcl_Obj *tzUnnormObj) /* Name of zone was loaded */ { + /* don't overwrite last-setup with GMT (special case) */ + if (timezoneObj == dataPtr->literals[LIT_GMT]) { + /* mark GMT zone loaded */ + if (dataPtr->gmtSetupTimeZone == NULL) { + Tcl_SetObjRef(dataPtr->gmtSetupTimeZone, + dataPtr->literals[LIT_GMT]); + } + Tcl_SetObjRef(dataPtr->gmtSetupTimeZoneUnnorm, tzUnnormObj); + return; + } + /* last setup zone loaded */ if (dataPtr->lastSetupTimeZone != timezoneObj) { SavePrevTimezoneObj(dataPtr); @@ -925,14 +936,6 @@ TimezoneLoaded( Tcl_UnsetObjRef(dataPtr->lastSetupTZData); } Tcl_SetObjRef(dataPtr->lastSetupTimeZoneUnnorm, tzUnnormObj); - - /* mark GMT zone loaded */ - if ( dataPtr->gmtSetupTimeZone == NULL - && timezoneObj == dataPtr->literals[LIT_GMT] - ) { - Tcl_SetObjRef(dataPtr->gmtSetupTimeZone, - dataPtr->literals[LIT_GMT]); - } } /* *---------------------------------------------------------------------- -- cgit v0.12 From 52573af89d6c0a561e3e7d9146f65c0b5475b72b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 15 Mar 2024 12:38:17 +0000 Subject: Mark 4 "clock" testcases with "knownBug". Ticket [1f40aa83c5] describes the details. --- tests/clock.test | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index 2a3557c..4420534 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18682,11 +18682,11 @@ test clock-6.8 {input of seconds} { clock scan {9223372036854775807} -format %s -gmt true } 9223372036854775807 -test clock-6.9 {input of seconds - overflow} { +test clock-6.9 {input of seconds - overflow} knownBug { list [catch {clock scan -9223372036854775809 -format %s -gmt true} result] $result $::errorCode } {1 {integer value too large to represent} {CLOCK dateTooLarge}} -test clock-6.10 {input of seconds - overflow} { +test clock-6.10 {input of seconds - overflow} knownBug { list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result $::errorCode } {1 {integer value too large to represent} {CLOCK dateTooLarge}} @@ -36243,11 +36243,11 @@ test clock-34.16 {clock scan, ISO 8601 point in time format} { set time [clock scan "19921023T235959" -gmt true] clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true } "Oct 23, 1992 23:59:59" -test clock-34.16.1a {clock scan, ISO 8601 T literal optional (YYYYMMDDhhmmss)} { +test clock-34.16.1a {clock scan, ISO 8601 T literal optional (YYYYMMDDhhmmss)} knownBug { set time [clock scan "19921023235959" -gmt true] clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true } "Oct 23, 1992 23:59:59" -test clock-34.16.1b {clock scan, ISO 8601 T literal optional (YYYYMMDDhhmm)} { +test clock-34.16.1b {clock scan, ISO 8601 T literal optional (YYYYMMDDhhmm)} knownBug { set time [clock scan "199210232359" -gmt true] clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true } "Oct 23, 1992 23:59:00" -- cgit v0.12 From 8c8ca843775e888866cd56725c5aef12ab17bec2 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 15 Mar 2024 14:14:47 +0000 Subject: fixes [1f40aa83c552f597]: suppress integer-overflow trapping (atm, GCC "trapv" only) for intended pieces, avoid unexpected app-crash; test cases (knownBug) reverted. --- generic/tclClockFmt.c | 9 +++++++++ generic/tclDate.c | 9 +++++++++ generic/tclGetDate.y | 9 +++++++++ tests/clock.test | 8 ++++---- 4 files changed, 31 insertions(+), 4 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index c216d34..66dbf6b 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -56,6 +56,11 @@ static void ClockFrmScnFinalize(void *clientData); *---------------------------------------------------------------------- */ +/* int overflows may happens here (expected case) */ +#if defined(__GNUC__) || defined(__GNUG__) +# pragma GCC optimize("no-trapv") +#endif + static inline int _str2int( int *out, @@ -113,6 +118,10 @@ _str2wideInt( *out = val; return TCL_OK; } + +#if defined(__GNUC__) || defined(__GNUG__) +# pragma GCC reset_options +#endif /* *---------------------------------------------------------------------- diff --git a/generic/tclDate.c b/generic/tclDate.c index 1614bb0..10f2151 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -2499,6 +2499,11 @@ LookupWord( return tID; } +/* int overflows may happens here (expected case) */ +#if defined(__GNUC__) || defined(__GNUG__) +# pragma GCC optimize("no-trapv") +#endif + static int TclDatelex( YYSTYPE* yylvalPtr, @@ -2636,6 +2641,10 @@ TclDatelex( } while (Count > 0); } } + +#if defined(__GNUC__) || defined(__GNUG__) +# pragma GCC reset_options +#endif int TclClockFreeScan( diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 0bf16e8..b0a8f85 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -875,6 +875,11 @@ LookupWord( return tID; } +/* int overflows may happens here (expected case) */ +#if defined(__GNUC__) || defined(__GNUG__) +# pragma GCC optimize("no-trapv") +#endif + static int TclDatelex( YYSTYPE* yylvalPtr, @@ -1012,6 +1017,10 @@ TclDatelex( } while (Count > 0); } } + +#if defined(__GNUC__) || defined(__GNUG__) +# pragma GCC reset_options +#endif int TclClockFreeScan( diff --git a/tests/clock.test b/tests/clock.test index 4420534..2a3557c 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18682,11 +18682,11 @@ test clock-6.8 {input of seconds} { clock scan {9223372036854775807} -format %s -gmt true } 9223372036854775807 -test clock-6.9 {input of seconds - overflow} knownBug { +test clock-6.9 {input of seconds - overflow} { list [catch {clock scan -9223372036854775809 -format %s -gmt true} result] $result $::errorCode } {1 {integer value too large to represent} {CLOCK dateTooLarge}} -test clock-6.10 {input of seconds - overflow} knownBug { +test clock-6.10 {input of seconds - overflow} { list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result $::errorCode } {1 {integer value too large to represent} {CLOCK dateTooLarge}} @@ -36243,11 +36243,11 @@ test clock-34.16 {clock scan, ISO 8601 point in time format} { set time [clock scan "19921023T235959" -gmt true] clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true } "Oct 23, 1992 23:59:59" -test clock-34.16.1a {clock scan, ISO 8601 T literal optional (YYYYMMDDhhmmss)} knownBug { +test clock-34.16.1a {clock scan, ISO 8601 T literal optional (YYYYMMDDhhmmss)} { set time [clock scan "19921023235959" -gmt true] clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true } "Oct 23, 1992 23:59:59" -test clock-34.16.1b {clock scan, ISO 8601 T literal optional (YYYYMMDDhhmm)} knownBug { +test clock-34.16.1b {clock scan, ISO 8601 T literal optional (YYYYMMDDhhmm)} { set time [clock scan "199210232359" -gmt true] clock format $time -format {%b %d, %Y %H:%M:%S} -gmt true } "Oct 23, 1992 23:59:00" -- cgit v0.12 From 3c9194088c89f442ef65c1ad0e518a6dfe84fd52 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 15 Mar 2024 16:16:39 +0000 Subject: Better solution for tclDate.c (since Number is not an int) --- generic/tclDate.c | 17 ++++------------- generic/tclGetDate.y | 17 ++++------------- 2 files changed, 8 insertions(+), 26 deletions(-) diff --git a/generic/tclDate.c b/generic/tclDate.c index 10f2151..e714161 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -139,7 +139,7 @@ typedef struct _TABLE { const char *name; int type; - Tcl_WideInt value; + long long value; } TABLE; /* @@ -221,7 +221,7 @@ extern int TclDatedebug; union YYSTYPE { - Tcl_WideInt Number; + long long Number; enum _MERIDIAN Meridian; @@ -2499,11 +2499,6 @@ LookupWord( return tID; } -/* int overflows may happens here (expected case) */ -#if defined(__GNUC__) || defined(__GNUG__) -# pragma GCC optimize("no-trapv") -#endif - static int TclDatelex( YYSTYPE* yylvalPtr, @@ -2534,7 +2529,7 @@ TclDatelex( /* * Convert the string into a number; count the number of digits. */ - int num = c - '0'; + long long num = c - '0'; p = (char *)yyInput; while (isdigit(UCHAR(c = *(++p)))) { if (num >= 0) { @@ -2566,7 +2561,7 @@ TclDatelex( location->last_column = yyInput - info->dateStart - 1; return tISOBASL; } - if (num < 0) { /* overflow */ + if (yyDigitCount > 14) { /* overflow */ return tID; } if (yyDigitCount == 8) { @@ -2641,10 +2636,6 @@ TclDatelex( } while (Count > 0); } } - -#if defined(__GNUC__) || defined(__GNUG__) -# pragma GCC reset_options -#endif int TclClockFreeScan( diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index b0a8f85..92e1b26 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -89,7 +89,7 @@ typedef struct _TABLE { const char *name; int type; - Tcl_WideInt value; + long long value; } TABLE; /* @@ -103,7 +103,7 @@ typedef enum _DSTMODE { %} %union { - Tcl_WideInt Number; + long long Number; enum _MERIDIAN Meridian; } @@ -875,11 +875,6 @@ LookupWord( return tID; } -/* int overflows may happens here (expected case) */ -#if defined(__GNUC__) || defined(__GNUG__) -# pragma GCC optimize("no-trapv") -#endif - static int TclDatelex( YYSTYPE* yylvalPtr, @@ -910,7 +905,7 @@ TclDatelex( /* * Convert the string into a number; count the number of digits. */ - int num = c - '0'; + long long num = c - '0'; p = (char *)yyInput; while (isdigit(UCHAR(c = *(++p)))) { if (num >= 0) { @@ -942,7 +937,7 @@ TclDatelex( location->last_column = yyInput - info->dateStart - 1; return tISOBASL; } - if (num < 0) { /* overflow */ + if (yyDigitCount > 14) { /* overflow */ return tID; } if (yyDigitCount == 8) { @@ -1017,10 +1012,6 @@ TclDatelex( } while (Count > 0); } } - -#if defined(__GNUC__) || defined(__GNUG__) -# pragma GCC reset_options -#endif int TclClockFreeScan( -- cgit v0.12 From 437550fcabfbe37a8efa3b13c6e9927d29854ead Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 15 Mar 2024 20:24:10 +0000 Subject: Review: Unnecessary use of 'L', TABLE.value: int is enough, making smaller tables --- generic/tclDate.c | 40 +++++++++++++--------------------------- generic/tclGetDate.y | 46 ++++++++++++++++------------------------------ 2 files changed, 29 insertions(+), 57 deletions(-) diff --git a/generic/tclDate.c b/generic/tclDate.c index e714161..e419585 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -78,8 +78,9 @@ * This file is generated from a yacc grammar defined in the file * tclGetDate.y. It should not be edited directly. * - * Copyright (c) 1992-1995 Karl Lehenbauer & Mark Diekhans. - * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * Copyright © 1992-1995 Karl Lehenbauer & Mark Diekhans. + * Copyright © 1995-1997 Sun Microsystems, Inc. + * Copyright © 2015 Sergey G. Brester aka sebres. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -121,8 +122,7 @@ #define TM_YEAR_BASE 1900 -#define HOUR(x) ((int) (60 * (x))) -#define SECSPERDAY (24L * 60L * 60L) +#define HOUR(x) ((60 * (int)(x))) #define IsLeapYear(x) (((x) % 4 == 0) && ((x) % 100 != 0 || (x) % 400 == 0)) #define yyIncrFlags(f) \ @@ -136,10 +136,10 @@ * An entry in the lexical lookup table. */ -typedef struct _TABLE { +typedef struct { const char *name; int type; - long long value; + int value; } TABLE; /* @@ -322,9 +322,9 @@ typedef enum yysymbol_kind_t yysymbol_kind_t; */ static int LookupWord(YYSTYPE* yylvalPtr, char *buff); - static void TclDateerror(YYLTYPE* location, +static void TclDateerror(YYLTYPE* location, DateInfo* info, const char *s); - static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location, +static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo* info); MODULE_SCOPE int yyparse(DateInfo*); @@ -1775,7 +1775,7 @@ yyreduce: yyDay = 1; yyMonth = 1; yyRelDay += (((yyvsp[-2].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000; - yyRelSeconds += (yyvsp[0].Number) * 144 * 60; + yyRelSeconds += (yyvsp[0].Number) * (144LL * 60LL); } break; @@ -2164,20 +2164,6 @@ static const TABLE OtherTable[] = { { "last", tUNUMBER, -1 }, { "this", tSEC_UNIT, 0 }, { "next", tNEXT, 1 }, -#if 0 - { "first", tUNUMBER, 1 }, - { "second", tUNUMBER, 2 }, - { "third", tUNUMBER, 3 }, - { "fourth", tUNUMBER, 4 }, - { "fifth", tUNUMBER, 5 }, - { "sixth", tUNUMBER, 6 }, - { "seventh", tUNUMBER, 7 }, - { "eighth", tUNUMBER, 8 }, - { "ninth", tUNUMBER, 9 }, - { "tenth", tUNUMBER, 10 }, - { "eleventh", tUNUMBER, 11 }, - { "twelfth", tUNUMBER, 12 }, -#endif { "ago", tAGO, 1 }, { "epoch", tEPOCH, 0 }, { "stardate", tSTARDATE, 0 }, @@ -2360,17 +2346,17 @@ ToSeconds( if (Hours < 0 || Hours > 23) { return -1; } - return (Hours * 60L + Minutes) * 60L + Seconds; + return (Hours * 60 + Minutes) * 60 + Seconds; case MERam: if (Hours < 1 || Hours > 12) { return -1; } - return ((Hours % 12) * 60L + Minutes) * 60L + Seconds; + return ((Hours % 12) * 60 + Minutes) * 60 + Seconds; case MERpm: if (Hours < 1 || Hours > 12) { return -1; } - return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds; + return (((Hours % 12) + 12) * 60 + Minutes) * 60 + Seconds; } return -1; /* Should never be reached */ } @@ -2579,7 +2565,7 @@ TclDatelex( int ret; for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */ || c == '.'; ) { - if (p < &buff[sizeof buff - 1]) { + if (p < &buff[sizeof(buff) - 1]) { *p++ = c; } } diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 92e1b26..077d751 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -7,9 +7,9 @@ * only used when doing free-form date parsing, an ill-defined process * anyway. * - * Copyright (c) 1992-1995 Karl Lehenbauer & Mark Diekhans. - * Copyright (c) 1995-1997 Sun Microsystems, Inc. - * Copyright (c) 2015 Sergey G. Brester aka sebres. + * Copyright © 1992-1995 Karl Lehenbauer & Mark Diekhans. + * Copyright © 1995-1997 Sun Microsystems, Inc. + * Copyright © 2015 Sergey G. Brester aka sebres. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -28,8 +28,9 @@ * This file is generated from a yacc grammar defined in the file * tclGetDate.y. It should not be edited directly. * - * Copyright (c) 1992-1995 Karl Lehenbauer & Mark Diekhans. - * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * Copyright © 1992-1995 Karl Lehenbauer & Mark Diekhans. + * Copyright © 1995-1997 Sun Microsystems, Inc. + * Copyright © 2015 Sergey G. Brester aka sebres. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -71,8 +72,7 @@ #define TM_YEAR_BASE 1900 -#define HOUR(x) ((int) (60 * (x))) -#define SECSPERDAY (24L * 60L * 60L) +#define HOUR(x) ((60 * (int)(x))) #define IsLeapYear(x) (((x) % 4 == 0) && ((x) % 100 != 0 || (x) % 400 == 0)) #define yyIncrFlags(f) \ @@ -86,10 +86,10 @@ * An entry in the lexical lookup table. */ -typedef struct _TABLE { +typedef struct { const char *name; int type; - long long value; + int value; } TABLE; /* @@ -114,9 +114,9 @@ typedef enum _DSTMODE { */ static int LookupWord(YYSTYPE* yylvalPtr, char *buff); - static void TclDateerror(YYLTYPE* location, +static void TclDateerror(YYLTYPE* location, DateInfo* info, const char *s); - static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location, +static int TclDatelex(YYSTYPE* yylvalPtr, YYLTYPE* location, DateInfo* info); MODULE_SCOPE int yyparse(DateInfo*); @@ -386,7 +386,7 @@ trek : tSTARDATE INTNUM '.' tUNUMBER { yyDay = 1; yyMonth = 1; yyRelDay += (($2%1000)*(365 + IsLeapYear(yyYear)))/1000; - yyRelSeconds += $4 * 144 * 60; + yyRelSeconds += $4 * (144LL * 60LL); } ; @@ -540,20 +540,6 @@ static const TABLE OtherTable[] = { { "last", tUNUMBER, -1 }, { "this", tSEC_UNIT, 0 }, { "next", tNEXT, 1 }, -#if 0 - { "first", tUNUMBER, 1 }, - { "second", tUNUMBER, 2 }, - { "third", tUNUMBER, 3 }, - { "fourth", tUNUMBER, 4 }, - { "fifth", tUNUMBER, 5 }, - { "sixth", tUNUMBER, 6 }, - { "seventh", tUNUMBER, 7 }, - { "eighth", tUNUMBER, 8 }, - { "ninth", tUNUMBER, 9 }, - { "tenth", tUNUMBER, 10 }, - { "eleventh", tUNUMBER, 11 }, - { "twelfth", tUNUMBER, 12 }, -#endif { "ago", tAGO, 1 }, { "epoch", tEPOCH, 0 }, { "stardate", tSTARDATE, 0 }, @@ -736,17 +722,17 @@ ToSeconds( if (Hours < 0 || Hours > 23) { return -1; } - return (Hours * 60L + Minutes) * 60L + Seconds; + return (Hours * 60 + Minutes) * 60 + Seconds; case MERam: if (Hours < 1 || Hours > 12) { return -1; } - return ((Hours % 12) * 60L + Minutes) * 60L + Seconds; + return ((Hours % 12) * 60 + Minutes) * 60 + Seconds; case MERpm: if (Hours < 1 || Hours > 12) { return -1; } - return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds; + return (((Hours % 12) + 12) * 60 + Minutes) * 60 + Seconds; } return -1; /* Should never be reached */ } @@ -955,7 +941,7 @@ TclDatelex( int ret; for (p = buff; isalpha(UCHAR(c = *yyInput++)) /* INTL: ISO only. */ || c == '.'; ) { - if (p < &buff[sizeof buff - 1]) { + if (p < &buff[sizeof(buff) - 1]) { *p++ = c; } } -- cgit v0.12 From 2eb1ac150dbbbea5e6540e5c094bd47a63dea44b Mon Sep 17 00:00:00 2001 From: sebres Date: Sun, 17 Mar 2024 12:13:43 +0000 Subject: review: registry loaded by first usage, no mc command needed (uses mcget instead, for merged dicts) --- library/clock.tcl | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) diff --git a/library/clock.tcl b/library/clock.tcl index 4c2529a..b518128 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -16,17 +16,9 @@ # #---------------------------------------------------------------------- -# msgcat 1.7 features are used. We need access to the Registry on Windows -# systems. +# msgcat 1.7 features are used. -uplevel \#0 { - package require msgcat 1.7 - if { $::tcl_platform(platform) eq {windows} } { - if { [catch { package require registry 1.1 }] } { - namespace eval ::tcl::clock [list variable NoRegistry {}] - } - } -} +package require msgcat 1.7 # Put the library directory into the namespace for the ensemble so that the # library code can find message catalogs and time zone definition files. @@ -60,7 +52,6 @@ namespace eval ::tcl::clock { # Import the message catalog commands that we use. namespace import ::msgcat::mclocale - proc mc {args} { tailcall ::msgcat::mcn [namespace current] {*}$args } namespace import ::msgcat::mcpackagelocale } @@ -923,7 +914,8 @@ proc ::tcl::clock::GetSystemTimeZone {} { set timezone [configure -system-tz] if { $timezone ne "" } { return $timezone - } elseif { $::tcl_platform(platform) eq {windows} } { + } + if { $::tcl_platform(platform) eq {windows} } { set timezone [GuessWindowsTimeZone] } elseif { [file exists /etc/localtime] && ![catch {ReadZoneinfoFile \ -- cgit v0.12 From 41f3a744b019cb440293a8f3216eaf48631fe0ca Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 17 Mar 2024 23:20:46 +0000 Subject: More int -> Tcl_Size --- generic/tclBasic.c | 19 ++++++++++--------- generic/tclCompile.h | 4 ++-- generic/tclInt.h | 2 +- generic/tclProc.c | 2 +- 4 files changed, 14 insertions(+), 13 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 09839d7..32472ad 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4931,7 +4931,7 @@ Dispatch( } if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) { Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr); - const char *a[6]; int i[2]; + const char *a[6]; Tcl_Size i[2]; TclDTraceInfo(info, a, i); TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); @@ -5183,7 +5183,7 @@ TEOV_NotFound( * namespace (TIP 181). */ Namespace *savedNsPtr = NULL; - int qualLen; + Tcl_Size qualLen; const char *qualName = TclGetStringFromObj(objv[0], &qualLen); currNsPtr = varFramePtr->nsPtr; @@ -5817,7 +5817,7 @@ TclEvalEx( */ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (expanding word %d)", objectsUsed)); + "\n (expanding word %" TCL_SIZE_MODIFIER "d)", objectsUsed)); Tcl_DecrRefCount(objv[objectsUsed]); break; } @@ -7352,7 +7352,7 @@ Tcl_AppendObjToErrorInfo( * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { - int length; + Tcl_Size length; const char *message = TclGetStringFromObj(objPtr, &length); Tcl_IncrRefCount(objPtr); @@ -7503,10 +7503,10 @@ Tcl_VarEvalVA( if (string == NULL) { break; } - Tcl_DStringAppend(&buf, string, -1); + Tcl_DStringAppend(&buf, string, TCL_INDEX_NONE); } - result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); + result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), TCL_INDEX_NONE, 0); Tcl_DStringFree(&buf); return result; } @@ -7577,7 +7577,7 @@ Tcl_GlobalEval( savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; - result = Tcl_EvalEx(interp, command, -1, 0); + result = Tcl_EvalEx(interp, command, TCL_INDEX_NONE, 0); iPtr->varFramePtr = savedVarFramePtr; return result; } @@ -8299,7 +8299,8 @@ ExprMaxMinFunc( { Tcl_Obj *res; double d; - int type, i; + int type; + int i; void *ptr; if (objc < 2) { @@ -9052,7 +9053,7 @@ void TclDTraceInfo( Tcl_Obj *info, const char **args, - int *argsi) + Tcl_Size *argsi) { static Tcl_Obj *keys[10] = { NULL }; Tcl_Obj **k = keys, *val; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 801b702..16bc972 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1762,7 +1762,7 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, #define TCL_DTRACE_DEBUG_LOG() MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, - int *argsi); + Tcl_Size *argsi); #else /* USE_DTRACE */ @@ -1817,7 +1817,7 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, MODULE_SCOPE int tclDTraceDebugEnabled, tclDTraceDebugIndent; MODULE_SCOPE FILE *tclDTraceDebugLog; MODULE_SCOPE void TclDTraceOpenDebugLog(void); -MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi); +MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *argsi); #define TCL_DTRACE_DEBUG_LOG() \ int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \ diff --git a/generic/tclInt.h b/generic/tclInt.h index 13e1c57..98f1494 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3299,7 +3299,7 @@ MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const char *operation, const char *reason, int index); MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[], + Tcl_Size objc, Tcl_Obj *const objv[], Tcl_Namespace *nsPtr, int flags); MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); diff --git a/generic/tclProc.c b/generic/tclProc.c index 25a32ba..a35fe60 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1763,7 +1763,7 @@ TclNRInterpProcCore( } if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) { Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr); - const char *a[6]; int i[2]; + const char *a[6]; Tcl_Size i[2]; TclDTraceInfo(info, a, i); TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]); -- cgit v0.12 From 64fd595e31d8a2a215ca65321c649100a279882d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 18 Mar 2024 08:46:29 +0000 Subject: For now, revert TIP #689 implementation, until it's accepted. --- generic/tclBasic.c | 51 ++++----------------------------------------------- tests/namespace.test | 42 ------------------------------------------ 2 files changed, 4 insertions(+), 89 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 32472ad..02607a4 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -5183,54 +5183,11 @@ TEOV_NotFound( * namespace (TIP 181). */ Namespace *savedNsPtr = NULL; - Tcl_Size qualLen; - const char *qualName = TclGetStringFromObj(objv[0], &qualLen); - currNsPtr = varFramePtr->nsPtr; - if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL) || - (qualLen > 2 && memchr(qualName, ':', qualLen)) /* fast check for NS:: */ - ) { - /* - * first try to find namespace unknown handler of the namespace - * of executed command if available: - */ - Namespace *altNsPtr, *dummyNsPtr; - const char *simpleName; - - (void) TclGetNamespaceForQualName(interp, qualName, currNsPtr, - TCL_FIND_IF_NOT_SIMPLE, &currNsPtr, &altNsPtr, - &dummyNsPtr, &simpleName); - if (!simpleName) { - goto globNS; - } - if (!currNsPtr || (currNsPtr == iPtr->globalNsPtr)) { - if (!altNsPtr || (altNsPtr == iPtr->globalNsPtr)) { - goto globNS; - } - currNsPtr = altNsPtr; - } - while (currNsPtr->unknownHandlerPtr == NULL || - (currNsPtr->flags & (NS_DYING | NS_DEAD)) - ) { - /* traverse to alive parent namespace containing handler */ - if (!(currNsPtr = currNsPtr->parentPtr) || - (currNsPtr == iPtr->globalNsPtr) - ) { - /* continue from alternate NS if available */ - if (!altNsPtr || (altNsPtr == iPtr->globalNsPtr)) { - goto globNS; - } - currNsPtr = altNsPtr; - altNsPtr = NULL; - continue; - globNS: - /* fallback to the global unknown */ - currNsPtr = iPtr->globalNsPtr; - if (currNsPtr == NULL) { - Tcl_Panic("TEOV_NotFound: NULL global namespace pointer"); - } - break; - } + if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) { + currNsPtr = iPtr->globalNsPtr; + if (currNsPtr == NULL) { + Tcl_Panic("TEOV_NotFound: NULL global namespace pointer"); } } diff --git a/tests/namespace.test b/tests/namespace.test index 11a17cb..c98ad4a 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -3112,48 +3112,6 @@ test namespace-52.12 {unknown: error case must not reset handler} -body { } -cleanup { namespace delete foo } -result ok -test namespace-52.13 {unknown: invocation outside of NS doesn't evade namespace unknown, bug 910d67a229fe7f65} -body { - namespace eval ::foo::bar { - proc _unknown args {list ::foo:bar:_unknown [uplevel {namespace current}] $args} - namespace unknown [namespace current]::_unknown - } - list [namespace inscope ::foo::bar {xxx}] [namespace inscope ::foo {bar::xxx}] [::foo::bar::xxx] [namespace inscope :: {foo::bar::xxx}] -} -cleanup { - namespace delete ::foo -} -result {{::foo:bar:_unknown ::foo::bar xxx} {::foo:bar:_unknown ::foo bar::xxx} {::foo:bar:_unknown :: ::foo::bar::xxx} {::foo:bar:_unknown :: foo::bar::xxx}} -test namespace-52.14 {unknown: invocation outside of NS doesn't evade namespace unknown for command with sub-NS, bug 910d67a229fe7f65} -body { - namespace eval ::foo::bar { - proc _unknown args {list ::foo:bar:_unknown [uplevel {namespace current}] $args} - namespace unknown [namespace current]::_unknown - } - set res {} - lappend res [namespace inscope ::foo::bar {xxx::yyy}] [namespace inscope ::foo {bar::xxx::yyy}] [::foo::bar::xxx::yyy] [namespace inscope :: {foo::bar::xxx::yyy}] - # now with existsing ::foo::bar::xxx, but without unknown handler inside (only parent ::foo::bar has a handler): - namespace eval ::foo::bar::xxx {} - lappend res [namespace inscope ::foo::bar {xxx::yyy}] [namespace inscope ::foo {bar::xxx::yyy}] [::foo::bar::xxx::yyy] [namespace inscope :: {foo::bar::xxx::yyy}] -} -cleanup { - namespace delete ::foo - unset -nocomplain res -} -result [lrepeat 2 \ - {::foo:bar:_unknown ::foo::bar xxx::yyy} {::foo:bar:_unknown ::foo bar::xxx::yyy} {::foo:bar:_unknown :: ::foo::bar::xxx::yyy} {::foo:bar:_unknown :: foo::bar::xxx::yyy} -] -test namespace-52.14 {unknown: it must consider alternate search path (relative global NS), bug 910d67a229fe7f65} -body { - namespace eval ::foo::bar {} - namespace eval ::xxx::yyy { - proc _unknown args {list ::xxx:yyy:_unknown [uplevel {namespace current}] $args} - namespace unknown [namespace current]::_unknown - } - set res {} - lappend res [namespace inscope ::foo::bar {xxx::yyy::cmd}] [namespace inscope ::foo {xxx::yyy::cmd}] - namespace eval ::foo::bar::xxx {} - lappend res [namespace inscope ::foo::bar {xxx::yyy::cmd}] [namespace inscope ::foo {xxx::yyy::cmd}] - namespace eval ::foo::bar::xxx::yyy {} - lappend res [namespace inscope ::foo::bar {xxx::yyy::cmd}] [namespace inscope ::foo {xxx::yyy::cmd}] -} -cleanup { - namespace delete ::foo - namespace delete ::xxx - unset -nocomplain res -} -result [lrepeat 3 {::xxx:yyy:_unknown ::foo::bar xxx::yyy::cmd} {::xxx:yyy:_unknown ::foo xxx::yyy::cmd}] # TIP 314 - ensembles with parameters test namespace-53.1 {ensembles: parameters} { -- cgit v0.12 From aabb871859e4ba0921cac811a30d53e6a88a208f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 18 Mar 2024 09:26:46 +0000 Subject: Make "clock configure" an internal command "::tcl::clock::configure" --- generic/tclClock.c | 2 +- library/init.tcl | 2 +- tests/clock-ivm.test | 2 +- tests/clock.test | 28 ++++++++++++++-------------- 4 files changed, 17 insertions(+), 17 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index a4d2ab7..af977eb 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -942,7 +942,7 @@ TimezoneLoaded( * * ClockConfigureObjCmd -- * - * This function is invoked to process the Tcl "clock configure" command. + * This function is invoked to process the Tcl "::clock::configure" (internal) command. * * Usage: * ::tcl::clock::configure ?-option ?value?? diff --git a/library/init.tcl b/library/init.tcl index 9306986..2fcd074 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -111,7 +111,7 @@ if {[interp issafe]} { proc clock args { set cmdmap [dict create] - foreach cmd {add clicks format microseconds milliseconds scan seconds configure} { + foreach cmd {add clicks format microseconds milliseconds scan seconds} { dict set cmdmap $cmd ::tcl::clock::$cmd } namespace inscope ::tcl::clock [list namespace ensemble create -command \ diff --git a/tests/clock-ivm.test b/tests/clock-ivm.test index 13de0b3..c6ac394 100644 --- a/tests/clock-ivm.test +++ b/tests/clock-ivm.test @@ -4,5 +4,5 @@ # # See the file "clock.test" for more information. -clock configure -valid [expr {![clock configure -valid]}] +::tcl::clock::configure -valid [expr {![::tcl::clock::configure -valid]}] source [file join [file dirname [info script]] clock.test] \ No newline at end of file diff --git a/tests/clock.test b/tests/clock.test index 2a3557c..5436051 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -34,7 +34,7 @@ testConstraint y2038 \ # Test with both validity modes - validate on / off: -set valid_mode [clock configure -valid] +set valid_mode [::tcl::clock::configure -valid] # Wrapper to show validity mode in the test-case name (for possible errors): proc test {args} { @@ -44,7 +44,7 @@ proc test {args} { } puts [outputChannel] " Validity default mode: [expr {$valid_mode ? "on": "off"}]" -testConstraint valid_off [expr {![clock configure -valid]}] +testConstraint valid_off [expr {![::tcl::clock::configure -valid]}] if {[namespace which -command ::tcl::unsupported::timerate] ne ""} { namespace import ::tcl::unsupported::timerate @@ -37141,13 +37141,13 @@ test clock-46.16$idx {freescan: validation rules: invalid day of week} \ _invalid_test "Sat Jan 02 00:00:00 1970$relstr" "Thu Jan 04 00:00:00 1970$relstr" } -result [lrepeat 10 1 {unable to convert input string: invalid day of week}] test clock-46.17$idx {scan: validation rules: invalid year} -setup { - set orgcfg [list -min-year [clock configure -min-year] -max-year [clock configure -max-year] \ - -year-century [clock configure -year-century] -century-switch [clock configure -century-switch]] - clock configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38 + set orgcfg [list -min-year [::tcl::clock::configure -min-year] -max-year [::tcl::clock::configure -max-year] \ + -year-century [::tcl::clock::configure -year-century] -century-switch [::tcl::clock::configure -century-switch]] + ::tcl::clock::configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38 } -body { _invalid_test "70-01-01$relstr" "1870-01-01$relstr" "9570-01-01$relstr" } -result [lrepeat 15 1 {unable to convert input string: invalid year}] -cleanup { - clock configure {*}$orgcfg + ::tcl::clock::configure {*}$orgcfg unset -nocomplain orgcfg } @@ -37285,23 +37285,23 @@ test clock-46.29-2 {scan: validation rules: valid day of leap/not leap year} \ [clock format [clock scan "365-2017" -format "%j-%G" -valid 1 -gmt 1] -format "%d-%m-%Y"] } -result {31-12-2016 31-12-2017 31-12-2016 31-12-2017} test clock-46.30 {scan: validation rules: invalid year} -setup { - set orgcfg [list -min-year [clock configure -min-year] -max-year [clock configure -max-year] \ - -year-century [clock configure -year-century] -century-switch [clock configure -century-switch]] - clock configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38 + set orgcfg [list -min-year [::tcl::clock::configure -min-year] -max-year [::tcl::clock::configure -max-year] \ + -year-century [::tcl::clock::configure -year-century] -century-switch [::tcl::clock::configure -century-switch]] + ::tcl::clock::configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38 } -body { _invalid_test "01-01-70" "%d-%m-%y" "01-01-1870" "%d-%m-%C%y" "01-01-1970" "%d-%m-%Y" } -result [lrepeat 15 1 {unable to convert input string: invalid year}] -cleanup { - clock configure {*}$orgcfg + ::tcl::clock::configure {*}$orgcfg unset -nocomplain orgcfg } test clock-46.31 {scan: validation rules: invalid iso year} -setup { - set orgcfg [list -min-year [clock configure -min-year] -max-year [clock configure -max-year] \ - -year-century [clock configure -year-century] -century-switch [clock configure -century-switch]] - clock configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38 + set orgcfg [list -min-year [::tcl::clock::configure -min-year] -max-year [::tcl::clock::configure -max-year] \ + -year-century [::tcl::clock::configure -year-century] -century-switch [::tcl::clock::configure -century-switch]] + ::tcl::clock::configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38 } -body { _invalid_test "01-01-70" "%d-%m-%g" "01-01-9870" "%d-%m-%C%g" "01-01-9870" "%d-%m-%G" } -result [lrepeat 15 1 {unable to convert input string: invalid iso year}] -cleanup { - clock configure {*}$orgcfg + ::tcl::clock::configure {*}$orgcfg unset -nocomplain orgcfg } rename _invalid_test {} -- cgit v0.12 From 4a6bea1b00641355931085f512bdce9bf721cfe9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 18 Mar 2024 10:31:58 +0000 Subject: Move "::tcl::clock::configure" to the tcl::unsupported namespace --- generic/tclClock.c | 8 ++++++-- library/clock.tcl | 18 +++++++++--------- library/init.tcl | 2 +- tests/clock-ivm.test | 2 +- tests/clock.test | 28 ++++++++++++++-------------- 5 files changed, 31 insertions(+), 27 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index af977eb..c49b1b4 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -146,7 +146,6 @@ static const struct ClockCommand clockCommands[] = { {"milliseconds", ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(2)}, {"scan", ClockScanObjCmd, TclCompileBasicMin1ArgCmd, NULL}, {"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, INT2PTR(3)}, - {"configure", ClockConfigureObjCmd, NULL, NULL}, {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd, NULL, NULL}, {"GetDateFields", ClockGetdatefieldsObjCmd, NULL, NULL}, {"GetJulianDayFromEraYearMonthDay", @@ -267,6 +266,11 @@ TclClockInit( cmdPtr->compileProc = clockCmdPtr->compileProc ? clockCmdPtr->compileProc : TclCompileBasicMin0ArgCmd; } + cmdPtr = (Command *)Tcl_CreateObjCommand(interp, + "::tcl::unsupported::clock::configure", + ClockConfigureObjCmd, data, NULL); + data->refCount++; + cmdPtr->compileProc = TclCompileBasicMin0ArgCmd; } /* @@ -945,7 +949,7 @@ TimezoneLoaded( * This function is invoked to process the Tcl "::clock::configure" (internal) command. * * Usage: - * ::tcl::clock::configure ?-option ?value?? + * ::tcl::unsupported::clock::configure ?-option ?value?? * * Results: * Returns a standard Tcl result. diff --git a/library/clock.tcl b/library/clock.tcl index b518128..a323a7c 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -280,9 +280,9 @@ proc ::tcl::clock::Initialize {} { # Default configuration - configure -current-locale [mclocale] - #configure -default-locale C - #configure -year-century 2000 \ + ::tcl::unsupported::clock::configure -current-locale [mclocale] + #::tcl::unsupported::clock::configure -default-locale C + #::tcl::unsupported::clock::configure -year-century 2000 \ # -century-switch 38 # Translation table to map Windows TZI onto cities, so that the Olson @@ -911,7 +911,7 @@ proc ::tcl::clock::GetSystemTimeZone {} { set timezone $result } else { # ask engine for the cached timezone: - set timezone [configure -system-tz] + set timezone [::tcl::unsupported::clock::configure -system-tz] if { $timezone ne "" } { return $timezone } @@ -934,7 +934,7 @@ proc ::tcl::clock::GetSystemTimeZone {} { } # tell backend - current system timezone: - configure -system-tz $timezone + ::tcl::unsupported::clock::configure -system-tz $timezone return $timezone } @@ -1037,7 +1037,7 @@ proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } { set tzname [::tcl::clock::SetupTimeZone $tzname $timezone] set TZData($timezone) $TZData($tzname) # tell backend - timezone is initialized and return shared timezone object: - return [configure -setup-tz $timezone] + return [::tcl::unsupported::clock::configure -setup-tz $timezone] } dict unset opts -errorinfo @@ -1049,7 +1049,7 @@ proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } { } # tell backend - timezone is initialized and return shared timezone object: - configure -setup-tz $timezone + ::tcl::unsupported::clock::configure -setup-tz $timezone } #---------------------------------------------------------------------- @@ -2045,7 +2045,7 @@ proc ::tcl::clock::WeekdayOnOrBefore { weekday j } { #---------------------------------------------------------------------- proc ::tcl::clock::ChangeCurrentLocale {args} { - configure -current-locale [lindex $args 0] + ::tcl::unsupported::clock::configure -current-locale [lindex $args 0] } #---------------------------------------------------------------------- @@ -2071,7 +2071,7 @@ proc ::tcl::clock::ClearCaches {} { variable TimeZoneBad # tell backend - should invalidate: - configure -clear + ::tcl::unsupported::clock::configure -clear # clear msgcat cache: set mcMergedCat [dict create] diff --git a/library/init.tcl b/library/init.tcl index 2fcd074..4d70f53 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -117,7 +117,7 @@ if {[interp issafe]} { namespace inscope ::tcl::clock [list namespace ensemble create -command \ [uplevel 1 [list ::namespace origin [::lindex [info level 0] 0]]] \ -map $cmdmap] - ::tcl::clock::configure -init-complete + ::tcl::unsupported::clock::configure -init-complete # Auto-loading stubs for 'clock.tcl' diff --git a/tests/clock-ivm.test b/tests/clock-ivm.test index c6ac394..acf4adb 100644 --- a/tests/clock-ivm.test +++ b/tests/clock-ivm.test @@ -4,5 +4,5 @@ # # See the file "clock.test" for more information. -::tcl::clock::configure -valid [expr {![::tcl::clock::configure -valid]}] +::tcl::unsupported::clock::configure -valid [expr {![::tcl::unsupported::clock::configure -valid]}] source [file join [file dirname [info script]] clock.test] \ No newline at end of file diff --git a/tests/clock.test b/tests/clock.test index 5436051..bd2b436 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -34,7 +34,7 @@ testConstraint y2038 \ # Test with both validity modes - validate on / off: -set valid_mode [::tcl::clock::configure -valid] +set valid_mode [::tcl::unsupported::clock::configure -valid] # Wrapper to show validity mode in the test-case name (for possible errors): proc test {args} { @@ -44,7 +44,7 @@ proc test {args} { } puts [outputChannel] " Validity default mode: [expr {$valid_mode ? "on": "off"}]" -testConstraint valid_off [expr {![::tcl::clock::configure -valid]}] +testConstraint valid_off [expr {![::tcl::unsupported::clock::configure -valid]}] if {[namespace which -command ::tcl::unsupported::timerate] ne ""} { namespace import ::tcl::unsupported::timerate @@ -37141,13 +37141,13 @@ test clock-46.16$idx {freescan: validation rules: invalid day of week} \ _invalid_test "Sat Jan 02 00:00:00 1970$relstr" "Thu Jan 04 00:00:00 1970$relstr" } -result [lrepeat 10 1 {unable to convert input string: invalid day of week}] test clock-46.17$idx {scan: validation rules: invalid year} -setup { - set orgcfg [list -min-year [::tcl::clock::configure -min-year] -max-year [::tcl::clock::configure -max-year] \ - -year-century [::tcl::clock::configure -year-century] -century-switch [::tcl::clock::configure -century-switch]] - ::tcl::clock::configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38 + set orgcfg [list -min-year [::tcl::unsupported::clock::configure -min-year] -max-year [::tcl::unsupported::clock::configure -max-year] \ + -year-century [::tcl::unsupported::clock::configure -year-century] -century-switch [::tcl::unsupported::clock::configure -century-switch]] + ::tcl::unsupported::clock::configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38 } -body { _invalid_test "70-01-01$relstr" "1870-01-01$relstr" "9570-01-01$relstr" } -result [lrepeat 15 1 {unable to convert input string: invalid year}] -cleanup { - ::tcl::clock::configure {*}$orgcfg + ::tcl::unsupported::clock::configure {*}$orgcfg unset -nocomplain orgcfg } @@ -37285,23 +37285,23 @@ test clock-46.29-2 {scan: validation rules: valid day of leap/not leap year} \ [clock format [clock scan "365-2017" -format "%j-%G" -valid 1 -gmt 1] -format "%d-%m-%Y"] } -result {31-12-2016 31-12-2017 31-12-2016 31-12-2017} test clock-46.30 {scan: validation rules: invalid year} -setup { - set orgcfg [list -min-year [::tcl::clock::configure -min-year] -max-year [::tcl::clock::configure -max-year] \ - -year-century [::tcl::clock::configure -year-century] -century-switch [::tcl::clock::configure -century-switch]] - ::tcl::clock::configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38 + set orgcfg [list -min-year [::tcl::unsupported::clock::configure -min-year] -max-year [::tcl::unsupported::clock::configure -max-year] \ + -year-century [::tcl::unsupported::clock::configure -year-century] -century-switch [::tcl::unsupported::clock::configure -century-switch]] + ::tcl::unsupported::clock::configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38 } -body { _invalid_test "01-01-70" "%d-%m-%y" "01-01-1870" "%d-%m-%C%y" "01-01-1970" "%d-%m-%Y" } -result [lrepeat 15 1 {unable to convert input string: invalid year}] -cleanup { - ::tcl::clock::configure {*}$orgcfg + ::tcl::unsupported::clock::configure {*}$orgcfg unset -nocomplain orgcfg } test clock-46.31 {scan: validation rules: invalid iso year} -setup { - set orgcfg [list -min-year [::tcl::clock::configure -min-year] -max-year [::tcl::clock::configure -max-year] \ - -year-century [::tcl::clock::configure -year-century] -century-switch [::tcl::clock::configure -century-switch]] - ::tcl::clock::configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38 + set orgcfg [list -min-year [::tcl::unsupported::clock::configure -min-year] -max-year [::tcl::unsupported::clock::configure -max-year] \ + -year-century [::tcl::unsupported::clock::configure -year-century] -century-switch [::tcl::unsupported::clock::configure -century-switch]] + ::tcl::unsupported::clock::configure -min-year 2000 -max-year 2100 -year-century 2000 -century-switch 38 } -body { _invalid_test "01-01-70" "%d-%m-%g" "01-01-9870" "%d-%m-%C%g" "01-01-9870" "%d-%m-%G" } -result [lrepeat 15 1 {unable to convert input string: invalid iso year}] -cleanup { - ::tcl::clock::configure {*}$orgcfg + ::tcl::unsupported::clock::configure {*}$orgcfg unset -nocomplain orgcfg } rename _invalid_test {} -- cgit v0.12 From ebb28177c0d2a42ce2e1400451f74b836fcfbffe Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 18 Mar 2024 11:59:02 +0000 Subject: Now _really_ remove TIP #689 --- generic/tclBasic.c | 51 ++++----------------------------------------------- tests/namespace.test | 42 ------------------------------------------ 2 files changed, 4 insertions(+), 89 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 411bb06..5ec29f3 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4805,54 +4805,11 @@ TEOV_NotFound( * namespace (TIP 181). */ Namespace *savedNsPtr = NULL; - Tcl_Size qualLen; - const char *qualName = TclGetStringFromObj(objv[0], &qualLen); - currNsPtr = varFramePtr->nsPtr; - if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL) || - (qualLen > 2 && memchr(qualName, ':', qualLen)) /* fast check for NS:: */ - ) { - /* - * first try to find namespace unknown handler of the namespace - * of executed command if available: - */ - Namespace *altNsPtr, *dummyNsPtr; - const char *simpleName; - - (void) TclGetNamespaceForQualName(interp, qualName, currNsPtr, - TCL_FIND_IF_NOT_SIMPLE, &currNsPtr, &altNsPtr, - &dummyNsPtr, &simpleName); - if (!simpleName) { - goto globNS; - } - if (!currNsPtr || (currNsPtr == iPtr->globalNsPtr)) { - if (!altNsPtr || (altNsPtr == iPtr->globalNsPtr)) { - goto globNS; - } - currNsPtr = altNsPtr; - } - while (currNsPtr->unknownHandlerPtr == NULL || - (currNsPtr->flags & (NS_DYING | NS_DEAD)) - ) { - /* traverse to alive parent namespace containing handler */ - if (!(currNsPtr = currNsPtr->parentPtr) || - (currNsPtr == iPtr->globalNsPtr) - ) { - /* continue from alternate NS if available */ - if (!altNsPtr || (altNsPtr == iPtr->globalNsPtr)) { - goto globNS; - } - currNsPtr = altNsPtr; - altNsPtr = NULL; - continue; - globNS: - /* fallback to the global unknown */ - currNsPtr = iPtr->globalNsPtr; - if (currNsPtr == NULL) { - Tcl_Panic("TEOV_NotFound: NULL global namespace pointer"); - } - break; - } + if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) { + currNsPtr = iPtr->globalNsPtr; + if (currNsPtr == NULL) { + Tcl_Panic("TEOV_NotFound: NULL global namespace pointer"); } } diff --git a/tests/namespace.test b/tests/namespace.test index abe642e..ae233cb 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -3124,48 +3124,6 @@ test namespace-52.12 {unknown: error case must not reset handler} -body { } -cleanup { namespace delete foo } -result ok -test namespace-52.13 {unknown: invocation outside of NS doesn't evade namespace unknown, bug 910d67a229fe7f65} -body { - namespace eval ::foo::bar { - proc _unknown args {list ::foo:bar:_unknown [uplevel {namespace current}] $args} - namespace unknown [namespace current]::_unknown - } - list [namespace inscope ::foo::bar {xxx}] [namespace inscope ::foo {bar::xxx}] [::foo::bar::xxx] [namespace inscope :: {foo::bar::xxx}] -} -cleanup { - namespace delete ::foo -} -result {{::foo:bar:_unknown ::foo::bar xxx} {::foo:bar:_unknown ::foo bar::xxx} {::foo:bar:_unknown :: ::foo::bar::xxx} {::foo:bar:_unknown :: foo::bar::xxx}} -test namespace-52.14 {unknown: invocation outside of NS doesn't evade namespace unknown for command with sub-NS, bug 910d67a229fe7f65} -body { - namespace eval ::foo::bar { - proc _unknown args {list ::foo:bar:_unknown [uplevel {namespace current}] $args} - namespace unknown [namespace current]::_unknown - } - set res {} - lappend res [namespace inscope ::foo::bar {xxx::yyy}] [namespace inscope ::foo {bar::xxx::yyy}] [::foo::bar::xxx::yyy] [namespace inscope :: {foo::bar::xxx::yyy}] - # now with existsing ::foo::bar::xxx, but without unknown handler inside (only parent ::foo::bar has a handler): - namespace eval ::foo::bar::xxx {} - lappend res [namespace inscope ::foo::bar {xxx::yyy}] [namespace inscope ::foo {bar::xxx::yyy}] [::foo::bar::xxx::yyy] [namespace inscope :: {foo::bar::xxx::yyy}] -} -cleanup { - namespace delete ::foo - unset -nocomplain res -} -result [lrepeat 2 \ - {::foo:bar:_unknown ::foo::bar xxx::yyy} {::foo:bar:_unknown ::foo bar::xxx::yyy} {::foo:bar:_unknown :: ::foo::bar::xxx::yyy} {::foo:bar:_unknown :: foo::bar::xxx::yyy} -] -test namespace-52.14 {unknown: it must consider alternate search path (relative global NS), bug 910d67a229fe7f65} -body { - namespace eval ::foo::bar {} - namespace eval ::xxx::yyy { - proc _unknown args {list ::xxx:yyy:_unknown [uplevel {namespace current}] $args} - namespace unknown [namespace current]::_unknown - } - set res {} - lappend res [namespace inscope ::foo::bar {xxx::yyy::cmd}] [namespace inscope ::foo {xxx::yyy::cmd}] - namespace eval ::foo::bar::xxx {} - lappend res [namespace inscope ::foo::bar {xxx::yyy::cmd}] [namespace inscope ::foo {xxx::yyy::cmd}] - namespace eval ::foo::bar::xxx::yyy {} - lappend res [namespace inscope ::foo::bar {xxx::yyy::cmd}] [namespace inscope ::foo {xxx::yyy::cmd}] -} -cleanup { - namespace delete ::foo - namespace delete ::xxx - unset -nocomplain res -} -result [lrepeat 3 {::xxx:yyy:_unknown ::foo::bar xxx::yyy::cmd} {::xxx:yyy:_unknown ::foo xxx::yyy::cmd}] # TIP 314 - ensembles with parameters test namespace-53.1 {ensembles: parameters} { -- cgit v0.12 From 4fe5cc0e44e83f9a1d4fa25e5f3cb4ffc08ddff7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 18 Mar 2024 16:18:00 +0000 Subject: Review: use more "LL". Eliminate some (Tcl_WideInt) typecasts. --- generic/tclClock.c | 8 ++++---- generic/tclClockFmt.c | 12 ++++++------ 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index c49b1b4..5b0e5b1 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -2403,7 +2403,7 @@ ConvertUTCToLocalUsingC( * Convert that value to seconds. */ - fields->localSeconds = (((fields->julianDay * (Tcl_WideInt) 24 + fields->localSeconds = (((fields->julianDay * 24LL + timeVal->tm_hour) * 60 + timeVal->tm_min) * 60 + timeVal->tm_sec) - JULIAN_SEC_POSIX_EPOCH; @@ -3178,7 +3178,7 @@ ClockClicksObjCmd( switch (index) { case CLICKS_MILLIS: Tcl_GetTime(&now); - clicks = (Tcl_WideInt)now.sec * 1000 + now.usec / 1000; + clicks = now.sec * 1000LL + now.usec / 1000; break; case CLICKS_NATIVE: #ifdef TCL_WIDE_CLICKS @@ -3787,8 +3787,8 @@ ClockScanCommit( if (info->flags & (CLF_ASSEMBLE_SECONDS)) { yydate.localSeconds = - -210866803200L - + ( SECONDS_PER_DAY * (Tcl_WideInt)yydate.julianDay ) + -210866803200LL + + ( SECONDS_PER_DAY * yydate.julianDay ) + ( yySecondOfDay % SECONDS_PER_DAY ); } diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 66dbf6b..d2175e6 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -231,9 +231,9 @@ _witoaw( if (val >= 0) { /* check resp. recalculate width */ - if (val >= 10000000000L) { + if (val >= 10000000000LL) { Tcl_WideInt val2; - val2 = val / 10000000000L; + val2 = val / 10000000000LL; while (width <= 9 && val2 >= wrange[width]) { width++; } @@ -263,9 +263,9 @@ _witoaw( if (!width) width++; /* check resp. recalculate width (regarding sign) */ width--; - if (val <= -10000000000L) { + if (val <= -10000000000LL) { Tcl_WideInt val2; - val2 = val / 10000000000L; + val2 = val / 10000000000LL; while (width <= 9 && val2 <= -wrange[width]) { width++; } @@ -1663,7 +1663,7 @@ done: yydate.julianDay = intJD; yydate.seconds = - -210866803200L + -210866803200LL + ( SECONDS_PER_DAY * intJD ) + ( fractJD ); @@ -1823,7 +1823,7 @@ ClockScnToken_StarDate_Proc(TCL_UNUSED(ClockFmtScnCmdArgs *), GetJulianDayFromEraYearDay(&yydate, GREGORIAN_CHANGE_DATE); yydate.localSeconds = - -210866803200L + -210866803200LL + ( SECONDS_PER_DAY * yydate.julianDay ) + ( SECONDS_PER_DAY * fractDay / fractDayDiv ); -- cgit v0.12 From 8925939c12d52f0c01b12796108f74ec08addd1b Mon Sep 17 00:00:00 2001 From: bch Date: Mon, 18 Mar 2024 20:33:55 +0000 Subject: docs - note that Tcl_AsyncMark() and Tcl_AsyncDelete() are actually void funcs --- doc/Async.3 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/doc/Async.3 b/doc/Async.3 index 45ae587..493c000 100644 --- a/doc/Async.3 +++ b/doc/Async.3 @@ -17,6 +17,7 @@ Tcl_AsyncCreate, Tcl_AsyncMark, Tcl_AsyncMarkFromSignal, Tcl_AsyncInvoke, Tcl_As Tcl_AsyncHandler \fBTcl_AsyncCreate\fR(\fIproc, clientData\fR) .sp +void \fBTcl_AsyncMark\fR(\fIasync\fR) .sp int @@ -25,6 +26,7 @@ int int \fBTcl_AsyncInvoke\fR(\fIinterp, code\fR) .sp +void \fBTcl_AsyncDelete\fR(\fIasync\fR) .sp int -- cgit v0.12 From 780e71600c142bee274fbf209304fb0ef2153143 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 19 Mar 2024 14:56:45 +0000 Subject: Fix indentation/brace usage style issues --- generic/tclArithSeries.c | 32 +++--- generic/tclAssembly.c | 1 - generic/tclBasic.c | 31 ++++-- generic/tclBinary.c | 3 +- generic/tclClock.c | 4 +- generic/tclCmdAH.c | 60 +++++------ generic/tclCmdIL.c | 28 ++--- generic/tclCmdMZ.c | 9 +- generic/tclCompCmds.c | 8 +- generic/tclCompCmdsSZ.c | 6 +- generic/tclCompile.c | 12 +-- generic/tclDictObj.c | 12 +-- generic/tclDisassemble.c | 4 +- generic/tclEncoding.c | 34 +++--- generic/tclEnsemble.c | 9 +- generic/tclEvent.c | 6 +- generic/tclExecute.c | 87 ++++++--------- generic/tclFCmd.c | 20 ++-- generic/tclFileName.c | 16 +-- generic/tclHash.c | 7 +- generic/tclIO.c | 120 +++++++++++---------- generic/tclIOCmd.c | 16 +-- generic/tclIORChan.c | 6 +- generic/tclIORTrans.c | 8 +- generic/tclIOUtil.c | 18 ++-- generic/tclIndexObj.c | 26 ++--- generic/tclListObj.c | 246 +++++++++++++++++++++--------------------- generic/tclLoad.c | 10 +- generic/tclOO.c | 5 +- generic/tclOOMethod.c | 5 +- generic/tclObj.c | 6 +- generic/tclParse.c | 2 +- generic/tclPathObj.c | 19 ++-- generic/tclProc.c | 9 +- generic/tclProcess.c | 121 ++++++++++++++------- generic/tclRegexp.c | 4 +- generic/tclScan.c | 2 +- generic/tclStrToD.c | 22 ++-- generic/tclStringObj.c | 40 ++++--- generic/tclStubInit.c | 10 +- generic/tclTestObj.c | 20 ++-- generic/tclTrace.c | 9 +- generic/tclUtf.c | 15 ++- generic/tclUtil.c | 39 +++---- generic/tclVar.c | 4 +- generic/tclZipfs.c | 158 ++++++++++++++------------- unix/tclLoadDyld.c | 16 ++- unix/tclUnixSock.c | 1 - unix/tclUnixTest.c | 2 +- unix/tclXtNotify.c | 2 +- unix/tclXtTest.c | 2 +- win/tclWinChan.c | 2 +- win/tclWinConsole.c | 274 ++++++++++++++++++++++------------------------- win/tclWinFCmd.c | 19 ++-- win/tclWinFile.c | 4 +- win/tclWinInit.c | 4 +- win/tclWinLoad.c | 2 +- win/tclWinNotify.c | 4 +- win/tclWinPipe.c | 2 +- win/tclWinReg.c | 3 +- win/tclWinSock.c | 6 +- win/tclWinTest.c | 9 +- 62 files changed, 852 insertions(+), 829 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 43a9995..50c8b13 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -339,7 +339,9 @@ NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_Wide ArithSeries *arithSeriesRepPtr; length = len>=0 ? len : -1; - if (length < 0) length = -1; + if (length < 0) { + length = -1; + } TclNewObj(arithSeriesObj); @@ -357,8 +359,9 @@ NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_Wide arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr; arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL; arithSeriesObj->typePtr = &arithSeriesType; - if (length > 0) + if (length > 0) { Tcl_InvalidateStringRep(arithSeriesObj); + } return arithSeriesObj; } @@ -644,7 +647,9 @@ TclArithSeriesObjIndex( * *---------------------------------------------------------------------- */ -Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesObj) +Tcl_Size +ArithSeriesObjLength( + Tcl_Obj *arithSeriesObj) { ArithSeries *arithSeriesRepPtr = (ArithSeries*) arithSeriesObj->internalRep.twoPtrValue.ptr1; @@ -757,8 +762,7 @@ TclArithSeriesObjRange( toIdx = arithSeriesRepPtr->len-1; } - if (fromIdx > toIdx || - fromIdx >= arithSeriesRepPtr->len) { + if (fromIdx > toIdx || fromIdx >= arithSeriesRepPtr->len) { TclNewObj(*newObjPtr); return TCL_OK; } @@ -780,8 +784,7 @@ TclArithSeriesObjRange( TclArithSeriesObjStep(arithSeriesObj, &stepObj); Tcl_IncrRefCount(stepObj); - if (Tcl_IsShared(arithSeriesObj) || - ((arithSeriesObj->refCount > 1))) { + if (Tcl_IsShared(arithSeriesObj) || (arithSeriesObj->refCount > 1)) { int status = TclNewArithSeriesObj(NULL, newObjPtr, arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL); @@ -916,9 +919,7 @@ TclArithSeriesGetElements( *objcPtr = objc; } else { if (interp != NULL) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("value is not an arithseries")); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("value is not an arithseries")); Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", (void *)NULL); } return TCL_ERROR; @@ -988,8 +989,7 @@ TclArithSeriesObjReverse( TclSetIntObj(stepObj, step); } - if (Tcl_IsShared(arithSeriesObj) || - ((arithSeriesObj->refCount > 1))) { + if (Tcl_IsShared(arithSeriesObj) || (arithSeriesObj->refCount > 1)) { Tcl_Obj *lenObj; TclNewIntObj(lenObj, len); if (TclNewArithSeriesObj(NULL, &resultObj, isDouble, @@ -1107,12 +1107,14 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr) char *str = Tcl_GetStringFromObj(eleObj, &slen); strcpy(p, str); p[slen] = ' '; - p += slen+1; + p += slen + 1; Tcl_DecrRefCount(eleObj); } // else TODO: report error here? } - if (bytlen > 0) arithSeriesObjPtr->bytes[bytlen-1] = '\0'; - arithSeriesObjPtr->length = bytlen-1; + if (bytlen > 0) { + arithSeriesObjPtr->bytes[bytlen - 1] = '\0'; + } + arithSeriesObjPtr->length = bytlen - 1; } /* diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index ba2e5a7..b041670 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -986,7 +986,6 @@ TclCompileAssembleCmd( if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, TCL_EVAL_DIRECT)) { - Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s\" body, line %d)", (int)parsePtr->tokenPtr->size, parsePtr->tokenPtr->start, diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 5ec29f3..a2f4edc 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -300,12 +300,16 @@ typedef struct { * The built-in commands, and the functions that implement them: */ -int procObjCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) { +static int +procObjCmd( + void *clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ return Tcl_ProcObjCmd(clientData, interp, objc, objv); } - static const CmdInfo builtInCmds[] = { /* * Commands in the generic core. @@ -2689,7 +2693,9 @@ typedef struct { } CmdWrapperInfo; -static int cmdWrapperProc(void *clientData, +static int +cmdWrapperProc( + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj * const *objv) @@ -2701,7 +2707,10 @@ static int cmdWrapperProc(void *clientData, return info->proc(info->clientData, interp, objc, objv); } -static void cmdWrapperDeleteProc(void *clientData) { +static void +cmdWrapperDeleteProc( + void *clientData) +{ CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; clientData = info->deleteData; @@ -3277,7 +3286,9 @@ invokeObj2Command( return result; } -static int cmdWrapper2Proc(void *clientData, +static int +cmdWrapper2Proc( + void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]) @@ -5364,7 +5375,7 @@ TclEvalEx( /* Currently max command words in INT_MAX */ if (additionalObjsCount > INT_MAX || - objectsNeeded > (INT_MAX - additionalObjsCount)) { + objectsNeeded > (INT_MAX - additionalObjsCount)) { code = TclCommandWordLimitError(interp, -1); Tcl_DecrRefCount(objv[objectsUsed]); break; @@ -8469,7 +8480,8 @@ Tcl_NRCallObjProc( return TclNRRunCallbacks(interp, TCL_OK, rootPtr); } -int wrapperNRObjProc( +static int +wrapperNRObjProc( void *clientData, Tcl_Interp *interp, int objc, @@ -8536,7 +8548,8 @@ Tcl_NRCallObjProc2( *---------------------------------------------------------------------- */ -static int cmdWrapperNreProc( +static int +cmdWrapperNreProc( void *clientData, Tcl_Interp *interp, int objc, diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 152b21e..916ba4c 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -961,8 +961,7 @@ BinaryFormatCmd( * The macro evals its args more than once: avoid arg++ */ - if (TclListObjLength(interp, objv[arg], &listc - ) != TCL_OK) { + if (TclListObjLength(interp, objv[arg], &listc) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclClock.c b/generic/tclClock.c index 83da0ef..b870f79 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -2083,7 +2083,9 @@ TzsetIfNecessary(void) wcscpy(tzWas, tzIsNow); } else if (tzIsNow == NULL && tzWas != NULL) { tzset(); - if (tzWas != (WCHAR *)INT2PTR(-1)) Tcl_Free(tzWas); + if (tzWas != (WCHAR *)INT2PTR(-1)) { + Tcl_Free(tzWas); + } tzWas = NULL; } Tcl_MutexUnlock(&clockMutex); diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 1268751..85d8a1c 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -62,7 +62,7 @@ static int GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr, static const char * GetTypeFromMode(int mode); static int StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName, Tcl_StatBuf *statPtr); -static int EachloopCmd(Tcl_Interp *interp, int collect, +static int EachloopCmd(Tcl_Interp *interp, int collect, int objc, Tcl_Obj *const objv[]); static Tcl_NRPostProc CatchObjCmdCallback; static Tcl_NRPostProc ExprCallback; @@ -424,7 +424,7 @@ TclInitEncodingCmd( *------------------------------------------------------------------------ */ static int -EncodingConvertParseOptions ( +EncodingConvertParseOptions( Tcl_Interp *interp, /* For error messages. May be NULL */ int objc, /* Number of arguments */ Tcl_Obj *const objv[], /* Argument objects as passed to command. */ @@ -452,11 +452,9 @@ EncodingConvertParseOptions ( */ if (objc == 1) { -numArgsError: /* ONLY jump here if nothing needs to be freed!!! */ - Tcl_WrongNumArgs(interp, - 1, - objv, - "?-profile profile? ?-failindex var? encoding data"); + numArgsError: /* ONLY jump here if nothing needs to be freed!!! */ + Tcl_WrongNumArgs(interp, 1, objv, + "?-profile profile? ?-failindex var? encoding data"); ((Interp *)interp)->flags |= INTERP_ALTERNATE_WRONG_ARGS; Tcl_WrongNumArgs(interp, 1, objv, "data"); return TCL_ERROR; @@ -469,9 +467,8 @@ numArgsError: /* ONLY jump here if nothing needs to be freed!!! */ } else { int argIndex; for (argIndex = 1; argIndex < (objc-2); ++argIndex) { - if (Tcl_GetIndexFromObj( - interp, objv[argIndex], options, "option", 0, &optIndex) - != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[argIndex], options, "option", + 0, &optIndex) != TCL_OK) { return TCL_ERROR; } if (++argIndex == (objc - 2)) { @@ -480,8 +477,7 @@ numArgsError: /* ONLY jump here if nothing needs to be freed!!! */ switch (optIndex) { case PROFILE: if (TclEncodingProfileNameToId(interp, - Tcl_GetString(objv[argIndex]), - &profile) != TCL_OK) { + Tcl_GetString(objv[argIndex]), &profile) != TCL_OK) { return TCL_ERROR; } break; @@ -491,8 +487,7 @@ numArgsError: /* ONLY jump here if nothing needs to be freed!!! */ } } /* Get encoding after opts so no need to free it on option error */ - if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) - != TCL_OK) { + if (Tcl_GetEncodingFromObj(interp, objv[objc - 2], &encoding) != TCL_OK) { return TCL_ERROR; } dataObj = objv[objc - 1]; @@ -537,9 +532,8 @@ EncodingConvertfromObjCmd( Tcl_Obj *failVarObj; Tcl_Size errorLocation; - if (EncodingConvertParseOptions( - interp, objc, objv, &encoding, &data, &flags, &failVarObj) - != TCL_OK) { + if (EncodingConvertParseOptions(interp, objc, objv, &encoding, &data, + &flags, &failVarObj) != TCL_OK) { return TCL_ERROR; } @@ -552,7 +546,7 @@ EncodingConvertfromObjCmd( return TCL_ERROR; } result = Tcl_ExternalToUtfDStringEx(interp, encoding, bytesPtr, length, flags, - &ds, failVarObj ? &errorLocation : NULL); + &ds, failVarObj ? &errorLocation : NULL); /* NOTE: ds must be freed beyond this point even on error */ switch (result) { case TCL_OK: @@ -583,11 +577,8 @@ EncodingConvertfromObjCmd( if (failVarObj) { Tcl_Obj *failIndex; TclNewIndexObj(failIndex, errorLocation); - if (Tcl_ObjSetVar2(interp, - failVarObj, - NULL, - failIndex, - TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(interp, failVarObj, NULL, failIndex, + TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DStringFree(&ds); return TCL_ERROR; } @@ -630,16 +621,15 @@ EncodingConverttoObjCmd( Tcl_Obj *data; /* String to convert */ Tcl_DString ds; /* Buffer to hold the byte array */ Tcl_Encoding encoding; /* Encoding to use */ - Tcl_Size length; /* Length of the string being converted */ + Tcl_Size length; /* Length of the string being converted */ const char *stringPtr; /* Pointer to the first byte of the string */ int result; int flags; Tcl_Obj *failVarObj; Tcl_Size errorLocation; - if (EncodingConvertParseOptions( - interp, objc, objv, &encoding, &data, &flags, &failVarObj) - != TCL_OK) { + if (EncodingConvertParseOptions(interp, objc, objv, &encoding, &data, + &flags, &failVarObj) != TCL_OK) { return TCL_ERROR; } @@ -649,7 +639,7 @@ EncodingConverttoObjCmd( stringPtr = Tcl_GetStringFromObj(data, &length); result = Tcl_UtfToExternalDStringEx(interp, encoding, stringPtr, length, flags, - &ds, failVarObj ? &errorLocation : NULL); + &ds, failVarObj ? &errorLocation : NULL); /* NOTE: ds must be freed beyond this point even on error */ switch (result) { @@ -679,20 +669,18 @@ EncodingConverttoObjCmd( */ if (failVarObj) { Tcl_Obj *failIndex; + TclNewIndexObj(failIndex, errorLocation); - if (Tcl_ObjSetVar2(interp, - failVarObj, - NULL, - failIndex, - TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(interp, failVarObj, NULL, failIndex, + TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DStringFree(&ds); return TCL_ERROR; } } - Tcl_SetObjResult(interp, - Tcl_NewByteArrayObj((unsigned char*) Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds))); + Tcl_SetObjResult(interp, Tcl_NewByteArrayObj( + (unsigned char*) Tcl_DStringValue(&ds), + Tcl_DStringLength(&ds))); Tcl_DStringFree(&ds); /* We're done with the encoding */ diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index fec8fcf..4474513 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2174,9 +2174,8 @@ Tcl_JoinObjCmd( if (TclObjTypeHasProc(objv[1], getElementsProc)) { listLen = TclObjTypeLength(objv[1]); isAbstractList = (listLen ? 1 : 0); - if (listLen > 1 && - TclObjTypeGetElements(interp, objv[1], &listLen, &elemPtrs) - != TCL_OK) { + if (listLen > 1 && TclObjTypeGetElements(interp, objv[1], + &listLen, &elemPtrs) != TCL_OK) { return TCL_ERROR; } } else if (TclListObjGetElements(interp, objv[1], &listLen, @@ -2194,8 +2193,8 @@ Tcl_JoinObjCmd( Tcl_SetObjResult(interp, elemPtrs[0]); } else { Tcl_Obj *elemObj; - if (TclObjTypeIndex(interp, objv[1], 0, &elemObj) - != TCL_OK) { + + if (TclObjTypeIndex(interp, objv[1], 0, &elemObj) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, elemObj); @@ -2289,6 +2288,7 @@ Tcl_LassignObjCmd( objv += 2; for (i = 0; i < objc && i < listObjc; ++i) { Tcl_Obj *elemObj; + if (Tcl_ListObjIndex(interp, listPtr, i, &elemObj) != TCL_OK) { return TCL_ERROR; } @@ -2299,8 +2299,8 @@ Tcl_LassignObjCmd( * the elemObj is stored in the var. See tests 6.{25,26} */ Tcl_IncrRefCount(elemObj); - if (Tcl_ObjSetVar2(interp, *objv++, NULL, elemObj, TCL_LEAVE_ERR_MSG) == - NULL) { + if (Tcl_ObjSetVar2(interp, *objv++, NULL, elemObj, + TCL_LEAVE_ERR_MSG) == NULL) { Tcl_DecrRefCount(elemObj); return TCL_ERROR; } @@ -2334,8 +2334,7 @@ Tcl_LassignObjCmd( interp, listPtr, fromIdx, toIdx, &resultObjPtr) != TCL_OK) { return TCL_ERROR; } - } - else { + } else { resultObjPtr = TclListObjRange( interp, listPtr, origListObjc - listObjc, origListObjc - 1); if (resultObjPtr == NULL) { @@ -3196,7 +3195,7 @@ Tcl_LreverseObjCmd( } if (Tcl_IsShared(objv[1]) - || ListObjRepIsShared(objv[1])) { /* Bug 1675044 */ + || ListObjRepIsShared(objv[1])) { /* Bug 1675044 */ Tcl_Obj *resultObj, **dataArray; ListRep listRep; @@ -4395,7 +4394,9 @@ Tcl_LseqObjCmd( done: // Free number arguments. while (--value_i>=0) { - if (numValues[value_i]) Tcl_DecrRefCount(numValues[value_i]); + if (numValues[value_i]) { + Tcl_DecrRefCount(numValues[value_i]); + } } // Free constants @@ -4904,8 +4905,7 @@ Tcl_LsortObjCmd( } else if (sortMode == SORTMODE_REAL) { double a; - if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr, - &a) != TCL_OK) { + if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done; } @@ -5368,7 +5368,7 @@ DictionaryCompare( int secondaryDiff = 0; while (1) { - if (isdigit(UCHAR(*right)) /* INTL: digit */ + if (isdigit(UCHAR(*right)) /* INTL: digit */ && isdigit(UCHAR(*left))) { /* INTL: digit */ /* * There are decimal numbers embedded in the two strings. Compare diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index a887aaf..56d4cca 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -30,9 +30,9 @@ static Tcl_NRPostProc TryPostFinal; static Tcl_NRPostProc TryPostHandler; static int UniCharIsAscii(int character); static int UniCharIsHexDigit(int character); -static int StringCmpOpts(Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[], int *nocase, - Tcl_Size *reqlength); +static int StringCmpOpts(Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[], int *nocase, + Tcl_Size *reqlength); /* * Default set of characters to trim in [string trim] and friends. This is a @@ -2241,8 +2241,7 @@ StringMatchCmd( Tcl_Size length; const char *string = Tcl_GetStringFromObj(objv[1], &length); - if ((length > 1) && - strncmp(string, "-nocase", length) == 0) { + if ((length > 1) && strncmp(string, "-nocase", length) == 0) { nocase = TCL_MATCH_NOCASE; } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 818b96b..98b1ec6 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -772,8 +772,8 @@ TclCompileClockClicksCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD - || tokenPtr[1].size < 4 - || tokenPtr[1].size > 13) { + || tokenPtr[1].size < 4 + || tokenPtr[1].size > 13) { return TCL_ERROR; } else if (!strncmp(tokenPtr[1].start, "-microseconds", tokenPtr[1].size)) { @@ -3570,8 +3570,8 @@ TclPushVarName( */ simpleVarName = 0; - for (p = varTokenPtr[1].start, - last = p + varTokenPtr[1].size; p < last; p++) { + for (p = varTokenPtr[1].start, last = p + varTokenPtr[1].size; + p < last; p++) { if (*p == '(') { simpleVarName = 1; break; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index b25862f..5f221bd 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -42,11 +42,11 @@ static int CompileUnaryOpCmd(Tcl_Interp *interp, static void IssueSwitchChainedTests(Tcl_Interp *interp, CompileEnv *envPtr, int mode, int noCase, Tcl_Size numWords, Tcl_Token **bodyToken, - Tcl_Size *bodyLines, Tcl_Size **bodyNext); + Tcl_Size *bodyLines, Tcl_Size **bodyNext); static void IssueSwitchJumpTable(Tcl_Interp *interp, CompileEnv *envPtr, int numWords, - Tcl_Token **bodyToken, Tcl_Size *bodyLines, - Tcl_Size **bodyContLines); + Tcl_Token **bodyToken, Tcl_Size *bodyLines, + Tcl_Size **bodyContLines); static int IssueTryClausesInstructions(Tcl_Interp *interp, CompileEnv *envPtr, Tcl_Token *bodyToken, int numHandlers, int *matchCodes, diff --git a/generic/tclCompile.c b/generic/tclCompile.c index e321fc7..9866ce2 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -2182,7 +2182,7 @@ TclCompileScript( */ if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "too many nested compilations (infinite loop?)", -1)); + "too many nested compilations (infinite loop?)", -1)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", (void *)NULL); TclCompileSyntaxError(interp, envPtr); return; @@ -2200,10 +2200,10 @@ TclCompileScript( * Note this gets -errorline as 1. Not worth figuring out which line * crosses the limit to get -errorline for this error case. */ - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("Script length %" TCL_SIZE_MODIFIER - "d exceeds max permitted length %d.", - numBytes, INT_MAX-1)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Script length %" TCL_SIZE_MODIFIER + "d exceeds max permitted length %d.", + numBytes, INT_MAX-1)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "SCRIPTLENGTH", (void *)NULL); TclCompileSyntaxError(interp, envPtr); return; @@ -2507,7 +2507,7 @@ TclCompileTokens( */ if ((length == 1) && (buffer[0] == ' ') && - (tokenPtr->start[1] == '\n')) { + (tokenPtr->start[1] == '\n')) { if (isLiteral) { int clPos = Tcl_DStringLength(&textBuffer); diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 43f003b..8b7bc3d 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -3844,7 +3844,7 @@ DictAsListLength( int literal; if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem, - &elemStart, &nextElem, &elemSize, &literal)) { + &elemStart, &nextElem, &elemSize, &literal)) { Tcl_DecrRefCount(elemPtr); return 0; } @@ -3854,14 +3854,14 @@ DictAsListLength( TclInvalidateStringRep(elemPtr); check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL, - elemSize); + elemSize); if (elemSize && check == NULL) { Tcl_DecrRefCount(elemPtr); return 0; } if (!literal) { Tcl_InitStringRep(elemPtr, NULL, - TclCopyAndCollapse(elemSize, elemStart, check)); + TclCopyAndCollapse(elemSize, elemStart, check)); } llen++; } @@ -3916,7 +3916,7 @@ DictAsListIndex( int literal; if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem, - &elemStart, &nextElem, &elemSize, &literal)) { + &elemStart, &nextElem, &elemSize, &literal)) { Tcl_DecrRefCount(elemPtr); return 0; } @@ -3926,7 +3926,7 @@ DictAsListIndex( TclInvalidateStringRep(elemPtr); check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL, - elemSize); + elemSize); if (elemSize && check == NULL) { Tcl_DecrRefCount(elemPtr); if (interp) { @@ -3936,7 +3936,7 @@ DictAsListIndex( } if (!literal) { Tcl_InitStringRep(elemPtr, NULL, - TclCopyAndCollapse(elemSize, elemStart, check)); + TclCopyAndCollapse(elemSize, elemStart, check)); } if (llen == index) { *elemObjPtr = elemPtr; diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 527f78f..1a41562 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -778,9 +778,9 @@ TclGetInnerContext( if (!objPtr) { Tcl_Panic("InnerContext: bad tos -- appending null object"); } - if ((objPtr->refCount<=0) + if ((objPtr->refCount <= 0) #ifdef TCL_MEM_DEBUG - || (objPtr->refCount==0x61616161) + || (objPtr->refCount == 0x61616161) #endif ) { Tcl_Panic("InnerContext: bad tos -- appending freed object %p", diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index f60f949..1b71026 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1236,7 +1236,7 @@ Tcl_ExternalToUtfDStringEx( * and loop. Otherwise, return the result we got. */ if ((result != TCL_CONVERT_NOSPACE) && - !(result == TCL_CONVERT_MULTIBYTE && (flags & TCL_ENCODING_END))) { + !(result == TCL_CONVERT_MULTIBYTE && (flags & TCL_ENCODING_END))) { Tcl_Size nBytesProcessed = (src - srcStart); Tcl_DStringSetLength(dstPtr, soFar); @@ -1251,14 +1251,12 @@ Tcl_ExternalToUtfDStringEx( if (result != TCL_OK && interp != NULL) { char buf[TCL_INTEGER_SPACE]; snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "d", nBytesProcessed); - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("unexpected byte sequence starting at index %" - TCL_SIZE_MODIFIER "d: '\\x%02X'", - nBytesProcessed, - UCHAR(srcStart[nBytesProcessed]))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unexpected byte sequence starting at index %" + TCL_SIZE_MODIFIER "d: '\\x%02X'", + nBytesProcessed, UCHAR(srcStart[nBytesProcessed]))); Tcl_SetErrorCode( - interp, "TCL", "ENCODING", "ILLEGALSEQUENCE", buf, (void *)NULL); + interp, "TCL", "ENCODING", "ILLEGALSEQUENCE", buf, (void *)NULL); } } if (result != TCL_OK) { @@ -1563,7 +1561,7 @@ Tcl_UtfToExternalDStringEx( * and loop. Otherwise, return the result we got. */ if ((result != TCL_CONVERT_NOSPACE) && - !(result == TCL_CONVERT_MULTIBYTE && (flags & TCL_ENCODING_END))) { + !(result == TCL_CONVERT_MULTIBYTE && (flags & TCL_ENCODING_END))) { Tcl_Size nBytesProcessed = (src - srcStart); Tcl_Size i = soFar + encodingPtr->nullSize - 1; /* Loop as DStringSetLength only stores one nul byte at a time */ @@ -1582,17 +1580,15 @@ Tcl_UtfToExternalDStringEx( Tcl_Size pos = Tcl_NumUtfChars(srcStart, nBytesProcessed); int ucs4; char buf[TCL_INTEGER_SPACE]; + Tcl_UtfToUniChar(&srcStart[nBytesProcessed], &ucs4); snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "d", nBytesProcessed); - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unexpected character at index %" TCL_SIZE_MODIFIER "u: 'U+%06X'", - pos, - ucs4)); + pos, ucs4)); Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALSEQUENCE", - buf, (void *)NULL); + buf, (void *)NULL); } } if (result != TCL_OK) { @@ -4337,10 +4333,8 @@ TclEncodingProfileNameToId( } } if (interp) { - Tcl_Obj *errorObj; /* This code assumes at least two profiles :-) */ - errorObj = - Tcl_ObjPrintf("bad profile name \"%s\": must be", + Tcl_Obj *errorObj = Tcl_ObjPrintf("bad profile name \"%s\": must be", profileName); for (i = 0; i < (numProfiles - 1); ++i) { Tcl_AppendStringsToObj( @@ -4384,9 +4378,7 @@ TclEncodingProfileIdToName( } } if (interp) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Internal error. Bad profile id \"%d\".", profileValue)); Tcl_SetErrorCode( diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 051eb7f..f4d4504 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -567,8 +567,7 @@ TclNamespaceEnsembleCmd( continue; } do { - if (TclListObjLength(interp, listObj, &len - ) != TCL_OK) { + if (TclListObjLength(interp, listObj, &len) != TCL_OK) { Tcl_DictObjDone(&search); if (patchedDict) { Tcl_DecrRefCount(patchedDict); @@ -2212,9 +2211,9 @@ TclSpellFix( TclNRAddCallback(interp, TclNRReleaseValues, fix, NULL, NULL, NULL); } -Tcl_Obj *const *TclEnsembleGetRewriteValues( - Tcl_Interp *interp /* Current interpreter. */ -) +Tcl_Obj *const * +TclEnsembleGetRewriteValues( + Tcl_Interp *interp) /* Current interpreter. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs; diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 54fe8dc..23925f2 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1609,7 +1609,7 @@ Tcl_VwaitObjCmd( goto needArg; } if (TclGetChannelFromObj(interp, objv[i], &chan, &mode, 0) - != TCL_OK) { + != TCL_OK) { result = TCL_ERROR; goto done; } @@ -1633,7 +1633,7 @@ Tcl_VwaitObjCmd( goto needArg; } if (TclGetChannelFromObj(interp, objv[i], &chan, &mode, 0) - != TCL_OK) { + != TCL_OK) { result = TCL_ERROR; goto done; } @@ -1657,7 +1657,7 @@ Tcl_VwaitObjCmd( endOfOptionLoop: if ((mask & (TCL_FILE_EVENTS | TCL_IDLE_EVENTS | - TCL_TIMER_EVENTS | TCL_WINDOW_EVENTS)) == 0) { + TCL_TIMER_EVENTS | TCL_WINDOW_EVENTS)) == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't wait: would block forever", -1)); Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", (void *)NULL); diff --git a/generic/tclExecute.c b/generic/tclExecute.c index fddceb5..ac27a87 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2281,7 +2281,7 @@ TEBCresume( goto instLoadScalar1; } else if (inst == INST_PUSH1) { PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]); - TRACE_WITH_OBJ(("%u => ", TclGetUInt1AtPtr(pc+1)), OBJ_AT_TOS); + TRACE_WITH_OBJ(("%u => ", TclGetUInt1AtPtr(pc + 1)), OBJ_AT_TOS); inst = *(pc += 2); goto peepholeStart; } else if (inst == INST_START_CMD) { @@ -2289,11 +2289,11 @@ TEBCresume( * Peephole: do not run INST_START_CMD, just skip it */ - iPtr->cmdCount += TclGetUInt4AtPtr(pc+5); + iPtr->cmdCount += TclGetUInt4AtPtr(pc + 5); if (checkInterp) { if (((codePtr->compileEpoch != iPtr->compileEpoch) || - (codePtr->nsEpoch != iPtr->varFramePtr->nsPtr->resolverEpoch)) && - !(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) { + (codePtr->nsEpoch != iPtr->varFramePtr->nsPtr->resolverEpoch)) && + !(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) { goto instStartCmdFailed; } checkInterp = 0; @@ -4763,17 +4763,13 @@ TEBCresume( { Tcl_Size value2Length; Tcl_Obj *indexListPtr = value2Ptr; + if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK) - && ( - !TclHasInternalRep(value2Ptr, &tclListType) - || - ((Tcl_ListObjLength(interp,value2Ptr,&value2Length), + && (!TclHasInternalRep(value2Ptr, &tclListType) + || (Tcl_ListObjLength(interp, value2Ptr, &value2Length), value2Length == 1 ? (indexListPtr = TclListObjGetElement(value2Ptr, 0), 1) - : 0 - )) - ) - ) { + : 0))) { int code; /* increment the refCount of value2Ptr because TclListObjGetElement may @@ -5197,9 +5193,8 @@ TEBCresume( DECACHE_STACK_INFO(); - if (TclGetIntForIndexM( - interp, fromIdxObj, length - end_indicator, &fromIdx) - != TCL_OK) { + if (TclGetIntForIndexM(interp, fromIdxObj, length - end_indicator, + &fromIdx) != TCL_OK) { CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; @@ -5211,9 +5206,8 @@ TEBCresume( } numToDelete = 0; if (toIdxObj) { - if (TclGetIntForIndexM( - interp, toIdxObj, length - end_indicator, &toIdx) - != TCL_OK) { + if (TclGetIntForIndexM(interp, toIdxObj, length - end_indicator, + &toIdx) != TCL_OK) { CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; @@ -5232,13 +5226,8 @@ TEBCresume( if (Tcl_IsShared(valuePtr)) { objResultPtr = Tcl_DuplicateObj(valuePtr); - if (Tcl_ListObjReplace(interp, - objResultPtr, - fromIdx, - numToDelete, - numNewElems, - &OBJ_AT_DEPTH(numNewElems - 1)) - != TCL_OK) { + if (Tcl_ListObjReplace(interp, objResultPtr, fromIdx, numToDelete, + numNewElems, &OBJ_AT_DEPTH(numNewElems - 1)) != TCL_OK) { TRACE_ERROR(interp); Tcl_DecrRefCount(objResultPtr); goto gotError; @@ -5246,13 +5235,8 @@ TEBCresume( TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_V(6, opnd, 1); } else { - if (Tcl_ListObjReplace(interp, - valuePtr, - fromIdx, - numToDelete, - numNewElems, - &OBJ_AT_DEPTH(numNewElems - 1)) - != TCL_OK) { + if (Tcl_ListObjReplace(interp, valuePtr, fromIdx, numToDelete, + numNewElems, &OBJ_AT_DEPTH(numNewElems - 1)) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } @@ -5437,14 +5421,12 @@ TEBCresume( slength = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1; DECACHE_STACK_INFO(); - if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, slength, - &fromIdx) != TCL_OK) { + if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, slength, &fromIdx) != TCL_OK) { CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; } - if (TclGetIntForIndexM(interp, OBJ_AT_TOS, slength, - &toIdx) != TCL_OK) { + if (TclGetIntForIndexM(interp, OBJ_AT_TOS, slength, &toIdx) != TCL_OK) { CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; @@ -5496,10 +5478,8 @@ TEBCresume( TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr))); DECACHE_STACK_INFO(); - if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, slength, - &fromIdx) != TCL_OK - || TclGetIntForIndexM(interp, OBJ_AT_TOS, slength, - &toIdx) != TCL_OK) { + if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, slength, &fromIdx) != TCL_OK + || TclGetIntForIndexM(interp, OBJ_AT_TOS, slength, &toIdx) != TCL_OK) { CACHE_STACK_INFO(); TclDecrRefCount(value3Ptr); TRACE_ERROR(interp); @@ -5511,9 +5491,7 @@ TEBCresume( TclDecrRefCount(OBJ_AT_TOS); (void) POP_OBJECT(); - if ((toIdx < 0) || - (fromIdx > slength) || - (toIdx < fromIdx)) { + if ((toIdx < 0) || (fromIdx > slength) || (toIdx < fromIdx)) { TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr))); TclDecrRefCount(value3Ptr); NEXT_INST_F(1, 0, 0); @@ -5583,10 +5561,10 @@ TEBCresume( end = ustring1 + slength; for (; ustring1 < end; ustring1++) { if ((*ustring1 == *ustring2) && - /* Fix bug [69218ab7b]: restrict max compare length. */ - ((end-ustring1) >= length2) && (length2==1 || - memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) - == 0)) { + /* Fix bug [69218ab7b]: restrict max compare length. */ + ((end - ustring1) >= length2) && (length2 == 1 || + memcmp(ustring1, ustring2, + sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p); p = ustring1 + length2; @@ -7168,7 +7146,6 @@ TEBCresume( searchPtr = (Tcl_DictSearch *)Tcl_Alloc(sizeof(Tcl_DictSearch)); if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr, &valuePtr, &done) != TCL_OK) { - /* * dictPtr is no longer on the stack, and we're not * moving it into the internalrep of an iterator. We need @@ -8206,9 +8183,8 @@ ExecuteExtendedBinaryMathOp( if ((type1 == TCL_NUMBER_INT) && ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) { w1 = *((const Tcl_WideInt *)ptr1); - if (!((w1>0 ? w1 : ~w1) - & -(((Tcl_WideUInt)1) - << (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) { + if (!((w1 > 0 ? w1 : ~w1) & -( + ((Tcl_WideUInt)1) << (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) { WIDE_RESULT((Tcl_WideUInt)w1 << shift); } } @@ -8599,8 +8575,7 @@ ExecuteExtendedBinaryMathOp( switch (opcode) { case INST_ADD: wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 + (Tcl_WideUInt)w2); - if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT)) - { + if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT)) { /* * Check for overflow. */ @@ -8613,8 +8588,7 @@ ExecuteExtendedBinaryMathOp( case INST_SUB: wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 - (Tcl_WideUInt)w2); - if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT)) - { + if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT)) { /* * Must check for overflow. The macro tests for overflows * in sums by looking at the sign bits. As we have a @@ -9077,8 +9051,7 @@ ValidatePcAndStackTop( opCode, relativePc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode"); } - if (checkStack && - (stackTop > stackUpperBound)) { + if (checkStack && (stackTop > stackUpperBound)) { Tcl_Size numChars; const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL); diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index c97997d..0285323 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -1247,12 +1247,12 @@ TclFileLinkCmd( if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) { return TCL_ERROR; } - if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[index]), - TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[index]), + TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + Tcl_DStringFree(&ds); + return TCL_ERROR; + } Tcl_DStringFree(&ds); - return TCL_ERROR; - } - Tcl_DStringFree(&ds); /* * Create link from source to target. @@ -1310,12 +1310,12 @@ TclFileLinkCmd( if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) { return TCL_ERROR; } - if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[index]), - TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, TclGetString(objv[index]), + TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + Tcl_DStringFree(&ds); + return TCL_ERROR; + } Tcl_DStringFree(&ds); - return TCL_ERROR; - } - Tcl_DStringFree(&ds); /* * Read link diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 5e167c7..baa915d 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -113,14 +113,14 @@ ExtractWinRoot( { int extended = 0; - if ( (path[0] == '/' || path[0] == '\\') - && (path[1] == '/' || path[1] == '\\') - && (path[2] == '?') - && (path[3] == '/' || path[3] == '\\')) { + if ( (path[0] == '/' || path[0] == '\\') + && (path[1] == '/' || path[1] == '\\') + && (path[2] == '?') + && (path[3] == '/' || path[3] == '\\')) { extended = 1; path = path + 4; if (path[0] == 'U' && path[1] == 'N' && path[2] == 'C' - && (path[3] == '/' || path[3] == '\\')) { + && (path[3] == '/' || path[3] == '\\')) { extended = 2; path = path + 4; } @@ -583,7 +583,7 @@ Tcl_SplitPath( for (i = 0; i < *argcPtr; i++) { (*argvPtr)[i] = p; - for (; *(p++)!='\0'; ); + while (*(p++) != '\0'); } (*argvPtr)[i] = NULL; @@ -823,8 +823,8 @@ TclpNativeJoinPath( if (length != 0) { if ((p[0] == '.') && (p[1] == '/') && - (tclPlatform==TCL_PLATFORM_WINDOWS) && isalpha(UCHAR(p[2])) - && (p[3] == ':')) { + (tclPlatform==TCL_PLATFORM_WINDOWS) && isalpha(UCHAR(p[2])) + && (p[3] == ':')) { p += 2; } } diff --git a/generic/tclHash.c b/generic/tclHash.c index c45b6c3..d024ecc 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -36,7 +36,7 @@ static Tcl_HashEntry * AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr); static int CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr); -static size_t HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr); +static size_t HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr); /* * Prototypes for the string hash key methods. @@ -45,7 +45,7 @@ static size_t HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr); static Tcl_HashEntry * AllocStringEntry(Tcl_HashTable *tablePtr, void *keyPtr); static int CompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr); -static size_t HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr); +static size_t HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr); /* * Function prototypes for static functions in this file: @@ -286,8 +286,7 @@ CreateHashEntry( } /* if keys pointers or values are equal */ if ((key == hPtr->key.oneWordValue) - || compareKeysProc((void *) key, hPtr) - ) { + || compareKeysProc((void *) key, hPtr)) { if (newPtr) { *newPtr = 0; } diff --git a/generic/tclIO.c b/generic/tclIO.c index 75427de..df9f665 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -28,7 +28,7 @@ typedef struct ChannelHandler { int mask; /* Mask of desired events. */ Tcl_ChannelProc *proc; /* Procedure to call in the type of * Tcl_CreateChannelHandler. */ - void *clientData; /* Argument to pass to procedure. */ + void *clientData; /* Argument to pass to procedure. */ struct ChannelHandler *nextPtr; /* Next one in list of registered handlers. */ } ChannelHandler; @@ -50,11 +50,12 @@ typedef struct ChannelHandler { */ typedef struct NextChannelHandler { - ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in - * this invocation. */ + ChannelHandler *nextHandlerPtr; + /* The next handler to be invoked in + * this invocation. */ struct NextChannelHandler *nestedHandlerPtr; - /* Next nested invocation of - * Tcl_NotifyChannel. */ + /* Next nested invocation of + * Tcl_NotifyChannel. */ } NextChannelHandler; /* @@ -103,7 +104,7 @@ typedef struct CopyState { Tcl_Interp *interp; /* Interp that started the copy. */ Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */ Tcl_Size bufSize; /* Size of appended buffer. */ - char buffer[TCLFLEXARRAY]; /* Copy buffer, this must be the last + char buffer[TCLFLEXARRAY]; /* Copy buffer, this must be the last * field. */ } CopyState; @@ -141,10 +142,11 @@ static Tcl_ThreadDataKey dataKey; */ typedef struct CloseCallback { - Tcl_CloseProc *proc; /* The procedure to call. */ + Tcl_CloseProc *proc; /* The procedure to call. */ void *clientData; /* Arbitrary one-word data to pass - * to the callback. */ - struct CloseCallback *nextPtr; /* For chaining close callbacks. */ + * to the callback. */ + struct CloseCallback *nextPtr; + /* For chaining close callbacks. */ } CloseCallback; /* @@ -174,7 +176,7 @@ static int CloseWrite(Tcl_Interp *interp, Channel *chanPtr); static void CommonGetsCleanup(Channel *chanPtr); static int CopyData(CopyState *csPtr, int mask); static void DeleteTimerHandler(ChannelState *statePtr); -int Lossless(ChannelState *inStatePtr, +static int Lossless(ChannelState *inStatePtr, ChannelState *outStatePtr, long long toRead); static int MoveBytes(CopyState *csPtr); @@ -617,7 +619,7 @@ TclFinalizeIOSubsystem(void) continue; } if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED ) - || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { + || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { ResetFlag(statePtr, BG_FLUSH_SCHEDULED); active = 1; break; @@ -4264,8 +4266,8 @@ WillWrite( { int inputBuffered; - if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) - ) && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){ + if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) + && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){ int ignore; DiscardInputQueued(chanPtr->state, 0); @@ -4286,8 +4288,8 @@ WillRead( Tcl_SetErrno(EINVAL); return -1; } - if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) - ) && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) { + if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL) + && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) { /* * CAVEAT - The assumption here is that FlushChannel() will push out * the bytes of any writes that are in progress. Since this is a @@ -4299,7 +4301,7 @@ WillRead( */ if (FlushChannel(NULL, chanPtr, 0) != 0) { - return -1; + return -1; } } return 0; @@ -4403,14 +4405,11 @@ Write( * current output encoding and strict encoding is active. */ - if ( - (result == TCL_CONVERT_UNKNOWN || result == TCL_CONVERT_SYNTAX) - || - /* - * We're reading from invalid/incomplete UTF-8. - */ - ((result != TCL_OK) && (srcRead + dstWrote == 0)) - ) { + if ((result == TCL_CONVERT_UNKNOWN || result == TCL_CONVERT_SYNTAX) || + /* + * We're reading from invalid/incomplete UTF-8. + */ + ((result != TCL_OK) && (srcRead + dstWrote == 0))) { encodingError = 1; result = TCL_OK; } @@ -6249,7 +6248,9 @@ ReadChars( int factor = *factorPtr; int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR; - if (dstLimit <= 0) dstLimit = INT_MAX; /* avoid overflow */ + if (dstLimit <= 0) { + dstLimit = INT_MAX; /* avoid overflow */ + } (void) Tcl_GetStringFromObj(objPtr, &numBytes); TclAppendUtfToUtf(objPtr, NULL, dstLimit); if (toRead == srcLen) { @@ -6306,12 +6307,8 @@ ReadChars( flags, &statePtr->inputEncodingState, dst, dstLimit, &srcRead, &dstDecoded, &numChars); - if (code == TCL_CONVERT_UNKNOWN || code == TCL_CONVERT_SYNTAX - || ( - code == TCL_CONVERT_MULTIBYTE - && GotFlag(statePtr, CHANNEL_EOF - )) - ) { + if (code == TCL_CONVERT_UNKNOWN || code == TCL_CONVERT_SYNTAX || + (code == TCL_CONVERT_MULTIBYTE && GotFlag(statePtr, CHANNEL_EOF))) { SetFlag(statePtr, CHANNEL_ENCODING_ERROR); code = TCL_OK; } @@ -6686,23 +6683,28 @@ TranslateInputEOL( int numBytes = crFound - src; memmove(dst, src, numBytes); - dst += numBytes; dstLen -= numBytes; - src += numBytes; srcLen -= numBytes; + dst += numBytes; + dstLen -= numBytes; + src += numBytes; + srcLen -= numBytes; if (srcLen == 1) { /* valid src bytes end in \r */ if (eof) { *dst++ = '\r'; - src++; srcLen--; + src++; + srcLen--; } else { lesser = 0; break; } } else if (src[1] == '\n') { *dst++ = '\n'; - src += 2; srcLen -= 2; + src += 2; + srcLen -= 2; } else { *dst++ = '\r'; - src++; srcLen--; + src++; + srcLen--; } dstLen--; lesser = (dstLen < srcLen) ? dstLen : srcLen; @@ -6718,21 +6720,27 @@ TranslateInputEOL( int lesser; if (GotFlag(statePtr, INPUT_SAW_CR) && srcLen) { - if (*src == '\n') { src++; srcLen--; } + if (*src == '\n') { + src++; + srcLen--; + } ResetFlag(statePtr, INPUT_SAW_CR); } lesser = (dstLen < srcLen) ? dstLen : srcLen; - while ((crFound = (const char *)memchr(src, '\r', lesser))) { + while ((crFound = (const char *) memchr(src, '\r', lesser))) { int numBytes = crFound - src; memmove(dst, src, numBytes); dst[numBytes] = '\n'; - dst += numBytes + 1; dstLen -= numBytes + 1; - src += numBytes + 1; srcLen -= numBytes + 1; + dst += numBytes + 1; + dstLen -= numBytes + 1; + src += numBytes + 1; + srcLen -= numBytes + 1; if (srcLen == 0) { SetFlag(statePtr, INPUT_SAW_CR); } else if (*src == '\n') { - src++; srcLen--; + src++; + srcLen--; } lesser = (dstLen < srcLen) ? dstLen : srcLen; } @@ -7152,8 +7160,7 @@ Tcl_Seek( * defined. This means that the channel does not support seeking. */ - if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) - ) { + if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) { Tcl_SetErrno(EINVAL); return -1; } @@ -7317,8 +7324,7 @@ Tcl_Tell( * defined. This means that the channel does not support seeking. */ - if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) - ) { + if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) { Tcl_SetErrno(EINVAL); return -1; } @@ -8698,19 +8704,18 @@ UpdateInterest( TclChannelPreserve((Tcl_Channel)chanPtr); statePtr->timerChanPtr = chanPtr; statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc, chanPtr); + ChannelTimerProc, chanPtr); } } } if (!statePtr->timer - && mask & TCL_WRITABLE - && GotFlag(statePtr, CHANNEL_NONBLOCKING)) { - + && mask & TCL_WRITABLE + && GotFlag(statePtr, CHANNEL_NONBLOCKING)) { TclChannelPreserve((Tcl_Channel)chanPtr); statePtr->timerChanPtr = chanPtr; statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc,chanPtr); + ChannelTimerProc,chanPtr); } @@ -8754,9 +8759,8 @@ ChannelTimerProc( Tcl_Preserve(statePtr); statePtr->timer = NULL; if (statePtr->interestMask & TCL_WRITABLE - && GotFlag(statePtr, CHANNEL_NONBLOCKING) - && !GotFlag(statePtr, BG_FLUSH_SCHEDULED) - ) { + && GotFlag(statePtr, CHANNEL_NONBLOCKING) + && !GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { /* * Restart the timer in case a channel handler reenters the event loop * before UpdateInterest gets called by Tcl_NotifyChannel. @@ -8768,9 +8772,9 @@ ChannelTimerProc( /* The channel may have just been closed from within Tcl_NotifyChannel */ if (!GotFlag(statePtr, CHANNEL_INCLOSE)) { if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA) - && (statePtr->interestMask & TCL_READABLE) - && (statePtr->inQueueHead != NULL) - && IsBufferReady(statePtr->inQueueHead)) { + && (statePtr->interestMask & TCL_READABLE) + && (statePtr->inQueueHead != NULL) + && IsBufferReady(statePtr->inQueueHead)) { /* * Restart the timer in case a channel handler reenters the event loop * before UpdateInterest gets called by Tcl_NotifyChannel. @@ -9810,8 +9814,8 @@ CopyData( if ((size == 0) && Tcl_Eof(inChan) && !(cmdPtr && (mask == 0))) { break; } - if (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) && - !(mask & TCL_READABLE)) { + if (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) + && !(mask & TCL_READABLE)) { if (mask & TCL_WRITABLE) { Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr); } diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 92a84b2..d9d2090 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -41,9 +41,9 @@ static Tcl_ExitProc FinalizeIOCmdTSD; static Tcl_TcpAcceptProc AcceptCallbackProc; static Tcl_ObjCmdProc ChanPendingObjCmd; static Tcl_ObjCmdProc ChanTruncateObjCmd; -static void RegisterTcpServerInterpCleanup( - Tcl_Interp *interp, - AcceptCallback *acceptCallbackPtr); +static void RegisterTcpServerInterpCleanup( + Tcl_Interp *interp, + AcceptCallback *acceptCallbackPtr); static Tcl_InterpDeleteProc TcpAcceptCallbacksDeleteProc; static void TcpServerCloseProc(void *callbackData); static void UnregisterTcpServerInterpCleanupProc( @@ -421,11 +421,11 @@ Tcl_ReadObjCmd( if (i < objc) { if ((TclGetWideIntFromObj(NULL, objv[i], &toRead) != TCL_OK) || (toRead < 0)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "expected non-negative integer but got \"%s\"", - TclGetString(objv[i]))); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", (void *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "expected non-negative integer but got \"%s\"", + TclGetString(objv[i]))); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", (void *)NULL); + return TCL_ERROR; } } diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 74b301b..0bfcb51 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -44,7 +44,7 @@ static void ReflectThread(void *clientData, int action); static int ReflectEventRun(Tcl_Event *ev, int flags); static int ReflectEventDelete(Tcl_Event *ev, void *cd); #endif -static long long ReflectSeekWide(void *clientData, +static long long ReflectSeekWide(void *clientData, long long offset, int mode, int *errorCodePtr); static int ReflectGetOption(void *clientData, Tcl_Interp *interp, const char *optionName, @@ -54,8 +54,8 @@ static int ReflectSetOption(void *clientData, const char *newValue); static int ReflectTruncate(void *clientData, long long length); -static void TimerRunRead(void *clientData); -static void TimerRunWrite(void *clientData); +static void TimerRunRead(void *clientData); +static void TimerRunWrite(void *clientData); /* * The C layer channel type/driver definition used by the reflection. diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 683b7f2..5d00805 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -84,16 +84,16 @@ static const Tcl_ChannelType tclRTransformType = { typedef struct { unsigned char *buf; /* Reference to the buffer area. */ size_t allocated; /* Allocated size of the buffer area. */ - size_t used; /* Number of bytes in the buffer, + size_t used; /* Number of bytes in the buffer, * <= allocated. */ } ResultBuffer; #define ResultLength(r) ((r)->used) /* static int ResultLength(ResultBuffer *r); */ -static inline void ResultClear(ResultBuffer *r); -static inline void ResultInit(ResultBuffer *r); -static inline void ResultAdd(ResultBuffer *r, unsigned char *buf, +static inline void ResultClear(ResultBuffer *r); +static inline void ResultInit(ResultBuffer *r); +static inline void ResultAdd(ResultBuffer *r, unsigned char *buf, size_t toWrite); static inline size_t ResultCopy(ResultBuffer *r, unsigned char *buf, size_t toRead); diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index df2d510..b892d65 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -1340,14 +1340,20 @@ TclFSNormalizeToUniquePath( */ path = Tcl_GetStringFromObj(pathPtr, &i); - if ( (i >= 3) && ( (path[0] == '/' && path[1] == '/') - || (path[0] == '\\' && path[1] == '\\') ) ) { - for ( i = 2; ; i++) { - if (path[i] == '\0') break; - if (path[i] == path[0]) break; + if ((i >= 3) && ((path[0] == '/' && path[1] == '/') + || (path[0] == '\\' && path[1] == '\\'))) { + for (i = 2; ; i++) { + if (path[i] == '\0') { + break; + } + if (path[i] == path[0]) { + break; + } } --i; - if (path[i] == ':') isVfsPath = 1; + if (path[i] == ':') { + isVfsPath = 1; + } } /* diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index e76cca3..438df72 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -203,28 +203,28 @@ Tcl_GetIndexFromObjStruct( if (offset < (Tcl_Size)sizeof(char *)) { if (interp) { - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("Invalid %s value %" TCL_SIZE_MODIFIER "d.", - "struct offset", offset)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Invalid %s value %" TCL_SIZE_MODIFIER "d.", + "struct offset", offset)); } - return TCL_ERROR; + return TCL_ERROR; } /* * See if there is a valid cached result from a previous lookup. */ if (objPtr && !(flags & TCL_INDEX_TEMP_TABLE)) { - irPtr = TclFetchInternalRep(objPtr, &tclIndexType); - if (irPtr) { - indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; - if ((indexRep->tablePtr == tablePtr) - && (indexRep->offset == offset) - && (indexRep->index != TCL_INDEX_NONE)) { - index = indexRep->index; - goto uncachedDone; + irPtr = TclFetchInternalRep(objPtr, &tclIndexType); + if (irPtr) { + indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1; + if ((indexRep->tablePtr == tablePtr) + && (indexRep->offset == offset) + && (indexRep->index != TCL_INDEX_NONE)) { + index = indexRep->index; + goto uncachedDone; + } } } - } /* * Lookup the value of the object in the table. Accept unique diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 47273d8..9513ee0 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -160,11 +160,12 @@ const Tcl_ObjType tclListType = { }; /* Macros to manipulate the List internal rep */ -#define ListRepIncrRefs(repPtr_) \ - do { \ - (repPtr_)->storePtr->refCount++; \ - if ((repPtr_)->spanPtr) \ - (repPtr_)->spanPtr->refCount++; \ +#define ListRepIncrRefs(repPtr_) \ + do { \ + (repPtr_)->storePtr->refCount++; \ + if ((repPtr_)->spanPtr) { \ + (repPtr_)->spanPtr->refCount++; \ + } \ } while (0) /* Returns number of free unused slots at the back of the ListRep's ListStore */ @@ -466,9 +467,7 @@ MemoryAllocationError( size_t size) /* Size of attempted allocation that failed */ { if (interp != NULL) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "list construction failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", size)); @@ -817,19 +816,18 @@ ListStoreNew( * *------------------------------------------------------------------------ */ -ListStore * -ListStoreReallocate (ListStore *storePtr, Tcl_Size needed) +static ListStore * +ListStoreReallocate( + ListStore *storePtr, + Tcl_Size needed) { Tcl_Size capacity; if (needed > LIST_MAX) { return NULL; } - storePtr = (ListStore *)TclAttemptReallocElemsEx(storePtr, - needed, - sizeof(Tcl_Obj *), - offsetof(ListStore, slots), - &capacity); + storePtr = (ListStore *) TclAttemptReallocElemsEx(storePtr, + needed, sizeof(Tcl_Obj *), offsetof(ListStore, slots), &capacity); /* Only the capacity has changed, fix it in the header */ if (storePtr) { storePtr->numAllocated = capacity; @@ -873,8 +871,7 @@ ListRepInit( Tcl_Size objc, Tcl_Obj *const objv[], int flags, - ListRep *repPtr - ) + ListRep *repPtr) { ListStore *storePtr; @@ -964,7 +961,10 @@ ListRepInitAttempt( *------------------------------------------------------------------------ */ static void -ListRepClone(ListRep *fromRepPtr, ListRep *toRepPtr, int flags) +ListRepClone( + ListRep *fromRepPtr, + ListRep *toRepPtr, + int flags) { Tcl_Obj **fromObjs; Tcl_Size numFrom; @@ -993,7 +993,9 @@ ListRepClone(ListRep *fromRepPtr, ListRep *toRepPtr, int flags) * *------------------------------------------------------------------------ */ -static void ListRepUnsharedFreeUnreferenced(const ListRep *repPtr) +static void +ListRepUnsharedFreeUnreferenced( + const ListRep *repPtr) { Tcl_Size count; ListStore *storePtr; @@ -1189,8 +1191,7 @@ TclNewListObj2( Tcl_Size objc1, /* Count of objects referenced by objv1. */ Tcl_Obj *const objv1[], /* First array of pointers to Tcl objects. */ Tcl_Size objc2, /* Count of objects referenced by objv2. */ - Tcl_Obj *const objv2[] /* Second array of pointers to Tcl objects. */ -) + Tcl_Obj *const objv2[]) /* Second array of pointers to Tcl objects. */ { Tcl_Obj *listObj; ListStore *storePtr; @@ -1249,7 +1250,7 @@ TclListObjGetRep( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listObj, /* List object for which an element array is * to be returned. */ - ListRep *repPtr) /* Location to store descriptor */ + ListRep *repPtr) /* Location to store descriptor */ { if (!TclHasInternalRep(listObj, &tclListType)) { int result; @@ -1389,13 +1390,13 @@ TclListObjCopy( */ static void ListRepRange( - ListRep *srcRepPtr, /* Contains source of the range */ - Tcl_Size rangeStart, /* Index of first element to include */ - Tcl_Size rangeEnd, /* Index of last element to include */ - int preserveSrcRep, /* If true, srcRepPtr contents must not be - modified (generally because a shared Tcl_Obj - references it) */ - ListRep *rangeRepPtr) /* Output. Must NOT be == srcRepPtr */ + ListRep *srcRepPtr, /* Contains source of the range */ + Tcl_Size rangeStart, /* Index of first element to include */ + Tcl_Size rangeEnd, /* Index of last element to include */ + int preserveSrcRep, /* If true, srcRepPtr contents must not be + * modified (generally because a shared Tcl_Obj + * references it) */ + ListRep *rangeRepPtr) /* Output. Must NOT be == srcRepPtr */ { Tcl_Obj **srcElems; Tcl_Size numSrcElems = ListRepLength(srcRepPtr); @@ -1447,7 +1448,7 @@ ListRepRange( /* T:listrep-1.10.1,2.8.1 */ *rangeRepPtr = *srcRepPtr; /* Not ref counts not incremented */ } else if (rangeStart == 0 && (!preserveSrcRep) - && (!ListRepIsShared(srcRepPtr) && srcRepPtr->spanPtr == NULL)) { + && (!ListRepIsShared(srcRepPtr) && srcRepPtr->spanPtr == NULL)) { /* Option 1 - Special case unshared, exclude end elements, no span */ LIST_ASSERT(srcRepPtr->storePtr->firstUsed == 0); /* If no span */ ListRepElements(srcRepPtr, numSrcElems, srcElems); @@ -1462,13 +1463,12 @@ ListRepRange( srcRepPtr->storePtr->flags = 0; rangeRepPtr->storePtr = srcRepPtr->storePtr; /* Note no incr ref */ rangeRepPtr->spanPtr = NULL; - } else if (ListSpanMerited(rangeLen, - srcRepPtr->storePtr->numUsed, - srcRepPtr->storePtr->numAllocated)) { + } else if (ListSpanMerited(rangeLen, srcRepPtr->storePtr->numUsed, + srcRepPtr->storePtr->numAllocated)) { /* Option 2 - because span would be most efficient */ Tcl_Size spanStart = ListRepStart(srcRepPtr) + rangeStart; if (!preserveSrcRep && srcRepPtr->spanPtr - && srcRepPtr->spanPtr->refCount <= 1) { + && srcRepPtr->spanPtr->refCount <= 1) { /* If span is not shared reuse it */ /* T:listrep-2.7.3,3.{16,18} */ srcRepPtr->spanPtr->spanStart = spanStart; @@ -1495,10 +1495,8 @@ ListRepRange( /* T:listrep-2.{4,6} */ ListRepElements(srcRepPtr, numSrcElems, srcElems); /* TODO - allocate extra space? */ - ListRepInit(rangeLen, - &srcElems[rangeStart], - LISTREP_PANIC_ON_FAIL, - rangeRepPtr); + ListRepInit(rangeLen, &srcElems[rangeStart], LISTREP_PANIC_ON_FAIL, + rangeRepPtr); } else { /* * Option 4 - modify in place. Note that because of the invariant @@ -1585,8 +1583,9 @@ TclListObjRange( ListRep resultRep; int isShared; - if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) + if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) { return NULL; + } isShared = Tcl_IsShared(listObj); @@ -1745,10 +1744,11 @@ Tcl_ListObjAppendList( * *------------------------------------------------------------------------ */ - int TclListObjAppendElements ( + int + TclListObjAppendElements ( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *toObj, /* List object to append */ - Tcl_Size elemCount, /* Number of elements in elemObjs[] */ + Tcl_Size elemCount, /* Number of elements in elemObjs[] */ Tcl_Obj * const elemObjv[]) /* Objects to append to toObj's list. */ { ListRep listRep; @@ -1760,11 +1760,15 @@ Tcl_ListObjAppendList( Tcl_Panic("%s called with shared object", "TclListObjAppendElements"); } - if (TclListObjGetRep(interp, toObj, &listRep) != TCL_OK) - return TCL_ERROR; /* Cannot be converted to a list */ + if (TclListObjGetRep(interp, toObj, &listRep) != TCL_OK) { + /* Cannot be converted to a list */ + return TCL_ERROR; + } - if (elemCount <= 0) - return TCL_OK; /* Nothing to do. Note AFTER check for list above */ + if (elemCount <= 0) { + /* Nothing to do. Note AFTER check for list above */ + return TCL_OK; + } ListRepElements(&listRep, toLen, toObjv); if (elemCount > LIST_MAX || toLen > (LIST_MAX - elemCount)) { @@ -1789,8 +1793,8 @@ Tcl_ListObjAppendList( if (finalLen > listRep.storePtr->numAllocated) { /* T:listrep-1.{2,11},3.6 */ - ListStore *newStorePtr; - newStorePtr = ListStoreReallocate(listRep.storePtr, finalLen); + ListStore *newStorePtr = ListStoreReallocate( + listRep.storePtr, finalLen); if (newStorePtr == NULL) { return MemoryAllocationError(interp, LIST_SIZE(finalLen)); } @@ -1820,10 +1824,10 @@ Tcl_ListObjAppendList( ListRepUnsharedShiftDown(&listRep, shiftCount); } } /* else T:listrep-3.{4,6} */ - ObjArrayCopy(&listRep.storePtr->slots[ListRepStart(&listRep) - + ListRepLength(&listRep)], - elemCount, - elemObjv); + ObjArrayCopy( + &listRep.storePtr->slots[ + ListRepStart(&listRep) + ListRepLength(&listRep)], + elemCount, elemObjv); listRep.storePtr->numUsed = finalLen; if (listRep.spanPtr) { /* T:listrep-3.{4,5,6} */ @@ -1845,12 +1849,9 @@ Tcl_ListObjAppendList( * not leave space in the front either, assuming all appends and no * prepends. */ - if (ListRepInit(finalLen, - NULL, - listRep.spanPtr ? LISTREP_SPACE_FAVOR_BACK - : LISTREP_SPACE_ONLY_BACK, - &listRep) - != TCL_OK) { + if (ListRepInit(finalLen, NULL, + listRep.spanPtr ? LISTREP_SPACE_FAVOR_BACK : LISTREP_SPACE_ONLY_BACK, + &listRep) != TCL_OK) { return MemoryAllocationError(interp, finalLen); } LIST_ASSERT(listRep.storePtr->numAllocated >= finalLen); @@ -1944,10 +1945,10 @@ Tcl_ListObjAppendElement( */ int Tcl_ListObjIndex( - Tcl_Interp *interp, /* Used to report errors if not NULL. */ - Tcl_Obj *listObj, /* List object to index into. */ - Tcl_Size index, /* Index of element to return. */ - Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */ + Tcl_Interp *interp, /* Used to report errors if not NULL. */ + Tcl_Obj *listObj, /* List object to index into. */ + Tcl_Size index, /* Index of element to return. */ + Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */ { Tcl_Obj **elemObjs; Tcl_Size numElems; @@ -1963,8 +1964,7 @@ Tcl_ListObjIndex( return TclObjTypeIndex(interp, listObj, index, objPtrPtr); } - if (TclListObjGetElements(interp, listObj, &numElems, &elemObjs) - != TCL_OK) { + if (TclListObjGetElements(interp, listObj, &numElems, &elemObjs) != TCL_OK) { return TCL_ERROR; } if ((index < 0) || (index >= numElems)) { @@ -2026,8 +2026,9 @@ Tcl_ListObjLength( return TCL_OK; } -Tcl_Size -ListLength(Tcl_Obj *listPtr) +static Tcl_Size +ListLength( + Tcl_Obj *listPtr) { ListRep listRep; ListObjGetRep(listPtr, &listRep); @@ -2098,11 +2099,13 @@ Tcl_ListObjReplace( if (TclObjTypeHasProc(listObj, replaceProc)) { return TclObjTypeReplace(interp, listObj, first, - numToDelete, numToInsert, insertObjs); + numToDelete, numToInsert, insertObjs); } - if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) - return TCL_ERROR; /* Cannot be converted to a list */ + if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) { + /* Cannot be converted to a list */ + return TCL_ERROR; + } /* Make limits sane */ origListLen = ListRepLength(&listRep); @@ -2204,16 +2207,14 @@ Tcl_ListObjReplace( * NOTE THIS IS TRUE EVEN IF THE ListStore IS SHARED as it will not * affect the other Tcl_Obj's referencing this ListStore. */ - if (first == 0 && /* (i) */ - ListRepStart(&listRep) == listRep.storePtr->firstUsed && /* (ii) */ - numToInsert <= listRep.storePtr->firstUsed /* (iii) */ - ) { + if (first == 0 && /* (i) */ + ListRepStart(&listRep) == listRep.storePtr->firstUsed && /* (ii) */ + numToInsert <= listRep.storePtr->firstUsed) { /* (iii) */ Tcl_Size newLen; LIST_ASSERT(numToInsert); /* Else would have returned above */ listRep.storePtr->firstUsed -= numToInsert; ObjArrayCopy(&listRep.storePtr->slots[listRep.storePtr->firstUsed], - numToInsert, - insertObjs); + numToInsert, insertObjs); listRep.storePtr->numUsed += numToInsert; newLen = listRep.spanPtr->spanLength + numToInsert; if (listRep.spanPtr && listRep.spanPtr->refCount <= 1) { @@ -2258,7 +2259,7 @@ Tcl_ListObjReplace( ListStoreReallocate(listRep.storePtr, origListLen + lenChange); if (newStorePtr == NULL) { return MemoryAllocationError(interp, - LIST_SIZE(origListLen + lenChange)); + LIST_SIZE(origListLen + lenChange)); } listRep.storePtr = newStorePtr; numFreeSlots = @@ -2278,17 +2279,15 @@ Tcl_ListObjReplace( * (c) The new unshared size is much "smaller" (TODO) than the allocated space * TODO - for unshared case ONLY, consider a "move" based implementation */ - if (ListRepIsShared(&listRep) || /* 3a */ - numFreeSlots < lenChange || /* 3b */ - (origListLen + lenChange) < (listRep.storePtr->numAllocated / 4) /* 3c */ - ) { + if (ListRepIsShared(&listRep) || /* 3a */ + numFreeSlots < lenChange || /* 3b */ + (origListLen + lenChange) < + (listRep.storePtr->numAllocated / 4)) { /* 3c */ ListRep newRep; Tcl_Obj **toObjs; listObjs = &listRep.storePtr->slots[ListRepStart(&listRep)]; - ListRepInit(origListLen + lenChange, - NULL, - LISTREP_PANIC_ON_FAIL | favor, - &newRep); + ListRepInit(origListLen + lenChange, NULL, + LISTREP_PANIC_ON_FAIL | favor, &newRep); toObjs = ListRepSlotPtr(&newRep, 0); if (leadSegmentLen > 0) { /* T:listrep-2.{2,3,13:18},4.{6,9,13:18} */ @@ -2296,15 +2295,13 @@ Tcl_ListObjReplace( } if (numToInsert > 0) { /* T:listrep-2.{1,2,3,10:18},4.{1,2,4,6,10:18} */ - ObjArrayCopy(&toObjs[leadSegmentLen], - numToInsert, - insertObjs); + ObjArrayCopy(&toObjs[leadSegmentLen], numToInsert, + insertObjs); } if (tailSegmentLen > 0) { /* T:listrep-2.{1,2,3,10:15},4.{1,2,4,6,9:12,16:18} */ ObjArrayCopy(&toObjs[leadSegmentLen + numToInsert], - tailSegmentLen, - &listObjs[leadSegmentLen+numToDelete]); + tailSegmentLen, &listObjs[leadSegmentLen+numToDelete]); } newRep.storePtr->numUsed = origListLen + lenChange; if (newRep.spanPtr) { @@ -2400,7 +2397,7 @@ Tcl_ListObjReplace( LIST_ASSERT((leadSpace + tailSpace) >= lenChange); if (leadSpace >= lenChange - && (leadSegmentLen < tailSegmentLen || tailSpace < lenChange)) { + && (leadSegmentLen < tailSegmentLen || tailSpace < lenChange)) { /* Move only lead to the front to make more room */ /* T:listrep-3.25,36,38, */ leadShift = -lenChange; @@ -2529,7 +2526,7 @@ Tcl_ListObjReplace( } else { /* T:listrep-1.{1,3,6.1,13,14,16,18,21} */ listRep.spanPtr = ListSpanNew(listRep.storePtr->firstUsed, - listRep.storePtr->numUsed); + listRep.storePtr->numUsed); } } @@ -2568,7 +2565,7 @@ TclLindexList( Tcl_Obj *listObj, /* List being unpacked. */ Tcl_Obj *argObj) /* Index or index list. */ { - Tcl_Size index; /* Index into the list. */ + Tcl_Size index; /* Index into the list. */ Tcl_Obj *indexListCopy; Tcl_Obj **indexObjs; Tcl_Size numIndexObjs; @@ -2580,8 +2577,8 @@ TclLindexList( * see TIP#22 and TIP#33 for the details. */ if (!TclHasInternalRep(argObj, &tclListType) - && TclGetIntForIndexM(NULL, argObj, TCL_SIZE_MAX - 1, &index) - == TCL_OK) { + && TclGetIntForIndexM(NULL, argObj, TCL_SIZE_MAX - 1, + &index) == TCL_OK) { /* * argPtr designates a single index. */ @@ -2658,7 +2655,8 @@ TclLindexFlat( Tcl_Obj *elemObj = listObj; /* for lindex without indices return list */ for (i=0 ; i (int) (sizeof(pendingInvalidates) / sizeof(pendingInvalidates[0]))) { + if (indexCount > (int) (sizeof(pendingInvalidates) / + sizeof(pendingInvalidates[0]))) { pendingInvalidatesPtr = (Tcl_Obj **) Tcl_Alloc(indexCount * sizeof(*pendingInvalidatesPtr)); } @@ -2940,8 +2938,8 @@ TclLsetFlat( * Check for the possible error conditions... */ - if (TclListObjGetElements(interp, subListObj, &elemCount, &elemPtrs) - != TCL_OK) { + if (TclListObjGetElements(interp, subListObj, + &elemCount, &elemPtrs) != TCL_OK) { /* ...the sublist we're indexing into isn't a list at all. */ result = TCL_ERROR; break; @@ -2952,8 +2950,8 @@ TclLsetFlat( * post-increments, avoid '*indexArray++' here. */ - if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, &index) - != TCL_OK) { + if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, + &index) != TCL_OK) { /* ...the index we're trying to use isn't an index at all. */ result = TCL_ERROR; indexArray++; /* Why bother with this increment? TBD */ @@ -2970,18 +2968,14 @@ TclLsetFlat( index = 0; } if (index < 0 || index > elemCount - || (valueObj == NULL && index >= elemCount)) { + || (valueObj == NULL && index >= elemCount)) { /* ...the index points outside the sublist. */ if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("index \"%s\" out of range", - Tcl_GetString(indexArray[-1]))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "index \"%s\" out of range", + Tcl_GetString(indexArray[-1]))); Tcl_SetErrorCode(interp, - "TCL", - "VALUE", - "INDEX" - "OUTOFRANGE", - (void *)NULL); + "TCL", "VALUE", "INDEX" "OUTOFRANGE", (void *)NULL); } result = TCL_ERROR; break; @@ -3076,8 +3070,9 @@ TclLsetFlat( } } - if (pendingInvalidatesPtr != pendingInvalidates) + if (pendingInvalidatesPtr != pendingInvalidates) { Tcl_Free(pendingInvalidatesPtr); + } if (result != TCL_OK) { /* @@ -3320,9 +3315,8 @@ SetListFromAny( Tcl_DictObjSize(NULL, objPtr, &size); /* TODO - leave space in front and/or back? */ - if (ListRepInitAttempt( - interp, size > 0 ? 2 * size : 1, NULL, &listRep) - != TCL_OK) { + if (ListRepInitAttempt(interp, size > 0 ? 2 * size : 1, NULL, + &listRep) != TCL_OK) { return TCL_ERROR; } @@ -3382,8 +3376,7 @@ SetListFromAny( estCount += (estCount == 0); /* Smallest list struct holds 1 * element. */ /* TODO - allocate additional space? */ - if (ListRepInitAttempt(interp, estCount, NULL, &listRep) - != TCL_OK) { + if (ListRepInitAttempt(interp, estCount, NULL, &listRep) != TCL_OK) { return TCL_ERROR; } @@ -3402,7 +3395,7 @@ SetListFromAny( if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem, &elemStart, &nextElem, &elemSize, &literal)) { -fail: + fail: while (--elemPtrs >= listRep.storePtr->slots) { Tcl_DecrRefCount(*elemPtrs); } @@ -3578,7 +3571,10 @@ UpdateStringOfList( *------------------------------------------------------------------------ */ Tcl_Obj * -TclListTestObj(size_t length, size_t leadingSpace, size_t endSpace) +TclListTestObj( + size_t length, + size_t leadingSpace, + size_t endSpace) { ListRep listRep; size_t capacity; diff --git a/generic/tclLoad.c b/generic/tclLoad.c index a2d1919..a689833 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -92,17 +92,17 @@ typedef struct InterpLibrary { static void LoadCleanupProc(void *clientData, Tcl_Interp *interp); -static int IsStatic (LoadedLibrary *libraryPtr); +static int IsStatic(LoadedLibrary *libraryPtr); static int UnloadLibrary(Tcl_Interp *interp, Tcl_Interp *target, LoadedLibrary *library, int keepLibrary, const char *fullFileName, int interpExiting); static int -IsStatic (LoadedLibrary *libraryPtr) { - int res; - res = (libraryPtr->fileName[0] == '\0'); - return res; +IsStatic( + LoadedLibrary *libraryPtr) +{ + return (libraryPtr->fileName[0] == '\0'); } /* diff --git a/generic/tclOO.c b/generic/tclOO.c index 1d72fb0..a028e07 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -1389,7 +1389,10 @@ TclOODecrRefCount( * * ---------------------------------------------------------------------- */ -int TclOOObjectDestroyed(Object *oPtr) { +int +TclOOObjectDestroyed( + Object *oPtr) +{ return (oPtr->namespacePtr == NULL); } diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index b03bbdb..a414ec2 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -761,9 +761,8 @@ InvokeProcedureMethod( * the next thing in the chain. */ - if (TclOOObjectDestroyed(((CallContext *)context)->oPtr) || - Tcl_InterpDeleted(interp) - ) { + if (TclOOObjectDestroyed(((CallContext *)context)->oPtr) + || Tcl_InterpDeleted(interp)) { return TclNRObjectContextInvokeNext(interp, context, objc, objv, Tcl_ObjectContextSkippedArgs(context)); } diff --git a/generic/tclObj.c b/generic/tclObj.c index 2be7bca..85b3155 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -4088,7 +4088,9 @@ TclCompareObjKeys( * If the object pointers are the same then they match. * OPT: this comparison was moved to the caller - if (objPtr1 == objPtr2) return 1; + if (objPtr1 == objPtr2) { + return 1; + } */ /* @@ -4277,7 +4279,7 @@ Tcl_GetCommandFromObj( TclGetCurrentNamespace(interp); if ((resPtr->refNsPtr == NULL) - || ((refNsPtr == resPtr->refNsPtr) + || ((refNsPtr == resPtr->refNsPtr) && (resPtr->refNsId == refNsPtr->nsId) && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) { return (Tcl_Command) cmdPtr; diff --git a/generic/tclParse.c b/generic/tclParse.c index 6417514..84200ac 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -120,7 +120,7 @@ const unsigned char tclCharTypeTable[] = { * Prototypes for local functions defined in this file: */ -static int CommandComplete(const char *script, Tcl_Size numBytes); +static int CommandComplete(const char *script, Tcl_Size numBytes); static Tcl_Size ParseComment(const char *src, Tcl_Size numBytes, Tcl_Parse *parsePtr); static int ParseTokens(const char *src, Tcl_Size numBytes, int mask, diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 249e399..9dc0583 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -276,8 +276,7 @@ TclFSNormalizeAbsolutePath( */ if (tclPlatform != TCL_PLATFORM_WINDOWS - && Tcl_FSGetPathType(linkObj) - == TCL_PATH_RELATIVE) { + && Tcl_FSGetPathType(linkObj) == TCL_PATH_RELATIVE) { /* * We need to follow this link which is relative * to retVal's directory. This means concatenating @@ -406,8 +405,9 @@ TclFSNormalizeAbsolutePath( Tcl_Size len; const char *path = Tcl_GetStringFromObj(retVal, &len); if (zipVolumeLen) { - if (len == (zipVolumeLen - 1)) + if (len == (zipVolumeLen - 1)) { needTrailingSlash = 1; + } } else { if (len == 2 && path[0] != 0 && path[1] == ':') { needTrailingSlash = 1; @@ -2593,9 +2593,8 @@ TclResolveTildePath( if (split == 1) { /* No user name specified -> current user */ - if (MakeTildeRelativePath( - interp, NULL, path[1] ? 2 + path : NULL, &resolvedPath) - != TCL_OK) { + if (MakeTildeRelativePath(interp, NULL, path[1] ? 2 + path : NULL, + &resolvedPath) != TCL_OK) { return NULL; } } else { @@ -2608,11 +2607,9 @@ TclResolveTildePath( expandedUser = Tcl_DStringValue(&userName); /* path[split] is / or \0 */ - if (MakeTildeRelativePath(interp, - expandedUser, - path[split] ? &path[split+1] : NULL, - &resolvedPath) - != TCL_OK) { + if (MakeTildeRelativePath(interp, expandedUser, + path[split] ? &path[split+1] : NULL, + &resolvedPath) != TCL_OK) { Tcl_DStringFree(&userName); return NULL; } diff --git a/generic/tclProc.c b/generic/tclProc.c index 2e424fa..419b9eb 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -608,8 +608,7 @@ TclCreateProc( const char *value = Tcl_GetStringFromObj(fieldValues[1], &valueLength); if ((valueLength != tmpLength) - || memcmp(value, tmpPtr, tmpLength) != 0 - ) { + || memcmp(value, tmpPtr, tmpLength) != 0) { Tcl_Obj *errorObj = Tcl_ObjPrintf( "procedure \"%s\": formal parameter \"", procName); Tcl_AppendObjToObj(errorObj, fieldValues[0]); @@ -1546,8 +1545,7 @@ TclPushProcCallFrame( || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != nsPtr) || (codePtr->nsEpoch != nsPtr->resolverEpoch) - || ((codePtr->procPtr != procPtr) && procPtr->bodyPtr->bytes) - ) { + || ((codePtr->procPtr != procPtr) && procPtr->bodyPtr->bytes)) { goto doCompilation; } } else { @@ -1934,8 +1932,7 @@ TclProcCompileProc( && (codePtr->compileEpoch == iPtr->compileEpoch) && (codePtr->nsPtr == nsPtr) && (codePtr->nsEpoch == nsPtr->resolverEpoch) - && ((codePtr->procPtr == procPtr) || !bodyPtr->bytes) - ) { + && ((codePtr->procPtr == procPtr) || !bodyPtr->bytes)) { return TCL_OK; } diff --git a/generic/tclProcess.c b/generic/tclProcess.c index 719f2e9..968e191 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -30,10 +30,11 @@ typedef struct ProcessInfo { int purge; /* Purge eventualy. */ TclProcessWaitStatus status;/* Process status. */ int code; /* Error code, exit status or signal - number. */ + * number. */ Tcl_Obj *msg; /* Error message. */ Tcl_Obj *error; /* Error code. */ } ProcessInfo; + static Tcl_HashTable infoTablePerPid; static Tcl_HashTable infoTablePerResolvedPid; static int infoTablesInitialized = 0; /* 0 means not yet initialized. */ @@ -76,7 +77,7 @@ void InitProcessInfo( ProcessInfo *info, /* Structure to initialize. */ Tcl_Pid pid, /* Process id. */ - Tcl_Size resolvedPid) /* Resolved process id. */ + Tcl_Size resolvedPid) /* Resolved process id. */ { info->pid = pid; info->resolvedPid = resolvedPid; @@ -144,8 +145,7 @@ FreeProcessInfo( int RefreshProcessInfo( ProcessInfo *info, /* Structure to refresh. */ - int options /* Options passed to WaitProcessStatus. */ -) + int options) /* Options passed to WaitProcessStatus. */ { if (info->status == TCL_PROCESS_UNCHANGED) { /* @@ -154,8 +154,12 @@ RefreshProcessInfo( info->status = WaitProcessStatus(info->pid, info->resolvedPid, options, &info->code, &info->msg, &info->error); - if (info->msg) Tcl_IncrRefCount(info->msg); - if (info->error) Tcl_IncrRefCount(info->error); + if (info->msg) { + Tcl_IncrRefCount(info->msg); + } + if (info->error) { + Tcl_IncrRefCount(info->error); + } return (info->status != TCL_PROCESS_UNCHANGED); } else { /* @@ -192,8 +196,7 @@ WaitProcessStatus( * - errno in case of error. * - non-zero exit code for abormal exit. * - signal number if killed or suspended. - * - Tcl_WaitPid status in all other cases. - */ + * - Tcl_WaitPid status in all other cases. */ Tcl_Obj **msgObjPtr, /* If non-NULL, will receive error message. */ Tcl_Obj **errorObjPtr) /* If non-NULL, will receive error code. */ { @@ -229,9 +232,13 @@ WaitProcessStatus( msg = "child process lost (is SIGCHLD ignored or trapped?)"; } - if (codePtr) *codePtr = errno; - if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf( - "error waiting for process to exit: %s", msg); + if (codePtr) { + *codePtr = errno; + } + if (msgObjPtr) { + *msgObjPtr = Tcl_ObjPrintf( + "error waiting for process to exit: %s", msg); + } if (errorObjPtr) { errorStrings[0] = Tcl_NewStringObj("POSIX", -1); errorStrings[1] = Tcl_NewStringObj(Tcl_ErrnoId(), -1); @@ -240,14 +247,20 @@ WaitProcessStatus( } return TCL_PROCESS_ERROR; } else if (WIFEXITED(waitStatus)) { - if (codePtr) *codePtr = WEXITSTATUS(waitStatus); + if (codePtr) { + *codePtr = WEXITSTATUS(waitStatus); + } if (!WEXITSTATUS(waitStatus)) { /* * Normal exit. */ - if (msgObjPtr) *msgObjPtr = NULL; - if (errorObjPtr) *errorObjPtr = NULL; + if (msgObjPtr) { + *msgObjPtr = NULL; + } + if (errorObjPtr) { + *errorObjPtr = NULL; + } } else { /* * CHILDSTATUS pid code @@ -255,8 +268,10 @@ WaitProcessStatus( * Child exited with a non-zero exit status. */ - if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj( - "child process exited abnormally", -1); + if (msgObjPtr) { + *msgObjPtr = Tcl_NewStringObj( + "child process exited abnormally", -1); + } if (errorObjPtr) { errorStrings[0] = Tcl_NewStringObj("CHILDSTATUS", -1); TclNewIntObj(errorStrings[1], resolvedPid); @@ -273,9 +288,12 @@ WaitProcessStatus( */ msg = Tcl_SignalMsg(WTERMSIG(waitStatus)); - if (codePtr) *codePtr = WTERMSIG(waitStatus); - if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf( - "child killed: %s", msg); + if (codePtr) { + *codePtr = WTERMSIG(waitStatus); + } + if (msgObjPtr) { + *msgObjPtr = Tcl_ObjPrintf("child killed: %s", msg); + } if (errorObjPtr) { errorStrings[0] = Tcl_NewStringObj("CHILDKILLED", -1); TclNewIntObj(errorStrings[1], resolvedPid); @@ -292,9 +310,12 @@ WaitProcessStatus( */ msg = Tcl_SignalMsg(WSTOPSIG(waitStatus)); - if (codePtr) *codePtr = WSTOPSIG(waitStatus); - if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf( - "child suspended: %s", msg); + if (codePtr) { + *codePtr = WSTOPSIG(waitStatus); + } + if (msgObjPtr) { + *msgObjPtr = Tcl_ObjPrintf("child suspended: %s", msg); + } if (errorObjPtr) { errorStrings[0] = Tcl_NewStringObj("CHILDSUSP", -1); TclNewIntObj(errorStrings[1], resolvedPid); @@ -310,9 +331,13 @@ WaitProcessStatus( * Child wait status didn't make sense. */ - if (codePtr) *codePtr = waitStatus; - if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj( - "child wait status didn't make sense\n", -1); + if (codePtr) { + *codePtr = waitStatus; + } + if (msgObjPtr) { + *msgObjPtr = Tcl_NewStringObj( + "child wait status didn't make sense\n", -1); + } if (errorObjPtr) { errorStrings[0] = Tcl_NewStringObj("TCL", -1); errorStrings[1] = Tcl_NewStringObj("OPERATION", -1); @@ -815,7 +840,9 @@ TclProcessCreated( info = (ProcessInfo *) Tcl_GetHashValue(entry); entry2 = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(resolvedPid)); - if (entry2) Tcl_DeleteHashEntry(entry2); + if (entry2) { + Tcl_DeleteHashEntry(entry2); + } FreeProcessInfo(info); } @@ -886,9 +913,13 @@ TclProcessWait( result = WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr, msgObjPtr, errorObjPtr); - if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr); - if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr); - Tcl_MutexUnlock(&infoTablesMutex); + if (msgObjPtr && *msgObjPtr) { + Tcl_IncrRefCount(*msgObjPtr); + } + if (errorObjPtr && *errorObjPtr) { + Tcl_IncrRefCount(*errorObjPtr); + } + Tcl_MutexUnlock(&infoTablesMutex); return result; } @@ -898,8 +929,8 @@ TclProcessWait( * Process has completed but TclProcessWait has already been called, * so report no change. */ - Tcl_MutexUnlock(&infoTablesMutex); + Tcl_MutexUnlock(&infoTablesMutex); return TCL_PROCESS_UNCHANGED; } @@ -908,8 +939,8 @@ TclProcessWait( /* * No change, stop there. */ - Tcl_MutexUnlock(&infoTablesMutex); + Tcl_MutexUnlock(&infoTablesMutex); return TCL_PROCESS_UNCHANGED; } @@ -918,11 +949,21 @@ TclProcessWait( */ result = info->status; - if (codePtr) *codePtr = info->code; - if (msgObjPtr) *msgObjPtr = info->msg; - if (errorObjPtr) *errorObjPtr = info->error; - if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr); - if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr); + if (codePtr) { + *codePtr = info->code; + } + if (msgObjPtr) { + *msgObjPtr = info->msg; + } + if (errorObjPtr) { + *errorObjPtr = info->error; + } + if (msgObjPtr && *msgObjPtr) { + Tcl_IncrRefCount(*msgObjPtr); + } + if (errorObjPtr && *errorObjPtr) { + Tcl_IncrRefCount(*errorObjPtr); + } if (autopurge) { /* @@ -945,3 +986,11 @@ TclProcessWait( Tcl_MutexUnlock(&infoTablesMutex); return result; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 83cd415..49deee6 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -529,8 +529,8 @@ Tcl_RegExpMatchObj( */ if (!(re = Tcl_GetRegExpFromObj(interp, patternObj, - TCL_REG_ADVANCED | TCL_REG_NOSUB)) - && !(re = Tcl_GetRegExpFromObj(interp, patternObj, TCL_REG_ADVANCED))) { + TCL_REG_ADVANCED | TCL_REG_NOSUB)) && + !(re = Tcl_GetRegExpFromObj(interp, patternObj, TCL_REG_ADVANCED))) { return -1; } return Tcl_RegExpExecObj(interp, re, textObj, 0 /* offset */, diff --git a/generic/tclScan.c b/generic/tclScan.c index 3dcc9ea..1fc7e97 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -923,7 +923,7 @@ Tcl_ScanObjCmd( width = ~0; } if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width, - &end, TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_UNDERSCORE | parseFlag)) { + &end, TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_UNDERSCORE | parseFlag)) { Tcl_DecrRefCount(objPtr); if (width < 0) { if (*end == '\0') { diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 4ea590a..87aab60 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -308,7 +308,7 @@ static double MakeNaN(int signum, Tcl_WideUInt tag); #endif static double RefineApproximation(double approx, mp_int *exactSignificand, int exponent); -static mp_err MulPow5(mp_int *, unsigned, mp_int *) MP_WUR; +static mp_err MulPow5(mp_int *, unsigned, mp_int *) MP_WUR; static int NormalizeRightward(Tcl_WideUInt *); static int RequiredPrecision(Tcl_WideUInt); static void DoubleToExpAndSig(double, Tcl_WideUInt *, int *, @@ -592,18 +592,18 @@ TclParseNumber( * V * example: 5___6 */ - for (before=(p-1); - (before && *before=='_'); - before=(before>p ? (before-1):NULL)); - for (after=(p+1); - (after && *after && *after=='_'); - after=(*after&&*after=='_')?(after+1):NULL); + for (before = (p - 1); + (before && *before == '_'); + before = (before > p ? (before - 1) : NULL)); + for (after = (p + 1); + (after && *after && *after == '_'); + after = (*after && *after == '_') ? (after + 1) : NULL); switch (state) { case ZERO_B: case BINARY: if ((before && (*before != '0' && *before != '1')) || - (after && (*after != '0' && *after != '1'))) { + (after && (*after != '0' && *after != '1'))) { /* Not a valid digit */ goto endgame; } @@ -611,7 +611,7 @@ TclParseNumber( case ZERO_O: case OCTAL: if (((before && (*before < '0' || '7' < *before))) || - ((after && (*after < '0' || '7' < *after)))) { + ((after && (*after < '0' || '7' < *after)))) { goto endgame; } break; @@ -624,7 +624,7 @@ TclParseNumber( case EXPONENT_SIGNUM: case EXPONENT: if ((!before || isdigit(UCHAR(*before))) && - (!after || isdigit(UCHAR(*after)))) { + (!after || isdigit(UCHAR(*after)))) { break; } if (after && *after=='(') { @@ -635,7 +635,7 @@ TclParseNumber( case ZERO_X: case HEXADECIMAL: if ( (!before || isxdigit(UCHAR(*before))) && - (!after || isxdigit(UCHAR(*after)))) { + (!after || isxdigit(UCHAR(*after)))) { break; } goto endgame; diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 42eaa8d..4f1a145 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -490,7 +490,7 @@ TclCheckEmptyString( } if (TclIsPureByteArray(objPtr) - && Tcl_GetCharLength(objPtr) == 0) { + && Tcl_GetCharLength(objPtr) == 0) { return TCL_EMPTYSTRING_YES; } @@ -1394,10 +1394,8 @@ Tcl_AppendObjToObj( return; } - if ( - TclIsPureByteArray(appendObjPtr) - && (TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString) - ) { + if (TclIsPureByteArray(appendObjPtr) + && (TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)) { /* * Both bytearray objects are pure, so the second internal bytearray value * can be appended to the first, with no need to modify the "bytes" field. @@ -2192,7 +2190,9 @@ Tcl_AppendFormatToObj( } cmpResult = mp_cmp_d(&big, 0); isNegative = (cmpResult == MP_LT); - if (cmpResult == MP_EQ) gotHash = 0; + if (cmpResult == MP_EQ) { + gotHash = 0; + } if (ch == 'u') { if (isNegative) { mp_clear(&big); @@ -2209,7 +2209,9 @@ Tcl_AppendFormatToObj( goto error; } isNegative = (w < (Tcl_WideInt) 0); - if (w == (Tcl_WideInt) 0) gotHash = 0; + if (w == (Tcl_WideInt) 0) { + gotHash = 0; + } #endif } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) { if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) { @@ -2220,18 +2222,26 @@ Tcl_AppendFormatToObj( if (useShort) { s = (short) l; isNegative = (s < (short) 0); - if (s == (short) 0) gotHash = 0; + if (s == (short) 0) { + gotHash = 0; + } } else { isNegative = (l < (long) 0); - if (l == (long) 0) gotHash = 0; + if (l == (long) 0) { + gotHash = 0; + } } } else if (useShort) { s = (short) l; isNegative = (s < (short) 0); - if (s == (short) 0) gotHash = 0; + if (s == (short) 0) { + gotHash = 0; + } } else { isNegative = (l < (long) 0); - if (l == (long) 0) gotHash = 0; + if (l == (long) 0) { + gotHash = 0; + } } TclNewObj(segment); @@ -2544,7 +2554,9 @@ Tcl_AppendFormatToObj( char *q = TclGetString(segment) + 1; *q = 'x'; q = strchr(q, 'P'); - if (q) *q = 'p'; + if (q) { + *q = 'p'; + } } break; } @@ -3275,11 +3287,11 @@ TclStringCat( Tcl_Obj *objPtr = *ov++; if (objPtr->bytes == NULL - && TclCheckEmptyString(objPtr) != TCL_EMPTYSTRING_YES) { + && TclCheckEmptyString(objPtr) != TCL_EMPTYSTRING_YES) { /* No string rep; Take the chance we can avoid making it */ pendingPtr = objPtr; } else { - (void)Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */ + (void) Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */ } } while (--oc && (length == 0) && (pendingPtr == NULL)); diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 78c2607..6b1dea2 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -305,7 +305,7 @@ TclWinNoBackslash(char *path) return path; } -void *TclWinGetTclInstance() +void *TclWinGetTclInstance(void) { void *hInstance = NULL; GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, @@ -330,8 +330,8 @@ static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){ long longValue; int result = Tcl_ExprLong(interp, expr, &longValue); if (result == TCL_OK) { - if ((longValue >= (long)(INT_MIN)) - && (longValue <= (long)(UINT_MAX))) { + if ((longValue >= (long)(INT_MIN)) + && (longValue <= (long)(UINT_MAX))) { *ptr = (int)longValue; } else { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -346,8 +346,8 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ long longValue; int result = Tcl_ExprLongObj(interp, expr, &longValue); if (result == TCL_OK) { - if ((longValue >= (long)(INT_MIN)) - && (longValue <= (long)(UINT_MAX))) { + if ((longValue >= (long)(INT_MIN)) + && (longValue <= (long)(UINT_MAX))) { *ptr = (int)longValue; } else { Tcl_SetObjResult(interp, Tcl_NewStringObj( diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index c94a0be..1714aad 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -49,17 +49,24 @@ static Tcl_ObjCmdProc TestbigdataCmd; #define VARPTR_KEY "TCLOBJTEST_VARPTR" #define NUMBER_OF_OBJECT_VARS 20 -static void VarPtrDeleteProc(void *clientData, TCL_UNUSED(Tcl_Interp *)) +static void +VarPtrDeleteProc( + void *clientData, + TCL_UNUSED(Tcl_Interp *)) { int i; Tcl_Obj **varPtr = (Tcl_Obj **) clientData; for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { - if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]); + if (varPtr[i]) { + Tcl_DecrRefCount(varPtr[i]); + } } Tcl_Free(varPtr); } -static Tcl_Obj **GetVarPtr(Tcl_Interp *interp) +static Tcl_Obj ** +GetVarPtr( + Tcl_Interp *interp) { Tcl_InterpDeleteProc *proc; @@ -1653,12 +1660,9 @@ TestbigdataCmd ( /* Need one byte for nul terminator */ Tcl_Size limit = TCL_SIZE_MAX-1; if (len < 0 || len > limit) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s is greater than max permitted length %" TCL_SIZE_MODIFIER "d", - Tcl_GetString(objv[2]), - limit)); + Tcl_GetString(objv[2]), limit)); return TCL_ERROR; } diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 0a9e47a..bea59a6 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1985,7 +1985,8 @@ typedef struct { void *clientData; } TraceWrapperInfo; -static int traceWrapperProc( +static int +traceWrapperProc( void *clientData, Tcl_Interp *interp, Tcl_Size level, @@ -2001,7 +2002,9 @@ static int traceWrapperProc( return info->proc(info->clientData, interp, (int)level, command, commandInfo, objc, objv); } -static void traceWrapperDelProc(void *clientData) +static void +traceWrapperDelProc( + void *clientData) { TraceWrapperInfo *info = (TraceWrapperInfo *)clientData; clientData = info->clientData; @@ -2396,7 +2399,7 @@ TclCheckArrayTraces( int code = TCL_OK; if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY) - && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) { + && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) { Interp *iPtr = (Interp *)interp; code = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, name, NULL, diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 0babf4d..3dede09 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -234,8 +234,8 @@ Tcl_UniCharToUtf( ((ch & 0xF800) == 0xD800)) { if (ch & 0x0400) { /* Low surrogate */ - if ( (0x80 == (0xC0 & buf[0])) - && (0 == (0xCF & buf[1]))) { + if ( (0x80 == (0xC0 & buf[0])) + && (0 == (0xCF & buf[1]))) { /* Previous Tcl_UniChar was a high surrogate, so combine */ buf[2] = (char) (0x80 | (0x3F & ch)); buf[1] |= (char) (0x80 | (0x0F & (ch >> 6))); @@ -246,12 +246,11 @@ Tcl_UniCharToUtf( /* High surrogate */ /* Add 0x10000 to the raw number encoded in the surrogate - * pair in order to get the code point. - */ + * pair in order to get the code point. */ ch += 0x40; /* Fill buffer with specific 3-byte (invalid) byte combination, - so following low surrogate can recognize it and combine */ + * so following low surrogate can recognize it and combine */ buf[2] = (char) ((ch << 4) & 0x30); buf[1] = (char) (0x80 | (0x3F & (ch >> 2))); buf[0] = (char) (0xF0 | (0x07 & (ch >> 8))); @@ -268,9 +267,9 @@ Tcl_UniCharToUtf( return 4; } } else if (ch == -1) { - if ( (0x80 == (0xC0 & buf[0])) - && (0 == (0xCF & buf[1])) - && (0xF0 == (0xF8 & buf[-1]))) { + if ( (0x80 == (0xC0 & buf[0])) + && (0 == (0xCF & buf[1])) + && (0xF0 == (0xF8 & buf[-1]))) { ch = 0xD7C0 + ((0x07 & buf[-1]) << 8) + ((0x3F & buf[0]) << 2) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 99d1010..efe7ea9 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1978,7 +1978,7 @@ Tcl_ConcatObj( objPtr = objv[i]; if (TclListObjIsCanonical(objPtr) || - TclObjTypeHasProc(objPtr,indexProc)) { + TclObjTypeHasProc(objPtr, indexProc)) { continue; } (void)Tcl_GetStringFromObj(objPtr, &length); @@ -1991,7 +1991,7 @@ Tcl_ConcatObj( for (i = 0; i < objc; i++) { objPtr = objv[i]; if (!TclListObjIsCanonical(objPtr) && - !TclObjTypeHasProc(objPtr,indexProc)) { + !TclObjTypeHasProc(objPtr, indexProc)) { continue; } if (resPtr) { @@ -2137,7 +2137,7 @@ Tcl_StringCaseMatch( * Skip all successive *'s in the pattern */ - while (*(++pattern) == '*') {} + while (*(++pattern) == '*'); p = *pattern; if (p == '\0') { return 1; @@ -2398,7 +2398,7 @@ TclByteArrayMatch( } } if (TclByteArrayMatch(string, stringEnd - string, - pattern, patternEnd - pattern, 0)) { + pattern, patternEnd - pattern, 0)) { return 1; } if (string == stringEnd) { @@ -3531,7 +3531,6 @@ GetEndOffsetFromObj( * This relies on TclGetString() returning a NUL-terminated string. */ if ((TclMaxListLength(bytes, TCL_INDEX_NONE, NULL) > 1) - /* If it's possible, do the full list parse. */ && (TCL_OK == TclListObjLength(NULL, objPtr, &length)) && (length > 1)) { @@ -3657,7 +3656,7 @@ GetEndOffsetFromObj( /* Parse the integer offset */ if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, - bytes+4, length-4, NULL, TCL_PARSE_INTEGER_ONLY)) { + bytes + 4, length - 4, NULL, TCL_PARSE_INTEGER_ONLY)) { /* Not a recognized integer format */ goto parseError; } @@ -3866,7 +3865,7 @@ TclIndexEncode( * the position after the end and so do not raise an error. */ if ((sizeof(int) != sizeof(Tcl_Size)) && - (wide > INT_MAX) && (wide < WIDE_MAX-1)) { + (wide > INT_MAX) && (wide < WIDE_MAX-1)) { /* 2(a,b) on 64-bit systems*/ goto rangeerror; } @@ -3896,7 +3895,7 @@ TclIndexEncode( * and so do not raise an error. */ if ((sizeof(int) != sizeof(Tcl_Size)) && - (wide > (ENDVALUE - LIST_MAX)) && (wide <= INT_MAX)) { + (wide > (ENDVALUE - LIST_MAX)) && (wide <= INT_MAX)) { /* 1(c), 4(a,b) on 64-bit systems */ goto rangeerror; } @@ -3976,25 +3975,21 @@ TclIndexDecode( *------------------------------------------------------------------------ */ int -TclCommandWordLimitError ( +TclCommandWordLimitError( Tcl_Interp *interp, /* May be NULL */ Tcl_Size count) /* If <= 0, "unknown" */ { if (interp) { if (count > 0) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("Number of words (%" TCL_SIZE_MODIFIER - "d) in command exceeds limit %" TCL_SIZE_MODIFIER - "d.", - count, - (Tcl_Size)INT_MAX)); - } - else { - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("Number of words in command exceeds " - "limit %" TCL_SIZE_MODIFIER "d.", - (Tcl_Size)INT_MAX)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Number of words (%" TCL_SIZE_MODIFIER + "d) in command exceeds limit %" TCL_SIZE_MODIFIER "d.", + count, (Tcl_Size)INT_MAX)); + } else { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Number of words in command exceeds limit %" + TCL_SIZE_MODIFIER "d.", + (Tcl_Size)INT_MAX)); } } return TCL_ERROR; /* Always */ diff --git a/generic/tclVar.c b/generic/tclVar.c index 9f1fbbf..1f5431c 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -986,7 +986,7 @@ TclLookupSimpleVar( localNameStr = Tcl_GetStringFromObj(objPtr, &localLen); if ((varLen == localLen) && (varName[0] == localNameStr[0]) - && !memcmp(varName, localNameStr, varLen)) { + && !memcmp(varName, localNameStr, varLen)) { *indexPtr = i; return (Var *) &varFramePtr->compiledLocals[i]; } @@ -5496,7 +5496,7 @@ TclDeleteVars( } for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL; - varPtr = VarHashFirstVar(tablePtr, &search)) { + varPtr = VarHashFirstVar(tablePtr, &search)) { UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags, -1); VarHashDeleteEntry(varPtr); diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index d9e6299..3aaeb6c 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -267,7 +267,11 @@ typedef struct ZipChannel { int mode; /* O_WRITE, O_APPEND, O_TRUNC etc.*/ unsigned long keys[3]; /* Key for decryption */ } ZipChannel; -static inline int ZipChannelWritable(ZipChannel *info) { + +static inline int +ZipChannelWritable( + ZipChannel *info) +{ return (info->mode & (O_WRONLY | O_RDWR)) != 0; } @@ -467,7 +471,9 @@ static Tcl_ChannelType ZipChannelType = { * *------------------------------------------------------------------------ */ -int TclIsZipfsPath (const char *path) +int +TclIsZipfsPath( + const char *path) { #ifdef _WIN32 return strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) ? 0 : ZIPFS_VOLUME_LEN; @@ -475,7 +481,7 @@ int TclIsZipfsPath (const char *path) int i; for (i = 0; i < ZIPFS_VOLUME_LEN; ++i) { if (path[i] != ZIPFS_VOLUME[i] && - (path[i] != '\\' || ZIPFS_VOLUME[i] != '/')) { + (path[i] != '\\' || ZIPFS_VOLUME[i] != '/')) { return 0; } } @@ -755,10 +761,10 @@ CountSlashes( * *------------------------------------------------------------------------ */ -static int IsCryptHeaderValid( - ZipEntry *z, - unsigned char cryptHeader[ZIP_CRYPT_HDR_LEN] - ) +static int +IsCryptHeaderValid( + ZipEntry *z, + unsigned char cryptHeader[ZIP_CRYPT_HDR_LEN]) { /* * There are multiple possibilities. The last one or two bytes of the @@ -1029,8 +1035,8 @@ NormalizeMountPoint(Tcl_Interp *interp, invalidMountPath: if (interp) { - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("Invalid mount path \"%s\"", mountPath)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Invalid mount path \"%s\"", mountPath)); ZIPFS_ERROR_CODE(interp, "MOUNT_PATH"); } @@ -1199,7 +1205,9 @@ ZipFSLookupZip( *------------------------------------------------------------------------ */ static int -ContainsMountPoint (const char *path, int pathLen) +ContainsMountPoint( + const char *path, + int pathLen) { Tcl_HashEntry *hPtr; Tcl_HashSearch search; @@ -1207,15 +1215,16 @@ ContainsMountPoint (const char *path, int pathLen) if (ZipFS.zipHash.numEntries == 0) { return 0; } - if (pathLen < 0) + if (pathLen < 0) { pathLen = strlen(path); + } /* * We are looking for the case where the path is //zipfs:/a/b * and there is a mount point //zipfs:/a/b/c/.. below it */ for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr; - hPtr = Tcl_NextHashEntry(&search)) { + hPtr = Tcl_NextHashEntry(&search)) { ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr); if (zf->mountPointLen == 0) { @@ -1229,8 +1238,8 @@ ContainsMountPoint (const char *path, int pathLen) for (z = zf->topEnts; z; z = z->tnext) { int lenz = (int) strlen(z->name); if ((lenz >= pathLen) && - (z->name[pathLen] == '/' || z->name[pathLen] == '\0') && - (strncmp(z->name, path, pathLen) == 0)) { + (z->name[pathLen] == '/' || z->name[pathLen] == '\0') && + (strncmp(z->name, path, pathLen) == 0)) { return 1; } } @@ -1477,7 +1486,7 @@ ZipFSFindTOC( * the EOCD. Note this automatically means cdirZipOffset+cdirSize < zf->length. */ if (!(cdirZipOffset <= (size_t)eocdDataOffset && - cdirSize <= eocdDataOffset - cdirZipOffset)) { + cdirSize <= eocdDataOffset - cdirZipOffset)) { if (!needZip) { /* Simply point to end od data */ zf->directoryOffset = zf->baseOffset = zf->passOffset = zf->length; @@ -1525,7 +1534,7 @@ ZipFSFindTOC( size_t localhdr_off = ZipReadInt(start, end, dirEntry + ZIP_CENTRAL_LOCALHDR_OFFS); const unsigned char *localP = zf->data + zf->baseOffset + localhdr_off; if (localP > (cdirStart - ZIP_LOCAL_HEADER_LEN) || - ZipReadInt(start, end, localP) != ZIP_LOCAL_HEADER_SIG) { + ZipReadInt(start, end, localP) != ZIP_LOCAL_HEADER_SIG) { ZIPFS_ERROR(interp, "Failed to find local header"); ZIPFS_ERROR_CODE(interp, "LCL_HDR"); goto error; @@ -1650,8 +1659,8 @@ ZipFSOpenArchive( } /* What's the magic about 64 * 1024 * 1024 ? */ if ((zf->length <= ZIP_CENTRAL_END_LEN) || - (zf->length - ZIP_CENTRAL_END_LEN) > - (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) { + (zf->length - ZIP_CENTRAL_END_LEN) > + (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) { ZIPFS_ERROR(interp, "illegal file size"); ZIPFS_ERROR_CODE(interp, "FILE_SIZE"); goto error; @@ -2344,27 +2353,24 @@ TclZipfs_Mount( Tcl_IncrRefCount(zipPathObj); normZipPathObj = Tcl_FSGetNormalizedPath(interp, zipPathObj); if (normZipPathObj == NULL) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("could not normalize zip filename \"%s\"", zipname)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "could not normalize zip filename \"%s\"", zipname)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NORMALIZE", (void *)NULL); ret = TCL_ERROR; } else { Tcl_IncrRefCount(normZipPathObj); const char *normPath = Tcl_GetString(normZipPathObj); if (passwd == NULL || - (ret = IsPasswordValid(interp, passwd, strlen(passwd))) == - TCL_OK) { + (ret = IsPasswordValid(interp, passwd, + strlen(passwd))) == TCL_OK) { zf = AllocateZipFile(interp, strlen(mountPoint)); if (zf == NULL) { ret = TCL_ERROR; - } - else { + } else { ret = ZipFSOpenArchive(interp, normPath, 1, zf); if (ret != TCL_OK) { Tcl_Free(zf); - } - else { + } else { ret = ZipFSCatalogFilesystem( interp, zf, mountPoint, passwd, normPath); /* Note zf is already freed on error! */ @@ -2440,8 +2446,8 @@ TclZipfs_MountBuffer( */ ret = TCL_ERROR; if ((datalen <= ZIP_CENTRAL_END_LEN) || - (datalen - ZIP_CENTRAL_END_LEN) > - (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) { + (datalen - ZIP_CENTRAL_END_LEN) > + (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) { ZIPFS_ERROR(interp, "illegal file size"); ZIPFS_ERROR_CODE(interp, "FILE_SIZE"); goto done; @@ -4086,10 +4092,9 @@ ZipFSInfoObjCmd( } else { Tcl_SetErrno(ENOENT); if (interp) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("path \"%s\" not found in any zipfs volume", - filename)); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "path \"%s\" not found in any zipfs volume", + filename)); } ret = TCL_ERROR; } @@ -4293,7 +4298,7 @@ TclZipfs_TclLibrary(void) #elif !defined(NO_DLFCN_H) Dl_info dlinfo; if (dladdr((const void *)TclZipfs_TclLibrary, &dlinfo) && (dlinfo.dli_fname != NULL) - && (ZipfsAppHookFindTclInit(dlinfo.dli_fname) == TCL_OK)) { + && (ZipfsAppHookFindTclInit(dlinfo.dli_fname) == TCL_OK)) { return ScriptLibrarySetup(zipfs_literal_tcl_library); } #else @@ -4746,9 +4751,9 @@ ZipChannelOpen( if ((ZipFS.wrmax <= 0) && wr) { Tcl_SetErrno(EACCES); if (interp) { - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("writes not permitted: %s", - Tcl_PosixError(interp))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "writes not permitted: %s", + Tcl_PosixError(interp))); } return NULL; } @@ -4756,11 +4761,10 @@ ZipChannelOpen( if ((mode & (O_APPEND|O_TRUNC)) && !wr) { Tcl_SetErrno(EINVAL); if (interp) { - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("Invalid flags 0x%x. O_APPEND and " - "O_TRUNC require write access: %s", - mode, - Tcl_PosixError(interp))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Invalid flags 0x%x. O_APPEND and " + "O_TRUNC require write access: %s", + mode, Tcl_PosixError(interp))); } return NULL; } @@ -4774,17 +4778,16 @@ ZipChannelOpen( if (!z) { Tcl_SetErrno(wr ? ENOTSUP : ENOENT); if (interp) { - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("file \"%s\" not %s: %s", - filename, - wr ? "created" : "found", - Tcl_PosixError(interp))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "file \"%s\" not %s: %s", + filename, wr ? "created" : "found", + Tcl_PosixError(interp))); } goto error; } if (z->numBytes < 0 || z->numCompressedBytes < 0 || - z->offset >= z->zipFilePtr->length) { + z->offset >= z->zipFilePtr->length) { /* Normally this should only happen for zip64. */ ZIPFS_ERROR(interp, "file size error (may be zip64)"); ZIPFS_ERROR_CODE(interp, "FILE_SIZE"); @@ -4815,8 +4818,9 @@ ZipChannelOpen( goto error; } flags = TCL_WRITABLE; - if (mode & O_RDWR) + if (mode & O_RDWR) { flags |= TCL_READABLE; + } } else { /* Read-only */ flags |= TCL_READABLE; @@ -4949,9 +4953,8 @@ InitWritableChannel( if (z->isEncrypted) { assert(z->numCompressedBytes >= ZIP_CRYPT_HDR_LEN); /* caller should have checked*/ - if (DecodeCryptHeader( - interp, z, info->keys, z->zipFilePtr->data + z->offset) != - TCL_OK) { + if (DecodeCryptHeader(interp, z, info->keys, + z->zipFilePtr->data + z->offset) != TCL_OK) { goto error_cleanup; } } @@ -5017,12 +5020,13 @@ InitWritableChannel( err = inflate(&stream, Z_SYNC_FLUSH); inflateEnd(&stream); if ((err != Z_STREAM_END) && - ((err != Z_OK) || (stream.avail_in != 0))) { + ((err != Z_OK) || (stream.avail_in != 0))) { goto corruptionError; } /* Even if decompression succeeded, counts should be as expected */ - if ((int) stream.total_out != z->numBytes) + if ((int) stream.total_out != z->numBytes) { goto corruptionError; + } info->numBytes = z->numBytes; if (cbuf) { Tcl_Free(cbuf); @@ -5032,8 +5036,9 @@ InitWritableChannel( * Need to decrypt some otherwise-simple stored data. */ if (z->numCompressedBytes <= ZIP_CRYPT_HDR_LEN || - (z->numCompressedBytes - ZIP_CRYPT_HDR_LEN) != z->numBytes) + (z->numCompressedBytes - ZIP_CRYPT_HDR_LEN) != z->numBytes) { goto corruptionError; + } int len = z->numCompressedBytes - ZIP_CRYPT_HDR_LEN; assert(len <= info->ubufSize); for (i = 0; i < len; i++) { @@ -5187,8 +5192,9 @@ InitReadableChannel( goto corruptionError; } /* Even if decompression succeeded, counts should be as expected */ - if ((int) stream.total_out != z->numBytes) + if ((int) stream.total_out != z->numBytes) { goto corruptionError; + } if (ubuf) { info->isEncrypted = 0; @@ -5203,8 +5209,9 @@ InitReadableChannel( * on it, and it can be randomly accessed later. */ if (z->numCompressedBytes <= ZIP_CRYPT_HDR_LEN || - (z->numCompressedBytes - ZIP_CRYPT_HDR_LEN) != z->numBytes) + (z->numCompressedBytes - ZIP_CRYPT_HDR_LEN) != z->numBytes) { goto corruptionError; + } len = z->numCompressedBytes - ZIP_CRYPT_HDR_LEN; ubuf = (unsigned char *) Tcl_AttemptAlloc(len); if (ubuf == NULL) { @@ -5545,7 +5552,7 @@ ZipFSMatchInDirectoryProc( return TCL_ERROR; } if ((wanted & (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE | - TCL_GLOB_TYPE_MOUNT)) == 0) { + TCL_GLOB_TYPE_MOUNT)) == 0) { /* Not looking for files,dirs,mounts. zipfs cannot have others */ return TCL_OK; } @@ -5609,8 +5616,8 @@ ZipFSMatchInDirectoryProc( /* TODO - can't seem to get to this code from script for tests. */ /* Follow logic of what tclUnixFile.c does */ if ((wanted == (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE)) || - (wanted == TCL_GLOB_TYPE_DIR && z->isDirectory) || - (wanted == TCL_GLOB_TYPE_FILE && !z->isDirectory)) { + (wanted == TCL_GLOB_TYPE_DIR && z->isDirectory) || + (wanted == TCL_GLOB_TYPE_FILE && !z->isDirectory)) { Tcl_ListObjAppendElement(NULL, result, pathPtr); } goto end; @@ -5655,17 +5662,17 @@ ZipFSMatchInDirectoryProc( Tcl_HashSearch search; if (foundInHash) { for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); hPtr; - hPtr = Tcl_NextHashEntry(&search)) { + hPtr = Tcl_NextHashEntry(&search)) { z = (ZipEntry *)Tcl_GetHashValue(hPtr); if ((wanted == (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE)) || - (wanted == TCL_GLOB_TYPE_DIR && z->isDirectory) || - (wanted == TCL_GLOB_TYPE_FILE && !z->isDirectory)) { + (wanted == TCL_GLOB_TYPE_DIR && z->isDirectory) || + (wanted == TCL_GLOB_TYPE_FILE && !z->isDirectory)) { if ((z->depth == scnt) && - ((z->flags & ZE_F_VOLUME) == 0) /* Bug 14db54d81e */ - && Tcl_StringCaseMatch(z->name, pat, 0)) { - Tcl_CreateHashEntry( - &duplicates, z->name + strip, ¬Duplicate); + ((z->flags & ZE_F_VOLUME) == 0) /* Bug 14db54d81e */ + && Tcl_StringCaseMatch(z->name, pat, 0)) { + Tcl_CreateHashEntry(&duplicates, z->name + strip, + ¬Duplicate); assert(notDuplicate); AppendWithPrefix(result, prefixBuf, z->name + strip, -1); } @@ -5682,16 +5689,16 @@ ZipFSMatchInDirectoryProc( Tcl_DString ds; Tcl_DStringInit(&ds); for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr; - hPtr = Tcl_NextHashEntry(&search)) { + hPtr = Tcl_NextHashEntry(&search)) { ZipFile *zf = (ZipFile *)Tcl_GetHashValue(hPtr); if (Tcl_StringCaseMatch(zf->mountPoint, pat, 0)) { const char *tail = zf->mountPoint + len; - if (*tail == '\0') + if (*tail == '\0') { continue; + } const char *end = strchr(tail, '/'); - Tcl_DStringAppend(&ds, - zf->mountPoint + strip, - end ? (Tcl_Size)(end - zf->mountPoint) : -1); + Tcl_DStringAppend(&ds, zf->mountPoint + strip, + end ? (Tcl_Size)(end - zf->mountPoint) : -1); const char *matchedPath = Tcl_DStringValue(&ds); (void)Tcl_CreateHashEntry( &duplicates, matchedPath, ¬Duplicate); @@ -6328,7 +6335,8 @@ ZipfsAppHookFindTclInit( * *------------------------------------------------------------------------ */ -void TclZipfsFinalize(void) +void +TclZipfsFinalize(void) { WriteLock(); if (!ZipFS.initialized) { @@ -6560,7 +6568,9 @@ TclZipfs_TclLibrary(void) return NULL; } -int TclIsZipfsPath (const char *path) +int +TclIsZipfsPath( + TCL_UNUSED(const char *)) /* path */ { return 0; } diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c index 7525abe..6aa14b2 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -257,8 +257,12 @@ TclpDlopen( &dyldObjFileImage); if (err == NSObjectFileImageSuccess && dyldObjFileImage) { int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR; - if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE; - if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW; + if (!(flags & 1)) { + nsflags |= NSLINKMODULE_OPTION_PRIVATE; + } + if (!(flags & 2)) { + nsflags |= NSLINKMODULE_OPTION_BINDNOW; + } module = NSLinkModule(dyldObjFileImage, nativePath, nsflags); NSDestroyObjectFileImage(dyldObjFileImage); if (module) { @@ -654,8 +658,12 @@ TclpLoadMemory( * Extract the module we want from the image of the object file. */ - if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE; - if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW; + if (!(flags & 1)) { + nsflags |= NSLINKMODULE_OPTION_PRIVATE; + } + if (!(flags & 2)) { + nsflags |= NSLINKMODULE_OPTION_BINDNOW; + } module = NSLinkModule(dyldObjFileImage, "[Memory Based Bundle]", nsflags); NSDestroyObjectFileImage(dyldObjFileImage); if (!module) { diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 36ed409..78ed008 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -1322,7 +1322,6 @@ TcpConnect( for (statePtr->myaddr = statePtr->myaddrlist; statePtr->myaddr != NULL; statePtr->myaddr = statePtr->myaddr->ai_next) { - /* * No need to try combinations of local and remote addresses of * different families. diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 133cdf6..cdb1caa 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -72,7 +72,7 @@ static Tcl_ObjCmdProc TestfindexecutableCmd; static Tcl_ObjCmdProc TestforkCmd; static Tcl_ObjCmdProc TestgotsigCmd; static Tcl_FileProc TestFileHandlerProc; -static void AlarmHandler(int signum); +static void AlarmHandler(int signum); /* *---------------------------------------------------------------------- diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c index aa88760..8ca2c5f 100644 --- a/unix/tclXtNotify.c +++ b/unix/tclXtNotify.c @@ -91,7 +91,7 @@ static int WaitForEvent(const Tcl_Time * timePtr); * Functions defined in this file for use by users of the Xt Notifier: */ -MODULE_SCOPE void InitNotifier(void); +MODULE_SCOPE void InitNotifier(void); MODULE_SCOPE XtAppContext TclSetAppContext(XtAppContext ctx); /* diff --git a/unix/tclXtTest.c b/unix/tclXtTest.c index 09f454c..c6bcc18 100644 --- a/unix/tclXtTest.c +++ b/unix/tclXtTest.c @@ -21,7 +21,7 @@ static Tcl_ObjCmdProc TesteventloopCmd; * Functions defined in tclXtNotify.c for use by users of the Xt Notifier: */ -extern void InitNotifier(void); +extern void InitNotifier(void); extern XtAppContext TclSetAppContext(XtAppContext ctx); /* diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 5f03138..6413adb 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -98,7 +98,7 @@ static int FileTruncateProc(void *instanceData, long long length); static DWORD FileGetType(HANDLE handle); static int NativeIsComPort(const WCHAR *nativeName); -static Tcl_Channel OpenFileChannel(HANDLE handle, char *channelName, +static Tcl_Channel OpenFileChannel(HANDLE handle, char *channelName, int permissions, int appendMode); /* diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index acd5851..146f6b8 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -178,8 +178,8 @@ typedef struct ConsoleHandleInfo { typedef struct ConsoleChannelInfo { HANDLE handle; /* Console handle */ Tcl_ThreadId threadId; /* Id of owning thread */ - struct ConsoleChannelInfo - *nextWatchingChannelPtr; /* Pointer to next channel watching events. */ + struct ConsoleChannelInfo *nextWatchingChannelPtr; + /* Pointer to next channel watching events. */ Tcl_Channel channel; /* Pointer to channel structure. */ DWORD initMode; /* Initial console mode. */ int numRefs; /* See comments above */ @@ -201,50 +201,51 @@ typedef struct ConsoleChannelInfo { */ typedef struct { - Tcl_Event header; /* Information that is standard for all events. */ - ConsoleChannelInfo *chanInfoPtr; /* Pointer to console info structure. Note - * that we still have to verify that the - * console exists before dereferencing this - * pointer. */ + Tcl_Event header; /* Information that is standard for all events. */ + ConsoleChannelInfo *chanInfoPtr; + /* Pointer to console info structure. Note + * that we still have to verify that the + * console exists before dereferencing this + * pointer. */ } ConsoleEvent; /* * Declarations for functions used only in this file. */ -static int ConsoleBlockModeProc(void *instanceData, int mode); -static void ConsoleCheckProc(void *clientData, int flags); -static int ConsoleCloseProc(void *instanceData, - Tcl_Interp *interp, int flags); -static int ConsoleEventProc(Tcl_Event *evPtr, int flags); -static void ConsoleExitHandler(void *clientData); -static int ConsoleGetHandleProc(void *instanceData, - int direction, void **handlePtr); -static int ConsoleGetOptionProc(void *instanceData, - Tcl_Interp *interp, const char *optionName, - Tcl_DString *dsPtr); -static void ConsoleInit(void); -static int ConsoleInputProc(void *instanceData, char *buf, - int toRead, int *errorCode); -static int ConsoleOutputProc(void *instanceData, - const char *buf, int toWrite, int *errorCode); -static int ConsoleSetOptionProc(void *instanceData, - Tcl_Interp *interp, const char *optionName, - const char *value); -static void ConsoleSetupProc(void *clientData, int flags); -static void ConsoleWatchProc(void *instanceData, int mask); -static void ProcExitHandler(void *clientData); -static void ConsoleThreadActionProc(void *instanceData, int action); -static DWORD ReadConsoleChars(HANDLE hConsole, WCHAR *lpBuffer, - Tcl_Size nChars, Tcl_Size *nCharsReadPtr); -static DWORD WriteConsoleChars(HANDLE hConsole, - const WCHAR *lpBuffer, Tcl_Size nChars, - Tcl_Size *nCharsWritten); -static void RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity); -static void RingBufferClear(RingBuffer *ringPtr); -static Tcl_Size RingBufferIn(RingBuffer *ringPtr, const char *srcPtr, +static int ConsoleBlockModeProc(void *instanceData, int mode); +static void ConsoleCheckProc(void *clientData, int flags); +static int ConsoleCloseProc(void *instanceData, + Tcl_Interp *interp, int flags); +static int ConsoleEventProc(Tcl_Event *evPtr, int flags); +static void ConsoleExitHandler(void *clientData); +static int ConsoleGetHandleProc(void *instanceData, + int direction, void **handlePtr); +static int ConsoleGetOptionProc(void *instanceData, + Tcl_Interp *interp, const char *optionName, + Tcl_DString *dsPtr); +static void ConsoleInit(void); +static int ConsoleInputProc(void *instanceData, char *buf, + int toRead, int *errorCode); +static int ConsoleOutputProc(void *instanceData, + const char *buf, int toWrite, int *errorCode); +static int ConsoleSetOptionProc(void *instanceData, + Tcl_Interp *interp, const char *optionName, + const char *value); +static void ConsoleSetupProc(void *clientData, int flags); +static void ConsoleWatchProc(void *instanceData, int mask); +static void ProcExitHandler(void *clientData); +static void ConsoleThreadActionProc(void *instanceData, int action); +static DWORD ReadConsoleChars(HANDLE hConsole, WCHAR *lpBuffer, + Tcl_Size nChars, Tcl_Size *nCharsReadPtr); +static DWORD WriteConsoleChars(HANDLE hConsole, + const WCHAR *lpBuffer, Tcl_Size nChars, + Tcl_Size *nCharsWritten); +static void RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity); +static void RingBufferClear(RingBuffer *ringPtr); +static Tcl_Size RingBufferIn(RingBuffer *ringPtr, const char *srcPtr, Tcl_Size srcLen, int partialCopyOk); -static Tcl_Size RingBufferOut(RingBuffer *ringPtr, char *dstPtr, +static Tcl_Size RingBufferOut(RingBuffer *ringPtr, char *dstPtr, Tcl_Size dstCapacity, int partialCopyOk); static ConsoleHandleInfo *AllocateConsoleHandleInfo(HANDLE consoleHandle, int permissions); @@ -253,7 +254,7 @@ static DWORD WINAPI ConsoleReaderThread(LPVOID arg); static DWORD WINAPI ConsoleWriterThread(LPVOID arg); static void NudgeWatchers(HANDLE consoleHandle); #ifndef NDEBUG -static int RingBufferCheck(const RingBuffer *ringPtr); +static int RingBufferCheck(const RingBuffer *ringPtr); #endif /* @@ -333,12 +334,14 @@ static const Tcl_ChannelType consoleChannelType = { *------------------------------------------------------------------------ */ static void -RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity) +RingBufferInit( + RingBuffer *ringPtr, + Tcl_Size capacity) { if (capacity <= 0 || capacity > TCL_SIZE_MAX) { Tcl_Panic("Internal error: invalid ring buffer capacity requested."); } - ringPtr->bufPtr = (char *)Tcl_Alloc(capacity); + ringPtr->bufPtr = (char *) Tcl_Alloc(capacity); ringPtr->capacity = capacity; ringPtr->start = 0; ringPtr->length = 0; @@ -360,7 +363,8 @@ RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity) *------------------------------------------------------------------------ */ static void -RingBufferClear(RingBuffer *ringPtr) +RingBufferClear( + RingBuffer *ringPtr) { if (ringPtr->bufPtr) { Tcl_Free(ringPtr->bufPtr); @@ -389,10 +393,9 @@ RingBufferClear(RingBuffer *ringPtr) static Tcl_Size RingBufferIn( RingBuffer *ringPtr, - const char *srcPtr, /* Source to be copied */ - Tcl_Size srcLen, /* Length of source */ - int partialCopyOk /* If true, partial copy is permitted */ - ) + const char *srcPtr, /* Source to be copied */ + Tcl_Size srcLen, /* Length of source */ + int partialCopyOk) /* If true, partial copy is permitted */ { Tcl_Size freeSpace; @@ -450,10 +453,11 @@ RingBufferIn( *------------------------------------------------------------------------ */ static Tcl_Size -RingBufferOut(RingBuffer *ringPtr, - char *dstPtr, /* Buffer for output data. May be NULL */ - Tcl_Size dstCapacity, /* Size of buffer */ - int partialCopyOk) /* If true, return what's available */ +RingBufferOut( + RingBuffer *ringPtr, + char *dstPtr, /* Buffer for output data. May be NULL */ + Tcl_Size dstCapacity, /* Size of buffer */ + int partialCopyOk) /* If true, return what's available */ { Tcl_Size leadLen; @@ -502,7 +506,8 @@ RingBufferOut(RingBuffer *ringPtr, #ifndef NDEBUG static int -RingBufferCheck(const RingBuffer *ringPtr) +RingBufferCheck( + const RingBuffer *ringPtr) { return (ringPtr->bufPtr != NULL && ringPtr->capacity == CONSOLE_BUFFER_SIZE && ringPtr->start < ringPtr->capacity @@ -560,13 +565,14 @@ ReadConsoleChars( result = ReadConsoleW(hConsole, lpBuffer, nChars, &nRead, NULL); if (result) { if ((nRead == 0 || nRead == (DWORD)-1) - && GetLastError() == ERROR_OPERATION_ABORTED) { + && GetLastError() == ERROR_OPERATION_ABORTED) { nRead = 0; } *nCharsReadPtr = nRead; return 0; - } else + } else { return GetLastError(); + } } /* @@ -721,19 +727,21 @@ ProcExitHandler( * As above. *------------------------------------------------------------------------ */ -void NudgeWatchers (HANDLE consoleHandle) +static void +NudgeWatchers( + HANDLE consoleHandle) { ConsoleChannelInfo *chanInfoPtr; AcquireSRWLockShared(&gConsoleLock); /* Shared-read lock */ for (chanInfoPtr = gWatchingChannelList; chanInfoPtr; - chanInfoPtr = chanInfoPtr->nextWatchingChannelPtr) { + chanInfoPtr = chanInfoPtr->nextWatchingChannelPtr) { /* * Notify channels interested in our handle AND that have * a thread attached. * No lock needed for chanInfoPtr. See ConsoleChannelInfo. */ if (chanInfoPtr->handle == consoleHandle - && chanInfoPtr->threadId != NULL) { + && chanInfoPtr->threadId != NULL) { Tcl_ThreadAlert(chanInfoPtr->threadId); } } @@ -779,7 +787,7 @@ ConsoleSetupProc( AcquireSRWLockShared(&gConsoleLock); /* READ lock - no data modification */ for (chanInfoPtr = gWatchingChannelList; block && chanInfoPtr != NULL; - chanInfoPtr = chanInfoPtr->nextWatchingChannelPtr) { + chanInfoPtr = chanInfoPtr->nextWatchingChannelPtr) { ConsoleHandleInfo *handleInfoPtr; handleInfoPtr = FindConsoleInfo(chanInfoPtr); if (handleInfoPtr != NULL) { @@ -787,7 +795,7 @@ ConsoleSetupProc( /* Remember at most one of READABLE, WRITABLE set */ if (chanInfoPtr->watchMask & TCL_READABLE) { if (RingBufferLength(&handleInfoPtr->buffer) > 0 - || handleInfoPtr->lastError != ERROR_SUCCESS) { + || handleInfoPtr->lastError != ERROR_SUCCESS) { block = 0; /* Input data available */ } } else if (chanInfoPtr->watchMask & TCL_WRITABLE) { @@ -874,7 +882,7 @@ ConsoleCheckProc( /* Rememeber channel is read or write, never both */ if (chanInfoPtr->watchMask & TCL_READABLE) { if (RingBufferLength(&handleInfoPtr->buffer) > 0 - || handleInfoPtr->lastError != ERROR_SUCCESS) { + || handleInfoPtr->lastError != ERROR_SUCCESS) { needEvent = 1; /* Input data available or error/EOF */ } /* @@ -925,7 +933,7 @@ ConsoleCheckProc( static int ConsoleBlockModeProc( - void *instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -985,9 +993,9 @@ ConsoleCloseProc( * still close the handle. That's historical behavior on all platforms. */ if (!TclInThreadExit() - || ((GetStdHandle(STD_INPUT_HANDLE) != chanInfoPtr->handle) - && (GetStdHandle(STD_OUTPUT_HANDLE) != chanInfoPtr->handle) - && (GetStdHandle(STD_ERROR_HANDLE) != chanInfoPtr->handle))) { + || ( (GetStdHandle(STD_INPUT_HANDLE) != chanInfoPtr->handle) + && (GetStdHandle(STD_OUTPUT_HANDLE) != chanInfoPtr->handle) + && (GetStdHandle(STD_ERROR_HANDLE) != chanInfoPtr->handle))) { closeHandle = 1; } else { closeHandle = 0; @@ -997,7 +1005,7 @@ ConsoleCloseProc( /* Remove channel from watchers' list */ for (nextPtrPtr = &gWatchingChannelList; *nextPtrPtr != NULL; - nextPtrPtr = &(*nextPtrPtr)->nextWatchingChannelPtr) { + nextPtrPtr = &(*nextPtrPtr)->nextWatchingChannelPtr) { if (*nextPtrPtr == (ConsoleChannelInfo *) chanInfoPtr) { *nextPtrPtr = (*nextPtrPtr)->nextWatchingChannelPtr; break; @@ -1084,7 +1092,7 @@ ConsoleCloseProc( */ static int ConsoleInputProc( - void *instanceData, /* Console state. */ + void *instanceData, /* Console state. */ char *bufPtr, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -1165,16 +1173,14 @@ ConsoleInputProc( * default is 4K which is < INPUT_BUFFER_SIZE and will rarely be * increased on stdin. */ - if ((1 & (size_t)bufPtr) == 0 /* aligned buffer */ - && (1 & bufSize) == 0 /* Even number of bytes */ - && bufSize > INPUT_BUFFER_SIZE) { + if ((1 & (size_t)bufPtr) == 0 /* aligned buffer */ + && (1 & bufSize) == 0 /* Even number of bytes */ + && bufSize > INPUT_BUFFER_SIZE) { DWORD lastError; Tcl_Size numChars; ReleaseSRWLockExclusive(&handleInfoPtr->lock); lastError = ReadConsoleChars(chanInfoPtr->handle, - (WCHAR *)bufPtr, - bufSize / sizeof(WCHAR), - &numChars); + (WCHAR *)bufPtr, bufSize / sizeof(WCHAR), &numChars); /* NOTE lock released so DON'T break. Return instead */ if (lastError != ERROR_SUCCESS) { Tcl_WinConvertError(lastError); @@ -1202,9 +1208,7 @@ ConsoleInputProc( handleInfoPtr->flags |= CONSOLE_DATA_AWAITED; WakeConditionVariable(&handleInfoPtr->consoleThreadCV); if (!SleepConditionVariableSRW(&handleInfoPtr->interpThreadCV, - &handleInfoPtr->lock, - INFINITE, - 0)) { + &handleInfoPtr->lock, INFINITE, 0)) { Tcl_WinConvertError(GetLastError()); *errorCode = Tcl_GetErrno(); numRead = -1; @@ -1216,7 +1220,7 @@ ConsoleInputProc( /* We read data. Ask for more if either async or watching for reads */ if ((chanInfoPtr->flags & CONSOLE_ASYNC) - || (chanInfoPtr->watchMask & TCL_READABLE)) { + || (chanInfoPtr->watchMask & TCL_READABLE)) { handleInfoPtr->flags |= CONSOLE_DATA_AWAITED; WakeConditionVariable(&handleInfoPtr->consoleThreadCV); } @@ -1244,7 +1248,7 @@ ConsoleInputProc( */ static int ConsoleOutputProc( - void *instanceData, /* Console state. */ + void *instanceData, /* Console state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -1301,15 +1305,12 @@ ConsoleOutputProc( * The ring buffer deals with cases (3) and (4). It would be harder * to duplicate that here. */ - if ((chanInfoPtr->flags & CONSOLE_ASYNC) /* Case (1) */ - || RingBufferLength(&handleInfoPtr->buffer) != 0 /* Case (2) */ - || (toWrite & 1) != 0 /* Case (3) */ - || (PTR2INT(buf) & 1) != 0 /* Case (4) */ - ) { + if ((chanInfoPtr->flags & CONSOLE_ASYNC) /* Case (1) */ + || RingBufferLength(&handleInfoPtr->buffer) != 0 /* Case (2) */ + || (toWrite & 1) != 0 /* Case (3) */ + || (PTR2INT(buf) & 1) != 0) { /* Case (4) */ numWritten += RingBufferIn(&handleInfoPtr->buffer, - numWritten + buf, - toWrite - numWritten, - 1); + numWritten + buf, toWrite - numWritten, 1); if (numWritten == toWrite || chanInfoPtr->flags & CONSOLE_ASYNC) { /* All done or async, just accept whatever was written */ break; @@ -1321,9 +1322,7 @@ ConsoleOutputProc( */ WakeConditionVariable(&handleInfoPtr->consoleThreadCV); if (!SleepConditionVariableSRW(&handleInfoPtr->interpThreadCV, - &handleInfoPtr->lock, - INFINITE, - 0)) { + &handleInfoPtr->lock, INFINITE, 0)) { /* Report the error */ Tcl_WinConvertError(GetLastError()); *errorCode = Tcl_GetErrno(); @@ -1336,11 +1335,10 @@ ConsoleOutputProc( HANDLE consoleHandle = handleInfoPtr->console; /* Unlock before blocking in WriteConsole */ ReleaseSRWLockExclusive(&handleInfoPtr->lock); - /* UNLOCKED so return, DON'T break out of loop as it will unlock again! */ + /* UNLOCKED so return, DON'T break out of loop as it will unlock + * again! */ winStatus = WriteConsoleChars(consoleHandle, - (WCHAR *)buf, - toWrite / sizeof(WCHAR), - &numWritten); + (WCHAR *)buf, toWrite / sizeof(WCHAR), &numWritten); if (winStatus == ERROR_SUCCESS) { return numWritten * sizeof(WCHAR); } else { @@ -1414,9 +1412,8 @@ ConsoleEventProc( * still owned by this thread AND is still watching events. */ if (chanInfoPtr->channel && chanInfoPtr->threadId == Tcl_GetCurrentThread() - && (chanInfoPtr->watchMask & (TCL_READABLE|TCL_WRITABLE))) { - ConsoleHandleInfo *handleInfoPtr; - handleInfoPtr = FindConsoleInfo(chanInfoPtr); + && (chanInfoPtr->watchMask & (TCL_READABLE|TCL_WRITABLE))) { + ConsoleHandleInfo *handleInfoPtr = FindConsoleInfo(chanInfoPtr); if (handleInfoPtr == NULL) { /* Console was closed. EOF->read event only (not write) */ if (chanInfoPtr->watchMask & TCL_READABLE) { @@ -1426,10 +1423,10 @@ ConsoleEventProc( AcquireSRWLockShared(&handleInfoPtr->lock); /* Remember at most one of READABLE, WRITABLE set */ if ((chanInfoPtr->watchMask & TCL_READABLE) - && RingBufferLength(&handleInfoPtr->buffer)) { + && RingBufferLength(&handleInfoPtr->buffer)) { mask = TCL_READABLE; } else if ((chanInfoPtr->watchMask & TCL_WRITABLE) - && RingBufferHasFreeSpace(&handleInfoPtr->buffer)) { + && RingBufferHasFreeSpace(&handleInfoPtr->buffer)) { /* Generate write event space available */ mask = TCL_WRITABLE; } @@ -1484,10 +1481,9 @@ ConsoleEventProc( static void ConsoleWatchProc( - void *instanceData, /* Console state. */ + void *instanceData, /* Console state. */ int newMask) /* What events to watch for, one of - * of TCL_READABLE, TCL_WRITABLE - */ + * of TCL_READABLE, TCL_WRITABLE */ { ConsoleChannelInfo **nextPtrPtr, *ptr; ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; @@ -1513,8 +1509,7 @@ ConsoleWatchProc( * that we are looking for data since it will not do reads until * it knows someone is awaiting. */ - ConsoleHandleInfo *handleInfoPtr; - handleInfoPtr = FindConsoleInfo(chanInfoPtr); + ConsoleHandleInfo *handleInfoPtr = FindConsoleInfo(chanInfoPtr); if (handleInfoPtr) { AcquireSRWLockExclusive(&handleInfoPtr->lock); handleInfoPtr->flags |= CONSOLE_DATA_AWAITED; @@ -1560,9 +1555,9 @@ ConsoleWatchProc( static int ConsoleGetHandleProc( - void *instanceData, /* The console state. */ + void *instanceData, /* The console state. */ TCL_UNUSED(int) /*direction*/, - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; @@ -1590,7 +1585,8 @@ ConsoleGetHandleProc( *------------------------------------------------------------------------ */ static int - ConsoleDataAvailable (HANDLE consoleHandle) + ConsoleDataAvailable( + HANDLE consoleHandle) { INPUT_RECORD input[10]; DWORD count; @@ -1599,9 +1595,8 @@ ConsoleGetHandleProc( /* * Need at least one keyboard event. */ - if (PeekConsoleInputW( - consoleHandle, input, sizeof(input) / sizeof(input[0]), &count) - == FALSE) { + if (PeekConsoleInputW(consoleHandle, input, + sizeof(input) / sizeof(input[0]), &count) == FALSE) { return -1; } /* @@ -1612,11 +1607,12 @@ ConsoleGetHandleProc( * down somewhere in the unread buffer. I suppose we could expand the * buffer but not worth... */ - if (count == (sizeof(input)/sizeof(input[0]))) + if (count == (sizeof(input)/sizeof(input[0]))) { return 1; + } for (i = 0; i < count; ++i) { if (input[i].EventType == KEY_EVENT - && input[i].Event.KeyEvent.bKeyDown) { + && input[i].Event.KeyEvent.bKeyDown) { return 1; } } @@ -1685,9 +1681,8 @@ ConsoleReaderThread( assert((inputLen - inputOffset) > 0); nStored = RingBufferIn(&handleInfoPtr->buffer, - inputOffset + inputChars, - inputLen - inputOffset, - 1); + inputOffset + inputChars, inputLen - inputOffset, + 1); inputOffset += nStored; if (inputOffset == inputLen) { /* Temp buffer now empty */ @@ -1746,21 +1741,19 @@ ConsoleReaderThread( * data. */ if (lastReadSize == sizeof(inputChars) - || ((handleInfoPtr->flags & CONSOLE_DATA_AWAITED) + || ((handleInfoPtr->flags & CONSOLE_DATA_AWAITED) && ConsoleDataAvailable(handleInfoPtr->console))) { DWORD error; /* Do not hold the lock while blocked in console */ ReleaseSRWLockExclusive(&handleInfoPtr->lock); error = ReadConsoleChars(handleInfoPtr->console, - (WCHAR *)inputChars, - sizeof(inputChars) / sizeof(WCHAR), - &inputLen); + (WCHAR *)inputChars, sizeof(inputChars) / sizeof(WCHAR), + &inputLen); AcquireSRWLockExclusive(&handleInfoPtr->lock); if (error == 0) { inputLen *= sizeof(WCHAR); lastReadSize = inputLen; - } - else { + } else { /* * We only store the last error. It is up to channel * handlers whether to close or not in case of errors. @@ -1771,8 +1764,7 @@ ConsoleReaderThread( handleInfoPtr->console = INVALID_HANDLE_VALUE; } } - } - else { + } else { /* * Either no one was asking for data, or no data was available. * In the former case, wait until someone wakes us asking for @@ -1783,9 +1775,7 @@ ConsoleReaderThread( sleepTime = handleInfoPtr->flags & CONSOLE_DATA_AWAITED ? 50 : INFINITE; SleepConditionVariableSRW(&handleInfoPtr->consoleThreadCV, - &handleInfoPtr->lock, - sleepTime, - 0); + &handleInfoPtr->lock, sleepTime, 0); } /* Loop again to check for exit or wait for readers to wake us */ @@ -1802,7 +1792,7 @@ ConsoleReaderThread( ReleaseSRWLockExclusive(&handleInfoPtr->lock); AcquireSRWLockExclusive(&gConsoleLock); /* Modifying - exclusive lock */ for (iterator = &gConsoleHandleInfoList; *iterator; - iterator = &(*iterator)->nextPtr) { + iterator = &(*iterator)->nextPtr) { if (*iterator == handleInfoPtr) { *iterator = handleInfoPtr->nextPtr; break; @@ -1814,7 +1804,7 @@ ConsoleReaderThread( RingBufferClear(&handleInfoPtr->buffer); if (handleInfoPtr->console != INVALID_HANDLE_VALUE - && handleInfoPtr->lastError != ERROR_INVALID_HANDLE) { + && handleInfoPtr->lastError != ERROR_INVALID_HANDLE) { SetConsoleMode(handleInfoPtr->console, handleInfoPtr->initMode); /* * NOTE: we do not call CloseHandle(handleInfoPtr->console) here. @@ -1847,7 +1837,8 @@ ConsoleReaderThread( *---------------------------------------------------------------------- */ static DWORD WINAPI -ConsoleWriterThread(LPVOID arg) +ConsoleWriterThread( + LPVOID arg) { ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg; ConsoleHandleInfo **iterator; @@ -1900,9 +1891,7 @@ ConsoleWriterThread(LPVOID arg) /* Wake up any threads waiting synchronously. */ WakeConditionVariable(&handleInfoPtr->interpThreadCV); success = SleepConditionVariableSRW(&handleInfoPtr->consoleThreadCV, - &handleInfoPtr->lock, - INFINITE, - 0); + &handleInfoPtr->lock, INFINITE, 0); /* Note: lock has been acquired again! */ if (!success && GetLastError() != ERROR_TIMEOUT) { /* TODO - what can be done? Should not happen */ @@ -1926,9 +1915,7 @@ ConsoleWriterThread(LPVOID arg) Tcl_Size numWChars = numBytes / sizeof(WCHAR); DWORD status; status = WriteConsoleChars(handleInfoPtr->console, - (WCHAR *)(offset + buffer), - numWChars, - &numWChars); + (WCHAR *)(offset + buffer), numWChars, &numWChars); if (status != 0) { /* Only overwrite if no previous error */ if (handleInfoPtr->lastError == 0) { @@ -1973,7 +1960,7 @@ ConsoleWriterThread(LPVOID arg) ReleaseSRWLockExclusive(&handleInfoPtr->lock); AcquireSRWLockExclusive(&gConsoleLock); /* Modifying - exclusive lock */ for (iterator = &gConsoleHandleInfoList; *iterator; - iterator = &(*iterator)->nextPtr) { + iterator = &(*iterator)->nextPtr) { if (*iterator == handleInfoPtr) { *iterator = handleInfoPtr->nextPtr; break; @@ -2019,8 +2006,7 @@ AllocateConsoleHandleInfo( ConsoleHandleInfo *handleInfoPtr; DWORD consoleMode; - - handleInfoPtr = (ConsoleHandleInfo *)Tcl_Alloc(sizeof(*handleInfoPtr)); + handleInfoPtr = (ConsoleHandleInfo *) Tcl_Alloc(sizeof(*handleInfoPtr)); memset(handleInfoPtr, 0, sizeof(*handleInfoPtr)); memset(handleInfoPtr, 0, sizeof(*handleInfoPtr)); handleInfoPtr->console = consoleHandle; @@ -2427,30 +2413,26 @@ ConsoleGetOptionProc( valid = 1; if (!GetConsoleScreenBufferInfo(chanInfoPtr->handle, - &consoleInfo)) { + &consoleInfo)) { Tcl_WinConvertError(GetLastError()); if (interp != NULL) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("couldn't read console size: %s", - Tcl_PosixError(interp))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read console size: %s", + Tcl_PosixError(interp))); } return TCL_ERROR; } Tcl_DStringStartSublist(dsPtr); - snprintf(buf, sizeof(buf), - "%d", + snprintf(buf, sizeof(buf), "%d", consoleInfo.srWindow.Right - consoleInfo.srWindow.Left + 1); Tcl_DStringAppendElement(dsPtr, buf); - snprintf(buf, sizeof(buf), - "%d", + snprintf(buf, sizeof(buf), "%d", consoleInfo.srWindow.Bottom - consoleInfo.srWindow.Top + 1); Tcl_DStringAppendElement(dsPtr, buf); Tcl_DStringEndSublist(dsPtr); } } - if (valid) { return TCL_OK; } diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 4cb23ea..7ce3b4c 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -411,8 +411,7 @@ DoRenameFile( * directory back, for completeness. */ - if (MoveFileW(nativeSrc, - nativeDst) != FALSE) { + if (MoveFileW(nativeSrc, nativeDst) != FALSE) { return TCL_OK; } @@ -697,8 +696,7 @@ DoCopyFile( if (dstAttr & FILE_ATTRIBUTE_READONLY) { SetFileAttributesW(nativeDst, dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); - if (CopyFileW(nativeSrc, nativeDst, - 0) != FALSE) { + if (CopyFileW(nativeSrc, nativeDst, 0) != FALSE) { return TCL_OK; } @@ -794,8 +792,7 @@ TclpDeleteFile( int res = SetFileAttributesW(path, attr & ~((DWORD) FILE_ATTRIBUTE_READONLY)); - if ((res != 0) && - (DeleteFileW(path) != FALSE)) { + if ((res != 0) && (DeleteFileW(path) != FALSE)) { return TCL_OK; } Tcl_WinConvertError(GetLastError()); @@ -1082,8 +1079,7 @@ DoRemoveJustDirectory( if (attr & FILE_ATTRIBUTE_READONLY) { attr &= ~FILE_ATTRIBUTE_READONLY; - if (SetFileAttributesW(nativePath, - attr) == FALSE) { + if (SetFileAttributesW(nativePath, attr) == FALSE) { goto end; } if (RemoveDirectoryW(nativePath) != FALSE) { @@ -1120,7 +1116,9 @@ DoRemoveJustDirectory( Tcl_DStringInit(errorPtr); p = Tcl_WCharToUtfDString(nativePath, TCL_INDEX_NONE, errorPtr); for (; *p; ++p) { - if (*p == '\\') *p = '/'; + if (*p == '\\') { + *p = '/'; + } } } return TCL_ERROR; @@ -1381,8 +1379,7 @@ TraversalCopy( if (DoCreateDirectory(nativeDst) == TCL_OK) { DWORD attr = GetFileAttributesW(nativeSrc); - if (SetFileAttributesW(nativeDst, - attr) != FALSE) { + if (SetFileAttributesW(nativeDst, attr) != FALSE) { return TCL_OK; } Tcl_WinConvertError(GetLastError()); diff --git a/win/tclWinFile.c b/win/tclWinFile.c index c0dd4fd..baf0734 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -149,7 +149,7 @@ typedef struct { * Other typedefs required by this code. */ -static __time64_t ToCTime(FILETIME fileTime); +static __time64_t ToCTime(FILETIME fileTime); static void FromCTime(__time64_t posixTime, FILETIME *fileTime); /* @@ -972,7 +972,7 @@ TclpMatchInDirectory( attr = GetFileAttributesW(native); if ((attr == INVALID_FILE_ATTRIBUTES) - || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { + || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { return TCL_OK; } diff --git a/win/tclWinInit.c b/win/tclWinInit.c index b506111..ca0c904 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -591,9 +591,7 @@ TclpFindVariable( Tcl_UtfToUpper(nameUpper); Tcl_DStringInit(&envString); - for (i = 0, env = _wenviron[i]; - env != NULL; - i++, env = _wenviron[i]) { + for (i = 0, env = _wenviron[i]; env != NULL; i++, env = _wenviron[i]) { /* * Chop the env string off after the equal sign, then Convert the name * to all upper case, so we do not have to convert all the characters diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 265c8e7..62590ef 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -114,7 +114,7 @@ TclpDlopen( * first error for reporting purposes. */ if (firstError == ERROR_MOD_NOT_FOUND || - firstError == ERROR_DLL_NOT_FOUND) { + firstError == ERROR_DLL_NOT_FOUND) { lastError = GetLastError(); } else { lastError = firstError; diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index de4f8f2..758276e 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -57,8 +57,8 @@ static CRITICAL_SECTION notifierMutex; * Static routines defined in this file. */ -static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, - WPARAM wParam, LPARAM lParam); +static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, + WPARAM wParam, LPARAM lParam); /* *---------------------------------------------------------------------- diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index bce4d52..1b2e946 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1321,7 +1321,7 @@ ApplicationType( ext = strrchr(fullName, '.'); if ((ext != NULL) && - (strcasecmp(ext, ".cmd") == 0 || strcasecmp(ext, ".bat") == 0)) { + (strcasecmp(ext, ".cmd") == 0 || strcasecmp(ext, ".bat") == 0)) { applType = APPL_DOS; break; } diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 9ef62c6..a0b4e90 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -853,7 +853,7 @@ GetValue( Tcl_NewStringObj(Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); - while (*wp++ != 0) {/* empty body */} + while (*wp++ != 0); /* empty loop body */ p = (char *) wp; Tcl_DStringFree(&buf); } @@ -937,7 +937,6 @@ GetValueNames( size = MAX_KEY_LENGTH; while (RegEnumValueW(key,index, (WCHAR *)Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { - Tcl_DStringInit(&ds); Tcl_WCharToUtfDString((const WCHAR *)Tcl_DStringValue(&buffer), size, &ds); name = Tcl_DStringValue(&ds); diff --git a/win/tclWinSock.c b/win/tclWinSock.c index d600f1f..17b6004 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -429,7 +429,7 @@ Tcl_GetHostName(void) */ void -TclInitSockets() +TclInitSockets(void) { /* Then Per thread initialization. */ DWORD id; @@ -1203,7 +1203,7 @@ TcpSetOptionProc( return TCL_OK; } if ((len > 1) && (optionName[1] == 'n') && - (strncmp(optionName, "-nodelay", len) == 0)) { + (strncmp(optionName, "-nodelay", len) == 0)) { BOOL boolVar; int rtn; @@ -2268,7 +2268,7 @@ Tcl_OpenTcpServerEx( ioctlsocket(sock, (long) FIONBIO, &flag); SendSelectMessage(tsdPtr, SELECT, statePtr); if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "") - == TCL_ERROR) { + == TCL_ERROR) { Tcl_CloseEx(NULL, statePtr->channel, 0); return NULL; } diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 1b679a9..999c5ba 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -454,8 +454,8 @@ TestplatformChmod( } /* Get process SID */ - if (!GetTokenInformation(hToken, TokenUser, NULL, 0, &dw) && - GetLastError() != ERROR_INSUFFICIENT_BUFFER) { + if (!GetTokenInformation(hToken, TokenUser, NULL, 0, &dw) + && GetLastError() != ERROR_INSUFFICIENT_BUFFER) { goto done; } pTokenUser = (TOKEN_USER *)Tcl_Alloc(dw); @@ -464,9 +464,8 @@ TestplatformChmod( } aceEntry[nSids].sidLen = GetLengthSid(pTokenUser->User.Sid); aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen); - if (!CopySid(aceEntry[nSids].sidLen, - aceEntry[nSids].pSid, - pTokenUser->User.Sid)) { + if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, + pTokenUser->User.Sid)) { Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ goto done; } -- cgit v0.12 From 963276ee6d0ba32137fc09c691ffe93eda538e3e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 19 Mar 2024 16:12:00 +0000 Subject: Backport fix for [bda99f2393]: gets stdin problem when non-blocking - Windows (cherry-pick): Fix indentation/brace usage style issues --- tests/winConsole.test | 54 +++++++- unix/tclLoadDyld.c | 16 ++- unix/tclUnixSock.c | 1 - unix/tclUnixTest.c | 2 +- unix/tclXtNotify.c | 2 +- unix/tclXtTest.c | 2 +- win/tclWinChan.c | 4 +- win/tclWinConsole.c | 347 ++++++++++++++++++++++++++------------------------ win/tclWinFCmd.c | 29 ++--- win/tclWinFile.c | 26 ++-- win/tclWinInit.c | 4 +- win/tclWinLoad.c | 4 +- win/tclWinNotify.c | 4 +- win/tclWinPipe.c | 4 +- win/tclWinReg.c | 3 +- win/tclWinSock.c | 6 +- win/tclWinTest.c | 9 +- 17 files changed, 287 insertions(+), 230 deletions(-) diff --git a/tests/winConsole.test b/tests/winConsole.test index 3f23c07..166599f 100644 --- a/tests/winConsole.test +++ b/tests/winConsole.test @@ -4,7 +4,8 @@ # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # -# Copyright © 1999 Scriptics Corporation. +# NOTE THIS CANNOT BE RUN VIA nmake/make test since stdin is connected to +# nmake in that case. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -15,7 +16,6 @@ if {"::tcltest" ni [namespace children]} { } catch {package require twapi} ;# Only to bring window to foreground. Not critical - ::tcltest::ConstraintInitializer haveThread { expr {![catch {package require Thread}]} } # Prompt user for a yes/no response @@ -155,6 +155,54 @@ test console-input-2.1 {Console file channel: non-blocking read} -constraints { set result } -result abc +test console-input-3.0 {Console gets blocking - long lines bug-bda99f2393} -constraints { + win interactive +} -body { + prompt "Try typing a line of at least 256 characters. Hit ENTER exactly once unless you don't see another prompt.\n" + gets stdin line + set len [string length $line] + list [yesno "Did you hit ENTER only once?"] [expr {$len > 256}] [yesno "Line length was $len characters. Is this correct?"] +} -result {1 1 1} + +test console-input-3.1 {Console gets blocking, small channel buffer size - long lines bug-bda99f2393} -constraints { + win interactive +} -body { + prompt "Try typing a line of at least 256 characters. Hit ENTER exactly once unless you don't see another prompt.\n" + set bufSize [fconfigure stdin -buffersize] + fconfigure stdin -buffersize 10 + gets stdin line + fconfigure stdin -buffersize $bufSize + set len [string length $line] + list [yesno "Did you hit ENTER only once?"] [expr {$len > 256}] [yesno "Line length was $len characters. Is this correct?"] +} -result {1 1 1} + +test console-input-3.2 {Console gets nonblocking - long lines bug-bda99f2393} -constraints { + win interactive +} -body { + prompt "Try typing a line of at least 256 characters. Hit ENTER exactly once unless you don't see another prompt.\n" + fconfigure stdin -blocking 0 + while {[gets stdin line] < 0} { + after 1000 + } + fconfigure stdin -blocking 1 + set len [string length $line] + list [yesno "Did you hit ENTER only once?"] [expr {$len > 256}] [yesno "Line length was $len characters. Is this correct?"] +} -result {1 1 1} + +test console-input-3.3 {Console gets nonblocking small channel buffer size - long lines bug-bda99f2393} -constraints { + win interactive +} -body { + prompt "Try typing a line of at least 256 characters. Hit ENTER exactly once unless you don't see another prompt.\n" + set bufSize [fconfigure stdin -buffersize] + fconfigure stdin -blocking 0 -buffersize 10 + while {[gets stdin line] < 0} { + after 1000 + } + fconfigure stdin -blocking 1 -buffersize $bufSize + set len [string length $line] + list [yesno "Did you hit ENTER only once?"] [expr {$len > 256}] [yesno "Line length was $len characters. Is this correct?"] +} -result {1 1 1} + # Output tests test console-output-1.0 {Console blocking puts stdout} -constraints {win interactive} -body { @@ -344,7 +392,7 @@ test console-fconfigure-set-3.0 { fconfigure stderr -winsize } -constraints {win interactive} -body { fconfigure stderr -winsize {10 30} -} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -profile, -translation} -returnCodes error +} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, or -translation} -returnCodes error # Multiple threads diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c index b831e36..375771c 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -253,8 +253,12 @@ TclpDlopen( &dyldObjFileImage); if (err == NSObjectFileImageSuccess && dyldObjFileImage) { int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR; - if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE; - if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW; + if (!(flags & 1)) { + nsflags |= NSLINKMODULE_OPTION_PRIVATE; + } + if (!(flags & 2)) { + nsflags |= NSLINKMODULE_OPTION_BINDNOW; + } module = NSLinkModule(dyldObjFileImage, nativePath, nsflags); NSDestroyObjectFileImage(dyldObjFileImage); if (module) { @@ -646,8 +650,12 @@ TclpLoadMemory( * Extract the module we want from the image of the object file. */ - if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE; - if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW; + if (!(flags & 1)) { + nsflags |= NSLINKMODULE_OPTION_PRIVATE; + } + if (!(flags & 2)) { + nsflags |= NSLINKMODULE_OPTION_BINDNOW; + } module = NSLinkModule(dyldObjFileImage, "[Memory Based Bundle]", nsflags); NSDestroyObjectFileImage(dyldObjFileImage); if (!module) { diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index d6e5386..2195ab0 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -1325,7 +1325,6 @@ TcpConnect( for (statePtr->myaddr = statePtr->myaddrlist; statePtr->myaddr != NULL; statePtr->myaddr = statePtr->myaddr->ai_next) { - /* * No need to try combinations of local and remote addresses of * different families. diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 4f052a8..008a2f0 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -70,7 +70,7 @@ static Tcl_ObjCmdProc TestfindexecutableCmd; static Tcl_ObjCmdProc TestforkCmd; static Tcl_ObjCmdProc TestgotsigCmd; static Tcl_FileProc TestFileHandlerProc; -static void AlarmHandler(int signum); +static void AlarmHandler(int signum); /* *---------------------------------------------------------------------- diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c index 4388009..5f99239 100644 --- a/unix/tclXtNotify.c +++ b/unix/tclXtNotify.c @@ -91,7 +91,7 @@ static int WaitForEvent(const Tcl_Time * timePtr); * Functions defined in this file for use by users of the Xt Notifier: */ -MODULE_SCOPE void InitNotifier(void); +MODULE_SCOPE void InitNotifier(void); MODULE_SCOPE XtAppContext TclSetAppContext(XtAppContext ctx); /* diff --git a/unix/tclXtTest.c b/unix/tclXtTest.c index e660c69..d4b4251 100644 --- a/unix/tclXtTest.c +++ b/unix/tclXtTest.c @@ -21,7 +21,7 @@ static Tcl_ObjCmdProc TesteventloopCmd; * Functions defined in tclXtNotify.c for use by users of the Xt Notifier: */ -extern void InitNotifier(void); +extern void InitNotifier(void); extern XtAppContext TclSetAppContext(XtAppContext ctx); /* diff --git a/win/tclWinChan.c b/win/tclWinChan.c index a8a757d..a69ca5d 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -102,7 +102,7 @@ static int FileTruncateProc(ClientData instanceData, long long length); static DWORD FileGetType(HANDLE handle); static int NativeIsComPort(const WCHAR *nativeName); -static Tcl_Channel OpenFileChannel(HANDLE handle, char *channelName, +static Tcl_Channel OpenFileChannel(HANDLE handle, char *channelName, int permissions, int appendMode); /* @@ -1048,7 +1048,7 @@ FileGetOptionProc( * general probe. */ - dictContents = Tcl_GetStringFromObj(dictObj, &dictLength); + dictContents = TclGetStringFromObj(dictObj, &dictLength); Tcl_DStringAppend(dsPtr, dictContents, dictLength); Tcl_DecrRefCount(dictObj); return TCL_OK; diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 25c4065..c7e12ae 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -70,14 +70,23 @@ static int gInitialized = 0; /* - * Permit CONSOLE_BUFFER_SIZE to be defined on build command for stress test. - * + * INPUT_BUFFER_SIZE is size of buffer passed to ReadConsole in bytes. + * Note that ReadConsole will only allow reading of line lengths up to the + * max of 256 and buffer size passed to it. So dropping this below 512 + * means user can type at most 256 chars. + */ +#ifndef INPUT_BUFFER_SIZE +#define INPUT_BUFFER_SIZE 8192 /* In bytes, so 4096 chars */ +#endif + +/* + * CONSOLE_BUFFER_SIZE is size of storage used in ring buffers. * In theory, at least sizeof(WCHAR) but note the Tcl channel bug * https://core.tcl-lang.org/tcl/tktview/b3977d199b08e3979a8da970553d5209b3042e9c * will cause failures in test suite if close to max input line in the suite. */ #ifndef CONSOLE_BUFFER_SIZE -#define CONSOLE_BUFFER_SIZE 8000 /* In bytes */ +#define CONSOLE_BUFFER_SIZE 8192 /* In bytes */ #endif /* @@ -169,8 +178,8 @@ typedef struct ConsoleHandleInfo { typedef struct ConsoleChannelInfo { HANDLE handle; /* Console handle */ Tcl_ThreadId threadId; /* Id of owning thread */ - struct ConsoleChannelInfo - *nextWatchingChannelPtr; /* Pointer to next channel watching events. */ + struct ConsoleChannelInfo *nextWatchingChannelPtr; + /* Pointer to next channel watching events. */ Tcl_Channel channel; /* Pointer to channel structure. */ DWORD initMode; /* Initial console mode. */ int numRefs; /* See comments above */ @@ -192,50 +201,51 @@ typedef struct ConsoleChannelInfo { */ typedef struct { - Tcl_Event header; /* Information that is standard for all events. */ - ConsoleChannelInfo *chanInfoPtr; /* Pointer to console info structure. Note - * that we still have to verify that the - * console exists before dereferencing this - * pointer. */ + Tcl_Event header; /* Information that is standard for all events. */ + ConsoleChannelInfo *chanInfoPtr; + /* Pointer to console info structure. Note + * that we still have to verify that the + * console exists before dereferencing this + * pointer. */ } ConsoleEvent; /* * Declarations for functions used only in this file. */ -static int ConsoleBlockModeProc(ClientData instanceData, int mode); -static void ConsoleCheckProc(ClientData clientData, int flags); -static int ConsoleCloseProc(ClientData instanceData, - Tcl_Interp *interp, int flags); -static int ConsoleEventProc(Tcl_Event *evPtr, int flags); -static void ConsoleExitHandler(ClientData clientData); -static int ConsoleGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); -static int ConsoleGetOptionProc(ClientData instanceData, - Tcl_Interp *interp, const char *optionName, - Tcl_DString *dsPtr); -static void ConsoleInit(void); -static int ConsoleInputProc(ClientData instanceData, char *buf, - int toRead, int *errorCode); -static int ConsoleOutputProc(ClientData instanceData, - const char *buf, int toWrite, int *errorCode); -static int ConsoleSetOptionProc(ClientData instanceData, - Tcl_Interp *interp, const char *optionName, - const char *value); -static void ConsoleSetupProc(ClientData clientData, int flags); -static void ConsoleWatchProc(ClientData instanceData, int mask); -static void ProcExitHandler(ClientData clientData); -static void ConsoleThreadActionProc(ClientData instanceData, int action); -static DWORD ReadConsoleChars(HANDLE hConsole, WCHAR *lpBuffer, - Tcl_Size nChars, Tcl_Size *nCharsReadPtr); -static DWORD WriteConsoleChars(HANDLE hConsole, - const WCHAR *lpBuffer, Tcl_Size nChars, - Tcl_Size *nCharsWritten); -static void RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity); -static void RingBufferClear(RingBuffer *ringPtr); -static Tcl_Size RingBufferIn(RingBuffer *ringPtr, const char *srcPtr, +static int ConsoleBlockModeProc(void *instanceData, int mode); +static void ConsoleCheckProc(void *clientData, int flags); +static int ConsoleCloseProc(void *instanceData, + Tcl_Interp *interp, int flags); +static int ConsoleEventProc(Tcl_Event *evPtr, int flags); +static void ConsoleExitHandler(void *clientData); +static int ConsoleGetHandleProc(void *instanceData, + int direction, void **handlePtr); +static int ConsoleGetOptionProc(void *instanceData, + Tcl_Interp *interp, const char *optionName, + Tcl_DString *dsPtr); +static void ConsoleInit(void); +static int ConsoleInputProc(void *instanceData, char *buf, + int toRead, int *errorCode); +static int ConsoleOutputProc(void *instanceData, + const char *buf, int toWrite, int *errorCode); +static int ConsoleSetOptionProc(void *instanceData, + Tcl_Interp *interp, const char *optionName, + const char *value); +static void ConsoleSetupProc(void *clientData, int flags); +static void ConsoleWatchProc(void *instanceData, int mask); +static void ProcExitHandler(void *clientData); +static void ConsoleThreadActionProc(void *instanceData, int action); +static DWORD ReadConsoleChars(HANDLE hConsole, WCHAR *lpBuffer, + Tcl_Size nChars, Tcl_Size *nCharsReadPtr); +static DWORD WriteConsoleChars(HANDLE hConsole, + const WCHAR *lpBuffer, Tcl_Size nChars, + Tcl_Size *nCharsWritten); +static void RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity); +static void RingBufferClear(RingBuffer *ringPtr); +static Tcl_Size RingBufferIn(RingBuffer *ringPtr, const char *srcPtr, Tcl_Size srcLen, int partialCopyOk); -static Tcl_Size RingBufferOut(RingBuffer *ringPtr, char *dstPtr, +static Tcl_Size RingBufferOut(RingBuffer *ringPtr, char *dstPtr, Tcl_Size dstCapacity, int partialCopyOk); static ConsoleHandleInfo *AllocateConsoleHandleInfo(HANDLE consoleHandle, int permissions); @@ -244,7 +254,7 @@ static DWORD WINAPI ConsoleReaderThread(LPVOID arg); static DWORD WINAPI ConsoleWriterThread(LPVOID arg); static void NudgeWatchers(HANDLE consoleHandle); #ifndef NDEBUG -static int RingBufferCheck(const RingBuffer *ringPtr); +static int RingBufferCheck(const RingBuffer *ringPtr); #endif /* @@ -324,12 +334,14 @@ static const Tcl_ChannelType consoleChannelType = { *------------------------------------------------------------------------ */ static void -RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity) +RingBufferInit( + RingBuffer *ringPtr, + Tcl_Size capacity) { if (capacity <= 0 || capacity > TCL_SIZE_MAX) { Tcl_Panic("Internal error: invalid ring buffer capacity requested."); } - ringPtr->bufPtr = (char *)ckalloc(capacity); + ringPtr->bufPtr = (char *) ckalloc(capacity); ringPtr->capacity = capacity; ringPtr->start = 0; ringPtr->length = 0; @@ -351,7 +363,8 @@ RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity) *------------------------------------------------------------------------ */ static void -RingBufferClear(RingBuffer *ringPtr) +RingBufferClear( + RingBuffer *ringPtr) { if (ringPtr->bufPtr) { ckfree(ringPtr->bufPtr); @@ -380,10 +393,9 @@ RingBufferClear(RingBuffer *ringPtr) static Tcl_Size RingBufferIn( RingBuffer *ringPtr, - const char *srcPtr, /* Source to be copied */ - Tcl_Size srcLen, /* Length of source */ - int partialCopyOk /* If true, partial copy is permitted */ - ) + const char *srcPtr, /* Source to be copied */ + Tcl_Size srcLen, /* Length of source */ + int partialCopyOk) /* If true, partial copy is permitted */ { Tcl_Size freeSpace; @@ -441,10 +453,11 @@ RingBufferIn( *------------------------------------------------------------------------ */ static Tcl_Size -RingBufferOut(RingBuffer *ringPtr, - char *dstPtr, /* Buffer for output data. May be NULL */ - Tcl_Size dstCapacity, /* Size of buffer */ - int partialCopyOk) /* If true, return what's available */ +RingBufferOut( + RingBuffer *ringPtr, + char *dstPtr, /* Buffer for output data. May be NULL */ + Tcl_Size dstCapacity, /* Size of buffer */ + int partialCopyOk) /* If true, return what's available */ { Tcl_Size leadLen; @@ -493,7 +506,8 @@ RingBufferOut(RingBuffer *ringPtr, #ifndef NDEBUG static int -RingBufferCheck(const RingBuffer *ringPtr) +RingBufferCheck( + const RingBuffer *ringPtr) { return (ringPtr->bufPtr != NULL && ringPtr->capacity == CONSOLE_BUFFER_SIZE && ringPtr->start < ringPtr->capacity @@ -551,13 +565,14 @@ ReadConsoleChars( result = ReadConsoleW(hConsole, lpBuffer, nChars, &nRead, NULL); if (result) { if ((nRead == 0 || nRead == (DWORD)-1) - && GetLastError() == ERROR_OPERATION_ABORTED) { + && GetLastError() == ERROR_OPERATION_ABORTED) { nRead = 0; } *nCharsReadPtr = nRead; return 0; - } else + } else { return GetLastError(); + } } /* @@ -663,7 +678,7 @@ ConsoleInit(void) static void ConsoleExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL); } @@ -687,7 +702,7 @@ ConsoleExitHandler( static void ProcExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { AcquireSRWLockExclusive(&gConsoleLock); gInitialized = 0; @@ -712,19 +727,21 @@ ProcExitHandler( * As above. *------------------------------------------------------------------------ */ -void NudgeWatchers (HANDLE consoleHandle) +static void +NudgeWatchers( + HANDLE consoleHandle) { ConsoleChannelInfo *chanInfoPtr; AcquireSRWLockShared(&gConsoleLock); /* Shared-read lock */ for (chanInfoPtr = gWatchingChannelList; chanInfoPtr; - chanInfoPtr = chanInfoPtr->nextWatchingChannelPtr) { + chanInfoPtr = chanInfoPtr->nextWatchingChannelPtr) { /* * Notify channels interested in our handle AND that have * a thread attached. * No lock needed for chanInfoPtr. See ConsoleChannelInfo. */ if (chanInfoPtr->handle == consoleHandle - && chanInfoPtr->threadId != NULL) { + && chanInfoPtr->threadId != NULL) { Tcl_ThreadAlert(chanInfoPtr->threadId); } } @@ -752,7 +769,7 @@ void NudgeWatchers (HANDLE consoleHandle) void ConsoleSetupProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { ConsoleChannelInfo *chanInfoPtr; @@ -770,7 +787,7 @@ ConsoleSetupProc( AcquireSRWLockShared(&gConsoleLock); /* READ lock - no data modification */ for (chanInfoPtr = gWatchingChannelList; block && chanInfoPtr != NULL; - chanInfoPtr = chanInfoPtr->nextWatchingChannelPtr) { + chanInfoPtr = chanInfoPtr->nextWatchingChannelPtr) { ConsoleHandleInfo *handleInfoPtr; handleInfoPtr = FindConsoleInfo(chanInfoPtr); if (handleInfoPtr != NULL) { @@ -778,7 +795,7 @@ ConsoleSetupProc( /* Remember at most one of READABLE, WRITABLE set */ if (chanInfoPtr->watchMask & TCL_READABLE) { if (RingBufferLength(&handleInfoPtr->buffer) > 0 - || handleInfoPtr->lastError != ERROR_SUCCESS) { + || handleInfoPtr->lastError != ERROR_SUCCESS) { block = 0; /* Input data available */ } } else if (chanInfoPtr->watchMask & TCL_WRITABLE) { @@ -817,7 +834,7 @@ ConsoleSetupProc( static void ConsoleCheckProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { ConsoleChannelInfo *chanInfoPtr; @@ -865,7 +882,7 @@ ConsoleCheckProc( /* Rememeber channel is read or write, never both */ if (chanInfoPtr->watchMask & TCL_READABLE) { if (RingBufferLength(&handleInfoPtr->buffer) > 0 - || handleInfoPtr->lastError != ERROR_SUCCESS) { + || handleInfoPtr->lastError != ERROR_SUCCESS) { needEvent = 1; /* Input data available or error/EOF */ } /* @@ -916,7 +933,7 @@ ConsoleCheckProc( static int ConsoleBlockModeProc( - ClientData instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -956,7 +973,7 @@ ConsoleBlockModeProc( static int ConsoleCloseProc( - ClientData instanceData, /* Pointer to ConsoleChannelInfo structure. */ + void *instanceData, /* Pointer to ConsoleChannelInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { @@ -976,9 +993,9 @@ ConsoleCloseProc( * still close the handle. That's historical behavior on all platforms. */ if (!TclInThreadExit() - || ((GetStdHandle(STD_INPUT_HANDLE) != chanInfoPtr->handle) - && (GetStdHandle(STD_OUTPUT_HANDLE) != chanInfoPtr->handle) - && (GetStdHandle(STD_ERROR_HANDLE) != chanInfoPtr->handle))) { + || ( (GetStdHandle(STD_INPUT_HANDLE) != chanInfoPtr->handle) + && (GetStdHandle(STD_OUTPUT_HANDLE) != chanInfoPtr->handle) + && (GetStdHandle(STD_ERROR_HANDLE) != chanInfoPtr->handle))) { closeHandle = 1; } else { closeHandle = 0; @@ -988,7 +1005,7 @@ ConsoleCloseProc( /* Remove channel from watchers' list */ for (nextPtrPtr = &gWatchingChannelList; *nextPtrPtr != NULL; - nextPtrPtr = &(*nextPtrPtr)->nextWatchingChannelPtr) { + nextPtrPtr = &(*nextPtrPtr)->nextWatchingChannelPtr) { if (*nextPtrPtr == (ConsoleChannelInfo *) chanInfoPtr) { *nextPtrPtr = (*nextPtrPtr)->nextWatchingChannelPtr; break; @@ -1075,7 +1092,7 @@ ConsoleCloseProc( */ static int ConsoleInputProc( - ClientData instanceData, /* Console state. */ + void *instanceData, /* Console state. */ char *bufPtr, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -1143,22 +1160,27 @@ ConsoleInputProc( /* * Blocking read. Just get data from directly from console. There - * is a small complication in that we can only read even number - * of bytes (wide-character API) and the destination buffer should be - * WCHAR aligned. If either condition is not met, we defer to the - * reader thread which handles these case rather than dealing with + * is a small complication in that + * 1. The destination buffer should be WCHAR aligned. + * 2. We can only read even number of bytes (wide-character API). + * 3. Caller has large enough buffer (else length of line user can + * enter will be limited) + * If any condition is not met, we defer to the + * reader thread which handles these cases rather than dealing with * them here (which is a little trickier than it might sound.) + * + * TODO - not clear this block is a useful optimization. bufSize by + * default is 4K which is < INPUT_BUFFER_SIZE and will rarely be + * increased on stdin. */ - if ((1 & (ptrdiff_t)bufPtr) == 0 /* aligned buffer */ - && bufSize > 1 /* Not single byte read */ - ) { + if ((1 & (size_t)bufPtr) == 0 /* aligned buffer */ + && (1 & bufSize) == 0 /* Even number of bytes */ + && bufSize > INPUT_BUFFER_SIZE) { DWORD lastError; Tcl_Size numChars; ReleaseSRWLockExclusive(&handleInfoPtr->lock); lastError = ReadConsoleChars(chanInfoPtr->handle, - (WCHAR *)bufPtr, - bufSize / sizeof(WCHAR), - &numChars); + (WCHAR *)bufPtr, bufSize / sizeof(WCHAR), &numChars); /* NOTE lock released so DON'T break. Return instead */ if (lastError != ERROR_SUCCESS) { Tcl_WinConvertError(lastError); @@ -1186,9 +1208,7 @@ ConsoleInputProc( handleInfoPtr->flags |= CONSOLE_DATA_AWAITED; WakeConditionVariable(&handleInfoPtr->consoleThreadCV); if (!SleepConditionVariableSRW(&handleInfoPtr->interpThreadCV, - &handleInfoPtr->lock, - INFINITE, - 0)) { + &handleInfoPtr->lock, INFINITE, 0)) { Tcl_WinConvertError(GetLastError()); *errorCode = Tcl_GetErrno(); numRead = -1; @@ -1200,7 +1220,7 @@ ConsoleInputProc( /* We read data. Ask for more if either async or watching for reads */ if ((chanInfoPtr->flags & CONSOLE_ASYNC) - || (chanInfoPtr->watchMask & TCL_READABLE)) { + || (chanInfoPtr->watchMask & TCL_READABLE)) { handleInfoPtr->flags |= CONSOLE_DATA_AWAITED; WakeConditionVariable(&handleInfoPtr->consoleThreadCV); } @@ -1228,7 +1248,7 @@ ConsoleInputProc( */ static int ConsoleOutputProc( - ClientData instanceData, /* Console state. */ + void *instanceData, /* Console state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -1285,15 +1305,12 @@ ConsoleOutputProc( * The ring buffer deals with cases (3) and (4). It would be harder * to duplicate that here. */ - if ((chanInfoPtr->flags & CONSOLE_ASYNC) /* Case (1) */ - || RingBufferLength(&handleInfoPtr->buffer) != 0 /* Case (2) */ - || (toWrite & 1) != 0 /* Case (3) */ - || (PTR2INT(buf) & 1) != 0 /* Case (4) */ - ) { + if ((chanInfoPtr->flags & CONSOLE_ASYNC) /* Case (1) */ + || RingBufferLength(&handleInfoPtr->buffer) != 0 /* Case (2) */ + || (toWrite & 1) != 0 /* Case (3) */ + || (PTR2INT(buf) & 1) != 0) { /* Case (4) */ numWritten += RingBufferIn(&handleInfoPtr->buffer, - numWritten + buf, - toWrite - numWritten, - 1); + numWritten + buf, toWrite - numWritten, 1); if (numWritten == toWrite || chanInfoPtr->flags & CONSOLE_ASYNC) { /* All done or async, just accept whatever was written */ break; @@ -1305,9 +1322,7 @@ ConsoleOutputProc( */ WakeConditionVariable(&handleInfoPtr->consoleThreadCV); if (!SleepConditionVariableSRW(&handleInfoPtr->interpThreadCV, - &handleInfoPtr->lock, - INFINITE, - 0)) { + &handleInfoPtr->lock, INFINITE, 0)) { /* Report the error */ Tcl_WinConvertError(GetLastError()); *errorCode = Tcl_GetErrno(); @@ -1320,11 +1335,10 @@ ConsoleOutputProc( HANDLE consoleHandle = handleInfoPtr->console; /* Unlock before blocking in WriteConsole */ ReleaseSRWLockExclusive(&handleInfoPtr->lock); - /* UNLOCKED so return, DON'T break out of loop as it will unlock again! */ + /* UNLOCKED so return, DON'T break out of loop as it will unlock + * again! */ winStatus = WriteConsoleChars(consoleHandle, - (WCHAR *)buf, - toWrite / sizeof(WCHAR), - &numWritten); + (WCHAR *)buf, toWrite / sizeof(WCHAR), &numWritten); if (winStatus == ERROR_SUCCESS) { return numWritten * sizeof(WCHAR); } else { @@ -1398,9 +1412,8 @@ ConsoleEventProc( * still owned by this thread AND is still watching events. */ if (chanInfoPtr->channel && chanInfoPtr->threadId == Tcl_GetCurrentThread() - && (chanInfoPtr->watchMask & (TCL_READABLE|TCL_WRITABLE))) { - ConsoleHandleInfo *handleInfoPtr; - handleInfoPtr = FindConsoleInfo(chanInfoPtr); + && (chanInfoPtr->watchMask & (TCL_READABLE|TCL_WRITABLE))) { + ConsoleHandleInfo *handleInfoPtr = FindConsoleInfo(chanInfoPtr); if (handleInfoPtr == NULL) { /* Console was closed. EOF->read event only (not write) */ if (chanInfoPtr->watchMask & TCL_READABLE) { @@ -1410,10 +1423,10 @@ ConsoleEventProc( AcquireSRWLockShared(&handleInfoPtr->lock); /* Remember at most one of READABLE, WRITABLE set */ if ((chanInfoPtr->watchMask & TCL_READABLE) - && RingBufferLength(&handleInfoPtr->buffer)) { + && RingBufferLength(&handleInfoPtr->buffer)) { mask = TCL_READABLE; } else if ((chanInfoPtr->watchMask & TCL_WRITABLE) - && RingBufferHasFreeSpace(&handleInfoPtr->buffer)) { + && RingBufferHasFreeSpace(&handleInfoPtr->buffer)) { /* Generate write event space available */ mask = TCL_WRITABLE; } @@ -1468,10 +1481,9 @@ ConsoleEventProc( static void ConsoleWatchProc( - ClientData instanceData, /* Console state. */ + void *instanceData, /* Console state. */ int newMask) /* What events to watch for, one of - * of TCL_READABLE, TCL_WRITABLE - */ + * of TCL_READABLE, TCL_WRITABLE */ { ConsoleChannelInfo **nextPtrPtr, *ptr; ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; @@ -1497,8 +1509,7 @@ ConsoleWatchProc( * that we are looking for data since it will not do reads until * it knows someone is awaiting. */ - ConsoleHandleInfo *handleInfoPtr; - handleInfoPtr = FindConsoleInfo(chanInfoPtr); + ConsoleHandleInfo *handleInfoPtr = FindConsoleInfo(chanInfoPtr); if (handleInfoPtr) { AcquireSRWLockExclusive(&handleInfoPtr->lock); handleInfoPtr->flags |= CONSOLE_DATA_AWAITED; @@ -1544,9 +1555,9 @@ ConsoleWatchProc( static int ConsoleGetHandleProc( - ClientData instanceData, /* The console state. */ + void *instanceData, /* The console state. */ TCL_UNUSED(int) /*direction*/, - ClientData *handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; @@ -1574,7 +1585,8 @@ ConsoleGetHandleProc( *------------------------------------------------------------------------ */ static int - ConsoleDataAvailable (HANDLE consoleHandle) + ConsoleDataAvailable( + HANDLE consoleHandle) { INPUT_RECORD input[10]; DWORD count; @@ -1583,9 +1595,8 @@ ConsoleGetHandleProc( /* * Need at least one keyboard event. */ - if (PeekConsoleInputW( - consoleHandle, input, sizeof(input) / sizeof(input[0]), &count) - == FALSE) { + if (PeekConsoleInputW(consoleHandle, input, + sizeof(input) / sizeof(input[0]), &count) == FALSE) { return -1; } /* @@ -1596,11 +1607,12 @@ ConsoleGetHandleProc( * down somewhere in the unread buffer. I suppose we could expand the * buffer but not worth... */ - if (count == (sizeof(input)/sizeof(input[0]))) + if (count == (sizeof(input)/sizeof(input[0]))) { return 1; + } for (i = 0; i < count; ++i) { if (input[i].EventType == KEY_EVENT - && input[i].Event.KeyEvent.bKeyDown) { + && input[i].Event.KeyEvent.bKeyDown) { return 1; } } @@ -1630,9 +1642,11 @@ ConsoleReaderThread( { ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg; ConsoleHandleInfo **iterator; - char inputChars[200]; /* Temporary buffer */ Tcl_Size inputLen = 0; Tcl_Size inputOffset = 0; + Tcl_Size lastReadSize = 0; + DWORD sleepTime; + char inputChars[INPUT_BUFFER_SIZE]; /* * Keep looping until one of the following happens. @@ -1666,11 +1680,9 @@ ConsoleReaderThread( Tcl_Size nStored; assert((inputLen - inputOffset) > 0); - nStored = RingBufferIn(&handleInfoPtr->buffer, - inputOffset + inputChars, - inputLen - inputOffset, - 1); + inputOffset + inputChars, inputLen - inputOffset, + 1); inputOffset += nStored; if (inputOffset == inputLen) { /* Temp buffer now empty */ @@ -1713,33 +1725,40 @@ ConsoleReaderThread( continue; } + assert(inputLen == 0); + /* - * Both shared buffer and private buffer are empty. Need to go get - * data from console but do not want to read ahead because the - * interp thread might change the read mode, e.g. turning off echo - * for password input. So only do so if at least one interpreter has - * requested data. + * Read more data in two cases: + * 1. The previous read filled the buffer and there could be more + * data in the console internal *text* buffer. Note + * ConsolePendingInput (checked in ConsoleDataAvailable) will NOT + * show this. It holds input events not yet translated to text. + * 2. Tcl threads want more data AND there is data in the + * ConsolePendingInput buffer. The latter check necessary because + * we do not want to read ahead because the interp thread might + * change the read mode, e.g. turning off echo for password + * input. So only do so if at least one interpreter has requested + * data. */ - if ((handleInfoPtr->flags & CONSOLE_DATA_AWAITED) - && ConsoleDataAvailable(handleInfoPtr->console)) { + if (lastReadSize == sizeof(inputChars) + || ((handleInfoPtr->flags & CONSOLE_DATA_AWAITED) + && ConsoleDataAvailable(handleInfoPtr->console))) { DWORD error; /* Do not hold the lock while blocked in console */ ReleaseSRWLockExclusive(&handleInfoPtr->lock); - /* - * Note - the temporary buffer serves two purposes. It - */ error = ReadConsoleChars(handleInfoPtr->console, - (WCHAR *)inputChars, - sizeof(inputChars) / sizeof(WCHAR), - &inputLen); + (WCHAR *)inputChars, sizeof(inputChars) / sizeof(WCHAR), + &inputLen); AcquireSRWLockExclusive(&handleInfoPtr->lock); if (error == 0) { inputLen *= sizeof(WCHAR); + lastReadSize = inputLen; } else { /* * We only store the last error. It is up to channel * handlers whether to close or not in case of errors. */ + lastReadSize = 0; handleInfoPtr->lastError = error; if (handleInfoPtr->lastError == ERROR_INVALID_HANDLE) { handleInfoPtr->console = INVALID_HANDLE_VALUE; @@ -1753,13 +1772,10 @@ ConsoleReaderThread( * poll since ReadConsole does not support async operation. * So sleep for a short while and loop back to retry. */ - DWORD sleepTime; sleepTime = handleInfoPtr->flags & CONSOLE_DATA_AWAITED ? 50 : INFINITE; SleepConditionVariableSRW(&handleInfoPtr->consoleThreadCV, - &handleInfoPtr->lock, - sleepTime, - 0); + &handleInfoPtr->lock, sleepTime, 0); } /* Loop again to check for exit or wait for readers to wake us */ @@ -1776,7 +1792,7 @@ ConsoleReaderThread( ReleaseSRWLockExclusive(&handleInfoPtr->lock); AcquireSRWLockExclusive(&gConsoleLock); /* Modifying - exclusive lock */ for (iterator = &gConsoleHandleInfoList; *iterator; - iterator = &(*iterator)->nextPtr) { + iterator = &(*iterator)->nextPtr) { if (*iterator == handleInfoPtr) { *iterator = handleInfoPtr->nextPtr; break; @@ -1788,7 +1804,7 @@ ConsoleReaderThread( RingBufferClear(&handleInfoPtr->buffer); if (handleInfoPtr->console != INVALID_HANDLE_VALUE - && handleInfoPtr->lastError != ERROR_INVALID_HANDLE) { + && handleInfoPtr->lastError != ERROR_INVALID_HANDLE) { SetConsoleMode(handleInfoPtr->console, handleInfoPtr->initMode); /* * NOTE: we do not call CloseHandle(handleInfoPtr->console) here. @@ -1821,7 +1837,8 @@ ConsoleReaderThread( *---------------------------------------------------------------------- */ static DWORD WINAPI -ConsoleWriterThread(LPVOID arg) +ConsoleWriterThread( + LPVOID arg) { ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg; ConsoleHandleInfo **iterator; @@ -1874,9 +1891,7 @@ ConsoleWriterThread(LPVOID arg) /* Wake up any threads waiting synchronously. */ WakeConditionVariable(&handleInfoPtr->interpThreadCV); success = SleepConditionVariableSRW(&handleInfoPtr->consoleThreadCV, - &handleInfoPtr->lock, - INFINITE, - 0); + &handleInfoPtr->lock, INFINITE, 0); /* Note: lock has been acquired again! */ if (!success && GetLastError() != ERROR_TIMEOUT) { /* TODO - what can be done? Should not happen */ @@ -1900,9 +1915,7 @@ ConsoleWriterThread(LPVOID arg) Tcl_Size numWChars = numBytes / sizeof(WCHAR); DWORD status; status = WriteConsoleChars(handleInfoPtr->console, - (WCHAR *)(offset + buffer), - numWChars, - &numWChars); + (WCHAR *)(offset + buffer), numWChars, &numWChars); if (status != 0) { /* Only overwrite if no previous error */ if (handleInfoPtr->lastError == 0) { @@ -1947,7 +1960,7 @@ ConsoleWriterThread(LPVOID arg) ReleaseSRWLockExclusive(&handleInfoPtr->lock); AcquireSRWLockExclusive(&gConsoleLock); /* Modifying - exclusive lock */ for (iterator = &gConsoleHandleInfoList; *iterator; - iterator = &(*iterator)->nextPtr) { + iterator = &(*iterator)->nextPtr) { if (*iterator == handleInfoPtr) { *iterator = handleInfoPtr->nextPtr; break; @@ -1993,8 +2006,8 @@ AllocateConsoleHandleInfo( ConsoleHandleInfo *handleInfoPtr; DWORD consoleMode; - - handleInfoPtr = (ConsoleHandleInfo *)ckalloc(sizeof(*handleInfoPtr)); + handleInfoPtr = (ConsoleHandleInfo *) ckalloc(sizeof(*handleInfoPtr)); + memset(handleInfoPtr, 0, sizeof(*handleInfoPtr)); memset(handleInfoPtr, 0, sizeof(*handleInfoPtr)); handleInfoPtr->console = consoleHandle; InitializeSRWLock(&handleInfoPtr->lock); @@ -2214,7 +2227,7 @@ TclWinOpenConsoleChannel( static void ConsoleThreadActionProc( - ClientData instanceData, + void *instanceData, int action) { ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData; @@ -2247,7 +2260,7 @@ ConsoleThreadActionProc( */ static int ConsoleSetOptionProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ @@ -2336,7 +2349,7 @@ ConsoleSetOptionProc( static int ConsoleGetOptionProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ @@ -2401,30 +2414,26 @@ ConsoleGetOptionProc( valid = 1; if (!GetConsoleScreenBufferInfo(chanInfoPtr->handle, - &consoleInfo)) { + &consoleInfo)) { Tcl_WinConvertError(GetLastError()); if (interp != NULL) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("couldn't read console size: %s", - Tcl_PosixError(interp))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't read console size: %s", + Tcl_PosixError(interp))); } return TCL_ERROR; } Tcl_DStringStartSublist(dsPtr); - snprintf(buf, sizeof(buf), - "%d", + snprintf(buf, sizeof(buf), "%d", consoleInfo.srWindow.Right - consoleInfo.srWindow.Left + 1); Tcl_DStringAppendElement(dsPtr, buf); - snprintf(buf, sizeof(buf), - "%d", + snprintf(buf, sizeof(buf), "%d", consoleInfo.srWindow.Bottom - consoleInfo.srWindow.Top + 1); Tcl_DStringAppendElement(dsPtr, buf); Tcl_DStringEndSublist(dsPtr); } } - if (valid) { return TCL_OK; } diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index e02f6d6..5d45fe1 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -410,8 +410,7 @@ DoRenameFile( * directory back, for completeness. */ - if (MoveFileW(nativeSrc, - nativeDst) != FALSE) { + if (MoveFileW(nativeSrc, nativeDst) != FALSE) { return TCL_OK; } @@ -696,8 +695,7 @@ DoCopyFile( if (dstAttr & FILE_ATTRIBUTE_READONLY) { SetFileAttributesW(nativeDst, dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY)); - if (CopyFileW(nativeSrc, nativeDst, - 0) != FALSE) { + if (CopyFileW(nativeSrc, nativeDst, 0) != FALSE) { return TCL_OK; } @@ -793,8 +791,7 @@ TclpDeleteFile( int res = SetFileAttributesW(path, attr & ~((DWORD) FILE_ATTRIBUTE_READONLY)); - if ((res != 0) && - (DeleteFileW(path) != FALSE)) { + if ((res != 0) && (DeleteFileW(path) != FALSE)) { return TCL_OK; } Tcl_WinConvertError(GetLastError()); @@ -1081,8 +1078,7 @@ DoRemoveJustDirectory( if (attr & FILE_ATTRIBUTE_READONLY) { attr &= ~FILE_ATTRIBUTE_READONLY; - if (SetFileAttributesW(nativePath, - attr) == FALSE) { + if (SetFileAttributesW(nativePath, attr) == FALSE) { goto end; } if (RemoveDirectoryW(nativePath) != FALSE) { @@ -1119,7 +1115,9 @@ DoRemoveJustDirectory( Tcl_DStringInit(errorPtr); p = Tcl_WCharToUtfDString(nativePath, TCL_INDEX_NONE, errorPtr); for (; *p; ++p) { - if (*p == '\\') *p = '/'; + if (*p == '\\') { + *p = '/'; + } } } return TCL_ERROR; @@ -1380,8 +1378,7 @@ TraversalCopy( if (DoCreateDirectory(nativeDst) == TCL_OK) { DWORD attr = GetFileAttributesW(nativeSrc); - if (SetFileAttributesW(nativeDst, - attr) != FALSE) { + if (SetFileAttributesW(nativeDst, attr) != FALSE) { return TCL_OK; } Tcl_WinConvertError(GetLastError()); @@ -1604,7 +1601,7 @@ ConvertFileNameFormat( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": no such file or directory", - Tcl_GetString(fileName))); + TclGetString(fileName))); errno = ENOENT; Tcl_PosixError(interp); } @@ -1895,7 +1892,7 @@ CannotSetAttribute( { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot set attribute \"%s\" for file \"%s\": attribute is readonly", - tclpFileAttrStrings[objIndex], Tcl_GetString(fileName))); + tclpFileAttrStrings[objIndex], TclGetString(fileName))); errno = EINVAL; Tcl_PosixError(interp); return TCL_ERROR; @@ -2002,12 +1999,12 @@ TclpCreateTemporaryDirectory( */ if (dirObj) { - Tcl_GetString(dirObj); + TclGetString(dirObj); if (dirObj->length < 1) { goto useSystemTemp; } Tcl_DStringInit(&base); - Tcl_UtfToWCharDString(Tcl_GetString(dirObj), TCL_INDEX_NONE, &base); + Tcl_UtfToWCharDString(TclGetString(dirObj), TCL_INDEX_NONE, &base); if (dirObj->bytes[dirObj->length - 1] != '\\') { Tcl_UtfToWCharDString("\\", TCL_INDEX_NONE, &base); } @@ -2025,7 +2022,7 @@ TclpCreateTemporaryDirectory( #define SUFFIX_LENGTH 8 if (basenameObj) { - Tcl_UtfToWCharDString(Tcl_GetString(basenameObj), TCL_INDEX_NONE, &base); + Tcl_UtfToWCharDString(TclGetString(basenameObj), TCL_INDEX_NONE, &base); } else { Tcl_UtfToWCharDString(DEFAULT_TEMP_DIR_PREFIX, TCL_INDEX_NONE, &base); } diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 5e47098..62cc94e 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -149,8 +149,8 @@ typedef struct { * Other typedefs required by this code. */ -static time_t ToCTime(FILETIME fileTime); -static void FromCTime(time_t posixTime, FILETIME *fileTime); +static __time64_t ToCTime(FILETIME fileTime); +static void FromCTime(__time64_t posixTime, FILETIME *fileTime); /* * Declarations for local functions defined in this file: @@ -991,7 +991,7 @@ TclpMatchInDirectory( attr = GetFileAttributesW(native); if ((attr == INVALID_FILE_ATTRIBUTES) - || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { + || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { return TCL_OK; } @@ -2288,7 +2288,7 @@ NativeStatMode( * * ToCTime -- * - * Converts a Windows FILETIME to a time_t in UTC. + * Converts a Windows FILETIME to a __time64_t in UTC. * * Results: * Returns the count of seconds from the Posix epoch. @@ -2296,7 +2296,7 @@ NativeStatMode( *------------------------------------------------------------------------ */ -static time_t +static __time64_t ToCTime( FILETIME fileTime) /* UTC time */ { @@ -2305,7 +2305,7 @@ ToCTime( convertedTime.LowPart = fileTime.dwLowDateTime; convertedTime.HighPart = (LONG) fileTime.dwHighDateTime; - return (time_t) ((convertedTime.QuadPart - + return (__time64_t) ((convertedTime.QuadPart - (long long) POSIX_EPOCH_AS_FILETIME) / (long long) 10000000); } @@ -2314,7 +2314,7 @@ ToCTime( * * FromCTime -- * - * Converts a time_t to a Windows FILETIME + * Converts a __time64_t to a Windows FILETIME * * Results: * Returns the count of 100-ns ticks seconds from the Windows epoch. @@ -2324,7 +2324,7 @@ ToCTime( static void FromCTime( - time_t posixTime, + __time64_t posixTime, FILETIME *fileTime) /* UTC Time */ { LARGE_INTEGER convertedTime; @@ -2471,7 +2471,7 @@ TclpFilesystemPathType( if (normPath == NULL) { return NULL; } - path = Tcl_GetString(normPath); + path = TclGetString(normPath); if (path == NULL) { return NULL; } @@ -2551,7 +2551,7 @@ TclpObjNormalizePath( Tcl_DString ds; /* Some workspace. */ Tcl_DStringInit(&dsNorm); - path = Tcl_GetString(pathPtr); + path = TclGetString(pathPtr); currentPathEndPosition = path + nextCheckpoint; if (*currentPathEndPosition == '/') { @@ -2649,12 +2649,12 @@ TclpObjNormalizePath( * Convert link to forward slashes. */ - for (path = Tcl_GetString(to); *path != 0; path++) { + for (path = TclGetString(to); *path != 0; path++) { if (*path == '\\') { *path = '/'; } } - path = Tcl_GetString(to); + path = TclGetString(to); currentPathEndPosition = path + nextCheckpoint; if (temp != NULL) { Tcl_DecrRefCount(temp); @@ -2889,7 +2889,7 @@ TclWinVolumeRelativeNormalize( * current volume. */ - const char *drive = Tcl_GetString(useThisCwd); + const char *drive = TclGetString(useThisCwd); absolutePath = Tcl_NewStringObj(drive,2); Tcl_AppendToObj(absolutePath, path, TCL_INDEX_NONE); diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 01714f0..59404d6 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -604,9 +604,7 @@ TclpFindVariable( Tcl_UtfToUpper(nameUpper); Tcl_DStringInit(&envString); - for (i = 0, env = _wenviron[i]; - env != NULL; - i++, env = _wenviron[i]) { + for (i = 0, env = _wenviron[i]; env != NULL; i++, env = _wenviron[i]) { /* * Chop the env string off after the equal sign, then Convert the name * to all upper case, so we do not have to convert all the characters diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index faf80ee..4d9b578 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -114,14 +114,14 @@ TclpDlopen( * first error for reporting purposes. */ if (firstError == ERROR_MOD_NOT_FOUND || - firstError == ERROR_DLL_NOT_FOUND) { + firstError == ERROR_DLL_NOT_FOUND) { lastError = GetLastError(); } else { lastError = firstError; } errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ", - Tcl_GetString(pathPtr)); + TclGetString(pathPtr)); /* * Check for possible DLL errors. This doesn't work quite right, diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index 7b7ef1e..64d739a 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -57,8 +57,8 @@ static CRITICAL_SECTION notifierMutex; * Static routines defined in this file. */ -static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, - WPARAM wParam, LPARAM lParam); +static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, + WPARAM wParam, LPARAM lParam); /* *---------------------------------------------------------------------- diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 5bf5165..bb4983e 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1316,7 +1316,7 @@ ApplicationType( ext = strrchr(fullName, '.'); if ((ext != NULL) && - (strcasecmp(ext, ".cmd") == 0 || strcasecmp(ext, ".bat") == 0)) { + (strcasecmp(ext, ".cmd") == 0 || strcasecmp(ext, ".bat") == 0)) { applType = APPL_DOS; break; } @@ -2770,7 +2770,7 @@ Tcl_PidObjCmd( TclNewIntObj(elemPtr, getpid()); Tcl_SetObjResult(interp, elemPtr); } else { - chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), + chan = Tcl_GetChannel(interp, TclGetString(objv[1]), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 9ef62c6..a0b4e90 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -853,7 +853,7 @@ GetValue( Tcl_NewStringObj(Tcl_DStringValue(&buf), Tcl_DStringLength(&buf))); - while (*wp++ != 0) {/* empty body */} + while (*wp++ != 0); /* empty loop body */ p = (char *) wp; Tcl_DStringFree(&buf); } @@ -937,7 +937,6 @@ GetValueNames( size = MAX_KEY_LENGTH; while (RegEnumValueW(key,index, (WCHAR *)Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { - Tcl_DStringInit(&ds); Tcl_WCharToUtfDString((const WCHAR *)Tcl_DStringValue(&buffer), size, &ds); name = Tcl_DStringValue(&ds); diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 9a3b127..4f1a9c2 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -433,7 +433,7 @@ Tcl_GetHostName(void) */ void -TclInitSockets() +TclInitSockets(void) { /* Then Per thread initialization. */ DWORD id; @@ -1207,7 +1207,7 @@ TcpSetOptionProc( return TCL_OK; } if ((len > 1) && (optionName[1] == 'n') && - (strncmp(optionName, "-nodelay", len) == 0)) { + (strncmp(optionName, "-nodelay", len) == 0)) { BOOL boolVar; int rtn; @@ -2272,7 +2272,7 @@ Tcl_OpenTcpServerEx( ioctlsocket(sock, (long) FIONBIO, &flag); SendSelectMessage(tsdPtr, SELECT, statePtr); if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "") - == TCL_ERROR) { + == TCL_ERROR) { Tcl_Close(NULL, statePtr->channel); return NULL; } diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 86f36b4..f2c9a86d 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -476,8 +476,8 @@ TestplatformChmod( } /* Get process SID */ - if (!GetTokenInformation(hToken, TokenUser, NULL, 0, &dw) && - GetLastError() != ERROR_INSUFFICIENT_BUFFER) { + if (!GetTokenInformation(hToken, TokenUser, NULL, 0, &dw) + && GetLastError() != ERROR_INSUFFICIENT_BUFFER) { goto done; } pTokenUser = (TOKEN_USER *)ckalloc(dw); @@ -486,9 +486,8 @@ TestplatformChmod( } aceEntry[nSids].sidLen = GetLengthSid(pTokenUser->User.Sid); aceEntry[nSids].pSid = ckalloc(aceEntry[nSids].sidLen); - if (!CopySid(aceEntry[nSids].sidLen, - aceEntry[nSids].pSid, - pTokenUser->User.Sid)) { + if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, + pTokenUser->User.Sid)) { ckfree(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ goto done; } -- cgit v0.12 From 3ba2524ad4dcbada77fd5079cb69007cdea2a5e9 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 19 Mar 2024 17:09:30 +0000 Subject: more spacing/formatting tweaks --- generic/tclAssembly.c | 2 +- generic/tclBasic.c | 2 +- generic/tclCkalloc.c | 2 +- generic/tclCmdAH.c | 10 +-- generic/tclCompCmds.c | 12 ++-- generic/tclCompCmdsGR.c | 2 +- generic/tclCompCmdsSZ.c | 2 +- generic/tclCompile.c | 180 ++++++++++++++++++++++++------------------------ generic/tclEncoding.c | 44 ++++++------ generic/tclEnsemble.c | 3 +- generic/tclEvent.c | 10 +-- generic/tclExecute.c | 30 ++++---- generic/tclFileName.c | 2 +- generic/tclIO.c | 10 +-- generic/tclIOUtil.c | 6 +- generic/tclNamesp.c | 24 +++---- generic/tclOOBasic.c | 2 +- generic/tclOptimize.c | 18 ++--- generic/tclPathObj.c | 12 ++-- generic/tclProc.c | 6 +- generic/tclScan.c | 3 +- generic/tclStringObj.c | 11 ++- generic/tclTest.c | 80 +++++++++------------ generic/tclTestObj.c | 11 ++- generic/tclVar.c | 4 +- generic/tclZipfs.c | 12 ++-- unix/tclAppInit.c | 7 +- unix/tclSelectNotfy.c | 4 +- unix/tclUnixFCmd.c | 17 +++-- unix/tclUnixFile.c | 4 +- unix/tclUnixInit.c | 43 ++++++------ unix/tclUnixPipe.c | 9 ++- win/tclAppInit.c | 5 +- win/tclWinFile.c | 2 +- win/tclWinPipe.c | 3 +- win/tclWinSock.c | 4 +- win/tclWinTest.c | 13 +--- win/tclWinThrd.c | 9 ++- 38 files changed, 290 insertions(+), 330 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index b041670..cc1fe3b 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -1383,7 +1383,7 @@ AssembleOneLine( } if (opnd < 0 || opnd > 3) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("operand must be [0..3]", -1)); + Tcl_NewStringObj("operand must be [0..3]", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND<0,>3", (void *)NULL); goto cleanup; } diff --git a/generic/tclBasic.c b/generic/tclBasic.c index a2f4edc..3435eef 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -6572,7 +6572,7 @@ int Tcl_ExprBooleanObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ int *ptr) /* Where to store 0/1 result. */ { Tcl_Obj *resultPtr; diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 6b989c9..1c12106 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -251,7 +251,7 @@ ValidateMemory( hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length; for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) { - byte = *(hiPtr + idx); + byte = hiPtr[idx]; if (byte != GUARD_VALUE) { guard_failed = TRUE; fflush(stdout); diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 85d8a1c..25d0441 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -822,7 +822,7 @@ EncodingSystemObjCmd( } if (objc == 1) { Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tcl_GetEncodingName(NULL), -1)); + Tcl_NewStringObj(Tcl_GetEncodingName(NULL), -1)); } else { return Tcl_SetSystemEncoding(interp, TclGetString(objv[1])); } @@ -1193,8 +1193,8 @@ FileAttrAccessTimeCmd( /* We use a value of 0 to indicate the access time not available */ if (Tcl_GetAccessTimeFromStat(&buf) == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not get access time for file \"%s\"", - TclGetString(objv[1]))); + "could not get access time for file \"%s\"", + TclGetString(objv[1]))); return TCL_ERROR; } #endif @@ -1275,8 +1275,8 @@ FileAttrModifyTimeCmd( /* We use a value of 0 to indicate the modification time not available */ if (Tcl_GetModificationTimeFromStat(&buf) == 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not get modification time for file \"%s\"", - TclGetString(objv[1]))); + "could not get modification time for file \"%s\"", + TclGetString(objv[1]))); return TCL_ERROR; } #endif diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 98b1ec6..2e61d11 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -776,11 +776,11 @@ TclCompileClockClicksCmd( || tokenPtr[1].size > 13) { return TCL_ERROR; } else if (!strncmp(tokenPtr[1].start, "-microseconds", - tokenPtr[1].size)) { + tokenPtr[1].size)) { TclEmitInstInt1(INST_CLOCK_READ, 1, envPtr); break; } else if (!strncmp(tokenPtr[1].start, "-milliseconds", - tokenPtr[1].size)) { + tokenPtr[1].size)) { TclEmitInstInt1(INST_CLOCK_READ, 2, envPtr); break; } else { @@ -3452,8 +3452,10 @@ TclLocalScalar( size_t numBytes, CompileEnv *envPtr) { - Tcl_Token token[2] = {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1}, - {TCL_TOKEN_TEXT, NULL, 0, 0}}; + Tcl_Token token[2] = { + {TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1}, + {TCL_TOKEN_TEXT, NULL, 0, 0} + }; token[1].start = bytes; token[1].size = numBytes; @@ -3640,7 +3642,7 @@ TclPushVarName( int hasNsQualifiers = 0; for (p = name, last = p + nameLen-1; p < last; p++) { - if ((*p == ':') && (*(p+1) == ':')) { + if ((p[0] == ':') && (p[1] == ':')) { hasNsQualifiers = 1; break; } diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index f35cd50..63f9e07 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -2754,7 +2754,7 @@ IndexTailVarIfKnown( */ for (p = tailName + len -1; p > tailName; p--) { - if ((*p == ':') && (*(p - 1) == ':')) { + if ((p[0] == ':') && (p[- 1] == ':')) { p++; break; } diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 5f221bd..09881cc 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -235,7 +235,7 @@ TclCompileStringCatCmd( } /* General case: issue CONCAT1's (by chunks of 254 if needed), folding - contiguous constants along the way */ + * contiguous constants along the way */ numArgs = 0; folded = NULL; diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 9866ce2..0fc3e48 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -2195,114 +2195,114 @@ TclCompileScript( /* Each iteration compiles one command from the script. */ if (numBytes > 0) { - if (numBytes >= INT_MAX) { - /* - * Note this gets -errorline as 1. Not worth figuring out which line - * crosses the limit to get -errorline for this error case. - */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "Script length %" TCL_SIZE_MODIFIER - "d exceeds max permitted length %d.", - numBytes, INT_MAX-1)); - Tcl_SetErrorCode(interp, "TCL", "LIMIT", "SCRIPTLENGTH", (void *)NULL); - TclCompileSyntaxError(interp, envPtr); - return; - } - /* - * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so - * many nested compilations (body enclosed in body) can cause abnormal - * program termination with a stack overflow exception, bug [fec0c17d39]. - */ - Tcl_Parse *parsePtr = (Tcl_Parse *)Tcl_Alloc(sizeof(Tcl_Parse)); - - do { - const char *next; - - if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, parsePtr)) { + if (numBytes >= INT_MAX) { /* - * Compile bytecodes to report the parsePtr error at runtime. + * Note this gets -errorline as 1. Not worth figuring out which line + * crosses the limit to get -errorline for this error case. */ - - Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, - parsePtr->term + 1 - parsePtr->commandStart); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Script length %" TCL_SIZE_MODIFIER + "d exceeds max permitted length %d.", + numBytes, INT_MAX-1)); + Tcl_SetErrorCode(interp, "TCL", "LIMIT", "SCRIPTLENGTH", (void *)NULL); TclCompileSyntaxError(interp, envPtr); - Tcl_Free(parsePtr); return; } - -#ifdef TCL_COMPILE_DEBUG /* - * If tracing, print a line for each top level command compiled. - * TODO: Suppress when numWords == 0 ? + * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so + * many nested compilations (body enclosed in body) can cause abnormal + * program termination with a stack overflow exception, bug [fec0c17d39]. */ + Tcl_Parse *parsePtr = (Tcl_Parse *)Tcl_Alloc(sizeof(Tcl_Parse)); - if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) { - int commandLength = parsePtr->term - parsePtr->commandStart; - fprintf(stdout, " Compiling: "); - TclPrintSource(stdout, parsePtr->commandStart, - TclMin(commandLength, 55)); - fprintf(stdout, "\n"); - } -#endif + do { + const char *next; - /* - * TIP #280: Count newlines before the command start. - * (See test info-30.33). - */ + if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, parsePtr)) { + /* + * Compile bytecodes to report the parsePtr error at runtime. + */ + + Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, + parsePtr->term + 1 - parsePtr->commandStart); + TclCompileSyntaxError(interp, envPtr); + Tcl_Free(parsePtr); + return; + } - TclAdvanceLines(&envPtr->line, p, parsePtr->commandStart); - TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, - parsePtr->commandStart - envPtr->source); +#ifdef TCL_COMPILE_DEBUG + /* + * If tracing, print a line for each top level command compiled. + * TODO: Suppress when numWords == 0 ? + */ - /* - * Advance parser to the next command in the script. - */ + if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) { + int commandLength = parsePtr->term - parsePtr->commandStart; + fprintf(stdout, " Compiling: "); + TclPrintSource(stdout, parsePtr->commandStart, + TclMin(commandLength, 55)); + fprintf(stdout, "\n"); + } +#endif - next = parsePtr->commandStart + parsePtr->commandSize; - numBytes -= next - p; - p = next; + /* + * TIP #280: Count newlines before the command start. + * (See test info-30.33). + */ + + TclAdvanceLines(&envPtr->line, p, parsePtr->commandStart); + TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, + parsePtr->commandStart - envPtr->source); - if (parsePtr->numWords == 0) { /* - * The "command" parsed has no words. In this case we can skip - * the rest of the loop body. With no words, clearly - * CompileCommandTokens() has nothing to do. Since the parser - * aggressively sucks up leading comment and white space, - * including newlines, parsePtr->commandStart must be pointing at - * either the end of script, or a command-terminating semi-colon. - * In either case, the TclAdvance*() calls have nothing to do. - * Finally, when no words are parsed, no tokens have been - * allocated at parsePtr->tokenPtr so there's also nothing for - * Tcl_FreeParse() to do. - * - * The advantage of this shortcut is that CompileCommandTokens() - * can be written with an assumption that (int)parsePtr->numWords > 0, with - * the implication the CCT() always generates bytecode. + * Advance parser to the next command in the script. */ - continue; - } - /* - * Avoid stack exhaustion by too many nested calls of TclCompileScript - * (considering interp recursionlimit). - */ - iPtr->numLevels++; + next = parsePtr->commandStart + parsePtr->commandSize; + numBytes -= next - p; + p = next; + + if (parsePtr->numWords == 0) { + /* + * The "command" parsed has no words. In this case we can skip + * the rest of the loop body. With no words, clearly + * CompileCommandTokens() has nothing to do. Since the parser + * aggressively sucks up leading comment and white space, + * including newlines, parsePtr->commandStart must be pointing at + * either the end of script, or a command-terminating semi-colon. + * In either case, the TclAdvance*() calls have nothing to do. + * Finally, when no words are parsed, no tokens have been + * allocated at parsePtr->tokenPtr so there's also nothing for + * Tcl_FreeParse() to do. + * + * The advantage of this shortcut is that CompileCommandTokens() + * can be written with an assumption that (int)parsePtr->numWords > 0, with + * the implication the CCT() always generates bytecode. + */ + continue; + } + + /* + * Avoid stack exhaustion by too many nested calls of TclCompileScript + * (considering interp recursionlimit). + */ + iPtr->numLevels++; - lastCmdIdx = CompileCommandTokens(interp, parsePtr, envPtr); + lastCmdIdx = CompileCommandTokens(interp, parsePtr, envPtr); - iPtr->numLevels--; + iPtr->numLevels--; - /* - * TIP #280: Track lines in the just compiled command. - */ + /* + * TIP #280: Track lines in the just compiled command. + */ - TclAdvanceLines(&envPtr->line, parsePtr->commandStart, p); - TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, - p - envPtr->source); - Tcl_FreeParse(parsePtr); - } while (numBytes > 0); + TclAdvanceLines(&envPtr->line, parsePtr->commandStart, p); + TclAdvanceContinuations(&envPtr->line, &envPtr->clNext, + p - envPtr->source); + Tcl_FreeParse(parsePtr); + } while (numBytes > 0); - Tcl_Free(parsePtr); + Tcl_Free(parsePtr); } if (lastCmdIdx == -1) { @@ -2374,12 +2374,12 @@ TclCompileVarSubst( */ for (i = 0, p = name; i < nameBytes; i++, p++) { - if ((*p == ':') && (i < nameBytes-1) && (*(p+1) == ':')) { + if ((p[0] == ':') && (i < nameBytes-1) && (p[1] == ':')) { localVarName = -1; break; - } else if ((*p == '(') + } else if ((p[0] == '(') && (tokenPtr->numComponents == 1) - && (*(name + nameBytes - 1) == ')')) { + && (name[nameBytes - 1] == ')')) { localVarName = 0; break; } diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 1b71026..074c58e 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1049,30 +1049,30 @@ Tcl_CreateEncoding( encodingPtr->refCount = 1; encodingPtr->hPtr = NULL; - if (typePtr->encodingName) { - Tcl_HashEntry *hPtr; - int isNew; - char *name; + if (typePtr->encodingName) { + Tcl_HashEntry *hPtr; + int isNew; + char *name; - Tcl_MutexLock(&encodingMutex); - hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &isNew); - if (isNew == 0) { - /* - * Remove old encoding from hash table, but don't delete it until last - * reference goes away. - */ + Tcl_MutexLock(&encodingMutex); + hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &isNew); + if (isNew == 0) { + /* + * Remove old encoding from hash table, but don't delete it until last + * reference goes away. + */ - Encoding *replaceMe = (Encoding *)Tcl_GetHashValue(hPtr); - replaceMe->hPtr = NULL; - } + Encoding *replaceMe = (Encoding *)Tcl_GetHashValue(hPtr); + replaceMe->hPtr = NULL; + } - name = (char *)Tcl_Alloc(strlen(typePtr->encodingName) + 1); - encodingPtr->name = strcpy(name, typePtr->encodingName); - encodingPtr->hPtr = hPtr; - Tcl_SetHashValue(hPtr, encodingPtr); + name = (char *) Tcl_Alloc(strlen(typePtr->encodingName) + 1); + encodingPtr->name = strcpy(name, typePtr->encodingName); + encodingPtr->hPtr = hPtr; + Tcl_SetHashValue(hPtr, encodingPtr); - Tcl_MutexUnlock(&encodingMutex); - } + Tcl_MutexUnlock(&encodingMutex); + } return (Tcl_Encoding) encodingPtr; } @@ -1545,8 +1545,8 @@ Tcl_UtfToExternalDStringEx( dstChunkLen = dstLen > INT_MAX ? INT_MAX : dstLen; result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, - srcChunkLen, flags, &state, dst, dstChunkLen, - &srcChunkRead, &dstChunkWrote, &dstChunkChars); + srcChunkLen, flags, &state, dst, dstChunkLen, + &srcChunkRead, &dstChunkWrote, &dstChunkChars); soFar = dst + dstChunkWrote - Tcl_DStringValue(dstPtr); /* Move past the part processed in this go around */ diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index f4d4504..1769324 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1818,8 +1818,7 @@ NsEnsembleImplementationCmdNR( */ const char *subcmdName; /* Name of the subcommand or unique prefix of - * it (a non-unique prefix produces an error). - */ + * it (a non-unique prefix produces an error). */ char *fullName = NULL; /* Full name of the subcommand. */ Tcl_Size stringLength, i; Tcl_Size tableLength = ensemblePtr->subcommandTable.numEntries; diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 23925f2..69c3c27 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -1593,8 +1593,8 @@ Tcl_VwaitObjCmd( goto needArg; } result = Tcl_TraceVar2(interp, TclGetString(objv[i]), NULL, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - VwaitVarProc, &vwaitItems[numItems]); + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + VwaitVarProc, &vwaitItems[numItems]); if (result != TCL_OK) { goto done; } @@ -1675,8 +1675,8 @@ Tcl_VwaitObjCmd( for (result = TCL_OK; i < objc; i++) { result = Tcl_TraceVar2(interp, TclGetString(objv[i]), NULL, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - VwaitVarProc, &vwaitItems[numItems]); + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + VwaitVarProc, &vwaitItems[numItems]); if (result != TCL_OK) { break; } @@ -1709,7 +1709,7 @@ Tcl_VwaitObjCmd( vwaitItems[numItems].mask = 0; vwaitItems[numItems].sourceObj = NULL; timer = Tcl_CreateTimerHandler(timeout, VwaitTimeoutProc, - &vwaitItems[numItems]); + &vwaitItems[numItems]); Tcl_GetTime(&before); } else { timeout = 0; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index ac27a87..f4c223c 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -361,9 +361,9 @@ VarHashCreateVar( #define OBJ_AT_TOS *tosPtr -#define OBJ_UNDER_TOS *(tosPtr-1) +#define OBJ_UNDER_TOS tosPtr[-1] -#define OBJ_AT_DEPTH(n) *(tosPtr-(n)) +#define OBJ_AT_DEPTH(n) tosPtr[-(n)] #define CURR_DEPTH (tosPtr - initTosPtr) @@ -379,8 +379,8 @@ VarHashCreateVar( # define TRACE(a) \ while (traceInstructions) { \ fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ - CURR_DEPTH, \ - (pc - codePtr->codeStart), \ + CURR_DEPTH, \ + (pc - codePtr->codeStart), \ GetOpcodeName(pc)); \ printf a; \ break; \ @@ -395,8 +395,8 @@ VarHashCreateVar( # define TRACE_WITH_OBJ(a, objPtr) \ while (traceInstructions) { \ fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ - CURR_DEPTH, \ - (pc - codePtr->codeStart), \ + CURR_DEPTH, \ + (pc - codePtr->codeStart), \ GetOpcodeName(pc)); \ printf a; \ TclPrintObject(stdout, objPtr, 30); \ @@ -450,15 +450,15 @@ VarHashCreateVar( */ #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ + ((TclHasInternalRep((objPtr), &tclIntType)) \ ? (*(tPtr) = TCL_NUMBER_INT, \ - *(ptrPtr) = (void *) \ + *(ptrPtr) = (void *) \ (&((objPtr)->internalRep.wideValue)), TCL_OK) : \ TclHasInternalRep((objPtr), &tclDoubleType) \ ? (((isnan((objPtr)->internalRep.doubleValue)) \ ? (*(tPtr) = TCL_NUMBER_NAN) \ : (*(tPtr) = TCL_NUMBER_DOUBLE)), \ - *(ptrPtr) = (void *) \ + *(ptrPtr) = (void *) \ (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \ (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)) \ ? TCL_ERROR : \ @@ -3123,7 +3123,7 @@ TEBCresume( objResultPtr = OBJ_AT_TOS; varPtr->value.objPtr = objResultPtr; #ifndef TCL_COMPILE_DEBUG - if (*(pc+pcAdjustment) == INST_POP) { + if (pc[pcAdjustment] == INST_POP) { tosPtr--; NEXT_INST_F((pcAdjustment+1), 0, 0); } @@ -3287,7 +3287,7 @@ TEBCresume( goto gotError; } #ifndef TCL_COMPILE_DEBUG - if (*(pc+pcAdjustment) == INST_POP) { + if (pc[pcAdjustment] == INST_POP) { NEXT_INST_V((pcAdjustment+1), cleanup, 0); } #endif @@ -3686,7 +3686,7 @@ TEBCresume( doneIncr: TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); #ifndef TCL_COMPILE_DEBUG - if (*(pc+pcAdjustment) == INST_POP) { + if (pc[pcAdjustment] == INST_POP) { NEXT_INST_V((pcAdjustment+1), cleanup, 0); } #endif @@ -5009,7 +5009,7 @@ TEBCresume( */ #ifndef TCL_COMPILE_DEBUG - if (*(pc+9) == INST_POP) { + if (pc[9] == INST_POP) { NEXT_INST_F(10, 1, 0); } #endif @@ -6993,7 +6993,7 @@ TEBCresume( } } #ifndef TCL_COMPILE_DEBUG - if (*(pc+9) == INST_POP) { + if (pc[9] == INST_POP) { NEXT_INST_V(10, cleanup, 0); } #endif @@ -7132,7 +7132,7 @@ TEBCresume( } } #ifndef TCL_COMPILE_DEBUG - if (*(pc+5) == INST_POP) { + if (pc[5] == INST_POP) { NEXT_INST_F(6, 2, 0); } #endif diff --git a/generic/tclFileName.c b/generic/tclFileName.c index baa915d..847b225 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -1267,7 +1267,7 @@ Tcl_GlobObjCmd( last = first + pathlength; for (; last != first; last--) { - if (strchr(separators, *(last-1)) != NULL) { + if (strchr(separators, last[-1]) != NULL) { break; } } diff --git a/generic/tclIO.c b/generic/tclIO.c index df9f665..f52edc4 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -647,7 +647,7 @@ TclFinalizeIOSubsystem(void) */ (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, - "-blocking", "on"); + "-blocking", "on"); } if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || @@ -2448,13 +2448,13 @@ Tcl_GetChannelHandle( int Tcl_RemoveChannelMode( - Tcl_Interp* interp, /* The interp for an error message. Allowed to be NULL. */ + Tcl_Interp *interp, /* The interp for an error message. Allowed to be NULL. */ Tcl_Channel chan, /* The channel which is modified. */ - int mode) /* The access mode to drop from the channel */ + int mode) /* The access mode to drop from the channel */ { const char* emsg; ChannelState *statePtr = ((Channel *) chan)->state; - /* State of actual channel. */ + /* State of actual channel. */ if ((mode != TCL_READABLE) && (mode != TCL_WRITABLE)) { emsg = "Illegal mode value."; @@ -3564,7 +3564,7 @@ TclClose( Tcl_SetErrno(stickyError); if (interp != NULL) { Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tcl_PosixError(interp), -1)); + Tcl_NewStringObj(Tcl_PosixError(interp), -1)); } return TCL_ERROR; } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index b892d65..af0e101 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -4351,16 +4351,14 @@ Tcl_FSCopyDirectory( int Tcl_FSRemoveDirectory( - Tcl_Obj *pathPtr, /* The pathname of the directory to be removed. - */ + Tcl_Obj *pathPtr, /* The pathname of the directory to be removed. */ int recursive, /* If zero, removes only an empty directory. * Otherwise, removes the directory and all its * contents. */ Tcl_Obj **errorPtr) /* If not NULL and an error occurs, stores a * place to store a a pointer to a new * object having a refCount of 1 and containing - * the name of the file that produced an error. - * */ + * the name of the file that produced an error. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 2268609..bdff82d 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -2260,13 +2260,13 @@ TclGetNamespaceForQualName( start = qualName; /* Points to start of qualifying * namespace. */ - if ((*qualName == ':') && (*(qualName+1) == ':')) { - start = qualName+2; /* Skip over the initial :: */ - while (*start == ':') { + if ((qualName[0] == ':') && (qualName[1] == ':')) { + start = qualName + 2; /* Skip over the initial :: */ + while (start[0] == ':') { start++; /* Skip over a subsequent : */ } nsPtr = globalNsPtr; - if (*start == '\0') { /* qualName is just two or more + if (start[0] == '\0') { /* qualName is just two or more * ":"s. */ *nsPtrPtr = globalNsPtr; *altNsPtrPtr = NULL; @@ -2306,7 +2306,7 @@ TclGetNamespaceForQualName( len = 0; for (end = start; *end != '\0'; end++) { - if ((*end == ':') && (*(end+1) == ':')) { + if ((end[0] == ':') && (end[1] == ':')) { end += 2; /* Skip over the initial :: */ while (*end == ':') { end++; /* Skip over the subsequent : */ @@ -2316,7 +2316,7 @@ TclGetNamespaceForQualName( len++; } - if (*end=='\0' && !(end-start>=2 && *(end-1)==':' && *(end-2)==':')) { + if (end[0]=='\0' && !(end-start>=2 && end[-1]==':' && end[-2]==':')) { /* * qualName ended with a simple name at start. If TCL_FIND_ONLY_NS * was specified, look this up as a namespace. Otherwise, start is @@ -2436,7 +2436,7 @@ TclGetNamespaceForQualName( * variable name, trailing "::"s refer to the cmd or var named {}. */ - if ((flags & TCL_FIND_ONLY_NS) || (end>start && *(end-1)!=':')) { + if ((flags & TCL_FIND_ONLY_NS) || (end>start && end[-1]!=':')) { *simpleNamePtr = NULL; /* Found namespace name. */ } else { *simpleNamePtr = end; /* Found cmd/var: points to empty @@ -3058,7 +3058,7 @@ NamespaceChildrenCmd( if (objc == 3) { const char *name = TclGetString(objv[2]); - if ((*name == ':') && (*(name+1) == ':')) { + if ((name[0] == ':') && (name[1] == ':')) { pattern = name; } else { Tcl_DStringAppend(&buffer, nsPtr->fullName, -1); @@ -4291,13 +4291,13 @@ NamespaceQualifiersCmd( */ name = TclGetString(objv[1]); - for (p = name; *p != '\0'; p++) { + for (p = name; p[0] != '\0'; p++) { /* empty body */ } while (--p >= name) { - if ((*p == ':') && (p > name) && (*(p-1) == ':')) { + if ((p[0] == ':') && (p > name) && (p[-1] == ':')) { p -= 2; /* Back up over the :: */ - while ((p >= name) && (*p == ':')) { + while ((p >= name) && (p[0] == ':')) { p--; /* Back up over the preceding : */ } break; @@ -4549,7 +4549,7 @@ NamespaceTailCmd( /* empty body */ } while (--p > name) { - if ((*p == ':') && (*(p-1) == ':')) { + if ((p[0] == ':') && (p[-1] == ':')) { p++; /* Just after the last "::" */ break; } diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 5a38dee..b1b36e0 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -1281,7 +1281,7 @@ TclOOCopyObjectCmd( if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, - "sourceName ?targetName? ?targetNamespace?"); + "sourceName ?targetName? ?targetNamespace?"); return TCL_ERROR; } diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c index 7a4a962..247c326 100644 --- a/generic/tclOptimize.c +++ b/generic/tclOptimize.c @@ -214,7 +214,7 @@ ConvertZeroEffectToNOP( size = AddrLength(currentInstPtr); while ((currentInstPtr + size < envPtr->codeNext) - && *(currentInstPtr+size) == INST_NOP) { + && currentInstPtr[size] == INST_NOP) { if (IsTargetAddress(&targets, currentInstPtr + size)) { break; } @@ -223,7 +223,7 @@ ConvertZeroEffectToNOP( if (IsTargetAddress(&targets, currentInstPtr + size)) { continue; } - nextInst = *(currentInstPtr + size); + nextInst = currentInstPtr[size]; switch (*currentInstPtr) { case INST_PUSH1: if (nextInst == INST_POP) { @@ -260,19 +260,19 @@ ConvertZeroEffectToNOP( switch (nextInst) { case INST_JUMP_TRUE1: blank = size; - *(currentInstPtr + size) = INST_JUMP_FALSE1; + currentInstPtr[size] = INST_JUMP_FALSE1; break; case INST_JUMP_FALSE1: blank = size; - *(currentInstPtr + size) = INST_JUMP_TRUE1; + currentInstPtr[size] = INST_JUMP_TRUE1; break; case INST_JUMP_TRUE4: blank = size; - *(currentInstPtr + size) = INST_JUMP_FALSE4; + currentInstPtr[size] = INST_JUMP_FALSE4; break; case INST_JUMP_FALSE4: blank = size; - *(currentInstPtr + size) = INST_JUMP_TRUE4; + currentInstPtr[size] = INST_JUMP_TRUE4; break; } break; @@ -318,7 +318,7 @@ ConvertZeroEffectToNOP( if (blank > 0) { for (i=0 ; i current user */ const char *subPath, /* Rest of path. May be NULL */ Tcl_DString *dsPtr) /* Output. Is initialized by the function. Must be - freed on success */ + * freed on success */ { const char *dir; Tcl_DString dirString; @@ -2489,10 +2489,10 @@ MakeTildeRelativePath( if (dir == NULL) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't find HOME environment variable to" - " expand path", -1)); + "couldn't find HOME environment variable to expand path", + -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", - "HOMELESS", (void *)NULL); + "HOMELESS", (void *)NULL); } return TCL_ERROR; } @@ -2502,9 +2502,9 @@ MakeTildeRelativePath( if (dir == NULL) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "user \"%s\" doesn't exist", user)); + "user \"%s\" doesn't exist", user)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER", - (void *)NULL); + (void *)NULL); } return TCL_ERROR; } diff --git a/generic/tclProc.c b/generic/tclProc.c index 419b9eb..ebd7681 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -559,9 +559,9 @@ TclCreateProc( "FORMALARGUMENTFORMAT", (void *)NULL); goto procError; } - } else if (*argnamei == ':' && *(argnamei+1) == ':') { + } else if (argnamei[0] == ':' && argnamei[1] == ':') { Tcl_Obj *errorObj = Tcl_NewStringObj( - "formal parameter \"", -1); + "formal parameter \"", -1); Tcl_AppendObjToObj(errorObj, fieldValues[0]); Tcl_AppendToObj(errorObj, "\" is not a simple name", -1); Tcl_SetObjResult(interp, errorObj); @@ -2592,7 +2592,7 @@ SetLambdaFromAny( } else { const char *nsName = TclGetString(objv[2]); - if ((*nsName != ':') || (*(nsName+1) != ':')) { + if ((nsName[0] != ':') || (nsName[1] != ':')) { TclNewLiteralStringObj(nsObjPtr, "::"); Tcl_AppendObjToObj(nsObjPtr, objv[2]); } else { diff --git a/generic/tclScan.c b/generic/tclScan.c index 1fc7e97..195153b 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -325,8 +325,7 @@ ValidateFormat( objIndex = (int) ull - 1; if (numVars && (objIndex >= numVars)) { goto badIndex; - } - else if (numVars == 0) { + } else if (numVars == 0) { /* * In the case where no vars are specified, the user can * specify %9999$ legally, so we have to consider special diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 4f1a145..d8b96f7 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -181,14 +181,11 @@ GrowUnicodeBuffer( } if (stringPtr->maxChars > 0) { /* Expansion - try allocating extra space */ - stringPtr = (String *)TclReallocElemsEx(stringPtr, - needed + 1, /* +1 for nul */ - sizeof(Tcl_UniChar), - offsetof(String, unicode), - &maxChars); + stringPtr = (String *) TclReallocElemsEx(stringPtr, + needed + 1, /* +1 for nul */ + sizeof(Tcl_UniChar), offsetof(String, unicode), &maxChars); maxChars -= 1; /* End nul not included */ - } - else { + } else { /* * First allocation - just big enough. Note needed does * not include terminating nul but STRING_SIZE does diff --git a/generic/tclTest.c b/generic/tclTest.c index 3e818ac..c0ce8db 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -688,7 +688,7 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testnumutfchars", TestNumUtfCharsCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testgetunichar", - TestGetUniCharCmd, NULL, NULL); + TestGetUniCharCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindfirst", TestFindFirstCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindlast", @@ -1908,9 +1908,9 @@ TestdoubledigitsObjCmd( } } if (status != TCL_OK - || Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK - || Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type", - TCL_EXACT, &type) != TCL_OK) { + || Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK + || Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type", + TCL_EXACT, &type) != TCL_OK) { fprintf(stderr, "bad value? %g\n", d); return TCL_ERROR; } @@ -2136,10 +2136,8 @@ static int UtfExtWrapper( Tcl_WideInt wide; if (objc < 7 || objc > 10) { - Tcl_WrongNumArgs(interp, - 2, - objv, - "encoding srcbytes flags state dstlen ?srcreadvar? ?dstwrotevar? ?dstcharsvar?"); + Tcl_WrongNumArgs(interp, 2, objv, + "encoding srcbytes flags state dstlen ?srcreadvar? ?dstwrotevar? ?dstcharsvar?"); return TCL_ERROR; } if (Tcl_GetEncodingFromObj(interp, objv[2], &encoding) != TCL_OK) { @@ -2158,13 +2156,8 @@ static int UtfExtWrapper( flags |= flag; } else { int idx; - if (Tcl_GetIndexFromObjStruct(interp, - flagObjs[i], - flagMap, - sizeof(flagMap[0]), - "flag", - 0, - &idx) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, flagObjs[i], flagMap, sizeof(flagMap[0]), + "flag", 0, &idx) != TCL_OK) { return TCL_ERROR; } flags |= flagMap[idx].flag; @@ -2228,14 +2221,14 @@ static int UtfExtWrapper( memmove(bufPtr + dstLen, "\xAB\xCD\xEF\xAB", 4); /* overflow detection */ bytes = Tcl_GetByteArrayFromObj(objv[3], &srcLen); /* Last! to avoid shimmering */ result = (*transformer)(interp, encoding, (const char *)bytes, srcLen, flags, - encStatePtr, (char *) bufPtr, dstLen, - srcReadVar ? &srcRead : NULL, - &dstWrote, - dstCharsVar ? &dstChars : NULL); + encStatePtr, (char *) bufPtr, dstLen, + srcReadVar ? &srcRead : NULL, + &dstWrote, + dstCharsVar ? &dstChars : NULL); if (memcmp(bufPtr + bufLen - 4, "\xAB\xCD\xEF\xAB", 4)) { Tcl_SetResult(interp, - "Tcl_ExternalToUtf wrote past output buffer", - TCL_STATIC); + "Tcl_ExternalToUtf wrote past output buffer", + TCL_STATIC); result = TCL_ERROR; } else if (result != TCL_ERROR) { Tcl_Obj *resultObjs[3]; @@ -2264,29 +2257,20 @@ static int UtfExtWrapper( encStatePtr ? Tcl_NewWideIntObj((Tcl_WideInt)(size_t)encState) : Tcl_NewObj(); resultObjs[2] = Tcl_NewByteArrayObj(bufPtr, dstLen); if (srcReadVar) { - if (Tcl_ObjSetVar2(interp, - srcReadVar, - NULL, - Tcl_NewIntObj(srcRead), - TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(interp, srcReadVar, NULL, Tcl_NewIntObj(srcRead), + TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } } if (dstWroteVar) { - if (Tcl_ObjSetVar2(interp, - dstWroteVar, - NULL, - Tcl_NewIntObj(dstWrote), - TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(interp, dstWroteVar, NULL, Tcl_NewIntObj(dstWrote), + TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } } if (dstCharsVar) { - if (Tcl_ObjSetVar2(interp, - dstCharsVar, - NULL, - Tcl_NewIntObj(dstChars), - TCL_LEAVE_ERR_MSG) == NULL) { + if (Tcl_ObjSetVar2(interp, dstCharsVar, NULL, Tcl_NewIntObj(dstChars), + TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } } @@ -2397,7 +2381,7 @@ TestencodingObjCmd( return TCL_ERROR; } Tcl_SetObjResult(interp, - Tcl_NewIntObj(Tcl_GetEncodingNulLength(encoding))); + Tcl_NewIntObj(Tcl_GetEncodingNulLength(encoding))); Tcl_FreeEncoding(encoding); break; case ENC_EXTTOUTF: @@ -3332,7 +3316,7 @@ TestlinkCmd( } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "wide", &wideVar, - TCL_LINK_WIDE_INT | flag) != TCL_OK) { + TCL_LINK_WIDE_INT | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[7], &writable) != TCL_OK) { @@ -3929,10 +3913,10 @@ TestlistrepCmd( ListObjGetRep(objv[2], &listRep); listRepObjs[0] = Tcl_NewStringObj("store", -1); listRepObjs[1] = Tcl_NewListObj(12, NULL); - Tcl_ListObjAppendElement( - interp, listRepObjs[1], Tcl_NewStringObj("memoryAddress", -1)); - Tcl_ListObjAppendElement( - interp, listRepObjs[1], Tcl_ObjPrintf("%p", listRep.storePtr)); + Tcl_ListObjAppendElement(interp, listRepObjs[1], + Tcl_NewStringObj("memoryAddress", -1)); + Tcl_ListObjAppendElement(interp, listRepObjs[1], + Tcl_ObjPrintf("%p", listRep.storePtr)); APPEND_FIELD(listRepObjs[1], listRep.storePtr, firstUsed); APPEND_FIELD(listRepObjs[1], listRep.storePtr, numUsed); APPEND_FIELD(listRepObjs[1], listRep.storePtr, numAllocated); @@ -3941,14 +3925,12 @@ TestlistrepCmd( if (listRep.spanPtr) { listRepObjs[2] = Tcl_NewStringObj("span", -1); listRepObjs[3] = Tcl_NewListObj(8, NULL); - Tcl_ListObjAppendElement(interp, - listRepObjs[3], - Tcl_NewStringObj("memoryAddress", -1)); - Tcl_ListObjAppendElement( - interp, listRepObjs[3], Tcl_ObjPrintf("%p", listRep.spanPtr)); + Tcl_ListObjAppendElement(interp, listRepObjs[3], + Tcl_NewStringObj("memoryAddress", -1)); + Tcl_ListObjAppendElement(interp, listRepObjs[3], + Tcl_ObjPrintf("%p", listRep.spanPtr)); APPEND_FIELD(listRepObjs[3], listRep.spanPtr, spanStart); - APPEND_FIELD( - listRepObjs[3], listRep.spanPtr, spanLength); + APPEND_FIELD(listRepObjs[3], listRep.spanPtr, spanLength); APPEND_FIELD(listRepObjs[3], listRep.spanPtr, refCount); } resultObj = Tcl_NewListObj(listRep.spanPtr ? 4 : 2, listRepObjs); diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 1714aad..cfca015 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -414,7 +414,7 @@ TestbooleanobjCmd( return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex], - &boolValue) != TCL_OK) { + &boolValue) != TCL_OK) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { @@ -514,7 +514,7 @@ TestdoubleobjCmd( return TCL_ERROR; } if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex], - &doubleValue) != TCL_OK) { + &doubleValue) != TCL_OK) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { @@ -953,7 +953,7 @@ TestlistobjCmd( case LISTOBJ_REPLACE: if (objc < 5) { Tcl_WrongNumArgs(interp, 2, objv, - "varIndex start count ?element...?"); + "varIndex start count ?element...?"); return TCL_ERROR; } if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK @@ -965,7 +965,7 @@ TestlistobjCmd( } Tcl_ResetResult(interp); return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count, - objc-5, objv+5); + objc-5, objv+5); case LISTOBJ_INDEXMEMCHECK: if (objc != 3) { @@ -1023,8 +1023,7 @@ TestlistobjCmd( * Hence this explicit test. */ if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, - "varIndex listIndex"); + Tcl_WrongNumArgs(interp, 2, objv, "varIndex listIndex"); return TCL_ERROR; } if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK) { diff --git a/generic/tclVar.c b/generic/tclVar.c index 1f5431c..ceac15d 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -914,7 +914,7 @@ TclLookupSimpleVar( const char *tail; int lookGlobal = (flags & TCL_GLOBAL_ONLY) || (cxtNsPtr == iPtr->globalNsPtr) - || ((*varName == ':') && (*(varName+1) == ':')); + || ((varName[0] == ':') && (varName[1] == ':')); if (lookGlobal) { *indexPtr = -1; @@ -4971,7 +4971,7 @@ Tcl_GlobalObjCmd( for (tail=varName ; *tail!='\0' ; tail++) { /* empty body */ } - while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) { + while ((tail > varName) && ((tail[0] != ':') || (tail[-1] != ':'))) { tail--; } if ((*tail == ':') && (tail > varName)) { diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 3aaeb6c..236fe72 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -2469,16 +2469,14 @@ TclZipfs_MountBuffer( } memcpy(zf->data, data, datalen); zf->ptrToFree = zf->data; - } - else { + } else { zf->data = (unsigned char *)data; zf->ptrToFree = NULL; } ret = ZipFSFindTOC(interp, 1, zf); if (ret != TCL_OK) { Tcl_Free(zf); - } - else { + } else { /* Note ZipFSCatalogFilesystem will free zf on error */ ret = ZipFSCatalogFilesystem( interp, zf, mountPoint, NULL, "Memory Buffer"); @@ -5046,8 +5044,7 @@ InitWritableChannel( info->ubuf[i] = zdecode(info->keys, crc32tab, ch); } info->numBytes = len; - } - else { + } else { /* * Simple stored data. Copy into our working buffer. */ @@ -5558,8 +5555,7 @@ ZipFSMatchInDirectoryProc( } wanted &= (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE | TCL_GLOB_TYPE_MOUNT); - } - else { + } else { wanted = TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE; } diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index c49df55..6158c99 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -164,10 +164,9 @@ Tcl_AppInit( #define INITFILENAME ".tclshrc" #endif - (void)Tcl_EvalEx(interp, - "set tcl_rcFileName [file tildeexpand ~/" INITFILENAME "]", - -1, - TCL_EVAL_GLOBAL); + (void) Tcl_EvalEx(interp, + "set tcl_rcFileName [file tildeexpand ~/" INITFILENAME "]", + -1, TCL_EVAL_GLOBAL); return TCL_OK; } diff --git a/unix/tclSelectNotfy.c b/unix/tclSelectNotfy.c index feabfa8..252c493 100644 --- a/unix/tclSelectNotfy.c +++ b/unix/tclSelectNotfy.c @@ -1115,12 +1115,12 @@ NotifierThreadProc( tspecPtr->tv_nsec = timePtr->tv_usec * 1000; } ret = pselect(numFdBits, &readableMask, &writableMask, - &exceptionMask, tspecPtr, ¬ifierSigMask); + &exceptionMask, tspecPtr, ¬ifierSigMask); } #else pthread_sigmask(SIG_SETMASK, ¬ifierSigMask, NULL); ret = select(numFdBits, &readableMask, &writableMask, &exceptionMask, - timePtr); + timePtr); pthread_sigmask(SIG_BLOCK, &allSigMask, NULL); #endif diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 3eee59e..08b9d27 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -484,8 +484,7 @@ DoCopyFile( char linkBuf[MAXPATHLEN+1]; int length; - length = readlink(src, linkBuf, MAXPATHLEN); - /* INTL: Native. */ + length = readlink(src, linkBuf, MAXPATHLEN); /* INTL: Native. */ if (length == -1) { return TCL_ERROR; } @@ -1786,7 +1785,7 @@ GetModeFromPermString( newMode = 0; for (i = 0; i < 9; i++) { - switch (*(modeStringPtr+i)) { + switch (modeStringPtr[i]) { case 'r': if ((i%3) != 0) { goto chmodStyleCheck; @@ -1848,13 +1847,13 @@ GetModeFromPermString( * We now check for an "ugoa+-=rwxst" style permissions string */ - for (n = 0 ; *(modeStringPtr+n) != '\0' ; n = n + i) { + for (n = 0 ; modeStringPtr[n] != '\0' ; n += i) { oldMode = *modePtr; who = op = what = op_found = who_found = 0; - for (i = 0 ; *(modeStringPtr+n+i) != '\0' ; i++ ) { + for (i = 0 ; modeStringPtr[n + i] != '\0' ; i++ ) { if (!who_found) { /* who */ - switch (*(modeStringPtr+n+i)) { + switch (modeStringPtr[n + i]) { case 'u': who |= 0x9C0; continue; @@ -1875,7 +1874,7 @@ GetModeFromPermString( } if (!op_found) { /* op */ - switch (*(modeStringPtr+n+i)) { + switch (modeStringPtr[n + i]) { case '+': op = 1; op_found = 1; @@ -1893,7 +1892,7 @@ GetModeFromPermString( } } /* what */ - switch (*(modeStringPtr+n+i)) { + switch (modeStringPtr[n + i]) { case 'r': what |= 0x124; continue; @@ -1914,7 +1913,7 @@ GetModeFromPermString( default: return TCL_ERROR; } - if (*(modeStringPtr+n+i) == ',') { + if (modeStringPtr[n + i] == ',') { i++; break; } diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 70924f8..444c73f 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -131,9 +131,9 @@ TclpFindExecutable( && S_ISREG(statBuf.st_mode)) { goto gotName; } - if (*p == '\0') { + if (p[0] == '\0') { break; - } else if (*(p+1) == 0) { + } else if (p[1] == 0) { p = "./"; } else { p++; diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index eb8fa4c..67bff10 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -53,31 +53,31 @@ static const char *const processors[NUMPROCESSORS] = { }; typedef struct { - union { - unsigned int dwOemId; - struct { - int wProcessorArchitecture; - int wReserved; + union { + unsigned int dwOemId; + struct { + int wProcessorArchitecture; + int wReserved; + }; }; - }; - unsigned int dwPageSize; - void *lpMinimumApplicationAddress; - void *lpMaximumApplicationAddress; - void *dwActiveProcessorMask; - unsigned int dwNumberOfProcessors; - unsigned int dwProcessorType; - unsigned int dwAllocationGranularity; - int wProcessorLevel; - int wProcessorRevision; + unsigned int dwPageSize; + void *lpMinimumApplicationAddress; + void *lpMaximumApplicationAddress; + void *dwActiveProcessorMask; + unsigned int dwNumberOfProcessors; + unsigned int dwProcessorType; + unsigned int dwAllocationGranularity; + int wProcessorLevel; + int wProcessorRevision; } SYSTEM_INFO; typedef struct { - unsigned int dwOSVersionInfoSize; - unsigned int dwMajorVersion; - unsigned int dwMinorVersion; - unsigned int dwBuildNumber; - unsigned int dwPlatformId; - wchar_t szCSDVersion[128]; + unsigned int dwOSVersionInfoSize; + unsigned int dwMajorVersion; + unsigned int dwMinorVersion; + unsigned int dwBuildNumber; + unsigned int dwPlatformId; + wchar_t szCSDVersion[128]; } OSVERSIONINFOW; #endif @@ -864,6 +864,7 @@ TclpSetVariables( /* Some platforms build configure scripts expect ~ expansion so do that */ Tcl_Obj *origPaths; Tcl_Obj *resolvedPaths; + origPaths = Tcl_GetVar2Ex(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY); resolvedPaths = TclResolveTildePathList(origPaths); if (resolvedPaths != origPaths && resolvedPaths != NULL) { diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 64dd8baf..939ec85 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -524,12 +524,11 @@ TclpCreateProcess( sigdelset(&sigs, SIGKILL); sigdelset(&sigs, SIGSTOP); - posix_spawnattr_setflags(&attr, - POSIX_SPAWN_SETSIGDEF + posix_spawnattr_setflags(&attr, POSIX_SPAWN_SETSIGDEF #ifdef POSIX_SPAWN_USEVFORK - | POSIX_SPAWN_USEVFORK + | POSIX_SPAWN_USEVFORK #endif - ); + ); posix_spawnattr_setsigdefault(&attr, &sigs); posix_spawn_file_actions_adddup2(&actions, GetFd(inputFile), 0); @@ -537,7 +536,7 @@ TclpCreateProcess( posix_spawn_file_actions_adddup2(&actions, GetFd(errorFile), 2); status = posix_spawnp(&pid, newArgv[0], &actions, &attr, - newArgv, environ); + newArgv, environ); childErrno = errno; posix_spawn_file_actions_destroy(&actions); posix_spawnattr_destroy(&attr); diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 8fad88a..339d61e 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -216,9 +216,8 @@ Tcl_AppInit( */ (void)Tcl_EvalEx(interp, - "set tcl_rcFileName [file tildeexpand ~/tclshrc.tcl]", - -1, - TCL_EVAL_GLOBAL); + "set tcl_rcFileName [file tildeexpand ~/tclshrc.tcl]", + TCL_AUTO_LENGTH, TCL_EVAL_GLOBAL); return TCL_OK; } diff --git a/win/tclWinFile.c b/win/tclWinFile.c index fd28ca5..d572628 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -3092,7 +3092,7 @@ TclNativeCreateNativeRep( wp = nativePathPtr = (WCHAR *)Tcl_Alloc((len + 6) * sizeof(WCHAR)); if (nativePathPtr==0) { - goto done; + goto done; } MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, len + 2); diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 67a96de..16efd6a 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -2124,8 +2124,7 @@ PipeClose2Proc( TCL_READABLE); Tcl_Free(filePtr); Tcl_SetChannelOption(NULL, errChan, "-profile", "replace"); - } - else { + } else { errChan = NULL; } diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 17b6004..2d083bb 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -2356,9 +2356,9 @@ TcpAccept( if (statePtr->acceptProc != NULL) { getnameinfo(&(addr.sa), len, host, sizeof(host), port, sizeof(port), - NI_NUMERICHOST|NI_NUMERICSERV); + NI_NUMERICHOST|NI_NUMERICSERV); statePtr->acceptProc(statePtr->acceptProcData, newInfoPtr->channel, - host, atoi(port)); + host, atoi(port)); } } diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 999c5ba..1a6a3db 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -582,14 +582,9 @@ TestplatformChmod( * to remove inherited ACL (we need to overwrite the default ACL's in this case) */ - if (SetNamedSecurityInfoA((LPSTR)nativePath, - SE_FILE_OBJECT, - DACL_SECURITY_INFORMATION | - PROTECTED_DACL_SECURITY_INFORMATION, - NULL, - NULL, - newAcl, - NULL) == ERROR_SUCCESS) { + if (SetNamedSecurityInfoA((LPSTR)nativePath, SE_FILE_OBJECT, + DACL_SECURITY_INFORMATION | PROTECTED_DACL_SECURITY_INFORMATION, + NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) { res = 0; } @@ -613,8 +608,6 @@ TestplatformChmod( /* Run normal chmod command */ return chmod(nativePath, pmode); - - } /* diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index 84a0eca..01db9f3 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -203,12 +203,12 @@ int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread. */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread. */ - void *clientData, /* The one argument to Main(). */ - size_t stackSize, /* Size of stack for the new thread. */ + void *clientData, /* The one argument to Main(). */ + size_t stackSize, /* Size of stack for the new thread. */ int flags) /* Flags controlling behaviour of the new * thread. */ { - WinThread *winThreadPtr; /* Per-thread startup info */ + WinThread *winThreadPtr; /* Per-thread startup info */ HANDLE tHandle; winThreadPtr = (WinThread *)Tcl_Alloc(sizeof(WinThread)); @@ -219,8 +219,7 @@ TclpThreadCreate( EnterCriticalSection(&joinLock); *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and - * on WIN64 sizeof void* != sizeof unsigned - */ + * on WIN64 sizeof void* != sizeof unsigned */ #if defined(_MSC_VER) || defined(__MSVCRT__) tHandle = (HANDLE) _beginthreadex(NULL, (unsigned)stackSize, -- cgit v0.12 From 6d093a49bdc100e9422cbde3980c3136f5989922 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 20 Mar 2024 13:14:26 +0000 Subject: (backport) more spacing/formatting tweaks. For now, macosx/unix/win only. --- macosx/tclMacOSXNotify.c | 22 +++++++-------- unix/tclEpollNotfy.c | 10 +++---- unix/tclKqueueNotfy.c | 10 +++---- unix/tclSelectNotfy.c | 10 +++---- unix/tclUnixChan.c | 2 +- unix/tclUnixCompat.c | 8 +++--- unix/tclUnixFCmd.c | 23 ++++++++-------- unix/tclUnixFile.c | 16 +++++------ unix/tclUnixInit.c | 42 ++++++++++++++--------------- unix/tclUnixNotfy.c | 8 +++--- unix/tclUnixPipe.c | 11 ++++---- unix/tclUnixTest.c | 20 +++++++------- unix/tclUnixThrd.c | 2 +- unix/tclUnixTime.c | 16 +++++------ unix/tclXtNotify.c | 10 +++---- unix/tclXtTest.c | 2 +- win/tclWinChan.c | 70 ++++++++++++++++++++++++------------------------ win/tclWinFile.c | 36 ++++++++++++------------- win/tclWinInit.c | 4 +-- win/tclWinLoad.c | 2 +- win/tclWinNotify.c | 10 +++---- win/tclWinSerial.c | 58 +++++++++++++++++++-------------------- win/tclWinSock.c | 4 +-- win/tclWinTest.c | 34 ++++++++++------------- win/tclWinThrd.c | 11 ++++---- win/tclWinTime.c | 18 ++++++------- 26 files changed, 224 insertions(+), 235 deletions(-) diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c index 169c7b9..de633a5 100644 --- a/macosx/tclMacOSXNotify.c +++ b/macosx/tclMacOSXNotify.c @@ -311,7 +311,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -505,7 +505,7 @@ static CFStringRef tclEventsOnlyRunLoopMode = NULL; */ static void StartNotifierThread(void); -static TCL_NORETURN void NotifierThreadProc(ClientData clientData); +static TCL_NORETURN void NotifierThreadProc(void *clientData); static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); static void TimerWakeUp(CFRunLoopTimerRef timer, void *info); static void QueueFileEvents(void *info); @@ -612,7 +612,7 @@ LookUpFileHandler( *---------------------------------------------------------------------- */ -ClientData +void * TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -868,7 +868,7 @@ StartNotifierThread(void) void TclpFinalizeNotifier( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -970,7 +970,7 @@ TclpFinalizeNotifier( void TclpAlertNotifier( - ClientData clientData) + void *clientData) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; @@ -1047,7 +1047,7 @@ TclpSetTimer( static void TimerWakeUp( TCL_UNUSED(CFRunLoopTimerRef), - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { } @@ -1114,7 +1114,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -1322,7 +1322,7 @@ FileHandlerEventProc( * * TclpNotifierData -- * - * This function returns a ClientData pointer to be associated + * This function returns a void pointer to be associated * with a Tcl_AsyncHandler. * * Results: @@ -1334,7 +1334,7 @@ FileHandlerEventProc( *---------------------------------------------------------------------- */ -ClientData +void * TclpNotifierData(void) { return NULL; @@ -1908,7 +1908,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ TCL_UNUSED(Tcl_ThreadId), /* Target thread. */ - TCL_UNUSED(ClientData), /* Notifier data. */ + TCL_UNUSED(void *), /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { @@ -1967,7 +1967,7 @@ TclAsyncNotifier( static TCL_NORETURN void NotifierThreadProc( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr; fd_set readableMask, writableMask, exceptionalMask; diff --git a/unix/tclEpollNotfy.c b/unix/tclEpollNotfy.c index 649c21b..563a30b 100644 --- a/unix/tclEpollNotfy.c +++ b/unix/tclEpollNotfy.c @@ -42,7 +42,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ LIST_ENTRY(FileHandler) readyNode; /* Next/previous in list of FileHandlers asso- @@ -150,7 +150,7 @@ static int PlatformEventsWait(struct epoll_event *events, *---------------------------------------------------------------------- */ -ClientData +void * TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -275,7 +275,7 @@ PlatformEventsControl( void TclpFinalizeNotifier( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -513,7 +513,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -791,7 +791,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ Tcl_ThreadId threadId, /* Target thread. */ - ClientData clientData, /* Notifier data. */ + void *clientData, /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclKqueueNotfy.c b/unix/tclKqueueNotfy.c index 2f495bd..627fa6e 100644 --- a/unix/tclKqueueNotfy.c +++ b/unix/tclKqueueNotfy.c @@ -40,7 +40,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ LIST_ENTRY(FileHandler) readyNode; /* Next/previous in list of FileHandlers asso- @@ -274,7 +274,7 @@ PlatformEventsControl( void TclpFinalizeNotifier( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -330,7 +330,7 @@ TclpFinalizeNotifier( *---------------------------------------------------------------------- */ -ClientData +void * TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -518,7 +518,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -787,7 +787,7 @@ int TclAsyncNotifier( int sigNumber, /* Signal number. */ Tcl_ThreadId threadId, /* Target thread. */ - ClientData clientData, /* Notifier data. */ + void *clientData, /* Notifier data. */ int *flagPtr, /* Flag to mark. */ int value) /* Value of mark. */ { diff --git a/unix/tclSelectNotfy.c b/unix/tclSelectNotfy.c index fc77e77..e41cefa 100644 --- a/unix/tclSelectNotfy.c +++ b/unix/tclSelectNotfy.c @@ -32,7 +32,7 @@ typedef struct FileHandler { * for this file. */ Tcl_FileProc *proc; /* Function to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -214,7 +214,7 @@ static sigset_t allSigMask; */ #if TCL_THREADS -static TCL_NORETURN void NotifierThreadProc(ClientData clientData); +static TCL_NORETURN void NotifierThreadProc(void *clientData); #if defined(HAVE_PTHREAD_ATFORK) static int atForkInit = 0; static void AtForkChild(void); @@ -480,7 +480,7 @@ TclpCreateFileHandler( * called. */ Tcl_FileProc *proc, /* Function to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); FileHandler *filePtr = LookUpFileHandler(tsdPtr, fd, NULL); @@ -1115,12 +1115,12 @@ NotifierThreadProc( tspecPtr->tv_nsec = timePtr->tv_usec * 1000; } ret = pselect(numFdBits, &readableMask, &writableMask, - &exceptionMask, tspecPtr, ¬ifierSigMask); + &exceptionMask, tspecPtr, ¬ifierSigMask); } #else pthread_sigmask(SIG_SETMASK, ¬ifierSigMask, NULL); ret = select(numFdBits, &readableMask, &writableMask, &exceptionMask, - timePtr); + timePtr); pthread_sigmask(SIG_BLOCK, &allSigMask, NULL); #endif diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index fc2280a..d0e47a8 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -775,7 +775,7 @@ FileGetOptionProc( * general probe. */ - dictContents = Tcl_GetStringFromObj(dictObj, &dictLength); + dictContents = TclGetStringFromObj(dictObj, &dictLength); Tcl_DStringAppend(dsPtr, dictContents, dictLength); Tcl_DecrRefCount(dictObj); return TCL_OK; diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 3a7778e..2a92031 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -118,10 +118,10 @@ static int CopyString(const char *src, char *buf, int buflen); #endif #ifdef NEED_PW_CLEANER -static void FreePwBuf(ClientData dummy); +static void FreePwBuf(void *dummy); #endif #ifdef NEED_GR_CLEANER -static void FreeGrBuf(ClientData dummy); +static void FreeGrBuf(void *dummy); #endif #endif /* TCL_THREADS */ @@ -336,7 +336,7 @@ TclpGetPwUid( #ifdef NEED_PW_CLEANER static void FreePwBuf( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -519,7 +519,7 @@ TclpGetGrGid( #ifdef NEED_GR_CLEANER static void FreeGrBuf( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index b009d97..cc8af05 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -484,8 +484,7 @@ DoCopyFile( char linkBuf[MAXPATHLEN+1]; int length; - length = readlink(src, linkBuf, MAXPATHLEN); - /* INTL: Native. */ + length = readlink(src, linkBuf, MAXPATHLEN); /* INTL: Native. */ if (length == -1) { return TCL_ERROR; } @@ -1515,7 +1514,7 @@ SetGroupAttribute( " group \"%s\" does not exist", TclGetString(fileName), string)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETGRP", - "NO_GROUP", (void *)NULL); + "NO_GROUP", (char *)NULL); } return TCL_ERROR; } @@ -1581,7 +1580,7 @@ SetOwnerAttribute( " user \"%s\" does not exist", TclGetString(fileName), string)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETOWN", - "NO_USER", (void *)NULL); + "NO_USER", (char *)NULL); } return TCL_ERROR; } @@ -1676,7 +1675,7 @@ SetPermissionsAttribute( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown permission string format \"%s\"", modeStringPtr)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PERMISSION", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "PERMISSION", (char *)NULL); } return TCL_ERROR; } @@ -1763,7 +1762,7 @@ GetModeFromPermString( newMode = 0; for (i = 0; i < 9; i++) { - switch (*(modeStringPtr+i)) { + switch (modeStringPtr[i]) { case 'r': if ((i%3) != 0) { goto chmodStyleCheck; @@ -1825,13 +1824,13 @@ GetModeFromPermString( * We now check for an "ugoa+-=rwxst" style permissions string */ - for (n = 0 ; *(modeStringPtr+n) != '\0' ; n = n + i) { + for (n = 0 ; modeStringPtr[n] != '\0' ; n += i) { oldMode = *modePtr; who = op = what = op_found = who_found = 0; - for (i = 0 ; *(modeStringPtr+n+i) != '\0' ; i++ ) { + for (i = 0 ; modeStringPtr[n + i] != '\0' ; i++ ) { if (!who_found) { /* who */ - switch (*(modeStringPtr+n+i)) { + switch (modeStringPtr[n + i]) { case 'u': who |= 0x9C0; continue; @@ -1852,7 +1851,7 @@ GetModeFromPermString( } if (!op_found) { /* op */ - switch (*(modeStringPtr+n+i)) { + switch (modeStringPtr[n + i]) { case '+': op = 1; op_found = 1; @@ -1870,7 +1869,7 @@ GetModeFromPermString( } } /* what */ - switch (*(modeStringPtr+n+i)) { + switch (modeStringPtr[n + i]) { case 'r': what |= 0x124; continue; @@ -1891,7 +1890,7 @@ GetModeFromPermString( default: return TCL_ERROR; } - if (*(modeStringPtr+n+i) == ',') { + if (modeStringPtr[n + i] == ',') { i++; break; } diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index fc3adab..80ef634 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -131,9 +131,9 @@ TclpFindExecutable( && S_ISREG(statBuf.st_mode)) { goto gotName; } - if (*p == '\0') { + if (p[0] == '\0') { break; - } else if (*(p+1) == 0) { + } else if (p[1] == 0) { p = "./"; } else { p++; @@ -712,9 +712,9 @@ TclpObjLstat( *---------------------------------------------------------------------- */ -ClientData +void * TclpGetNativeCwd( - ClientData clientData) + void *clientData) { char buffer[MAXPATHLEN+1]; @@ -1058,7 +1058,7 @@ TclpFilesystemPathType( Tcl_Obj * TclpNativeToNormalized( - ClientData clientData) + void *clientData) { Tcl_DString ds; @@ -1082,7 +1082,7 @@ TclpNativeToNormalized( *--------------------------------------------------------------------------- */ -ClientData +void * TclNativeCreateNativeRep( Tcl_Obj *pathPtr) { @@ -1149,9 +1149,9 @@ TclNativeCreateNativeRep( *--------------------------------------------------------------------------- */ -ClientData +void * TclNativeDupInternalRep( - ClientData clientData) + void *clientData) { char *copy; size_t len; diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 8e2dd1e..b15f80a 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -53,31 +53,31 @@ static const char *const processors[NUMPROCESSORS] = { }; typedef struct { - union { - unsigned int dwOemId; - struct { - int wProcessorArchitecture; - int wReserved; + union { + unsigned int dwOemId; + struct { + int wProcessorArchitecture; + int wReserved; + }; }; - }; - unsigned int dwPageSize; - void *lpMinimumApplicationAddress; - void *lpMaximumApplicationAddress; - void *dwActiveProcessorMask; - unsigned int dwNumberOfProcessors; - unsigned int dwProcessorType; - unsigned int dwAllocationGranularity; - int wProcessorLevel; - int wProcessorRevision; + unsigned int dwPageSize; + void *lpMinimumApplicationAddress; + void *lpMaximumApplicationAddress; + void *dwActiveProcessorMask; + unsigned int dwNumberOfProcessors; + unsigned int dwProcessorType; + unsigned int dwAllocationGranularity; + int wProcessorLevel; + int wProcessorRevision; } SYSTEM_INFO; typedef struct { - unsigned int dwOSVersionInfoSize; - unsigned int dwMajorVersion; - unsigned int dwMinorVersion; - unsigned int dwBuildNumber; - unsigned int dwPlatformId; - wchar_t szCSDVersion[128]; + unsigned int dwOSVersionInfoSize; + unsigned int dwMajorVersion; + unsigned int dwMinorVersion; + unsigned int dwBuildNumber; + unsigned int dwPlatformId; + wchar_t szCSDVersion[128]; } OSVERSIONINFOW; #endif diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index 0a2b695..1023db4 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -27,7 +27,7 @@ static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); # define NOTIFIER_SELECT #elif !defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE) # define NOTIFIER_SELECT -static TCL_NORETURN void NotifierThreadProc(ClientData clientData); +static TCL_NORETURN void NotifierThreadProc(void *clientData); # if defined(HAVE_PTHREAD_ATFORK) static void AtForkChild(void); # endif /* HAVE_PTHREAD_ATFORK */ @@ -484,7 +484,7 @@ AtForkChild(void) * * TclpNotifierData -- * - * This function returns a ClientData pointer to be associated + * This function returns a void pointer to be associated * with a Tcl_AsyncHandler. * * Results: @@ -497,13 +497,13 @@ AtForkChild(void) *---------------------------------------------------------------------- */ -ClientData +void * TclpNotifierData(void) { #if defined(NOTIFIER_EPOLL) || defined(NOTIFIER_KQUEUE) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - return (ClientData) tsdPtr; + return tsdPtr; #else return NULL; #endif diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 63e576b..70a5d5d 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -507,12 +507,11 @@ TclpCreateProcess( sigdelset(&sigs, SIGKILL); sigdelset(&sigs, SIGSTOP); - posix_spawnattr_setflags(&attr, - POSIX_SPAWN_SETSIGDEF + posix_spawnattr_setflags(&attr, POSIX_SPAWN_SETSIGDEF #ifdef POSIX_SPAWN_USEVFORK - | POSIX_SPAWN_USEVFORK + | POSIX_SPAWN_USEVFORK #endif - ); + ); posix_spawnattr_setsigdefault(&attr, &sigs); posix_spawn_file_actions_adddup2(&actions, GetFd(inputFile), 0); @@ -520,7 +519,7 @@ TclpCreateProcess( posix_spawn_file_actions_adddup2(&actions, GetFd(errorFile), 2); status = posix_spawnp(&pid, newArgv[0], &actions, &attr, - newArgv, environ); + newArgv, environ); childErrno = errno; posix_spawn_file_actions_destroy(&actions); posix_spawnattr_destroy(&attr); @@ -1349,7 +1348,7 @@ Tcl_WaitPid( int Tcl_PidObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 008a2f0..515f234 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -129,7 +129,7 @@ TclplatformtestInit( static int TestfilehandlerCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -310,7 +310,7 @@ TestfilehandlerCmd( static void TestFileHandlerProc( - ClientData clientData, /* Points to a Pipe structure. */ + void *clientData, /* Points to a Pipe structure. */ int mask) /* Indicates which events happened: * TCL_READABLE or TCL_WRITABLE. */ { @@ -343,7 +343,7 @@ TestFileHandlerProc( static int TestfilewaitCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -351,7 +351,7 @@ TestfilewaitCmd( int mask, result, timeout; Tcl_Channel channel; int fd; - ClientData data; + void *data; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "file readable|writable|both timeout"); @@ -374,7 +374,7 @@ TestfilewaitCmd( } if (Tcl_GetChannelHandle(channel, (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE, - (ClientData*) &data) != TCL_OK) { + (void **) &data) != TCL_OK) { Tcl_AppendResult(interp, "couldn't get channel file", (void *)NULL); return TCL_ERROR; } @@ -411,7 +411,7 @@ TestfilewaitCmd( static int TestfindexecutableCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -453,7 +453,7 @@ TestfindexecutableCmd( static int TestforkCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -499,7 +499,7 @@ TestforkCmd( static int TestalarmCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ @@ -577,7 +577,7 @@ AlarmHandler( static int TestgotsigCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ TCL_UNUSED(int) /*objc*/, TCL_UNUSED(Tcl_Obj *const *)) @@ -608,7 +608,7 @@ TestgotsigCmd( static int TestchmodCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Argument strings. */ diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c index c67495e..9587590 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -221,7 +221,7 @@ int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ - ClientData clientData, /* The one argument to Main() */ + void *clientData, /* The one argument to Main() */ TCL_HASH_TYPE stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index f242cf4..c4f6737 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -44,13 +44,13 @@ static char *lastTZ = NULL; /* Holds the last setting of the TZ */ static void SetTZIfNecessary(void); -static void CleanupMemory(ClientData clientData); +static void CleanupMemory(void *clientData); #endif /* TCL_NO_DEPRECATED */ static void NativeScaleTime(Tcl_Time *timebuf, - ClientData clientData); + void *clientData); static void NativeGetTime(Tcl_Time *timebuf, - ClientData clientData); + void *clientData); /* * TIP #233 (Virtualized Time): Data for the time hooks, if any. @@ -466,7 +466,7 @@ void Tcl_SetTimeProc( Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - ClientData clientData) + void *clientData) { tclGetTimeProcPtr = getProc; tclScaleTimeProcPtr = scaleProc; @@ -493,7 +493,7 @@ void Tcl_QueryTimeProc( Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - ClientData *clientData) + void **clientData) { if (getProc) { *getProc = tclGetTimeProcPtr; @@ -526,7 +526,7 @@ Tcl_QueryTimeProc( static void NativeScaleTime( TCL_UNUSED(Tcl_Time *), - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { /* Native scale is 1:1. Nothing is done */ } @@ -551,7 +551,7 @@ NativeScaleTime( static void NativeGetTime( Tcl_Time *timePtr, - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { struct timeval tv; @@ -620,7 +620,7 @@ SetTZIfNecessary(void) static void CleanupMemory( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ckfree(lastTZ); } diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c index 5f99239..87f7e86 100644 --- a/unix/tclXtNotify.c +++ b/unix/tclXtNotify.c @@ -33,7 +33,7 @@ typedef struct FileHandler { XtInputId except; /* Xt exception callback handle. */ Tcl_FileProc *proc; /* Procedure to call, in the style of * Tcl_CreateFileHandler. */ - ClientData clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ struct FileHandler *nextPtr;/* Next in list of all files we care about. */ } FileHandler; @@ -79,10 +79,10 @@ static int initialized = 0; static int FileHandlerEventProc(Tcl_Event *evPtr, int flags); static void FileProc(XtPointer clientData, int *source, XtInputId *id); -static void NotifierExitHandler(ClientData clientData); +static void NotifierExitHandler(void *clientData); static void TimerProc(XtPointer clientData, XtIntervalId *id); static void CreateFileHandler(int fd, int mask, - Tcl_FileProc *proc, ClientData clientData); + Tcl_FileProc *proc, void *clientData); static void DeleteFileHandler(int fd); static void SetTimer(const Tcl_Time * timePtr); static int WaitForEvent(const Tcl_Time * timePtr); @@ -229,7 +229,7 @@ InitNotifier(void) static void NotifierExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { if (notifier.currentTimeout != 0) { XtRemoveTimeOut(notifier.currentTimeout); @@ -339,7 +339,7 @@ CreateFileHandler( * called. */ Tcl_FileProc *proc, /* Procedure to call for each selected * event. */ - ClientData clientData) /* Arbitrary data to pass to proc. */ + void *clientData) /* Arbitrary data to pass to proc. */ { FileHandler *filePtr; diff --git a/unix/tclXtTest.c b/unix/tclXtTest.c index d4b4251..c6bcc18 100644 --- a/unix/tclXtTest.c +++ b/unix/tclXtTest.c @@ -77,7 +77,7 @@ Tclxttest_Init( static int TesteventloopCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ diff --git a/win/tclWinChan.c b/win/tclWinChan.c index a69ca5d..9b018e4 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -72,33 +72,33 @@ typedef struct { * Static routines for this file: */ -static int FileBlockProc(ClientData instanceData, int mode); -static void FileChannelExitHandler(ClientData clientData); -static void FileCheckProc(ClientData clientData, int flags); -static int FileCloseProc(ClientData instanceData, +static int FileBlockProc(void *instanceData, int mode); +static void FileChannelExitHandler(void *clientData); +static void FileCheckProc(void *clientData, int flags); +static int FileCloseProc(void *instanceData, Tcl_Interp *interp, int flags); static int FileEventProc(Tcl_Event *evPtr, int flags); -static int FileGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); -static int FileGetOptionProc(ClientData instanceData, +static int FileGetHandleProc(void *instanceData, + int direction, void **handlePtr); +static int FileGetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static ThreadSpecificData *FileInit(void); -static int FileInputProc(ClientData instanceData, char *buf, +static int FileInputProc(void *instanceData, char *buf, int toRead, int *errorCode); -static int FileOutputProc(ClientData instanceData, +static int FileOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); #ifndef TCL_NO_DEPRECATED -static int FileSeekProc(ClientData instanceData, long offset, +static int FileSeekProc(void *instanceData, long offset, int mode, int *errorCode); #endif -static long long FileWideSeekProc(ClientData instanceData, +static long long FileWideSeekProc(void *instanceData, long long offset, int mode, int *errorCode); -static void FileSetupProc(ClientData clientData, int flags); -static void FileWatchProc(ClientData instanceData, int mask); -static void FileThreadActionProc(ClientData instanceData, +static void FileSetupProc(void *clientData, int flags); +static void FileWatchProc(void *instanceData, int mask); +static void FileThreadActionProc(void *instanceData, int action); -static int FileTruncateProc(ClientData instanceData, +static int FileTruncateProc(void *instanceData, long long length); static DWORD FileGetType(HANDLE handle); static int NativeIsComPort(const WCHAR *nativeName); @@ -227,7 +227,7 @@ FileInit(void) static void FileChannelExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL); } @@ -251,7 +251,7 @@ FileChannelExitHandler( void FileSetupProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { FileInfo *infoPtr; @@ -294,7 +294,7 @@ FileSetupProc( static void FileCheckProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { FileEvent *evPtr; @@ -393,7 +393,7 @@ FileEventProc( static int FileBlockProc( - ClientData instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -432,7 +432,7 @@ FileBlockProc( static int FileCloseProc( - ClientData instanceData, /* Pointer to FileInfo structure. */ + void *instanceData, /* Pointer to FileInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { @@ -510,7 +510,7 @@ FileCloseProc( #ifndef TCL_NO_DEPRECATED static int FileSeekProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ @@ -589,7 +589,7 @@ FileSeekProc( static long long FileWideSeekProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ long long offset, /* Offset to seek to. */ int mode, /* Relative to where should we seek? */ int *errorCodePtr) /* To store error code. */ @@ -641,7 +641,7 @@ FileWideSeekProc( static int FileTruncateProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ long long length) /* Length to truncate at. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -717,7 +717,7 @@ FileTruncateProc( static int FileInputProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ char *buf, /* Where to store data read. */ int bufSize, /* Num bytes available in buffer. */ int *errorCode) /* Where to store error code. */ @@ -772,7 +772,7 @@ FileInputProc( static int FileOutputProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -819,7 +819,7 @@ FileOutputProc( static void FileWatchProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ int mask) /* What events to watch for; OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -858,9 +858,9 @@ FileWatchProc( static int FileGetHandleProc( - ClientData instanceData, /* The file state. */ + void *instanceData, /* The file state. */ int direction, /* TCL_READABLE or TCL_WRITABLE */ - ClientData *handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { FileInfo *infoPtr = (FileInfo *)instanceData; @@ -868,7 +868,7 @@ FileGetHandleProc( return TCL_ERROR; } - *handlePtr = (ClientData) infoPtr->handle; + *handlePtr = (void *)infoPtr->handle; return TCL_OK; } @@ -913,7 +913,7 @@ StoreElementInDict( * duplicate keys. */ - Tcl_Obj *nameObj = Tcl_NewStringObj(name, -1); + Tcl_Obj *nameObj = Tcl_NewStringObj(name, TCL_INDEX_NONE); Tcl_DictObjPut(NULL, dictObj, nameObj, valueObj); } @@ -997,9 +997,9 @@ StatOpenFile( * Anything else and we definitely couldn't have got here anyway. */ if (attr & FILE_ATTRIBUTE_DIRECTORY) { - STORE_ELEM("type", Tcl_NewStringObj("directory", -1)); + STORE_ELEM("type", Tcl_NewStringObj("directory", TCL_INDEX_NONE)); } else { - STORE_ELEM("type", Tcl_NewStringObj("file", -1)); + STORE_ELEM("type", Tcl_NewStringObj("file", TCL_INDEX_NONE)); } #undef STORE_ELEM @@ -1008,7 +1008,7 @@ StatOpenFile( static int FileGetOptionProc( - ClientData instanceData, /* The file state. */ + void *instanceData, /* The file state. */ Tcl_Interp *interp, /* For error reporting. */ const char *optionName, /* What option to read, or NULL for all. */ Tcl_DString *dsPtr) /* Where to write the value read. */ @@ -1306,7 +1306,7 @@ TclpOpenFileChannel( Tcl_Channel Tcl_MakeFileChannel( - ClientData rawHandle, /* OS level handle */ + void *rawHandle, /* OS level handle */ int mode) /* OR'ed combination of TCL_READABLE and * TCL_WRITABLE to indicate file mode. */ { @@ -1694,7 +1694,7 @@ TclWinFlushDirtyChannels(void) static void FileThreadActionProc( - ClientData instanceData, + void *instanceData, int action) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 62cc94e..b27487f 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -2769,27 +2769,25 @@ TclpObjNormalizePath( * Convert the entire known path to long form. */ - if (1) { - WCHAR wpath[MAX_PATH]; - const WCHAR *nativePath; - DWORD wpathlen; + WCHAR wpath[MAX_PATH]; + const WCHAR *nativePath; + DWORD wpathlen; - Tcl_DStringInit(&ds); - nativePath = - Tcl_UtfToWCharDString(path, lastValidPathEnd - path, &ds); - wpathlen = GetLongPathNameProc(nativePath, - (WCHAR *) wpath, MAX_PATH); - /* - * We have to make the drive letter uppercase. - */ + Tcl_DStringInit(&ds); + nativePath = + Tcl_UtfToWCharDString(path, lastValidPathEnd - path, &ds); + wpathlen = GetLongPathNameProc(nativePath, + (WCHAR *) wpath, MAX_PATH); + /* + * We have to make the drive letter uppercase. + */ - if (wpath[0] >= 'a') { - wpath[0] -= ('a' - 'A'); - } - Tcl_DStringAppend(&dsNorm, (const char *) wpath, - wpathlen * sizeof(WCHAR)); - Tcl_DStringFree(&ds); + if (wpath[0] >= 'a') { + wpath[0] -= ('a' - 'A'); } + Tcl_DStringAppend(&dsNorm, (const char *) wpath, + wpathlen * sizeof(WCHAR)); + Tcl_DStringFree(&ds); #endif /* TclNORM_LONG_PATH */ } @@ -3111,7 +3109,7 @@ TclNativeCreateNativeRep( wp = nativePathPtr = (WCHAR *)ckalloc((len + 6) * sizeof(WCHAR)); if (nativePathPtr==0) { - goto done; + goto done; } MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, len + 2); diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 59404d6..3764a79 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -588,7 +588,7 @@ TclpFindVariable( * entries in environ (for unsuccessful * searches). */ { - Tcl_Size i, length, result = -1; + Tcl_Size i, length, result = TCL_INDEX_NONE; const WCHAR *env; const char *p1, *p2; char *envUpper, *nameUpper; @@ -612,7 +612,7 @@ TclpFindVariable( */ Tcl_DStringInit(&envString); - envUpper = Tcl_WCharToUtfDString(env, -1, &envString); + envUpper = Tcl_WCharToUtfDString(env, TCL_INDEX_NONE, &envString); p1 = strchr(envUpper, '='); if (p1 == NULL) { continue; diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index 4d9b578..a03132f 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -175,7 +175,7 @@ TclpDlopen( */ handlePtr = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_)); - handlePtr->clientData = (ClientData) hInstance; + handlePtr->clientData = (void *) hInstance; handlePtr->findSymbolProcPtr = &FindSymbol; handlePtr->unloadFileProcPtr = &UnloadFile; *loadHandle = handlePtr; diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c index 64d739a..795db74 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -76,7 +76,7 @@ static LRESULT CALLBACK NotifierProc(HWND hwnd, UINT message, *---------------------------------------------------------------------- */ -ClientData +void * TclpInitNotifier(void) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -148,7 +148,7 @@ TclpInitNotifier(void) void TclpFinalizeNotifier( - ClientData clientData) /* Pointer to notifier data. */ + void *clientData) /* Pointer to notifier data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; @@ -218,7 +218,7 @@ TclpFinalizeNotifier( void TclpAlertNotifier( - ClientData clientData) /* Pointer to thread data. */ + void *clientData) /* Pointer to thread data. */ { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData; @@ -424,7 +424,7 @@ NotifierProc( * * TclpNotifierData -- * - * This function returns a ClientData pointer to be associated + * This function returns a void pointer to be associated * with a Tcl_AsyncHandler. * * Results: @@ -436,7 +436,7 @@ NotifierProc( *---------------------------------------------------------------------- */ -ClientData +void * TclpNotifierData(void) { return NULL; diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 7e6b76a..d343d87 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -165,30 +165,30 @@ static COMMTIMEOUTS no_timeout = { * Declarations for functions used only in this file. */ -static int SerialBlockProc(ClientData instanceData, int mode); -static void SerialCheckProc(ClientData clientData, int flags); -static int SerialCloseProc(ClientData instanceData, +static int SerialBlockProc(void *instanceData, int mode); +static void SerialCheckProc(void *clientData, int flags); +static int SerialCloseProc(void *instanceData, Tcl_Interp *interp, int flags); static int SerialEventProc(Tcl_Event *evPtr, int flags); -static void SerialExitHandler(ClientData clientData); -static int SerialGetHandleProc(ClientData instanceData, - int direction, ClientData *handlePtr); +static void SerialExitHandler(void *clientData); +static int SerialGetHandleProc(void *instanceData, + int direction, void **handlePtr); static ThreadSpecificData *SerialInit(void); -static int SerialInputProc(ClientData instanceData, char *buf, +static int SerialInputProc(void *instanceData, char *buf, int toRead, int *errorCode); -static int SerialOutputProc(ClientData instanceData, +static int SerialOutputProc(void *instanceData, const char *buf, int toWrite, int *errorCode); -static void SerialSetupProc(ClientData clientData, int flags); -static void SerialWatchProc(ClientData instanceData, int mask); -static void ProcExitHandler(ClientData clientData); -static int SerialGetOptionProc(ClientData instanceData, +static void SerialSetupProc(void *clientData, int flags); +static void SerialWatchProc(void *instanceData, int mask); +static void ProcExitHandler(void *clientData); +static int SerialGetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); -static int SerialSetOptionProc(ClientData instanceData, +static int SerialSetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, const char *value); static DWORD WINAPI SerialWriterThread(LPVOID arg); -static void SerialThreadActionProc(ClientData instanceData, +static void SerialThreadActionProc(void *instanceData, int action); static int SerialBlockingRead(SerialInfo *infoPtr, LPVOID buf, DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr); @@ -285,7 +285,7 @@ SerialInit(void) static void SerialExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); SerialInfo *infoPtr; @@ -323,7 +323,7 @@ SerialExitHandler( static void ProcExitHandler( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { Tcl_MutexLock(&serialMutex); initialized = 0; @@ -406,7 +406,7 @@ SerialGetMilliseconds(void) void SerialSetupProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; @@ -461,7 +461,7 @@ SerialSetupProc( static void SerialCheckProc( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), int flags) /* Event flags as passed to Tcl_DoOneEvent. */ { SerialInfo *infoPtr; @@ -561,7 +561,7 @@ SerialCheckProc( static int SerialBlockProc( - ClientData instanceData, /* Instance data for channel. */ + void *instanceData, /* Instance data for channel. */ int mode) /* TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ { @@ -600,7 +600,7 @@ SerialBlockProc( static int SerialCloseProc( - ClientData instanceData, /* Pointer to SerialInfo structure. */ + void *instanceData, /* Pointer to SerialInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { @@ -855,7 +855,7 @@ SerialBlockingWrite( static int SerialInputProc( - ClientData instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -962,7 +962,7 @@ SerialInputProc( static int SerialOutputProc( - ClientData instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCode) /* Where to store error code. */ @@ -1192,7 +1192,7 @@ SerialEventProc( static void SerialWatchProc( - ClientData instanceData, /* Serial state. */ + void *instanceData, /* Serial state. */ int mask) /* What events to watch for, OR-ed combination * of TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -1249,13 +1249,13 @@ SerialWatchProc( static int SerialGetHandleProc( - ClientData instanceData, /* The serial state. */ + void *instanceData, /* The serial state. */ TCL_UNUSED(int) /*direction*/, - ClientData *handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { SerialInfo *infoPtr = (SerialInfo *) instanceData; - *handlePtr = (ClientData) infoPtr->handle; + *handlePtr = (void *)infoPtr->handle; return TCL_OK; } @@ -1618,7 +1618,7 @@ SerialModemStatusStr( static int SerialSetOptionProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Which option to set? */ const char *value) /* New value for option. */ @@ -2042,7 +2042,7 @@ SerialSetOptionProc( static int SerialGetOptionProc( - ClientData instanceData, /* File state. */ + void *instanceData, /* File state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Option to get. */ Tcl_DString *dsPtr) /* Where to store value(s). */ @@ -2279,7 +2279,7 @@ SerialGetOptionProc( static void SerialThreadActionProc( - ClientData instanceData, + void *instanceData, int action) { SerialInfo *infoPtr = (SerialInfo *) instanceData; diff --git a/win/tclWinSock.c b/win/tclWinSock.c index 4f1a9c2..0dd7871 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -2360,9 +2360,9 @@ TcpAccept( if (statePtr->acceptProc != NULL) { getnameinfo(&(addr.sa), len, host, sizeof(host), port, sizeof(port), - NI_NUMERICHOST|NI_NUMERICSERV); + NI_NUMERICHOST|NI_NUMERICSERV); statePtr->acceptProc(statePtr->acceptProcData, newInfoPtr->channel, - host, atoi(port)); + host, atoi(port)); } } diff --git a/win/tclWinTest.c b/win/tclWinTest.c index f2c9a86d..ec12f67 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -101,7 +101,7 @@ TclplatformtestInit( static int TesteventloopCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -152,7 +152,7 @@ TesteventloopCmd( framePtr = oldFramePtr; } else { Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), - "\": must be done or wait", (void *)NULL); + "\": must be done or wait", (char *)NULL); return TCL_ERROR; } return TCL_OK; @@ -177,7 +177,7 @@ TesteventloopCmd( static int TestvolumetypeCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ @@ -206,11 +206,11 @@ TestvolumetypeCmd( if (found == 0) { Tcl_AppendResult(interp, "could not get volume type for \"", - (path?path:""), "\"", (void *)NULL); + (path?path:""), "\"", (char *)NULL); Tcl_WinConvertError(GetLastError()); return TCL_ERROR; } - Tcl_AppendResult(interp, volType, (void *)NULL); + Tcl_AppendResult(interp, volType, (char *)NULL); return TCL_OK; #undef VOL_BUF_SIZE } @@ -243,7 +243,7 @@ TestvolumetypeCmd( static int TestwinclockCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ @@ -292,7 +292,7 @@ TestwinclockCmd( static int TestwinsleepCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ @@ -312,7 +312,7 @@ TestwinsleepCmd( static int TestSizeCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ @@ -357,7 +357,7 @@ syntax: static int TestExceptionCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp* interp, /* Tcl interpreter */ int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ @@ -604,14 +604,9 @@ TestplatformChmod( * to remove inherited ACL (we need to overwrite the default ACL's in this case) */ - if (SetNamedSecurityInfoA((LPSTR)nativePath, - SE_FILE_OBJECT, - DACL_SECURITY_INFORMATION | - PROTECTED_DACL_SECURITY_INFORMATION, - NULL, - NULL, - newAcl, - NULL) == ERROR_SUCCESS) { + if (SetNamedSecurityInfoA((LPSTR)nativePath, SE_FILE_OBJECT, + DACL_SECURITY_INFORMATION | PROTECTED_DACL_SECURITY_INFORMATION, + NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) { res = 0; } @@ -635,7 +630,6 @@ TestplatformChmod( /* Run normal chmod command */ return chmod(nativePath, pmode); - } /* @@ -659,7 +653,7 @@ TestplatformChmod( static int TestchmodCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Parameter count */ Tcl_Obj *const * objv) /* Parameter vector */ @@ -685,7 +679,7 @@ TestchmodCmd( } if (TestplatformChmod(translated, mode) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), - (void *)NULL); + (char *)NULL); return TCL_ERROR; } Tcl_DStringFree(&buffer); diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index e468d7a..e8d4d4d 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -203,12 +203,12 @@ int TclpThreadCreate( Tcl_ThreadId *idPtr, /* Return, the ID of the thread. */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread. */ - ClientData clientData, /* The one argument to Main(). */ + void *clientData, /* The one argument to Main(). */ TCL_HASH_TYPE stackSize, /* Size of stack for the new thread. */ int flags) /* Flags controlling behaviour of the new * thread. */ { - WinThread *winThreadPtr; /* Per-thread startup info */ + WinThread *winThreadPtr; /* Per-thread startup info */ HANDLE tHandle; winThreadPtr = (WinThread *)ckalloc(sizeof(WinThread)); @@ -219,8 +219,7 @@ TclpThreadCreate( EnterCriticalSection(&joinLock); *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and - * on WIN64 sizeof void* != sizeof unsigned - */ + * on WIN64 sizeof void* != sizeof unsigned */ #if defined(_MSC_VER) || defined(__MSVCRT__) tHandle = (HANDLE) _beginthreadex(NULL, (unsigned)stackSize, @@ -535,7 +534,7 @@ TclFinalizeLock(void) #if TCL_THREADS /* locally used prototype */ -static void FinalizeConditionEvent(ClientData data); +static void FinalizeConditionEvent(void *data); /* *---------------------------------------------------------------------- @@ -880,7 +879,7 @@ Tcl_ConditionNotify( static void FinalizeConditionEvent( - ClientData data) + void *data) { ThreadSpecificData *tsdPtr = (ThreadSpecificData *) data; diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 6fecbd2..438a8ec 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -136,7 +136,7 @@ static struct { #ifndef TCL_NO_DEPRECATED static struct tm * ComputeGMT(const time_t *tp); #endif /* TCL_NO_DEPRECATED */ -static void StopCalibration(ClientData clientData); +static void StopCalibration(void *clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); static void ResetCounterSamples(unsigned long long fileTime, @@ -144,10 +144,10 @@ static void ResetCounterSamples(unsigned long long fileTime, static long long AccumulateSample(long long perfCounter, unsigned long long fileTime); static void NativeScaleTime(Tcl_Time* timebuf, - ClientData clientData); + void *clientData); static long long NativeGetMicroseconds(void); static void NativeGetTime(Tcl_Time* timebuf, - ClientData clientData); + void *clientData); /* * TIP #233 (Virtualized Time): Data for the time hooks, if any. @@ -155,7 +155,7 @@ static void NativeGetTime(Tcl_Time* timebuf, Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime; Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime; -ClientData tclTimeClientData = NULL; +void *tclTimeClientData = NULL; /* * Inlined version of Tcl_GetTime. @@ -438,7 +438,7 @@ Tcl_GetTime( static void NativeScaleTime( TCL_UNUSED(Tcl_Time *), - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { /* * Native scale is 1:1. Nothing is done. @@ -704,7 +704,7 @@ NativeGetMicroseconds(void) static void NativeGetTime( Tcl_Time *timePtr, - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { long long usecSincePosixEpoch; @@ -751,7 +751,7 @@ void TclWinResetTimerResolution(void); static void StopCalibration( - TCL_UNUSED(ClientData)) + TCL_UNUSED(void *)) { SetEvent(timeInfo.exitEvent); @@ -1515,7 +1515,7 @@ void Tcl_SetTimeProc( Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, - ClientData clientData) + void *clientData) { tclGetTimeProcPtr = getProc; tclScaleTimeProcPtr = scaleProc; @@ -1542,7 +1542,7 @@ void Tcl_QueryTimeProc( Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, - ClientData *clientData) + void **clientData) { if (getProc) { *getProc = tclGetTimeProcPtr; -- cgit v0.12 From 52c8d4007d2a4480394e37792b4be00adeab7848 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 20 Mar 2024 14:42:16 +0000 Subject: dup test name --- tests/zipfs.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/zipfs.test b/tests/zipfs.test index 69c682e..b696308 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -1450,7 +1450,7 @@ namespace eval test_ns_zipfs { testzipfsglob basic-type-d-f $basicMounts [list -type {d f} $defMountPt/*] [zipfspathsmt $defMountPt test testdir] testzipfsglob basic-type-l $basicMounts [list -type l $defMountPt/*] "no files matched glob pattern \"$defMountPt/*\"" -returnCodes error foreach type {b c l p s} { - testzipfsglob basic-type-$type $basicMounts [list -type $type $defMountPt/*] "no files matched glob pattern \"$defMountPt/*\"" -returnCodes error + testzipfsglob basic-type-1-$type $basicMounts [list -type $type $defMountPt/*] "no files matched glob pattern \"$defMountPt/*\"" -returnCodes error testzipfsglob basic-type-f-$type $basicMounts [list -type [list f $type] $defMountPt/*] [zipfspathsmt $defMountPt test] testzipfsglob basic-type-d-$type $basicMounts [list -type [list d $type] $defMountPt/*] [zipfspathsmt $defMountPt testdir] } -- cgit v0.12 From 5623a4788e197931cedc57d4fc2d5c7ca57358f2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 20 Mar 2024 15:01:42 +0000 Subject: Review: use Tcl_Size for "length" in tclStrIdxTree.h. Macro tweaks. --- generic/tclClock.c | 173 ++++++++++++++++++++++++------------------------ generic/tclClockFmt.c | 10 +-- generic/tclDate.h | 4 +- generic/tclStrIdxTree.c | 26 ++++---- generic/tclStrIdxTree.h | 44 +++++++----- 5 files changed, 133 insertions(+), 124 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 6c6ac94..2ce8445 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -203,7 +203,7 @@ TclClockInit( data->refCount = 0; data->literals = (Tcl_Obj **)Tcl_Alloc(LIT__END * sizeof(Tcl_Obj*)); for (i = 0; i < LIT__END; ++i) { - Tcl_InitObjRef(data->literals[i], Tcl_NewStringObj(Literals[i], -1)); + TclInitObjRef(data->literals[i], Tcl_NewStringObj(Literals[i], -1)); } data->mcLiterals = NULL; data->mcLitIdxs = NULL; @@ -295,38 +295,38 @@ ClockConfigureClear( ClockFrmScnClearCaches(); data->lastTZEpoch = 0; - Tcl_UnsetObjRef(data->systemTimeZone); - Tcl_UnsetObjRef(data->systemSetupTZData); - Tcl_UnsetObjRef(data->gmtSetupTimeZoneUnnorm); - Tcl_UnsetObjRef(data->gmtSetupTimeZone); - Tcl_UnsetObjRef(data->gmtSetupTZData); - Tcl_UnsetObjRef(data->gmtTZName); - Tcl_UnsetObjRef(data->lastSetupTimeZoneUnnorm); - Tcl_UnsetObjRef(data->lastSetupTimeZone); - Tcl_UnsetObjRef(data->lastSetupTZData); - Tcl_UnsetObjRef(data->prevSetupTimeZoneUnnorm); - Tcl_UnsetObjRef(data->prevSetupTimeZone); - Tcl_UnsetObjRef(data->prevSetupTZData); - - Tcl_UnsetObjRef(data->defaultLocale); + TclUnsetObjRef(data->systemTimeZone); + TclUnsetObjRef(data->systemSetupTZData); + TclUnsetObjRef(data->gmtSetupTimeZoneUnnorm); + TclUnsetObjRef(data->gmtSetupTimeZone); + TclUnsetObjRef(data->gmtSetupTZData); + TclUnsetObjRef(data->gmtTZName); + TclUnsetObjRef(data->lastSetupTimeZoneUnnorm); + TclUnsetObjRef(data->lastSetupTimeZone); + TclUnsetObjRef(data->lastSetupTZData); + TclUnsetObjRef(data->prevSetupTimeZoneUnnorm); + TclUnsetObjRef(data->prevSetupTimeZone); + TclUnsetObjRef(data->prevSetupTZData); + + TclUnsetObjRef(data->defaultLocale); data->defaultLocaleDict = NULL; - Tcl_UnsetObjRef(data->currentLocale); + TclUnsetObjRef(data->currentLocale); data->currentLocaleDict = NULL; - Tcl_UnsetObjRef(data->lastUsedLocaleUnnorm); - Tcl_UnsetObjRef(data->lastUsedLocale); + TclUnsetObjRef(data->lastUsedLocaleUnnorm); + TclUnsetObjRef(data->lastUsedLocale); data->lastUsedLocaleDict = NULL; - Tcl_UnsetObjRef(data->prevUsedLocaleUnnorm); - Tcl_UnsetObjRef(data->prevUsedLocale); + TclUnsetObjRef(data->prevUsedLocaleUnnorm); + TclUnsetObjRef(data->prevUsedLocale); data->prevUsedLocaleDict = NULL; - Tcl_UnsetObjRef(data->lastBase.timezoneObj); + TclUnsetObjRef(data->lastBase.timezoneObj); - Tcl_UnsetObjRef(data->lastTZOffsCache[0].timezoneObj); - Tcl_UnsetObjRef(data->lastTZOffsCache[0].tzName); - Tcl_UnsetObjRef(data->lastTZOffsCache[1].timezoneObj); - Tcl_UnsetObjRef(data->lastTZOffsCache[1].tzName); + TclUnsetObjRef(data->lastTZOffsCache[0].timezoneObj); + TclUnsetObjRef(data->lastTZOffsCache[0].tzName); + TclUnsetObjRef(data->lastTZOffsCache[1].timezoneObj); + TclUnsetObjRef(data->lastTZOffsCache[1].tzName); - Tcl_UnsetObjRef(data->mcDicts); + TclUnsetObjRef(data->mcDicts); } /* @@ -394,9 +394,9 @@ SavePrevTimezoneObj( { Tcl_Obj *timezoneObj = dataPtr->lastSetupTimeZone; if (timezoneObj && timezoneObj != dataPtr->prevSetupTimeZone) { - Tcl_SetObjRef(dataPtr->prevSetupTimeZoneUnnorm, dataPtr->lastSetupTimeZoneUnnorm); - Tcl_SetObjRef(dataPtr->prevSetupTimeZone, timezoneObj); - Tcl_SetObjRef(dataPtr->prevSetupTZData, dataPtr->lastSetupTZData); + TclSetObjRef(dataPtr->prevSetupTimeZoneUnnorm, dataPtr->lastSetupTimeZoneUnnorm); + TclSetObjRef(dataPtr->prevSetupTimeZone, timezoneObj); + TclSetObjRef(dataPtr->prevSetupTZData, dataPtr->lastSetupTZData); } } @@ -452,13 +452,13 @@ NormTimezoneObj( if (dataPtr->lastSetupTimeZone != NULL && strcmp(tz, TclGetString(dataPtr->lastSetupTimeZone)) == 0 ) { - Tcl_SetObjRef(dataPtr->lastSetupTimeZoneUnnorm, timezoneObj); + TclSetObjRef(dataPtr->lastSetupTimeZoneUnnorm, timezoneObj); return dataPtr->lastSetupTimeZone; } if (dataPtr->prevSetupTimeZone != NULL && strcmp(tz, TclGetString(dataPtr->prevSetupTimeZone)) == 0 ) { - Tcl_SetObjRef(dataPtr->prevSetupTimeZoneUnnorm, timezoneObj); + TclSetObjRef(dataPtr->prevSetupTimeZoneUnnorm, timezoneObj); return dataPtr->prevSetupTimeZone; } if (dataPtr->systemTimeZone != NULL && @@ -467,7 +467,7 @@ NormTimezoneObj( return dataPtr->systemTimeZone; } if (strcmp(tz, Literals[LIT_GMT]) == 0) { - Tcl_SetObjRef(dataPtr->gmtSetupTimeZoneUnnorm, timezoneObj); + TclSetObjRef(dataPtr->gmtSetupTimeZoneUnnorm, timezoneObj); if (dataPtr->gmtSetupTimeZone == NULL) { *loaded = 0; } @@ -528,7 +528,7 @@ ClockGetCurrentLocale( return NULL; } - Tcl_SetObjRef(dataPtr->currentLocale, Tcl_GetObjResult(interp)); + TclSetObjRef(dataPtr->currentLocale, Tcl_GetObjResult(interp)); dataPtr->currentLocaleDict = NULL; Tcl_ResetResult(interp); @@ -556,8 +556,8 @@ SavePrevLocaleObj( { Tcl_Obj *localeObj = dataPtr->lastUsedLocale; if (localeObj && localeObj != dataPtr->prevUsedLocale) { - Tcl_SetObjRef(dataPtr->prevUsedLocaleUnnorm, dataPtr->lastUsedLocaleUnnorm); - Tcl_SetObjRef(dataPtr->prevUsedLocale, localeObj); + TclSetObjRef(dataPtr->prevUsedLocaleUnnorm, dataPtr->lastUsedLocaleUnnorm); + TclSetObjRef(dataPtr->prevUsedLocale, localeObj); /* mcDicts owns reference to dict */ dataPtr->prevUsedLocaleDict = dataPtr->lastUsedLocaleDict; } @@ -636,7 +636,7 @@ NormLocaleObj( ) ) { *mcDictObj = dataPtr->lastUsedLocaleDict; - Tcl_SetObjRef(dataPtr->lastUsedLocaleUnnorm, localeObj); + TclSetObjRef(dataPtr->lastUsedLocaleUnnorm, localeObj); return dataPtr->lastUsedLocale; } if ( dataPtr->prevUsedLocale != NULL @@ -647,7 +647,7 @@ NormLocaleObj( ) ) { *mcDictObj = dataPtr->prevUsedLocaleDict; - Tcl_SetObjRef(dataPtr->prevUsedLocaleUnnorm, localeObj); + TclSetObjRef(dataPtr->prevUsedLocaleUnnorm, localeObj); return dataPtr->prevUsedLocale; } if ( @@ -675,9 +675,9 @@ NormLocaleObj( && strcasecmp(loc, Literals[LIT_SYSTEM]) == 0) ) { SavePrevLocaleObj(dataPtr); - Tcl_SetObjRef(dataPtr->lastUsedLocaleUnnorm, localeObj); + TclSetObjRef(dataPtr->lastUsedLocaleUnnorm, localeObj); localeObj = ClockGetSystemLocale(dataPtr, interp); - Tcl_SetObjRef(dataPtr->lastUsedLocale, localeObj); + TclSetObjRef(dataPtr->lastUsedLocale, localeObj); *mcDictObj = NULL; return localeObj; } @@ -729,7 +729,7 @@ ClockMCDict(ClockFmtScnCmdArgs *opts) int i; dataPtr->mcLiterals = (Tcl_Obj **)Tcl_Alloc(MCLIT__END * sizeof(Tcl_Obj*)); for (i = 0; i < MCLIT__END; ++i) { - Tcl_InitObjRef(dataPtr->mcLiterals[i], + TclInitObjRef(dataPtr->mcLiterals[i], Tcl_NewStringObj(MsgCtLiterals[i], -1)); } } @@ -741,7 +741,7 @@ ClockMCDict(ClockFmtScnCmdArgs *opts) /* first try to find locale catalog dict */ if (dataPtr->mcDicts == NULL) { - Tcl_SetObjRef(dataPtr->mcDicts, Tcl_NewDictObj()); + TclSetObjRef(dataPtr->mcDicts, Tcl_NewDictObj()); } Tcl_DictObjGet(NULL, dataPtr->mcDicts, opts->localeObj, &opts->mcDictObj); @@ -784,8 +784,8 @@ ClockMCDict(ClockFmtScnCmdArgs *opts) dataPtr->lastUsedLocaleDict = opts->mcDictObj; } else { SavePrevLocaleObj(dataPtr); - Tcl_SetObjRef(dataPtr->lastUsedLocale, opts->localeObj); - Tcl_UnsetObjRef(dataPtr->lastUsedLocaleUnnorm); + TclSetObjRef(dataPtr->lastUsedLocale, opts->localeObj); + TclUnsetObjRef(dataPtr->lastUsedLocaleUnnorm); dataPtr->lastUsedLocaleDict = opts->mcDictObj; } } @@ -907,7 +907,7 @@ ClockMCSetIdx( int i; dataPtr->mcLitIdxs = (Tcl_Obj **)Tcl_Alloc(MCLIT__END * sizeof(Tcl_Obj*)); for (i = 0; i < MCLIT__END; ++i) { - Tcl_InitObjRef(dataPtr->mcLitIdxs[i], + TclInitObjRef(dataPtr->mcLitIdxs[i], Tcl_NewStringObj(MsgCtLitIdxs[i], -1)); } } @@ -926,20 +926,20 @@ TimezoneLoaded( if (timezoneObj == dataPtr->literals[LIT_GMT]) { /* mark GMT zone loaded */ if (dataPtr->gmtSetupTimeZone == NULL) { - Tcl_SetObjRef(dataPtr->gmtSetupTimeZone, + TclSetObjRef(dataPtr->gmtSetupTimeZone, dataPtr->literals[LIT_GMT]); } - Tcl_SetObjRef(dataPtr->gmtSetupTimeZoneUnnorm, tzUnnormObj); + TclSetObjRef(dataPtr->gmtSetupTimeZoneUnnorm, tzUnnormObj); return; } /* last setup zone loaded */ if (dataPtr->lastSetupTimeZone != timezoneObj) { SavePrevTimezoneObj(dataPtr); - Tcl_SetObjRef(dataPtr->lastSetupTimeZone, timezoneObj); - Tcl_UnsetObjRef(dataPtr->lastSetupTZData); + TclSetObjRef(dataPtr->lastSetupTimeZone, timezoneObj); + TclUnsetObjRef(dataPtr->lastSetupTZData); } - Tcl_SetObjRef(dataPtr->lastSetupTimeZoneUnnorm, tzUnnormObj); + TclSetObjRef(dataPtr->lastSetupTimeZoneUnnorm, tzUnnormObj); } /* *---------------------------------------------------------------------- @@ -995,14 +995,13 @@ ClockConfigureObjCmd( return TCL_ERROR; } switch (optionIndex) { - case CLOCK_SYSTEM_TZ: - if (1) { + case CLOCK_SYSTEM_TZ: { /* validate current tz-epoch */ size_t lastTZEpoch = TzsetIfNecessary(); if (i < objc) { if (dataPtr->systemTimeZone != objv[i]) { - Tcl_SetObjRef(dataPtr->systemTimeZone, objv[i]); - Tcl_UnsetObjRef(dataPtr->systemSetupTZData); + TclSetObjRef(dataPtr->systemTimeZone, objv[i]); + TclUnsetObjRef(dataPtr->systemSetupTZData); } dataPtr->lastTZEpoch = lastTZEpoch; } @@ -1029,7 +1028,7 @@ ClockConfigureObjCmd( case CLOCK_DEFAULT_LOCALE: if (i < objc) { if (dataPtr->defaultLocale != objv[i]) { - Tcl_SetObjRef(dataPtr->defaultLocale, objv[i]); + TclSetObjRef(dataPtr->defaultLocale, objv[i]); dataPtr->defaultLocaleDict = NULL; } } @@ -1041,7 +1040,7 @@ ClockConfigureObjCmd( case CLOCK_CURRENT_LOCALE: if (i < objc) { if (dataPtr->currentLocale != objv[i]) { - Tcl_SetObjRef(dataPtr->currentLocale, objv[i]); + TclSetObjRef(dataPtr->currentLocale, objv[i]); dataPtr->currentLocaleDict = NULL; } } @@ -1240,14 +1239,14 @@ ClockGetTZData( /* cache using corresponding slot and as last used */ if (out != NULL) { - Tcl_SetObjRef(*out, ret); + TclSetObjRef(*out, ret); } else if (dataPtr->lastSetupTimeZone != timezoneObj) { SavePrevTimezoneObj(dataPtr); - Tcl_SetObjRef(dataPtr->lastSetupTimeZone, timezoneObj); - Tcl_UnsetObjRef(dataPtr->lastSetupTimeZoneUnnorm); - Tcl_SetObjRef(dataPtr->lastSetupTZData, ret); + TclSetObjRef(dataPtr->lastSetupTimeZone, timezoneObj); + TclUnsetObjRef(dataPtr->lastSetupTimeZoneUnnorm); + TclSetObjRef(dataPtr->lastSetupTZData, ret); } return ret; } @@ -1281,14 +1280,14 @@ ClockGetSystemTimeZone( return dataPtr->systemTimeZone; } - Tcl_UnsetObjRef(dataPtr->systemTimeZone); - Tcl_UnsetObjRef(dataPtr->systemSetupTZData); + TclUnsetObjRef(dataPtr->systemTimeZone); + TclUnsetObjRef(dataPtr->systemSetupTZData); if (Tcl_EvalObjv(interp, 1, &dataPtr->literals[LIT_GETSYSTEMTIMEZONE], 0) != TCL_OK) { return NULL; } if (dataPtr->systemTimeZone == NULL) { - Tcl_SetObjRef(dataPtr->systemTimeZone, Tcl_GetObjResult(interp)); + TclSetObjRef(dataPtr->systemTimeZone, Tcl_GetObjResult(interp)); } Tcl_ResetResult(interp); return dataPtr->systemTimeZone; @@ -1353,7 +1352,7 @@ ClockSetupTimeZone( callargs[0] = dataPtr->literals[LIT_SETUPTIMEZONE]; if (Tcl_EvalObjv(interp, 2, callargs, 0) == TCL_OK) { /* save unnormalized last used */ - Tcl_SetObjRef(dataPtr->lastSetupTimeZoneUnnorm, timezoneObj); + TclSetObjRef(dataPtr->lastSetupTimeZoneUnnorm, timezoneObj); return callargs[1]; } return NULL; @@ -1967,16 +1966,16 @@ ConvertLocalToUTC( /* Cache the last conversion */ if (ltzoc != NULL) { /* slot was found above */ /* timezoneObj and changeover are the same */ - Tcl_SetObjRef(ltzoc->tzName, fields->tzName); /* may be NULL */ + TclSetObjRef(ltzoc->tzName, fields->tzName); /* may be NULL */ } else { /* no TZ in cache - just move second slot down and use the first one */ ltzoc = &dataPtr->lastTZOffsCache[0]; - Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].timezoneObj); - Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].tzName); + TclUnsetObjRef(dataPtr->lastTZOffsCache[1].timezoneObj); + TclUnsetObjRef(dataPtr->lastTZOffsCache[1].tzName); memcpy(&dataPtr->lastTZOffsCache[1], ltzoc, sizeof(*ltzoc)); - Tcl_InitObjRef(ltzoc->timezoneObj, timezoneObj); + TclInitObjRef(ltzoc->timezoneObj, timezoneObj); ltzoc->changeover = changeover; - Tcl_InitObjRef(ltzoc->tzName, fields->tzName); /* may be NULL */ + TclInitObjRef(ltzoc->tzName, fields->tzName); /* may be NULL */ } ltzoc->localSeconds = fields->localSeconds; ltzoc->rangesVal[0] = rangesVal[0]; @@ -2075,7 +2074,7 @@ ConvertLocalToUTCUsingTable( found: fields->tzOffset = have[i].tzOffset; fields->seconds = fields->localSeconds - fields->tzOffset; - Tcl_SetObjRef(fields->tzName, have[i].tzName); + TclSetObjRef(fields->tzName, have[i].tzName); return TCL_OK; } @@ -2198,9 +2197,9 @@ ConvertUTCToLocal( || Tcl_ListObjIndex(interp, rowv[0], 3, &tzName) != TCL_OK) { return TCL_ERROR; } - Tcl_SetObjRef(dataPtr->gmtTZName, tzName); + TclSetObjRef(dataPtr->gmtTZName, tzName); } - Tcl_SetObjRef(fields->tzName, dataPtr->gmtTZName); + TclSetObjRef(fields->tzName, dataPtr->gmtTZName); return TCL_OK; } @@ -2220,7 +2219,7 @@ ConvertUTCToLocal( /* the same time zone and offset (UTC time inside the last minute) */ fields->tzOffset = ltzoc->tzOffset; fields->localSeconds = fields->seconds + fields->tzOffset; - Tcl_SetObjRef(fields->tzName, ltzoc->tzName); + TclSetObjRef(fields->tzName, ltzoc->tzName); return TCL_OK; } } @@ -2267,16 +2266,16 @@ ConvertUTCToLocal( /* Cache the last conversion */ if (ltzoc != NULL) { /* slot was found above */ /* timezoneObj and changeover are the same */ - Tcl_SetObjRef(ltzoc->tzName, fields->tzName); + TclSetObjRef(ltzoc->tzName, fields->tzName); } else { /* no TZ in cache - just move second slot down and use the first one */ ltzoc = &dataPtr->lastTZOffsCache[0]; - Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].timezoneObj); - Tcl_UnsetObjRef(dataPtr->lastTZOffsCache[1].tzName); + TclUnsetObjRef(dataPtr->lastTZOffsCache[1].timezoneObj); + TclUnsetObjRef(dataPtr->lastTZOffsCache[1].tzName); memcpy(&dataPtr->lastTZOffsCache[1], ltzoc, sizeof(*ltzoc)); - Tcl_InitObjRef(ltzoc->timezoneObj, timezoneObj); + TclInitObjRef(ltzoc->timezoneObj, timezoneObj); ltzoc->changeover = changeover; - Tcl_InitObjRef(ltzoc->tzName, fields->tzName); + TclInitObjRef(ltzoc->tzName, fields->tzName); } ltzoc->localSeconds = fields->localSeconds; ltzoc->rangesVal[0] = rangesVal[0]; @@ -2333,7 +2332,7 @@ ConvertUTCToLocalUsingTable( * Convert the time. */ - Tcl_SetObjRef(fields->tzName, cellv[3]); + TclSetObjRef(fields->tzName, cellv[3]); fields->localSeconds = fields->seconds + fields->tzOffset; return TCL_OK; } @@ -2424,7 +2423,7 @@ ConvertUTCToLocalUsingC( if (diff != 0) { p = TclItoAw(buffer+5, diff, '0', 2); } - Tcl_SetObjRef(fields->tzName, Tcl_NewStringObj(buffer, p - buffer)); + TclSetObjRef(fields->tzName, Tcl_NewStringObj(buffer, p - buffer)); return TCL_OK; } @@ -3510,7 +3509,7 @@ baseNow: } /* cache last base */ memcpy(&dataPtr->lastBase.date, date, ClockCacheableDateFieldsSize); - Tcl_SetObjRef(dataPtr->lastBase.timezoneObj, opts->timezoneObj); + TclSetObjRef(dataPtr->lastBase.timezoneObj, opts->timezoneObj); } return TCL_OK; @@ -3598,7 +3597,7 @@ ClockFormatObjCmd( done: - Tcl_UnsetObjRef(dateFmt.date.tzName); + TclUnsetObjRef(dateFmt.date.tzName); if (ret != TCL_OK) { return ret; @@ -3722,7 +3721,7 @@ ClockScanObjCmd( done: - Tcl_UnsetObjRef(yy.date.tzName); + TclUnsetObjRef(yy.date.tzName); if (ret != TCL_OK) { return ret; @@ -4060,7 +4059,7 @@ ClockFreeScan( goto done; } - // Tcl_SetObjRef(yydate.tzName, opts->timezoneObj); + // TclSetObjRef(yydate.tzName, opts->timezoneObj); info->flags |= CLF_ASSEMBLE_SECONDS; } @@ -4542,7 +4541,7 @@ ClockAddObjCmd( done: - Tcl_UnsetObjRef(yy.date.tzName); + TclUnsetObjRef(yy.date.tzName); if (ret != TCL_OK) { return ret; @@ -4634,13 +4633,13 @@ ClockSafeCatchCmd( statePtr = (InterpState *)Tcl_SaveInterpState(interp, 0); if (!statePtr->errorInfo) { /* todo: avoid traced get of errorInfo here */ - Tcl_InitObjRef(statePtr->errorInfo, + TclInitObjRef(statePtr->errorInfo, Tcl_ObjGetVar2(interp, iPtr->eiVar, NULL, 0)); flags |= ERR_LEGACY_COPY; } if (!statePtr->errorCode) { /* todo: avoid traced get of errorCode here */ - Tcl_InitObjRef(statePtr->errorCode, + TclInitObjRef(statePtr->errorCode, Tcl_ObjGetVar2(interp, iPtr->ecVar, NULL, 0)); flags |= ERR_LEGACY_COPY; } @@ -4653,7 +4652,7 @@ ClockSafeCatchCmd( return TCL_ERROR; } /* overwrite result in state with catch result */ - Tcl_SetObjRef(statePtr->objResult, Tcl_GetObjResult(interp)); + TclSetObjRef(statePtr->objResult, Tcl_GetObjResult(interp)); /* set result (together with restore state) to interpreter */ (void) Tcl_RestoreInterpState(interp, (Tcl_InterpState)statePtr); /* todo: unless ERR_LEGACY_COPY not set in restore (branch [bug-554117edde] not merged yet) */ diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index d2175e6..ad273d0 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -556,7 +556,7 @@ ClockFmtObj_DupInternalRep( ObjClockFmtScn(copyPtr) = fss; /* regards special case - format not localizable */ if (ObjLocFmtKey(srcPtr) != srcPtr) { - Tcl_InitObjRef(ObjLocFmtKey(copyPtr), ObjLocFmtKey(srcPtr)); + TclInitObjRef(ObjLocFmtKey(copyPtr), ObjLocFmtKey(srcPtr)); } else { ObjLocFmtKey(copyPtr) = copyPtr; } @@ -592,7 +592,7 @@ ClockFmtObj_FreeInternalRep( } ObjClockFmtScn(objPtr) = NULL; if (ObjLocFmtKey(objPtr) != objPtr) { - Tcl_UnsetObjRef(ObjLocFmtKey(objPtr)); + TclUnsetObjRef(ObjLocFmtKey(objPtr)); } else { ObjLocFmtKey(objPtr) = NULL; } @@ -679,7 +679,7 @@ ClockFrmObjGetLocFmtKey( } keyObj = Tcl_ObjPrintf("FMT_%s", TclGetString(objPtr)); - Tcl_InitObjRef(ObjLocFmtKey(objPtr), keyObj); + TclInitObjRef(ObjLocFmtKey(objPtr), keyObj); return keyObj; } @@ -890,7 +890,7 @@ ClockLocalizeFormat( if (valObj == opts->formatObj) { /* mark it as unlocalizable, by setting self as key (without refcount incr) */ if (valObj->typePtr == &ClockFmtObjType) { - Tcl_UnsetObjRef(ObjLocFmtKey(valObj)); + TclUnsetObjRef(ObjLocFmtKey(valObj)); ObjLocFmtKey(valObj) = valObj; } } @@ -898,7 +898,7 @@ ClockLocalizeFormat( done: - Tcl_UnsetObjRef(keyObj); + TclUnsetObjRef(keyObj); return (opts->formatObj = valObj); } diff --git a/generic/tclDate.h b/generic/tclDate.h index 81910ff..8a1e8cd 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -486,7 +486,7 @@ struct ClockFmtScnStorage { * Extracts Julian day and seconds of the day from posix seconds (tm). */ #define ClockExtractJDAndSODFromSeconds(jd, sod, tm) \ - if (1) { \ + do { \ jd = (tm + JULIAN_SEC_POSIX_EPOCH); \ if (jd >= SECONDS_PER_DAY || jd <= -SECONDS_PER_DAY) { \ jd /= SECONDS_PER_DAY; \ @@ -501,7 +501,7 @@ struct ClockFmtScnStorage { jd--; \ } \ } \ - } + } while(0) /* * Prototypes of module functions. diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c index bdb16f2..5410b55 100644 --- a/generic/tclStrIdxTree.c +++ b/generic/tclStrIdxTree.c @@ -87,7 +87,7 @@ TclStrIdxTreeSearch( TclStrIdxTree *parent = tree, *prevParent = tree; TclStrIdx *item = tree->firstPtr, *prevItem = NULL; const char *s = start, *f, *cin, *cinf, *prevf = NULL; - int offs = 0; + Tcl_Size offs = 0; if (item == NULL) { goto done; @@ -280,7 +280,7 @@ TclStrIdxTreeBuildFromList( && foundItem->length <= (f - s) /* only if found item is covered in full */ && foundItem->childTree.firstPtr == NULL ) { - Tcl_SetObjRef(foundItem->key, lwrv[i]); + TclSetObjRef(foundItem->key, lwrv[i]); foundItem->length = lwrv[i]->length; continue; } @@ -292,7 +292,7 @@ TclStrIdxTreeBuildFromList( if (item == NULL) { goto done; } - Tcl_InitObjRef(item->key, foundItem->key); + TclInitObjRef(item->key, foundItem->key); item->length = f - s; /* set value or mark as ambigous if not the same value of both */ item->value = (foundItem->value == val) ? val : NULL; @@ -311,7 +311,7 @@ TclStrIdxTreeBuildFromList( goto done; } item->childTree.lastPtr = item->childTree.firstPtr = NULL; - Tcl_InitObjRef(item->key, lwrv[i]); + TclInitObjRef(item->key, lwrv[i]); item->length = lwrv[i]->length; item->value = val; TclStrIdxTreeAppend(foundParent, item); @@ -375,7 +375,7 @@ StrIdxTreeObj_DupIntRepProc(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) srcPtr = (Tcl_Obj*)srcPtr->internalRep.twoPtrValue.ptr1; } /* create smart pointer to it (ptr1 != NULL, ptr2 = NULL) */ - Tcl_InitObjRef(*((Tcl_Obj **)©Ptr->internalRep.twoPtrValue.ptr1), + TclInitObjRef(*((Tcl_Obj **)©Ptr->internalRep.twoPtrValue.ptr1), srcPtr); copyPtr->internalRep.twoPtrValue.ptr2 = NULL; copyPtr->typePtr = &StrIdxTreeObjType; @@ -389,7 +389,7 @@ StrIdxTreeObj_FreeIntRepProc(Tcl_Obj *objPtr) && objPtr->internalRep.twoPtrValue.ptr2 == NULL ) { /* is a link */ - Tcl_UnsetObjRef(*((Tcl_Obj **)&objPtr->internalRep.twoPtrValue.ptr1)); + TclUnsetObjRef(*((Tcl_Obj **)&objPtr->internalRep.twoPtrValue.ptr1)); } else { /* is a tree */ TclStrIdxTree *tree = (TclStrIdxTree*)&objPtr->internalRep.twoPtrValue.ptr1; @@ -431,7 +431,7 @@ TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr) { #if 0 /* currently unused, debug resp. test purposes only */ -void +static void TclStrIdxTreePrint( Tcl_Interp *interp, TclStrIdx *tree, @@ -439,19 +439,19 @@ TclStrIdxTreePrint( { Tcl_Obj *obj[2]; const char *s; - Tcl_InitObjRef(obj[0], Tcl_NewStringObj("::puts", -1)); + TclInitObjRef(obj[0], Tcl_NewStringObj("::puts", -1)); while (tree != NULL) { s = TclGetString(tree->key) + offs; - Tcl_InitObjRef(obj[1], Tcl_ObjPrintf("%*s%.*s\t:%d", + TclInitObjRef(obj[1], Tcl_ObjPrintf("%*s%.*s\t:%d", offs, "", tree->length - offs, s, tree->value)); Tcl_PutsObjCmd(NULL, interp, 2, obj); - Tcl_UnsetObjRef(obj[1]); + TclUnsetObjRef(obj[1]); if (tree->childTree.firstPtr != NULL) { TclStrIdxTreePrint(interp, tree->childTree.firstPtr, tree->length); } tree = tree->nextPtr; } - Tcl_UnsetObjRef(obj[0]); + TclUnsetObjRef(obj[0]); } @@ -494,9 +494,7 @@ TclStrIdxTreeTestObjCmd( Tcl_SetObjResult(interp, Tcl_NewIntObj(ret - cs)); break; case O_INDEX: - case O_PUTS_INDEX: - - if (1) { + case O_PUTS_INDEX: { Tcl_Obj **lstv; int i, lstc; TclStrIdxTree idxTree = {NULL, NULL}; diff --git a/generic/tclStrIdxTree.h b/generic/tclStrIdxTree.h index 19e7624..5052823 100644 --- a/generic/tclStrIdxTree.h +++ b/generic/tclStrIdxTree.h @@ -28,7 +28,7 @@ typedef struct TclStrIdx { struct TclStrIdx *nextPtr; struct TclStrIdx *prevPtr; Tcl_Obj *key; - int length; + Tcl_Size length; void *value; } TclStrIdx; @@ -115,19 +115,31 @@ TclUtfFindEqualNCInLwr( * Primitives to safe set, reset and free references. */ -#define Tcl_UnsetObjRef(obj) \ - if (obj != NULL) { Tcl_DecrRefCount(obj); obj = NULL; } -#define Tcl_InitObjRef(obj, val) \ - obj = val; if (obj) { Tcl_IncrRefCount(obj); } -#define Tcl_SetObjRef(obj, val) \ -if (1) { \ - Tcl_Obj *nval = val; \ - if (obj != nval) { \ - Tcl_Obj *prev = obj; \ - Tcl_InitObjRef(obj, nval); \ - if (prev != NULL) { Tcl_DecrRefCount(prev); }; \ - } \ -} +#define TclUnsetObjRef(obj) \ + do { \ + if (obj != NULL) { \ + Tcl_DecrRefCount(obj); \ + obj = NULL; \ + } \ + } while (0) +#define TclInitObjRef(obj, val) \ + do { \ + obj = val; \ + if (obj) { \ + Tcl_IncrRefCount(obj); \ + } \ + } while (0) +#define TclSetObjRef(obj, val) \ + do { \ + Tcl_Obj *nval = val; \ + if (obj != nval) { \ + Tcl_Obj *prev = obj; \ + TclInitObjRef(obj, nval); \ + if (prev != NULL) { \ + Tcl_DecrRefCount(prev); \ + }; \ + } \ + } while (0) /* * Prototypes of module functions. @@ -147,8 +159,8 @@ MODULE_SCOPE Tcl_Obj* MODULE_SCOPE TclStrIdxTree* TclStrIdxTreeGetFromObj(Tcl_Obj *objPtr); -#if 1 - +#if 0 +/* currently unused, debug resp. test purposes only */ MODULE_SCOPE Tcl_ObjCmdProc TclStrIdxTreeTestObjCmd; #endif -- cgit v0.12 From e9d501fca085dc074f6873aa80907fdf29fdeea0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 20 Mar 2024 20:40:56 +0000 Subject: put back line accidently removed --- generic/tclStringObj.c | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index dba36a6..10faa02 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -618,6 +618,7 @@ TclGetUniChar( return -1; } const char *begin = TclUtfAtIndex(objPtr->bytes, index); + TclUtfToUniChar(begin, &ch); return ch; } -- cgit v0.12 From 4d34ce202b3c9139e9046f447fa2b5d4dc87b72c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 21 Mar 2024 12:57:21 +0000 Subject: Formatting/indenting --- generic/tclArithSeries.c | 58 ++--- generic/tclIO.c | 101 ++++---- generic/tclObj.c | 6 +- generic/tclTest.c | 561 +++++++++++++++++++++---------------------- generic/tclTestObj.c | 25 +- generic/tclTestProcBodyObj.c | 2 +- macosx/tclMacOSXFCmd.c | 19 +- unix/tclUnixTest.c | 50 ++-- 8 files changed, 412 insertions(+), 410 deletions(-) diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index a29b589..48e9f80 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -106,9 +106,9 @@ ArithSeriesIndexDbl( { ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr; if (arithSeriesRepPtr->isDouble) { - double d = dblRepPtr->start + (index * dblRepPtr->step); + double d = dblRepPtr->start + (index * dblRepPtr->step); unsigned n = (dblRepPtr->precision > 0 ? dblRepPtr->precision : 0); - return ArithRound(d, n); + return ArithRound(d, n); } else { return (double)(arithSeriesRepPtr->start + (index * arithSeriesRepPtr->step)); } @@ -277,8 +277,7 @@ DupArithSeriesInternalRep( static void FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesObjPtr) /* Free any allocated memory */ { - ArithSeries *arithSeriesRepPtr = - (ArithSeries *)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1; + ArithSeries *arithSeriesRepPtr = (ArithSeries *)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1; if (arithSeriesRepPtr->elements) { Tcl_Size i; @@ -319,7 +318,9 @@ NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_Wide ArithSeries *arithSeriesRepPtr; length = len>=0 ? len : -1; - if (length < 0) length = -1; + if (length < 0) { + length = -1; + } TclNewObj(arithSeriesObj); @@ -337,8 +338,9 @@ NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_Wide arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr; arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL; arithSeriesObj->typePtr = &tclArithSeriesType; - if (length > 0) + if (length > 0) { Tcl_InvalidateStringRep(arithSeriesObj); + } return arithSeriesObj; } @@ -621,7 +623,9 @@ TclArithSeriesObjIndex( * *---------------------------------------------------------------------- */ -Tcl_Size TclArithSeriesObjLength(Tcl_Obj *arithSeriesObj) +Tcl_Size +TclArithSeriesObjLength( + Tcl_Obj *arithSeriesObj) { ArithSeries *arithSeriesRepPtr = (ArithSeries*) arithSeriesObj->internalRep.twoPtrValue.ptr1; @@ -655,7 +659,7 @@ ArithSeriesObjStep( Tcl_Obj *stepObj; if (arithSeriesObj->typePtr != &tclArithSeriesType) { - Tcl_Panic("ArithSeriesObjStep called with a not ArithSeries Obj."); + Tcl_Panic("ArithSeriesObjStep called with a not ArithSeries Obj."); } arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj); if (arithSeriesRepPtr->isDouble) { @@ -767,7 +771,7 @@ TclArithSeriesObjRange( ((arithSeriesObj->refCount > 1))) { Tcl_Obj *newSlicePtr; if (TclNewArithSeriesObj(interp, &newSlicePtr, - arithSeriesRepPtr->isDouble, startObj, endObj, + arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL) != TCL_OK) { newSlicePtr = NULL; } @@ -901,9 +905,7 @@ TclArithSeriesGetElements( *objcPtr = objc; } else { if (interp != NULL) { - Tcl_SetObjResult( - interp, - Tcl_ObjPrintf("value is not an arithseries")); + Tcl_SetObjResult(interp, Tcl_NewStringObj("value is not an arithseries", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", (void *)NULL); } return TCL_ERROR; @@ -1046,12 +1048,10 @@ TclArithSeriesObjReverse( static void UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr) { - ArithSeries *arithSeriesRepPtr = - (ArithSeries*)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1; + ArithSeries *arithSeriesRepPtr = (ArithSeries*)arithSeriesObjPtr->internalRep.twoPtrValue.ptr1; char *p; - Tcl_Obj *elemObj; - Tcl_Size i; - Tcl_Size length = 0; + Tcl_Obj *eleObj; + Tcl_Size i, bytlen = 0; Tcl_Size slen; /* @@ -1061,7 +1061,7 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr) for (i = 0; i < arithSeriesRepPtr->len; i++) { double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i); slen = d>0 ? log10(d)+1 : d<0 ? log10((0-d))+2 : 1; - length += slen; + bytlen += slen; } } else { for (i = 0; i < arithSeriesRepPtr->len; i++) { @@ -1069,35 +1069,35 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr) char tmp[TCL_DOUBLE_SPACE+2]; tmp[0] = 0; Tcl_PrintDouble(NULL,d,tmp); - if ((length + strlen(tmp)) > TCL_SIZE_MAX) { + if ((bytlen + strlen(tmp)) > TCL_SIZE_MAX) { break; // overflow } - length += strlen(tmp); + bytlen += strlen(tmp); } } - length += arithSeriesRepPtr->len; // Space for each separator + bytlen += arithSeriesRepPtr->len; // Space for each separator /* * Pass 2: generate the string repr. */ - p = Tcl_InitStringRep(arithSeriesObjPtr, NULL, length); + p = Tcl_InitStringRep(arithSeriesObjPtr, NULL, bytlen); if (p == NULL) { - Tcl_Panic("Unable to allocate string size %d", length); + Tcl_Panic("Unable to allocate string size %d", bytlen); } for (i = 0; i < arithSeriesRepPtr->len; i++) { - elemObj = TclArithSeriesObjIndex(NULL, arithSeriesObjPtr, i); - char *str = Tcl_GetStringFromObj(elemObj, &slen); - if (((p - arithSeriesObjPtr->bytes)+slen) > length) { + eleObj = TclArithSeriesObjIndex(NULL, arithSeriesObjPtr, i); + char *str = TclGetStringFromObj(eleObj, &slen); + if (((p - arithSeriesObjPtr->bytes)+slen) > bytlen) { break; } strncpy(p, str, slen); p[slen] = ' '; p += slen+1; - Tcl_DecrRefCount(elemObj); + Tcl_DecrRefCount(eleObj); } - if (length > 0) arithSeriesObjPtr->bytes[length-1] = '\0'; - arithSeriesObjPtr->length = length-1; + if (bytlen > 0) arithSeriesObjPtr->bytes[bytlen-1] = '\0'; + arithSeriesObjPtr->length = bytlen-1; } /* diff --git a/generic/tclIO.c b/generic/tclIO.c index 15e0785..8f53bb9 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -28,7 +28,7 @@ typedef struct ChannelHandler { int mask; /* Mask of desired events. */ Tcl_ChannelProc *proc; /* Procedure to call in the type of * Tcl_CreateChannelHandler. */ - void *clientData; /* Argument to pass to procedure. */ + void *clientData; /* Argument to pass to procedure. */ struct ChannelHandler *nextPtr; /* Next one in list of registered handlers. */ } ChannelHandler; @@ -50,11 +50,12 @@ typedef struct ChannelHandler { */ typedef struct NextChannelHandler { - ChannelHandler *nextHandlerPtr; /* The next handler to be invoked in - * this invocation. */ + ChannelHandler *nextHandlerPtr; + /* The next handler to be invoked in + * this invocation. */ struct NextChannelHandler *nestedHandlerPtr; - /* Next nested invocation of - * Tcl_NotifyChannel. */ + /* Next nested invocation of + * Tcl_NotifyChannel. */ } NextChannelHandler; /* @@ -103,7 +104,7 @@ typedef struct CopyState { Tcl_Interp *interp; /* Interp that started the copy. */ Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */ Tcl_Size bufSize; /* Size of appended buffer. */ - char buffer[TCLFLEXARRAY]; /* Copy buffer, this must be the last + char buffer[TCLFLEXARRAY]; /* Copy buffer, this must be the last * field. */ } CopyState; @@ -141,10 +142,11 @@ static Tcl_ThreadDataKey dataKey; */ typedef struct CloseCallback { - Tcl_CloseProc *proc; /* The procedure to call. */ + Tcl_CloseProc *proc; /* The procedure to call. */ void *clientData; /* Arbitrary one-word data to pass - * to the callback. */ - struct CloseCallback *nextPtr; /* For chaining close callbacks. */ + * to the callback. */ + struct CloseCallback *nextPtr; + /* For chaining close callbacks. */ } CloseCallback; /* @@ -626,7 +628,7 @@ TclFinalizeIOSubsystem(void) continue; } if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED ) - || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { + || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { ResetFlag(statePtr, BG_FLUSH_SCHEDULED); active = 1; break; @@ -654,7 +656,7 @@ TclFinalizeIOSubsystem(void) */ (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, - "-blocking", "on"); + "-blocking", "on"); } if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || @@ -2476,13 +2478,13 @@ Tcl_GetChannelHandle( int Tcl_RemoveChannelMode( - Tcl_Interp* interp, /* The interp for an error message. Allowed to be NULL. */ + Tcl_Interp *interp, /* The interp for an error message. Allowed to be NULL. */ Tcl_Channel chan, /* The channel which is modified. */ - int mode) /* The access mode to drop from the channel */ + int mode) /* The access mode to drop from the channel */ { const char* emsg; ChannelState *statePtr = ((Channel *) chan)->state; - /* State of actual channel. */ + /* State of actual channel. */ if ((mode != TCL_READABLE) && (mode != TCL_WRITABLE)) { emsg = "Illegal mode value."; @@ -3613,7 +3615,7 @@ Tcl_Close( Tcl_SetErrno(stickyError); if (interp != NULL) { Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tcl_PosixError(interp), -1)); + Tcl_NewStringObj(Tcl_PosixError(interp), -1)); } return TCL_ERROR; } @@ -4355,7 +4357,7 @@ WillRead( */ if (FlushChannel(NULL, chanPtr, 0) != 0) { - return -1; + return -1; } } return 0; @@ -4393,7 +4395,7 @@ Write( /* State info for channel */ char *nextNewLine = NULL; int endEncoding, needNlFlush = 0; - int saved = 0, total = 0, flushed = 0; + Tcl_Size saved = 0, total = 0, flushed = 0; char safe[BUFFER_PADDING]; int encodingError = 0; @@ -4707,7 +4709,7 @@ Tcl_GetsObj( * newline in the available input. */ - TclGetStringFromObj(objPtr, &oldLength); + (void)TclGetStringFromObj(objPtr, &oldLength); oldFlags = statePtr->inputEncodingFlags; oldState = statePtr->inputEncodingState; oldRemoved = BUFFER_PADDING; @@ -5577,7 +5579,7 @@ FilterInputBytes( } extra = rawLen - gsPtr->rawRead; memcpy(nextPtr->buf + (BUFFER_PADDING - extra), - raw + gsPtr->rawRead, (size_t) extra); + raw + gsPtr->rawRead, extra); nextPtr->nextRemoved -= extra; bufPtr->nextAdded -= extra; } @@ -6380,11 +6382,7 @@ ReadChars( dst, dstLimit, &srcRead, &dstDecoded, &numChars); if (code == TCL_CONVERT_UNKNOWN || code == TCL_CONVERT_SYNTAX - || ( - code == TCL_CONVERT_MULTIBYTE - && GotFlag(statePtr, CHANNEL_EOF - )) - ) { + || (code == TCL_CONVERT_MULTIBYTE && GotFlag(statePtr, CHANNEL_EOF))) { SetFlag(statePtr, CHANNEL_ENCODING_ERROR); code = TCL_OK; } @@ -6759,23 +6757,28 @@ TranslateInputEOL( int numBytes = crFound - src; memmove(dst, src, numBytes); - dst += numBytes; dstLen -= numBytes; - src += numBytes; srcLen -= numBytes; + dst += numBytes; + dstLen -= numBytes; + src += numBytes; + srcLen -= numBytes; if (srcLen == 1) { /* valid src bytes end in \r */ if (eof) { *dst++ = '\r'; - src++; srcLen--; + src++; + srcLen--; } else { lesser = 0; break; } } else if (src[1] == '\n') { *dst++ = '\n'; - src += 2; srcLen -= 2; + src += 2; + srcLen -= 2; } else { *dst++ = '\r'; - src++; srcLen--; + src++; + srcLen--; } dstLen--; lesser = (dstLen < srcLen) ? dstLen : srcLen; @@ -6791,7 +6794,10 @@ TranslateInputEOL( int lesser; if (GotFlag(statePtr, INPUT_SAW_CR) && srcLen) { - if (*src == '\n') { src++; srcLen--; } + if (*src == '\n') { + src++; + srcLen--; + } ResetFlag(statePtr, INPUT_SAW_CR); } lesser = (dstLen < srcLen) ? dstLen : srcLen; @@ -6800,12 +6806,15 @@ TranslateInputEOL( memmove(dst, src, numBytes); dst[numBytes] = '\n'; - dst += numBytes + 1; dstLen -= numBytes + 1; - src += numBytes + 1; srcLen -= numBytes + 1; + dst += numBytes + 1; + dstLen -= numBytes + 1; + src += numBytes + 1; + srcLen -= numBytes + 1; if (srcLen == 0) { SetFlag(statePtr, INPUT_SAW_CR); } else if (*src == '\n') { - src++; srcLen--; + src++; + srcLen--; } lesser = (dstLen < srcLen) ? dstLen : srcLen; } @@ -8824,19 +8833,18 @@ UpdateInterest( TclChannelPreserve((Tcl_Channel)chanPtr); statePtr->timerChanPtr = chanPtr; statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc, chanPtr); + ChannelTimerProc, chanPtr); } } } if (!statePtr->timer - && mask & TCL_WRITABLE - && GotFlag(statePtr, CHANNEL_NONBLOCKING)) { - + && mask & TCL_WRITABLE + && GotFlag(statePtr, CHANNEL_NONBLOCKING)) { TclChannelPreserve((Tcl_Channel)chanPtr); statePtr->timerChanPtr = chanPtr; statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ChannelTimerProc,chanPtr); + ChannelTimerProc,chanPtr); } @@ -8880,9 +8888,8 @@ ChannelTimerProc( Tcl_Preserve(statePtr); statePtr->timer = NULL; if (statePtr->interestMask & TCL_WRITABLE - && GotFlag(statePtr, CHANNEL_NONBLOCKING) - && !GotFlag(statePtr, BG_FLUSH_SCHEDULED) - ) { + && GotFlag(statePtr, CHANNEL_NONBLOCKING) + && !GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { /* * Restart the timer in case a channel handler reenters the event loop * before UpdateInterest gets called by Tcl_NotifyChannel. @@ -8894,9 +8901,9 @@ ChannelTimerProc( /* The channel may have just been closed from within Tcl_NotifyChannel */ if (!GotFlag(statePtr, CHANNEL_INCLOSE)) { if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA) - && (statePtr->interestMask & TCL_READABLE) - && (statePtr->inQueueHead != NULL) - && IsBufferReady(statePtr->inQueueHead)) { + && (statePtr->interestMask & TCL_READABLE) + && (statePtr->inQueueHead != NULL) + && IsBufferReady(statePtr->inQueueHead)) { /* * Restart the timer in case a channel handler reenters the event loop * before UpdateInterest gets called by Tcl_NotifyChannel. @@ -9929,7 +9936,7 @@ CopyData( * - Fail below with a read error */ if (size < 0 && Tcl_GetErrno() == EILSEQ) { - Tcl_GetStringFromObj(bufObj, &sizePart); + TclGetStringFromObj(bufObj, &sizePart); if (sizePart > 0) { size = sizePart; } @@ -9966,8 +9973,8 @@ CopyData( if ((size == 0) && Tcl_Eof(inChan) && !(cmdPtr && (mask == 0))) { break; } - if (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) && - !(mask & TCL_READABLE)) { + if (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) + && !(mask & TCL_READABLE)) { if (mask & TCL_WRITABLE) { Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr); } diff --git a/generic/tclObj.c b/generic/tclObj.c index f321399..f3e1f7f 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2261,7 +2261,7 @@ TclSetBooleanFromAny( badBoolean: if (interp != NULL) { Tcl_Size length; - const char *str = Tcl_GetStringFromObj(objPtr, &length); + const char *str = TclGetStringFromObj(objPtr, &length); Tcl_Obj *msg; TclNewLiteralStringObj(msg, "expected boolean value but got \""); @@ -2280,7 +2280,7 @@ ParseBoolean( int newBool; char lowerCase[6]; Tcl_Size i, length; - const char *str = Tcl_GetStringFromObj(objPtr, &length); + const char *str = TclGetStringFromObj(objPtr, &length); if ((length < 1) || (length > 5)) { /* @@ -4493,7 +4493,7 @@ TclHashObjKey( { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; Tcl_Size length; - const char *string = Tcl_GetStringFromObj(objPtr, &length); + const char *string = TclGetStringFromObj(objPtr, &length); TCL_HASH_TYPE result = 0; /* diff --git a/generic/tclTest.c b/generic/tclTest.c index e656985..ddc6024 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -540,6 +540,9 @@ static const char version[] = TCL_PATCH_LEVEL "+" STRINGIFY(TCL_VERSION_UUID) #ifdef STATIC_BUILD ".static" #endif +#if TCL_UTF_MAX < 4 + ".utf-16" +#endif ; int @@ -715,7 +718,7 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testnumutfchars", TestNumUtfCharsCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testgetunichar", - TestGetUniCharCmd, NULL, NULL); + TestGetUniCharCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindfirst", TestFindFirstCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfindlast", @@ -886,18 +889,17 @@ TestasyncCmd( asyncPtr = (TestAsyncHandler *)ckalloc(sizeof(TestAsyncHandler)); asyncPtr->command = (char *)ckalloc(strlen(argv[2]) + 1); strcpy(asyncPtr->command, argv[2]); - Tcl_MutexLock(&asyncTestMutex); + Tcl_MutexLock(&asyncTestMutex); asyncPtr->id = nextId; nextId++; - asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc, - INT2PTR(asyncPtr->id)); + asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc, INT2PTR(asyncPtr->id)); asyncPtr->nextPtr = firstHandler; firstHandler = asyncPtr; - Tcl_MutexUnlock(&asyncTestMutex); + Tcl_MutexUnlock(&asyncTestMutex); Tcl_SetObjResult(interp, Tcl_NewWideIntObj(asyncPtr->id)); } else if (strcmp(argv[1], "delete") == 0) { if (argc == 2) { - Tcl_MutexLock(&asyncTestMutex); + Tcl_MutexLock(&asyncTestMutex); while (firstHandler != NULL) { asyncPtr = firstHandler; firstHandler = asyncPtr->nextPtr; @@ -905,7 +907,7 @@ TestasyncCmd( ckfree(asyncPtr->command); ckfree(asyncPtr); } - Tcl_MutexUnlock(&asyncTestMutex); + Tcl_MutexUnlock(&asyncTestMutex); return TCL_OK; } if (argc != 3) { @@ -914,7 +916,7 @@ TestasyncCmd( if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) { return TCL_ERROR; } - Tcl_MutexLock(&asyncTestMutex); + Tcl_MutexLock(&asyncTestMutex); for (prevPtr = NULL, asyncPtr = firstHandler; asyncPtr != NULL; prevPtr = asyncPtr, asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id != id) { @@ -930,7 +932,7 @@ TestasyncCmd( ckfree(asyncPtr); break; } - Tcl_MutexUnlock(&asyncTestMutex); + Tcl_MutexUnlock(&asyncTestMutex); } else if (strcmp(argv[1], "mark") == 0) { if (argc != 5) { goto wrongNumArgs; @@ -957,7 +959,7 @@ TestasyncCmd( if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) { return TCL_ERROR; } - Tcl_MutexLock(&asyncTestMutex); + Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; asyncPtr = asyncPtr->nextPtr) { if (asyncPtr->id == id) { @@ -972,7 +974,7 @@ TestasyncCmd( break; } } - Tcl_MutexUnlock(&asyncTestMutex); + Tcl_MutexUnlock(&asyncTestMutex); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be create, delete, int, mark, or marklater", (void *)NULL); @@ -984,7 +986,7 @@ TestasyncCmd( static int AsyncHandlerProc( void *clientData, /* If of TestAsyncHandler structure. - * in global list. */ + * in global list. */ Tcl_Interp *interp, /* Interpreter in which command was * executed, or NULL. */ int code) /* Current return code from command. */ @@ -997,16 +999,16 @@ AsyncHandlerProc( Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; - asyncPtr = asyncPtr->nextPtr) { - if (asyncPtr->id == id) { - break; - } + asyncPtr = asyncPtr->nextPtr) { + if (asyncPtr->id == id) { + break; + } } Tcl_MutexUnlock(&asyncTestMutex); if (!asyncPtr) { - /* Woops - this one was deleted between the AsyncMark and now */ - return TCL_OK; + /* Woops - this one was deleted between the AsyncMark and now */ + return TCL_OK; } TclFormatInt(string, code); @@ -1054,11 +1056,11 @@ AsyncThreadProc( Tcl_Sleep(1); Tcl_MutexLock(&asyncTestMutex); for (asyncPtr = firstHandler; asyncPtr != NULL; - asyncPtr = asyncPtr->nextPtr) { - if (asyncPtr->id == id) { - Tcl_AsyncMark(asyncPtr->handler); - break; - } + asyncPtr = asyncPtr->nextPtr) { + if (asyncPtr->id == id) { + Tcl_AsyncMark(asyncPtr->handler); + break; + } } Tcl_MutexUnlock(&asyncTestMutex); Tcl_ExitThread(TCL_OK); @@ -1869,9 +1871,9 @@ TestdoubledigitsObjCmd( } } if (status != TCL_OK - || Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK - || Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type", - TCL_EXACT, &type) != TCL_OK) { + || Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK + || Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type", + TCL_EXACT, &type) != TCL_OK) { fprintf(stderr, "bad value? %g\n", d); return TCL_ERROR; } @@ -2064,8 +2066,10 @@ static void SpecialFree( *------------------------------------------------------------------------ */ typedef int -UtfTransformFn(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_EncodingState *statePtr, - char *dst, Tcl_Size dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); +UtfTransformFn(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, + Tcl_Size srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, + Tcl_Size dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); + static int UtfExtWrapper( Tcl_Interp *interp, UtfTransformFn *transformer, int objc, Tcl_Obj *const objv[]) { @@ -2097,14 +2101,12 @@ static int UtfExtWrapper( Tcl_WideInt wide; if (objc < 7 || objc > 10) { - Tcl_WrongNumArgs(interp, - 2, - objv, - "encoding srcbytes flags state dstlen ?srcreadvar? ?dstwrotevar? ?dstcharsvar?"); - return TCL_ERROR; + Tcl_WrongNumArgs(interp, 2, objv, + "encoding srcbytes flags state dstlen ?srcreadvar? ?dstwrotevar? ?dstcharsvar?"); + return TCL_ERROR; } if (Tcl_GetEncodingFromObj(interp, objv[2], &encoding) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } /* Flags may be specified as list of integers and keywords */ @@ -2119,13 +2121,8 @@ static int UtfExtWrapper( flags |= flag; } else { int idx; - if (Tcl_GetIndexFromObjStruct(interp, - flagObjs[i], - flagMap, - sizeof(flagMap[0]), - "flag", - 0, - &idx) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, flagObjs[i], flagMap, sizeof(flagMap[0]), + "flag", 0, &idx) != TCL_OK) { return TCL_ERROR; } flags |= flagMap[idx].flag; @@ -2134,16 +2131,16 @@ static int UtfExtWrapper( /* Assumes state is integer if not "" */ if (Tcl_GetWideIntFromObj(interp, objv[5], &wide) == TCL_OK) { - encState = (Tcl_EncodingState)(size_t)wide; - encStatePtr = &encState; + encState = (Tcl_EncodingState)(size_t)wide; + encStatePtr = &encState; } else if (Tcl_GetCharLength(objv[5]) == 0) { - encStatePtr = NULL; + encStatePtr = NULL; } else { - return TCL_ERROR; + return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[6], &dstLen) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } srcReadVar = NULL; dstWroteVar = NULL; @@ -2155,12 +2152,12 @@ static int UtfExtWrapper( } if (objc > 8) { /* Ditto for dstWrote */ - if (Tcl_GetCharLength(objv[8])) { - dstWroteVar = objv[8]; - } + if (Tcl_GetCharLength(objv[8])) { + dstWroteVar = objv[8]; + } if (objc > 9) { - if (Tcl_GetCharLength(objv[9])) { - dstCharsVar = objv[9]; + if (Tcl_GetCharLength(objv[9])) { + dstCharsVar = objv[9]; } } } @@ -2189,69 +2186,60 @@ static int UtfExtWrapper( memmove(bufPtr + dstLen, "\xAB\xCD\xEF\xAB", 4); /* overflow detection */ bytes = Tcl_GetByteArrayFromObj(objv[3], &srcLen); /* Last! to avoid shimmering */ result = (*transformer)(interp, encoding, (const char *)bytes, srcLen, flags, - encStatePtr, (char *) bufPtr, dstLen, - srcReadVar ? &srcRead : NULL, - &dstWrote, - dstCharsVar ? &dstChars : NULL); + encStatePtr, (char *) bufPtr, dstLen, + srcReadVar ? &srcRead : NULL, + &dstWrote, + dstCharsVar ? &dstChars : NULL); if (memcmp(bufPtr + bufLen - 4, "\xAB\xCD\xEF\xAB", 4)) { - Tcl_SetResult(interp, - "Tcl_ExternalToUtf wrote past output buffer", - TCL_STATIC); - result = TCL_ERROR; + Tcl_SetResult(interp, + "Tcl_ExternalToUtf wrote past output buffer", + TCL_STATIC); + result = TCL_ERROR; } else if (result != TCL_ERROR) { - Tcl_Obj *resultObjs[3]; - switch (result) { - case TCL_OK: - resultObjs[0] = Tcl_NewStringObj("ok", TCL_INDEX_NONE); - break; - case TCL_CONVERT_MULTIBYTE: - resultObjs[0] = Tcl_NewStringObj("multibyte", TCL_INDEX_NONE); - break; - case TCL_CONVERT_SYNTAX: - resultObjs[0] = Tcl_NewStringObj("syntax", TCL_INDEX_NONE); - break; - case TCL_CONVERT_UNKNOWN: - resultObjs[0] = Tcl_NewStringObj("unknown", TCL_INDEX_NONE); - break; - case TCL_CONVERT_NOSPACE: - resultObjs[0] = Tcl_NewStringObj("nospace", TCL_INDEX_NONE); - break; - default: - resultObjs[0] = Tcl_NewIntObj(result); - break; - } - result = TCL_OK; - resultObjs[1] = - encStatePtr ? Tcl_NewWideIntObj((Tcl_WideInt)(size_t)encState) : Tcl_NewObj(); - resultObjs[2] = Tcl_NewByteArrayObj(bufPtr, dstLen); - if (srcReadVar) { - if (Tcl_ObjSetVar2(interp, - srcReadVar, - NULL, - Tcl_NewIntObj(srcRead), - TCL_LEAVE_ERR_MSG) == NULL) { + Tcl_Obj *resultObjs[3]; + switch (result) { + case TCL_OK: + resultObjs[0] = Tcl_NewStringObj("ok", TCL_INDEX_NONE); + break; + case TCL_CONVERT_MULTIBYTE: + resultObjs[0] = Tcl_NewStringObj("multibyte", TCL_INDEX_NONE); + break; + case TCL_CONVERT_SYNTAX: + resultObjs[0] = Tcl_NewStringObj("syntax", TCL_INDEX_NONE); + break; + case TCL_CONVERT_UNKNOWN: + resultObjs[0] = Tcl_NewStringObj("unknown", TCL_INDEX_NONE); + break; + case TCL_CONVERT_NOSPACE: + resultObjs[0] = Tcl_NewStringObj("nospace", TCL_INDEX_NONE); + break; + default: + resultObjs[0] = Tcl_NewIntObj(result); + break; + } + result = TCL_OK; + resultObjs[1] = + encStatePtr ? Tcl_NewWideIntObj((Tcl_WideInt)(size_t)encState) : Tcl_NewObj(); + resultObjs[2] = Tcl_NewByteArrayObj(bufPtr, dstLen); + if (srcReadVar) { + if (Tcl_ObjSetVar2(interp, srcReadVar, NULL, Tcl_NewIntObj(srcRead), + TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } } - if (dstWroteVar) { - if (Tcl_ObjSetVar2(interp, - dstWroteVar, - NULL, - Tcl_NewIntObj(dstWrote), - TCL_LEAVE_ERR_MSG) == NULL) { + if (dstWroteVar) { + if (Tcl_ObjSetVar2(interp, dstWroteVar, NULL, Tcl_NewIntObj(dstWrote), + TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } } - if (dstCharsVar) { - if (Tcl_ObjSetVar2(interp, - dstCharsVar, - NULL, - Tcl_NewIntObj(dstChars), - TCL_LEAVE_ERR_MSG) == NULL) { + if (dstCharsVar) { + if (Tcl_ObjSetVar2(interp, dstCharsVar, NULL, Tcl_NewIntObj(dstChars), + TCL_LEAVE_ERR_MSG) == NULL) { result = TCL_ERROR; } } - Tcl_SetObjResult(interp, Tcl_NewListObj(3, resultObjs)); + Tcl_SetObjResult(interp, Tcl_NewListObj(3, resultObjs)); } ckfree(bufPtr); @@ -2359,13 +2347,13 @@ TestencodingObjCmd( return TCL_ERROR; } Tcl_SetObjResult(interp, - Tcl_NewIntObj(Tcl_GetEncodingNulLength(encoding))); + Tcl_NewIntObj(Tcl_GetEncodingNulLength(encoding))); Tcl_FreeEncoding(encoding); - break; + break; case ENC_EXTTOUTF: - return UtfExtWrapper(interp,Tcl_ExternalToUtf,objc,objv); + return UtfExtWrapper(interp,Tcl_ExternalToUtf,objc,objv); case ENC_UTFTOEXT: - return UtfExtWrapper(interp,Tcl_UtfToExternal,objc,objv); + return UtfExtWrapper(interp,Tcl_UtfToExternal,objc,objv); } return TCL_OK; } @@ -3294,7 +3282,7 @@ TestlinkCmd( } flag = writable ? 0 : TCL_LINK_READ_ONLY; if (Tcl_LinkVar(interp, "wide", &wideVar, - TCL_LINK_WIDE_INT | flag) != TCL_OK) { + TCL_LINK_WIDE_INT | flag) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[7], &writable) != TCL_OK) { @@ -3688,12 +3676,12 @@ TestlinkCmd( static int TestlinkarrayCmd( TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *LinkOption[] = { - "update", "remove", "create", NULL + "update", "remove", "create", NULL }; enum LinkOptionEnum { LINK_UPDATE, LINK_REMOVE, LINK_CREATE }; static const char *LinkType[] = { @@ -3891,10 +3879,10 @@ TestlistrepCmd( ListObjGetRep(objv[2], &listRep); listRepObjs[0] = Tcl_NewStringObj("store", -1); listRepObjs[1] = Tcl_NewListObj(12, NULL); - Tcl_ListObjAppendElement( - interp, listRepObjs[1], Tcl_NewStringObj("memoryAddress", -1)); - Tcl_ListObjAppendElement( - interp, listRepObjs[1], Tcl_ObjPrintf("%p", listRep.storePtr)); + Tcl_ListObjAppendElement(interp, listRepObjs[1], + Tcl_NewStringObj("memoryAddress", -1)); + Tcl_ListObjAppendElement(interp, listRepObjs[1], + Tcl_ObjPrintf("%p", listRep.storePtr)); APPEND_FIELD(listRepObjs[1], listRep.storePtr, firstUsed); APPEND_FIELD(listRepObjs[1], listRep.storePtr, numUsed); APPEND_FIELD(listRepObjs[1], listRep.storePtr, numAllocated); @@ -3903,14 +3891,12 @@ TestlistrepCmd( if (listRep.spanPtr) { listRepObjs[2] = Tcl_NewStringObj("span", -1); listRepObjs[3] = Tcl_NewListObj(8, NULL); - Tcl_ListObjAppendElement(interp, - listRepObjs[3], - Tcl_NewStringObj("memoryAddress", -1)); - Tcl_ListObjAppendElement( - interp, listRepObjs[3], Tcl_ObjPrintf("%p", listRep.spanPtr)); + Tcl_ListObjAppendElement(interp, listRepObjs[3], + Tcl_NewStringObj("memoryAddress", -1)); + Tcl_ListObjAppendElement(interp, listRepObjs[3], + Tcl_ObjPrintf("%p", listRep.spanPtr)); APPEND_FIELD(listRepObjs[3], listRep.spanPtr, spanStart); - APPEND_FIELD( - listRepObjs[3], listRep.spanPtr, spanLength); + APPEND_FIELD(listRepObjs[3], listRep.spanPtr, spanLength); APPEND_FIELD(listRepObjs[3], listRep.spanPtr, refCount); } resultObj = Tcl_NewListObj(listRep.spanPtr ? 4 : 2, listRepObjs); @@ -4613,7 +4599,7 @@ TestregexpObjCmd( * instead of the first character after the match. */ - if (end >= 0) { + if (end != TCL_INDEX_NONE) { end--; } @@ -5742,6 +5728,7 @@ TestbytestringObjCmd( if (p == NULL) { return TCL_ERROR; } + if (x.m != 1) { Tcl_AppendResult(interp, "Tcl_GetBytesFromObj() overwrites variable", (void *)NULL); return TCL_ERROR; @@ -6440,19 +6427,19 @@ TestChannelCmd( } if ((cmdName[0] == 'm') && (strncmp(cmdName, "mremove-rd", len) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); - return TCL_ERROR; - } + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", (void *)NULL); + return TCL_ERROR; + } return Tcl_RemoveChannelMode(interp, chan, TCL_READABLE); } if ((cmdName[0] == 'm') && (strncmp(cmdName, "mremove-wr", len) == 0)) { - if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); - return TCL_ERROR; - } + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", (void *)NULL); + return TCL_ERROR; + } return Tcl_RemoveChannelMode(interp, chan, TCL_WRITABLE); } @@ -6880,39 +6867,39 @@ TestSocketCmd( len = strlen(cmdName); if ((cmdName[0] == 't') && (strncmp(cmdName, "testflags", len) == 0)) { - Tcl_Channel hChannel; - int modePtr; - int testMode; - TcpState *statePtr; - /* Set test value in the socket driver - */ - /* Check for argument "channel name" - */ - if (argc < 4) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " testflags channel flags\"", (void *)NULL); - return TCL_ERROR; - } - hChannel = Tcl_GetChannel(interp, argv[2], &modePtr); - if ( NULL == hChannel ) { - Tcl_AppendResult(interp, "unknown channel:", argv[2], (void *)NULL); - return TCL_ERROR; - } - statePtr = (TcpState *)Tcl_GetChannelInstanceData(hChannel); - if ( NULL == statePtr) { - Tcl_AppendResult(interp, "No channel instance data:", argv[2], - (void *)NULL); - return TCL_ERROR; - } - if (Tcl_GetBoolean(interp, argv[3], &testMode) != TCL_OK) { - return TCL_ERROR; - } - if (testMode) { - statePtr->flags |= TCP_ASYNC_TEST_MODE; - } else { - statePtr->flags &= ~TCP_ASYNC_TEST_MODE; - } - return TCL_OK; + Tcl_Channel hChannel; + int modePtr; + int testMode; + TcpState *statePtr; + /* Set test value in the socket driver + */ + /* Check for argument "channel name" + */ + if (argc < 4) { + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " testflags channel flags\"", (void *)NULL); + return TCL_ERROR; + } + hChannel = Tcl_GetChannel(interp, argv[2], &modePtr); + if ( NULL == hChannel ) { + Tcl_AppendResult(interp, "unknown channel:", argv[2], (void *)NULL); + return TCL_ERROR; + } + statePtr = (TcpState *)Tcl_GetChannelInstanceData(hChannel); + if ( NULL == statePtr) { + Tcl_AppendResult(interp, "No channel instance data:", argv[2], + (void *)NULL); + return TCL_ERROR; + } + if (Tcl_GetBoolean(interp, argv[3], &testMode) != TCL_OK) { + return TCL_ERROR; + } + if (testMode) { + statePtr->flags |= TCP_ASYNC_TEST_MODE; + } else { + statePtr->flags &= ~TCP_ASYNC_TEST_MODE; + } + return TCL_OK; } Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be " @@ -6949,20 +6936,20 @@ TestServiceModeCmd( { int newmode, oldmode; if (argc > 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ?newmode?\"", (void *)NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], + " ?newmode?\"", (void *)NULL); + return TCL_ERROR; } oldmode = (Tcl_GetServiceMode() != TCL_SERVICE_NONE); if (argc == 2) { - if (Tcl_GetInt(interp, argv[1], &newmode) == TCL_ERROR) { - return TCL_ERROR; - } - if (newmode == 0) { - Tcl_SetServiceMode(TCL_SERVICE_NONE); - } else { - Tcl_SetServiceMode(TCL_SERVICE_ALL); - } + if (Tcl_GetInt(interp, argv[1], &newmode) == TCL_ERROR) { + return TCL_ERROR; + } + if (newmode == 0) { + Tcl_SetServiceMode(TCL_SERVICE_NONE); + } else { + Tcl_SetServiceMode(TCL_SERVICE_ALL); + } } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(oldmode)); return TCL_OK; @@ -7714,7 +7701,7 @@ TestUtfPrevCmd( if (TCL_OK != Tcl_GetIntForIndex(interp, objv[2], numBytes, &offset)) { return TCL_ERROR; } - if (offset < 0) { + if (offset == TCL_INDEX_NONE) { offset = 0; } if (offset > numBytes) { @@ -8043,20 +8030,20 @@ NREUnwind_callback( void *cStackPtr = TclGetCStackPtr(); if (data[0] == INT2PTR(-1)) { - Tcl_NRAddCallback(interp, NREUnwind_callback, cStackPtr, INT2PTR(-1), - INT2PTR(-1), NULL); + Tcl_NRAddCallback(interp, NREUnwind_callback, cStackPtr, INT2PTR(-1), + INT2PTR(-1), NULL); } else if (data[1] == INT2PTR(-1)) { - Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], cStackPtr, - INT2PTR(-1), NULL); + Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], cStackPtr, + INT2PTR(-1), NULL); } else if (data[2] == INT2PTR(-1)) { - Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], data[1], - cStackPtr, NULL); + Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], data[1], + cStackPtr, NULL); } else { - Tcl_Obj *idata[3]; - idata[0] = Tcl_NewWideIntObj(((char *) data[1] - (char *) data[0])); - idata[1] = Tcl_NewWideIntObj(((char *) data[2] - (char *) data[0])); - idata[2] = Tcl_NewWideIntObj(((char *) cStackPtr - (char *) data[0])); - Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata)); + Tcl_Obj *idata[3]; + idata[0] = Tcl_NewWideIntObj(((char *) data[1] - (char *) data[0])); + idata[1] = Tcl_NewWideIntObj(((char *) data[2] - (char *) data[0])); + idata[2] = Tcl_NewWideIntObj(((char *) cStackPtr - (char *) data[0])); + Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata)); } return TCL_OK; } @@ -8074,7 +8061,7 @@ TestNREUnwind( */ Tcl_NRAddCallback(interp, NREUnwind_callback, INT2PTR(-1), INT2PTR(-1), - INT2PTR(-1), NULL); + INT2PTR(-1), NULL); return TCL_OK; } @@ -8438,13 +8425,13 @@ TestparseargsCmd( Tcl_Size count = objc; Tcl_Obj **remObjv, *result[3]; const Tcl_ArgvInfo argTable[] = { - {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL}, - TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END + {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL}, + TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END }; foo = 0; if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } result[0] = Tcl_NewWideIntObj(foo); result[1] = Tcl_NewWideIntObj(count); @@ -8469,7 +8456,7 @@ InterpCmdResolver( Interp *iPtr = (Interp *) interp; CallFrame *varFramePtr = iPtr->varFramePtr; Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ? - varFramePtr->procPtr : NULL; + varFramePtr->procPtr : NULL; Namespace *callerNsPtr = varFramePtr->nsPtr; Tcl_Command resolvedCmdPtr = NULL; @@ -8479,74 +8466,74 @@ InterpCmdResolver( * B) the caller's namespace is "ctx1" or "ctx2" */ if ( (name[0] == 'z') && (name[1] == '\0') ) { - Namespace *ns2NsPtr = (Namespace *) Tcl_FindNamespace(interp, "::ns2", NULL, 0); - - if (procPtr != NULL - && ((procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr) - || (ns2NsPtr != NULL && procPtr->cmdPtr->nsPtr == ns2NsPtr) - ) - ) { - /* - * Case A) - * - * - The context, in which this resolver becomes active, is - * determined by the name of the caller proc, which has to be - * named "x". - * - * - To determine the name of the caller proc, the proc is taken - * from the topmost stack frame. - * - * - Note that the context is NOT provided during byte-code - * compilation (e.g. in TclProcCompileProc) - * - * When these conditions hold, this function resolves the - * passed-in cmd literal into a cmd "y", which is taken from the - * the global namespace (for simplicity). - */ - - const char *callingCmdName = - Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr); - - if ( callingCmdName[0] == 'x' && callingCmdName[1] == '\0' ) { - resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY); - } - } else if (callerNsPtr != NULL) { - /* - * Case B) - * - * - The context, in which this resolver becomes active, is - * determined by the name of the parent namespace, which has - * to be named "ctx1" or "ctx2". - * - * - To determine the name of the parent namesace, it is taken - * from the 2nd highest stack frame. - * - * - Note that the context can be provided during byte-code - * compilation (e.g. in TclProcCompileProc) - * - * When these conditions hold, this function resolves the - * passed-in cmd literal into a cmd "y" or "Y" depending on the - * context. The resolved procs are taken from the the global - * namespace (for simplicity). - */ - - CallFrame *parentFramePtr = varFramePtr->callerPtr; - const char *context = parentFramePtr != NULL ? parentFramePtr->nsPtr->name : "(NULL)"; - - if (strcmp(context, "ctx1") == 0 && (name[0] == 'z') && (name[1] == '\0')) { - resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY); - /* fprintf(stderr, "... y ==> %p\n", resolvedCmdPtr);*/ - - } else if (strcmp(context, "ctx2") == 0 && (name[0] == 'z') && (name[1] == '\0')) { - resolvedCmdPtr = Tcl_FindCommand(interp, "Y", NULL, TCL_GLOBAL_ONLY); - /*fprintf(stderr, "... Y ==> %p\n", resolvedCmdPtr);*/ - } - } - - if (resolvedCmdPtr != NULL) { - *rPtr = resolvedCmdPtr; - return TCL_OK; - } + Namespace *ns2NsPtr = (Namespace *) Tcl_FindNamespace(interp, "::ns2", NULL, 0); + + if (procPtr != NULL + && ((procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr) + || (ns2NsPtr != NULL && procPtr->cmdPtr->nsPtr == ns2NsPtr) + ) + ) { + /* + * Case A) + * + * - The context, in which this resolver becomes active, is + * determined by the name of the caller proc, which has to be + * named "x". + * + * - To determine the name of the caller proc, the proc is taken + * from the topmost stack frame. + * + * - Note that the context is NOT provided during byte-code + * compilation (e.g. in TclProcCompileProc) + * + * When these conditions hold, this function resolves the + * passed-in cmd literal into a cmd "y", which is taken from the + * the global namespace (for simplicity). + */ + + const char *callingCmdName = + Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr); + + if ( callingCmdName[0] == 'x' && callingCmdName[1] == '\0' ) { + resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY); + } + } else if (callerNsPtr != NULL) { + /* + * Case B) + * + * - The context, in which this resolver becomes active, is + * determined by the name of the parent namespace, which has + * to be named "ctx1" or "ctx2". + * + * - To determine the name of the parent namesace, it is taken + * from the 2nd highest stack frame. + * + * - Note that the context can be provided during byte-code + * compilation (e.g. in TclProcCompileProc) + * + * When these conditions hold, this function resolves the + * passed-in cmd literal into a cmd "y" or "Y" depending on the + * context. The resolved procs are taken from the the global + * namespace (for simplicity). + */ + + CallFrame *parentFramePtr = varFramePtr->callerPtr; + const char *context = parentFramePtr != NULL ? parentFramePtr->nsPtr->name : "(NULL)"; + + if (strcmp(context, "ctx1") == 0 && (name[0] == 'z') && (name[1] == '\0')) { + resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY); + /* fprintf(stderr, "... y ==> %p\n", resolvedCmdPtr);*/ + + } else if (strcmp(context, "ctx2") == 0 && (name[0] == 'z') && (name[1] == '\0')) { + resolvedCmdPtr = Tcl_FindCommand(interp, "Y", NULL, TCL_GLOBAL_ONLY); + /*fprintf(stderr, "... Y ==> %p\n", resolvedCmdPtr);*/ + } + } + + if (resolvedCmdPtr != NULL) { + *rPtr = resolvedCmdPtr; + return TCL_OK; + } } return TCL_CONTINUE; } @@ -8577,9 +8564,9 @@ HashVarFree( Tcl_Var var) { if (VarHashRefCount(var) < 2) { - ckfree(var); + ckfree(var); } else { - VarHashRefCount(var)--; + VarHashRefCount(var)--; } } @@ -8591,7 +8578,7 @@ MyCompiledVarFree( Tcl_DecrRefCount(resVarInfo->nameObj); if (resVarInfo->var) { - HashVarFree(resVarInfo->var); + HashVarFree(resVarInfo->var); } ckfree(vInfoPtr); } @@ -8611,27 +8598,27 @@ MyCompiledVarFetch( Tcl_HashEntry *hPtr; if (var != NULL) { - if (!(((Var *) var)->flags & VAR_DEAD_HASH)) { - /* - * The cached variable is valid, return it. - */ + if (!(((Var *) var)->flags & VAR_DEAD_HASH)) { + /* + * The cached variable is valid, return it. + */ - return var; - } + return var; + } - /* - * The variable is not valid anymore. Clean it up. - */ + /* + * The variable is not valid anymore. Clean it up. + */ - HashVarFree(var); + HashVarFree(var); } hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) &iPtr->globalNsPtr->varTable, - (char *)resVarInfo->nameObj, &isNewVar); + resVarInfo->nameObj, &isNewVar); if (hPtr) { - var = (Tcl_Var) TclVarHashGetValue(hPtr); + var = (Tcl_Var) TclVarHashGetValue(hPtr); } else { - var = NULL; + var = NULL; } resVarInfo->var = var; @@ -8674,7 +8661,7 @@ TestInterpResolverCmd( Tcl_Obj *const objv[]) { static const char *const table[] = { - "down", "up", NULL + "down", "up", NULL }; int idx; #define RESOLVER_KEY "testInterpResolver" @@ -8691,20 +8678,20 @@ TestInterpResolverCmd( } } if (Tcl_GetIndexFromObj(interp, objv[1], table, "operation", TCL_EXACT, - &idx) != TCL_OK) { - return TCL_ERROR; + &idx) != TCL_OK) { + return TCL_ERROR; } switch (idx) { case 1: /* up */ - Tcl_AddInterpResolvers(interp, RESOLVER_KEY, InterpCmdResolver, - InterpVarResolver, InterpCompiledVarResolver); - break; + Tcl_AddInterpResolvers(interp, RESOLVER_KEY, InterpCmdResolver, + InterpVarResolver, InterpCompiledVarResolver); + break; case 0: /*down*/ - if (!Tcl_RemoveInterpResolvers(interp, RESOLVER_KEY)) { - Tcl_AppendResult(interp, "could not remove the resolver scheme", - (void *)NULL); - return TCL_ERROR; - } + if (!Tcl_RemoveInterpResolvers(interp, RESOLVER_KEY)) { + Tcl_AppendResult(interp, "could not remove the resolver scheme", + (void *)NULL); + return TCL_ERROR; + } } return TCL_OK; } diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 9f31cff..8a9dc7b 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -13,6 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ + #undef BUILD_tcl #ifndef USE_TCL_STUBS # define USE_TCL_STUBS @@ -54,17 +55,24 @@ static Tcl_ObjCmdProc TeststringobjCmd; #define VARPTR_KEY "TCLOBJTEST_VARPTR" #define NUMBER_OF_OBJECT_VARS 20 -static void VarPtrDeleteProc(void *clientData, TCL_UNUSED(Tcl_Interp *)) +static void +VarPtrDeleteProc( + void *clientData, + TCL_UNUSED(Tcl_Interp *)) { int i; Tcl_Obj **varPtr = (Tcl_Obj **) clientData; for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { - if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]); + if (varPtr[i]) { + Tcl_DecrRefCount(varPtr[i]); + } } ckfree(varPtr); } -static Tcl_Obj **GetVarPtr(Tcl_Interp *interp) +static Tcl_Obj ** +GetVarPtr( + Tcl_Interp *interp) { Tcl_InterpDeleteProc *proc; @@ -408,7 +416,7 @@ TestbooleanobjCmd( return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex], - &boolValue) != TCL_OK) { + &boolValue) != TCL_OK) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { @@ -508,7 +516,7 @@ TestdoubleobjCmd( return TCL_ERROR; } if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex], - &doubleValue) != TCL_OK) { + &doubleValue) != TCL_OK) { return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { @@ -947,7 +955,7 @@ TestlistobjCmd( case LISTOBJ_REPLACE: if (objc < 5) { Tcl_WrongNumArgs(interp, 2, objv, - "varIndex start count ?element...?"); + "varIndex start count ?element...?"); return TCL_ERROR; } if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK @@ -959,7 +967,7 @@ TestlistobjCmd( } Tcl_ResetResult(interp); return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count, - objc-5, objv+5); + objc-5, objv+5); case LISTOBJ_INDEXMEMCHECK: if (objc != 3) { @@ -1016,8 +1024,7 @@ TestlistobjCmd( * Hence this explicit test. */ if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, - "varIndex listIndex"); + Tcl_WrongNumArgs(interp, 2, objv, "varIndex listIndex"); return TCL_ERROR; } if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK) { diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index 2139b81..a86499e 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -146,7 +146,7 @@ RegisterCommand( if (cmdTablePtr->exportIt) { snprintf(buf, sizeof(buf), "namespace eval %s { namespace export %s }", namesp, cmdTablePtr->cmdName); - if (Tcl_EvalEx(interp, buf, -1, 0) != TCL_OK) { + if (Tcl_EvalEx(interp, buf, TCL_INDEX_NONE, 0) != TCL_OK) { return TCL_ERROR; } } diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index eb40b3b..3ff3d24 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -202,8 +202,8 @@ TclMacOSXGetFileAttribute( return TCL_OK; #else Tcl_SetObjResult(interp, Tcl_NewStringObj( - "Mac OS X file attributes not supported", -1)); - Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (void *)NULL); + "Mac OS X file attributes not supported", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); return TCL_ERROR; #endif /* HAVE_GETATTRLIST */ } @@ -334,8 +334,8 @@ TclMacOSXSetFileAttribute( if (newRsrcForkSize != 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "setting nonzero rsrclength not supported", -1)); - Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (void *)NULL); + "setting nonzero rsrclength not supported", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); return TCL_ERROR; } @@ -375,8 +375,8 @@ TclMacOSXSetFileAttribute( return TCL_OK; #else Tcl_SetObjResult(interp, Tcl_NewStringObj( - "Mac OS X file attributes not supported", -1)); - Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (void *)NULL); + "Mac OS X file attributes not supported", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); return TCL_ERROR; #endif } @@ -639,15 +639,16 @@ SetOSTypeFromAny( int result = TCL_OK; Tcl_DString ds; Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman"); + Tcl_Size length; - string = TclGetString(objPtr); - Tcl_UtfToExternalDString(encoding, string, objPtr->length, &ds); + string = TclGetStringFromObj(objPtr, &length); + Tcl_UtfToExternalDString(encoding, string, length, &ds); if (Tcl_DStringLength(&ds) > 4) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected Macintosh OS type but got \"%s\": ", string)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", (char *)NULL); } result = TCL_ERROR; } else { diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 515f234..2358d06 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -102,7 +102,7 @@ TclplatformtestInit( Tcl_CreateObjCommand(interp, "testfindexecutable", TestfindexecutableCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testfork", TestforkCmd, - NULL, NULL); + NULL, NULL); Tcl_CreateObjCommand(interp, "testalarm", TestalarmCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testgotsig", TestgotsigCmd, @@ -154,7 +154,7 @@ TestfilehandlerCmd( if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ..."); - return TCL_ERROR; + return TCL_ERROR; } pipePtr = NULL; if (objc >= 3) { @@ -162,7 +162,7 @@ TestfilehandlerCmd( return TCL_ERROR; } if (i >= MAX_PIPES) { - Tcl_AppendResult(interp, "bad index ", objv[2], (void *)NULL); + Tcl_AppendResult(interp, "bad index ", objv[2], (char *)NULL); return TCL_ERROR; } pipePtr = &testPipes[i]; @@ -191,7 +191,7 @@ TestfilehandlerCmd( return TCL_ERROR; } snprintf(buf, sizeof(buf), "%d %d", pipePtr->readCount, pipePtr->writeCount); - Tcl_AppendResult(interp, buf, (void *)NULL); + Tcl_AppendResult(interp, buf, (char *)NULL); } else if (strcmp(Tcl_GetString(objv[1]), "create") == 0) { if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "index readMode writeMode"); @@ -200,7 +200,7 @@ TestfilehandlerCmd( if (pipePtr->readFile == NULL) { if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) { Tcl_AppendResult(interp, "couldn't open pipe: ", - Tcl_PosixError(interp), (void *)NULL); + Tcl_PosixError(interp), (char *)NULL); return TCL_ERROR; } #ifdef O_NONBLOCK @@ -208,7 +208,7 @@ TestfilehandlerCmd( fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK); #else Tcl_AppendResult(interp, "can't make pipes non-blocking", - (void *)NULL); + (char *)NULL); return TCL_ERROR; #endif } @@ -224,7 +224,7 @@ TestfilehandlerCmd( Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0, TestFileHandlerProc, pipePtr); } else { - Tcl_AppendResult(interp, "bad read mode \"", Tcl_GetString(objv[3]), "\"", (void *)NULL); + Tcl_AppendResult(interp, "bad read mode \"", Tcl_GetString(objv[3]), "\"", (char *)NULL); return TCL_ERROR; } if (strcmp(Tcl_GetString(objv[4]), "writable") == 0) { @@ -236,7 +236,7 @@ TestfilehandlerCmd( Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0, TestFileHandlerProc, pipePtr); } else { - Tcl_AppendResult(interp, "bad read mode \"", Tcl_GetString(objv[4]), "\"", (void *)NULL); + Tcl_AppendResult(interp, "bad read mode \"", Tcl_GetString(objv[4]), "\"", (char *)NULL); return TCL_ERROR; } } else if (strcmp(Tcl_GetString(objv[1]), "empty") == 0) { @@ -245,9 +245,9 @@ TestfilehandlerCmd( return TCL_ERROR; } - while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) { + while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) { /* Empty loop body. */ - } + } } else if (strcmp(Tcl_GetString(objv[1]), "fill") == 0) { if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "index"); @@ -268,7 +268,7 @@ TestfilehandlerCmd( memset(buffer, 'b', 10); TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10)); - Tcl_AppendResult(interp, buf, (void *)NULL); + Tcl_AppendResult(interp, buf, (char *)NULL); } else if (strcmp(Tcl_GetString(objv[1]), "oneevent") == 0) { Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT); } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) { @@ -277,7 +277,7 @@ TestfilehandlerCmd( return TCL_ERROR; } if (pipePtr->readFile == NULL) { - Tcl_AppendResult(interp, "pipe ", Tcl_GetString(objv[2]), " doesn't exist", (void *)NULL); + Tcl_AppendResult(interp, "pipe ", Tcl_GetString(objv[2]), " doesn't exist", (char *)NULL); return TCL_ERROR; } if (strcmp(Tcl_GetString(objv[3]), "readable") == 0) { @@ -302,7 +302,7 @@ TestfilehandlerCmd( } else { Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), "\": must be close, clear, counts, create, empty, fill, " - "fillpartial, oneevent, wait, or windowevent", (void *)NULL); + "fillpartial, oneevent, wait, or windowevent", (char *)NULL); return TCL_ERROR; } return TCL_OK; @@ -369,13 +369,13 @@ TestfilewaitCmd( mask = TCL_WRITABLE|TCL_READABLE; } else { Tcl_AppendResult(interp, "bad argument \"", Tcl_GetString(objv[2]), - "\": must be readable, writable, or both", (void *)NULL); + "\": must be readable, writable, or both", (char *)NULL); return TCL_ERROR; } if (Tcl_GetChannelHandle(channel, (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE, (void **) &data) != TCL_OK) { - Tcl_AppendResult(interp, "couldn't get channel file", (void *)NULL); + Tcl_AppendResult(interp, "couldn't get channel file", (char *)NULL); return TCL_ERROR; } fd = PTR2INT(data); @@ -461,14 +461,14 @@ TestforkCmd( pid_t pid; if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, ""); - return TCL_ERROR; + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; } pid = fork(); if (pid == -1) { - Tcl_AppendResult(interp, - "Cannot fork", (void *)NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, + "Cannot fork", (char *)NULL); + return TCL_ERROR; } /* Only needed when pthread_atfork is not present, * should not hurt otherwise. */ @@ -518,11 +518,11 @@ TestalarmCmd( */ action.sa_handler = AlarmHandler; - memset((void *) &action.sa_mask, 0, sizeof(sigset_t)); + memset((void *)&action.sa_mask, 0, sizeof(sigset_t)); action.sa_flags = SA_RESTART; if (sigaction(SIGALRM, &action, NULL) < 0) { - Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), (void *)NULL); + Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), (char *)NULL); return TCL_ERROR; } (void) alarm(sec); @@ -531,7 +531,7 @@ TestalarmCmd( Tcl_AppendResult(interp, "warning: sigaction SA_RESTART not support on this platform", - (void *)NULL); + (char *)NULL); return TCL_ERROR; #endif } @@ -582,7 +582,7 @@ TestgotsigCmd( TCL_UNUSED(int) /*objc*/, TCL_UNUSED(Tcl_Obj *const *)) { - Tcl_AppendResult(interp, gotsig, (void *)NULL); + Tcl_AppendResult(interp, gotsig, (char *)NULL); gotsig = "0"; return TCL_OK; } @@ -634,7 +634,7 @@ TestchmodCmd( } if (chmod(translated, mode) != 0) { Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp), - (void *)NULL); + (char *)NULL); return TCL_ERROR; } Tcl_DStringFree(&buffer); -- cgit v0.12 From ada3e1dce9b00806b46799a2784eeaee6e4d190a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 22 Mar 2024 09:03:38 +0000 Subject: Add testcase for bug [1f40aa83c5]: crash with CFLAGS=-ftrapv --- tests/clock.test | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/clock.test b/tests/clock.test index 51bd89e..b7226db 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18690,6 +18690,10 @@ test clock-6.10 {input of seconds - overflow} { list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result $::errorCode } {1 {integer value too large to represent} {CLOCK dateTooLarge}} +test clock-6.10a {input of seconds - overflow, bug [1f40aa83c5]} knownBug { + list [catch {clock scan 27670116110564327423 -format %s -gmt true} result] $result $::errorCode +} {1 {integer value too large to represent} {CLOCK dateTooLarge}} + test clock-6.11 {input of seconds - two values} { clock scan {1 2} -format {%s %s} -gmt true } 2 -- cgit v0.12 From 42b7f7794dde88e89c5c3721c833f04eabc0f853 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 22 Mar 2024 13:06:51 +0000 Subject: Add more testcases, 0-measurement of current behavior. integervalueTooLarge -> dateTooLarge. --- library/clock.tcl | 2 +- tests/clock.test | 24 ++++++++++++++++++++---- 2 files changed, 21 insertions(+), 5 deletions(-) diff --git a/library/clock.tcl b/library/clock.tcl index b468fea..d80fb2f 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -2683,7 +2683,7 @@ proc ::tcl::clock::ScanWide { str } { "\"$str\" is not an integer" } if { [incr result 0] != $str } { - return -code error -errorcode [list CLOCK integervalueTooLarge] \ + return -code error -errorcode [list CLOCK dateTooLarge] \ "integer value too large to represent" } return $result diff --git a/tests/clock.test b/tests/clock.test index 189b83a..b75237e 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18532,12 +18532,28 @@ test clock-6.8 {input of seconds} { } 9223372036854775807 test clock-6.9 {input of seconds - overflow} { - list [catch {clock scan -9223372036854775809 -format %s -gmt true} result] $result -} {1 {integer value too large to represent}} + list [catch {clock scan -9223372036854775809 -format %s -gmt true} result] $result $::errorCode +} {1 {integer value too large to represent} {CLOCK dateTooLarge}} test clock-6.10 {input of seconds - overflow} { - list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result -} {1 {integer value too large to represent}} + list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result $::errorCode +} {1 {integer value too large to represent} {CLOCK dateTooLarge}} + +test clock-6.10a {input of seconds - overflow, bug [1f40aa83c5]} { + list [catch {clock scan 27670116110564327423 -format %s -gmt true} result] $result $::errorCode +} {1 {integer value too large to represent} {CLOCK dateTooLarge}} + +test clock-6.10b {input of seconds - overflow ??, bug [1f40aa83c5]} { + clock scan 27670116110564327423 -gmt true +} 89170590268800 + +test clock-6.10c {input of seconds - overflow, bug [1f40aa83c5]} { + list [catch {clock scan 27670116110564327424 -format %s -gmt true} result] $result $::errorCode +} {1 {integer value too large to represent} {CLOCK dateTooLarge}} + +test clock-6.10d {input of seconds - overflow ??, bug [1f40aa83c5]} { + clock scan 27670116110564327424 -gmt true +} -90247104115200 test clock-6.11 {input of seconds - two values} { clock scan {1 2} -format {%s %s} -gmt true -- cgit v0.12 From d7ec31013a808f22ead867f83d5d8ddad36d7826 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 22 Mar 2024 13:41:36 +0000 Subject: Mark clock-6.10b/clock-6.10d as "knownBug": Those testcases crash with CFLAGS=-ftrapv, even with current clock code. --- tests/clock.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index b75237e..7cb86a3 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18543,7 +18543,7 @@ test clock-6.10a {input of seconds - overflow, bug [1f40aa83c5]} { list [catch {clock scan 27670116110564327423 -format %s -gmt true} result] $result $::errorCode } {1 {integer value too large to represent} {CLOCK dateTooLarge}} -test clock-6.10b {input of seconds - overflow ??, bug [1f40aa83c5]} { +test clock-6.10b {input of seconds - overflow ??, bug [1f40aa83c5]} knownBug { clock scan 27670116110564327423 -gmt true } 89170590268800 @@ -18551,7 +18551,7 @@ test clock-6.10c {input of seconds - overflow, bug [1f40aa83c5]} { list [catch {clock scan 27670116110564327424 -format %s -gmt true} result] $result $::errorCode } {1 {integer value too large to represent} {CLOCK dateTooLarge}} -test clock-6.10d {input of seconds - overflow ??, bug [1f40aa83c5]} { +test clock-6.10d {input of seconds - overflow ??, bug [1f40aa83c5]} knownBug { clock scan 27670116110564327424 -gmt true } -90247104115200 -- cgit v0.12 From ea2e6b81903423c914c0681ea329adbd7061a3fd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 22 Mar 2024 14:19:54 +0000 Subject: There are no testcases showing overflow in _str2int() --- generic/tclClockFmt.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index ad273d0..9a32721 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -56,11 +56,6 @@ static void ClockFrmScnFinalize(void *clientData); *---------------------------------------------------------------------- */ -/* int overflows may happens here (expected case) */ -#if defined(__GNUC__) || defined(__GNUG__) -# pragma GCC optimize("no-trapv") -#endif - static inline int _str2int( int *out, @@ -90,6 +85,11 @@ _str2int( return TCL_OK; } +/* Tcl_WideInt overflows may happens here (expected case) */ +#if defined(__GNUC__) || defined(__GNUG__) +# pragma GCC optimize("no-trapv") +#endif + static inline int _str2wideInt( Tcl_WideInt *out, -- cgit v0.12 From 730f68f30c3a5c0d8d52ee40de257338c657d927 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 22 Mar 2024 19:15:30 +0000 Subject: fix for [1f40aa83c552f597]: the overflow check could mistakenly pass in some cases (so basically expects div 10 to check it properly); optimizes both str2int, since we don't need to check it for most cases at all, thus definitely faster now (O(n)+O(1) vs. O(n)+O(n) and also has fewer branch mispredictions). --- generic/tclClockFmt.c | 48 +++++++++++++++++++++++++++++++++++------------- tests/clock.test | 43 +++++++++++++++++++++++++------------------ 2 files changed, 60 insertions(+), 31 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 9a32721..d36b4a8 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -56,6 +56,11 @@ static void ClockFrmScnFinalize(void *clientData); *---------------------------------------------------------------------- */ +/* int & Tcl_WideInt overflows may happens here (expected case) */ +#if defined(__GNUC__) || defined(__GNUG__) +# pragma GCC optimize("no-trapv") +#endif + static inline int _str2int( int *out, @@ -64,18 +69,29 @@ _str2int( int sign) { int val = 0, prev = 0; + const char *eNO = e; + /* overflow impossible for 10 digits ("9..9"), so no needs to check before */ + if (e-p > 10) { + eNO = p+10; + } if (sign >= 0) { - while (p < e) { + while (p < eNO) { /* never overflows */ val = val * 10 + (*p++ - '0'); - if (val < prev) { + } + while (p < e) { /* check for overflow */ + val = val * 10 + (*p++ - '0'); + if (val / 10 < prev) { return TCL_ERROR; } prev = val; } } else { - while (p < e) { + while (p < eNO) { /* never overflows */ + val = val * 10 - (*p++ - '0'); + } + while (p < e) { /* check for overflow */ val = val * 10 - (*p++ - '0'); - if (val > prev) { + if (val / 10 > prev) { return TCL_ERROR; } prev = val; @@ -85,11 +101,6 @@ _str2int( return TCL_OK; } -/* Tcl_WideInt overflows may happens here (expected case) */ -#if defined(__GNUC__) || defined(__GNUG__) -# pragma GCC optimize("no-trapv") -#endif - static inline int _str2wideInt( Tcl_WideInt *out, @@ -98,18 +109,29 @@ _str2wideInt( int sign) { Tcl_WideInt val = 0, prev = 0; + const char *eNO = e; + /* overflow impossible for 18 digits ("9..9"), so no needs to check before */ + if (e-p > 18) { + eNO = p+18; + } if (sign >= 0) { - while (p < e) { + while (p < eNO) { /* never overflows */ val = val * 10 + (*p++ - '0'); - if (val < prev) { + } + while (p < e) { /* check for overflow */ + val = val * 10 + (*p++ - '0'); + if (val / 10 < prev) { return TCL_ERROR; } prev = val; } } else { - while (p < e) { + while (p < eNO) { /* never overflows */ + val = val * 10 - (*p++ - '0'); + } + while (p < e) { /* check for overflow */ val = val * 10 - (*p++ - '0'); - if (val > prev) { + if (val / 10 > prev) { return TCL_ERROR; } prev = val; diff --git a/tests/clock.test b/tests/clock.test index a94f854..1a708e7 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18683,28 +18683,35 @@ test clock-6.8 {input of seconds} { } 9223372036854775807 test clock-6.9 {input of seconds - overflow} { - list [catch {clock scan -9223372036854775809 -format %s -gmt true} result] $result $::errorCode + list [catch {clock scan -9223372036854775809 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""] } {1 {integer value too large to represent} {CLOCK dateTooLarge}} - test clock-6.10 {input of seconds - overflow} { - list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result $::errorCode -} {1 {integer value too large to represent} {CLOCK dateTooLarge}} - -test clock-6.10a {input of seconds - overflow, bug [1f40aa83c5]} knownBug { - list [catch {clock scan 27670116110564327423 -format %s -gmt true} result] $result $::errorCode -} {1 {integer value too large to represent} {CLOCK dateTooLarge}} - -test clock-6.10b {input of seconds - overflow ??, bug [1f40aa83c5]} knownBug { - clock scan 27670116110564327423 -gmt true -} 89170590268800 - -test clock-6.10c {input of seconds - overflow, bug [1f40aa83c5]} { - list [catch {clock scan 27670116110564327424 -format %s -gmt true} result] $result $::errorCode + list [catch {clock scan 9223372036854775808 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""] } {1 {integer value too large to represent} {CLOCK dateTooLarge}} -test clock-6.10d {input of seconds - overflow ??, bug [1f40aa83c5]} knownBug { - clock scan 27670116110564327424 -gmt true -} -90247104115200 +foreach sign {{} -} { + test clock-6.10a {input of seconds - overflow, bug [1f40aa83c5]} { + list [catch {clock scan ${sign}27670116110564327423 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""] + } {1 {integer value too large to represent} {CLOCK dateTooLarge}} + test clock-6.10b {input of seconds - overflow, bug [1f40aa83c5]} { + list [catch {clock scan ${sign}27670116110564327424 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""] + } {1 {integer value too large to represent} {CLOCK dateTooLarge}} + test clock-6.10c {input of seconds - no overflow, bug [1f40aa83c5]} { + list [catch {clock scan ${sign}[string repeat 9 18] -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""] + } [list 0 ${sign}[string repeat 9 18] {}] + test clock-6.10d {input of seconds - overflow, bug [1f40aa83c5]} { + list [catch {clock scan ${sign}[string repeat 9 19] -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""] + } {1 {integer value too large to represent} {CLOCK dateTooLarge}} + # both fololowing freescan test don't generate overflow error, + # since it is a free scan, thus the token is simply not recognized further in yacc lexer, + # therefore we get parse error (can be surely changed latter): + test clock-6.10e {input of seconds - overflow (but since freescan parse error, but not boom), bug [1f40aa83c5]} -body { + list [catch {clock scan ${sign}27670116110564327423 -gmt true} result opt] $result [dict getd $opt -errorcode ""] + } -match glob -result {1 {unable to convert date-time string "*": syntax error *} {TCL VALUE DATE PARSE}} + test clock-6.10f {input of seconds - overflow (but since freescan parse error, but not boom), bug [1f40aa83c5]} -body { + list [catch {clock scan ${sign}27670116110564327424 -gmt true} result opt] $result [dict getd $opt -errorcode ""] + } -match glob -result {1 {unable to convert date-time string "*": syntax error *} {TCL VALUE DATE PARSE}} +}; unset sign test clock-6.11 {input of seconds - two values} { clock scan {1 2} -format {%s %s} -gmt true -- cgit v0.12 From f6bc0e3bf58345986684a7f8c43bbb7aa5e06e2d Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 22 Mar 2024 20:07:26 +0000 Subject: small amend (unsaved change) --- generic/tclClockFmt.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index d36b4a8..76af74c 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -79,22 +79,22 @@ _str2int( val = val * 10 + (*p++ - '0'); } while (p < e) { /* check for overflow */ + prev = val; val = val * 10 + (*p++ - '0'); if (val / 10 < prev) { return TCL_ERROR; } - prev = val; } } else { while (p < eNO) { /* never overflows */ val = val * 10 - (*p++ - '0'); } while (p < e) { /* check for overflow */ + prev = val; val = val * 10 - (*p++ - '0'); if (val / 10 > prev) { return TCL_ERROR; } - prev = val; } } *out = val; @@ -119,22 +119,22 @@ _str2wideInt( val = val * 10 + (*p++ - '0'); } while (p < e) { /* check for overflow */ + prev = val; val = val * 10 + (*p++ - '0'); if (val / 10 < prev) { return TCL_ERROR; } - prev = val; } } else { while (p < eNO) { /* never overflows */ val = val * 10 - (*p++ - '0'); } while (p < e) { /* check for overflow */ + prev = val; val = val * 10 - (*p++ - '0'); if (val / 10 > prev) { return TCL_ERROR; } - prev = val; } } *out = val; -- cgit v0.12 From fed7903c6c96af171b9e490278380c744925e166 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 23 Mar 2024 13:28:46 +0000 Subject: Revise clock-6.10c? testcases --- tests/clock.test | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index 7cb86a3..1db5af8 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -18532,27 +18532,25 @@ test clock-6.8 {input of seconds} { } 9223372036854775807 test clock-6.9 {input of seconds - overflow} { - list [catch {clock scan -9223372036854775809 -format %s -gmt true} result] $result $::errorCode + list [catch {clock scan -9223372036854775809 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""] } {1 {integer value too large to represent} {CLOCK dateTooLarge}} - test clock-6.10 {input of seconds - overflow} { - list [catch {clock scan 9223372036854775808 -format %s -gmt true} result] $result $::errorCode -} {1 {integer value too large to represent} {CLOCK dateTooLarge}} - -test clock-6.10a {input of seconds - overflow, bug [1f40aa83c5]} { - list [catch {clock scan 27670116110564327423 -format %s -gmt true} result] $result $::errorCode + list [catch {clock scan 9223372036854775808 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""] } {1 {integer value too large to represent} {CLOCK dateTooLarge}} -test clock-6.10b {input of seconds - overflow ??, bug [1f40aa83c5]} knownBug { +foreach sign {{} -} { + test clock-6.10a$sign {input of seconds - overflow, bug [1f40aa83c5]} { + list [catch {clock scan ${sign}27670116110564327423 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""] + } {1 {integer value too large to represent} {CLOCK dateTooLarge}} + test clock-6.10b$sign {input of seconds - overflow, bug [1f40aa83c5]} { + list [catch {clock scan ${sign}27670116110564327424 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""] + } {1 {integer value too large to represent} {CLOCK dateTooLarge}} +}; unset sign +test clock-6.10c {input of seconds - overflow ??, bug [1f40aa83c5]} knownBug { clock scan 27670116110564327423 -gmt true } 89170590268800 - -test clock-6.10c {input of seconds - overflow, bug [1f40aa83c5]} { - list [catch {clock scan 27670116110564327424 -format %s -gmt true} result] $result $::errorCode -} {1 {integer value too large to represent} {CLOCK dateTooLarge}} - test clock-6.10d {input of seconds - overflow ??, bug [1f40aa83c5]} knownBug { - clock scan 27670116110564327424 -gmt true + clock scan 27670116110564327424 -gmt true } -90247104115200 test clock-6.11 {input of seconds - two values} { -- cgit v0.12 From d3d3b26765ba609cc97692ab6a82bed93905768f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 23 Mar 2024 18:17:28 +0000 Subject: Backport formatting from 9.0. Revise genStubs.tcl such that dummy entries are only generated for Tcl 8.x, not for 9.0 --- generic/tclTest.c | 396 +++++++++++++++++++++++++-------------------------- tools/genStubs.tcl | 4 +- unix/dltest/pkgb.c | 2 +- unix/dltest/pkgooa.c | 6 +- unix/tclLoadDl.c | 2 +- unix/tclLoadDyld.c | 2 +- unix/tclLoadNext.c | 2 +- unix/tclLoadOSF.c | 2 +- unix/tclXtTest.c | 2 +- win/tclWinDde.c | 18 +-- win/tclWinLoad.c | 14 +- win/tclWinReg.c | 6 +- 12 files changed, 228 insertions(+), 228 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index ddc6024..007d51a 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -879,7 +879,7 @@ TestasyncCmd( if (argc < 2) { wrongNumArgs: - Tcl_AppendResult(interp, "wrong # args", (void *)NULL); + Tcl_AppendResult(interp, "wrong # args", (char *)NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { @@ -967,7 +967,7 @@ TestasyncCmd( if (Tcl_CreateThread(&threadID, AsyncThreadProc, INT2PTR(id), TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) { - Tcl_AppendResult(interp, "can't create thread", (void *)NULL); + Tcl_AppendResult(interp, "can't create thread", (char *)NULL); Tcl_MutexUnlock(&asyncTestMutex); return TCL_ERROR; } @@ -977,7 +977,7 @@ TestasyncCmd( Tcl_MutexUnlock(&asyncTestMutex); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be create, delete, int, mark, or marklater", (void *)NULL); + "\": must be create, delete, int, mark, or marklater", (char *)NULL); return TCL_ERROR; } return TCL_OK; @@ -1137,34 +1137,34 @@ TestcmdinfoObjCmd( break; case CMDINFO_GET: if (Tcl_GetCommandInfo(interp, Tcl_GetString(objv[2]), &info) ==0) { - Tcl_AppendResult(interp, "??", (void *)NULL); + Tcl_AppendResult(interp, "??", (char *)NULL); return TCL_OK; } if (info.proc == CmdProc1) { Tcl_AppendResult(interp, "CmdProc1", " ", - (char *) info.clientData, (void *)NULL); + (char *) info.clientData, (char *)NULL); } else if (info.proc == CmdProc2) { Tcl_AppendResult(interp, "CmdProc2", " ", - (char *) info.clientData, (void *)NULL); + (char *) info.clientData, (char *)NULL); } else { - Tcl_AppendResult(interp, "unknown", (void *)NULL); + Tcl_AppendResult(interp, "unknown", (char *)NULL); } if (info.deleteProc == CmdDelProc1) { Tcl_AppendResult(interp, " CmdDelProc1", " ", - (char *) info.deleteData, (void *)NULL); + (char *) info.deleteData, (char *)NULL); } else if (info.deleteProc == CmdDelProc2) { Tcl_AppendResult(interp, " CmdDelProc2", " ", - (char *) info.deleteData, (void *)NULL); + (char *) info.deleteData, (char *)NULL); } else { - Tcl_AppendResult(interp, " unknown", (void *)NULL); + Tcl_AppendResult(interp, " unknown", (char *)NULL); } - Tcl_AppendResult(interp, " ", info.namespacePtr->fullName, (void *)NULL); + Tcl_AppendResult(interp, " ", info.namespacePtr->fullName, (char *)NULL); if (info.isNativeObjectProc == 0) { - Tcl_AppendResult(interp, " stringProc", (void *)NULL); + Tcl_AppendResult(interp, " stringProc", (char *)NULL); } else if (info.isNativeObjectProc == 1) { - Tcl_AppendResult(interp, " nativeObjectProc", (void *)NULL); + Tcl_AppendResult(interp, " nativeObjectProc", (char *)NULL); } else if (info.isNativeObjectProc == 2) { - Tcl_AppendResult(interp, " nativeObjectProc2", (void *)NULL); + Tcl_AppendResult(interp, " nativeObjectProc2", (char *)NULL); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid isNativeObjectProc value %d", info.isNativeObjectProc)); @@ -1200,7 +1200,7 @@ CmdProc0( TCL_UNUSED(const char **) /*argv*/) { TestCommandTokenRef *refPtr = (TestCommandTokenRef *) clientData; - Tcl_AppendResult(interp, "CmdProc1 ", refPtr->value, (void *)NULL); + Tcl_AppendResult(interp, "CmdProc1 ", refPtr->value, (char *)NULL); return TCL_OK; } @@ -1211,7 +1211,7 @@ CmdProc1( TCL_UNUSED(int) /*argc*/, TCL_UNUSED(const char **) /*argv*/) { - Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData, (void *)NULL); + Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData, (char *)NULL); return TCL_OK; } @@ -1222,7 +1222,7 @@ CmdProc2( TCL_UNUSED(int) /*argc*/, TCL_UNUSED(const char **) /*argv*/) { - Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData, (void *)NULL); + Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData, (char *)NULL); return TCL_OK; } @@ -1296,7 +1296,7 @@ TestcmdtokenCmd( if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option arg\"", (void *)NULL); + " option arg\"", (char *)NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { @@ -1309,11 +1309,11 @@ TestcmdtokenCmd( refPtr->nextPtr = firstCommandTokenRef; firstCommandTokenRef = refPtr; snprintf(buf, sizeof(buf), "%d", refPtr->id); - Tcl_AppendResult(interp, buf, (void *)NULL); + Tcl_AppendResult(interp, buf, (char *)NULL); } else { if (sscanf(argv[2], "%d", &id) != 1) { Tcl_AppendResult(interp, "bad command token \"", argv[2], - "\"", (void *)NULL); + "\"", (char *)NULL); return TCL_ERROR; } @@ -1326,7 +1326,7 @@ TestcmdtokenCmd( if (refPtr == NULL) { Tcl_AppendResult(interp, "bad command token \"", argv[2], - "\"", (void *)NULL); + "\"", (char *)NULL); return TCL_ERROR; } @@ -1342,7 +1342,7 @@ TestcmdtokenCmd( Tcl_DecrRefCount(objPtr); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be create, name, or free", (void *)NULL); + "\": must be create, name, or free", (char *)NULL); return TCL_ERROR; } } @@ -1380,7 +1380,7 @@ TestcmdtraceCmd( if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option script\"", (void *)NULL); + " option script\"", (char *)NULL); return TCL_ERROR; } @@ -1390,7 +1390,7 @@ TestcmdtraceCmd( result = Tcl_EvalEx(interp, argv[2], TCL_INDEX_NONE, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), (void *)NULL); + Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), (char *)NULL); } Tcl_DeleteTrace(interp, cmdTrace); Tcl_DStringFree(&buffer); @@ -1412,7 +1412,7 @@ TestcmdtraceCmd( result = Tcl_EvalEx(interp, argv[2], TCL_INDEX_NONE, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), (void *)NULL); + Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), (char *)NULL); } Tcl_DeleteTrace(interp, cmdTrace); Tcl_DStringFree(&buffer); @@ -1430,7 +1430,7 @@ TestcmdtraceCmd( result = Tcl_EvalEx(interp, argv[2], TCL_INDEX_NONE, 0); Tcl_DeleteTrace(interp, cmdTrace); if (!deleteCalled) { - Tcl_AppendResult(interp, "Delete wasn't called", (void *)NULL); + Tcl_AppendResult(interp, "Delete wasn't called", (char *)NULL); return TCL_ERROR; } else { return result; @@ -1444,14 +1444,14 @@ TestcmdtraceCmd( result = Tcl_EvalEx(interp, argv[2], TCL_INDEX_NONE, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), (void *)NULL); + Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), (char *)NULL); } Tcl_DeleteTrace(interp, t2); Tcl_DeleteTrace(interp, t1); Tcl_DStringFree(&buffer); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be tracetest, deletetest, doubletest or resulttest", (void *)NULL); + "\": must be tracetest, deletetest, doubletest or resulttest", (char *)NULL); return TCL_ERROR; } return TCL_OK; @@ -1569,7 +1569,7 @@ TestcreatecommandCmd( { if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option\"", (void *)NULL); + " option\"", (char *)NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { @@ -1584,7 +1584,7 @@ TestcreatecommandCmd( Tcl_DeleteCommand(interp, "value:at:"); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be create, delete, create2, or delete2", (void *)NULL); + "\": must be create, delete, create2, or delete2", (char *)NULL); return TCL_ERROR; } return TCL_OK; @@ -1604,11 +1604,11 @@ CreatedCommandProc( &info); if (!found) { Tcl_AppendResult(interp, "CreatedCommandProc could not get command info for test_ns_basic::createdcommand", - (void *)NULL); + (char *)NULL); return TCL_ERROR; } Tcl_AppendResult(interp, "CreatedCommandProc in ", - info.namespacePtr->fullName, (void *)NULL); + info.namespacePtr->fullName, (char *)NULL); return TCL_OK; } @@ -1625,11 +1625,11 @@ CreatedCommandProc2( found = Tcl_GetCommandInfo(interp, "value:at:", &info); if (!found) { Tcl_AppendResult(interp, "CreatedCommandProc2 could not get command info for test_ns_basic::createdcommand", - (void *)NULL); + (char *)NULL); return TCL_ERROR; } Tcl_AppendResult(interp, "CreatedCommandProc2 in ", - info.namespacePtr->fullName, (void *)NULL); + info.namespacePtr->fullName, (char *)NULL); return TCL_OK; } @@ -1725,7 +1725,7 @@ TestdelCmd( Tcl_Interp *child; if (argc != 4) { - Tcl_AppendResult(interp, "wrong # args", (void *)NULL); + Tcl_AppendResult(interp, "wrong # args", (char *)NULL); return TCL_ERROR; } @@ -1753,7 +1753,7 @@ DelCmdProc( { DelCmd *dPtr = (DelCmd *) clientData; - Tcl_AppendResult(interp, dPtr->deleteCmd, (void *)NULL); + Tcl_AppendResult(interp, dPtr->deleteCmd, (char *)NULL); ckfree(dPtr->deleteCmd); ckfree(dPtr); return TCL_OK; @@ -1798,7 +1798,7 @@ TestdelassocdataCmd( { if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " data_key\"", (void *)NULL); + " data_key\"", (char *)NULL); return TCL_ERROR; } Tcl_DeleteAssocData(interp, argv[1]); @@ -1924,7 +1924,7 @@ TestdstringCmd( if (argc < 2) { wrongNumArgs: - Tcl_AppendResult(interp, "wrong # args", (void *)NULL); + Tcl_AppendResult(interp, "wrong # args", (char *)NULL); return TCL_ERROR; } if (strcmp(argv[1], "append") == 0) { @@ -1960,9 +1960,9 @@ TestdstringCmd( goto wrongNumArgs; } if (strcmp(argv[2], "staticsmall") == 0) { - Tcl_AppendResult(interp, "short", (void *)NULL); + Tcl_AppendResult(interp, "short", (char *)NULL); } else if (strcmp(argv[2], "staticlarge") == 0) { - Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", (void *)NULL); + Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", (char *)NULL); } else if (strcmp(argv[2], "free") == 0) { char *s = (char *)ckalloc(100); strcpy(s, "This is a malloc-ed string"); @@ -1974,7 +1974,7 @@ TestdstringCmd( } else { Tcl_AppendResult(interp, "bad gresult option \"", argv[2], "\": must be staticsmall, staticlarge, free, or special", - (void *)NULL); + (char *)NULL); return TCL_ERROR; } Tcl_DStringGetResult(interp, &dstring); @@ -2010,7 +2010,7 @@ TestdstringCmd( } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be append, element, end, free, get, gresult, length, " - "result, start, toobj, or trunc", (void *)NULL); + "result, start, toobj, or trunc", (char *)NULL); return TCL_ERROR; } return TCL_OK; @@ -2466,7 +2466,7 @@ TestevalexObjCmd( const char *global = Tcl_GetString(objv[2]); if (strcmp(global, "global") != 0) { Tcl_AppendResult(interp, "bad value \"", global, - "\": must be global", (void *)NULL); + "\": must be global", (char *)NULL); return TCL_ERROR; } flags = TCL_EVAL_GLOBAL; @@ -2735,7 +2735,7 @@ TestexithandlerCmd( if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " create|delete value\"", (void *)NULL); + " create|delete value\"", (char *)NULL); return TCL_ERROR; } if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) { @@ -2749,7 +2749,7 @@ TestexithandlerCmd( INT2PTR(value)); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be create or delete", (void *)NULL); + "\": must be create or delete", (char *)NULL); return TCL_ERROR; } return TCL_OK; @@ -2813,16 +2813,16 @@ TestexprlongCmd( if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " expression\"", (void *)NULL); + " expression\"", (char *)NULL); return TCL_ERROR; } - Tcl_AppendResult(interp, "This is a result", (void *)NULL); + Tcl_AppendResult(interp, "This is a result", (char *)NULL); result = Tcl_ExprLong(interp, argv[1], &exprResult); if (result != TCL_OK) { return result; } snprintf(buf, sizeof(buf), ": %ld", exprResult); - Tcl_AppendResult(interp, buf, (void *)NULL); + Tcl_AppendResult(interp, buf, (char *)NULL); return TCL_OK; } @@ -2858,13 +2858,13 @@ TestexprlongobjCmd( Tcl_WrongNumArgs(interp, 1, objv, "expression"); return TCL_ERROR; } - Tcl_AppendResult(interp, "This is a result", (void *)NULL); + Tcl_AppendResult(interp, "This is a result", (char *)NULL); result = Tcl_ExprLongObj(interp, objv[1], &exprResult); if (result != TCL_OK) { return result; } snprintf(buf, sizeof(buf), ": %ld", exprResult); - Tcl_AppendResult(interp, buf, (void *)NULL); + Tcl_AppendResult(interp, buf, (char *)NULL); return TCL_OK; } @@ -2898,17 +2898,17 @@ TestexprdoubleCmd( if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " expression\"", (void *)NULL); + " expression\"", (char *)NULL); return TCL_ERROR; } - Tcl_AppendResult(interp, "This is a result", (void *)NULL); + Tcl_AppendResult(interp, "This is a result", (char *)NULL); result = Tcl_ExprDouble(interp, argv[1], &exprResult); if (result != TCL_OK) { return result; } strcpy(buf, ": "); Tcl_PrintDouble(interp, exprResult, buf+2); - Tcl_AppendResult(interp, buf, (void *)NULL); + Tcl_AppendResult(interp, buf, (char *)NULL); return TCL_OK; } @@ -2944,14 +2944,14 @@ TestexprdoubleobjCmd( Tcl_WrongNumArgs(interp, 1, objv, "expression"); return TCL_ERROR; } - Tcl_AppendResult(interp, "This is a result", (void *)NULL); + Tcl_AppendResult(interp, "This is a result", (char *)NULL); result = Tcl_ExprDoubleObj(interp, objv[1], &exprResult); if (result != TCL_OK) { return result; } strcpy(buf, ": "); Tcl_PrintDouble(interp, exprResult, buf+2); - Tcl_AppendResult(interp, buf, (void *)NULL); + Tcl_AppendResult(interp, buf, (char *)NULL); return TCL_OK; } @@ -2980,7 +2980,7 @@ TestexprstringCmd( { if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " expression\"", (void *)NULL); + " expression\"", (char *)NULL); return TCL_ERROR; } return Tcl_ExprString(interp, argv[1]); @@ -3029,7 +3029,7 @@ TestfilelinkCmd( Tcl_AppendResult(interp, "could not create link from \"", Tcl_GetString(objv[1]), "\" to \"", Tcl_GetString(objv[2]), "\": ", - Tcl_PosixError(interp), (void *)NULL); + Tcl_PosixError(interp), (char *)NULL); return TCL_ERROR; } } else { @@ -3038,7 +3038,7 @@ TestfilelinkCmd( if (contents == NULL) { Tcl_AppendResult(interp, "could not read link \"", Tcl_GetString(objv[1]), "\": ", - Tcl_PosixError(interp), (void *)NULL); + Tcl_PosixError(interp), (char *)NULL); return TCL_ERROR; } } @@ -3081,12 +3081,12 @@ TestgetassocdataCmd( if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " data_key\"", (void *)NULL); + " data_key\"", (char *)NULL); return TCL_ERROR; } res = (char *) Tcl_GetAssocData(interp, argv[1], NULL); if (res != NULL) { - Tcl_AppendResult(interp, res, (void *)NULL); + Tcl_AppendResult(interp, res, (char *)NULL); } return TCL_OK; } @@ -3122,11 +3122,11 @@ TestgetplatformCmd( if (argc != 1) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - (void *)NULL); + (char *)NULL); return TCL_ERROR; } - Tcl_AppendResult(interp, platformStrings[*platform], (void *)NULL); + Tcl_AppendResult(interp, platformStrings[*platform], (char *)NULL); return TCL_OK; } @@ -3159,7 +3159,7 @@ TestinterpdeleteCmd( if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " path\"", (void *)NULL); + " path\"", (char *)NULL); return TCL_ERROR; } childToDelete = Tcl_GetChild(interp, argv[1]); @@ -3217,7 +3217,7 @@ TestlinkCmd( if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " option ?arg arg arg arg arg arg arg arg arg arg arg arg" - " arg arg?\"", (void *)NULL); + " arg arg?\"", (char *)NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { @@ -3225,7 +3225,7 @@ TestlinkCmd( Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ", argv[1], " intRO realRO boolRO stringRO wideRO charRO ucharRO shortRO" - " ushortRO uintRO longRO ulongRO floatRO uwideRO\"", (void *)NULL); + " ushortRO uintRO longRO ulongRO floatRO uwideRO\"", (char *)NULL); return TCL_ERROR; } if (created) { @@ -3434,7 +3434,7 @@ TestlinkCmd( argv[0], " ", argv[1], " intValue realValue boolValue stringValue wideValue" " charValue ucharValue shortValue ushortValue uintValue" - " longValue ulongValue floatValue uwideValue\"", (void *)NULL); + " longValue ulongValue floatValue uwideValue\"", (char *)NULL); return TCL_ERROR; } if (argv[2][0] != 0) { @@ -3538,7 +3538,7 @@ TestlinkCmd( argv[0], " ", argv[1], " intValue realValue boolValue stringValue wideValue" " charValue ucharValue shortValue ushortValue uintValue" - " longValue ulongValue floatValue uwideValue\"", (void *)NULL); + " longValue ulongValue floatValue uwideValue\"", (char *)NULL); return TCL_ERROR; } if (argv[2][0] != 0) { @@ -3650,7 +3650,7 @@ TestlinkCmd( } } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": should be create, delete, get, set, or update", (void *)NULL); + "\": should be create, delete, get, set, or update", (char *)NULL); return TCL_ERROR; } return TCL_OK; @@ -3849,7 +3849,7 @@ TestlistrepCmd( } resultObj = TclListTestObj(length, leadSpace, endSpace); if (resultObj == NULL) { - Tcl_AppendResult(interp, "List capacity exceeded", (void *)NULL); + Tcl_AppendResult(interp, "List capacity exceeded", (char *)NULL); return TCL_ERROR; } } @@ -4545,7 +4545,7 @@ TestregexpObjCmd( value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", - varName, "\"", (void *)NULL); + varName, "\"", (char *)NULL); return TCL_ERROR; } } else if (cflags & TCL_REG_CANMATCH) { @@ -4559,7 +4559,7 @@ TestregexpObjCmd( value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", - varName, "\"", (void *)NULL); + varName, "\"", (char *)NULL); return TCL_ERROR; } } @@ -4780,7 +4780,7 @@ TestsetassocdataCmd( if (argc != 3) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " data_key data_item\"", (void *)NULL); + " data_key data_item\"", (char *)NULL); return TCL_ERROR; } @@ -4833,7 +4833,7 @@ TestsetplatformCmd( if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], - " platform\"", (void *)NULL); + " platform\"", (char *)NULL); return TCL_ERROR; } @@ -4844,7 +4844,7 @@ TestsetplatformCmd( *platform = TCL_PLATFORM_WINDOWS; } else { Tcl_AppendResult(interp, "unsupported platform: should be one of " - "unix, or windows", (void *)NULL); + "unix, or windows", (char *)NULL); return TCL_ERROR; } return TCL_OK; @@ -4879,7 +4879,7 @@ TeststaticlibraryCmd( if (argc != 4) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " prefix safe loaded\"", (void *)NULL); + argv[0], " prefix safe loaded\"", (char *)NULL); return TCL_ERROR; } if (Tcl_GetInt(interp, argv[2], &safe) != TCL_OK) { @@ -4931,14 +4931,14 @@ TesttranslatefilenameCmd( if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " path\"", (void *)NULL); + argv[0], " path\"", (char *)NULL); return TCL_ERROR; } result = Tcl_TranslateFileName(interp, argv[1], &buffer); if (result == NULL) { return TCL_ERROR; } - Tcl_AppendResult(interp, result, (void *)NULL); + Tcl_AppendResult(interp, result, (char *)NULL); Tcl_DStringFree(&buffer); return TCL_OK; } @@ -4971,7 +4971,7 @@ TestupvarCmd( if ((argc != 5) && (argc != 6)) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", - argv[0], " level name ?name2? dest global\"", (void *)NULL); + argv[0], " level name ?name2? dest global\"", (char *)NULL); return TCL_ERROR; } @@ -5020,28 +5020,28 @@ TestseterrorcodeCmd( const char **argv) /* Argument strings. */ { if (argc > 6) { - Tcl_AppendResult(interp, "too many args", (void *)NULL); + Tcl_AppendResult(interp, "too many args", (char *)NULL); return TCL_ERROR; } switch (argc) { case 1: - Tcl_SetErrorCode(interp, "NONE", (void *)NULL); + Tcl_SetErrorCode(interp, "NONE", (char *)NULL); break; case 2: - Tcl_SetErrorCode(interp, argv[1], (void *)NULL); + Tcl_SetErrorCode(interp, argv[1], (char *)NULL); break; case 3: - Tcl_SetErrorCode(interp, argv[1], argv[2], (void *)NULL); + Tcl_SetErrorCode(interp, argv[1], argv[2], (char *)NULL); break; case 4: - Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], (void *)NULL); + Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], (char *)NULL); break; case 5: - Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], (void *)NULL); + Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], (char *)NULL); break; case 6: Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], - argv[5], (void *)NULL); + argv[5], (char *)NULL); } return TCL_ERROR; } @@ -5105,13 +5105,13 @@ TestfeventCmd( if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option ?arg ...?", (void *)NULL); + " option ?arg ...?", (char *)NULL); return TCL_ERROR; } if (strcmp(argv[1], "cmd") == 0) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " cmd script", (void *)NULL); + " cmd script", (char *)NULL); return TCL_ERROR; } if (interp2 != NULL) { @@ -5121,7 +5121,7 @@ TestfeventCmd( } else { Tcl_AppendResult(interp, "called \"testfevent code\" before \"testfevent create\"", - (void *)NULL); + (char *)NULL); return TCL_ERROR; } } else if (strcmp(argv[1], "create") == 0) { @@ -5237,11 +5237,11 @@ TestfileCmd( if (result != TCL_OK) { if (error != NULL) { if (Tcl_GetString(error)[0] != '\0') { - Tcl_AppendResult(interp, Tcl_GetString(error), " ", (void *)NULL); + Tcl_AppendResult(interp, Tcl_GetString(error), " ", (char *)NULL); } Tcl_DecrRefCount(error); } - Tcl_AppendResult(interp, Tcl_ErrnoId(), (void *)NULL); + Tcl_AppendResult(interp, Tcl_ErrnoId(), (char *)NULL); } end: @@ -5682,7 +5682,7 @@ TestsetbytearraylengthObjCmd( if (obj != objv[1]) { Tcl_DecrRefCount(obj); } - Tcl_AppendResult(interp, "expected bytes", (void *)NULL); + Tcl_AppendResult(interp, "expected bytes", (char *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, obj); @@ -5730,7 +5730,7 @@ TestbytestringObjCmd( } if (x.m != 1) { - Tcl_AppendResult(interp, "Tcl_GetBytesFromObj() overwrites variable", (void *)NULL); + Tcl_AppendResult(interp, "Tcl_GetBytesFromObj() overwrites variable", (char *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj(p, x.n)); @@ -5802,7 +5802,7 @@ TestsetCmd( const char *value; if (argc == 2) { - Tcl_AppendResult(interp, "before get", (void *)NULL); + Tcl_AppendResult(interp, "before get", (char *)NULL); value = Tcl_GetVar2(interp, argv[1], NULL, flags); if (value == NULL) { return TCL_ERROR; @@ -5810,7 +5810,7 @@ TestsetCmd( Tcl_AppendElement(interp, value); return TCL_OK; } else if (argc == 3) { - Tcl_AppendResult(interp, "before set", (void *)NULL); + Tcl_AppendResult(interp, "before set", (char *)NULL); value = Tcl_SetVar2(interp, argv[1], NULL, argv[2], flags); if (value == NULL) { return TCL_ERROR; @@ -5819,7 +5819,7 @@ TestsetCmd( return TCL_OK; } else { Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " varName ?newValue?\"", (void *)NULL); + argv[0], " varName ?newValue?\"", (char *)NULL); return TCL_ERROR; } } @@ -5834,7 +5834,7 @@ Testset2Cmd( const char *value; if (argc == 3) { - Tcl_AppendResult(interp, "before get", (void *)NULL); + Tcl_AppendResult(interp, "before get", (char *)NULL); value = Tcl_GetVar2(interp, argv[1], argv[2], flags); if (value == NULL) { return TCL_ERROR; @@ -5842,7 +5842,7 @@ Testset2Cmd( Tcl_AppendElement(interp, value); return TCL_OK; } else if (argc == 4) { - Tcl_AppendResult(interp, "before set", (void *)NULL); + Tcl_AppendResult(interp, "before set", (char *)NULL); value = Tcl_SetVar2(interp, argv[1], argv[2], argv[3], flags); if (value == NULL) { return TCL_ERROR; @@ -5851,7 +5851,7 @@ Testset2Cmd( return TCL_OK; } else { Tcl_AppendResult(interp, "wrong # args: should be \"", - argv[0], " varName elemName ?newValue?\"", (void *)NULL); + argv[0], " varName elemName ?newValue?\"", (char *)NULL); return TCL_ERROR; } } @@ -5912,10 +5912,10 @@ TestsaveresultCmd( objPtr = NULL; switch ((enum options) index) { case RESULT_SMALL: - Tcl_AppendResult(interp, "small result", (void *)NULL); + Tcl_AppendResult(interp, "small result", (char *)NULL); break; case RESULT_APPEND: - Tcl_AppendResult(interp, "append result", (void *)NULL); + Tcl_AppendResult(interp, "append result", (char *)NULL); break; case RESULT_FREE: { char *buf = (char *)ckalloc(200); @@ -6023,7 +6023,7 @@ TestmainthreadCmd( Tcl_SetObjResult(interp, idObj); return TCL_OK; } else { - Tcl_AppendResult(interp, "wrong # args", (void *)NULL); + Tcl_AppendResult(interp, "wrong # args", (char *)NULL); return TCL_ERROR; } } @@ -6149,7 +6149,7 @@ TestChannelCmd( if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " subcommand ?additional args..?\"", (void *)NULL); + " subcommand ?additional args..?\"", (char *)NULL); return TCL_ERROR; } cmdName = argv[1]; @@ -6232,7 +6232,7 @@ TestChannelCmd( if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " cut channelName\"", (void *)NULL); + " cut channelName\"", (char *)NULL); return TCL_ERROR; } @@ -6255,7 +6255,7 @@ TestChannelCmd( (strncmp(cmdName, "clearchannelhandlers", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " clearchannelhandlers channelName\"", (void *)NULL); + " clearchannelhandlers channelName\"", (char *)NULL); return TCL_ERROR; } Tcl_ClearChannelHandlers(chan); @@ -6265,7 +6265,7 @@ TestChannelCmd( if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " info channelName\"", (void *)NULL); + " info channelName\"", (char *)NULL); return TCL_ERROR; } Tcl_AppendElement(interp, argv[2]); @@ -6357,40 +6357,40 @@ TestChannelCmd( if ((cmdName[0] == 'i') && (strncmp(cmdName, "inputbuffered", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); + Tcl_AppendResult(interp, "channel name required", (char *)NULL); return TCL_ERROR; } IOQueued = Tcl_InputBuffered(chan); TclFormatInt(buf, IOQueued); - Tcl_AppendResult(interp, buf, (void *)NULL); + Tcl_AppendResult(interp, buf, (char *)NULL); return TCL_OK; } if ((cmdName[0] == 'i') && (strncmp(cmdName, "isshared", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); + Tcl_AppendResult(interp, "channel name required", (char *)NULL); return TCL_ERROR; } TclFormatInt(buf, Tcl_IsChannelShared(chan)); - Tcl_AppendResult(interp, buf, (void *)NULL); + Tcl_AppendResult(interp, buf, (char *)NULL); return TCL_OK; } if ((cmdName[0] == 'i') && (strncmp(cmdName, "isstandard", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); + Tcl_AppendResult(interp, "channel name required", (char *)NULL); return TCL_ERROR; } TclFormatInt(buf, Tcl_IsStandardChannel(chan)); - Tcl_AppendResult(interp, buf, (void *)NULL); + Tcl_AppendResult(interp, buf, (char *)NULL); return TCL_OK; } if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); + Tcl_AppendResult(interp, "channel name required", (char *)NULL); return TCL_ERROR; } @@ -6409,7 +6409,7 @@ TestChannelCmd( if ((cmdName[0] == 'm') && (strncmp(cmdName, "maxmode", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); + Tcl_AppendResult(interp, "channel name required", (char *)NULL); return TCL_ERROR; } @@ -6428,7 +6428,7 @@ TestChannelCmd( if ((cmdName[0] == 'm') && (strncmp(cmdName, "mremove-rd", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); + Tcl_AppendResult(interp, "channel name required", (char *)NULL); return TCL_ERROR; } @@ -6437,7 +6437,7 @@ TestChannelCmd( if ((cmdName[0] == 'm') && (strncmp(cmdName, "mremove-wr", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); + Tcl_AppendResult(interp, "channel name required", (char *)NULL); return TCL_ERROR; } @@ -6446,7 +6446,7 @@ TestChannelCmd( if ((cmdName[0] == 'm') && (strncmp(cmdName, "mthread", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); + Tcl_AppendResult(interp, "channel name required", (char *)NULL); return TCL_ERROR; } @@ -6457,10 +6457,10 @@ TestChannelCmd( if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); + Tcl_AppendResult(interp, "channel name required", (char *)NULL); return TCL_ERROR; } - Tcl_AppendResult(interp, statePtr->channelName, (void *)NULL); + Tcl_AppendResult(interp, statePtr->channelName, (char *)NULL); return TCL_OK; } @@ -6480,25 +6480,25 @@ TestChannelCmd( if ((cmdName[0] == 'o') && (strncmp(cmdName, "outputbuffered", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); + Tcl_AppendResult(interp, "channel name required", (char *)NULL); return TCL_ERROR; } IOQueued = Tcl_OutputBuffered(chan); TclFormatInt(buf, IOQueued); - Tcl_AppendResult(interp, buf, (void *)NULL); + Tcl_AppendResult(interp, buf, (char *)NULL); return TCL_OK; } if ((cmdName[0] == 'q') && (strncmp(cmdName, "queuedcr", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); + Tcl_AppendResult(interp, "channel name required", (char *)NULL); return TCL_ERROR; } Tcl_AppendResult(interp, - (statePtr->flags & INPUT_SAW_CR) ? "1" : "0", (void *)NULL); + (statePtr->flags & INPUT_SAW_CR) ? "1" : "0", (char *)NULL); return TCL_OK; } @@ -6521,12 +6521,12 @@ TestChannelCmd( if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); + Tcl_AppendResult(interp, "channel name required", (char *)NULL); return TCL_ERROR; } TclFormatInt(buf, statePtr->refCount); - Tcl_AppendResult(interp, buf, (void *)NULL); + Tcl_AppendResult(interp, buf, (char *)NULL); return TCL_OK; } @@ -6539,7 +6539,7 @@ TestChannelCmd( if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); + Tcl_AppendResult(interp, "channel name required", (char *)NULL); return TCL_ERROR; } @@ -6553,10 +6553,10 @@ TestChannelCmd( if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) { if (argc != 3) { - Tcl_AppendResult(interp, "channel name required", (void *)NULL); + Tcl_AppendResult(interp, "channel name required", (char *)NULL); return TCL_ERROR; } - Tcl_AppendResult(interp, Tcl_ChannelName(chanPtr->typePtr), (void *)NULL); + Tcl_AppendResult(interp, Tcl_ChannelName(chanPtr->typePtr), (char *)NULL); return TCL_OK; } @@ -6583,12 +6583,12 @@ TestChannelCmd( if (argc != 5) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " transform channelId -command cmd\"", (void *)NULL); + " transform channelId -command cmd\"", (char *)NULL); return TCL_ERROR; } if (strcmp(argv[3], "-command") != 0) { Tcl_AppendResult(interp, "bad argument \"", argv[3], - "\": should be \"-command\"", (void *)NULL); + "\": should be \"-command\"", (char *)NULL); return TCL_ERROR; } @@ -6603,7 +6603,7 @@ TestChannelCmd( if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " unstack channel\"", (void *)NULL); + " unstack channel\"", (char *)NULL); return TCL_ERROR; } return Tcl_UnstackChannel(interp, chan); @@ -6611,7 +6611,7 @@ TestChannelCmd( Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be " "cut, clearchannelhandlers, info, isshared, mode, open, " - "readable, splice, writable, transform, unstack", (void *)NULL); + "readable, splice, writable, transform, unstack", (char *)NULL); return TCL_ERROR; } @@ -6648,7 +6648,7 @@ TestChannelEventCmd( if ((argc < 3) || (argc > 5)) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName cmd ?arg1? ?arg2?\"", (void *)NULL); + " channelName cmd ?arg1? ?arg2?\"", (char *)NULL); return TCL_ERROR; } chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL); @@ -6662,7 +6662,7 @@ TestChannelEventCmd( if ((cmd[0] == 'a') && (strncmp(cmd, "add", len) == 0)) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName add eventSpec script\"", (void *)NULL); + " channelName add eventSpec script\"", (char *)NULL); return TCL_ERROR; } if (strcmp(argv[3], "readable") == 0) { @@ -6673,7 +6673,7 @@ TestChannelEventCmd( mask = 0; } else { Tcl_AppendResult(interp, "bad event name \"", argv[3], - "\": must be readable, writable, or none", (void *)NULL); + "\": must be readable, writable, or none", (char *)NULL); return TCL_ERROR; } @@ -6696,7 +6696,7 @@ TestChannelEventCmd( if ((cmd[0] == 'd') && (strncmp(cmd, "delete", len) == 0)) { if (argc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName delete index\"", (void *)NULL); + " channelName delete index\"", (char *)NULL); return TCL_ERROR; } if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) { @@ -6704,7 +6704,7 @@ TestChannelEventCmd( } if (index < 0) { Tcl_AppendResult(interp, "bad event index: ", argv[3], - ": must be nonnegative", (void *)NULL); + ": must be nonnegative", (char *)NULL); return TCL_ERROR; } for (i = 0, esPtr = statePtr->scriptRecordPtr; @@ -6714,7 +6714,7 @@ TestChannelEventCmd( } if (esPtr == NULL) { Tcl_AppendResult(interp, "bad event index ", argv[3], - ": out of range", (void *)NULL); + ": out of range", (char *)NULL); return TCL_ERROR; } if (esPtr == statePtr->scriptRecordPtr) { @@ -6742,7 +6742,7 @@ TestChannelEventCmd( if ((cmd[0] == 'l') && (strncmp(cmd, "list", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName list\"", (void *)NULL); + " channelName list\"", (char *)NULL); return TCL_ERROR; } resultListPtr = Tcl_GetObjResult(interp); @@ -6765,7 +6765,7 @@ TestChannelEventCmd( if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName removeall\"", (void *)NULL); + " channelName removeall\"", (char *)NULL); return TCL_ERROR; } for (esPtr = statePtr->scriptRecordPtr; @@ -6784,7 +6784,7 @@ TestChannelEventCmd( if ((cmd[0] == 's') && (strncmp(cmd, "set", len) == 0)) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " channelName delete index event\"", (void *)NULL); + " channelName delete index event\"", (char *)NULL); return TCL_ERROR; } if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) { @@ -6792,7 +6792,7 @@ TestChannelEventCmd( } if (index < 0) { Tcl_AppendResult(interp, "bad event index: ", argv[3], - ": must be nonnegative", (void *)NULL); + ": must be nonnegative", (char *)NULL); return TCL_ERROR; } for (i = 0, esPtr = statePtr->scriptRecordPtr; @@ -6802,7 +6802,7 @@ TestChannelEventCmd( } if (esPtr == NULL) { Tcl_AppendResult(interp, "bad event index ", argv[3], - ": out of range", (void *)NULL); + ": out of range", (char *)NULL); return TCL_ERROR; } @@ -6814,7 +6814,7 @@ TestChannelEventCmd( mask = 0; } else { Tcl_AppendResult(interp, "bad event name \"", argv[4], - "\": must be readable, writable, or none", (void *)NULL); + "\": must be readable, writable, or none", (char *)NULL); return TCL_ERROR; } esPtr->mask = mask; @@ -6823,7 +6823,7 @@ TestChannelEventCmd( return TCL_OK; } Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of " - "add, delete, list, set, or removeall", (void *)NULL); + "add, delete, list, set, or removeall", (char *)NULL); return TCL_ERROR; } @@ -6860,7 +6860,7 @@ TestSocketCmd( if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " subcommand ?additional args..?\"", (void *)NULL); + " subcommand ?additional args..?\"", (char *)NULL); return TCL_ERROR; } cmdName = argv[1]; @@ -6877,18 +6877,18 @@ TestSocketCmd( */ if (argc < 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " testflags channel flags\"", (void *)NULL); + " testflags channel flags\"", (char *)NULL); return TCL_ERROR; } hChannel = Tcl_GetChannel(interp, argv[2], &modePtr); if ( NULL == hChannel ) { - Tcl_AppendResult(interp, "unknown channel:", argv[2], (void *)NULL); + Tcl_AppendResult(interp, "unknown channel:", argv[2], (char *)NULL); return TCL_ERROR; } statePtr = (TcpState *)Tcl_GetChannelInstanceData(hChannel); if ( NULL == statePtr) { Tcl_AppendResult(interp, "No channel instance data:", argv[2], - (void *)NULL); + (char *)NULL); return TCL_ERROR; } if (Tcl_GetBoolean(interp, argv[3], &testMode) != TCL_OK) { @@ -6903,7 +6903,7 @@ TestSocketCmd( } Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be " - "testflags", (void *)NULL); + "testflags", (char *)NULL); return TCL_ERROR; } @@ -6937,7 +6937,7 @@ TestServiceModeCmd( int newmode, oldmode; if (argc > 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " ?newmode?\"", (void *)NULL); + " ?newmode?\"", (char *)NULL); return TCL_ERROR; } oldmode = (Tcl_GetServiceMode() != TCL_SERVICE_NONE); @@ -6999,7 +6999,7 @@ TestWrongNumArgsObjCmd( * Asked for more arguments than were given. */ insufArgs: - Tcl_AppendResult(interp, "insufficient arguments", (void *)NULL); + Tcl_AppendResult(interp, "insufficient arguments", (char *)NULL); return TCL_ERROR; } @@ -7052,15 +7052,15 @@ TestGetIndexFromObjStructObjCmd( return TCL_ERROR; } if (idx[0] != 85 || idx[2] != 85) { - Tcl_AppendResult(interp, "Tcl_GetIndexFromObjStruct overwrites bytes near index variable", (void *)NULL); + Tcl_AppendResult(interp, "Tcl_GetIndexFromObjStruct overwrites bytes near index variable", (char *)NULL); return TCL_ERROR; } else if (idx[1] != target) { char buffer[64]; snprintf(buffer, sizeof(buffer), "%d", idx[1]); Tcl_AppendResult(interp, "index value comparison failed: got ", - buffer, (void *)NULL); + buffer, (char *)NULL); snprintf(buffer, sizeof(buffer), "%d", target); - Tcl_AppendResult(interp, " when ", buffer, " expected", (void *)NULL); + Tcl_AppendResult(interp, " when ", buffer, " expected", (char *)NULL); return TCL_ERROR; } Tcl_WrongNumArgs(interp, objc, objv, NULL); @@ -7567,7 +7567,7 @@ SimpleOpenFileChannel( Tcl_Channel chan; if ((mode != 0) && !(mode & O_RDONLY)) { - Tcl_AppendResult(interp, "read-only", (void *)NULL); + Tcl_AppendResult(interp, "read-only", (char *)NULL); return NULL; } @@ -7653,7 +7653,7 @@ TestUtfNextCmd( /* Run Tcl_UtfNext with many more possible bytes at src[-1], all should give the same result */ result = Tcl_UtfNext(buffer + 1); if (first != result) { - Tcl_AppendResult(interp, "Tcl_UtfNext is not supposed to read src[-1]", (void *)NULL); + Tcl_AppendResult(interp, "Tcl_UtfNext is not supposed to read src[-1]", (char *)NULL); return TCL_ERROR; } } @@ -7925,7 +7925,7 @@ TestHashSystemHashCmd( Tcl_InitCustomHashTable(&hash, TCL_CUSTOM_TYPE_KEYS, &hkType); if (hash.numEntries != 0) { - Tcl_AppendResult(interp, "non-zero initial size", (void *)NULL); + Tcl_AppendResult(interp, "non-zero initial size", (char *)NULL); Tcl_DeleteHashTable(&hash); return TCL_ERROR; } @@ -7942,7 +7942,7 @@ TestHashSystemHashCmd( } if (hash.numEntries != (Tcl_Size)limit) { - Tcl_AppendResult(interp, "unexpected maximal size", (void *)NULL); + Tcl_AppendResult(interp, "unexpected maximal size", (char *)NULL); Tcl_DeleteHashTable(&hash); return TCL_ERROR; } @@ -7965,13 +7965,13 @@ TestHashSystemHashCmd( } if (hash.numEntries != 0) { - Tcl_AppendResult(interp, "non-zero final size", (void *)NULL); + Tcl_AppendResult(interp, "non-zero final size", (char *)NULL); Tcl_DeleteHashTable(&hash); return TCL_ERROR; } Tcl_DeleteHashTable(&hash); - Tcl_AppendResult(interp, "OK", (void *)NULL); + Tcl_AppendResult(interp, "OK", (char *)NULL); return TCL_OK; } @@ -7987,7 +7987,7 @@ TestgetintCmd( const char **argv) { if (argc < 2) { - Tcl_AppendResult(interp, "wrong # args", (void *)NULL); + Tcl_AppendResult(interp, "wrong # args", (char *)NULL); return TCL_ERROR; } else { int val, i, total=0; @@ -8014,7 +8014,7 @@ TestlongsizeCmd( TCL_UNUSED(const char **) /*argv*/) { if (argc != 1) { - Tcl_AppendResult(interp, "wrong # args", (void *)NULL); + Tcl_AppendResult(interp, "wrong # args", (char *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(long))); @@ -8165,21 +8165,21 @@ TestconcatobjCmd( if (concatPtr->refCount != 0) { result = TCL_ERROR; Tcl_AppendResult(interp, - "\n\t* (a) concatObj does not have refCount 0", (void *)NULL); + "\n\t* (a) concatObj does not have refCount 0", (char *)NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (a) concatObj is not a new obj ", - (void *)NULL); + (char *)NULL); switch (tmpPtr->refCount) { case 0: - Tcl_AppendResult(interp, "(no new refCount)", (void *)NULL); + Tcl_AppendResult(interp, "(no new refCount)", (char *)NULL); break; case 1: - Tcl_AppendResult(interp, "(refCount added)", (void *)NULL); + Tcl_AppendResult(interp, "(refCount added)", (char *)NULL); break; default: - Tcl_AppendResult(interp, "(more than one refCount added!)", (void *)NULL); + Tcl_AppendResult(interp, "(more than one refCount added!)", (char *)NULL); Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); } tmpPtr = Tcl_DuplicateObj(list1Ptr); @@ -8192,26 +8192,26 @@ TestconcatobjCmd( if (concatPtr->refCount != 0) { result = TCL_ERROR; Tcl_AppendResult(interp, - "\n\t* (b) concatObj does not have refCount 0", (void *)NULL); + "\n\t* (b) concatObj does not have refCount 0", (char *)NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (b) concatObj is not a new obj ", - (void *)NULL); + (char *)NULL); switch (tmpPtr->refCount) { case 0: - Tcl_AppendResult(interp, "(refCount removed?)", (void *)NULL); + Tcl_AppendResult(interp, "(refCount removed?)", (char *)NULL); Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); break; case 1: - Tcl_AppendResult(interp, "(no new refCount)", (void *)NULL); + Tcl_AppendResult(interp, "(no new refCount)", (char *)NULL); break; case 2: - Tcl_AppendResult(interp, "(refCount added)", (void *)NULL); + Tcl_AppendResult(interp, "(refCount added)", (char *)NULL); Tcl_DecrRefCount(tmpPtr); break; default: - Tcl_AppendResult(interp, "(more than one refCount added!)", (void *)NULL); + Tcl_AppendResult(interp, "(more than one refCount added!)", (char *)NULL); Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); } tmpPtr = Tcl_DuplicateObj(list1Ptr); @@ -8226,21 +8226,21 @@ TestconcatobjCmd( if (concatPtr->refCount != 0) { result = TCL_ERROR; Tcl_AppendResult(interp, - "\n\t* (c) concatObj does not have refCount 0", (void *)NULL); + "\n\t* (c) concatObj does not have refCount 0", (char *)NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (c) concatObj is not a new obj ", - (void *)NULL); + (char *)NULL); switch (tmpPtr->refCount) { case 0: - Tcl_AppendResult(interp, "(no new refCount)", (void *)NULL); + Tcl_AppendResult(interp, "(no new refCount)", (char *)NULL); break; case 1: - Tcl_AppendResult(interp, "(refCount added)", (void *)NULL); + Tcl_AppendResult(interp, "(refCount added)", (char *)NULL); break; default: - Tcl_AppendResult(interp, "(more than one refCount added!)", (void *)NULL); + Tcl_AppendResult(interp, "(more than one refCount added!)", (char *)NULL); Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); } tmpPtr = Tcl_DuplicateObj(list1Ptr); @@ -8253,26 +8253,26 @@ TestconcatobjCmd( if (concatPtr->refCount != 0) { result = TCL_ERROR; Tcl_AppendResult(interp, - "\n\t* (d) concatObj does not have refCount 0", (void *)NULL); + "\n\t* (d) concatObj does not have refCount 0", (char *)NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (d) concatObj is not a new obj ", - (void *)NULL); + (char *)NULL); switch (tmpPtr->refCount) { case 0: - Tcl_AppendResult(interp, "(refCount removed?)", (void *)NULL); + Tcl_AppendResult(interp, "(refCount removed?)", (char *)NULL); Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); break; case 1: - Tcl_AppendResult(interp, "(no new refCount)", (void *)NULL); + Tcl_AppendResult(interp, "(no new refCount)", (char *)NULL); break; case 2: - Tcl_AppendResult(interp, "(refCount added)", (void *)NULL); + Tcl_AppendResult(interp, "(refCount added)", (char *)NULL); Tcl_DecrRefCount(tmpPtr); break; default: - Tcl_AppendResult(interp, "(more than one refCount added!)", (void *)NULL); + Tcl_AppendResult(interp, "(more than one refCount added!)", (char *)NULL); Tcl_Panic("extremely unsafe behaviour by Tcl_ConcatObj()"); } tmpPtr = Tcl_DuplicateObj(list1Ptr); @@ -8291,20 +8291,20 @@ TestconcatobjCmd( if (concatPtr->refCount != 0) { result = TCL_ERROR; Tcl_AppendResult(interp, - "\n\t* (e) concatObj does not have refCount 0", (void *)NULL); + "\n\t* (e) concatObj does not have refCount 0", (char *)NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (e) concatObj is not a new obj ", - (void *)NULL); + (char *)NULL); (void) Tcl_ListObjLength(NULL, concatPtr, &len); switch (tmpPtr->refCount) { case 3: - Tcl_AppendResult(interp, "(failed to concat)", (void *)NULL); + Tcl_AppendResult(interp, "(failed to concat)", (char *)NULL); break; default: - Tcl_AppendResult(interp, "(corrupted input!)", (void *)NULL); + Tcl_AppendResult(interp, "(corrupted input!)", (char *)NULL); } if (Tcl_IsShared(tmpPtr)) { Tcl_DecrRefCount(tmpPtr); @@ -8321,20 +8321,20 @@ TestconcatobjCmd( if (concatPtr->refCount != 0) { result = TCL_ERROR; Tcl_AppendResult(interp, - "\n\t* (f) concatObj does not have refCount 0", (void *)NULL); + "\n\t* (f) concatObj does not have refCount 0", (char *)NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (f) concatObj is not a new obj ", - (void *)NULL); + (char *)NULL); (void) Tcl_ListObjLength(NULL, concatPtr, &len); switch (tmpPtr->refCount) { case 3: - Tcl_AppendResult(interp, "(failed to concat)", (void *)NULL); + Tcl_AppendResult(interp, "(failed to concat)", (char *)NULL); break; default: - Tcl_AppendResult(interp, "(corrupted input!)", (void *)NULL); + Tcl_AppendResult(interp, "(corrupted input!)", (char *)NULL); } if (Tcl_IsShared(tmpPtr)) { Tcl_DecrRefCount(tmpPtr); @@ -8352,20 +8352,20 @@ TestconcatobjCmd( if (concatPtr->refCount != 0) { result = TCL_ERROR; Tcl_AppendResult(interp, - "\n\t* (g) concatObj does not have refCount 0", (void *)NULL); + "\n\t* (g) concatObj does not have refCount 0", (char *)NULL); } if (concatPtr == tmpPtr) { result = TCL_ERROR; Tcl_AppendResult(interp, "\n\t* (g) concatObj is not a new obj ", - (void *)NULL); + (char *)NULL); (void) Tcl_ListObjLength(NULL, concatPtr, &len); switch (tmpPtr->refCount) { case 3: - Tcl_AppendResult(interp, "(failed to concat)", (void *)NULL); + Tcl_AppendResult(interp, "(failed to concat)", (char *)NULL); break; default: - Tcl_AppendResult(interp, "(corrupted input!)", (void *)NULL); + Tcl_AppendResult(interp, "(corrupted input!)", (char *)NULL); } Tcl_DecrRefCount(tmpPtr); if (Tcl_IsShared(tmpPtr)) { @@ -8673,7 +8673,7 @@ TestInterpResolverCmd( if (objc == 3) { interp = Tcl_GetChild(interp, Tcl_GetString(objv[2])); if (interp == NULL) { - Tcl_AppendResult(interp, "provided interpreter not found", (void *)NULL); + Tcl_AppendResult(interp, "provided interpreter not found", (char *)NULL); return TCL_ERROR; } } @@ -8689,7 +8689,7 @@ TestInterpResolverCmd( case 0: /*down*/ if (!Tcl_RemoveInterpResolvers(interp, RESOLVER_KEY)) { Tcl_AppendResult(interp, "could not remove the resolver scheme", - (void *)NULL); + (char *)NULL); return TCL_ERROR; } } diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 89e4ccc..87de58c 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -822,9 +822,9 @@ proc genStubs::forAllStubs {name slotProc onAll textVar # TkIntStubs entry 113 for aqua is in fact at position # 114 in the table, entry 114 at position 116 etc). eval {append temp} $skipString - set temp "[string range $temp 0 end-1] /*\ + set temp "# if TCL_MAJOR_VERSION < 9\n[string range $temp 0 end-1] /*\ Dummy entry for stubs table backwards\ - compatibility */\n" + compatibility */\n# endif /* TCL_MAJOR_VERSION < 9 */\n" } if {$slot($plat)} { append temp [$slotProc $name $stubs($name,$plat,$i) $i] diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index 165c5e3..3a1d3d4 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -56,7 +56,7 @@ Pkgb_SubObjCmd( || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) { char buf[TCL_INTEGER_SPACE]; snprintf(buf, sizeof(buf), "%d", Tcl_GetErrorLine(interp)); - Tcl_AppendResult(interp, " in line: ", buf, (void *)NULL); + Tcl_AppendResult(interp, " in line: ", buf, (char *)NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second)); diff --git a/unix/dltest/pkgooa.c b/unix/dltest/pkgooa.c index 60e3864..7a84481 100644 --- a/unix/dltest/pkgooa.c +++ b/unix/dltest/pkgooa.c @@ -108,18 +108,18 @@ Pkgooa_Init( } if (tclStubsPtr == NULL) { Tcl_AppendResult(interp, "Tcl stubs are not initialized, " - "did you compile using -DUSE_TCL_STUBS? ", (void *)NULL); + "did you compile using -DUSE_TCL_STUBS? ", (char *)NULL); return TCL_ERROR; } if (Tcl_OOInitStubs(interp) == NULL) { return TCL_ERROR; } if (tclOOStubsPtr == NULL) { - Tcl_AppendResult(interp, "TclOO stubs are not initialized", (void *)NULL); + Tcl_AppendResult(interp, "TclOO stubs are not initialized", (char *)NULL); return TCL_ERROR; } if (tclOOIntStubsPtr == NULL) { - Tcl_AppendResult(interp, "TclOO internal stubs are not initialized", (void *)NULL); + Tcl_AppendResult(interp, "TclOO internal stubs are not initialized", (char *)NULL); return TCL_ERROR; } diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c index 13b183b..f0eab5c 100644 --- a/unix/tclLoadDl.c +++ b/unix/tclLoadDl.c @@ -224,7 +224,7 @@ FindSymbol( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot find symbol \"%s\": %s", symbol, errorStr)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, - (void *)NULL); + (char *)NULL); } } return proc; diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c index 375771c..43cb806 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -414,7 +414,7 @@ FindSymbol( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot find symbol \"%s\": %s", symbol, errMsg)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, - (void *)NULL); + (char *)NULL); } return (void *)proc; } diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c index b52fa2a..fe511f9 100644 --- a/unix/tclLoadNext.c +++ b/unix/tclLoadNext.c @@ -146,7 +146,7 @@ FindSymbol( if (proc == NULL && interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot find symbol \"%s\"", symbol)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (char *)NULL); } return proc; } diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c index 81468b8..1c423bd 100644 --- a/unix/tclLoadOSF.c +++ b/unix/tclLoadOSF.c @@ -164,7 +164,7 @@ FindSymbol( if (retval == NULL && interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot find symbol \"%s\"", symbol)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (char *)NULL); } return retval; } diff --git a/unix/tclXtTest.c b/unix/tclXtTest.c index c6bcc18..ad7cb77 100644 --- a/unix/tclXtTest.c +++ b/unix/tclXtTest.c @@ -117,7 +117,7 @@ TesteventloopCmd( framePtr = oldFramePtr; } else { Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]), - "\": must be done or wait", (void *)NULL); + "\": must be done or wait", (char *)NULL); return TCL_ERROR; } return TCL_OK; diff --git a/win/tclWinDde.c b/win/tclWinDde.c index d883bac..f36407d 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -578,7 +578,7 @@ ExecuteRemoteObject( Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: " "a handler procedure must be defined for use in a safe " "interp", -1)); - Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", (void *)NULL); + Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", (char *)NULL); result = TCL_ERROR; } @@ -1050,7 +1050,7 @@ MakeDdeConnection( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "no registered server named \"%s\"", Tcl_DStringValue(&dString))); Tcl_DStringFree(&dString); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", (char *)NULL); } return TCL_ERROR; } @@ -1281,7 +1281,7 @@ SetDdeError( } Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, (char *)NULL); } /* @@ -1568,7 +1568,7 @@ DdeObjCmd( Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot execute null data", -1)); Tcl_DStringFree(&dsBuf); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (char *)NULL); result = TCL_ERROR; break; } @@ -1618,7 +1618,7 @@ DdeObjCmd( if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot request value of null data", -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (char *)NULL); result = TCL_ERROR; goto cleanup; } @@ -1684,7 +1684,7 @@ DdeObjCmd( if (length == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj("cannot have a null item", -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (char *)NULL); result = TCL_ERROR; goto cleanup; } @@ -1738,7 +1738,7 @@ DdeObjCmd( if (serviceName == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid service name \"\"", -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", (char *)NULL); result = TCL_ERROR; goto cleanup; } @@ -1787,7 +1787,7 @@ DdeObjCmd( "permission denied: a handler procedure must be" " defined for use in a safe interp", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK", - (void *)NULL); + (char *)NULL); result = TCL_ERROR; } @@ -1852,7 +1852,7 @@ DdeObjCmd( invalidServerResponse: Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid data returned from server", -1)); - Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", (char *)NULL); result = TCL_ERROR; goto cleanup; } diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c index a03132f..8d2e5b3 100644 --- a/win/tclWinLoad.c +++ b/win/tclWinLoad.c @@ -133,32 +133,32 @@ TclpDlopen( if (interp) { switch (lastError) { case ERROR_MOD_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", (void *)NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", (char *)NULL); goto notFoundMsg; case ERROR_DLL_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", (void *)NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", (char *)NULL); notFoundMsg: Tcl_AppendToObj(errMsg, "this library or a dependent library" " could not be found in library path", TCL_INDEX_NONE); break; case ERROR_PROC_NOT_FOUND: - Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", (void *)NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", (char *)NULL); Tcl_AppendToObj(errMsg, "A function specified in the import" " table could not be resolved by the system. Windows" " is not telling which one, I'm sorry.", TCL_INDEX_NONE); break; case ERROR_INVALID_DLL: - Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", (void *)NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", (char *)NULL); Tcl_AppendToObj(errMsg, "this library or a dependent library" " is damaged", TCL_INDEX_NONE); break; case ERROR_DLL_INIT_FAILED: - Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", (void *)NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", (char *)NULL); Tcl_AppendToObj(errMsg, "the library initialization" " routine failed", TCL_INDEX_NONE); break; case ERROR_BAD_EXE_FORMAT: - Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", (void *)NULL); + Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", (char *)NULL); Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", TCL_INDEX_NONE); break; default: @@ -227,7 +227,7 @@ FindSymbol( if (proc == NULL && interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot find symbol \"%s\"", symbol)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, (char *)NULL); } return proc; } diff --git a/win/tclWinReg.c b/win/tclWinReg.c index a0b4e90..68e22cb 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -466,7 +466,7 @@ DeleteKey( if (*keyName == '\0') { Tcl_SetObjResult(interp, Tcl_NewStringObj("bad key: cannot delete root keys", -1)); - Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", (void *)NULL); + Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", (char *)NULL); Tcl_Free(buffer); return TCL_ERROR; } @@ -1146,7 +1146,7 @@ ParseKeyName( if (!rootName) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad key \"%s\": must start with a valid root", name)); - Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", (void *)NULL); + Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", (char *)NULL); return TCL_ERROR; } @@ -1538,7 +1538,7 @@ AppendSystemError( } snprintf(id, sizeof(id), "%ld", error); - Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (void *)NULL); + Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (char *)NULL); Tcl_AppendToObj(resultPtr, msg, length); Tcl_SetObjResult(interp, resultPtr); -- cgit v0.12 From 9d3646eaee37dcfe6b5a44ebdf7380b5684f3c7b Mon Sep 17 00:00:00 2001 From: pooryorick Date: Sat, 23 Mar 2024 23:34:58 +0000 Subject: A new test constraint, "bigmem", configurable via the environment variable TCL_TESTCONSTRAINT_BIGMEM, to bypass tests that require large amounts of memory. --- tests/binary.test | 4 +++- tests/tcltests.tcl | 5 +++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/tests/binary.test b/tests/binary.test index 299e1e0..da25cd9 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -3048,7 +3048,9 @@ test binary-80.3 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes test binary-80.4 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body { testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xF0\x9F\x98\x81"] } -result "expected byte sequence but character 4 was '\U01F601' (U+01F601)" -test binary-80.5 {Tcl_GetBytesFromObj} -constraints {testbytestring pointerIs64bit deprecated} -body { +test binary-80.5 {Tcl_GetBytesFromObj} -constraints { + bigmem testbytestring pointerIs64bit deprecated +} -body { testbytestring [string repeat A [expr 2**31]] } -returnCodes 1 -result "byte sequence length exceeds INT_MAX" diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl index 409a2cc..50ea9d1 100644 --- a/tests/tcltests.tcl +++ b/tests/tcltests.tcl @@ -15,6 +15,11 @@ testConstraint debugpurify [ && [testConstraint debug] && [testConstraint purify] }] +testConstraint bigmem [expr {[ + info exists ::env(TCL_TESTCONSTRAINT_BIGMEM)] + ? !!$::env(TCL_TESTCONSTRAINT_BIGMEM) + : 1 +}] testConstraint fcopy [llength [info commands fcopy]] testConstraint fileevent [llength [info commands fileevent]] testConstraint thread [expr {![catch {package require Thread 2.7-}]}] -- cgit v0.12 From d01d33538d08aa2a4cbbc055a657537ffd61d499 Mon Sep 17 00:00:00 2001 From: sebres Date: Sun, 24 Mar 2024 16:37:19 +0000 Subject: still one fix for [1f40aa83c552f597], now for freescan (overflow in tests clock-6.10e/clock-6.10f): rewritten with common str2int now --- generic/tclClockFmt.c | 10 +++++++++ generic/tclDate.c | 56 ++++++++++++++++++++++++--------------------------- generic/tclDate.h | 2 ++ generic/tclGetDate.y | 56 ++++++++++++++++++++++++--------------------------- 4 files changed, 64 insertions(+), 60 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 76af74c..6ce478f 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -140,6 +140,16 @@ _str2wideInt( *out = val; return TCL_OK; } +int +TclAtoWIe( + Tcl_WideInt *out, + const char *p, + const char *e, + int sign) +{ + return _str2wideInt(out, p, e, sign); +} + #if defined(__GNUC__) || defined(__GNUG__) # pragma GCC reset_options diff --git a/generic/tclDate.c b/generic/tclDate.c index e419585..af07ee1 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -221,7 +221,7 @@ extern int TclDatedebug; union YYSTYPE { - long long Number; + Tcl_WideInt Number; enum _MERIDIAN Meridian; @@ -2512,44 +2512,40 @@ TclDatelex( if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */ - /* - * Convert the string into a number; count the number of digits. + /* + * Count the number of digits. */ - long long num = c - '0'; p = (char *)yyInput; - while (isdigit(UCHAR(c = *(++p)))) { - if (num >= 0) { - num *= 10; num += c - '0'; - } - } - yylvalPtr->Number = num; + while (isdigit(UCHAR(*++p))) {}; yyDigitCount = p - yyInput; + /* + * A number with 12 or 14 digits is considered an ISO 8601 date. + */ + if (yyDigitCount == 14 || yyDigitCount == 12) { + /* long form of ISO 8601 (without separator), either + * YYYYMMDDhhmmss or YYYYMMDDhhmm, so reduce to date + * (8 chars is isodate) */ + p = (char *)yyInput+8; + if (TclAtoWIe(&yylvalPtr->Number, yyInput, p, 1) != TCL_OK) { + return tID; /* overflow*/ + } + yyDigitCount = 8; + yyInput = p; + location->last_column = yyInput - info->dateStart - 1; + return tISOBASL; + } + /* + * Convert the string into a number + */ + if (TclAtoWIe(&yylvalPtr->Number, yyInput, p, 1) != TCL_OK) { + return tID; /* overflow*/ + } yyInput = p; - /* * A number with 6 or more digits is considered an ISO 8601 base. */ - location->last_column = yyInput - info->dateStart - 1; if (yyDigitCount >= 6) { - if (yyDigitCount == 14 || yyDigitCount == 12) { - /* long form of ISO 8601 (without separator), either - * YYYYMMDDhhmmss or YYYYMMDDhhmm, so reduce to date - * (8 chars is isodate) */ - p = (char *)tokStart; - num = *p++ - '0'; - do { - num *= 10; num += *p++ - '0'; - } while (p - tokStart < 8); - yylvalPtr->Number = num; - yyDigitCount = 8; - yyInput = p; - location->last_column = yyInput - info->dateStart - 1; - return tISOBASL; - } - if (yyDigitCount > 14) { /* overflow */ - return tID; - } if (yyDigitCount == 8) { return tISOBAS8; } diff --git a/generic/tclDate.h b/generic/tclDate.h index 8a1e8cd..adc3e85 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -547,6 +547,8 @@ MODULE_SCOPE int ClockMCSetIdx(ClockFmtScnCmdArgs *opts, int mcKey, MODULE_SCOPE char * TclItoAw(char *buf, int val, char padchar, unsigned short int width); +MODULE_SCOPE int + TclAtoWIe(Tcl_WideInt *out, const char *p, const char *e, int sign); MODULE_SCOPE Tcl_Obj* ClockFrmObjGetLocFmtKey(Tcl_Interp *interp, diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index 077d751..612845d 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -103,7 +103,7 @@ typedef enum _DSTMODE { %} %union { - long long Number; + Tcl_WideInt Number; enum _MERIDIAN Meridian; } @@ -888,44 +888,40 @@ TclDatelex( if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */ - /* - * Convert the string into a number; count the number of digits. + /* + * Count the number of digits. */ - long long num = c - '0'; p = (char *)yyInput; - while (isdigit(UCHAR(c = *(++p)))) { - if (num >= 0) { - num *= 10; num += c - '0'; - } - } - yylvalPtr->Number = num; + while (isdigit(UCHAR(*++p))) {}; yyDigitCount = p - yyInput; + /* + * A number with 12 or 14 digits is considered an ISO 8601 date. + */ + if (yyDigitCount == 14 || yyDigitCount == 12) { + /* long form of ISO 8601 (without separator), either + * YYYYMMDDhhmmss or YYYYMMDDhhmm, so reduce to date + * (8 chars is isodate) */ + p = (char *)yyInput+8; + if (TclAtoWIe(&yylvalPtr->Number, yyInput, p, 1) != TCL_OK) { + return tID; /* overflow*/ + } + yyDigitCount = 8; + yyInput = p; + location->last_column = yyInput - info->dateStart - 1; + return tISOBASL; + } + /* + * Convert the string into a number + */ + if (TclAtoWIe(&yylvalPtr->Number, yyInput, p, 1) != TCL_OK) { + return tID; /* overflow*/ + } yyInput = p; - /* * A number with 6 or more digits is considered an ISO 8601 base. */ - location->last_column = yyInput - info->dateStart - 1; if (yyDigitCount >= 6) { - if (yyDigitCount == 14 || yyDigitCount == 12) { - /* long form of ISO 8601 (without separator), either - * YYYYMMDDhhmmss or YYYYMMDDhhmm, so reduce to date - * (8 chars is isodate) */ - p = (char *)tokStart; - num = *p++ - '0'; - do { - num *= 10; num += *p++ - '0'; - } while (p - tokStart < 8); - yylvalPtr->Number = num; - yyDigitCount = 8; - yyInput = p; - location->last_column = yyInput - info->dateStart - 1; - return tISOBASL; - } - if (yyDigitCount > 14) { /* overflow */ - return tID; - } if (yyDigitCount == 8) { return tISOBAS8; } -- cgit v0.12 From 9c3bf540b706f4a1bab0be84a82ded3f49190690 Mon Sep 17 00:00:00 2001 From: sebres Date: Sun, 24 Mar 2024 16:54:40 +0000 Subject: review and more optimizations (cherry-pick from tclclockmod) --- generic/tclClockFmt.c | 102 +++++++++++++++++++++++++++++++++++--------------- 1 file changed, 71 insertions(+), 31 deletions(-) diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 6ce478f..d59f424 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -56,6 +56,40 @@ static void ClockFrmScnFinalize(void *clientData); *---------------------------------------------------------------------- */ +static inline void +_str2int_no( + int *out, + const char *p, + const char *e, + int sign) +{ + /* assert(e <= p+10); */ + int val = 0; + /* overflow impossible for 10 digits ("9..9"), so no needs to check at all */ + while (p < e) { /* never overflows */ + val = val * 10 + (*p++ - '0'); + } + if (sign < 0) { val = -val; } + *out = val; +} + +static inline void +_str2wideInt_no( + Tcl_WideInt *out, + const char *p, + const char *e, + int sign) +{ + /* assert(e <= p+18); */ + Tcl_WideInt val = 0; + /* overflow impossible for 18 digits ("9..9"), so no needs to check at all */ + while (p < e) { /* never overflows */ + val = val * 10 + (*p++ - '0'); + } + if (sign < 0) { val = -val; } + *out = val; +} + /* int & Tcl_WideInt overflows may happens here (expected case) */ #if defined(__GNUC__) || defined(__GNUG__) # pragma GCC optimize("no-trapv") @@ -68,29 +102,27 @@ _str2int( const char *e, int sign) { - int val = 0, prev = 0; - const char *eNO = e; + int val = 0; /* overflow impossible for 10 digits ("9..9"), so no needs to check before */ - if (e-p > 10) { - eNO = p+10; + const char *eNO = p+10; + if (eNO > e) { + eNO = e; + } + while (p < eNO) { /* never overflows */ + val = val * 10 + (*p++ - '0'); } if (sign >= 0) { - while (p < eNO) { /* never overflows */ - val = val * 10 + (*p++ - '0'); - } while (p < e) { /* check for overflow */ - prev = val; + int prev = val; val = val * 10 + (*p++ - '0'); if (val / 10 < prev) { return TCL_ERROR; } } } else { - while (p < eNO) { /* never overflows */ - val = val * 10 - (*p++ - '0'); - } + val = -val; while (p < e) { /* check for overflow */ - prev = val; + int prev = val; val = val * 10 - (*p++ - '0'); if (val / 10 > prev) { return TCL_ERROR; @@ -108,29 +140,27 @@ _str2wideInt( const char *e, int sign) { - Tcl_WideInt val = 0, prev = 0; - const char *eNO = e; + register Tcl_WideInt val = 0; /* overflow impossible for 18 digits ("9..9"), so no needs to check before */ - if (e-p > 18) { - eNO = p+18; + const char *eNO = p+18; + if (eNO > e) { + eNO = e; + } + while (p < eNO) { /* never overflows */ + val = val * 10 + (*p++ - '0'); } if (sign >= 0) { - while (p < eNO) { /* never overflows */ - val = val * 10 + (*p++ - '0'); - } while (p < e) { /* check for overflow */ - prev = val; + Tcl_WideInt prev = val; val = val * 10 + (*p++ - '0'); if (val / 10 < prev) { return TCL_ERROR; } } } else { - while (p < eNO) { /* never overflows */ - val = val * 10 - (*p++ - '0'); - } + val = -val; while (p < e) { /* check for overflow */ - prev = val; + Tcl_WideInt prev = val; val = val * 10 - (*p++ - '0'); if (val / 10 > prev) { return TCL_ERROR; @@ -140,6 +170,7 @@ _str2wideInt( *out = val; return TCL_OK; } + int TclAtoWIe( Tcl_WideInt *out, @@ -150,7 +181,6 @@ TclAtoWIe( return _str2wideInt(out, p, e, sign); } - #if defined(__GNUC__) || defined(__GNUG__) # pragma GCC reset_options #endif @@ -2343,15 +2373,25 @@ ClockScan( if (map->offs) { p = yyInput; x = p + size; if (map->type == CTOKT_INT) { - if (_str2int((int *)(((char *)info) + map->offs), - p, x, sign) != TCL_OK) { - goto overflow; + if (size <= 10) { + _str2int_no((int *)(((char *)info) + map->offs), + p, x, sign); + } else { + if (_str2int((int *)(((char *)info) + map->offs), + p, x, sign) != TCL_OK) { + goto overflow; + } } p = x; } else { - if (_str2wideInt((Tcl_WideInt *)(((char *)info) + map->offs), - p, x, sign) != TCL_OK) { - goto overflow; + if (size <= 18) { + _str2wideInt_no((Tcl_WideInt *)(((char *)info) + map->offs), + p, x, sign); + } else { + if (_str2wideInt((Tcl_WideInt *)(((char *)info) + map->offs), + p, x, sign) != TCL_OK) { + goto overflow; + } } p = x; } -- cgit v0.12 From 9293fc3b5a11000cca9415eeefe6105b7e26a676 Mon Sep 17 00:00:00 2001 From: sebres Date: Sun, 24 Mar 2024 17:01:35 +0000 Subject: TCL_MEM_DEBUG build: disable cache/storage-GC for released clock scan/format objects --- generic/tclDate.h | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/generic/tclDate.h b/generic/tclDate.h index adc3e85..cdef706 100644 --- a/generic/tclDate.h +++ b/generic/tclDate.h @@ -366,7 +366,11 @@ typedef struct ClockClientData { * Clock scan and format facilities. */ -#define CLOCK_FMT_SCN_STORAGE_GC_SIZE 32 +#ifndef TCL_MEM_DEBUG +# define CLOCK_FMT_SCN_STORAGE_GC_SIZE 32 +#else +# define CLOCK_FMT_SCN_STORAGE_GC_SIZE 0 +#endif #define CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE 2 -- cgit v0.12 From 79481e896dba0539e9e16bd9db4e0461b6c15125 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 24 Mar 2024 18:05:07 +0000 Subject: (cherry-pick): Change Tcl_ExternalToUtfDStringEx and Tcl_UtfToExternalDStringEx to ignore START/END flags as stated in documentation instead of raising an error. --- generic/tclEncoding.c | 24 ------------------------ 1 file changed, 24 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 39c6ee3..c3bd36d 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1285,18 +1285,6 @@ Tcl_ExternalToUtfDStringEx( /* DO FIRST - Must always be initialized before returning */ Tcl_DStringInit(dstPtr); - if (flags & (TCL_ENCODING_START|TCL_ENCODING_END)) { - /* TODO - what other flags are illegal? - See TIP 656 */ - Tcl_SetObjResult( - interp, - Tcl_NewStringObj( - "Parameter error: TCL_ENCODING_{START,STOP} bits set in flags.", - TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALFLAGS", (void *)NULL); - errno = EINVAL; - return TCL_ERROR; - } - dst = Tcl_DStringValue(dstPtr); dstLen = dstPtr->spaceAvl - 1; @@ -1587,18 +1575,6 @@ Tcl_UtfToExternalDStringEx( /* DO FIRST - must always be initialized on return */ Tcl_DStringInit(dstPtr); - if (flags & (TCL_ENCODING_START|TCL_ENCODING_END)) { - /* TODO - what other flags are illegal? - See TIP 656 */ - Tcl_SetObjResult( - interp, - Tcl_NewStringObj( - "Parameter error: TCL_ENCODING_{START,STOP} bits set in flags.", - TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALFLAGS", (void *)NULL); - errno = EINVAL; - return TCL_ERROR; - } - dst = Tcl_DStringValue(dstPtr); dstLen = dstPtr->spaceAvl - 1; -- cgit v0.12 From 3759e6ffbfcbed0f548bd400a2198a2df3a63b47 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 25 Mar 2024 20:22:59 +0000 Subject: fixes mem-leak introduced in [06b7ba18bdd9c2c3] (move of configure to unsupported) --- generic/tclClock.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 2ce8445..7c179f6 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -268,7 +268,7 @@ TclClockInit( } cmdPtr = (Command *)Tcl_CreateObjCommand(interp, "::tcl::unsupported::clock::configure", - ClockConfigureObjCmd, data, NULL); + ClockConfigureObjCmd, data, ClockDeleteCmdProc); data->refCount++; cmdPtr->compileProc = TclCompileBasicMin0ArgCmd; } -- cgit v0.12 From b14399a3cde3d0e12aba5b82bc03768ec33837ed Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 26 Mar 2024 17:37:58 +0000 Subject: added missing test coverage for clock ensemble in safe-interpreter (shared from parent interpreter) --- tests/clock.test | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index 893e410..b809ba1 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -273,21 +273,35 @@ proc ::testClock::registry { cmd path key } { # Base test cases: -test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" { +test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" -setup { set i [interp create]; # because clock can be used somewhere, test it in new interp: - - set ret [$i eval { - +} -body { + $i eval { lappend ret ens:[namespace ensemble exists ::clock] clock seconds; # init ensemble (but not yet stubs, loading of clock.tcl retarded) lappend ret ens:[namespace ensemble exists ::clock] lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}] clock format -now; # clock.tcl stubs expected lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}] - }] + } +} -cleanup { + interp delete $i +} -result {ens:0 ens:1 stubs:0 stubs:1} +test clock-0.1a "initial: safe interpreter shares clock command with parent" -setup { + set i [interp create] + $i eval {set sci [interp create -safe]} +} -body { + $i eval { + lappend ret ens:[namespace ensemble exists ::clock] + $sci eval { clock seconds }; # init ensemble (but not yet stubs, loading of clock.tcl retarded) + lappend ret ens:[namespace ensemble exists ::clock] + lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}] + $sci eval { clock format -now }; # clock.tcl stubs expected + lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}] + } +} -cleanup { interp delete $i - set ret -} {ens:0 ens:1 stubs:0 stubs:1} +} -result {ens:0 ens:1 stubs:0 stubs:1} test clock-0.2 "initial: loading of format/locale does not overwrite interp state (errorInfo)" -setup { # be sure - we have no cached locale/msgcat, etc: -- cgit v0.12 From cc9af6e242a36149dbbf4f3e4029a579af506ed0 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 27 Mar 2024 20:18:32 +0000 Subject: fixes SF [edb4b065f49b9e51]: cherry-picked from 5d52c6d7302b320e] --- generic/tclStringObj.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 5ec026f..fc697f9 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -3968,7 +3968,7 @@ TclStringCmp( if (empty > 0) { switch (TclCheckEmptyString(value2Ptr)) { case -1: - s1 = 0; + s1 = ""; s1len = 0; s2 = TclGetStringFromObj(value2Ptr, &s2len); break; @@ -3983,7 +3983,7 @@ TclStringCmp( } else if (TclCheckEmptyString(value2Ptr) > 0) { switch (empty) { case -1: - s2 = 0; + s2 = ""; s2len = 0; s1 = TclGetStringFromObj(value1Ptr, &s1len); break; -- cgit v0.12 From 4e2cc7801a06a941b3bbfceffeb5f467350ff129 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 29 Mar 2024 12:26:11 +0000 Subject: Upgrade provided libtommath with version 1.3. Still works with external libtommath 1.2 too. --- generic/tclExecute.c | 3 +- generic/tclStubInit.c | 16 +- generic/tclTomMath.decls | 2 +- generic/tclTomMathDecls.h | 16 +- libtommath/CMakeLists.txt | 311 ++++++++++++++++++++++++ libtommath/appveyor.yml | 40 +-- libtommath/bn_deprecated.c | 61 ++++- libtommath/bn_mp_div_d.c | 4 +- libtommath/bn_mp_expt_n.c | 53 ++++ libtommath/bn_mp_exptmod.c | 4 +- libtommath/bn_mp_exteuclid.c | 4 +- libtommath/bn_mp_get_ll.c | 7 - libtommath/bn_mp_get_mag_ull.c | 7 - libtommath/bn_mp_init_ll.c | 7 - libtommath/bn_mp_init_ull.c | 7 - libtommath/bn_mp_lcm.c | 4 +- libtommath/bn_mp_log_n.c | 29 +++ libtommath/bn_mp_prime_frobenius_underwood.c | 4 +- libtommath/bn_mp_prime_rand.c | 5 +- libtommath/bn_mp_prime_strong_lucas_selfridge.c | 4 +- libtommath/bn_mp_root_n.c | 141 +++++++++++ libtommath/bn_mp_set_double.c | 4 +- libtommath/bn_mp_set_ll.c | 7 - libtommath/bn_mp_set_ull.c | 7 - libtommath/bn_mp_sqrtmod_prime.c | 4 +- libtommath/bn_s_mp_div_3.c | 63 +++++ libtommath/bn_s_mp_invmod_fast.c | 4 +- libtommath/bn_s_mp_invmod_slow.c | 4 +- libtommath/bn_s_mp_log.c | 81 ++++++ libtommath/bn_s_mp_log_2expt.c | 12 + libtommath/bn_s_mp_log_d.c | 65 +++++ libtommath/bn_s_mp_mul_high_digs_fast.c | 2 +- libtommath/bn_s_mp_toom_mul.c | 2 +- libtommath/changes.txt | 6 + libtommath/helper.pl | 38 ++- libtommath/libtommath.pc.in | 9 +- libtommath/libtommath_VS2008.sln | 2 +- libtommath/libtommath_VS2008.vcproj | 50 ++-- libtommath/makefile | 56 +++-- libtommath/makefile.mingw | 62 ++--- libtommath/makefile.msvc | 50 ++-- libtommath/makefile.shared | 53 ++-- libtommath/makefile.unix | 52 ++-- libtommath/makefile_include.mk | 6 +- libtommath/sources.cmake | 167 +++++++++++++ libtommath/tommath.def | 18 +- libtommath/tommath.h | 58 ++--- libtommath/tommath_class.h | 113 +++++---- libtommath/tommath_private.h | 11 +- libtommath/win32/libtommath.dll | Bin 72704 -> 71168 bytes libtommath/win32/tommath.lib | Bin 29796 -> 30148 bytes libtommath/win64-arm/libtommath.dll | Bin 69120 -> 70144 bytes libtommath/win64-arm/tommath.lib | Bin 28856 -> 29386 bytes libtommath/win64/libtommath.dll | Bin 81408 -> 81408 bytes libtommath/win64/tommath.lib | Bin 29044 -> 29386 bytes macosx/Tcl.xcodeproj/project.pbxproj | 16 +- unix/Makefile.in | 27 +- win/Makefile.in | 4 +- win/makefile.vc | 4 +- 59 files changed, 1378 insertions(+), 408 deletions(-) create mode 100644 libtommath/CMakeLists.txt create mode 100644 libtommath/bn_mp_expt_n.c delete mode 100644 libtommath/bn_mp_get_ll.c delete mode 100644 libtommath/bn_mp_get_mag_ull.c delete mode 100644 libtommath/bn_mp_init_ll.c delete mode 100644 libtommath/bn_mp_init_ull.c create mode 100644 libtommath/bn_mp_log_n.c create mode 100644 libtommath/bn_mp_root_n.c delete mode 100644 libtommath/bn_mp_set_ll.c delete mode 100644 libtommath/bn_mp_set_ull.c create mode 100644 libtommath/bn_s_mp_div_3.c create mode 100644 libtommath/bn_s_mp_log.c create mode 100644 libtommath/bn_s_mp_log_2expt.c create mode 100644 libtommath/bn_s_mp_log_d.c create mode 100644 libtommath/sources.cmake diff --git a/generic/tclExecute.c b/generic/tclExecute.c index de57fc5..962acba 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -8773,7 +8773,8 @@ ExecuteExtendedBinaryMathOp( Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); err = mp_init(&bigResult); if (err == MP_OKAY) { - err = mp_expt_u32(&big1, (unsigned int)w2, &bigResult); + /* Don't use "mp_expt_n" directly here, it doesn't exist in libtommath 1.2 */ + err = TclBN_mp_expt_n(&big1, (int)w2, &bigResult); } if (err != MP_OKAY) { return OUT_OF_MEMORY; diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 975e3ab..562bdef 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -188,6 +188,7 @@ static const char *TclUtfPrev(const char *src, const char *start) { #define TclBN_mp_zero mp_zero #define TclBN_s_mp_add s_mp_add #define TclBN_s_mp_balance_mul s_mp_balance_mul +#define TclBN_s_mp_div_3 s_mp_div_3 #define TclBN_mp_karatsuba_mul s_mp_karatsuba_mul #define TclBN_mp_karatsuba_sqr s_mp_karatsuba_sqr #define TclBN_s_mp_mul_digs s_mp_mul_digs @@ -226,7 +227,7 @@ static mp_err TclBN_mp_set_long(mp_int *a, unsigned long i) #define TclBN_mp_set_ul (void (*)(mp_int *a, unsigned long i))(void *)TclBN_mp_set_long mp_err MP_WUR TclBN_mp_expt_u32(const mp_int *a, unsigned int b, mp_int *c) { - return mp_expt_u32(a, b, c); + return TclBN_mp_expt_n(a, b, c); } mp_err TclBN_mp_add_d(const mp_int *a, unsigned int b, mp_int *c) { return mp_add_d(a, b, c); @@ -272,7 +273,6 @@ mp_err TclBN_mp_mul_d(const mp_int *a, unsigned int b, mp_int *c) { # define TclBN_mp_toradix_n 0 # undef TclBN_mp_sqr # define TclBN_mp_sqr 0 -# undef TclBN_mp_div_3 # define TclBN_mp_div_3 0 # define TclBN_mp_init_l 0 # define TclBN_mp_init_ul 0 @@ -587,6 +587,7 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ return result; } #define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))(void *)exprIntObj +#if !defined(TCL_NO_DEPRECATED) static int utfNcmp(const char *s1, const char *s2, unsigned int n){ return Tcl_UtfNcmp(s1, s2, (unsigned long)n); } @@ -595,6 +596,7 @@ static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){ return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n); } #define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcasecmp +#endif /* !defined(TCL_NO_DEPRECATED) */ #endif /* TCL_WIDE_INT_IS_LONG */ @@ -777,6 +779,14 @@ MODULE_SCOPE const TclTomMathStubs tclTomMathStubs; #pragma GCC diagnostic ignored "-Wdeprecated-declarations" #endif +#ifdef TCL_WITH_EXTERNAL_TOMMATH +/* If Tcl is linked with an external libtommath 1.2.x, then mp_expt_n doesn't + * exist (since that was introduced in libtommath 1.3.0. Provide it here.) */ +mp_err MP_WUR TclBN_mp_expt_n(const mp_int *a, int b, mp_int *c) { + return mp_expt_u32(a, (uint32_t)b, c);; +} +#endif /* TCL_WITH_EXTERNAL_TOMMATH */ + /* !BEGIN!: Do not edit below this line. */ static const TclIntStubs tclIntStubs = { @@ -1188,7 +1198,7 @@ const TclTomMathStubs tclTomMathStubs = { TclBN_mp_div_2d, /* 16 */ TclBN_mp_div_3, /* 17 */ TclBN_mp_exch, /* 18 */ - TclBN_mp_expt_u32, /* 19 */ + TclBN_mp_expt_n, /* 19 */ TclBN_mp_grow, /* 20 */ TclBN_mp_init, /* 21 */ TclBN_mp_init_copy, /* 22 */ diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls index 27c4f98..2d6bc61 100644 --- a/generic/tclTomMath.decls +++ b/generic/tclTomMath.decls @@ -80,7 +80,7 @@ declare 18 { void TclBN_mp_exch(mp_int *a, mp_int *b) } declare 19 { - mp_err MP_WUR TclBN_mp_expt_u32(const mp_int *a, unsigned int b, mp_int *c) + mp_err MP_WUR TclBN_mp_expt_n(const mp_int *a, int b, mp_int *c) } declare 20 { mp_err MP_WUR TclBN_mp_grow(mp_int *a, int size) diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h index b4ab607..657300f 100644 --- a/generic/tclTomMathDecls.h +++ b/generic/tclTomMathDecls.h @@ -63,17 +63,17 @@ #ifdef __cplusplus extern "C" { #endif +MODULE_SCOPE mp_err TclBN_s_mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c); +MODULE_SCOPE mp_err TclBN_s_mp_div_3(const mp_int *a, mp_int *c, mp_digit *d); MODULE_SCOPE mp_err TclBN_s_mp_add_d(const mp_int *a, mp_digit b, mp_int *c); MODULE_SCOPE mp_ord TclBN_s_mp_cmp_d(const mp_int *a, mp_digit b); MODULE_SCOPE mp_err TclBN_s_mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d); -MODULE_SCOPE mp_err TclBN_s_mp_div_3(const mp_int *a, mp_int *c, mp_digit *b); MODULE_SCOPE mp_err TclBN_s_mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c); MODULE_SCOPE mp_err TclBN_s_mp_init_set(mp_int *a, mp_digit b); MODULE_SCOPE mp_err TclBN_s_mp_mul_d(const mp_int *a, mp_digit b, mp_int *c); MODULE_SCOPE void TclBN_s_mp_reverse(unsigned char *s, size_t len); MODULE_SCOPE void TclBN_s_mp_set(mp_int *a, mp_digit b); MODULE_SCOPE mp_err TclBN_s_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c); -MODULE_SCOPE mp_err TclBN_s_mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c); MODULE_SCOPE const char *const TclBN_mp_s_rmap; MODULE_SCOPE const uint8_t TclBN_mp_s_rmap_reverse[]; MODULE_SCOPE const size_t TclBN_mp_s_rmap_reverse_sz; @@ -101,12 +101,12 @@ MODULE_SCOPE mp_err TclBN_mp_set_int(mp_int *a, unsigned long b); #define mp_div TclBN_mp_div #define mp_div_d TclBN_s_mp_div_d #define mp_div_2 TclBN_mp_div_2 -#define mp_div_3 TclBN_s_mp_div_3 #define mp_div_2d TclBN_mp_div_2d #define mp_exch TclBN_mp_exch #define mp_expt_d TclBN_mp_expt_d #define mp_expt_d_ex TclBN_mp_expt_d_ex #define mp_expt_u32 TclBN_s_mp_expt_u32 +#define mp_expt_n TclBN_mp_expt_n #define mp_get_mag_u64 TclBN_mp_get_mag_u64 #define mp_grow TclBN_mp_grow #define mp_init TclBN_mp_init @@ -157,6 +157,7 @@ MODULE_SCOPE mp_err TclBN_mp_set_int(mp_int *a, unsigned long b); #define mp_zero TclBN_mp_zero #define s_mp_add TclBN_s_mp_add #define s_mp_balance_mul TclBN_s_mp_balance_mul +#define s_mp_div_3 TclBN_s_mp_div_3 #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 @@ -249,8 +250,7 @@ mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, /* 18 */ EXTERN void TclBN_mp_exch(mp_int *a, mp_int *b); /* 19 */ -EXTERN mp_err TclBN_mp_expt_u32(const mp_int *a, unsigned int b, - mp_int *c) MP_WUR; +EXTERN mp_err TclBN_mp_expt_n(const mp_int *a, int b, mp_int *c) MP_WUR; /* 20 */ EXTERN mp_err TclBN_mp_grow(mp_int *a, int size) MP_WUR; /* 21 */ @@ -452,7 +452,7 @@ typedef struct TclTomMathStubs { mp_err (*tclBN_mp_div_2d) (const mp_int *a, int b, mp_int *q, mp_int *r) MP_WUR; /* 16 */ TCL_DEPRECATED_API("is private function in libtommath") mp_err (*tclBN_mp_div_3) (const mp_int *a, mp_int *q, unsigned int *r); /* 17 */ void (*tclBN_mp_exch) (mp_int *a, mp_int *b); /* 18 */ - mp_err (*tclBN_mp_expt_u32) (const mp_int *a, unsigned int b, mp_int *c) MP_WUR; /* 19 */ + mp_err (*tclBN_mp_expt_n) (const mp_int *a, int b, mp_int *c) MP_WUR; /* 19 */ mp_err (*tclBN_mp_grow) (mp_int *a, int size) MP_WUR; /* 20 */ mp_err (*tclBN_mp_init) (mp_int *a) MP_WUR; /* 21 */ mp_err (*tclBN_mp_init_copy) (mp_int *a, const mp_int *b) MP_WUR; /* 22 */ @@ -566,8 +566,8 @@ extern const TclTomMathStubs *tclTomMathStubsPtr; (tclTomMathStubsPtr->tclBN_mp_div_3) /* 17 */ #define TclBN_mp_exch \ (tclTomMathStubsPtr->tclBN_mp_exch) /* 18 */ -#define TclBN_mp_expt_u32 \ - (tclTomMathStubsPtr->tclBN_mp_expt_u32) /* 19 */ +#define TclBN_mp_expt_n \ + (tclTomMathStubsPtr->tclBN_mp_expt_n) /* 19 */ #define TclBN_mp_grow \ (tclTomMathStubsPtr->tclBN_mp_grow) /* 20 */ #define TclBN_mp_init \ diff --git a/libtommath/CMakeLists.txt b/libtommath/CMakeLists.txt new file mode 100644 index 0000000..0b84e79 --- /dev/null +++ b/libtommath/CMakeLists.txt @@ -0,0 +1,311 @@ +# SPDX-License-Identifier: Unlicense +# +# LibTomMath, a free open source portable number theoretic multiple-precision +# integer (MPI) library written entirely in C. +# + +cmake_minimum_required(VERSION 3.10) + +project(libtommath + VERSION 1.3.0 + DESCRIPTION "A free open source portable number theoretic multiple-precision integer (MPI) library written entirely in C." + HOMEPAGE_URL "https://www.libtom.net/LibTomMath" + LANGUAGES C) + +# package release version +# bump if re-releasing the same VERSION + patches +# set to 1 if releasing a new VERSION +set(PACKAGE_RELEASE_VERSION 1) + +#----------------------------------------------------------------------------- +# Include cmake modules +#----------------------------------------------------------------------------- +include(GNUInstallDirs) +include(CheckIPOSupported) +include(CMakePackageConfigHelpers) +# default is "No tests" +option(BUILD_TESTING "" OFF) +include(CTest) +include(sources.cmake) + +#----------------------------------------------------------------------------- +# Options +#----------------------------------------------------------------------------- +option(BUILD_SHARED_LIBS "Build shared library and only the shared library if \"ON\", default is static" OFF) + +#----------------------------------------------------------------------------- +# Add support for ccache if desired +#----------------------------------------------------------------------------- +find_program(CCACHE ccache) + +if(CCACHE) + option(ENABLE_CCACHE "Enable ccache." ON) +endif() + +# use ccache if installed +if(CCACHE AND ENABLE_CCACHE) + set(CMAKE_C_COMPILER_LAUNCHER ${CCACHE}) +endif() + +#----------------------------------------------------------------------------- +# Compose CFLAGS +#----------------------------------------------------------------------------- + +# Some information ported from makefile_include.mk + + +if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) + message(STATUS "Setting build type to 'Release' as none was specified.") + set(CMAKE_BUILD_TYPE "Release") +endif() + +# We only differentiate between MSVC and GCC-compatible compilers +if(MSVC) + set(LTM_C_FLAGS -W3) +elseif(WATCOM) + set(LTM_C_FLAGS -fo=.obj -oaxt -3r -w3) +else() + set(LTM_C_FLAGS -Wall -Wsign-compare -Wextra -Wshadow + -Wdeclaration-after-statement -Wbad-function-cast -Wcast-align + -Wstrict-prototypes -Wpointer-arith -Wsystem-headers) + set(CMAKE_C_FLAGS_DEBUG "-g3") + set(CMAKE_C_FLAGS_RELEASE "-O3 -funroll-loops -fomit-frame-pointer") + set(CMAKE_C_FLAGS_RELWITHDEBINFO "-g3 -O2") + set(CMAKE_C_FLAGS_MINSIZEREL "-Os") +endif() + +# What compiler do we have and what are their...uhm... peculiarities +if(CMAKE_C_COMPILER_ID MATCHES "(C|c?)lang") + list(APPEND LTM_C_FLAGS -Wno-typedef-redefinition -Wno-tautological-compare -Wno-builtin-requires-header) + # Clang requires at least '-O1' for dead code elimination + set(CMAKE_C_FLAGS_DEBUG "-O1 ${CMAKE_C_FLAGS_DEBUG}") +endif() +if(CMAKE_C_COMPILER MATCHES "mingw") + list(APPEND LTM_C_FLAGS -Wno-shadow -Wno-expansion-to-defined -Wno-declaration-after-statement -Wno-bad-function-cast) +endif() +if(CMAKE_SYSTEM_NAME MATCHES "Darwin") + list(APPEND LTM_C_FLAGS -Wno-nullability-completeness) +endif() +if(CMAKE_SYSTEM_NAME MATCHES "CYGWIN") + list(APPEND LTM_C_FLAGS -no-undefined) +endif() + +# TODO: coverage (lgcov) + +# If the user set the environment variables at generate-time, append them +# in order to allow overriding our defaults. +# ${LTM_CFLAGS} means the user passed it via sth like: +# $ cmake -DLTM_CFLAGS="foo" +list(APPEND LTM_C_FLAGS ${LTM_CFLAGS}) +list(APPEND LTM_LD_FLAGS ${LTM_LDFLAGS}) + +#----------------------------------------------------------------------------- +# library target +#----------------------------------------------------------------------------- +add_library(${PROJECT_NAME} + ${SOURCES} + ${HEADERS} +) + +target_include_directories(${PROJECT_NAME} PUBLIC + $ + $ +) + +target_compile_options(${PROJECT_NAME} BEFORE PRIVATE + ${LTM_C_FLAGS} +) +target_link_options(${PROJECT_NAME} BEFORE PRIVATE + ${LTM_LD_FLAGS} +) + +set(PUBLIC_HEADERS tommath.h) +set(C89 False CACHE BOOL "(Usually maintained automatically) Enable when the library is in c89 mode to package the correct header files on install") +if(C89) + list(APPEND PUBLIC_HEADERS tommath_c89.h) +endif() + +set_target_properties(${PROJECT_NAME} PROPERTIES + OUTPUT_NAME tommath + VERSION ${PROJECT_VERSION} + SOVERSION ${PROJECT_VERSION_MAJOR} + PUBLIC_HEADER "${PUBLIC_HEADERS}" +) + +option(COMPILE_LTO "Build with LTO enabled") +if(COMPILE_LTO) + check_ipo_supported(RESULT COMPILER_SUPPORTS_LTO) + if(COMPILER_SUPPORTS_LTO) + set_property(TARGET ${PROJECT_NAME} PROPERTY INTERPROCEDURAL_OPTIMIZATION TRUE) + else() + message(SEND_ERROR "This compiler does not support LTO. Reconfigure ${PROJECT_NAME} with -DCOMPILE_LTO=OFF.") + endif() +endif() + +#----------------------------------------------------------------------------- +# demo target +#----------------------------------------------------------------------------- + +if(BUILD_TESTING) + enable_testing() + add_subdirectory(demo) +endif() + +#----------------------------------------------------------------------------- +# Install/export targets and files +#----------------------------------------------------------------------------- +set(CONFIG_INSTALL_DIR "${CMAKE_INSTALL_LIBDIR}/cmake/${PROJECT_NAME}") +set(PROJECT_VERSION_FILE "${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}-config-version.cmake") +set(PROJECT_CONFIG_FILE "${PROJECT_NAME}-config.cmake") +set(TARGETS_EXPORT_NAME "${PROJECT_NAME}Targets") + +install(TARGETS ${PROJECT_NAME} + EXPORT ${TARGETS_EXPORT_NAME} + LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR} + ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} COMPONENT Libraries + RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} + PUBLIC_HEADER DESTINATION ${CMAKE_INSTALL_INCLUDEDIR} +) + +# Install libtommath.pc for pkg-config if we build a shared library +if(BUILD_SHARED_LIBS) + # Let the user override the default directory of the pkg-config file (usually this shouldn't be required to be changed) + set(CMAKE_INSTALL_PKGCONFIGDIR "${CMAKE_INSTALL_LIBDIR}/pkgconfig" CACHE PATH "Folder where to install .pc files") + + configure_file( + ${CMAKE_CURRENT_SOURCE_DIR}/${PROJECT_NAME}.pc.in + ${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}.pc + @ONLY + ) + + install(FILES ${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME}.pc + DESTINATION ${CMAKE_INSTALL_PKGCONFIGDIR} + ) +endif() + +# generate package version file +write_basic_package_version_file( + ${PROJECT_VERSION_FILE} + VERSION ${PROJECT_VERSION} + COMPATIBILITY SameMajorVersion +) + +# install version file +install(FILES ${PROJECT_VERSION_FILE} + DESTINATION ${CONFIG_INSTALL_DIR} +) + +# build directory package config +export(EXPORT ${TARGETS_EXPORT_NAME} + FILE ${PROJECT_CONFIG_FILE} +) + +# installed package config +install(EXPORT ${TARGETS_EXPORT_NAME} + DESTINATION ${CONFIG_INSTALL_DIR} + FILE ${PROJECT_CONFIG_FILE} +) + +# add to CMake registry +export(PACKAGE ${PROJECT_NAME}) + +#--------------------------------------------------------------------------------------- +# Create release packages +#--------------------------------------------------------------------------------------- + +# determine distribution and architecture +find_program(LSB_RELEASE lsb_release) +find_program(SYSCTL sysctl) +find_program(UNAME uname) + +if(UNAME) + execute_process(COMMAND uname -m OUTPUT_VARIABLE MACHINE_ARCH OUTPUT_STRIP_TRAILING_WHITESPACE) +elseif(SYSCTL) + execute_process(COMMAND sysctl -b hw.machine_arch OUTPUT_VARIABLE MACHINE_ARCH OUTPUT_STRIP_TRAILING_WHITESPACE) +else() + string(TOLOWER ${CMAKE_SYSTEM_NAME} MACHINE_ARCH) +endif() + +if(LSB_RELEASE) + execute_process(COMMAND lsb_release -si OUTPUT_VARIABLE LINUX_DISTRO OUTPUT_STRIP_TRAILING_WHITESPACE) + execute_process(COMMAND lsb_release -sc OUTPUT_VARIABLE LINUX_DISTRO_CODENAME OUTPUT_STRIP_TRAILING_WHITESPACE) + execute_process(COMMAND lsb_release -sr OUTPUT_VARIABLE LINUX_DISTRO_VERSION OUTPUT_STRIP_TRAILING_WHITESPACE) + + string(TOLOWER ${LINUX_DISTRO} LINUX_DISTRO) + if(LINUX_DISTRO_CODENAME STREQUAL "n/a") + set(DISTRO_PACK_PATH ${LINUX_DISTRO}/${LINUX_DISTRO_VERSION}/) + else() + set(DISTRO_PACK_PATH ${LINUX_DISTRO}/${LINUX_DISTRO_CODENAME}/) + endif() +else() + set(DISTRO_PACK_PATH ${CMAKE_SYSTEM_NAME}/) +endif() + +# make sure untagged versions get a different package name +execute_process(COMMAND git describe --exact-match --tags ERROR_QUIET RESULT_VARIABLE REPO_HAS_TAG) +if(REPO_HAS_TAG EQUAL 0) + set(PACKAGE_NAME_SUFFIX "") +else() + set(PACKAGE_NAME_SUFFIX "-git") + message(STATUS "Use -git suffix") +endif() + +# default CPack generators +set(CPACK_GENERATOR TGZ STGZ) + +# extra CPack generators +if(LINUX_DISTRO STREQUAL "debian" OR LINUX_DISTRO STREQUAL "ubuntu" OR LINUX_DISTRO STREQUAL "linuxmint") + list(APPEND CPACK_GENERATOR DEB) +elseif(LINUX_DISTRO STREQUAL "fedora" OR LINUX_DISTRO STREQUAL "opensuse" OR LINUX_DISTRO STREQUAL "centos") + list(APPEND CPACK_GENERATOR RPM) +elseif(CMAKE_SYSTEM_NAME STREQUAL "FreeBSD") + list(APPEND CPACK_GENERATOR FREEBSD) +endif() + +set(LTM_DEBIAN_SHARED_PACKAGE_NAME "${PROJECT_NAME}${PACKAGE_NAME_SUFFIX}${PROJECT_VERSION_MAJOR}") + +# general CPack config +set(CPACK_PACKAGE_DIRECTORY ${CMAKE_BINARY_DIR}/packages/${DISTRO_PACK_PATH}) +message(STATUS "CPack: packages will be generated under ${CPACK_PACKAGE_DIRECTORY}") +if(BUILD_SHARED_LIBS) + set(CPACK_PACKAGE_NAME "${PROJECT_NAME}${PROJECT_VERSION_MAJOR}") + set(CPACK_DEBIAN_PACKAGE_NAME "${LTM_DEBIAN_SHARED_PACKAGE_NAME}") +else() + set(CPACK_PACKAGE_NAME "${PROJECT_NAME}-devel") + set(CPACK_DEBIAN_LIBRARIES_PACKAGE_NAME "${PROJECT_NAME}${PACKAGE_NAME_SUFFIX}-dev") +endif() +set(CPACK_PACKAGE_VERSION ${PROJECT_VERSION}) +set(CPACK_PACKAGE_DESCRIPTION_SUMMARY "LibTomMath") +set(CPACK_PACKAGE_VENDOR "libtom projects") +set(CPACK_PACKAGE_CONTACT "libtom@googlegroups.com") +set(CPACK_RESOURCE_FILE_LICENSE "${PROJECT_SOURCE_DIR}/LICENSE") +set(PACKAGE_NAME_TRAILER ${CPACK_PACKAGE_VERSION}-${PACKAGE_RELEASE_VERSION}_${MACHINE_ARCH}) +set(CPACK_PACKAGE_FILE_NAME ${CPACK_PACKAGE_NAME}-${PACKAGE_NAME_TRAILER}) + +# deb specific CPack config +set(CPACK_DEBIAN_FILE_NAME DEB-DEFAULT) +set(CPACK_DEBIAN_DEBUGINFO_PACKAGE ON) +set(CPACK_DEBIAN_PACKAGE_RELEASE ${PACKAGE_RELEASE_VERSION}) +set(CPACK_DEBIAN_PACKAGE_SHLIBDEPS ON) +if(BUILD_SHARED_LIBS) + set(CPACK_DEBIAN_PACKAGE_SECTION "libs") +else() + set(CPACK_DEBIAN_PACKAGE_SECTION "devel") + set(CPACK_DEBIAN_PACKAGE_DEPENDS ${LTM_DEBIAN_SHARED_PACKAGE_NAME}) + set(CPACK_DEB_COMPONENT_INSTALL ON) + set(CPACK_ARCHIVE_COMPONENT_INSTALL ON) + set(CPACK_COMPONENTS_ALL Libraries) +endif() + +# rpm specific CPack config +set(CPACK_RPM_PACKAGE_RELEASE ${PACKAGE_RELEASE_VERSION}) +set(CPACK_RPM_PACKAGE_ARCHITECTURE ${MACHINE_ARCH}) +set(CPACK_RPM_PACKAGE_NAME "${CPACK_PACKAGE_NAME}-${PROJECT_VERSION}") +set(CPACK_RPM_PACKAGE_LICENSE "The Unlicense") + +# FreeBSD specific CPack config +set(CPACK_FREEBSD_PACKAGE_MAINTAINER "gahr@FreeBSD.org") +set(CPACK_FREEBSD_PACKAGE_ORIGIN "math/libtommath") +set(CPACK_FREEBSD_PACKAGE_CATEGORIES "math") + +include(CPack) diff --git a/libtommath/appveyor.yml b/libtommath/appveyor.yml index 0a8e075..e235491 100644 --- a/libtommath/appveyor.yml +++ b/libtommath/appveyor.yml @@ -1,20 +1,20 @@ -version: 1.2.1-{build} -branches: - only: - - master - - develop - - /^release/ - - /^travis/ -image: -- Visual Studio 2019 -- Visual Studio 2017 -- Visual Studio 2015 -build_script: -- cmd: >- - if "Visual Studio 2019"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvars64.bat" - if "Visual Studio 2017"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\VC\Auxiliary\Build\vcvars64.bat" - if "Visual Studio 2015"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin\SetEnv.cmd" /x64 - if "Visual Studio 2015"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\vcvarsall.bat" x86_amd64 - nmake -f makefile.msvc all -test_script: -- cmd: test.exe +version: 1.3.0-{build} +branches: + only: + - master + - develop + - /^release/ + - /^travis/ +image: +- Visual Studio 2019 +- Visual Studio 2017 +- Visual Studio 2015 +build_script: +- cmd: >- + if "Visual Studio 2019"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvars64.bat" + if "Visual Studio 2017"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\VC\Auxiliary\Build\vcvars64.bat" + if "Visual Studio 2015"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin\SetEnv.cmd" /x64 + if "Visual Studio 2015"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\vcvarsall.bat" x86_amd64 + nmake -f makefile.msvc all +test_script: +- cmd: test.exe diff --git a/libtommath/bn_deprecated.c b/libtommath/bn_deprecated.c index 2056b20..fc19092 100644 --- a/libtommath/bn_deprecated.c +++ b/libtommath/bn_deprecated.c @@ -74,6 +74,12 @@ mp_err mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c) return s_mp_balance_mul(a, b, c); } #endif +#ifdef BN_MP_DIV_3_C +mp_err mp_div_3(const mp_int *a, mp_int *c, mp_digit *d) +{ + return s_mp_div_3(a, c, d); +} +#endif #ifdef BN_MP_EXPTMOD_FAST_C mp_err mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) { @@ -184,51 +190,88 @@ unsigned long mp_get_long(const mp_int *a) #ifdef BN_MP_GET_LONG_LONG_C unsigned long long mp_get_long_long(const mp_int *a) { - return mp_get_mag_ull(a); + return (unsigned long long)mp_get_mag_u64(a); } #endif +#ifdef BN_MP_GET_LL_C +MP_GET_SIGNED(mp_get_ll, mp_get_mag_u64, long long, uint64_t) +#endif +#ifdef BN_MP_GET_MAG_ULL_C +MP_GET_MAG(mp_get_mag_ull, unsigned long long) +#endif +#ifdef BN_MP_INIT_LL_C +MP_INIT_INT(mp_init_ll, mp_set_i64, long long) +#endif +#ifdef BN_MP_SET_LL_C +MP_SET_SIGNED(mp_set_ll, mp_set_i64, long long, long long) +#endif +#ifdef BN_MP_INIT_ULL_C +MP_INIT_INT(mp_init_ull, mp_set_u64, unsigned long long) +#endif +#ifdef BN_MP_SET_ULL_C +MP_SET_UNSIGNED(mp_set_ull, unsigned long long) +#endif #ifdef BN_MP_PRIME_IS_DIVISIBLE_C mp_err mp_prime_is_divisible(const mp_int *a, mp_bool *result) { return s_mp_prime_is_divisible(a, result); } #endif +#ifdef BN_MP_LOG_U32_C +mp_err mp_log_u32(const mp_int *a, uint32_t base, uint32_t *c) +{ + mp_err e; + int c_; + if (base > MP_MIN(MP_DIGIT_MAX, INT_MAX)) { + return MP_VAL; + } + e = mp_log_n(a, (int)base, &c_); + *c = (uint32_t)c_; + return e; +} +#endif #ifdef BN_MP_EXPT_D_EX_C mp_err mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) { (void)fast; - if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) { + if (b > MP_MIN(MP_DIGIT_MAX, INT_MAX)) { return MP_VAL; } - return mp_expt_u32(a, (uint32_t)b, c); + return mp_expt_n(a, (int)b, c); } #endif #ifdef BN_MP_EXPT_D_C mp_err mp_expt_d(const mp_int *a, mp_digit b, mp_int *c) { - if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) { + if (b > MP_MIN(MP_DIGIT_MAX, INT_MAX)) { return MP_VAL; } - return mp_expt_u32(a, (uint32_t)b, c); + return mp_expt_n(a, (int)b, c); } #endif #ifdef BN_MP_N_ROOT_EX_C mp_err mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) { (void)fast; - if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) { + if (b > MP_MIN(MP_DIGIT_MAX, INT_MAX)) { return MP_VAL; } - return mp_root_u32(a, (uint32_t)b, c); + return mp_root_n(a, (int)b, c); } #endif #ifdef BN_MP_N_ROOT_C mp_err mp_n_root(const mp_int *a, mp_digit b, mp_int *c) { - if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) { + if (b > MP_MIN(MP_DIGIT_MAX, INT_MAX)) { return MP_VAL; } - return mp_root_u32(a, (uint32_t)b, c); + return mp_root_n(a, (int)b, c); +} +#endif +#ifdef BN_MP_ROOT_U32_C +mp_err mp_root_u32(const mp_int *a, uint32_t b, mp_int *c) +{ + return mp_root_n(a, (int)b, c); } #endif #ifdef BN_MP_UNSIGNED_BIN_SIZE_C diff --git a/libtommath/bn_mp_div_d.c b/libtommath/bn_mp_div_d.c index b9d718b..24a2c19 100644 --- a/libtommath/bn_mp_div_d.c +++ b/libtommath/bn_mp_div_d.c @@ -44,8 +44,8 @@ mp_err mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d) } /* three? */ - if (MP_HAS(MP_DIV_3) && (b == 3u)) { - return mp_div_3(a, c, d); + if (MP_HAS(S_MP_DIV_3) && (b == 3u)) { + return s_mp_div_3(a, c, d); } /* no easy answer [c'est la vie]. Just division */ diff --git a/libtommath/bn_mp_expt_n.c b/libtommath/bn_mp_expt_n.c new file mode 100644 index 0000000..19c0225 --- /dev/null +++ b/libtommath/bn_mp_expt_n.c @@ -0,0 +1,53 @@ +#include "tommath_private.h" +#ifdef BN_MP_EXPT_N_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +#ifdef BN_MP_EXPT_U32_C +mp_err mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c) +{ + if (b > MP_MIN(MP_DIGIT_MAX, INT_MAX)) { + return MP_VAL; + } + return mp_expt_n(a, (int)b, c); +} +#endif + +/* calculate c = a**b using a square-multiply algorithm */ +mp_err mp_expt_n(const mp_int *a, int b, mp_int *c) +{ + mp_err err; + mp_int g; + + if ((err = mp_init_copy(&g, a)) != MP_OKAY) { + return err; + } + + /* set initial result */ + mp_set(c, 1uL); + + while (b > 0) { + /* if the bit is set multiply */ + if ((b & 1) != 0) { + if ((err = mp_mul(c, &g, c)) != MP_OKAY) { + goto LBL_ERR; + } + } + + /* square */ + if (b > 1) { + if ((err = mp_sqr(&g, &g)) != MP_OKAY) { + goto LBL_ERR; + } + } + + /* shift to next bit */ + b >>= 1; + } + +LBL_ERR: + mp_clear(&g); + return err; +} + +#endif diff --git a/libtommath/bn_mp_exptmod.c b/libtommath/bn_mp_exptmod.c index 5f811eb..1ca2e93 100644 --- a/libtommath/bn_mp_exptmod.c +++ b/libtommath/bn_mp_exptmod.c @@ -26,7 +26,7 @@ mp_err mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y) return MP_VAL; } - if ((err = mp_init_multi(&tmpG, &tmpX, NULL)) != MP_OKAY) { + if ((err = mp_init_multi(&tmpG, &tmpX, (void *)NULL)) != MP_OKAY) { return err; } @@ -43,7 +43,7 @@ mp_err mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y) /* and now compute (1/G)**|X| instead of G**X [X < 0] */ err = mp_exptmod(&tmpG, &tmpX, P, Y); LBL_ERR: - mp_clear_multi(&tmpG, &tmpX, NULL); + mp_clear_multi(&tmpG, &tmpX, (void *)NULL); return err; } diff --git a/libtommath/bn_mp_exteuclid.c b/libtommath/bn_mp_exteuclid.c index faf47ba..fbac454 100644 --- a/libtommath/bn_mp_exteuclid.c +++ b/libtommath/bn_mp_exteuclid.c @@ -11,7 +11,7 @@ mp_err mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp mp_int u1, u2, u3, v1, v2, v3, t1, t2, t3, q, tmp; mp_err err; - if ((err = mp_init_multi(&u1, &u2, &u3, &v1, &v2, &v3, &t1, &t2, &t3, &q, &tmp, NULL)) != MP_OKAY) { + if ((err = mp_init_multi(&u1, &u2, &u3, &v1, &v2, &v3, &t1, &t2, &t3, &q, &tmp, (void *)NULL)) != MP_OKAY) { return err; } @@ -67,7 +67,7 @@ mp_err mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp err = MP_OKAY; LBL_ERR: - mp_clear_multi(&u1, &u2, &u3, &v1, &v2, &v3, &t1, &t2, &t3, &q, &tmp, NULL); + mp_clear_multi(&u1, &u2, &u3, &v1, &v2, &v3, &t1, &t2, &t3, &q, &tmp, (void *)NULL); return err; } #endif diff --git a/libtommath/bn_mp_get_ll.c b/libtommath/bn_mp_get_ll.c deleted file mode 100644 index 2687534..0000000 --- a/libtommath/bn_mp_get_ll.c +++ /dev/null @@ -1,7 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_GET_LL_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis */ -/* SPDX-License-Identifier: Unlicense */ - -MP_GET_SIGNED(mp_get_ll, mp_get_mag_ull, long long, unsigned long long) -#endif diff --git a/libtommath/bn_mp_get_mag_ull.c b/libtommath/bn_mp_get_mag_ull.c deleted file mode 100644 index 63a2741..0000000 --- a/libtommath/bn_mp_get_mag_ull.c +++ /dev/null @@ -1,7 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_GET_MAG_ULL_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis */ -/* SPDX-License-Identifier: Unlicense */ - -MP_GET_MAG(mp_get_mag_ull, unsigned long long) -#endif diff --git a/libtommath/bn_mp_init_ll.c b/libtommath/bn_mp_init_ll.c deleted file mode 100644 index dc7c4a4..0000000 --- a/libtommath/bn_mp_init_ll.c +++ /dev/null @@ -1,7 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_INIT_LL_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis */ -/* SPDX-License-Identifier: Unlicense */ - -MP_INIT_INT(mp_init_ll, mp_set_ll, long long) -#endif diff --git a/libtommath/bn_mp_init_ull.c b/libtommath/bn_mp_init_ull.c deleted file mode 100644 index 84110c0..0000000 --- a/libtommath/bn_mp_init_ull.c +++ /dev/null @@ -1,7 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_INIT_ULL_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis */ -/* SPDX-License-Identifier: Unlicense */ - -MP_INIT_INT(mp_init_ull, mp_set_ull, unsigned long long) -#endif diff --git a/libtommath/bn_mp_lcm.c b/libtommath/bn_mp_lcm.c index c32b269..5be3fc6 100644 --- a/libtommath/bn_mp_lcm.c +++ b/libtommath/bn_mp_lcm.c @@ -10,7 +10,7 @@ mp_err mp_lcm(const mp_int *a, const mp_int *b, mp_int *c) mp_int t1, t2; - if ((err = mp_init_multi(&t1, &t2, NULL)) != MP_OKAY) { + if ((err = mp_init_multi(&t1, &t2, (void *)NULL)) != MP_OKAY) { return err; } @@ -38,7 +38,7 @@ mp_err mp_lcm(const mp_int *a, const mp_int *b, mp_int *c) c->sign = MP_ZPOS; LBL_T: - mp_clear_multi(&t1, &t2, NULL); + mp_clear_multi(&t1, &t2, (void *)NULL); return err; } #endif diff --git a/libtommath/bn_mp_log_n.c b/libtommath/bn_mp_log_n.c new file mode 100644 index 0000000..d866fa0 --- /dev/null +++ b/libtommath/bn_mp_log_n.c @@ -0,0 +1,29 @@ +#include "tommath_private.h" +#ifdef BN_MP_LOG_N_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +mp_err mp_log_n(const mp_int *a, int base, int *c) +{ + if (mp_isneg(a) || mp_iszero(a) || (base < 2) || (unsigned)base > (unsigned)MP_DIGIT_MAX) { + return MP_VAL; + } + + if (MP_HAS(S_MP_LOG_2EXPT) && MP_IS_2EXPT((mp_digit)base)) { + *c = s_mp_log_2expt(a, (mp_digit)base); + return MP_OKAY; + } + + if (MP_HAS(S_MP_LOG_D) && (a->used == 1)) { + *c = s_mp_log_d((mp_digit)base, a->dp[0]); + return MP_OKAY; + } + + if (MP_HAS(S_MP_LOG)) { + return s_mp_log(a, (mp_digit)base, c); + } + + return MP_VAL; +} + +#endif diff --git a/libtommath/bn_mp_prime_frobenius_underwood.c b/libtommath/bn_mp_prime_frobenius_underwood.c index 253e8d5..be4bd08 100644 --- a/libtommath/bn_mp_prime_frobenius_underwood.c +++ b/libtommath/bn_mp_prime_frobenius_underwood.c @@ -32,7 +32,7 @@ mp_err mp_prime_frobenius_underwood(const mp_int *N, mp_bool *result) *result = MP_NO; - if ((err = mp_init_multi(&T1z, &T2z, &Np1z, &sz, &tz, NULL)) != MP_OKAY) { + if ((err = mp_init_multi(&T1z, &T2z, &Np1z, &sz, &tz, (void *)NULL)) != MP_OKAY) { return err; } @@ -124,7 +124,7 @@ mp_err mp_prime_frobenius_underwood(const mp_int *N, mp_bool *result) } LBL_FU_ERR: - mp_clear_multi(&tz, &sz, &Np1z, &T2z, &T1z, NULL); + mp_clear_multi(&tz, &sz, &Np1z, &T2z, &T1z, (void *)NULL); return err; } diff --git a/libtommath/bn_mp_prime_rand.c b/libtommath/bn_mp_prime_rand.c index 4530e9a..b931569 100644 --- a/libtommath/bn_mp_prime_rand.c +++ b/libtommath/bn_mp_prime_rand.c @@ -36,7 +36,10 @@ mp_err s_mp_prime_random_ex(mp_int *a, int t, int size, int flags, private_mp_pr } /* calc the byte size */ - bsize = (size>>3) + ((size&7)?1:0); + bsize = (size>>3); + if (size&7) { + bsize++; + } /* we need a buffer of bsize bytes */ tmp = (unsigned char *) MP_MALLOC((size_t)bsize); diff --git a/libtommath/bn_mp_prime_strong_lucas_selfridge.c b/libtommath/bn_mp_prime_strong_lucas_selfridge.c index b50bbcd..617648c 100644 --- a/libtommath/bn_mp_prime_strong_lucas_selfridge.c +++ b/libtommath/bn_mp_prime_strong_lucas_selfridge.c @@ -73,7 +73,7 @@ mp_err mp_prime_strong_lucas_selfridge(const mp_int *a, mp_bool *result) */ if ((err = mp_init_multi(&Dz, &gcd, &Np1, &Uz, &Vz, &U2mz, &V2mz, &Qmz, &Q2mz, &Qkdz, &T1z, &T2z, &T3z, &T4z, &Q2kdz, - NULL)) != MP_OKAY) { + (void *)NULL)) != MP_OKAY) { return err; } @@ -281,7 +281,7 @@ mp_err mp_prime_strong_lucas_selfridge(const mp_int *a, mp_bool *result) } } LBL_LS_ERR: - mp_clear_multi(&Q2kdz, &T4z, &T3z, &T2z, &T1z, &Qkdz, &Q2mz, &Qmz, &V2mz, &U2mz, &Vz, &Uz, &Np1, &gcd, &Dz, NULL); + mp_clear_multi(&Q2kdz, &T4z, &T3z, &T2z, &T1z, &Qkdz, &Q2mz, &Qmz, &V2mz, &U2mz, &Vz, &Uz, &Np1, &gcd, &Dz, (void *)NULL); return err; } #endif diff --git a/libtommath/bn_mp_root_n.c b/libtommath/bn_mp_root_n.c new file mode 100644 index 0000000..c028ef1 --- /dev/null +++ b/libtommath/bn_mp_root_n.c @@ -0,0 +1,141 @@ +#include "tommath_private.h" +#ifdef BN_MP_ROOT_N_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* find the n'th root of an integer + * + * Result found such that (c)**b <= a and (c+1)**b > a + * + * This algorithm uses Newton's approximation + * x[i+1] = x[i] - f(x[i])/f'(x[i]) + * which will find the root in log(N) time where + * each step involves a fair bit. + */ +mp_err mp_root_n(const mp_int *a, int b, mp_int *c) +{ + mp_int t1, t2, t3, a_; + int ilog2; + mp_err err; + + if ((unsigned)b > (unsigned)MP_MIN(MP_DIGIT_MAX, INT_MAX)) { + return MP_VAL; + } + + /* input must be positive if b is even */ + if (((b & 1) == 0) && mp_isneg(a)) { + return MP_VAL; + } + + if ((err = mp_init_multi(&t1, &t2, &t3, (void *)NULL)) != MP_OKAY) { + return err; + } + + /* if a is negative fudge the sign but keep track */ + a_ = *a; + a_.sign = MP_ZPOS; + + /* Compute seed: 2^(log_2(n)/b + 2)*/ + ilog2 = mp_count_bits(a); + + /* + If "b" is larger than INT_MAX it is also larger than + log_2(n) because the bit-length of the "n" is measured + with an int and hence the root is always < 2 (two). + */ + if (b > INT_MAX/2) { + mp_set(c, 1uL); + c->sign = a->sign; + err = MP_OKAY; + goto LBL_ERR; + } + + /* "b" is smaller than INT_MAX, we can cast safely */ + if (ilog2 < b) { + mp_set(c, 1uL); + c->sign = a->sign; + err = MP_OKAY; + goto LBL_ERR; + } + ilog2 = ilog2 / b; + if (ilog2 == 0) { + mp_set(c, 1uL); + c->sign = a->sign; + err = MP_OKAY; + goto LBL_ERR; + } + /* Start value must be larger than root */ + ilog2 += 2; + if ((err = mp_2expt(&t2,ilog2)) != MP_OKAY) goto LBL_ERR; + do { + /* t1 = t2 */ + if ((err = mp_copy(&t2, &t1)) != MP_OKAY) goto LBL_ERR; + + /* t2 = t1 - ((t1**b - a) / (b * t1**(b-1))) */ + + /* t3 = t1**(b-1) */ + if ((err = mp_expt_n(&t1, b - 1, &t3)) != MP_OKAY) goto LBL_ERR; + + /* numerator */ + /* t2 = t1**b */ + if ((err = mp_mul(&t3, &t1, &t2)) != MP_OKAY) goto LBL_ERR; + + /* t2 = t1**b - a */ + if ((err = mp_sub(&t2, &a_, &t2)) != MP_OKAY) goto LBL_ERR; + + /* denominator */ + /* t3 = t1**(b-1) * b */ + if ((err = mp_mul_d(&t3, (mp_digit)b, &t3)) != MP_OKAY) goto LBL_ERR; + + /* t3 = (t1**b - a)/(b * t1**(b-1)) */ + if ((err = mp_div(&t2, &t3, &t3, NULL)) != MP_OKAY) goto LBL_ERR; + + if ((err = mp_sub(&t1, &t3, &t2)) != MP_OKAY) goto LBL_ERR; + + /* + Number of rounds is at most log_2(root). If it is more it + got stuck, so break out of the loop and do the rest manually. + */ + if (ilog2-- == 0) { + break; + } + } while (mp_cmp(&t1, &t2) != MP_EQ); + + /* result can be off by a few so check */ + /* Loop beneath can overshoot by one if found root is smaller than actual root */ + for (;;) { + mp_ord cmp; + if ((err = mp_expt_n(&t1, b, &t2)) != MP_OKAY) goto LBL_ERR; + cmp = mp_cmp(&t2, &a_); + if (cmp == MP_EQ) { + err = MP_OKAY; + goto LBL_ERR; + } + if (cmp == MP_LT) { + if ((err = mp_add_d(&t1, 1uL, &t1)) != MP_OKAY) goto LBL_ERR; + } else { + break; + } + } + /* correct overshoot from above or from recurrence */ + for (;;) { + if ((err = mp_expt_n(&t1, b, &t2)) != MP_OKAY) goto LBL_ERR; + if (mp_cmp(&t2, &a_) == MP_GT) { + if ((err = mp_sub_d(&t1, 1uL, &t1)) != MP_OKAY) goto LBL_ERR; + } else { + break; + } + } + + /* set the result */ + mp_exch(&t1, c); + + /* set the sign of the result */ + c->sign = a->sign; + +LBL_ERR: + mp_clear_multi(&t1, &t2, &t3, (void *)NULL); + return err; +} + +#endif diff --git a/libtommath/bn_mp_set_double.c b/libtommath/bn_mp_set_double.c index 7f1ab75..a42fc70 100644 --- a/libtommath/bn_mp_set_double.c +++ b/libtommath/bn_mp_set_double.c @@ -16,7 +16,7 @@ mp_err mp_set_double(mp_int *a, double b) cast.dbl = b; exp = (int)((unsigned)(cast.bits >> 52) & 0x7FFu); - frac = (cast.bits & (((uint64_t)1 << 52) - (uint64_t)1)) | ((uint64_t)1 << 52); + frac = (cast.bits & ((1uLL << 52) - 1uLL)) | (1uLL << 52); if (exp == 0x7FF) { /* +-inf, NaN */ return MP_VAL; @@ -30,7 +30,7 @@ mp_err mp_set_double(mp_int *a, double b) return err; } - if (((cast.bits >> 63) != 0u) && !MP_IS_ZERO(a)) { + if (((cast.bits >> 63) != 0uLL) && !MP_IS_ZERO(a)) { a->sign = MP_NEG; } diff --git a/libtommath/bn_mp_set_ll.c b/libtommath/bn_mp_set_ll.c deleted file mode 100644 index 3e2324f..0000000 --- a/libtommath/bn_mp_set_ll.c +++ /dev/null @@ -1,7 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_SET_LL_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis */ -/* SPDX-License-Identifier: Unlicense */ - -MP_SET_SIGNED(mp_set_ll, mp_set_ull, long long, unsigned long long) -#endif diff --git a/libtommath/bn_mp_set_ull.c b/libtommath/bn_mp_set_ull.c deleted file mode 100644 index 8fbc1bd..0000000 --- a/libtommath/bn_mp_set_ull.c +++ /dev/null @@ -1,7 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_SET_ULL_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis */ -/* SPDX-License-Identifier: Unlicense */ - -MP_SET_UNSIGNED(mp_set_ull, unsigned long long) -#endif diff --git a/libtommath/bn_mp_sqrtmod_prime.c b/libtommath/bn_mp_sqrtmod_prime.c index a833ed7..425ae17 100644 --- a/libtommath/bn_mp_sqrtmod_prime.c +++ b/libtommath/bn_mp_sqrtmod_prime.c @@ -25,7 +25,7 @@ mp_err mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret) if ((err = mp_kronecker(n, prime, &legendre)) != MP_OKAY) return err; if (legendre == -1) return MP_VAL; /* quadratic non-residue mod prime */ - if ((err = mp_init_multi(&t1, &C, &Q, &S, &Z, &M, &T, &R, &two, NULL)) != MP_OKAY) { + if ((err = mp_init_multi(&t1, &C, &Q, &S, &Z, &M, &T, &R, &two, (void *)NULL)) != MP_OKAY) { return err; } @@ -111,7 +111,7 @@ mp_err mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret) } cleanup: - mp_clear_multi(&t1, &C, &Q, &S, &Z, &M, &T, &R, &two, NULL); + mp_clear_multi(&t1, &C, &Q, &S, &Z, &M, &T, &R, &two, (void *)NULL); return err; } diff --git a/libtommath/bn_s_mp_div_3.c b/libtommath/bn_s_mp_div_3.c new file mode 100644 index 0000000..e0aeefc --- /dev/null +++ b/libtommath/bn_s_mp_div_3.c @@ -0,0 +1,63 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_DIV_3_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +/* divide by three (based on routine from MPI and the GMP manual) */ +mp_err s_mp_div_3(const mp_int *a, mp_int *c, mp_digit *d) +{ + mp_int q; + mp_word w, t; + mp_digit b; + mp_err err; + int ix; + + /* b = 2**MP_DIGIT_BIT / 3 */ + b = ((mp_word)1 << (mp_word)MP_DIGIT_BIT) / (mp_word)3; + + if ((err = mp_init_size(&q, a->used)) != MP_OKAY) { + return err; + } + + q.used = a->used; + q.sign = a->sign; + w = 0; + for (ix = a->used - 1; ix >= 0; ix--) { + w = (w << (mp_word)MP_DIGIT_BIT) | (mp_word)a->dp[ix]; + + if (w >= 3u) { + /* multiply w by [1/3] */ + t = (w * (mp_word)b) >> (mp_word)MP_DIGIT_BIT; + + /* now subtract 3 * [w/3] from w, to get the remainder */ + w -= t+t+t; + + /* fixup the remainder as required since + * the optimization is not exact. + */ + while (w >= 3u) { + t += 1u; + w -= 3u; + } + } else { + t = 0; + } + q.dp[ix] = (mp_digit)t; + } + + /* [optional] store the remainder */ + if (d != NULL) { + *d = (mp_digit)w; + } + + /* [optional] store the quotient */ + if (c != NULL) { + mp_clamp(&q); + mp_exch(&q, c); + } + mp_clear(&q); + + return err; +} + +#endif diff --git a/libtommath/bn_s_mp_invmod_fast.c b/libtommath/bn_s_mp_invmod_fast.c index 677d7ab..e76c604 100644 --- a/libtommath/bn_s_mp_invmod_fast.c +++ b/libtommath/bn_s_mp_invmod_fast.c @@ -21,7 +21,7 @@ mp_err s_mp_invmod_fast(const mp_int *a, const mp_int *b, mp_int *c) } /* init all our temps */ - if ((err = mp_init_multi(&x, &y, &u, &v, &B, &D, NULL)) != MP_OKAY) { + if ((err = mp_init_multi(&x, &y, &u, &v, &B, &D, (void *)NULL)) != MP_OKAY) { return err; } @@ -112,7 +112,7 @@ top: err = MP_OKAY; LBL_ERR: - mp_clear_multi(&x, &y, &u, &v, &B, &D, NULL); + mp_clear_multi(&x, &y, &u, &v, &B, &D, (void *)NULL); return err; } #endif diff --git a/libtommath/bn_s_mp_invmod_slow.c b/libtommath/bn_s_mp_invmod_slow.c index 4c5db33..6079d4b 100644 --- a/libtommath/bn_s_mp_invmod_slow.c +++ b/libtommath/bn_s_mp_invmod_slow.c @@ -16,7 +16,7 @@ mp_err s_mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c) /* init temps */ if ((err = mp_init_multi(&x, &y, &u, &v, - &A, &B, &C, &D, NULL)) != MP_OKAY) { + &A, &B, &C, &D, (void *)NULL)) != MP_OKAY) { return err; } @@ -113,7 +113,7 @@ top: mp_exch(&C, c); err = MP_OKAY; LBL_ERR: - mp_clear_multi(&x, &y, &u, &v, &A, &B, &C, &D, NULL); + mp_clear_multi(&x, &y, &u, &v, &A, &B, &C, &D, (void *)NULL); return err; } #endif diff --git a/libtommath/bn_s_mp_log.c b/libtommath/bn_s_mp_log.c new file mode 100644 index 0000000..6ead7d9 --- /dev/null +++ b/libtommath/bn_s_mp_log.c @@ -0,0 +1,81 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_LOG_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +mp_err s_mp_log(const mp_int *a, mp_digit base, int *c) +{ + mp_err err; + int high, low; + mp_int bracket_low, bracket_high, bracket_mid, t, bi_base; + + mp_ord cmp = mp_cmp_d(a, base); + if ((cmp == MP_LT) || (cmp == MP_EQ)) { + *c = cmp == MP_EQ; + return MP_OKAY; + } + + if ((err = + mp_init_multi(&bracket_low, &bracket_high, + &bracket_mid, &t, &bi_base, (void *)NULL)) != MP_OKAY) { + return err; + } + + low = 0; + mp_set(&bracket_low, 1uL); + high = 1; + + mp_set(&bracket_high, base); + + /* + A kind of Giant-step/baby-step algorithm. + Idea shamelessly stolen from https://programmingpraxis.com/2010/05/07/integer-logarithms/2/ + The effect is asymptotic, hence needs benchmarks to test if the Giant-step should be skipped + for small n. + */ + while (mp_cmp(&bracket_high, a) == MP_LT) { + low = high; + if ((err = mp_copy(&bracket_high, &bracket_low)) != MP_OKAY) { + goto LBL_END; + } + high <<= 1; + if ((err = mp_sqr(&bracket_high, &bracket_high)) != MP_OKAY) { + goto LBL_END; + } + } + mp_set(&bi_base, base); + + while ((high - low) > 1) { + int mid = (high + low) >> 1; + + if ((err = mp_expt_n(&bi_base, mid - low, &t)) != MP_OKAY) { + goto LBL_END; + } + if ((err = mp_mul(&bracket_low, &t, &bracket_mid)) != MP_OKAY) { + goto LBL_END; + } + cmp = mp_cmp(a, &bracket_mid); + if (cmp == MP_LT) { + high = mid; + mp_exch(&bracket_mid, &bracket_high); + } + if (cmp == MP_GT) { + low = mid; + mp_exch(&bracket_mid, &bracket_low); + } + if (cmp == MP_EQ) { + *c = mid; + goto LBL_END; + } + } + + *c = (mp_cmp(&bracket_high, a) == MP_EQ) ? high : low; + +LBL_END: + mp_clear_multi(&bracket_low, &bracket_high, &bracket_mid, + &t, &bi_base, (void *)NULL); + return err; +} + + +#endif diff --git a/libtommath/bn_s_mp_log_2expt.c b/libtommath/bn_s_mp_log_2expt.c new file mode 100644 index 0000000..e87ff35 --- /dev/null +++ b/libtommath/bn_s_mp_log_2expt.c @@ -0,0 +1,12 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_LOG_2EXPT_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +int s_mp_log_2expt(const mp_int *a, mp_digit base) +{ + int y; + for (y = 0; (base & 1) == 0; y++, base >>= 1) {} + return (mp_count_bits(a) - 1) / y; +} +#endif diff --git a/libtommath/bn_s_mp_log_d.c b/libtommath/bn_s_mp_log_d.c new file mode 100644 index 0000000..181d984 --- /dev/null +++ b/libtommath/bn_s_mp_log_d.c @@ -0,0 +1,65 @@ +#include "tommath_private.h" +#ifdef BN_S_MP_LOG_D_C +/* LibTomMath, multiple-precision integer library -- Tom St Denis */ +/* SPDX-License-Identifier: Unlicense */ + +static mp_word s_pow(mp_word base, mp_word exponent) +{ + mp_word result = 1u; + while (exponent != 0u) { + if ((exponent & 1u) == 1u) { + result *= base; + } + exponent >>= 1; + base *= base; + } + + return result; +} + +int s_mp_log_d(mp_digit base, mp_digit n) +{ + mp_word bracket_low = 1uLL, bracket_high = base, N = n; + int ret, high = 1, low = 0; + + if (n < base) { + return 0; + } + if (n == base) { + return 1; + } + + while (bracket_high < N) { + low = high; + bracket_low = bracket_high; + high <<= 1; + bracket_high *= bracket_high; + } + + while (((mp_digit)(high - low)) > 1uL) { + int mid = (low + high) >> 1; + mp_word bracket_mid = bracket_low * s_pow(base, (mp_word)(mid - low)); + + if (N < bracket_mid) { + high = mid ; + bracket_high = bracket_mid ; + } + if (N > bracket_mid) { + low = mid ; + bracket_low = bracket_mid ; + } + if (N == bracket_mid) { + return mid; + } + } + + if (bracket_high == N) { + ret = high; + } else { + ret = low; + } + + return ret; +} + +#endif diff --git a/libtommath/bn_s_mp_mul_high_digs_fast.c b/libtommath/bn_s_mp_mul_high_digs_fast.c index 0796f72..04c74a8 100644 --- a/libtommath/bn_s_mp_mul_high_digs_fast.c +++ b/libtommath/bn_s_mp_mul_high_digs_fast.c @@ -3,7 +3,7 @@ /* LibTomMath, multiple-precision integer library -- Tom St Denis */ /* SPDX-License-Identifier: Unlicense */ -/* this is a modified version of s_mp_mul_digs_fast that only produces +/* this is a modified version of s_mp_mul_digs_fast that only produces * output digits *above* digs. See the comments for s_mp_mul_digs_fast * to see how it works. * diff --git a/libtommath/bn_s_mp_toom_mul.c b/libtommath/bn_s_mp_toom_mul.c index c7db3a5..fd574a2 100644 --- a/libtommath/bn_s_mp_toom_mul.c +++ b/libtommath/bn_s_mp_toom_mul.c @@ -146,7 +146,7 @@ mp_err s_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c) if ((err = mp_sub(&S2, &a1, &S2)) != MP_OKAY) goto LBL_ERR; /** S2 = S2 / 3; \\ this is an exact division */ - if ((err = mp_div_3(&S2, &S2, NULL)) != MP_OKAY) goto LBL_ERR; + if ((err = s_mp_div_3(&S2, &S2, NULL)) != MP_OKAY) goto LBL_ERR; /** a1 = S1 - a1; */ if ((err = mp_sub(&S1, &a1, &a1)) != MP_OKAY) goto LBL_ERR; diff --git a/libtommath/changes.txt b/libtommath/changes.txt index 956cdd4..ac9e49a 100644 --- a/libtommath/changes.txt +++ b/libtommath/changes.txt @@ -1,3 +1,9 @@ +Mar 27th, 2024 +v1.3.0 + -- Deprecate more APIs which are replaced in develop (PR #572) + -- Add support for CMake (PR #573) + -- Add support for GitHub Actions (PR #573) + Sep 04th, 2023 v1.2.1 -- Bugfix release because of potential integer overflow diff --git a/libtommath/helper.pl b/libtommath/helper.pl index c624b7c..5294262 100755 --- a/libtommath/helper.pl +++ b/libtommath/helper.pl @@ -222,11 +222,32 @@ sub patch_file { return $content; } +sub make_sources_cmake { + my ($src_ref, $hdr_ref) = @_; + my @sources = @{ $src_ref }; + my @headers = @{ $hdr_ref }; + my $output = "# SPDX-License-Identifier: Unlicense +# Autogenerated File! Do not edit. + +set(SOURCES\n"; + foreach my $sobj (sort @sources) { + $output .= $sobj . "\n"; + } + $output .= ")\n\nset(HEADERS\n"; + foreach my $hobj (sort @headers) { + $output .= $hobj . "\n"; + } + $output .= ")\n"; + return $output; +} + sub process_makefiles { my $write = shift; my $changed_count = 0; - my @o = map { my $x = $_; $x =~ s/\.c$/.o/; $x } bsd_glob("*.c"); - my @all = bsd_glob("*.{c,h}"); + my @headers = bsd_glob("*.h"); + my @sources = bsd_glob("*.c"); + my @o = map { my $x = $_; $x =~ s/\.c$/.o/; $x } @sources; + my @all = sort(@sources, @headers); my $var_o = prepare_variable("OBJECTS", @o); (my $var_obj = $var_o) =~ s/\.o\b/.obj/sg; @@ -245,10 +266,12 @@ sub process_makefiles { } # update OBJECTS + HEADERS in makefile* - for my $m (qw/ makefile makefile.shared makefile_include.mk makefile.msvc makefile.unix makefile.mingw /) { + for my $m (qw/ makefile makefile.shared makefile_include.mk makefile.msvc makefile.unix makefile.mingw sources.cmake /) { my $old = read_file($m); my $new = $m eq 'makefile.msvc' ? patch_file($old, $var_obj) - : patch_file($old, $var_o); + : $m eq 'sources.cmake' ? make_sources_cmake(\@sources, \@headers) + : patch_file($old, $var_o); + if ($old ne $new) { write_file($m, $new) if $write; warn "changed: $m\n"; @@ -389,6 +412,11 @@ EOS push @deps, $a; } } + if ($filename =~ "BN_DEPRECATED") { + push(@deps, qw(BN_MP_GET_LL_C BN_MP_INIT_LL_C BN_MP_SET_LL_C)); + push(@deps, qw(BN_MP_GET_MAG_ULL_C BN_MP_INIT_ULL_C BN_MP_SET_ULL_C)); + push(@deps, qw(BN_MP_DIV_3_C BN_MP_EXPT_U32_C BN_MP_ROOT_U32_C BN_MP_LOG_U32_C)); + } @deps = sort(@deps); foreach my $a (@deps) { if ($list !~ /$a/) { @@ -435,6 +463,8 @@ sub generate_def { @files = grep(!/mp_radix_smap/, @files); push(@files, qw(mp_set_int mp_set_long mp_set_long_long mp_get_int mp_get_long mp_get_long_long mp_init_set_int)); + push(@files, qw(mp_get_ll mp_get_mag_ull mp_init_ll mp_set_ll mp_init_ull mp_set_ull)); + push(@files, qw(mp_div_3 mp_expt_u32 mp_root_u32 mp_log_u32)); my $files = join("\n ", sort(grep(/^mp_/, @files))); write_file "tommath.def", "; libtommath diff --git a/libtommath/libtommath.pc.in b/libtommath/libtommath.pc.in index 099b1cd..7ce50fd 100644 --- a/libtommath/libtommath.pc.in +++ b/libtommath/libtommath.pc.in @@ -1,10 +1,9 @@ -prefix=@to-be-replaced@ -exec_prefix=${prefix} -libdir=${exec_prefix}/lib -includedir=${prefix}/include +prefix=@CMAKE_INSTALL_PREFIX@ +libdir=${prefix}/@CMAKE_INSTALL_LIBDIR@ +includedir=${prefix}/@CMAKE_INSTALL_INCLUDEDIR@ Name: LibTomMath Description: public domain library for manipulating large integer numbers -Version: @to-be-replaced@ +Version: @PROJECT_VERSION@ Libs: -L${libdir} -ltommath Cflags: -I${includedir} diff --git a/libtommath/libtommath_VS2008.sln b/libtommath/libtommath_VS2008.sln index 3bd6688..6bfc159 100644 --- a/libtommath/libtommath_VS2008.sln +++ b/libtommath/libtommath_VS2008.sln @@ -1,4 +1,4 @@ - + Microsoft Visual Studio Solution File, Format Version 10.00 # Visual Studio 2008 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "tommath", "libtommath_VS2008.vcproj", "{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}" diff --git a/libtommath/libtommath_VS2008.vcproj b/libtommath/libtommath_VS2008.vcproj index 67cc89b..5cbbb89 100644 --- a/libtommath/libtommath_VS2008.vcproj +++ b/libtommath/libtommath_VS2008.vcproj @@ -401,10 +401,6 @@ > - - @@ -429,7 +425,7 @@ > - - @@ -493,10 +485,6 @@ > - - @@ -525,10 +513,6 @@ > - - @@ -553,10 +537,6 @@ > - - @@ -581,7 +561,7 @@ > - - @@ -777,10 +753,6 @@ > - - @@ -857,6 +829,10 @@ > + + @@ -885,6 +861,18 @@ > + + + + + + diff --git a/libtommath/makefile b/libtommath/makefile index be9fac6..bee51a1 100644 --- a/libtommath/makefile +++ b/libtommath/makefile @@ -29,32 +29,32 @@ LCOV_ARGS=--directory . OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \ bn_mp_and.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_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \ -bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \ -bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_u32.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \ +bn_mp_div_2d.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \ +bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_n.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \ bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \ -bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_ll.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o \ -bn_mp_get_mag_ull.o bn_mp_grow.o bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o \ -bn_mp_init_i64.o bn_mp_init_l.o bn_mp_init_ll.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o \ -bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o bn_mp_init_ull.o bn_mp_invmod.o bn_mp_is_square.o \ -bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_u32.o bn_mp_lshd.o bn_mp_mod.o \ -bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \ -bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \ -bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o \ -bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \ -bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o bn_mp_prime_strong_lucas_selfridge.o \ -bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o \ -bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o \ -bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_root_u32.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o \ -bn_mp_set_double.o bn_mp_set_i32.o bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_ll.o bn_mp_set_u32.o \ -bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_set_ull.o bn_mp_shrink.o bn_mp_signed_rsh.o bn_mp_sqr.o \ -bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o \ -bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o bn_mp_xor.o bn_mp_zero.o \ -bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o \ -bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o bn_s_mp_karatsuba_mul.o \ -bn_s_mp_karatsuba_sqr.o bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o \ -bn_s_mp_mul_high_digs.o bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o \ -bn_s_mp_rand_jenkins.o bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o \ -bn_s_mp_sub.o bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o +bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o bn_mp_grow.o \ +bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o bn_mp_init_i64.o bn_mp_init_l.o \ +bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o \ +bn_mp_invmod.o bn_mp_is_square.o bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_n.o \ +bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o \ +bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o \ +bn_mp_mulmod.o bn_mp_neg.o bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o \ +bn_mp_prime_frobenius_underwood.o bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o \ +bn_mp_prime_next_prime.o bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o \ +bn_mp_prime_strong_lucas_selfridge.o bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o \ +bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o \ +bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o \ +bn_mp_root_n.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o bn_mp_set_double.o bn_mp_set_i32.o \ +bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_u32.o bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_shrink.o \ +bn_mp_signed_rsh.o bn_mp_sqr.o bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o \ +bn_mp_submod.o bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o \ +bn_mp_xor.o bn_mp_zero.o bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_div_3.o \ +bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o \ +bn_s_mp_karatsuba_mul.o bn_s_mp_karatsuba_sqr.o bn_s_mp_log.o bn_s_mp_log_2expt.o bn_s_mp_log_d.o \ +bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o bn_s_mp_mul_high_digs.o \ +bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o bn_s_mp_rand_jenkins.o \ +bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o bn_s_mp_sub.o \ +bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o #END_INS @@ -133,7 +133,11 @@ pre_gen: sed -e 's/[[:blank:]]*$$//' mpi.c > pre_gen/mpi.c rm mpi.c -zipup: clean astyle new_file docs +zipup: + $(MAKE) clean + $(MAKE) .zipup + +.zipup: astyle new_file docs @# Update the index, so diff-index won't fail in case the pdf has been created. @# As the pdf creation modifies the tex files, git sometimes detects the @# modified files, but misses that it's put back to its original version. diff --git a/libtommath/makefile.mingw b/libtommath/makefile.mingw index 7eee57d..d05d84d 100644 --- a/libtommath/makefile.mingw +++ b/libtommath/makefile.mingw @@ -11,16 +11,20 @@ #The following can be overridden from command line e.g. make -f makefile.mingw CC=gcc ARFLAGS=rcs PREFIX = c:\mingw -CC = gcc +CC = i686-w64-mingw32-gcc +#CC = x86_64-w64-mingw32-clang +#CC = aarch64-w64-mingw32-clang AR = ar ARFLAGS = r RANLIB = ranlib -STRIP = strip +STRIP = i686-w64-mingw32-gcc-strip +#STRIP = x86_64-w64-mingw32-strip +#STRIP = aarch64-w64-mingw32-strip CFLAGS = -O2 LDFLAGS = #Compilation flags -LTM_CFLAGS = -I. $(CFLAGS) +LTM_CFLAGS = -I. $(CFLAGS) -DTCL_WITH_EXTERNAL_TOMMATH LTM_LDFLAGS = $(LDFLAGS) -static-libgcc #Libraries to be created @@ -32,32 +36,32 @@ LIBMAIN_D =libtommath.dll OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \ bn_mp_and.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_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \ -bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \ -bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_u32.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \ +bn_mp_div_2d.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \ +bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_n.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \ bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \ -bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_ll.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o \ -bn_mp_get_mag_ull.o bn_mp_grow.o bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o \ -bn_mp_init_i64.o bn_mp_init_l.o bn_mp_init_ll.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o \ -bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o bn_mp_init_ull.o bn_mp_invmod.o bn_mp_is_square.o \ -bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_u32.o bn_mp_lshd.o bn_mp_mod.o \ -bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \ -bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \ -bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o \ -bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \ -bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o bn_mp_prime_strong_lucas_selfridge.o \ -bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o \ -bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o \ -bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_root_u32.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o \ -bn_mp_set_double.o bn_mp_set_i32.o bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_ll.o bn_mp_set_u32.o \ -bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_set_ull.o bn_mp_shrink.o bn_mp_signed_rsh.o bn_mp_sqr.o \ -bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o \ -bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o bn_mp_xor.o bn_mp_zero.o \ -bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o \ -bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o bn_s_mp_karatsuba_mul.o \ -bn_s_mp_karatsuba_sqr.o bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o \ -bn_s_mp_mul_high_digs.o bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o \ -bn_s_mp_rand_jenkins.o bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o \ -bn_s_mp_sub.o bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o +bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o bn_mp_grow.o \ +bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o bn_mp_init_i64.o bn_mp_init_l.o \ +bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o \ +bn_mp_invmod.o bn_mp_is_square.o bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_n.o \ +bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o \ +bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o \ +bn_mp_mulmod.o bn_mp_neg.o bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o \ +bn_mp_prime_frobenius_underwood.o bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o \ +bn_mp_prime_next_prime.o bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o \ +bn_mp_prime_strong_lucas_selfridge.o bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o \ +bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o \ +bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o \ +bn_mp_root_n.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o bn_mp_set_double.o bn_mp_set_i32.o \ +bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_u32.o bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_shrink.o \ +bn_mp_signed_rsh.o bn_mp_sqr.o bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o \ +bn_mp_submod.o bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o \ +bn_mp_xor.o bn_mp_zero.o bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_div_3.o \ +bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o \ +bn_s_mp_karatsuba_mul.o bn_s_mp_karatsuba_sqr.o bn_s_mp_log.o bn_s_mp_log_2expt.o bn_s_mp_log_d.o \ +bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o bn_s_mp_mul_high_digs.o \ +bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o bn_s_mp_rand_jenkins.o \ +bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o bn_s_mp_sub.o \ +bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o HEADERS_PUB=tommath.h HEADERS=tommath_private.h tommath_class.h tommath_superclass.h tommath_cutoffs.h $(HEADERS_PUB) @@ -78,7 +82,7 @@ $(LIBMAIN_S): $(OBJECTS) #Create DLL + import library libtommath.dll.a $(LIBMAIN_D) $(LIBMAIN_I): $(OBJECTS) - $(CC) -s -shared -o $(LIBMAIN_D) $^ -Wl,--enable-auto-import,--export-all -Wl,--out-implib=$(LIBMAIN_I) $(LTM_LDFLAGS) + $(CC) -s -shared -o $(LIBMAIN_D) $^ -Wl,--enable-auto-import tommath.def -Wl,--out-implib=$(LIBMAIN_I) $(LTM_LDFLAGS) $(STRIP) -S $(LIBMAIN_D) #Build test suite diff --git a/libtommath/makefile.msvc b/libtommath/makefile.msvc index aa8d8be..a78080b 100644 --- a/libtommath/makefile.msvc +++ b/libtommath/makefile.msvc @@ -24,32 +24,32 @@ LIBMAIN_S =tommath.lib OBJECTS=bn_cutoffs.obj bn_deprecated.obj bn_mp_2expt.obj bn_mp_abs.obj bn_mp_add.obj bn_mp_add_d.obj bn_mp_addmod.obj \ bn_mp_and.obj bn_mp_clamp.obj bn_mp_clear.obj bn_mp_clear_multi.obj bn_mp_cmp.obj bn_mp_cmp_d.obj bn_mp_cmp_mag.obj \ bn_mp_cnt_lsb.obj bn_mp_complement.obj bn_mp_copy.obj bn_mp_count_bits.obj bn_mp_decr.obj bn_mp_div.obj bn_mp_div_2.obj \ -bn_mp_div_2d.obj bn_mp_div_3.obj bn_mp_div_d.obj bn_mp_dr_is_modulus.obj bn_mp_dr_reduce.obj bn_mp_dr_setup.obj \ -bn_mp_error_to_string.obj bn_mp_exch.obj bn_mp_expt_u32.obj bn_mp_exptmod.obj bn_mp_exteuclid.obj bn_mp_fread.obj \ +bn_mp_div_2d.obj bn_mp_div_d.obj bn_mp_dr_is_modulus.obj bn_mp_dr_reduce.obj bn_mp_dr_setup.obj \ +bn_mp_error_to_string.obj bn_mp_exch.obj bn_mp_expt_n.obj bn_mp_exptmod.obj bn_mp_exteuclid.obj bn_mp_fread.obj \ bn_mp_from_sbin.obj bn_mp_from_ubin.obj bn_mp_fwrite.obj bn_mp_gcd.obj bn_mp_get_double.obj bn_mp_get_i32.obj \ -bn_mp_get_i64.obj bn_mp_get_l.obj bn_mp_get_ll.obj bn_mp_get_mag_u32.obj bn_mp_get_mag_u64.obj bn_mp_get_mag_ul.obj \ -bn_mp_get_mag_ull.obj bn_mp_grow.obj bn_mp_incr.obj bn_mp_init.obj bn_mp_init_copy.obj bn_mp_init_i32.obj \ -bn_mp_init_i64.obj bn_mp_init_l.obj bn_mp_init_ll.obj bn_mp_init_multi.obj bn_mp_init_set.obj bn_mp_init_size.obj \ -bn_mp_init_u32.obj bn_mp_init_u64.obj bn_mp_init_ul.obj bn_mp_init_ull.obj bn_mp_invmod.obj bn_mp_is_square.obj \ -bn_mp_iseven.obj bn_mp_isodd.obj bn_mp_kronecker.obj bn_mp_lcm.obj bn_mp_log_u32.obj bn_mp_lshd.obj bn_mp_mod.obj \ -bn_mp_mod_2d.obj bn_mp_mod_d.obj bn_mp_montgomery_calc_normalization.obj bn_mp_montgomery_reduce.obj \ -bn_mp_montgomery_setup.obj bn_mp_mul.obj bn_mp_mul_2.obj bn_mp_mul_2d.obj bn_mp_mul_d.obj bn_mp_mulmod.obj bn_mp_neg.obj \ -bn_mp_or.obj bn_mp_pack.obj bn_mp_pack_count.obj bn_mp_prime_fermat.obj bn_mp_prime_frobenius_underwood.obj \ -bn_mp_prime_is_prime.obj bn_mp_prime_miller_rabin.obj bn_mp_prime_next_prime.obj \ -bn_mp_prime_rabin_miller_trials.obj bn_mp_prime_rand.obj bn_mp_prime_strong_lucas_selfridge.obj \ -bn_mp_radix_size.obj bn_mp_radix_smap.obj bn_mp_rand.obj bn_mp_read_radix.obj bn_mp_reduce.obj bn_mp_reduce_2k.obj \ -bn_mp_reduce_2k_l.obj bn_mp_reduce_2k_setup.obj bn_mp_reduce_2k_setup_l.obj bn_mp_reduce_is_2k.obj \ -bn_mp_reduce_is_2k_l.obj bn_mp_reduce_setup.obj bn_mp_root_u32.obj bn_mp_rshd.obj bn_mp_sbin_size.obj bn_mp_set.obj \ -bn_mp_set_double.obj bn_mp_set_i32.obj bn_mp_set_i64.obj bn_mp_set_l.obj bn_mp_set_ll.obj bn_mp_set_u32.obj \ -bn_mp_set_u64.obj bn_mp_set_ul.obj bn_mp_set_ull.obj bn_mp_shrink.obj bn_mp_signed_rsh.obj bn_mp_sqr.obj \ -bn_mp_sqrmod.obj bn_mp_sqrt.obj bn_mp_sqrtmod_prime.obj bn_mp_sub.obj bn_mp_sub_d.obj bn_mp_submod.obj \ -bn_mp_to_radix.obj bn_mp_to_sbin.obj bn_mp_to_ubin.obj bn_mp_ubin_size.obj bn_mp_unpack.obj bn_mp_xor.obj bn_mp_zero.obj \ -bn_prime_tab.obj bn_s_mp_add.obj bn_s_mp_balance_mul.obj bn_s_mp_exptmod.obj bn_s_mp_exptmod_fast.obj \ -bn_s_mp_get_bit.obj bn_s_mp_invmod_fast.obj bn_s_mp_invmod_slow.obj bn_s_mp_karatsuba_mul.obj \ -bn_s_mp_karatsuba_sqr.obj bn_s_mp_montgomery_reduce_fast.obj bn_s_mp_mul_digs.obj bn_s_mp_mul_digs_fast.obj \ -bn_s_mp_mul_high_digs.obj bn_s_mp_mul_high_digs_fast.obj bn_s_mp_prime_is_divisible.obj \ -bn_s_mp_rand_jenkins.obj bn_s_mp_rand_platform.obj bn_s_mp_reverse.obj bn_s_mp_sqr.obj bn_s_mp_sqr_fast.obj \ -bn_s_mp_sub.obj bn_s_mp_toom_mul.obj bn_s_mp_toom_sqr.obj +bn_mp_get_i64.obj bn_mp_get_l.obj bn_mp_get_mag_u32.obj bn_mp_get_mag_u64.obj bn_mp_get_mag_ul.obj bn_mp_grow.obj \ +bn_mp_incr.obj bn_mp_init.obj bn_mp_init_copy.obj bn_mp_init_i32.obj bn_mp_init_i64.obj bn_mp_init_l.obj \ +bn_mp_init_multi.obj bn_mp_init_set.obj bn_mp_init_size.obj bn_mp_init_u32.obj bn_mp_init_u64.obj bn_mp_init_ul.obj \ +bn_mp_invmod.obj bn_mp_is_square.obj bn_mp_iseven.obj bn_mp_isodd.obj bn_mp_kronecker.obj bn_mp_lcm.obj bn_mp_log_n.obj \ +bn_mp_lshd.obj bn_mp_mod.obj bn_mp_mod_2d.obj bn_mp_mod_d.obj bn_mp_montgomery_calc_normalization.obj \ +bn_mp_montgomery_reduce.obj bn_mp_montgomery_setup.obj bn_mp_mul.obj bn_mp_mul_2.obj bn_mp_mul_2d.obj bn_mp_mul_d.obj \ +bn_mp_mulmod.obj bn_mp_neg.obj bn_mp_or.obj bn_mp_pack.obj bn_mp_pack_count.obj bn_mp_prime_fermat.obj \ +bn_mp_prime_frobenius_underwood.obj bn_mp_prime_is_prime.obj bn_mp_prime_miller_rabin.obj \ +bn_mp_prime_next_prime.obj bn_mp_prime_rabin_miller_trials.obj bn_mp_prime_rand.obj \ +bn_mp_prime_strong_lucas_selfridge.obj bn_mp_radix_size.obj bn_mp_radix_smap.obj bn_mp_rand.obj \ +bn_mp_read_radix.obj bn_mp_reduce.obj bn_mp_reduce_2k.obj bn_mp_reduce_2k_l.obj bn_mp_reduce_2k_setup.obj \ +bn_mp_reduce_2k_setup_l.obj bn_mp_reduce_is_2k.obj bn_mp_reduce_is_2k_l.obj bn_mp_reduce_setup.obj \ +bn_mp_root_n.obj bn_mp_rshd.obj bn_mp_sbin_size.obj bn_mp_set.obj bn_mp_set_double.obj bn_mp_set_i32.obj \ +bn_mp_set_i64.obj bn_mp_set_l.obj bn_mp_set_u32.obj bn_mp_set_u64.obj bn_mp_set_ul.obj bn_mp_shrink.obj \ +bn_mp_signed_rsh.obj bn_mp_sqr.obj bn_mp_sqrmod.obj bn_mp_sqrt.obj bn_mp_sqrtmod_prime.obj bn_mp_sub.obj bn_mp_sub_d.obj \ +bn_mp_submod.obj bn_mp_to_radix.obj bn_mp_to_sbin.obj bn_mp_to_ubin.obj bn_mp_ubin_size.obj bn_mp_unpack.obj \ +bn_mp_xor.obj bn_mp_zero.obj bn_prime_tab.obj bn_s_mp_add.obj bn_s_mp_balance_mul.obj bn_s_mp_div_3.obj \ +bn_s_mp_exptmod.obj bn_s_mp_exptmod_fast.obj bn_s_mp_get_bit.obj bn_s_mp_invmod_fast.obj bn_s_mp_invmod_slow.obj \ +bn_s_mp_karatsuba_mul.obj bn_s_mp_karatsuba_sqr.obj bn_s_mp_log.obj bn_s_mp_log_2expt.obj bn_s_mp_log_d.obj \ +bn_s_mp_montgomery_reduce_fast.obj bn_s_mp_mul_digs.obj bn_s_mp_mul_digs_fast.obj bn_s_mp_mul_high_digs.obj \ +bn_s_mp_mul_high_digs_fast.obj bn_s_mp_prime_is_divisible.obj bn_s_mp_rand_jenkins.obj \ +bn_s_mp_rand_platform.obj bn_s_mp_reverse.obj bn_s_mp_sqr.obj bn_s_mp_sqr_fast.obj bn_s_mp_sub.obj \ +bn_s_mp_toom_mul.obj bn_s_mp_toom_sqr.obj HEADERS_PUB=tommath.h HEADERS=tommath_private.h tommath_class.h tommath_superclass.h tommath_cutoffs.h $(HEADERS_PUB) diff --git a/libtommath/makefile.shared b/libtommath/makefile.shared index 6802107..bf0ee43 100644 --- a/libtommath/makefile.shared +++ b/libtommath/makefile.shared @@ -26,32 +26,32 @@ LCOV_ARGS=--directory .libs --directory . OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \ bn_mp_and.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_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \ -bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \ -bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_u32.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \ +bn_mp_div_2d.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \ +bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_n.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \ bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \ -bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_ll.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o \ -bn_mp_get_mag_ull.o bn_mp_grow.o bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o \ -bn_mp_init_i64.o bn_mp_init_l.o bn_mp_init_ll.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o \ -bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o bn_mp_init_ull.o bn_mp_invmod.o bn_mp_is_square.o \ -bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_u32.o bn_mp_lshd.o bn_mp_mod.o \ -bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \ -bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \ -bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o \ -bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \ -bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o bn_mp_prime_strong_lucas_selfridge.o \ -bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o \ -bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o \ -bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_root_u32.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o \ -bn_mp_set_double.o bn_mp_set_i32.o bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_ll.o bn_mp_set_u32.o \ -bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_set_ull.o bn_mp_shrink.o bn_mp_signed_rsh.o bn_mp_sqr.o \ -bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o \ -bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o bn_mp_xor.o bn_mp_zero.o \ -bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o \ -bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o bn_s_mp_karatsuba_mul.o \ -bn_s_mp_karatsuba_sqr.o bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o \ -bn_s_mp_mul_high_digs.o bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o \ -bn_s_mp_rand_jenkins.o bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o \ -bn_s_mp_sub.o bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o +bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o bn_mp_grow.o \ +bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o bn_mp_init_i64.o bn_mp_init_l.o \ +bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o \ +bn_mp_invmod.o bn_mp_is_square.o bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_n.o \ +bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o \ +bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o \ +bn_mp_mulmod.o bn_mp_neg.o bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o \ +bn_mp_prime_frobenius_underwood.o bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o \ +bn_mp_prime_next_prime.o bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o \ +bn_mp_prime_strong_lucas_selfridge.o bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o \ +bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o \ +bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o \ +bn_mp_root_n.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o bn_mp_set_double.o bn_mp_set_i32.o \ +bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_u32.o bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_shrink.o \ +bn_mp_signed_rsh.o bn_mp_sqr.o bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o \ +bn_mp_submod.o bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o \ +bn_mp_xor.o bn_mp_zero.o bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_div_3.o \ +bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o \ +bn_s_mp_karatsuba_mul.o bn_s_mp_karatsuba_sqr.o bn_s_mp_log.o bn_s_mp_log_2expt.o bn_s_mp_log_d.o \ +bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o bn_s_mp_mul_high_digs.o \ +bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o bn_s_mp_rand_jenkins.o \ +bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o bn_s_mp_sub.o \ +bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o #END_INS @@ -70,7 +70,8 @@ install: $(LIBNAME) install -d $(DESTDIR)$(INCPATH) $(LIBTOOL) --mode=install install -m 644 $(LIBNAME) $(DESTDIR)$(LIBPATH)/$(LIBNAME) install -m 644 $(HEADERS_PUB) $(DESTDIR)$(INCPATH) - sed -e 's,^prefix=.*,prefix=$(PREFIX),' -e 's,^Version:.*,Version: $(VERSION_PC),' libtommath.pc.in > libtommath.pc + sed -e 's,^prefix=.*,prefix=$(PREFIX),' -e 's,^Version:.*,Version: $(VERSION_PC),' -e 's,@CMAKE_INSTALL_LIBDIR@,lib,' \ + -e 's,@CMAKE_INSTALL_INCLUDEDIR@,include,' libtommath.pc.in > libtommath.pc install -d $(DESTDIR)$(LIBPATH)/pkgconfig install -m 644 libtommath.pc $(DESTDIR)$(LIBPATH)/pkgconfig/ diff --git a/libtommath/makefile.unix b/libtommath/makefile.unix index 9336da0..fdc3fa7 100644 --- a/libtommath/makefile.unix +++ b/libtommath/makefile.unix @@ -21,7 +21,7 @@ RANLIB = ranlib CFLAGS = -O2 LDFLAGS = -VERSION = 1.2.1 +VERSION = 1.3.0 #Compilation flags LTM_CFLAGS = -I. $(CFLAGS) @@ -33,32 +33,32 @@ LIBMAIN_S = libtommath.a OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \ bn_mp_and.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_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \ -bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \ -bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_u32.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \ +bn_mp_div_2d.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \ +bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_n.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \ bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \ -bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_ll.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o \ -bn_mp_get_mag_ull.o bn_mp_grow.o bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o \ -bn_mp_init_i64.o bn_mp_init_l.o bn_mp_init_ll.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o \ -bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o bn_mp_init_ull.o bn_mp_invmod.o bn_mp_is_square.o \ -bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_u32.o bn_mp_lshd.o bn_mp_mod.o \ -bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \ -bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \ -bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o \ -bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \ -bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o bn_mp_prime_strong_lucas_selfridge.o \ -bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o \ -bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o \ -bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_root_u32.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o \ -bn_mp_set_double.o bn_mp_set_i32.o bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_ll.o bn_mp_set_u32.o \ -bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_set_ull.o bn_mp_shrink.o bn_mp_signed_rsh.o bn_mp_sqr.o \ -bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o \ -bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o bn_mp_xor.o bn_mp_zero.o \ -bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o \ -bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o bn_s_mp_karatsuba_mul.o \ -bn_s_mp_karatsuba_sqr.o bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o \ -bn_s_mp_mul_high_digs.o bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o \ -bn_s_mp_rand_jenkins.o bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o \ -bn_s_mp_sub.o bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o +bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o bn_mp_grow.o \ +bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o bn_mp_init_i64.o bn_mp_init_l.o \ +bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o \ +bn_mp_invmod.o bn_mp_is_square.o bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_n.o \ +bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o \ +bn_mp_montgomery_reduce.o bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o \ +bn_mp_mulmod.o bn_mp_neg.o bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o \ +bn_mp_prime_frobenius_underwood.o bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o \ +bn_mp_prime_next_prime.o bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o \ +bn_mp_prime_strong_lucas_selfridge.o bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o \ +bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o \ +bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o \ +bn_mp_root_n.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o bn_mp_set_double.o bn_mp_set_i32.o \ +bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_u32.o bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_shrink.o \ +bn_mp_signed_rsh.o bn_mp_sqr.o bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o \ +bn_mp_submod.o bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o \ +bn_mp_xor.o bn_mp_zero.o bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_div_3.o \ +bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o \ +bn_s_mp_karatsuba_mul.o bn_s_mp_karatsuba_sqr.o bn_s_mp_log.o bn_s_mp_log_2expt.o bn_s_mp_log_d.o \ +bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o bn_s_mp_mul_high_digs.o \ +bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o bn_s_mp_rand_jenkins.o \ +bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o bn_s_mp_sub.o \ +bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o HEADERS_PUB=tommath.h HEADERS=tommath_private.h tommath_class.h tommath_superclass.h tommath_cutoffs.h $(HEADERS_PUB) diff --git a/libtommath/makefile_include.mk b/libtommath/makefile_include.mk index 71f04dd..df51a12 100644 --- a/libtommath/makefile_include.mk +++ b/libtommath/makefile_include.mk @@ -3,9 +3,9 @@ # #version of library -VERSION=1.2.1 -VERSION_PC=1.2.1 -VERSION_SO=3:1:2 +VERSION=1.3.0 +VERSION_PC=1.3.0 +VERSION_SO=4:0:3 PLATFORM := $(shell uname | sed -e 's/_.*//') diff --git a/libtommath/sources.cmake b/libtommath/sources.cmake new file mode 100644 index 0000000..a2df090 --- /dev/null +++ b/libtommath/sources.cmake @@ -0,0 +1,167 @@ +# SPDX-License-Identifier: Unlicense +# Autogenerated File! Do not edit. + +set(SOURCES +bn_cutoffs.c +bn_deprecated.c +bn_mp_2expt.c +bn_mp_abs.c +bn_mp_add.c +bn_mp_add_d.c +bn_mp_addmod.c +bn_mp_and.c +bn_mp_clamp.c +bn_mp_clear.c +bn_mp_clear_multi.c +bn_mp_cmp.c +bn_mp_cmp_d.c +bn_mp_cmp_mag.c +bn_mp_cnt_lsb.c +bn_mp_complement.c +bn_mp_copy.c +bn_mp_count_bits.c +bn_mp_decr.c +bn_mp_div.c +bn_mp_div_2.c +bn_mp_div_2d.c +bn_mp_div_d.c +bn_mp_dr_is_modulus.c +bn_mp_dr_reduce.c +bn_mp_dr_setup.c +bn_mp_error_to_string.c +bn_mp_exch.c +bn_mp_expt_n.c +bn_mp_exptmod.c +bn_mp_exteuclid.c +bn_mp_fread.c +bn_mp_from_sbin.c +bn_mp_from_ubin.c +bn_mp_fwrite.c +bn_mp_gcd.c +bn_mp_get_double.c +bn_mp_get_i32.c +bn_mp_get_i64.c +bn_mp_get_l.c +bn_mp_get_mag_u32.c +bn_mp_get_mag_u64.c +bn_mp_get_mag_ul.c +bn_mp_grow.c +bn_mp_incr.c +bn_mp_init.c +bn_mp_init_copy.c +bn_mp_init_i32.c +bn_mp_init_i64.c +bn_mp_init_l.c +bn_mp_init_multi.c +bn_mp_init_set.c +bn_mp_init_size.c +bn_mp_init_u32.c +bn_mp_init_u64.c +bn_mp_init_ul.c +bn_mp_invmod.c +bn_mp_is_square.c +bn_mp_iseven.c +bn_mp_isodd.c +bn_mp_kronecker.c +bn_mp_lcm.c +bn_mp_log_n.c +bn_mp_lshd.c +bn_mp_mod.c +bn_mp_mod_2d.c +bn_mp_mod_d.c +bn_mp_montgomery_calc_normalization.c +bn_mp_montgomery_reduce.c +bn_mp_montgomery_setup.c +bn_mp_mul.c +bn_mp_mul_2.c +bn_mp_mul_2d.c +bn_mp_mul_d.c +bn_mp_mulmod.c +bn_mp_neg.c +bn_mp_or.c +bn_mp_pack.c +bn_mp_pack_count.c +bn_mp_prime_fermat.c +bn_mp_prime_frobenius_underwood.c +bn_mp_prime_is_prime.c +bn_mp_prime_miller_rabin.c +bn_mp_prime_next_prime.c +bn_mp_prime_rabin_miller_trials.c +bn_mp_prime_rand.c +bn_mp_prime_strong_lucas_selfridge.c +bn_mp_radix_size.c +bn_mp_radix_smap.c +bn_mp_rand.c +bn_mp_read_radix.c +bn_mp_reduce.c +bn_mp_reduce_2k.c +bn_mp_reduce_2k_l.c +bn_mp_reduce_2k_setup.c +bn_mp_reduce_2k_setup_l.c +bn_mp_reduce_is_2k.c +bn_mp_reduce_is_2k_l.c +bn_mp_reduce_setup.c +bn_mp_root_n.c +bn_mp_rshd.c +bn_mp_sbin_size.c +bn_mp_set.c +bn_mp_set_double.c +bn_mp_set_i32.c +bn_mp_set_i64.c +bn_mp_set_l.c +bn_mp_set_u32.c +bn_mp_set_u64.c +bn_mp_set_ul.c +bn_mp_shrink.c +bn_mp_signed_rsh.c +bn_mp_sqr.c +bn_mp_sqrmod.c +bn_mp_sqrt.c +bn_mp_sqrtmod_prime.c +bn_mp_sub.c +bn_mp_sub_d.c +bn_mp_submod.c +bn_mp_to_radix.c +bn_mp_to_sbin.c +bn_mp_to_ubin.c +bn_mp_ubin_size.c +bn_mp_unpack.c +bn_mp_xor.c +bn_mp_zero.c +bn_prime_tab.c +bn_s_mp_add.c +bn_s_mp_balance_mul.c +bn_s_mp_div_3.c +bn_s_mp_exptmod.c +bn_s_mp_exptmod_fast.c +bn_s_mp_get_bit.c +bn_s_mp_invmod_fast.c +bn_s_mp_invmod_slow.c +bn_s_mp_karatsuba_mul.c +bn_s_mp_karatsuba_sqr.c +bn_s_mp_log.c +bn_s_mp_log_2expt.c +bn_s_mp_log_d.c +bn_s_mp_montgomery_reduce_fast.c +bn_s_mp_mul_digs.c +bn_s_mp_mul_digs_fast.c +bn_s_mp_mul_high_digs.c +bn_s_mp_mul_high_digs_fast.c +bn_s_mp_prime_is_divisible.c +bn_s_mp_rand_jenkins.c +bn_s_mp_rand_platform.c +bn_s_mp_reverse.c +bn_s_mp_sqr.c +bn_s_mp_sqr_fast.c +bn_s_mp_sub.c +bn_s_mp_toom_mul.c +bn_s_mp_toom_sqr.c +) + +set(HEADERS +tommath.h +tommath_class.h +tommath_cutoffs.h +tommath_private.h +tommath_superclass.h +) diff --git a/libtommath/tommath.def b/libtommath/tommath.def index 879767f..cc6a9f1 100644 --- a/libtommath/tommath.def +++ b/libtommath/tommath.def @@ -33,6 +33,7 @@ EXPORTS mp_dr_setup mp_error_to_string mp_exch + mp_expt_n mp_expt_u32 mp_exptmod mp_exteuclid @@ -75,6 +76,7 @@ EXPORTS mp_isodd mp_kronecker mp_lcm + mp_log_n mp_log_u32 mp_lshd mp_mod @@ -111,6 +113,7 @@ EXPORTS mp_reduce_is_2k mp_reduce_is_2k_l mp_reduce_setup + mp_root_n mp_root_u32 mp_rshd mp_sbin_size @@ -143,14 +146,15 @@ EXPORTS mp_unpack mp_xor mp_zero - s_mp_mul_digs - s_mp_sub s_mp_add - s_mp_toom_mul - s_mp_mul_digs_fast + s_mp_balance_mul s_mp_karatsuba_mul - s_mp_sqr_fast - s_mp_reverse s_mp_karatsuba_sqr - s_mp_toom_sqr + s_mp_mul_digs + s_mp_mul_digs_fast + s_mp_reverse s_mp_sqr + s_mp_sqr_fast + s_mp_sub + s_mp_toom_mul + s_mp_toom_sqr diff --git a/libtommath/tommath.h b/libtommath/tommath.h index a235210..9e0839e 100644 --- a/libtommath/tommath.h +++ b/libtommath/tommath.h @@ -234,22 +234,13 @@ TOOM_SQR_CUTOFF; #if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 405) # define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x))) -#elif defined(_MSC_VER) && _MSC_VER >= 1500 -# define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x)) -#else -# define MP_DEPRECATED(x) -#endif - -#ifndef MP_NO_DEPRECATED_PRAGMA -#if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 301) # define PRIVATE_MP_DEPRECATED_PRAGMA(s) _Pragma(#s) # define MP_DEPRECATED_PRAGMA(s) PRIVATE_MP_DEPRECATED_PRAGMA(GCC warning s) #elif defined(_MSC_VER) && _MSC_VER >= 1500 +# define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x)) # define MP_DEPRECATED_PRAGMA(s) __pragma(message(s)) -#endif -#endif - -#ifndef MP_DEPRECATED_PRAGMA +#else +# define MP_DEPRECATED(s) # define MP_DEPRECATED_PRAGMA(s) #endif @@ -338,7 +329,7 @@ mp_err mp_init_u64(mp_int *a, uint64_t b) MP_WUR; uint32_t mp_get_mag_u32(const mp_int *a) MP_WUR; uint64_t mp_get_mag_u64(const mp_int *a) MP_WUR; unsigned long mp_get_mag_ul(const mp_int *a) MP_WUR; -#define mp_get_mag_ull(a) ((unsigned long long)mp_get_mag_u64(a)) +MP_DEPRECATED(mp_get_mag_u64) unsigned long long mp_get_mag_ull(const mp_int *a) MP_WUR; /* get integer, set integer (long) */ long mp_get_l(const mp_int *a) MP_WUR; @@ -351,14 +342,14 @@ void mp_set_ul(mp_int *a, unsigned long b); mp_err mp_init_ul(mp_int *a, unsigned long b) MP_WUR; /* get integer, set integer (long long) */ -#define mp_get_ll(a) ((long long)mp_get_i64(a)) -#define mp_set_ll(a,b) mp_set_i64(a,b) -#define mp_init_ll(a,b) mp_init_i64(a,b) +MP_DEPRECATED(mp_get_i64) long long mp_get_ll(const mp_int *a) MP_WUR; +MP_DEPRECATED(mp_set_i64) void mp_set_ll(mp_int *a, long long b); +MP_DEPRECATED(mp_init_i64) mp_err mp_init_ll(mp_int *a, long long b) MP_WUR; /* get integer, set integer (unsigned long long) */ -#define mp_get_ull(a) ((unsigned long long)mp_get_i64(a)) -#define mp_set_ull(a,b) mp_set_u64(a,b) -#define mp_init_ull(a,b) mp_init_u64(a,b) +#define mp_get_ull(a) (MP_DEPRECATED_PRAGMA("mp_get_ull() has been deprecated, use mp_get_u64()") ((unsigned long long)mp_get_ll(a))) +MP_DEPRECATED(mp_set_u64) void mp_set_ull(mp_int *a, unsigned long long b); +MP_DEPRECATED(mp_init_u64) mp_err mp_init_ull(mp_int *a, unsigned long long b) MP_WUR; /* set to single unsigned digit, up to MP_DIGIT_MAX */ void mp_set(mp_int *a, mp_digit b); @@ -367,7 +358,7 @@ mp_err mp_init_set(mp_int *a, mp_digit b) MP_WUR; /* get integer, set integer and init with integer (deprecated) */ MP_DEPRECATED(mp_get_mag_u32/mp_get_u32) unsigned long mp_get_int(const mp_int *a) MP_WUR; MP_DEPRECATED(mp_get_mag_ul/mp_get_ul) unsigned long mp_get_long(const mp_int *a) MP_WUR; -MP_DEPRECATED(mp_get_mag_ull/mp_get_ull) unsigned long long mp_get_long_long(const mp_int *a) MP_WUR; +MP_DEPRECATED(mp_get_mag_u64/mp_get_u64) unsigned long long mp_get_long_long(const mp_int *a) MP_WUR; MP_DEPRECATED(mp_set_ul) mp_err mp_set_int(mp_int *a, unsigned long b); MP_DEPRECATED(mp_set_ul) mp_err mp_set_long(mp_int *a, unsigned long b); MP_DEPRECATED(mp_set_ull) mp_err mp_set_long_long(mp_int *a, unsigned long long b); @@ -416,7 +407,7 @@ mp_err mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d) MP_WUR; mp_err mp_div_2(const mp_int *a, mp_int *b) MP_WUR; /* a/3 => 3c + d == a */ -mp_err mp_div_3(const mp_int *a, mp_int *c, mp_digit *d) MP_WUR; +MP_DEPRECATED(mp_div_d) mp_err mp_div_3(const mp_int *a, mp_int *c, mp_digit *d) MP_WUR; /* c = a * 2**b, implemented as c = a << b */ mp_err mp_mul_2d(const mp_int *a, int b, mp_int *c) MP_WUR; @@ -563,13 +554,24 @@ mp_err mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp /* c = [a, b] or (a*b)/(a, b) */ mp_err mp_lcm(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; +/* Integer logarithm to integer base */ +mp_err mp_log_n(const mp_int *a, int base, int *c) MP_WUR; +MP_DEPRECATED(mp_log_n) mp_err mp_log_u32(const mp_int *a, uint32_t base, uint32_t *c) MP_WUR; + +/* c = a**b */ +mp_err mp_expt_n(const mp_int *a, int b, mp_int *c) MP_WUR; +MP_DEPRECATED(mp_expt_n) mp_err mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c) MP_WUR; +MP_DEPRECATED(mp_expt_n) mp_err mp_expt_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; +MP_DEPRECATED(mp_expt_n) mp_err mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR; + /* finds one of the b'th root of a, such that |c|**b <= |a| * * returns error if a < 0 and b is even */ -mp_err mp_root_u32(const mp_int *a, uint32_t b, mp_int *c) MP_WUR; -MP_DEPRECATED(mp_root_u32) mp_err mp_n_root(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; -MP_DEPRECATED(mp_root_u32) mp_err mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR; +mp_err mp_root_n(const mp_int *a, int b, mp_int *c) MP_WUR; +MP_DEPRECATED(mp_root_n) mp_err mp_root_u32(const mp_int *a, uint32_t b, mp_int *c) MP_WUR; +MP_DEPRECATED(mp_root_n) mp_err mp_n_root(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; +MP_DEPRECATED(mp_root_n) mp_err mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR; /* special sqrt algo */ mp_err mp_sqrt(const mp_int *arg, mp_int *ret) MP_WUR; @@ -729,14 +731,6 @@ MP_DEPRECATED(mp_prime_rand) mp_err mp_prime_random_ex(mp_int *a, int t, int siz private_mp_prime_callback cb, void *dat) MP_WUR; mp_err mp_prime_rand(mp_int *a, int t, int size, int flags) MP_WUR; -/* Integer logarithm to integer base */ -mp_err mp_log_u32(const mp_int *a, uint32_t base, uint32_t *c) MP_WUR; - -/* c = a**b */ -mp_err mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c) MP_WUR; -MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR; -MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR; - /* ---> radix conversion <--- */ int mp_count_bits(const mp_int *a) MP_WUR; diff --git a/libtommath/tommath_class.h b/libtommath/tommath_class.h index 52ba585..0be592b 100644 --- a/libtommath/tommath_class.h +++ b/libtommath/tommath_class.h @@ -33,14 +33,13 @@ # define BN_MP_DIV_C # define BN_MP_DIV_2_C # define BN_MP_DIV_2D_C -# define BN_MP_DIV_3_C # define BN_MP_DIV_D_C # define BN_MP_DR_IS_MODULUS_C # define BN_MP_DR_REDUCE_C # define BN_MP_DR_SETUP_C # define BN_MP_ERROR_TO_STRING_C # define BN_MP_EXCH_C -# define BN_MP_EXPT_U32_C +# define BN_MP_EXPT_N_C # define BN_MP_EXPTMOD_C # define BN_MP_EXTEUCLID_C # define BN_MP_FREAD_C @@ -52,11 +51,9 @@ # define BN_MP_GET_I32_C # define BN_MP_GET_I64_C # define BN_MP_GET_L_C -# define BN_MP_GET_LL_C # define BN_MP_GET_MAG_U32_C # define BN_MP_GET_MAG_U64_C # define BN_MP_GET_MAG_UL_C -# define BN_MP_GET_MAG_ULL_C # define BN_MP_GROW_C # define BN_MP_INCR_C # define BN_MP_INIT_C @@ -64,21 +61,19 @@ # define BN_MP_INIT_I32_C # define BN_MP_INIT_I64_C # define BN_MP_INIT_L_C -# define BN_MP_INIT_LL_C # define BN_MP_INIT_MULTI_C # define BN_MP_INIT_SET_C # define BN_MP_INIT_SIZE_C # define BN_MP_INIT_U32_C # define BN_MP_INIT_U64_C # define BN_MP_INIT_UL_C -# define BN_MP_INIT_ULL_C # define BN_MP_INVMOD_C # define BN_MP_IS_SQUARE_C # define BN_MP_ISEVEN_C # define BN_MP_ISODD_C # define BN_MP_KRONECKER_C # define BN_MP_LCM_C -# define BN_MP_LOG_U32_C +# define BN_MP_LOG_N_C # define BN_MP_LSHD_C # define BN_MP_MOD_C # define BN_MP_MOD_2D_C @@ -115,7 +110,7 @@ # define BN_MP_REDUCE_IS_2K_C # define BN_MP_REDUCE_IS_2K_L_C # define BN_MP_REDUCE_SETUP_C -# define BN_MP_ROOT_U32_C +# define BN_MP_ROOT_N_C # define BN_MP_RSHD_C # define BN_MP_SBIN_SIZE_C # define BN_MP_SET_C @@ -123,11 +118,9 @@ # define BN_MP_SET_I32_C # define BN_MP_SET_I64_C # define BN_MP_SET_L_C -# define BN_MP_SET_LL_C # define BN_MP_SET_U32_C # define BN_MP_SET_U64_C # define BN_MP_SET_UL_C -# define BN_MP_SET_ULL_C # define BN_MP_SHRINK_C # define BN_MP_SIGNED_RSH_C # define BN_MP_SQR_C @@ -147,6 +140,7 @@ # define BN_PRIME_TAB_C # define BN_S_MP_ADD_C # define BN_S_MP_BALANCE_MUL_C +# define BN_S_MP_DIV_3_C # define BN_S_MP_EXPTMOD_C # define BN_S_MP_EXPTMOD_FAST_C # define BN_S_MP_GET_BIT_C @@ -154,6 +148,9 @@ # define BN_S_MP_INVMOD_SLOW_C # define BN_S_MP_KARATSUBA_MUL_C # define BN_S_MP_KARATSUBA_SQR_C +# define BN_S_MP_LOG_C +# define BN_S_MP_LOG_2EXPT_C +# define BN_S_MP_LOG_D_C # define BN_S_MP_MONTGOMERY_REDUCE_FAST_C # define BN_S_MP_MUL_DIGS_C # define BN_S_MP_MUL_DIGS_FAST_C @@ -182,28 +179,36 @@ # define BN_MP_AND_C # define BN_MP_BALANCE_MUL_C # define BN_MP_CMP_D_C +# define BN_MP_DIV_3_C # define BN_MP_EXPORT_C # define BN_MP_EXPTMOD_FAST_C # define BN_MP_EXPT_D_C # define BN_MP_EXPT_D_EX_C +# define BN_MP_EXPT_N_C # define BN_MP_EXPT_U32_C # define BN_MP_FROM_SBIN_C # define BN_MP_FROM_UBIN_C # define BN_MP_GET_BIT_C # define BN_MP_GET_INT_C +# define BN_MP_GET_LL_C # define BN_MP_GET_LONG_C # define BN_MP_GET_LONG_LONG_C # define BN_MP_GET_MAG_U32_C +# define BN_MP_GET_MAG_U64_C # define BN_MP_GET_MAG_ULL_C # define BN_MP_GET_MAG_UL_C # define BN_MP_IMPORT_C +# define BN_MP_INIT_LL_C # define BN_MP_INIT_SET_INT_C # define BN_MP_INIT_U32_C +# define BN_MP_INIT_ULL_C # define BN_MP_INVMOD_SLOW_C # define BN_MP_JACOBI_C # define BN_MP_KARATSUBA_MUL_C # define BN_MP_KARATSUBA_SQR_C # define BN_MP_KRONECKER_C +# define BN_MP_LOG_N_C +# define BN_MP_LOG_U32_C # define BN_MP_N_ROOT_C # define BN_MP_N_ROOT_EX_C # define BN_MP_OR_C @@ -213,13 +218,16 @@ # define BN_MP_RAND_DIGIT_C # define BN_MP_READ_SIGNED_BIN_C # define BN_MP_READ_UNSIGNED_BIN_C +# define BN_MP_ROOT_N_C # define BN_MP_ROOT_U32_C # define BN_MP_SBIN_SIZE_C # define BN_MP_SET_INT_C +# define BN_MP_SET_LL_C # define BN_MP_SET_LONG_C # define BN_MP_SET_LONG_LONG_C # define BN_MP_SET_U32_C # define BN_MP_SET_U64_C +# define BN_MP_SET_ULL_C # define BN_MP_SIGNED_BIN_SIZE_C # define BN_MP_SIGNED_RSH_C # define BN_MP_TC_AND_C @@ -242,6 +250,7 @@ # define BN_MP_UNSIGNED_BIN_SIZE_C # define BN_MP_XOR_C # define BN_S_MP_BALANCE_MUL_C +# define BN_S_MP_DIV_3_C # define BN_S_MP_EXPTMOD_FAST_C # define BN_S_MP_GET_BIT_C # define BN_S_MP_INVMOD_FAST_C @@ -369,21 +378,14 @@ # define BN_MP_ZERO_C #endif -#if defined(BN_MP_DIV_3_C) -# define BN_MP_CLAMP_C -# define BN_MP_CLEAR_C -# define BN_MP_EXCH_C -# define BN_MP_INIT_SIZE_C -#endif - #if defined(BN_MP_DIV_D_C) # define BN_MP_CLAMP_C # define BN_MP_CLEAR_C # define BN_MP_COPY_C # define BN_MP_DIV_2D_C -# define BN_MP_DIV_3_C # define BN_MP_EXCH_C # define BN_MP_INIT_SIZE_C +# define BN_S_MP_DIV_3_C #endif #if defined(BN_MP_DR_IS_MODULUS_C) @@ -405,7 +407,7 @@ #if defined(BN_MP_EXCH_C) #endif -#if defined(BN_MP_EXPT_U32_C) +#if defined(BN_MP_EXPT_N_C) # define BN_MP_CLEAR_C # define BN_MP_INIT_COPY_C # define BN_MP_MUL_C @@ -486,10 +488,6 @@ # define BN_MP_GET_MAG_UL_C #endif -#if defined(BN_MP_GET_LL_C) -# define BN_MP_GET_MAG_ULL_C -#endif - #if defined(BN_MP_GET_MAG_U32_C) #endif @@ -499,9 +497,6 @@ #if defined(BN_MP_GET_MAG_UL_C) #endif -#if defined(BN_MP_GET_MAG_ULL_C) -#endif - #if defined(BN_MP_GROW_C) #endif @@ -535,11 +530,6 @@ # define BN_MP_SET_L_C #endif -#if defined(BN_MP_INIT_LL_C) -# define BN_MP_INIT_C -# define BN_MP_SET_LL_C -#endif - #if defined(BN_MP_INIT_MULTI_C) # define BN_MP_CLEAR_C # define BN_MP_INIT_C @@ -568,11 +558,6 @@ # define BN_MP_SET_UL_C #endif -#if defined(BN_MP_INIT_ULL_C) -# define BN_MP_INIT_C -# define BN_MP_SET_ULL_C -#endif - #if defined(BN_MP_INVMOD_C) # define BN_MP_CMP_D_C # define BN_S_MP_INVMOD_FAST_C @@ -616,18 +601,10 @@ # define BN_MP_MUL_C #endif -#if defined(BN_MP_LOG_U32_C) -# define BN_MP_CLEAR_MULTI_C -# define BN_MP_CMP_C -# define BN_MP_CMP_D_C -# define BN_MP_COPY_C -# define BN_MP_COUNT_BITS_C -# define BN_MP_EXCH_C -# define BN_MP_EXPT_U32_C -# define BN_MP_INIT_MULTI_C -# define BN_MP_MUL_C -# define BN_MP_SET_C -# define BN_MP_SQR_C +#if defined(BN_MP_LOG_N_C) +# define BN_S_MP_LOG_2EXPT_C +# define BN_S_MP_LOG_C +# define BN_S_MP_LOG_D_C #endif #if defined(BN_MP_LSHD_C) @@ -929,7 +906,7 @@ # define BN_MP_DIV_C #endif -#if defined(BN_MP_ROOT_U32_C) +#if defined(BN_MP_ROOT_N_C) # define BN_MP_2EXPT_C # define BN_MP_ADD_D_C # define BN_MP_CLEAR_MULTI_C @@ -938,7 +915,7 @@ # define BN_MP_COUNT_BITS_C # define BN_MP_DIV_C # define BN_MP_EXCH_C -# define BN_MP_EXPT_U32_C +# define BN_MP_EXPT_N_C # define BN_MP_INIT_MULTI_C # define BN_MP_MUL_C # define BN_MP_MUL_D_C @@ -976,10 +953,6 @@ # define BN_MP_SET_UL_C #endif -#if defined(BN_MP_SET_LL_C) -# define BN_MP_SET_ULL_C -#endif - #if defined(BN_MP_SET_U32_C) #endif @@ -989,9 +962,6 @@ #if defined(BN_MP_SET_UL_C) #endif -#if defined(BN_MP_SET_ULL_C) -#endif - #if defined(BN_MP_SHRINK_C) #endif @@ -1121,6 +1091,13 @@ # define BN_MP_MUL_C #endif +#if defined(BN_S_MP_DIV_3_C) +# define BN_MP_CLAMP_C +# define BN_MP_CLEAR_C +# define BN_MP_EXCH_C +# define BN_MP_INIT_SIZE_C +#endif + #if defined(BN_S_MP_EXPTMOD_C) # define BN_MP_CLEAR_C # define BN_MP_COPY_C @@ -1213,6 +1190,26 @@ # define BN_S_MP_SUB_C #endif +#if defined(BN_S_MP_LOG_C) +# define BN_MP_CLEAR_MULTI_C +# define BN_MP_CMP_C +# define BN_MP_CMP_D_C +# define BN_MP_COPY_C +# define BN_MP_EXCH_C +# define BN_MP_EXPT_N_C +# define BN_MP_INIT_MULTI_C +# define BN_MP_MUL_C +# define BN_MP_SET_C +# define BN_MP_SQR_C +#endif + +#if defined(BN_S_MP_LOG_2EXPT_C) +# define BN_MP_COUNT_BITS_C +#endif + +#if defined(BN_S_MP_LOG_D_C) +#endif + #if defined(BN_S_MP_MONTGOMERY_REDUCE_FAST_C) # define BN_MP_CLAMP_C # define BN_MP_CMP_MAG_C @@ -1283,13 +1280,13 @@ # define BN_MP_CLEAR_C # define BN_MP_CLEAR_MULTI_C # define BN_MP_DIV_2_C -# define BN_MP_DIV_3_C # define BN_MP_INIT_MULTI_C # define BN_MP_INIT_SIZE_C # define BN_MP_LSHD_C # define BN_MP_MUL_2_C # define BN_MP_MUL_C # define BN_MP_SUB_C +# define BN_S_MP_DIV_3_C #endif #if defined(BN_S_MP_TOOM_SQR_C) diff --git a/libtommath/tommath_private.h b/libtommath/tommath_private.h index 8aab7c3..16a7e46 100644 --- a/libtommath/tommath_private.h +++ b/libtommath/tommath_private.h @@ -5,7 +5,11 @@ #define TOMMATH_PRIV_H_ #include -#include "tclTomMath.h" +#ifndef TCL_WITH_EXTERNAL_TOMMATH +# include "tclTomMath.h" +#else +# include "tommath.h" +#endif #include "tommath_class.h" /* @@ -159,6 +163,8 @@ typedef private_mp_word mp_word; #define MP_MIN(x, y) (((x) < (y)) ? (x) : (y)) #define MP_MAX(x, y) (((x) > (y)) ? (x) : (y)) +#define MP_IS_2EXPT(x) (((x) != 0u) && (((x) & ((x) - 1u)) == 0u)) + /* Static assertion */ #define MP_STATIC_ASSERT(msg, cond) typedef char mp_static_assert_##msg[(cond) ? 1 : -1]; @@ -193,6 +199,8 @@ extern "C" { #endif /* lowlevel functions, do not call! */ MP_PRIVATE mp_bool s_mp_get_bit(const mp_int *a, unsigned int b); +MP_PRIVATE int s_mp_log_2expt(const mp_int *a, mp_digit base) MP_WUR; +MP_PRIVATE int s_mp_log_d(mp_digit base, mp_digit n) MP_WUR; MP_PRIVATE mp_err s_mp_add(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; MP_PRIVATE mp_err s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; MP_PRIVATE mp_err s_mp_mul_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR; @@ -211,6 +219,7 @@ MP_PRIVATE mp_err s_mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c) MP_PRIVATE mp_err s_mp_montgomery_reduce_fast(mp_int *x, const mp_int *n, mp_digit rho) MP_WUR; MP_PRIVATE mp_err s_mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) MP_WUR; MP_PRIVATE mp_err s_mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) MP_WUR; +MP_PRIVATE mp_err s_mp_log(const mp_int *a, mp_digit base, int *c) MP_WUR; MP_PRIVATE mp_err s_mp_rand_platform(void *p, size_t n) MP_WUR; MP_PRIVATE mp_err s_mp_prime_random_ex(mp_int *a, int t, int size, int flags, private_mp_prime_callback cb, void *dat); MP_PRIVATE void s_mp_reverse(unsigned char *s, size_t len); diff --git a/libtommath/win32/libtommath.dll b/libtommath/win32/libtommath.dll index 62779fa..c0aba14 100755 Binary files a/libtommath/win32/libtommath.dll and b/libtommath/win32/libtommath.dll differ diff --git a/libtommath/win32/tommath.lib b/libtommath/win32/tommath.lib index dd3e82e..9c539d1 100644 Binary files a/libtommath/win32/tommath.lib and b/libtommath/win32/tommath.lib differ diff --git a/libtommath/win64-arm/libtommath.dll b/libtommath/win64-arm/libtommath.dll index e795d6d..9cec45b 100755 Binary files a/libtommath/win64-arm/libtommath.dll and b/libtommath/win64-arm/libtommath.dll differ diff --git a/libtommath/win64-arm/tommath.lib b/libtommath/win64-arm/tommath.lib index f14fbe7..36d3527 100644 Binary files a/libtommath/win64-arm/tommath.lib and b/libtommath/win64-arm/tommath.lib differ diff --git a/libtommath/win64/libtommath.dll b/libtommath/win64/libtommath.dll index 3667593..856af88 100755 Binary files a/libtommath/win64/libtommath.dll and b/libtommath/win64/libtommath.dll differ diff --git a/libtommath/win64/tommath.lib b/libtommath/win64/tommath.lib index 434fa7c..18a8532 100644 Binary files a/libtommath/win64/tommath.lib and b/libtommath/win64/tommath.lib differ diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj index e8c0924..ebc614a 100644 --- a/macosx/Tcl.xcodeproj/project.pbxproj +++ b/macosx/Tcl.xcodeproj/project.pbxproj @@ -110,7 +110,7 @@ F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427608F272B3004A47F5 /* bn_mp_div.c */; }; F96D48F508F272C3004A47F5 /* bn_mp_div_2.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427708F272B3004A47F5 /* bn_mp_div_2.c */; }; F96D48F608F272C3004A47F5 /* bn_mp_div_2d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */; }; - F96D48F708F272C3004A47F5 /* bn_mp_div_3.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427908F272B3004A47F5 /* bn_mp_div_3.c */; }; + F96D48F708F272C3004A47F5 /* bn_s_mp_div_3.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427908F272B3004A47F5 /* bn_s_mp_div_3.c */; }; F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */; }; F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427E08F272B3004A47F5 /* bn_mp_exch.c */; }; F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D428708F272B3004A47F5 /* bn_mp_grow.c */; }; @@ -163,7 +163,7 @@ F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A208F272B3004A47F5 /* bn_mp_neg.c */; }; F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */; }; F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426C08F272B3004A47F5 /* bn_mp_and.c */; }; - F9E61D2C090A48AC002B3151 /* bn_mp_expt_u32.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */; }; + F9E61D2C090A48AC002B3151 /* bn_mp_expt_n.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_n.c */; }; F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */; }; F9E61D2E090A48BF002B3151 /* bn_mp_or.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A308F272B3004A47F5 /* bn_mp_or.c */; }; F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */; }; @@ -569,10 +569,10 @@ F96D427608F272B3004A47F5 /* bn_mp_div.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div.c; sourceTree = ""; }; F96D427708F272B3004A47F5 /* bn_mp_div_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2.c; sourceTree = ""; }; F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2d.c; sourceTree = ""; }; - F96D427908F272B3004A47F5 /* bn_mp_div_3.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_3.c; sourceTree = ""; }; + F96D427908F272B3004A47F5 /* bn_s_mp_div_3.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_div_3.c; sourceTree = ""; }; F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_d.c; sourceTree = ""; }; F96D427E08F272B3004A47F5 /* bn_mp_exch.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exch.c; sourceTree = ""; }; - F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_u32.c; sourceTree = ""; }; + F96D427F08F272B3004A47F5 /* bn_mp_expt_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_n.c; sourceTree = ""; }; F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_d_ex.c; sourceTree = ""; }; F96D428708F272B3004A47F5 /* bn_mp_grow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_grow.c; sourceTree = ""; }; F96D428808F272B3004A47F5 /* bn_mp_init.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init.c; sourceTree = ""; }; @@ -1416,10 +1416,10 @@ F96D427608F272B3004A47F5 /* bn_mp_div.c */, F96D427708F272B3004A47F5 /* bn_mp_div_2.c */, F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */, - F96D427908F272B3004A47F5 /* bn_mp_div_3.c */, + F96D427908F272B3004A47F5 /* bn_s_mp_div_3.c */, F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */, F96D427E08F272B3004A47F5 /* bn_mp_exch.c */, - F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */, + F96D427F08F272B3004A47F5 /* bn_mp_expt_n.c */, F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */, F96D428708F272B3004A47F5 /* bn_mp_grow.c */, F96D428808F272B3004A47F5 /* bn_mp_init.c */, @@ -2033,10 +2033,10 @@ F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */, F96D48F508F272C3004A47F5 /* bn_mp_div_2.c in Sources */, F96D48F608F272C3004A47F5 /* bn_mp_div_2d.c in Sources */, - F96D48F708F272C3004A47F5 /* bn_mp_div_3.c in Sources */, + F96D48F708F272C3004A47F5 /* bn_s_mp_div_3.c in Sources */, F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */, F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */, - F9E61D2C090A48AC002B3151 /* bn_mp_expt_u32.c in Sources */, + F9E61D2C090A48AC002B3151 /* bn_mp_expt_n.c in Sources */, F9E61D2C090A48AC002B3151 /* bn_mp_expt_d_ex.c in Sources */, F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */, F96D490608F272C3004A47F5 /* bn_mp_init.c in Sources */, diff --git a/unix/Makefile.in b/unix/Makefile.in index 0a9d84e..c9ac291 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -327,7 +327,7 @@ TOMMATH_OBJS = bn_s_mp_reverse.o bn_s_mp_mul_digs_fast.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_mp_div_2d.o bn_s_mp_div_3.o bn_mp_exch.o bn_mp_expt_n.o \ bn_mp_get_mag_u64.o \ bn_mp_grow.o bn_mp_init.o \ bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \ @@ -516,14 +516,14 @@ TOMMATH_SRCS = \ $(TOMMATH_DIR)/bn_mp_div.c \ $(TOMMATH_DIR)/bn_mp_div_2.c \ $(TOMMATH_DIR)/bn_mp_div_2d.c \ - $(TOMMATH_DIR)/bn_mp_div_3.c \ + $(TOMMATH_DIR)/bn_s_mp_div_3.c \ $(TOMMATH_DIR)/bn_mp_div_d.c \ $(TOMMATH_DIR)/bn_mp_dr_is_modulus.c \ $(TOMMATH_DIR)/bn_mp_dr_reduce.c \ $(TOMMATH_DIR)/bn_mp_dr_setup.c \ $(TOMMATH_DIR)/bn_mp_error_to_string.c \ $(TOMMATH_DIR)/bn_mp_exch.c \ - $(TOMMATH_DIR)/bn_mp_expt_u32.c \ + $(TOMMATH_DIR)/bn_mp_expt_n.c \ $(TOMMATH_DIR)/bn_mp_exptmod.c \ $(TOMMATH_DIR)/bn_mp_exteuclid.c \ $(TOMMATH_DIR)/bn_mp_fread.c \ @@ -535,11 +535,9 @@ TOMMATH_SRCS = \ $(TOMMATH_DIR)/bn_mp_get_i32.c \ $(TOMMATH_DIR)/bn_mp_get_i64.c \ $(TOMMATH_DIR)/bn_mp_get_l.c \ - $(TOMMATH_DIR)/bn_mp_get_ll.c \ $(TOMMATH_DIR)/bn_mp_get_mag_u32.c \ $(TOMMATH_DIR)/bn_mp_get_mag_u64.c \ $(TOMMATH_DIR)/bn_mp_get_mag_ul.c \ - $(TOMMATH_DIR)/bn_mp_get_mag_ull.c \ $(TOMMATH_DIR)/bn_mp_grow.c \ $(TOMMATH_DIR)/bn_mp_incr.c \ $(TOMMATH_DIR)/bn_mp_init.c \ @@ -547,21 +545,22 @@ TOMMATH_SRCS = \ $(TOMMATH_DIR)/bn_mp_init_i32.c \ $(TOMMATH_DIR)/bn_mp_init_i64.c \ $(TOMMATH_DIR)/bn_mp_init_l.c \ - $(TOMMATH_DIR)/bn_mp_init_ll.c \ $(TOMMATH_DIR)/bn_mp_init_multi.c \ $(TOMMATH_DIR)/bn_mp_init_set.c \ $(TOMMATH_DIR)/bn_mp_init_size.c \ $(TOMMATH_DIR)/bn_mp_init_u32.c \ $(TOMMATH_DIR)/bn_mp_init_u64.c \ $(TOMMATH_DIR)/bn_mp_init_ul.c \ - $(TOMMATH_DIR)/bn_mp_init_ull.c \ $(TOMMATH_DIR)/bn_mp_invmod.c \ $(TOMMATH_DIR)/bn_mp_is_square.c \ $(TOMMATH_DIR)/bn_mp_iseven.c \ $(TOMMATH_DIR)/bn_mp_isodd.c \ $(TOMMATH_DIR)/bn_mp_kronecker.c \ $(TOMMATH_DIR)/bn_mp_lcm.c \ - $(TOMMATH_DIR)/bn_mp_log_u32.c \ + $(TOMMATH_DIR)/bn_mp_log_n.c \ + $(TOMMATH_DIR)/bn_s_mp_log.c \ + $(TOMMATH_DIR)/bn_s_mp_log_2expt.c \ + $(TOMMATH_DIR)/bn_s_mp_log_d.c \ $(TOMMATH_DIR)/bn_mp_lshd.c \ $(TOMMATH_DIR)/bn_mp_mod.c \ $(TOMMATH_DIR)/bn_mp_mod_2d.c \ @@ -598,7 +597,7 @@ TOMMATH_SRCS = \ $(TOMMATH_DIR)/bn_mp_reduce_is_2k.c \ $(TOMMATH_DIR)/bn_mp_reduce_is_2k_l.c \ $(TOMMATH_DIR)/bn_mp_reduce_setup.c \ - $(TOMMATH_DIR)/bn_mp_root_u32.c \ + $(TOMMATH_DIR)/bn_mp_root_n.c \ $(TOMMATH_DIR)/bn_mp_rshd.c \ $(TOMMATH_DIR)/bn_mp_sbin_size.c \ $(TOMMATH_DIR)/bn_mp_set.c \ @@ -606,11 +605,9 @@ TOMMATH_SRCS = \ $(TOMMATH_DIR)/bn_mp_set_i32.c \ $(TOMMATH_DIR)/bn_mp_set_i64.c \ $(TOMMATH_DIR)/bn_mp_set_l.c \ - $(TOMMATH_DIR)/bn_mp_set_ll.c \ $(TOMMATH_DIR)/bn_mp_set_u32.c \ $(TOMMATH_DIR)/bn_mp_set_u64.c \ $(TOMMATH_DIR)/bn_mp_set_ul.c \ - $(TOMMATH_DIR)/bn_mp_set_ull.c \ $(TOMMATH_DIR)/bn_mp_shrink.c \ $(TOMMATH_DIR)/bn_mp_signed_rsh.c \ $(TOMMATH_DIR)/bn_mp_sqr.c \ @@ -1647,14 +1644,14 @@ bn_mp_div_2.o: $(TOMMATH_DIR)/bn_mp_div_2.c $(MATHHDRS) bn_mp_div_2d.o: $(TOMMATH_DIR)/bn_mp_div_2d.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_div_2d.c -bn_mp_div_3.o: $(TOMMATH_DIR)/bn_mp_div_3.c $(MATHHDRS) - $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_div_3.c +bn_s_mp_div_3.o: $(TOMMATH_DIR)/bn_s_mp_div_3.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_div_3.c bn_mp_exch.o: $(TOMMATH_DIR)/bn_mp_exch.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_exch.c -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_mp_expt_n.o: $(TOMMATH_DIR)/bn_mp_expt_n.c $(MATHHDRS) + $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_n.c bn_mp_get_mag_u64.o: $(TOMMATH_DIR)/bn_mp_get_mag_u64.c $(MATHHDRS) $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_mag_u64.c diff --git a/win/Makefile.in b/win/Makefile.in index e103ef2..91aed32 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -384,9 +384,9 @@ TOMMATH_OBJS = \ bn_mp_div_d.${OBJEXT} \ bn_mp_div_2.${OBJEXT} \ bn_mp_div_2d.${OBJEXT} \ - bn_mp_div_3.${OBJEXT} \ + bn_s_mp_div_3.${OBJEXT} \ bn_mp_exch.${OBJEXT} \ - bn_mp_expt_u32.${OBJEXT} \ + bn_mp_expt_n.${OBJEXT} \ bn_mp_get_mag_u64.${OBJEXT} \ bn_mp_grow.${OBJEXT} \ bn_mp_init.${OBJEXT} \ diff --git a/win/makefile.vc b/win/makefile.vc index 987bcb8..5b8721e 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -368,9 +368,9 @@ TOMMATHOBJS = \ $(TMP_DIR)\bn_mp_div_d.obj \ $(TMP_DIR)\bn_mp_div_2.obj \ $(TMP_DIR)\bn_mp_div_2d.obj \ - $(TMP_DIR)\bn_mp_div_3.obj \ + $(TMP_DIR)\bn_s_mp_div_3.obj \ $(TMP_DIR)\bn_mp_exch.obj \ - $(TMP_DIR)\bn_mp_expt_u32.obj \ + $(TMP_DIR)\bn_mp_expt_n.obj \ $(TMP_DIR)\bn_mp_get_mag_u64.obj \ $(TMP_DIR)\bn_mp_grow.obj \ $(TMP_DIR)\bn_mp_init.obj \ -- cgit v0.12 From d7c95147c6dfcf4c46807b065be99ceda12f3cfb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 29 Mar 2024 15:42:29 +0000 Subject: 4 more files, which should have been removed as part of the libtommath 1.2 -> 1.3 upgrade --- libtommath/bn_mp_div_3.c | 63 ---------------- libtommath/bn_mp_expt_u32.c | 46 ----------- libtommath/bn_mp_log_u32.c | 180 -------------------------------------------- libtommath/bn_mp_root_u32.c | 139 ---------------------------------- 4 files changed, 428 deletions(-) delete mode 100644 libtommath/bn_mp_div_3.c delete mode 100644 libtommath/bn_mp_expt_u32.c delete mode 100644 libtommath/bn_mp_log_u32.c delete mode 100644 libtommath/bn_mp_root_u32.c diff --git a/libtommath/bn_mp_div_3.c b/libtommath/bn_mp_div_3.c deleted file mode 100644 index 3a23fdf..0000000 --- a/libtommath/bn_mp_div_3.c +++ /dev/null @@ -1,63 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_DIV_3_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis */ -/* SPDX-License-Identifier: Unlicense */ - -/* divide by three (based on routine from MPI and the GMP manual) */ -mp_err mp_div_3(const mp_int *a, mp_int *c, mp_digit *d) -{ - mp_int q; - mp_word w, t; - mp_digit b; - mp_err err; - int ix; - - /* b = 2**MP_DIGIT_BIT / 3 */ - b = ((mp_word)1 << (mp_word)MP_DIGIT_BIT) / (mp_word)3; - - if ((err = mp_init_size(&q, a->used)) != MP_OKAY) { - return err; - } - - q.used = a->used; - q.sign = a->sign; - w = 0; - for (ix = a->used - 1; ix >= 0; ix--) { - w = (w << (mp_word)MP_DIGIT_BIT) | (mp_word)a->dp[ix]; - - if (w >= 3u) { - /* multiply w by [1/3] */ - t = (w * (mp_word)b) >> (mp_word)MP_DIGIT_BIT; - - /* now subtract 3 * [w/3] from w, to get the remainder */ - w -= t+t+t; - - /* fixup the remainder as required since - * the optimization is not exact. - */ - while (w >= 3u) { - t += 1u; - w -= 3u; - } - } else { - t = 0; - } - q.dp[ix] = (mp_digit)t; - } - - /* [optional] store the remainder */ - if (d != NULL) { - *d = (mp_digit)w; - } - - /* [optional] store the quotient */ - if (c != NULL) { - mp_clamp(&q); - mp_exch(&q, c); - } - mp_clear(&q); - - return err; -} - -#endif diff --git a/libtommath/bn_mp_expt_u32.c b/libtommath/bn_mp_expt_u32.c deleted file mode 100644 index 2ab67ba..0000000 --- a/libtommath/bn_mp_expt_u32.c +++ /dev/null @@ -1,46 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_EXPT_U32_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis */ -/* SPDX-License-Identifier: Unlicense */ - -/* calculate c = a**b using a square-multiply algorithm */ -mp_err mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c) -{ - mp_err err; - - mp_int g; - - if ((err = mp_init_copy(&g, a)) != MP_OKAY) { - return err; - } - - /* set initial result */ - mp_set(c, 1uL); - - while (b > 0u) { - /* if the bit is set multiply */ - if ((b & 1u) != 0u) { - if ((err = mp_mul(c, &g, c)) != MP_OKAY) { - goto LBL_ERR; - } - } - - /* square */ - if (b > 1u) { - if ((err = mp_sqr(&g, &g)) != MP_OKAY) { - goto LBL_ERR; - } - } - - /* shift to next bit */ - b >>= 1; - } - - err = MP_OKAY; - -LBL_ERR: - mp_clear(&g); - return err; -} - -#endif diff --git a/libtommath/bn_mp_log_u32.c b/libtommath/bn_mp_log_u32.c deleted file mode 100644 index b86d789..0000000 --- a/libtommath/bn_mp_log_u32.c +++ /dev/null @@ -1,180 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_LOG_U32_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis */ -/* SPDX-License-Identifier: Unlicense */ - -/* Compute log_{base}(a) */ -static mp_word s_pow(mp_word base, mp_word exponent) -{ - mp_word result = 1u; - while (exponent != 0u) { - if ((exponent & 1u) == 1u) { - result *= base; - } - exponent >>= 1; - base *= base; - } - - return result; -} - -static mp_digit s_digit_ilogb(mp_digit base, mp_digit n) -{ - mp_word bracket_low = 1u, bracket_mid, bracket_high, N; - mp_digit ret, high = 1u, low = 0uL, mid; - - if (n < base) { - return 0uL; - } - if (n == base) { - return 1uL; - } - - bracket_high = (mp_word) base ; - N = (mp_word) n; - - while (bracket_high < N) { - low = high; - bracket_low = bracket_high; - high <<= 1; - bracket_high *= bracket_high; - } - - while (((mp_digit)(high - low)) > 1u) { - mid = (low + high) >> 1; - bracket_mid = bracket_low * s_pow(base, (mp_word)(mid - low)); - - if (N < bracket_mid) { - high = mid ; - bracket_high = bracket_mid ; - } - if (N > bracket_mid) { - low = mid ; - bracket_low = bracket_mid ; - } - if (N == bracket_mid) { - return (mp_digit) mid; - } - } - - if (bracket_high == N) { - ret = high; - } else { - ret = low; - } - - return ret; -} - -/* TODO: output could be "int" because the output of mp_radix_size is int, too, - as is the output of mp_bitcount. - With the same problem: max size is INT_MAX * MP_DIGIT not INT_MAX only! -*/ -mp_err mp_log_u32(const mp_int *a, uint32_t base, uint32_t *c) -{ - mp_err err; - mp_ord cmp; - uint32_t high, low, mid; - mp_int bracket_low, bracket_high, bracket_mid, t, bi_base; - - err = MP_OKAY; - - if (a->sign == MP_NEG) { - return MP_VAL; - } - - if (MP_IS_ZERO(a)) { - return MP_VAL; - } - - if (base < 2u) { - return MP_VAL; - } - - /* A small shortcut for bases that are powers of two. */ - if ((base & (base - 1u)) == 0u) { - int y, bit_count; - for (y=0; (y < 7) && ((base & 1u) == 0u); y++) { - base >>= 1; - } - bit_count = mp_count_bits(a) - 1; - *c = (uint32_t)(bit_count/y); - return MP_OKAY; - } - - if (a->used == 1) { - *c = (uint32_t)s_digit_ilogb(base, a->dp[0]); - return err; - } - - cmp = mp_cmp_d(a, base); - if ((cmp == MP_LT) || (cmp == MP_EQ)) { - *c = cmp == MP_EQ; - return err; - } - - if ((err = - mp_init_multi(&bracket_low, &bracket_high, - &bracket_mid, &t, &bi_base, NULL)) != MP_OKAY) { - return err; - } - - low = 0u; - mp_set(&bracket_low, 1uL); - high = 1u; - - mp_set(&bracket_high, base); - - /* - A kind of Giant-step/baby-step algorithm. - Idea shamelessly stolen from https://programmingpraxis.com/2010/05/07/integer-logarithms/2/ - The effect is asymptotic, hence needs benchmarks to test if the Giant-step should be skipped - for small n. - */ - while (mp_cmp(&bracket_high, a) == MP_LT) { - low = high; - if ((err = mp_copy(&bracket_high, &bracket_low)) != MP_OKAY) { - goto LBL_ERR; - } - high <<= 1; - if ((err = mp_sqr(&bracket_high, &bracket_high)) != MP_OKAY) { - goto LBL_ERR; - } - } - mp_set(&bi_base, base); - - while ((high - low) > 1u) { - mid = (high + low) >> 1; - - if ((err = mp_expt_u32(&bi_base, (uint32_t)(mid - low), &t)) != MP_OKAY) { - goto LBL_ERR; - } - if ((err = mp_mul(&bracket_low, &t, &bracket_mid)) != MP_OKAY) { - goto LBL_ERR; - } - cmp = mp_cmp(a, &bracket_mid); - if (cmp == MP_LT) { - high = mid; - mp_exch(&bracket_mid, &bracket_high); - } - if (cmp == MP_GT) { - low = mid; - mp_exch(&bracket_mid, &bracket_low); - } - if (cmp == MP_EQ) { - *c = mid; - goto LBL_END; - } - } - - *c = (mp_cmp(&bracket_high, a) == MP_EQ) ? high : low; - -LBL_END: -LBL_ERR: - mp_clear_multi(&bracket_low, &bracket_high, &bracket_mid, - &t, &bi_base, NULL); - return err; -} - - -#endif diff --git a/libtommath/bn_mp_root_u32.c b/libtommath/bn_mp_root_u32.c deleted file mode 100644 index ba65549..0000000 --- a/libtommath/bn_mp_root_u32.c +++ /dev/null @@ -1,139 +0,0 @@ -#include "tommath_private.h" -#ifdef BN_MP_ROOT_U32_C -/* LibTomMath, multiple-precision integer library -- Tom St Denis */ -/* SPDX-License-Identifier: Unlicense */ - -/* find the n'th root of an integer - * - * Result found such that (c)**b <= a and (c+1)**b > a - * - * This algorithm uses Newton's approximation - * x[i+1] = x[i] - f(x[i])/f'(x[i]) - * which will find the root in log(N) time where - * each step involves a fair bit. - */ -mp_err mp_root_u32(const mp_int *a, uint32_t b, mp_int *c) -{ - mp_int t1, t2, t3, a_; - mp_ord cmp; - int ilog2; - mp_err err; - - /* input must be positive if b is even */ - if (((b & 1u) == 0u) && (a->sign == MP_NEG)) { - return MP_VAL; - } - - if ((err = mp_init_multi(&t1, &t2, &t3, NULL)) != MP_OKAY) { - return err; - } - - /* if a is negative fudge the sign but keep track */ - a_ = *a; - a_.sign = MP_ZPOS; - - /* Compute seed: 2^(log_2(n)/b + 2)*/ - ilog2 = mp_count_bits(a); - - /* - If "b" is larger than INT_MAX it is also larger than - log_2(n) because the bit-length of the "n" is measured - with an int and hence the root is always < 2 (two). - */ - if (b > (uint32_t)(INT_MAX/2)) { - mp_set(c, 1uL); - c->sign = a->sign; - err = MP_OKAY; - goto LBL_ERR; - } - - /* "b" is smaller than INT_MAX, we can cast safely */ - if (ilog2 < (int)b) { - mp_set(c, 1uL); - c->sign = a->sign; - err = MP_OKAY; - goto LBL_ERR; - } - ilog2 = ilog2 / ((int)b); - if (ilog2 == 0) { - mp_set(c, 1uL); - c->sign = a->sign; - err = MP_OKAY; - goto LBL_ERR; - } - /* Start value must be larger than root */ - ilog2 += 2; - if ((err = mp_2expt(&t2,ilog2)) != MP_OKAY) goto LBL_ERR; - do { - /* t1 = t2 */ - if ((err = mp_copy(&t2, &t1)) != MP_OKAY) goto LBL_ERR; - - /* t2 = t1 - ((t1**b - a) / (b * t1**(b-1))) */ - - /* t3 = t1**(b-1) */ - if ((err = mp_expt_u32(&t1, b - 1u, &t3)) != MP_OKAY) goto LBL_ERR; - - /* numerator */ - /* t2 = t1**b */ - if ((err = mp_mul(&t3, &t1, &t2)) != MP_OKAY) goto LBL_ERR; - - /* t2 = t1**b - a */ - if ((err = mp_sub(&t2, &a_, &t2)) != MP_OKAY) goto LBL_ERR; - - /* denominator */ - /* t3 = t1**(b-1) * b */ - if ((err = mp_mul_d(&t3, b, &t3)) != MP_OKAY) goto LBL_ERR; - - /* t3 = (t1**b - a)/(b * t1**(b-1)) */ - if ((err = mp_div(&t2, &t3, &t3, NULL)) != MP_OKAY) goto LBL_ERR; - - if ((err = mp_sub(&t1, &t3, &t2)) != MP_OKAY) goto LBL_ERR; - - /* - Number of rounds is at most log_2(root). If it is more it - got stuck, so break out of the loop and do the rest manually. - */ - if (ilog2-- == 0) { - break; - } - } while (mp_cmp(&t1, &t2) != MP_EQ); - - /* result can be off by a few so check */ - /* Loop beneath can overshoot by one if found root is smaller than actual root */ - for (;;) { - if ((err = mp_expt_u32(&t1, b, &t2)) != MP_OKAY) goto LBL_ERR; - cmp = mp_cmp(&t2, &a_); - if (cmp == MP_EQ) { - err = MP_OKAY; - goto LBL_ERR; - } - if (cmp == MP_LT) { - if ((err = mp_add_d(&t1, 1uL, &t1)) != MP_OKAY) goto LBL_ERR; - } else { - break; - } - } - /* correct overshoot from above or from recurrence */ - for (;;) { - if ((err = mp_expt_u32(&t1, b, &t2)) != MP_OKAY) goto LBL_ERR; - if (mp_cmp(&t2, &a_) == MP_GT) { - if ((err = mp_sub_d(&t1, 1uL, &t1)) != MP_OKAY) goto LBL_ERR; - } else { - break; - } - } - - /* set the result */ - mp_exch(&t1, c); - - /* set the sign of the result */ - c->sign = a->sign; - - err = MP_OKAY; - -LBL_ERR: - mp_clear_multi(&t1, &t2, &t3, NULL); - return err; -} - -#endif -- cgit v0.12 From 6e8238944201c02321c9c5fc20a4d95c4f5383c8 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 3 Apr 2024 18:49:41 +0000 Subject: fixed [dc0770a2397ae0b1]: tests are timezone independent now --- tests/clock.test | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/clock.test b/tests/clock.test index b809ba1..b3510fa 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -37315,10 +37315,10 @@ test clock-46.29-1 {scan: validation rules: invalid day of year} \ } -result [lrepeat 20 1 {unable to convert input string: invalid day of year}] test clock-46.29-2 {scan: validation rules: valid day of leap/not leap year} \ -body { - list [clock format [clock scan "366-2016" -format "%j-%Y" -valid 1 -gmt 1] -format "%d-%m-%Y"] \ - [clock format [clock scan "365-2017" -format "%j-%Y" -valid 1 -gmt 1] -format "%d-%m-%Y"] \ - [clock format [clock scan "366-2016" -format "%j-%G" -valid 1 -gmt 1] -format "%d-%m-%Y"] \ - [clock format [clock scan "365-2017" -format "%j-%G" -valid 1 -gmt 1] -format "%d-%m-%Y"] + list [clock format [clock scan "366-2016" -format "%j-%Y" -valid 1 -gmt 1] -format "%d-%m-%Y" -gmt 1] \ + [clock format [clock scan "365-2017" -format "%j-%Y" -valid 1 -gmt 1] -format "%d-%m-%Y" -gmt 1] \ + [clock format [clock scan "366-2016" -format "%j-%G" -valid 1 -gmt 1] -format "%d-%m-%Y" -gmt 1] \ + [clock format [clock scan "365-2017" -format "%j-%G" -valid 1 -gmt 1] -format "%d-%m-%Y" -gmt 1] } -result {31-12-2016 31-12-2017 31-12-2016 31-12-2017} test clock-46.30 {scan: validation rules: invalid year} -setup { set orgcfg [list -min-year [::tcl::unsupported::clock::configure -min-year] -max-year [::tcl::unsupported::clock::configure -max-year] \ -- cgit v0.12 From 599a1dd2b77ed55cc53798a6ca94b659a9b9edac Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 3 Apr 2024 22:09:01 +0000 Subject: Proposed fix for [7cb7409e05]: Tcl_ParseArgsObjv bug with TCL_ARGV_GENFUNC --- doc/ParseArgs.3 | 10 +++++----- generic/tclIndexObj.c | 8 ++++++-- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/doc/ParseArgs.3 b/doc/ParseArgs.3 index f29f161..ecff658 100644 --- a/doc/ParseArgs.3 +++ b/doc/ParseArgs.3 @@ -156,11 +156,11 @@ typedef int (\fBTcl_ArgvGenFuncProc\fR)( void *\fIdstPtr\fR); .CE .PP -The \fIclientData\fR is the value from the table entry, the \fIinterp\fR is -where to store any error messages, the \fIkeyStr\fR is the name of the -argument, \fIobjc\fR and \fIobjv\fR describe an array of all the remaining -arguments, and \fIdstPtr\fR argument to the \fBTcl_ArgvGenFuncProc\fR is the -location to write the parsed value (or values) to. +The \fIclientData\fR is the value from the table entry, the \fIinterp\fR +is where to store any error messages, \fIobjc\fR and \fIobjv\fR describe +an array of all the remaining arguments, and \fIdstPtr\fR argument to the +\fBTcl_ArgvGenFuncProc\fR is the location to write the parsed value +(or values) to. .RE .TP \fBTCL_ARGV_HELP\fR diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index d999cc9..135fe4a 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -1113,6 +1113,7 @@ Tcl_ParseArgsObjv( * reporting. */ Tcl_Size objc; /* # arguments in objv still to process. */ Tcl_Size length; /* Number of characters in current argument */ + Tcl_Size gf_ret; /* Return value from Tcl_ArgvGenFuncProc*/ if (remObjv != NULL) { /* @@ -1268,10 +1269,13 @@ Tcl_ParseArgsObjv( Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *) infoPtr->srcPtr; - objc = handlerProc(infoPtr->clientData, interp, objc, + gf_ret = handlerProc(infoPtr->clientData, interp, objc, &objv[srcIndex], infoPtr->dstPtr); - if (objc < 0) { + if (gf_ret < 0) { goto error; + } else { + srcIndex += gf_ret; + objc -= gf_ret; } break; } -- cgit v0.12 From b3e3d35bef643c773ffdba698d0b74b4f2e74a0d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 3 Apr 2024 22:21:47 +0000 Subject: Add "testparseargsobj" command. Testcases to be added --- generic/tclTest.c | 79 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 79 insertions(+) diff --git a/generic/tclTest.c b/generic/tclTest.c index 007d51a..5491d80 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -246,6 +246,7 @@ static Tcl_ObjCmdProc TestbumpinterpepochObjCmd; static Tcl_ObjCmdProc TestbytestringObjCmd; static Tcl_ObjCmdProc TestsetbytearraylengthObjCmd; static Tcl_ObjCmdProc TestpurebytesobjObjCmd; +static Tcl_ObjCmdProc TestparseargsObjCmd; static Tcl_ObjCmdProc TeststringbytesObjCmd; static Tcl_ObjCmdProc Testutf16stringObjCmd; static Tcl_ObjCmdProc TestcmdinfoObjCmd; @@ -592,6 +593,7 @@ Tcltest_Init( Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testparseargsobj", TestparseargsObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL); @@ -5643,6 +5645,83 @@ TestpurebytesobjObjCmd( /* *---------------------------------------------------------------------- * + * TestparseargsObjCmd -- + * + * This object-based procedure tests the TCL_ARGV_GENFUNC functionality. + * + * Results: + * Returns the TCL_OK result code. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ParseMedia( + TCL_UNUSED(void *), + Tcl_Interp *interp, + TCL_UNUSED(int), + Tcl_Obj *const *objv, + void *dstPtr) +{ + static const char *const mediaOpts[] = {"A4", "Legal", "Letter", NULL}; + static const char *const ExtendedMediaOpts[] = { + "Paper size is ISO A4", "Paper size is US Legal", + "Paper size is US Letter", NULL}; + int index; + const char **media = (const char **) dstPtr; + + if (Tcl_GetIndexFromObjStruct(interp, objv[0], mediaOpts, + sizeof(char *), "media", 0, &index) != TCL_OK) { + return -1; + } + + *media = ExtendedMediaOpts[index]; + return 1; +} + +static int +TestparseargsObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tcl_Size count; + + const char *media = NULL, *color = NULL; + + const Tcl_ArgvInfo argTable[] = { + {TCL_ARGV_STRING, "-colormode" , NULL, &color, "color mode", NULL}, + {TCL_ARGV_GENFUNC, "-media", ParseMedia, &media, "media page size", NULL}, + TCL_ARGV_TABLE_END + }; + + if (objc%2 != 1) { + Tcl_WrongNumArgs(interp, 1, objv, "?-opt arg ...?"); + return TCL_ERROR; + } + + count = objc; + + if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, NULL)!=TCL_OK) { + return TCL_ERROR; + } + + /* show color and media parsed values */ + Tcl_SetObjResult(interp, Tcl_ObjPrintf("Color: |%d|%s|, Media: |%d|%s|", + color?1:0, color?color:"NO COLOR", + media?1:0, media?media:"NO MEDIA" + )); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestsetbytearraylengthObjCmd -- * * Testing command 'testsetbytearraylength` used to test the public -- cgit v0.12 From 4e1c4f560a7a0c6588845ca2b96e0a4f11392af8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 4 Apr 2024 20:01:44 +0000 Subject: Combine with "testparseargs" command. With testcases now --- generic/tclTest.c | 113 +++++++++++++++------------------------------------- tests/indexObj.test | 37 ++++++++++++----- 2 files changed, 59 insertions(+), 91 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 5491d80..cc193ef 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -246,7 +246,6 @@ static Tcl_ObjCmdProc TestbumpinterpepochObjCmd; static Tcl_ObjCmdProc TestbytestringObjCmd; static Tcl_ObjCmdProc TestsetbytearraylengthObjCmd; static Tcl_ObjCmdProc TestpurebytesobjObjCmd; -static Tcl_ObjCmdProc TestparseargsObjCmd; static Tcl_ObjCmdProc TeststringbytesObjCmd; static Tcl_ObjCmdProc Testutf16stringObjCmd; static Tcl_ObjCmdProc TestcmdinfoObjCmd; @@ -593,7 +592,6 @@ Tcltest_Init( Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testparseargsobj", TestparseargsObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL); @@ -5645,83 +5643,6 @@ TestpurebytesobjObjCmd( /* *---------------------------------------------------------------------- * - * TestparseargsObjCmd -- - * - * This object-based procedure tests the TCL_ARGV_GENFUNC functionality. - * - * Results: - * Returns the TCL_OK result code. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -ParseMedia( - TCL_UNUSED(void *), - Tcl_Interp *interp, - TCL_UNUSED(int), - Tcl_Obj *const *objv, - void *dstPtr) -{ - static const char *const mediaOpts[] = {"A4", "Legal", "Letter", NULL}; - static const char *const ExtendedMediaOpts[] = { - "Paper size is ISO A4", "Paper size is US Legal", - "Paper size is US Letter", NULL}; - int index; - const char **media = (const char **) dstPtr; - - if (Tcl_GetIndexFromObjStruct(interp, objv[0], mediaOpts, - sizeof(char *), "media", 0, &index) != TCL_OK) { - return -1; - } - - *media = ExtendedMediaOpts[index]; - return 1; -} - -static int -TestparseargsObjCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - Tcl_Size count; - - const char *media = NULL, *color = NULL; - - const Tcl_ArgvInfo argTable[] = { - {TCL_ARGV_STRING, "-colormode" , NULL, &color, "color mode", NULL}, - {TCL_ARGV_GENFUNC, "-media", ParseMedia, &media, "media page size", NULL}, - TCL_ARGV_TABLE_END - }; - - if (objc%2 != 1) { - Tcl_WrongNumArgs(interp, 1, objv, "?-opt arg ...?"); - return TCL_ERROR; - } - - count = objc; - - if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, NULL)!=TCL_OK) { - return TCL_ERROR; - } - - /* show color and media parsed values */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf("Color: |%d|%s|, Media: |%d|%s|", - color?1:0, color?color:"NO COLOR", - media?1:0, media?media:"NO MEDIA" - )); - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * TestsetbytearraylengthObjCmd -- * * Testing command 'testsetbytearraylength` used to test the public @@ -8483,6 +8404,7 @@ TestconcatobjCmd( * This procedure implements the "testparseargs" command. It is used to * test that Tcl_ParseArgsObjv does indeed return the right number of * arguments. In other words, that [Bug 3413857] was fixed properly. + * Also test for bug [7cb7409e05] * * Results: * A standard Tcl result. @@ -8494,6 +8416,30 @@ TestconcatobjCmd( */ static int +ParseMedia( + TCL_UNUSED(void *), + Tcl_Interp *interp, + TCL_UNUSED(int), + Tcl_Obj *const *objv, + void *dstPtr) +{ + static const char *const mediaOpts[] = {"A4", "Legal", "Letter", NULL}; + static const char *const ExtendedMediaOpts[] = { + "Paper size is ISO A4", "Paper size is US Legal", + "Paper size is US Letter", NULL}; + int index; + const char **media = (const char **) dstPtr; + + if (Tcl_GetIndexFromObjStruct(interp, objv[0], mediaOpts, + sizeof(char *), "media", 0, &index) != TCL_OK) { + return -1; + } + + *media = ExtendedMediaOpts[index]; + return 1; +} + +static int TestparseargsCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ @@ -8501,10 +8447,13 @@ TestparseargsCmd( Tcl_Obj *const objv[]) /* Arguments. */ { static int foo = 0; + const char *media = NULL, *color = NULL; Tcl_Size count = objc; - Tcl_Obj **remObjv, *result[3]; + Tcl_Obj **remObjv, *result[5]; const Tcl_ArgvInfo argTable[] = { {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL}, + {TCL_ARGV_STRING, "-colormode" , NULL, &color, "color mode", NULL}, + {TCL_ARGV_GENFUNC, "-media", ParseMedia, &media, "media page size", NULL}, TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END }; @@ -8515,7 +8464,9 @@ TestparseargsCmd( result[0] = Tcl_NewWideIntObj(foo); result[1] = Tcl_NewWideIntObj(count); result[2] = Tcl_NewListObj(count, remObjv); - Tcl_SetObjResult(interp, Tcl_NewListObj(3, result)); + result[3] = Tcl_NewStringObj(color ? color : "NULL", -1); + result[4] = Tcl_NewStringObj(media ? media : "NULL", -1); + Tcl_SetObjResult(interp, Tcl_NewListObj(5, result)); ckfree(remObjv); return TCL_OK; } diff --git a/tests/indexObj.test b/tests/indexObj.test index 1cf782a..eec5485 100644 --- a/tests/indexObj.test +++ b/tests/indexObj.test @@ -147,29 +147,46 @@ test indexObj-6.7 {Tcl_GetIndexFromObjStruct} testindexobj { test indexObj-7.1 {Tcl_ParseArgsObjv} testparseargs { testparseargs -} {0 1 testparseargs} +} {0 1 testparseargs NULL NULL} test indexObj-7.2 {Tcl_ParseArgsObjv} testparseargs { testparseargs -bool -} {1 1 testparseargs} +} {1 1 testparseargs NULL NULL} test indexObj-7.3 {Tcl_ParseArgsObjv} testparseargs { testparseargs -bool bar -} {1 2 {testparseargs bar}} +} {1 2 {testparseargs bar} NULL NULL} test indexObj-7.4 {Tcl_ParseArgsObjv} testparseargs { testparseargs bar -} {0 2 {testparseargs bar}} +} {0 2 {testparseargs bar} NULL NULL} test indexObj-7.5 {Tcl_ParseArgsObjv} -constraints testparseargs -body { testparseargs -help } -returnCodes error -result {Command-specific options: - -bool: booltest - --: Marks the end of the options - -help: Print summary of command-line options and abort} + -bool: booltest + -colormode: color mode + -media: media page size + --: Marks the end of the options + -help: Print summary of command-line options and abort} test indexObj-7.6 {Tcl_ParseArgsObjv} testparseargs { testparseargs -- -bool -help -} {0 3 {testparseargs -bool -help}} +} {0 3 {testparseargs -bool -help} NULL NULL} test indexObj-7.7 {Tcl_ParseArgsObjv memory management} testparseargs { testparseargs 1 2 3 4 5 6 7 8 9 0 -bool 1 2 3 4 5 6 7 8 9 0 -} {1 21 {testparseargs 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0}} - +} {1 21 {testparseargs 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0} NULL NULL} +test indexObj-7.8 {Tcl_ParseArgsObjv} testparseargs { + testparseargs -color Nothing +} {0 1 testparseargs Nothing NULL} +test indexObj-7.9 {Tcl_ParseArgsObjv} testparseargs { + testparseargs -media A4 +} {0 1 testparseargs NULL {Paper size is ISO A4}} +test indexObj-7.10 {Tcl_ParseArgsObjv} testparseargs { + testparseargs -media A4 -color Somecolor +} {0 1 testparseargs Somecolor {Paper size is ISO A4}} +test indexObj-7.11 {Tcl_ParseArgsObjv} testparseargs { + testparseargs -color othercolor -media Letter +} {0 1 testparseargs othercolor {Paper size is US Letter}} +test indexObj-7.12 {Tcl_ParseArgsObjv} -constraints testparseargs -body { + testparseargs -color othercolor -media Nosuchmedia +} -returnCodes error -result {bad media "Nosuchmedia": must be A4, Legal, or Letter} + test indexObj-8.1 {Tcl_GetIntForIndex integer} testgetintforindex { testgetintforindex 0 0 } 0 -- cgit v0.12 From 236e3e1beace12620e71c3bc5abb2616d69c1f07 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 4 Apr 2024 20:14:07 +0000 Subject: Tcl_ArgvGenFuncProc: int -> Tcl_Size (twice) --- generic/tcl.h | 4 ++-- generic/tclTest.c | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index da94b47..ca8901d 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2341,8 +2341,8 @@ typedef struct { typedef int (Tcl_ArgvFuncProc)(void *clientData, Tcl_Obj *objPtr, void *dstPtr); -typedef int (Tcl_ArgvGenFuncProc)(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv, void *dstPtr); +typedef Tcl_Size (Tcl_ArgvGenFuncProc)(void *clientData, Tcl_Interp *interp, + Tcl_Size objc, Tcl_Obj *const *objv, void *dstPtr); /* * Shorthand for commonly used argTable entries. diff --git a/generic/tclTest.c b/generic/tclTest.c index cc193ef..e2ffda9 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -8419,7 +8419,7 @@ static int ParseMedia( TCL_UNUSED(void *), Tcl_Interp *interp, - TCL_UNUSED(int), + TCL_UNUSED(Tcl_Size), Tcl_Obj *const *objv, void *dstPtr) { -- cgit v0.12