/Doc/install/

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 f3896e51875d3696de089804ab5e205403ee842a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 4 Nov 2022 11:11:18 +0000 Subject: New functions Tcl_NewWideUIntObj()/Tcl_SetWideUIntObj() (still experimental) --- doc/IntObj.3 | 29 +++++++++++++--------- generic/tcl.decls | 8 ++++++ generic/tclClock.c | 4 +-- generic/tclCmdMZ.c | 2 +- generic/tclDecls.h | 11 +++++++++ generic/tclLink.c | 4 +-- generic/tclObj.c | 68 +++++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclStubInit.c | 2 ++ generic/tclTest.c | 2 +- 9 files changed, 113 insertions(+), 17 deletions(-) diff --git a/doc/IntObj.3 b/doc/IntObj.3 index d640dbb..5577cc9 100644 --- a/doc/IntObj.3 +++ b/doc/IntObj.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers +Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_NewWideUIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers .SH SYNOPSIS .nf \fB#include \fR @@ -22,12 +22,17 @@ Tcl_Obj * Tcl_Obj * \fBTcl_NewWideIntObj\fR(\fIwideValue\fR) .sp +Tcl_Obj * +\fBTcl_NewWideUIntObj\fR(\fIuwideValue\fR) +.sp \fBTcl_SetIntObj\fR(\fIobjPtr, intValue\fR) .sp \fBTcl_SetLongObj\fR(\fIobjPtr, longValue\fR) .sp \fBTcl_SetWideIntObj\fR(\fIobjPtr, wideValue\fR) .sp +\fBTcl_SetWideUIntObj\fR(\fIobjPtr, uwideValue\fR) +.sp int \fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR) .sp @@ -66,6 +71,8 @@ Integer value used to initialize or set a Tcl value. Long integer value used to initialize or set a Tcl value. .AP Tcl_WideInt wideValue in Wide integer value used to initialize or set a Tcl value. +.AP Tcl_WideUInt uwideValue in +Unsigned wide integer value used to initialize or set a Tcl value. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, and \fBTcl_SetBignumObj\fR, this points to the value in which to store an @@ -107,18 +114,18 @@ The \fBmp_int\fR type is a multiple-precision integer type defined by the LibTomMath multiple-precision integer library. .PP The \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR, -and \fBTcl_NewBignumObj\fR routines each create and return a new -Tcl value initialized to the integral value of the argument. The -returned Tcl value is unshared. +\fBTcl_NewWideIntObj\fR, and \fBTcl_NewBignumObj\fR routines each create +and return a new Tcl value initialized to the integral value of the +argument. The returned Tcl value is unshared. .PP The \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, -and \fBTcl_SetBignumObj\fR routines each set the value of an existing -Tcl value pointed to by \fIobjPtr\fR to the integral value provided -by the other argument. The \fIobjPtr\fR argument must point to an -unshared Tcl value. Any attempt to set the value of a shared Tcl value -violates Tcl's copy-on-write policy. Any existing string representation -or internal representation in the unshared Tcl value will be freed -as a consequence of setting the new value. +\fBTcl_SetWideIntObj\fR, and \fBTcl_SetBignumObj\fR routines each set +the value of an existing Tcl value pointed to by \fIobjPtr\fR to the +integral value provided by the other argument. The \fIobjPtr\fR +argument must point to an unshared Tcl value. Any attempt to set the +value of a shared Tcl value violates Tcl's copy-on-write policy. Any +existing string representation or internal representation in the unshared +Tcl value will be freed as a consequence of setting the new value. .PP The \fBTcl_GetIntForIndex\fR routine attempts to retrieve an index value from the Tcl value \fIobjPtr\fR. If the attempt succeeds, diff --git a/generic/tcl.decls b/generic/tcl.decls index 994af13..f3d8924 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2552,6 +2552,14 @@ declare 683 { int Tcl_GetEncodingNulLength(Tcl_Encoding encoding) } +# TIP #648 +declare 684 { + Tcl_Obj *Tcl_NewWideUIntObj(Tcl_WideUInt wideValue) +} +declare 685 { + void Tcl_SetWideUIntObj(Tcl_Obj *objPtr, Tcl_WideUInt uwideValue) +} + # ----- BASELINE -- FOR -- 8.7.0 ----- # ############################################################################## diff --git a/generic/tclClock.c b/generic/tclClock.c index a9ba70c..72605ca 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -1810,7 +1810,7 @@ ClockMillisecondsObjCmd( return TCL_ERROR; } Tcl_GetTime(&now); - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) + Tcl_SetObjResult(interp, Tcl_NewWideUIntObj( now.sec * 1000 + now.usec / 1000)); return TCL_OK; } @@ -1998,7 +1998,7 @@ ClockSecondsObjCmd( return TCL_ERROR; } Tcl_GetTime(&now); - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec)); + Tcl_SetObjResult(interp, Tcl_NewWideUIntObj(now.sec)); return TCL_OK; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index b063689..3f42438 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -4099,7 +4099,7 @@ Tcl_TimeObjCmd( * Use int obj since we know time is not fractional. [Bug 1202178] */ - objs[0] = Tcl_NewWideIntObj((count <= 0) ? 0 : (Tcl_WideInt)totalMicroSec); + objs[0] = Tcl_NewWideUIntObj((count <= 0) ? 0 : (Tcl_WideUInt)totalMicroSec); } else { objs[0] = Tcl_NewDoubleObj(totalMicroSec/count); } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 8cb77b8..f7523fd 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -2038,6 +2038,11 @@ EXTERN int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 683 */ EXTERN int Tcl_GetEncodingNulLength(Tcl_Encoding encoding); +/* 684 */ +EXTERN Tcl_Obj * Tcl_NewWideUIntObj(Tcl_WideUInt wideValue); +/* 685 */ +EXTERN void Tcl_SetWideUIntObj(Tcl_Obj *objPtr, + Tcl_WideUInt uwideValue); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2757,6 +2762,8 @@ typedef struct TclStubs { int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, size_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */ int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */ int (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ + Tcl_Obj * (*tcl_NewWideUIntObj) (Tcl_WideUInt wideValue); /* 684 */ + void (*tcl_SetWideUIntObj) (Tcl_Obj *objPtr, Tcl_WideUInt uwideValue); /* 685 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -4155,6 +4162,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_RemoveChannelMode) /* 682 */ #define Tcl_GetEncodingNulLength \ (tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */ +#define Tcl_NewWideUIntObj \ + (tclStubsPtr->tcl_NewWideUIntObj) /* 684 */ +#define Tcl_SetWideUIntObj \ + (tclStubsPtr->tcl_SetWideUIntObj) /* 685 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclLink.c b/generic/tclLink.c index 0d57d44..7775cf8 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -1456,7 +1456,7 @@ ObjValue( memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *)); for (i=0; i < linkPtr->numElems; i++) { - TclNewIntObj(objv[i], (Tcl_WideInt) + objv[i] = Tcl_NewWideUIntObj( linkPtr->lastValue.uwPtr[i]); } resultObj = Tcl_NewListObj(linkPtr->numElems, objv); @@ -1464,7 +1464,7 @@ ObjValue( return resultObj; } linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt); - return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw); + return Tcl_NewWideUIntObj(linkPtr->lastValue.uw); case TCL_LINK_STRING: p = LinkedVar(char *); diff --git a/generic/tclObj.c b/generic/tclObj.c index ce8e610..806f910 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3219,6 +3219,34 @@ Tcl_NewWideIntObj( /* *---------------------------------------------------------------------- * + * Tcl_NewWideUIntObj -- + * + * Results: + * The newly created object is returned. This object will have an invalid + * string representation. The returned object has ref count 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +Tcl_NewWideUIntObj( + Tcl_WideUInt uwideValue) + /* Wide integer used to initialize the new + * object. */ +{ + Tcl_Obj *objPtr; + + TclNewObj(objPtr); + Tcl_SetWideUIntObj(objPtr, uwideValue); + return objPtr; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_DbNewWideIntObj -- * * If a client is compiled with TCL_MEM_DEBUG defined, calls to @@ -3312,6 +3340,46 @@ Tcl_SetWideIntObj( TclSetIntObj(objPtr, wideValue); } + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetWideUIntObj -- + * + * Modify an object to be a wide integer object or a bignum object + * and to have the specified unsigned wide integer value. + * + * Results: + * None. + * + * Side effects: + * The object's old string rep, if any, is freed. Also, any old internal + * rep is freed. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_SetWideUIntObj( + Tcl_Obj *objPtr, /* Object w. internal rep to init. */ + Tcl_WideUInt uwideValue) + /* Wide integer used to initialize the + * object's value. */ +{ + if (Tcl_IsShared(objPtr)) { + Tcl_Panic("%s called with shared object", "Tcl_SetWideUIntObj"); + } + + if (uwideValue > WIDE_MAX) { + mp_int bignumValue; + if (mp_init_i64(&bignumValue, uwideValue) != MP_OKAY) { + Tcl_Panic("%s called with shared object", "Tcl_SetWideUIntObj"); + } + TclSetBignumInternalRep(objPtr, &bignumValue); + } { + TclSetIntObj(objPtr, (Tcl_WideInt)uwideValue); + } +} /* *---------------------------------------------------------------------- diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 1ffe916..8c72144 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -2050,6 +2050,8 @@ const TclStubs tclStubs = { Tcl_GetNumber, /* 681 */ Tcl_RemoveChannelMode, /* 682 */ Tcl_GetEncodingNulLength, /* 683 */ + Tcl_NewWideUIntObj, /* 684 */ + Tcl_SetWideUIntObj, /* 685 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index c9bad56..878e51f 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -3119,7 +3119,7 @@ TestlinkCmd( Tcl_DecrRefCount(tmp); Tcl_PrintDouble(NULL, (double)floatVar, buffer); Tcl_AppendElement(interp, buffer); - tmp = Tcl_NewWideIntObj((Tcl_WideInt)uwideVar); + tmp = Tcl_NewWideUIntObj(uwideVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); } else if (strcmp(argv[1], "set") == 0) { -- cgit v0.12 From 3b7f710d06680e498bd8d451f6c47cb6c78918f7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 9 Nov 2022 22:18:01 +0000 Subject: New functions Tcl_NewSizeObj/Tcl_SetSizeObj --- generic/tclDecls.h | 8 ++++++++ generic/tclInt.decls | 2 +- generic/tclIntDecls.h | 6 +++--- generic/tclListObj.c | 8 +++----- 4 files changed, 15 insertions(+), 9 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 9344d68..d802789 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4431,6 +4431,14 @@ extern const TclStubs *tclStubsPtr; #undef Tcl_StringMatch #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) +#if TCL_MAJOR_VERSION > 8 +# define Tcl_NewSizeObj(value) (((value) == TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideUIntObj(value)) +# define Tcl_SetSizeObj(objPtr, value) (((value) == TCL_INDEX_NONE) ? Tcl_SetWideIntObj(objPtr, -1) : Tcl_SetWideUIntObj(objPtr, value)) +#else +# define Tcl_NewSizeObj Tcl_NewIntObj +# define Tcl_SetSizeObj Tcl_SetIntObj +#endif + #if TCL_UTF_MAX < 4 # undef Tcl_UniCharToUtfDString # define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString diff --git a/generic/tclInt.decls b/generic/tclInt.decls index c0e0e06..b3e352a 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -701,7 +701,7 @@ declare 258 { # TIP 625: for unit testing - create list objects with span declare 260 { - Tcl_Obj *TclListTestObj(int length, int leadingSpace, int endSpace) + Tcl_Obj *TclListTestObj(Tcl_Size length, Tcl_Size leadingSpace, Tcl_Size endSpace) } # TIP 625: for unit testing - check list invariants diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 3da8567..4c8d897 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -660,8 +660,8 @@ EXTERN Tcl_Obj * TclpCreateTemporaryDirectory(Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* Slot 259 is reserved */ /* 260 */ -EXTERN Tcl_Obj * TclListTestObj(int length, int leadingSpace, - int endSpace); +EXTERN Tcl_Obj * TclListTestObj(Tcl_Size length, + Tcl_Size leadingSpace, Tcl_Size endSpace); /* 261 */ EXTERN void TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj); @@ -930,7 +930,7 @@ typedef struct TclIntStubs { void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */ Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */ void (*reserved259)(void); - Tcl_Obj * (*tclListTestObj) (int length, int leadingSpace, int endSpace); /* 260 */ + Tcl_Obj * (*tclListTestObj) (Tcl_Size length, Tcl_Size leadingSpace, Tcl_Size endSpace); /* 260 */ void (*tclListObjValidate) (Tcl_Interp *interp, Tcl_Obj *listObj); /* 261 */ } TclIntStubs; diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 8ee0f48..6950d9d 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -3514,10 +3514,8 @@ UpdateStringOfList( *------------------------------------------------------------------------ */ Tcl_Obj * -TclListTestObj (int length, int leadingSpace, int endSpace) +TclListTestObj (Tcl_Size length, Tcl_Size leadingSpace, Tcl_Size endSpace) { - if (length < 0) - length = 0; if (leadingSpace < 0) leadingSpace = 0; if (endSpace < 0) @@ -3538,9 +3536,9 @@ TclListTestObj (int length, int leadingSpace, int endSpace) ListRepInit(capacity, NULL, 0, &listRep); ListStore *storePtr = listRep.storePtr; - int i; + Tcl_Size i; for (i = 0; i < length; ++i) { - storePtr->slots[i + leadingSpace] = Tcl_NewIntObj(i); + storePtr->slots[i + leadingSpace] = Tcl_NewSizeObj(i); Tcl_IncrRefCount(storePtr->slots[i + leadingSpace]); } storePtr->firstUsed = leadingSpace; -- cgit v0.12 From 9dd0e900483a5b0cca9e68966d34dffa814b43e2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 10 Nov 2022 15:21:13 +0000 Subject: If value is out-of-range (e.g. on 32-bit system >= 2^32-1), Tcl_NewSizeObj() will result in a '-1' object as well --- generic/tclDecls.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index d802789..b9d2347 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4432,8 +4432,8 @@ extern const TclStubs *tclStubsPtr; #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) #if TCL_MAJOR_VERSION > 8 -# define Tcl_NewSizeObj(value) (((value) == TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideUIntObj(value)) -# define Tcl_SetSizeObj(objPtr, value) (((value) == TCL_INDEX_NONE) ? Tcl_SetWideIntObj(objPtr, -1) : Tcl_SetWideUIntObj(objPtr, value)) +# define Tcl_NewSizeObj(value) (((value) >= TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideUIntObj(value)) +# define Tcl_SetSizeObj(objPtr, value) (((value) >= TCL_INDEX_NONE) ? Tcl_SetWideIntObj(objPtr, -1) : Tcl_SetWideUIntObj(objPtr, value)) #else # define Tcl_NewSizeObj Tcl_NewIntObj # define Tcl_SetSizeObj Tcl_SetIntObj -- cgit v0.12 From 29f4c762f29d31c1d2184e4bdb515038ec1d5d27 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 10 Nov 2022 17:28:15 +0000 Subject: Update doc --- doc/IntObj.3 | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/doc/IntObj.3 b/doc/IntObj.3 index 5577cc9..7ca7f75 100644 --- a/doc/IntObj.3 +++ b/doc/IntObj.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_NewWideUIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers +Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_NewWideUIntObj, Tcl_NewSizeObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_NewWideUIntObj, Tcl_NewSizeObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers .SH SYNOPSIS .nf \fB#include \fR @@ -25,6 +25,9 @@ Tcl_Obj * Tcl_Obj * \fBTcl_NewWideUIntObj\fR(\fIuwideValue\fR) .sp +Tcl_Obj * +\fBTcl_NewSizeObj\fR(\fIsizeValue\fR) +.sp \fBTcl_SetIntObj\fR(\fIobjPtr, intValue\fR) .sp \fBTcl_SetLongObj\fR(\fIobjPtr, longValue\fR) @@ -33,6 +36,8 @@ Tcl_Obj * .sp \fBTcl_SetWideUIntObj\fR(\fIobjPtr, uwideValue\fR) .sp +\fBTcl_SetSizeObj\fR(\fIobjPtr, sizeValue\fR) +.sp int \fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR) .sp @@ -73,8 +78,12 @@ Long integer value used to initialize or set a Tcl value. Wide integer value used to initialize or set a Tcl value. .AP Tcl_WideUInt uwideValue in Unsigned wide integer value used to initialize or set a Tcl value. +.AP Tcl_Size sizeValue in +\fTcl_Size\f integer value used to initialize or set a Tcl value. +In Tcl 8.x, \fTcl_Size\f is actually the same as int. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, +\fBTcl_SetWideUIntObj\fR, \fBTcl_SetSizeObj\fR, and \fBTcl_SetBignumObj\fR, this points to the value in which to store an integral value. For \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR, \fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and -- cgit v0.12 From ee898100a16badc57acbcc0bac4f211b9253d1e9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 10 Nov 2022 17:44:56 +0000 Subject: Tcl_NewSizeObj -> Tcl_NewIndexObj --- doc/IntObj.3 | 24 ++++++++++++------------ generic/tclDecls.h | 8 ++++---- generic/tclListObj.c | 7 +------ 3 files changed, 17 insertions(+), 22 deletions(-) diff --git a/doc/IntObj.3 b/doc/IntObj.3 index 7ca7f75..cfae9a0 100644 --- a/doc/IntObj.3 +++ b/doc/IntObj.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_NewWideUIntObj, Tcl_NewSizeObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_NewWideUIntObj, Tcl_NewSizeObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers +Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_NewWideUIntObj, Tcl_NewIndexObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_SetWideUIntObj, Tcl_SetIndexObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers .SH SYNOPSIS .nf \fB#include \fR @@ -26,7 +26,7 @@ Tcl_Obj * \fBTcl_NewWideUIntObj\fR(\fIuwideValue\fR) .sp Tcl_Obj * -\fBTcl_NewSizeObj\fR(\fIsizeValue\fR) +\fBTcl_NewIndexObj\fR(\fIindexValue\fR) .sp \fBTcl_SetIntObj\fR(\fIobjPtr, intValue\fR) .sp @@ -36,7 +36,7 @@ Tcl_Obj * .sp \fBTcl_SetWideUIntObj\fR(\fIobjPtr, uwideValue\fR) .sp -\fBTcl_SetSizeObj\fR(\fIobjPtr, sizeValue\fR) +\fBTcl_SetIndexObj\fR(\fIobjPtr, indexValue\fR) .sp int \fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR) @@ -78,12 +78,12 @@ Long integer value used to initialize or set a Tcl value. Wide integer value used to initialize or set a Tcl value. .AP Tcl_WideUInt uwideValue in Unsigned wide integer value used to initialize or set a Tcl value. -.AP Tcl_Size sizeValue in -\fTcl_Size\f integer value used to initialize or set a Tcl value. +.AP Tcl_Size indexValue in +\fTcl_Size\f value used to initialize or set a Tcl value. In Tcl 8.x, \fTcl_Size\f is actually the same as int. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, -\fBTcl_SetWideUIntObj\fR, \fBTcl_SetSizeObj\fR, +\fBTcl_SetWideUIntObj\fR, \fBTcl_SetIndexObj\fR, and \fBTcl_SetBignumObj\fR, this points to the value in which to store an integral value. For \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR, \fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and @@ -123,14 +123,14 @@ The \fBmp_int\fR type is a multiple-precision integer type defined by the LibTomMath multiple-precision integer library. .PP The \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR, -\fBTcl_NewWideIntObj\fR, and \fBTcl_NewBignumObj\fR routines each create -and return a new Tcl value initialized to the integral value of the -argument. The returned Tcl value is unshared. +\fBTcl_NewWideUIntObj\fR, \fBTcl_NewIndexObj\fR, and \fBTcl_NewBignumObj\fR +routines each create and return a new Tcl value initialized to the +integral value of the argument. The returned Tcl value is unshared. .PP The \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, -\fBTcl_SetWideIntObj\fR, and \fBTcl_SetBignumObj\fR routines each set -the value of an existing Tcl value pointed to by \fIobjPtr\fR to the -integral value provided by the other argument. The \fIobjPtr\fR +\fBTcl_SetWideUIntObj\fR, \fBTcl_SetIndexObj\fR, and \fBTcl_SetBignumObj\fR +routines each set the value of an existing Tcl value pointed to by \fIobjPtr\fR +to the integral value provided by the other argument. The \fIobjPtr\fR argument must point to an unshared Tcl value. Any attempt to set the value of a shared Tcl value violates Tcl's copy-on-write policy. Any existing string representation or internal representation in the unshared diff --git a/generic/tclDecls.h b/generic/tclDecls.h index b9d2347..6fcd08d 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4432,11 +4432,11 @@ extern const TclStubs *tclStubsPtr; #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0) #if TCL_MAJOR_VERSION > 8 -# define Tcl_NewSizeObj(value) (((value) >= TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideUIntObj(value)) -# define Tcl_SetSizeObj(objPtr, value) (((value) >= TCL_INDEX_NONE) ? Tcl_SetWideIntObj(objPtr, -1) : Tcl_SetWideUIntObj(objPtr, value)) +# define Tcl_NewIndexObj(value) (((value) >= TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideUIntObj(value)) +# define Tcl_SetIndexObj(objPtr, value) (((value) >= TCL_INDEX_NONE) ? Tcl_SetWideIntObj(objPtr, -1) : Tcl_SetWideUIntObj(objPtr, value)) #else -# define Tcl_NewSizeObj Tcl_NewIntObj -# define Tcl_SetSizeObj Tcl_SetIntObj +# define Tcl_NewIndexObj Tcl_NewIntObj +# define Tcl_SetIndexObj Tcl_SetIntObj #endif #if TCL_UTF_MAX < 4 diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 6950d9d..f016224 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -3516,11 +3516,6 @@ UpdateStringOfList( Tcl_Obj * TclListTestObj (Tcl_Size length, Tcl_Size leadingSpace, Tcl_Size endSpace) { - if (leadingSpace < 0) - leadingSpace = 0; - if (endSpace < 0) - endSpace = 0; - ListRep listRep; Tcl_Size capacity; Tcl_Obj *listObj; @@ -3538,7 +3533,7 @@ TclListTestObj (Tcl_Size length, Tcl_Size leadingSpace, Tcl_Size endSpace) ListStore *storePtr = listRep.storePtr; Tcl_Size i; for (i = 0; i < length; ++i) { - storePtr->slots[i + leadingSpace] = Tcl_NewSizeObj(i); + storePtr->slots[i + leadingSpace] = Tcl_NewIndexObj(i); Tcl_IncrRefCount(storePtr->slots[i + leadingSpace]); } storePtr->firstUsed = leadingSpace; -- cgit v0.12 From 0a5df8ec7faf67b198d81d81ff4efe575614db00 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 11 Nov 2022 22:26:03 +0000 Subject: Fix for Tcl_SetWideUIntObj --- generic/tclClock.c | 2 +- generic/tclCmdMZ.c | 2 +- generic/tclObj.c | 2 +- generic/tclScan.c | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 72605ca..d64348e 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -1810,7 +1810,7 @@ ClockMillisecondsObjCmd( return TCL_ERROR; } Tcl_GetTime(&now); - Tcl_SetObjResult(interp, Tcl_NewWideUIntObj( + Tcl_SetObjResult(interp, Tcl_NewWideUIntObj((Tcl_WideUInt) now.sec * 1000 + now.usec / 1000)); return TCL_OK; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 3f42438..ff466d9 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -3775,7 +3775,7 @@ TclNRSwitchObjCmd( TclNewIndexObj(rangeObjAry[0], info.matches[j].start); TclNewIndexObj(rangeObjAry[1], info.matches[j].end-1); } else { - TclNewIndexObj(rangeObjAry[1], TCL_INDEX_NONE); + TclNewIntObj(rangeObjAry[1], -1); rangeObjAry[0] = rangeObjAry[1]; } diff --git a/generic/tclObj.c b/generic/tclObj.c index 7871692..0d56eec 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3371,7 +3371,7 @@ Tcl_SetWideUIntObj( if (uwideValue > WIDE_MAX) { mp_int bignumValue; - if (mp_init_i64(&bignumValue, uwideValue) != MP_OKAY) { + if (mp_init_u64(&bignumValue, uwideValue) != MP_OKAY) { Tcl_Panic("%s called with shared object", "Tcl_SetWideUIntObj"); } TclSetBignumInternalRep(objPtr, &bignumValue); diff --git a/generic/tclScan.c b/generic/tclScan.c index 6bc914d..c0cf49f 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -1090,7 +1090,7 @@ Tcl_ScanObjCmd( if (code == TCL_OK) { if (underflow && (nconversions == 0)) { if (numVars) { - TclNewIndexObj(objPtr, TCL_INDEX_NONE); + TclNewIntObj(objPtr, -1); } else { if (objPtr) { Tcl_SetListObj(objPtr, 0, NULL); -- cgit v0.12 From 3c61afae6735dd0fd14a8ec428464827a8cc68cd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 11 Nov 2022 22:48:53 +0000 Subject: Fix panic message --- generic/tclObj.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclObj.c b/generic/tclObj.c index 0d56eec..4639731 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -3372,7 +3372,7 @@ Tcl_SetWideUIntObj( if (uwideValue > WIDE_MAX) { mp_int bignumValue; if (mp_init_u64(&bignumValue, uwideValue) != MP_OKAY) { - Tcl_Panic("%s called with shared object", "Tcl_SetWideUIntObj"); + Tcl_Panic("%s: memory overflow", "Tcl_SetWideUIntObj"); } TclSetBignumInternalRep(objPtr, &bignumValue); } { -- cgit v0.12 From 87f9abf5115a341e8bf09345b229a4334799d6fe Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 24 Jan 2023 18:06:02 +0000 Subject: Bump to 9.0b1 for release --- README.md | 2 +- generic/tcl.h | 8 ++++---- 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, 11 insertions(+), 11 deletions(-) diff --git a/README.md b/README.md index 1ec9c96..ba29fad 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # README: Tcl -This is the **Tcl 9.0a4** source distribution. +This is the **Tcl 9.0b1** 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 fa4da26..37f37e4 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -41,7 +41,7 @@ extern "C" { * unix/configure.ac (2 LOC Major, 2 LOC minor, 1 LOC patch) * win/configure.ac (as above) * win/tcl.m4 (not patchlevel) - * README (sections 0 and 2, with and without separator) + * README.md (sections 0 and 2, with and without separator) * macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC * win/README (not patchlevel) (sections 0 and 2) * unix/tcl.spec (1 LOC patch) @@ -52,11 +52,11 @@ extern "C" { #endif #if TCL_MAJOR_VERSION == 9 # define TCL_MINOR_VERSION 0 -# define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE -# define TCL_RELEASE_SERIAL 4 +# define TCL_RELEASE_LEVEL TCL_BETA_RELEASE +# define TCL_RELEASE_SERIAL 1 # define TCL_VERSION "9.0" -# define TCL_PATCH_LEVEL "9.0a4" +# define TCL_PATCH_LEVEL "9.0b1" #endif /* TCL_MAJOR_VERSION */ #if defined(RC_INVOKED) diff --git a/library/init.tcl b/library/init.tcl index 2646aa7..424ca3b 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -19,7 +19,7 @@ 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 9.0a4 +package require -exact tcl 9.0b1 # 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 4855fd3..747b81e 100755 --- a/unix/configure +++ b/unix/configure @@ -2684,7 +2684,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="a4" +TCL_PATCH_LEVEL="b1" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} diff --git a/unix/configure.ac b/unix/configure.ac index 109af38..b42e2a2 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="a4" +TCL_PATCH_LEVEL="b1" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} diff --git a/unix/tcl.spec b/unix/tcl.spec index f2d4bd5..d56cee3 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 9.0a4 +Version: 9.0b1 Release: 2 License: BSD Group: Development/Languages diff --git a/win/configure b/win/configure index d47fc6cb..b8b58a7 100755 --- a/win/configure +++ b/win/configure @@ -2402,7 +2402,7 @@ SHELL=/bin/sh TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="a4" +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 c6ff202..0974913 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="a4" +TCL_PATCH_LEVEL="b1" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 -- cgit v0.12 From f562be24c35d2baff59412a04ebc4df604709e5e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 7 Mar 2023 21:01:32 +0000 Subject: Start implementing TIP #657. WIP --- doc/Encoding.3 | 13 ++------- generic/tcl.h | 25 ++++++---------- generic/tclCmdAH.c | 2 +- generic/tclEncoding.c | 72 ++--------------------------------------------- generic/tclIO.c | 14 ++------- generic/tclIO.h | 2 -- generic/tclInt.h | 1 - tests/encoding.test | 32 ++++++++++----------- tests/encodingVectors.tcl | 2 +- 9 files changed, 35 insertions(+), 128 deletions(-) diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 7b5e9d4..93f389a 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -102,15 +102,8 @@ converted. \fBTCL_ENCODING_END\fR signifies that the source buffer is the last block in a (potentially multi-block) input stream, telling the conversion routine to perform any finalization that needs to occur after the last byte is converted and then to reset to an initial state. -\fBTCL_ENCODING_NOCOMPLAIN\fR signifies that the conversion routine should -not return immediately upon reading a source character that does not exist in -the target encoding, but it will substitute a default fallback character for -all of such characters. The flag \fBTCL_ENCODING_STOPONERROR\fR has no effect, -it only has meaning in Tcl 8.x. The flag \fBTCL_ENCODING_STRICT\fR makes the -encoder/decoder more strict in what it considers to be an invalid byte -sequence. The flag \fBTCL_ENCODING_MODIFIED\fR makes -\fBTcl_UtfToExternalDStringEx\fR and \fBTcl_UtfToExternal\fR produce the byte -sequence \exC0\ex80 in stead of \ex00, for the utf-8/cesu-8 encoders. +The flag \fBTCL_ENCODING_STOPONERROR\fR has no effect, +it only has meaning in Tcl 8.x. .AP Tcl_EncodingState *statePtr in/out Used when converting a (generally long or indefinite length) byte stream in a piece-by-piece fashion. The conversion routine stores its current @@ -241,7 +234,7 @@ if the input stream has been damaged or if the input encoding method was misidentified. .IP \fBTCL_CONVERT_UNKNOWN\fR 29 The source buffer contained a character that could not be represented in -the target encoding and \fBTCL_ENCODING_NOCOMPLAIN\fR was not specified. +the target encoding. .RE .LP \fBTcl_UtfToExternalDString\fR converts a source buffer \fIsrc\fR from UTF-8 diff --git a/generic/tcl.h b/generic/tcl.h index fd02ccc..2713966 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1927,8 +1927,6 @@ typedef struct Tcl_EncodingType { * reset to an initial state. If the source * buffer contains the entire input stream to be * converted, this flag should be set. - * TCL_ENCODING_STRICT - Be more strict in accepting what - * is considered a 'invalid byte sequence'. * TCL_ENCODING_STOPONERROR - Not used any more. * TCL_ENCODING_NO_TERMINATE - If set, Tcl_ExternalToUtf does not append a * terminating NUL byte. Since it does not need @@ -1955,10 +1953,8 @@ typedef struct Tcl_EncodingType { #define TCL_ENCODING_START 0x01 #define TCL_ENCODING_END 0x02 #if TCL_MAJOR_VERSION > 8 -# define TCL_ENCODING_STRICT 0x04 # define TCL_ENCODING_STOPONERROR 0x0 /* Not used any more */ #else -# define TCL_ENCODING_STRICT 0x44 # define TCL_ENCODING_STOPONERROR 0x04 #endif #define TCL_ENCODING_NO_TERMINATE 0x08 @@ -1967,8 +1963,12 @@ typedef struct Tcl_EncodingType { #define TCL_ENCODING_INTERNAL_USE_MASK 0xFF00 /* Reserve top byte for profile values (disjoint, not a mask) */ #define TCL_ENCODING_PROFILE_TCL8 0x01000000 -#define TCL_ENCODING_PROFILE_STRICT 0x02000000 -#define TCL_ENCODING_PROFILE_REPLACE 0x03000000 +#if TCL_MAJOR_VERSION > 8 +# define TCL_ENCODING_PROFILE_STRICT 0x00000000 +#else +# define TCL_ENCODING_PROFILE_STRICT 0x03000000 +#endif +#define TCL_ENCODING_PROFILE_REPLACE 0x02000000 #define TCL_ENCODING_PROFILE_MASK 0xFF000000 #define TCL_ENCODING_PROFILE_GET(flags_) ((flags_) & TCL_ENCODING_PROFILE_MASK) #define TCL_ENCODING_PROFILE_SET(flags_, profile_) \ @@ -1976,12 +1976,6 @@ typedef struct Tcl_EncodingType { (flags_) &= ~TCL_ENCODING_PROFILE_MASK; \ (flags_) |= profile_; \ } while (0) -/* Still being argued - For Tcl9, is the default strict? TODO */ -#if TCL_MAJOR_VERSION < 9 -#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_TCL8 -#else -#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_TCL8 /* STRICT? REPLACE? TODO */ -#endif /* * The following definitions are the error codes returned by the conversion @@ -2002,13 +1996,10 @@ typedef struct Tcl_EncodingType { * TCL_CONVERT_SYNTAX - The source stream contained an invalid * character sequence. This may occur if the * input stream has been damaged or if the input - * encoding method was misidentified. This error - * is reported unless if TCL_ENCODING_NOCOMPLAIN - * was specified. + * encoding method was misidentified. * TCL_CONVERT_UNKNOWN - The source string contained a character that * could not be represented in the target - * encoding. This error is reported unless if - * TCL_ENCODING_NOCOMPLAIN was specified. + * encoding. */ #define TCL_CONVERT_MULTIBYTE (-1) diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 7fab2f0..f90018e 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -435,7 +435,7 @@ EncodingConvertParseOptions ( Tcl_Obj *dataObj; Tcl_Obj *failVarObj; #if TCL_MAJOR_VERSION > 8 || defined(TCL_NO_DEPRECATED) - int profile = TCL_ENCODING_PROFILE_TCL8; /* TODO - default for Tcl9? */ + int profile = TCL_ENCODING_PROFILE_STRICT; #else int profile = TCL_ENCODING_PROFILE_TCL8; #endif diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 3842f2f..267a667 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -200,14 +200,10 @@ static struct TclEncodingProfiles { {"tcl8", TCL_ENCODING_PROFILE_TCL8}, }; #define PROFILE_STRICT(flags_) \ - ((TCL_ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_STRICT) \ - || (TCL_ENCODING_PROFILE_GET(flags_) == 0 \ - && TCL_ENCODING_PROFILE_DEFAULT == TCL_ENCODING_PROFILE_STRICT)) + (TCL_ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_STRICT) #define PROFILE_REPLACE(flags_) \ - ((TCL_ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) \ - || (TCL_ENCODING_PROFILE_GET(flags_) == 0 \ - && TCL_ENCODING_PROFILE_DEFAULT == TCL_ENCODING_PROFILE_REPLACE)) + (TCL_ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) #define UNICODE_REPLACE_CHAR ((Tcl_UniChar)0xFFFD) #define SURROGATE(c_) (((c_) & ~0x7FF) == 0xD800) @@ -1168,10 +1164,6 @@ Tcl_ExternalToUtfDString( * Possible flags values: * target encoding. It should be composed by OR-ing the following: * - *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT} - * - TCL_ENCODING_STOPONERROR: Backward compatibility. Sets the profile - * to TCL_ENCODING_PROFILE_STRICT overriding any specified profile flags - * Any other flag bits will cause an error to be returned (for future - * compatibility) * * Results: * The return value is one of @@ -1475,7 +1467,7 @@ Tcl_UtfToExternalDString( * converted string is stored. */ { Tcl_UtfToExternalDStringEx( - NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_DEFAULT, dstPtr, NULL); + NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL); return Tcl_DStringValue(dstPtr); } @@ -1490,8 +1482,6 @@ Tcl_UtfToExternalDString( * the source buffer are invalid or cannot be represented in the * target encoding. It should be composed by OR-ing the following: * - *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT} - * - TCL_ENCODING_STOPONERROR: Backward compatibility. Sets the profile - * to TCL_ENCODING_PROFILE_STRICT overriding any specified profile flags * * Results: * The return value is one of @@ -2432,7 +2422,6 @@ BinaryProc( if (dstLen < 0) { dstLen = 0; } - flags = TclEncodingSetProfileFlags(flags); if ((flags & TCL_ENCODING_CHAR_LIMIT) && srcLen > *dstCharsPtr) { srcLen = *dstCharsPtr; } @@ -2500,7 +2489,6 @@ UtfToUtfProc( srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; - flags = TclEncodingSetProfileFlags(flags); if ((flags & TCL_ENCODING_END) == 0) { srcClose -= 6; } @@ -2726,7 +2714,6 @@ Utf32ToUtfProc( int result, numChars, charLimit = INT_MAX; int ch, bytesLeft = srcLen % 4; - flags = TclEncodingSetProfileFlags(flags); flags |= PTR2INT(clientData); if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; @@ -2857,7 +2844,6 @@ UtfToUtf32Proc( srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; - flags = TclEncodingSetProfileFlags(flags); if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } @@ -2955,7 +2941,6 @@ Utf16ToUtfProc( int result, numChars, charLimit = INT_MAX; unsigned short ch = 0; - flags = TclEncodingSetProfileFlags(flags); flags |= PTR2INT(clientData); if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; @@ -3095,7 +3080,6 @@ UtfToUtf16Proc( srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; - flags = TclEncodingSetProfileFlags(flags); if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } @@ -3201,7 +3185,6 @@ UtfToUcs2Proc( int result, numChars, len; Tcl_UniChar ch = 0; - flags = TclEncodingSetProfileFlags(flags); flags |= PTR2INT(clientData); srcStart = src; srcEnd = src + srcLen; @@ -3324,7 +3307,6 @@ TableToUtfProc( const unsigned short *pageZero; TableEncodingData *dataPtr = (TableEncodingData *)clientData; - flags = TclEncodingSetProfileFlags(flags); if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } @@ -3453,7 +3435,6 @@ TableFromUtfProc( srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; - flags = TclEncodingSetProfileFlags(flags); if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } @@ -3560,7 +3541,6 @@ Iso88591ToUtfProc( const char *dstEnd, *dstStart; int result, numChars, charLimit = INT_MAX; - flags = TclEncodingSetProfileFlags(flags); if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } @@ -3645,7 +3625,6 @@ Iso88591FromUtfProc( srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; - flags = TclEncodingSetProfileFlags(flags); if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } @@ -3793,7 +3772,6 @@ EscapeToUtfProc( int state, result, numChars, charLimit = INT_MAX; const char *dstStart, *dstEnd; - flags = TclEncodingSetProfileFlags(flags); if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } @@ -4017,7 +3995,6 @@ EscapeFromUtfProc( srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; - flags = TclEncodingSetProfileFlags(flags); if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } @@ -4466,49 +4443,6 @@ TclEncodingProfileIdToName( /* *------------------------------------------------------------------------ * - * TclEncodingSetProfileFlags -- - * - * Maps the flags supported in the encoding C API's to internal flags. - * - * For backward compatibility reasons, TCL_ENCODING_STOPONERROR is - * is mapped to the TCL_ENCODING_PROFILE_STRICT overwriting any profile - * specified. - * - * If no profile or an invalid profile is specified, it is set to - * the default. - * - * Results: - * Internal encoding flag mask. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------ - */ -int TclEncodingSetProfileFlags(int flags) -{ - if (flags & TCL_ENCODING_STOPONERROR) { - TCL_ENCODING_PROFILE_SET(flags, TCL_ENCODING_PROFILE_STRICT); - } - else { - int profile = TCL_ENCODING_PROFILE_GET(flags); - switch (profile) { - case TCL_ENCODING_PROFILE_TCL8: - case TCL_ENCODING_PROFILE_STRICT: - case TCL_ENCODING_PROFILE_REPLACE: - break; - case 0: /* Unspecified by caller */ - default: - TCL_ENCODING_PROFILE_SET(flags, TCL_ENCODING_PROFILE_DEFAULT); - break; - } - } - return flags; -} - -/* - *------------------------------------------------------------------------ - * * TclGetEncodingProfiles -- * * Get the list of supported encoding profiles. diff --git a/generic/tclIO.c b/generic/tclIO.c index dd05ee3..3ee2dff 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -1675,12 +1675,10 @@ Tcl_CreateChannel( } statePtr->inputEncodingState = NULL; statePtr->inputEncodingFlags = TCL_ENCODING_START; - TCL_ENCODING_PROFILE_SET(statePtr->inputEncodingFlags, - TCL_ENCODING_PROFILE_DEFAULT); + TCL_ENCODING_PROFILE_SET(statePtr->inputEncodingFlags, 0); statePtr->outputEncodingState = NULL; statePtr->outputEncodingFlags = TCL_ENCODING_START; - TCL_ENCODING_PROFILE_SET(statePtr->outputEncodingFlags, - TCL_ENCODING_PROFILE_DEFAULT); + TCL_ENCODING_PROFILE_SET(statePtr->outputEncodingFlags, 0); /* * Set the channel up initially in AUTO input translation mode to accept @@ -7499,8 +7497,7 @@ Tcl_Eof( ChannelState *statePtr = ((Channel *) chan)->state; /* State of real channel structure. */ - if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_FCOPY) - && GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { + if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { return 0; } return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0; @@ -9631,7 +9628,6 @@ CopyData( * the bottom of the stack. */ - SetFlag(inStatePtr, CHANNEL_FCOPY); inBinary = (inStatePtr->encoding == NULL); outBinary = (outStatePtr->encoding == NULL); sameEncoding = inStatePtr->encoding == outStatePtr->encoding @@ -9747,7 +9743,6 @@ CopyData( TclDecrRefCount(bufObj); bufObj = NULL; } - ResetFlag(inStatePtr, CHANNEL_FCOPY); return TCL_OK; } } @@ -9839,7 +9834,6 @@ CopyData( TclDecrRefCount(bufObj); bufObj = NULL; } - ResetFlag(inStatePtr, CHANNEL_FCOPY); return TCL_OK; } @@ -9862,7 +9856,6 @@ CopyData( TclDecrRefCount(bufObj); bufObj = NULL; } - ResetFlag(inStatePtr, CHANNEL_FCOPY); return TCL_OK; } } /* while */ @@ -9915,7 +9908,6 @@ CopyData( } } } - ResetFlag(inStatePtr, CHANNEL_FCOPY); return result; } diff --git a/generic/tclIO.h b/generic/tclIO.h index 8f0ef8a..a050010 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -235,8 +235,6 @@ typedef struct ChannelState { * flushed after every newline. */ #define CHANNEL_UNBUFFERED (1<<5) /* Output to the channel must always * be flushed immediately. */ -#define CHANNEL_FCOPY (1<<6) /* Channel is currently doing an fcopy - * mode. */ #define BG_FLUSH_SCHEDULED (1<<7) /* A background flush of the queued * output buffers has been * scheduled. */ diff --git a/generic/tclInt.h b/generic/tclInt.h index a90ac79..289c902 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2886,7 +2886,6 @@ TclEncodingProfileNameToId(Tcl_Interp *interp, int *profilePtr); MODULE_SCOPE const char *TclEncodingProfileIdToName(Tcl_Interp *interp, int profileId); -MODULE_SCOPE int TclEncodingSetProfileFlags(int flags); MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp); /* diff --git a/tests/encoding.test b/tests/encoding.test index 8044c8c..bc330ae 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -465,7 +465,7 @@ test encoding-15.25 {UtfToUtfProc CESU-8} { encoding convertfrom cesu-8 \x00 } \x00 test encoding-15.26 {UtfToUtfProc CESU-8} { - encoding convertfrom cesu-8 \xC0\x80 + encoding convertfrom -profile tcl8 cesu-8 \xC0\x80 } \x00 test encoding-15.27 {UtfToUtfProc -profile strict CESU-8} { encoding convertfrom -profile strict cesu-8 \x00 @@ -511,21 +511,21 @@ test encoding-16.7 {Utf32ToUtfProc} -body { set val [encoding convertfrom utf-32be \0\0NN] list $val [format %x [scan $val %c]] } -result "乎 4e4e" -test encoding-16.8 {Utf32ToUtfProc} -body { +test encoding-16.8 {Utf32ToUtfProc} -constraints knownBug -body { set val [encoding convertfrom -profile tcl8 utf-32 \x41\x00\x00\x41] list $val [format %x [scan $val %c]] } -result "\uFFFD fffd" test encoding-16.9 {Utf32ToUtfProc} -constraints utf32 -body { - encoding convertfrom utf-32le \x00\xD8\x00\x00 + encoding convertfrom -profile tcl8 utf-32le \x00\xD8\x00\x00 } -result \uD800 test encoding-16.10 {Utf32ToUtfProc} -body { - encoding convertfrom utf-32le \x00\xDC\x00\x00 + encoding convertfrom -profile tcl8 utf-32le \x00\xDC\x00\x00 } -result \uDC00 test encoding-16.11 {Utf32ToUtfProc} -body { - encoding convertfrom utf-32le \x00\xD8\x00\x00\x00\xDC\x00\x00 + encoding convertfrom -profile tcl8 utf-32le \x00\xD8\x00\x00\x00\xDC\x00\x00 } -result \uD800\uDC00 test encoding-16.12 {Utf32ToUtfProc} -constraints utf32 -body { - encoding convertfrom utf-32le \x00\xDC\x00\x00\x00\xD8\x00\x00 + encoding convertfrom -profile tcl8 utf-32le \x00\xDC\x00\x00\x00\xD8\x00\x00 } -result \uDC00\uD800 test encoding-16.13 {Utf16ToUtfProc} -body { encoding convertfrom utf-16le \x00\xD8 @@ -563,13 +563,13 @@ test encoding-16.18 { } [namespace current]] } -result done test encoding-16.19 {UnicodeToUtfProc, bug [d19fe0a5b]} -body { - encoding convertfrom utf-16 "\x41\x41\x41" + encoding convertfrom -profile tcl8 utf-16 "\x41\x41\x41" } -result \u4141\uFFFD -test encoding-16.20 {UnicodeToUtfProc, bug [d19fe0a5b]} -constraints deprecated -body { - encoding convertfrom utf-16 "\xD8\xD8" +test encoding-16.20 {UnicodeToUtfProc, bug [d19fe0a5b]} -body { + encoding convertfrom -profile tcl8 utf-16 "\xD8\xD8" } -result \uD8D8 test encoding-16.21 {UnicodeToUtfProc, bug [d19fe0a5b]} -body { - encoding convertfrom utf-32 "\x00\x00\x00\x00\x41\x41" + encoding convertfrom -profile tcl8 utf-32 "\x00\x00\x00\x00\x41\x41" } -result \x00\uFFFD test encoding-17.1 {UtfToUtf16Proc} -body { @@ -616,14 +616,14 @@ test encoding-18.4 {TableToUtfProc on invalid input with -failindex -profile str list [catch {encoding convertto -failindex pos -profile strict jis0208 \\} res] $res $pos } -result {0 {} 0} test encoding-18.5 {TableToUtfProc on invalid input with -failindex} -body { - list [catch {encoding convertto -failindex pos jis0208 \\} res] $res $pos + list [catch {encoding convertto -profile tcl8 -failindex pos jis0208 \\} res] $res $pos } -result {0 !) -1} test encoding-18.6 {TableToUtfProc on invalid input with -profile tcl8} -body { list [catch {encoding convertto -profile tcl8 jis0208 \\} res] $res } -result {0 !)} test encoding-19.1 {TableFromUtfProc} -body { - encoding convertfrom ascii AÁ + encoding convertfrom -profile tcl8 ascii AÁ } -result AÁ test encoding-19.2 {TableFromUtfProc} -body { encoding convertfrom -profile tcl8 ascii AÁ @@ -632,7 +632,7 @@ test encoding-19.3 {TableFromUtfProc} -body { encoding convertfrom -profile strict ascii AÁ } -returnCodes 1 -result {unexpected byte sequence starting at index 1: '\xC1'} test encoding-19.4 {TableFromUtfProc} -body { - list [encoding convertfrom -failindex idx ascii AÁ] [set idx] + list [encoding convertfrom -profile tcl8 -failindex idx ascii AÁ] [set idx] } -result [list A\xC1 -1] test encoding-19.5 {TableFromUtfProc} -body { list [encoding convertfrom -failindex idx -profile strict ascii A\xC1] [set idx] @@ -748,7 +748,7 @@ test encoding-24.3 {EscapeFreeProc on open channels} {stdio} { } [list 3 "乎乞也 (\\u4E4E\\u4E5E\\u4E5F)"] test encoding-24.4 {Parse valid or invalid utf-8} { - string length [encoding convertfrom utf-8 "\xC0\x80"] + string length [encoding convertfrom -profile tcl8 utf-8 "\xC0\x80"] } 1 test encoding-24.5 {Parse valid or invalid utf-8} { string length [encoding convertfrom -profile tcl8 utf-8 "\xC0\x81"] @@ -781,7 +781,7 @@ test encoding-24.14 {Parse valid or invalid utf-8} { string length [encoding convertfrom utf-8 "\xC2\x80"] } 1 test encoding-24.15 {Parse valid or invalid utf-8} -body { - encoding convertfrom utf-8 "Z\xE0\x80" + encoding convertfrom -profile tcl8 utf-8 "Z\xE0\x80" } -result Z\xE0\u20AC test encoding-24.16 {Parse valid or invalid utf-8} -constraints testbytestring -body { encoding convertto utf-8 [testbytestring "Z\u4343\x80"] @@ -841,7 +841,7 @@ test encoding-24.34 {Try to generate invalid utf-8 with -profile tcl8} -body { encoding convertto -profile tcl8 utf-8 \uFFFF } -result \xEF\xBF\xBF test encoding-24.35 {Parse invalid utf-8} -constraints utf32 -body { - encoding convertfrom utf-8 \xED\xA0\x80 + encoding convertfrom -profile tcl8 utf-8 \xED\xA0\x80 } -result \uD800 test encoding-24.36 {Parse invalid utf-8 with -profile strict} -body { encoding convertfrom -profile strict utf-8 \xED\xA0\x80 diff --git a/tests/encodingVectors.tcl b/tests/encodingVectors.tcl index b3f3efa..725f4ae 100644 --- a/tests/encodingVectors.tcl +++ b/tests/encodingVectors.tcl @@ -10,7 +10,7 @@ # List of defined encoding profiles set encProfiles {tcl8 strict replace} -set encDefaultProfile tcl8; # Should reflect the default from implementation +set encDefaultProfile strict; # Should reflect the default from implementation # encValidStrings - Table of valid strings. # -- cgit v0.12 From 0eaea8713d066effbb0b2a5062db37be59b615af Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 7 Mar 2023 23:11:17 +0000 Subject: encodingprofile -> profile, and fix more testcases --- generic/tclIO.c | 8 ++++---- tests/chanio.test | 6 +++--- tests/encoding.test | 10 +++++----- tests/io.test | 52 +++++++++++++++++++++++++-------------------------- tests/ioCmd.test | 20 ++++++++++---------- tests/winConsole.test | 14 +++++++------- tests/zlib.test | 4 ++-- 7 files changed, 57 insertions(+), 57 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 3ee2dff..9528896 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -7774,7 +7774,7 @@ Tcl_BadChannelOption( { if (interp != NULL) { const char *genericopt = - "blocking buffering buffersize encoding encodingprofile eofchar translation"; + "blocking buffering buffersize encoding eofchar profile translation"; const char **argv; Tcl_Size argc, i; Tcl_DString ds; @@ -7929,11 +7929,11 @@ Tcl_GetChannelOption( return TCL_OK; } } - if (len == 0 || HaveOpt(9, "-encodingprofile")) { + if (len == 0 || HaveOpt(1, "-profile")) { int profile; const char *profileName; if (len == 0) { - Tcl_DStringAppendElement(dsPtr, "-encodingprofile"); + Tcl_DStringAppendElement(dsPtr, "-profile"); } /* Note currently input and output profiles are same */ profile = TCL_ENCODING_PROFILE_GET(statePtr->inputEncodingFlags); @@ -8209,7 +8209,7 @@ Tcl_SetChannelOption( ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; return TCL_OK; - } else if (HaveOpt(1, "-encodingprofile")) { + } else if (HaveOpt(1, "-profile")) { int profile; if (TclEncodingProfileNameToId(interp, newValue, &profile) != TCL_OK) { return TCL_ERROR; diff --git a/tests/chanio.test b/tests/chanio.test index dadb997..95cde7f 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -254,7 +254,7 @@ test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} -bod test chan-io-3.4 {WriteChars: loop over stage buffer} -body { # stage buffer maps to more than can be queued at once. set f [open $path(test1) w] - chan configure $f -encoding jis0208 -buffersize 16 -encodingprofile tcl8 + chan configure $f -encoding jis0208 -buffersize 16 -profile tcl8 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] chan close $f @@ -267,7 +267,7 @@ test chan-io-3.5 {WriteChars: saved != 0} -body { # be moved to beginning of next channel buffer to preserve requested # buffersize. set f [open $path(test1) w] - chan configure $f -encoding jis0208 -buffersize 17 -encodingprofile tcl8 + chan configure $f -encoding jis0208 -buffersize 17 -profile tcl8 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] chan close $f @@ -300,7 +300,7 @@ test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body { # on flush. The truncated bytes are moved to the beginning of the next # channel buffer. set f [open $path(test1) w] - chan configure $f -encoding jis0208 -buffersize 17 -encodingprofile tcl8 + chan configure $f -encoding jis0208 -buffersize 17 -profile tcl8 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] chan close $f diff --git a/tests/encoding.test b/tests/encoding.test index bc330ae..0497846 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -106,13 +106,13 @@ test encoding-3.2 {Tcl_GetEncodingName, non-null} -setup { } -cleanup { fconfigure stdout -encoding $old } -result {jis0208} -test encoding-3.3 {fconfigure -encodingprofile} -setup { - set old [fconfigure stdout -encodingprofile] +test encoding-3.3 {fconfigure -profile} -setup { + set old [fconfigure stdout -profile] } -body { - fconfigure stdout -encodingprofile replace - fconfigure stdout -encodingprofile + fconfigure stdout -profile replace + fconfigure stdout -profile } -cleanup { - fconfigure stdout -encodingprofile $old + fconfigure stdout -profile $old } -result replace test encoding-4.1 {Tcl_GetEncodingNames} -constraints {testencoding} -setup { diff --git a/tests/io.test b/tests/io.test index 6251a4c..2a18482 100644 --- a/tests/io.test +++ b/tests/io.test @@ -339,7 +339,7 @@ test io-3.4 {WriteChars: loop over stage buffer} -body { # stage buffer maps to more than can be queued at once. set f [open $path(test1) w] - fconfigure $f -encoding jis0208 -buffersize 16 -encodingprofile tcl8 + fconfigure $f -encoding jis0208 -buffersize 16 -profile tcl8 puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] close $f @@ -353,7 +353,7 @@ test io-3.5 {WriteChars: saved != 0} -body { # requested buffersize. set f [open $path(test1) w] - fconfigure $f -encoding jis0208 -buffersize 17 -encodingprofile tcl8 + fconfigure $f -encoding jis0208 -buffersize 17 -profile tcl8 puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] close $f @@ -386,7 +386,7 @@ test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body { # of the next channel buffer. set f [open $path(test1) w] - fconfigure $f -encoding jis0208 -buffersize 17 -encodingprofile tcl8 + fconfigure $f -encoding jis0208 -buffersize 17 -profile tcl8 puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] close $f @@ -1620,7 +1620,7 @@ test io-12.9 {ReadChars: multibyte chars split} -body { puts -nonewline $f [string repeat a 9]\xC2 close $f set f [open $path(test1)] - fconfigure $f -encoding utf-8 -buffersize 10 + fconfigure $f -encoding utf-8 -profile tcl8 -buffersize 10 set in [read $f] close $f scan [string index $in end] %c @@ -1633,7 +1633,7 @@ test io-12.10 {ReadChars: multibyte chars split} -body { puts -nonewline $f [string repeat a 9]\xC2 close $f set f [open $path(test1)] - fconfigure $f -encoding utf-8 -buffersize 11 + fconfigure $f -encoding utf-8 -profile tcl8 -buffersize 11 set in [read $f] close $f scan [string index $in end] %c @@ -7689,7 +7689,7 @@ test io-52.20 {TclCopyChannel & encodings} -setup { set out [open $path(kyrillic.txt) w] # Using "-encoding ascii" means reading the "Á" gives an error - fconfigure $in -encoding ascii -encodingprofile strict + fconfigure $in -encoding ascii -profile strict fconfigure $out -encoding koi8-r -translation lf fcopy $in $out @@ -7711,7 +7711,7 @@ test io-52.21 {TclCopyChannel & encodings} -setup { # Using "-encoding ascii" means writing the "Á" gives an error fconfigure $in -encoding utf-8 - fconfigure $out -encoding ascii -translation lf -encodingprofile strict + fconfigure $out -encoding ascii -translation lf -profile strict fcopy $in $out } -cleanup { @@ -7731,7 +7731,7 @@ test io-52.22 {TclCopyChannel & encodings} -setup { set out [open $path(kyrillic.txt) w] # Using "-encoding ascii" means reading the "Á" gives an error - fconfigure $in -encoding ascii -encodingprofile strict + fconfigure $in -encoding ascii -profile strict fconfigure $out -encoding koi8-r -translation lf proc ::xxx args { set ::s0 $args @@ -7759,7 +7759,7 @@ test io-52.23 {TclCopyChannel & encodings} -setup { # Using "-encoding ascii" means writing the "Á" gives an error fconfigure $in -encoding utf-8 - fconfigure $out -encoding ascii -translation lf -encodingprofile strict + fconfigure $out -encoding ascii -translation lf -profile strict proc ::xxx args { set ::s0 $args } @@ -9125,7 +9125,7 @@ test io-75.1 {multibyte encoding error read results in raw bytes (-nocomplainenc puts -nonewline $f A\xC0\x40 flush $f seek $f 0 - fconfigure $f -encoding utf-8 -encodingprofile tcl8 -buffering none + fconfigure $f -encoding utf-8 -profile tcl8 -buffering none } -body { set d [read $f] binary scan $d H* hd @@ -9135,10 +9135,10 @@ test io-75.1 {multibyte encoding error read results in raw bytes (-nocomplainenc removeFile io-75.1 } -result 41c040 -test io-75.2 {unrepresentable character write passes and is replaced by ? (-encodingprofile tcl8)} -setup { +test io-75.2 {unrepresentable character write passes and is replaced by ? (-profile tcl8)} -setup { set fn [makeFile {} io-75.2] set f [open $fn w+] - fconfigure $f -encoding iso8859-1 -encodingprofile tcl8 + fconfigure $f -encoding iso8859-1 -profile tcl8 } -body { puts -nonewline $f A\u2022 flush $f @@ -9152,14 +9152,14 @@ test io-75.2 {unrepresentable character write passes and is replaced by ? (-enco # Incomplete sequence test. # This error may IMHO only be detected with the close. # But the read already returns the incomplete sequence. -test io-75.3 {incomplete multibyte encoding read is ignored (-encodingprofile tcl8)} -setup { +test io-75.3 {incomplete multibyte encoding read is ignored (-profile tcl8)} -setup { set fn [makeFile {} io-75.3] set f [open $fn w+] fconfigure $f -encoding binary puts -nonewline $f "A\xC0" flush $f seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -encodingprofile tcl8 + fconfigure $f -encoding utf-8 -buffering none -profile tcl8 } -body { set d [read $f] close $f @@ -9171,7 +9171,7 @@ test io-75.3 {incomplete multibyte encoding read is ignored (-encodingprofile tc # As utf-8 has a special treatment in multi-byte decoding, also test another # one. -test io-75.4 {shiftjis encoding error read results in raw bytes (-encodingprofile tcl8)} -setup { +test io-75.4 {shiftjis encoding error read results in raw bytes (-profile tcl8)} -setup { set fn [makeFile {} io-75.4] set f [open $fn w+] fconfigure $f -encoding binary @@ -9180,7 +9180,7 @@ test io-75.4 {shiftjis encoding error read results in raw bytes (-encodingprofil puts -nonewline $f A\x81\xFFA flush $f seek $f 0 - fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf -encodingprofile tcl8 + fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf -profile tcl8 } -body { set d [read $f] binary scan $d H* hd @@ -9190,14 +9190,14 @@ test io-75.4 {shiftjis encoding error read results in raw bytes (-encodingprofil removeFile io-75.4 } -result 4181ff41 -test io-75.5 {invalid utf-8 encoding read is ignored (-encodingprofile tcl8)} -setup { +test io-75.5 {invalid utf-8 encoding read is ignored (-profile tcl8)} -setup { set fn [makeFile {} io-75.5] set f [open $fn w+] fconfigure $f -encoding binary puts -nonewline $f A\x81 flush $f seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -encodingprofile tcl8 + fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -profile tcl8 } -body { set d [read $f] close $f @@ -9207,7 +9207,7 @@ test io-75.5 {invalid utf-8 encoding read is ignored (-encodingprofile tcl8)} -s removeFile io-75.5 } -result 4181 -test io-75.8 {invalid utf-8 encoding eof handling (-encodingprofile strict)} -setup { +test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup { set fn [makeFile {} io-75.8] set f [open $fn w+] fconfigure $f -encoding binary @@ -9215,7 +9215,7 @@ test io-75.8 {invalid utf-8 encoding eof handling (-encodingprofile strict)} -se puts -nonewline $f A\x1A\x81 flush $f seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A -translation lf -encodingprofile strict + fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A -translation lf -profile strict } -body { set d [read $f] binary scan $d H* hd @@ -9230,7 +9230,7 @@ test io-75.8 {invalid utf-8 encoding eof handling (-encodingprofile strict)} -se test io-75.9 {unrepresentable character write passes and is replaced by ?} -setup { set fn [makeFile {} io-75.9] set f [open $fn w+] - fconfigure $f -encoding iso8859-1 -encodingprofile strict + fconfigure $f -encoding iso8859-1 -profile strict } -body { catch {puts -nonewline $f "A\u2022"} msg flush $f @@ -9251,7 +9251,7 @@ test io-75.10 {incomplete multibyte encoding read is ignored} -setup { puts -nonewline $f A\xC0 flush $f seek $f 0 - fconfigure $f -encoding utf-8 -buffering none + fconfigure $f -encoding utf-8 -profile tcl8 -buffering none } -body { set d [read $f] close $f @@ -9274,7 +9274,7 @@ test io-75.11 {shiftjis encoding error read results in raw bytes} -setup { puts -nonewline $f A\x81\xFFA flush $f seek $f 0 - fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf -encodingprofile strict + fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf -profile strict } -body { set d [read $f] binary scan $d H* hd @@ -9292,7 +9292,7 @@ test io-75.12 {invalid utf-8 encoding read is ignored} -setup { puts -nonewline $f A\x81 flush $f seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf + fconfigure $f -encoding utf-8 -profile tcl8 -buffering none -eofchar "" -translation lf } -body { set d [read $f] close $f @@ -9301,7 +9301,7 @@ test io-75.12 {invalid utf-8 encoding read is ignored} -setup { } -cleanup { removeFile io-75.12 } -result 4181 -test io-75.13 {invalid utf-8 encoding read is not ignored (-encodingprofile strict)} -setup { +test io-75.13 {invalid utf-8 encoding read is not ignored (-profile strict)} -setup { set fn [makeFile {} io-75.13] set f [open $fn w+] fconfigure $f -encoding binary @@ -9309,7 +9309,7 @@ test io-75.13 {invalid utf-8 encoding read is not ignored (-encodingprofile stri puts -nonewline $f "A\x81" flush $f seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -encodingprofile strict + fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -profile strict } -body { set d [read $f] binary scan $d H* hd diff --git a/tests/ioCmd.test b/tests/ioCmd.test index a1ec571..8a68559 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -207,7 +207,7 @@ test iocmd-7.5 {close command} -setup { proc expectedOpts {got extra} { set basicOpts { - -blocking -buffering -buffersize -encoding -encodingprofile -eofchar -translation + -blocking -buffering -buffersize -encoding -eofchar -profile -translation } set opts [list {*}$basicOpts {*}$extra] lset opts end [string cat "or " [lindex $opts end]] @@ -244,19 +244,19 @@ test iocmd-8.7 {fconfigure command} -setup { fconfigure $f1 } -cleanup { catch {close $f1} -} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -encodingprofile tcl8 -eofchar {} -translation lf} +} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -profile strict -eofchar {} -translation lf} test iocmd-8.8 {fconfigure command} -setup { file delete $path(test1) set x {} } -body { set f1 [open $path(test1) w] fconfigure $f1 -translation lf -buffering line -buffersize 3030 \ - -eofchar {} -encoding utf-16 -encodingprofile tcl8 + -eofchar {} -encoding utf-16 -profile tcl8 lappend x [fconfigure $f1 -buffering] lappend x [fconfigure $f1] } -cleanup { catch {close $f1} -} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -encodingprofile tcl8 -eofchar {} -translation lf}} +} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -profile tcl8 -eofchar {} -translation lf}} test iocmd-8.9 {fconfigure command} -setup { file delete $path(test1) } -body { @@ -266,7 +266,7 @@ test iocmd-8.9 {fconfigure command} -setup { fconfigure $f1 } -cleanup { catch {close $f1} -} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -encodingprofile tcl8 -eofchar {} -translation lf} +} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -profile strict -eofchar {} -translation lf} test iocmd-8.10 {fconfigure command} -returnCodes error -body { fconfigure a b } -result {can not find channel named "a"} @@ -369,8 +369,8 @@ test iocmd-8.20 {fconfigure command / win console channel} -constraints {nonPort # TODO: Test parsing of serial channel options (nonPortable, since requires an # open channel to work with). -test iocmd-8.21 {fconfigure -encodingprofile badprofile} -body { - fconfigure stdin -encodingprofile froboz +test iocmd-8.21 {fconfigure -profile badprofile} -body { + fconfigure stdin -profile froboz } -returnCodes error -result {bad profile name "froboz": must be replace, strict, or tcl8} test iocmd-9.1 {eof command} { @@ -1372,7 +1372,7 @@ test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body { close $c rename foo {} set res -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -encodingprofile * -eofchar {} -translation {auto *}}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -profile * -eofchar {} -translation {auto *}}} test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} proc foo {args} {oninit cget cgetall; onfinal; track; return ""} @@ -1381,7 +1381,7 @@ test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body { close $c rename foo {} set res -} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -encodingprofile * -eofchar {} -translation {auto *}}} +} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -profile * -eofchar {} -translation {auto *}}} test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} proc foo {args} { @@ -1393,7 +1393,7 @@ test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body { close $c rename foo {} set res -} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -encodingprofile * -eofchar {} -translation {auto *} -bar foo -snarf x}} +} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -profile * -eofchar {} -translation {auto *} -bar foo -snarf x}} test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body { set res {} proc foo {args} { diff --git a/tests/winConsole.test b/tests/winConsole.test index 62dfbf3..ede6e92 100644 --- a/tests/winConsole.test +++ b/tests/winConsole.test @@ -198,7 +198,7 @@ test console-fconfigure-get-1.0 { Console get stdin configuration } -constraints {win interactive} -body { lsort [dict keys [fconfigure stdin]] -} -result {-blocking -buffering -buffersize -encoding -encodingprofile -eofchar -inputmode -translation} +} -result {-blocking -buffering -buffersize -encoding -profile -eofchar -inputmode -translation} set testnum 0 foreach {opt result} { @@ -224,7 +224,7 @@ test console-fconfigure-get-1.[incr testnum] { fconfigure -winsize } -constraints {win interactive} -body { fconfigure stdin -winsize -} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -encodingprofile, -eofchar, -translation, or -inputmode} -returnCodes error +} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, -translation, or -inputmode} -returnCodes error ## fconfigure get stdout/stderr foreach chan {stdout stderr} major {2 3} { @@ -232,7 +232,7 @@ foreach chan {stdout stderr} major {2 3} { win interactive } -body { lsort [dict keys [fconfigure $chan]] - } -result {-blocking -buffering -buffersize -encoding -encodingprofile -eofchar -translation -winsize} + } -result {-blocking -buffering -buffersize -encoding -profile -eofchar -translation -winsize} set testnum 0 foreach {opt result} { -blocking 1 @@ -260,7 +260,7 @@ foreach chan {stdout stderr} major {2 3} { fconfigure -inputmode } -constraints {win interactive} -body { fconfigure $chan -inputmode - } -result {bad option "-inputmode": should be one of -blocking, -buffering, -buffersize, -encoding, -encodingprofile, -eofchar, -translation, or -winsize} -returnCodes error + } -result {bad option "-inputmode": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, -translation, or -winsize} -returnCodes error } @@ -330,7 +330,7 @@ test console-fconfigure-set-1.3 { fconfigure stdin -winsize } -constraints {win interactive} -body { fconfigure stdin -winsize {10 30} -} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -encodingprofile, -eofchar, -translation, or -inputmode} -returnCodes error +} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, -translation, or -inputmode} -returnCodes error ## fconfigure set stdout,stderr @@ -338,13 +338,13 @@ test console-fconfigure-set-2.0 { fconfigure stdout -winsize } -constraints {win interactive} -body { fconfigure stdout -winsize {10 30} -} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -encodingprofile, -eofchar, or -translation} -returnCodes error +} -result {bad option "-winsize": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -profile, or -translation} -returnCodes error 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, -encodingprofile, -eofchar, or -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/tests/zlib.test b/tests/zlib.test index ae7dd6d..b343c06 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -292,7 +292,7 @@ test zlib-8.6 {transformation and fconfigure} -setup { } -cleanup { catch {close $fd} removeFile $file -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -encodingprofile tcl8 -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -encodingprofile tcl8 -eofchar {} -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -encodingprofile tcl8 -eofchar {} -translation lf}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -profile strict -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -profile strict -eofchar {} -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -profile strict -eofchar {} -translation lf}} test zlib-8.7 {transformation and fconfigure} -setup { set file [makeFile {} test.gz] set fd [open $file wb] @@ -302,7 +302,7 @@ test zlib-8.7 {transformation and fconfigure} -setup { } -cleanup { catch {close $fd} removeFile $file -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -encodingprofile tcl8 -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -encodingprofile tcl8 -eofchar {} -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -encodingprofile tcl8 -eofchar {} -translation lf}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -profile strict -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -profile strict -eofchar {} -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -profile strict -eofchar {} -translation lf}} # Input is headers from fetching SPDY draft # Dictionary is that which is proposed _in_ SPDY draft set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n" -- cgit v0.12 From 5669c89824bbcb01904dc6fde19a8e5713abd4a6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 8 Mar 2023 22:04:09 +0000 Subject: Oops --- generic/tclIO.c | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index f3c8480..53213b8 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4608,7 +4608,6 @@ Tcl_GetsObj( /* State info for channel */ ChannelBuffer *bufPtr; int inEofChar, skip, copiedTotal, oldFlags, oldRemoved; - int reportError = 0; Tcl_Size oldLength; Tcl_Encoding encoding; char *dst, *dstEnd, *eol, *eof; @@ -4890,7 +4889,6 @@ Tcl_GetsObj( * point, if desired. */ eol = dstEnd; - reportError = 1; goto gotEOL; } dst = dstEnd; @@ -10206,7 +10204,7 @@ DoRead( if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) && ((p == dst) || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) { Tcl_SetErrno(EILSEQ); - if (!copied) { + if (p == dst) { p = dst - 1; } } -- cgit v0.12 From 2ff0d1c5c1dfa32d96b3d627878eedb04c72b18f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 9 Mar 2023 16:20:30 +0000 Subject: Bug-fix for Utf32ToUtfProc, in case TCL_UTF_MAX=3 --- generic/tclEncoding.c | 55 ++++++++++++++++++++++++++++++++++++--------- library/tcltest/tcltest.tcl | 16 ++++++------- tests/io.test | 3 ++- 3 files changed, 54 insertions(+), 20 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 267a667..dacc263 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2712,7 +2712,7 @@ Utf32ToUtfProc( const char *srcStart, *srcEnd; const char *dstEnd, *dstStart; int result, numChars, charLimit = INT_MAX; - int ch, bytesLeft = srcLen % 4; + int ch = 0, bytesLeft = srcLen % 4; flags |= PTR2INT(clientData); if (flags & TCL_ENCODING_CHAR_LIMIT) { @@ -2729,6 +2729,21 @@ Utf32ToUtfProc( srcLen -= bytesLeft; } +#if TCL_UTF_MAX < 4 + /* + * If last code point is a high surrogate, we cannot handle that yet, + * unless we are at the end. + */ + + if (!(flags & TCL_ENCODING_END) && (srcLen >= 4) && + ((src[srcLen - ((flags & TCL_ENCODING_LE)?3:2)] & 0xFC) == 0xD8) && + ((src[srcLen - ((flags & TCL_ENCODING_LE)?2:3)]) == 0) && + ((src[srcLen - ((flags & TCL_ENCODING_LE)?1:4)]) == 0)) { + result = TCL_CONVERT_MULTIBYTE; + srcLen-= 4; + } +#endif + srcStart = src; srcEnd = src + srcLen; @@ -2741,15 +2756,27 @@ Utf32ToUtfProc( break; } +#if TCL_UTF_MAX < 4 + int prev = ch; +#endif if (flags & TCL_ENCODING_LE) { ch = (src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF); } else { ch = (src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF); } +#if TCL_UTF_MAX < 4 + if (((prev & ~0x3FF) == 0xD800) && ((ch & ~0x3FF) != 0xDC00)) { + /* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */ + dst += Tcl_UniCharToUtf(-1, dst); + } +#endif if ((unsigned)ch > 0x10FFFF || SURROGATE(ch)) { if (PROFILE_STRICT(flags)) { result = TCL_CONVERT_SYNTAX; +#if TCL_UTF_MAX < 4 + ch = 0; +#endif break; } if (PROFILE_REPLACE(flags)) { @@ -2770,6 +2797,12 @@ Utf32ToUtfProc( src += 4; } +#if TCL_UTF_MAX < 4 + if ((ch & ~0x3FF) == 0xD800) { + /* Bug [10c2c17c32]. If Hi surrogate, finish 3-byte UTF-8 */ + dst += Tcl_UniCharToUtf(-1, dst); + } +#endif /* @@ -2780,16 +2813,16 @@ Utf32ToUtfProc( if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; } else { - if (PROFILE_STRICT(flags)) { - result = TCL_CONVERT_SYNTAX; - } else { - /* PROFILE_REPLACE or PROFILE_TCL8 */ - result = TCL_OK; - dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst); - numChars++; - src += bytesLeft; /* Go past truncated code unit */ - } - } + if (PROFILE_STRICT(flags)) { + result = TCL_CONVERT_SYNTAX; + } else { + /* PROFILE_REPLACE or PROFILE_TCL8 */ + result = TCL_OK; + dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst); + numChars++; + src += bytesLeft; /* Go past truncated code unit */ + } + } } *srcReadPtr = src - srcStart; diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 7344f9f..1ba5d9f 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -400,7 +400,7 @@ namespace eval tcltest { default { set outputChannel [open $filename a] if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $outputChannel -encoding utf-8 + fconfigure $outputChannel -profile tcl8 -encoding utf-8 } set ChannelsWeOpened($outputChannel) 1 @@ -447,7 +447,7 @@ namespace eval tcltest { default { set errorChannel [open $filename a] if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $errorChannel -encoding utf-8 + fconfigure $errorChannel -profile tcl8 -encoding utf-8 } set ChannelsWeOpened($errorChannel) 1 @@ -792,7 +792,7 @@ namespace eval tcltest { if {$Option(-loadfile) eq {}} {return} set tmp [open $Option(-loadfile) r] if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $tmp -encoding utf-8 + fconfigure $tmp -profile tcl8 -encoding utf-8 } loadScript [read $tmp] close $tmp @@ -1340,7 +1340,7 @@ proc tcltest::DefineConstraintInitializers {} { set code 0 if {![catch {set f [open "|[list [interpreter]]" w]}]} { if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $f -encoding utf-8 + fconfigure $f -profile tcl8 -encoding utf-8 } if {![catch {puts $f exit}]} { if {![catch {close $f}]} { @@ -2190,7 +2190,7 @@ proc tcltest::test {name description args} { if {[file readable $testFile]} { set testFd [open $testFile r] if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $testFd -encoding utf-8 + fconfigure $testFd -profile tcl8 -encoding utf-8 } set testLine [expr {[lsearch -regexp \ [split [read $testFd] "\n"] \ @@ -2901,7 +2901,7 @@ proc tcltest::runAllTests { {shell ""} } { incr numTestFiles set pipeFd [open $cmd "r"] if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $pipeFd -encoding utf-8 + fconfigure $pipeFd -profile tcl8 -encoding utf-8 } while {[gets $pipeFd line] >= 0} { if {[regexp [join { @@ -3101,7 +3101,7 @@ proc tcltest::makeFile {contents name {directory ""}} { set fd [open $fullName w] fconfigure $fd -translation lf if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $fd -encoding utf-8 + fconfigure $fd -profile tcl8 -encoding utf-8 } if {[string index $contents end] eq "\n"} { puts -nonewline $fd $contents @@ -3252,7 +3252,7 @@ proc tcltest::viewFile {name {directory ""}} { set fullName [file join $directory $name] set f [open $fullName] if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $f -encoding utf-8 + fconfigure $f -profile tcl8 -encoding utf-8 } set data [read -nonewline $f] close $f diff --git a/tests/io.test b/tests/io.test index 8dde2b2..a8ec7e5 100644 --- a/tests/io.test +++ b/tests/io.test @@ -9292,10 +9292,10 @@ test io-75.12 {invalid utf-8 encoding read is ignored} -setup { fconfigure $f -encoding utf-8 -profile tcl8 -buffering none -eofchar "" -translation lf } -body { set d [read $f] - close $f binary scan $d H* hd set hd } -cleanup { + close $f removeFile io-75.12 } -result 4181 test io-75.13 {invalid utf-8 encoding read is not ignored (-profile strict)} -setup { @@ -9310,6 +9310,7 @@ test io-75.13 {invalid utf-8 encoding read is not ignored (-profile strict)} -se } -body { read $f } -cleanup { + close $f removeFile io-75.13 } -match glob -returnCodes 1 -result {error reading "*": illegal byte sequence} -- cgit v0.12 From 6e644e2a603401e7062f75c483325edf779f497a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 10 Mar 2023 15:55:51 +0000 Subject: Implement new function Tcl_InputEncodingError() --- doc/OpenFileChnl.3 | 15 +++++++++++++-- generic/tcl.decls | 5 +++++ generic/tclDecls.h | 8 +++++--- generic/tclIO.c | 26 ++++++++++++++++++++++++++ generic/tclStubInit.c | 2 +- library/http/http.tcl | 27 ++++++++++++++++++++++++--- library/tcltest/tcltest.tcl | 41 +++++++++++++++++++++++++++++++++++++++-- 7 files changed, 113 insertions(+), 11 deletions(-) diff --git a/doc/OpenFileChnl.3 b/doc/OpenFileChnl.3 index 1b9d5d3..cac1723 100644 --- a/doc/OpenFileChnl.3 +++ b/doc/OpenFileChnl.3 @@ -9,7 +9,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -Tcl_OpenFileChannel, Tcl_OpenCommandChannel, Tcl_MakeFileChannel, Tcl_GetChannel, Tcl_GetChannelNames, Tcl_GetChannelNamesEx, Tcl_RegisterChannel, Tcl_UnregisterChannel, Tcl_DetachChannel, Tcl_IsStandardChannel, Tcl_Close, Tcl_ReadChars, Tcl_Read, Tcl_GetsObj, Tcl_Gets, Tcl_WriteObj, Tcl_WriteChars, Tcl_Write, Tcl_Flush, Tcl_Seek, Tcl_Tell, Tcl_TruncateChannel, Tcl_GetChannelOption, Tcl_SetChannelOption, Tcl_Eof, Tcl_InputBlocked, Tcl_InputBuffered, Tcl_OutputBuffered, Tcl_Ungets, Tcl_ReadRaw, Tcl_WriteRaw \- buffered I/O facilities using channels +Tcl_OpenFileChannel, Tcl_OpenCommandChannel, Tcl_MakeFileChannel, Tcl_GetChannel, Tcl_GetChannelNames, Tcl_GetChannelNamesEx, Tcl_RegisterChannel, Tcl_UnregisterChannel, Tcl_DetachChannel, Tcl_IsStandardChannel, Tcl_Close, Tcl_ReadChars, Tcl_Read, Tcl_GetsObj, Tcl_Gets, Tcl_WriteObj, Tcl_WriteChars, Tcl_Write, Tcl_Flush, Tcl_Seek, Tcl_Tell, Tcl_TruncateChannel, Tcl_GetChannelOption, Tcl_SetChannelOption, Tcl_Eof, Tcl_InputBlocked, Tcl_InputBuffered, Tcl_InputEncodingError, Tcl_OutputBuffered, Tcl_Ungets, Tcl_ReadRaw, Tcl_WriteRaw \- buffered I/O facilities using channels .SH SYNOPSIS .nf \fB#include \fR @@ -90,6 +90,9 @@ int \fBTcl_InputBuffered\fR(\fIchannel\fR) .sp int +\fBTcl_InputEncodingError\fR(\fIchannel\fR) +.sp +int \fBTcl_OutputBuffered\fR(\fIchannel\fR) .sp long long @@ -476,12 +479,20 @@ that can be retrieved with \fBTcl_GetErrno\fR. \fBTcl_GetsObj\fR also returns TCL_INDEX_NONE if the end of the file is reached; the \fBTcl_Eof\fR procedure can be used to distinguish an error from an end-of-file condition. .PP -If the channel is in nonblocking mode, the return value can also be TCL_INDEX_NONE +If the channel is in blocking mode, the return value can also be TCL_INDEX_NONE if no data was available or the data that was available did not contain an end-of-line character. When TCL_INDEX_NONE is returned, the \fBTcl_InputBlocked\fR procedure may be invoked to determine if the channel is blocked because of input unavailability. .PP +If the channel is in blocking mode, it might be that there is data available +but - at the same time - an encoding error occurred. In that case, the +POSIX error EILSEQ will be recorded, but - since \fBTcl_Gets\fR/\fBTcl_Read\fR +didn't return TCL_INDEX_NONE we cannot be sure if the POSIX error +maybe was a left-over from an earlier error. The only way to be sure +is calling the \fBTcl_InputEncodingError\fR procedure, it will +return 1 if the channel is at an encoding error position. +.PP \fBTcl_Gets\fR is the same as \fBTcl_GetsObj\fR except the resulting characters are appended to the dynamic string given by \fIlineRead\fR rather than a Tcl value. diff --git a/generic/tcl.decls b/generic/tcl.decls index 1608a88..403dc38 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2626,6 +2626,11 @@ declare 685 { Tcl_Obj *Tcl_DStringToObj(Tcl_DString *dsPtr) } +# TIP 657 +declare 686 { + int Tcl_InputEncodingError(Tcl_Channel chan) +} + # ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- # declare 687 { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index ec9a49a..99661f4 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1861,7 +1861,8 @@ EXTERN int Tcl_GetWideUIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 685 */ EXTERN Tcl_Obj * Tcl_DStringToObj(Tcl_DString *dsPtr); -/* Slot 686 is reserved */ +/* 686 */ +EXTERN int Tcl_InputEncodingError(Tcl_Channel chan); /* 687 */ EXTERN void TclUnusedStubEntry(void); @@ -2561,7 +2562,7 @@ typedef struct TclStubs { Tcl_Size (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */ Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */ - void (*reserved686)(void); + int (*tcl_InputEncodingError) (Tcl_Channel chan); /* 686 */ void (*tclUnusedStubEntry) (void); /* 687 */ } TclStubs; @@ -3887,7 +3888,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetWideUIntFromObj) /* 684 */ #define Tcl_DStringToObj \ (tclStubsPtr->tcl_DStringToObj) /* 685 */ -/* Slot 686 is reserved */ +#define Tcl_InputEncodingError \ + (tclStubsPtr->tcl_InputEncodingError) /* 686 */ #define TclUnusedStubEntry \ (tclStubsPtr->tclUnusedStubEntry) /* 687 */ diff --git a/generic/tclIO.c b/generic/tclIO.c index 53213b8..0d6c108 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -7615,6 +7615,32 @@ Tcl_InputBuffered( return bytesBuffered; } + +/* + *---------------------------------------------------------------------- + * + * Tcl_InputEncodingError -- + * + * Returns 1 if input is in an encoding error position, 0 otherwise. + * + * Results: + * 0 or 1, always. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_InputEncodingError( + Tcl_Channel chan) /* Is this channel blocked? */ +{ + ChannelState *statePtr = ((Channel *) chan)->state; + /* State of real channel structure. */ + + return GotFlag(statePtr, CHANNEL_ENCODING_ERROR) ? 1 : 0; +} /* *---------------------------------------------------------------------- diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index dbd8b52..05f0ac7 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1492,7 +1492,7 @@ const TclStubs tclStubs = { Tcl_GetEncodingNulLength, /* 683 */ Tcl_GetWideUIntFromObj, /* 684 */ Tcl_DStringToObj, /* 685 */ - 0, /* 686 */ + Tcl_InputEncodingError, /* 686 */ TclUnusedStubEntry, /* 687 */ }; diff --git a/library/http/http.tcl b/library/http/http.tcl index 88f66eb..fb49954 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -1746,6 +1746,9 @@ proc http::OpenSocket {token DoLater} { } fconfigure $sock -translation {auto crlf} \ -buffersize $state(-blocksize) + if {[package vsatisfies [package provide Tcl] 9.0-]} { + fconfigure $sock -profile replace \ + } ##Log socket opened, DONE fconfigure - token $token } @@ -2164,6 +2167,9 @@ proc http::Connected {token proto phost srvurl} { lassign [fconfigure $sock -translation] trRead trWrite fconfigure $sock -translation [list $trRead crlf] \ -buffersize $state(-blocksize) + if {[package vsatisfies [package provide Tcl] 9.0-]} { + fconfigure $sock -profile replace \ + } # The following is disallowed in safe interpreters, but the socket is # already in non-blocking mode in that case. @@ -2554,6 +2560,9 @@ proc http::ReceiveResponse {token} { lassign [fconfigure $sock -translation] trRead trWrite fconfigure $sock -translation [list auto $trWrite] \ -buffersize $state(-blocksize) + if {[package vsatisfies [package provide Tcl] 9.0-]} { + fconfigure $sock -profile replace \ + } Log ^D$tk begin receiving response - token $token coroutine ${token}--EventCoroutine http::Event $sock $token @@ -4545,7 +4554,11 @@ proc http::Eot {token {reason {}}} { set enc [CharsetToEncoding $state(charset)] if {$enc ne "binary"} { - set state(body) [encoding convertfrom -profile tcl8 $enc $state(body)] + if {[package vsatisfies [package provide Tcl] 9.0-]} { + set state(body) [encoding convertfrom -profile replace $enc $state(body)] + } else { + set state(body) [encoding convertfrom $enc $state(body)] + } } # Translate text line endings. @@ -4628,7 +4641,11 @@ proc http::GuessType {token} { if {$enc eq "binary"} { return 0 } - set state(body) [encoding convertfrom -profile tcl8 $enc $state(body)] + if {[package vsatisfies [package provide Tcl] 9.0-]} { + set state(body) [encoding convertfrom -profile replace $enc $state(body)] + } else { + set state(body) [encoding convertfrom -profile replace $enc $state(body)] + } set state(body) [string map {\r\n \n \r \n} $state(body)] set state(type) application/xml set state(binary) 0 @@ -4709,7 +4726,11 @@ proc http::quoteString {string} { # a pre-computed map and [string map] to do the conversion (much faster # than [regsub]/[subst]). [Bug 1020491] - set string [encoding convertto -profile tcl8 $http(-urlencoding) $string] + if {[package vsatisfies [package provide Tcl] 9.0-]} { + set string [encoding convertto -profile replace $http(-urlencoding) $string] + } else { + set string [encoding convertto $http(-urlencoding) $string] + } return [string map $formMap $string] } diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 1ba5d9f..12791da 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -1134,6 +1134,39 @@ proc tcltest::SafeFetch {n1 n2 op} { } } + +# tcltest::Asciify -- +# +# Transforms the passed string to contain only printable ascii characters. +# Useful for printing to terminals. Non-printables are mapped to +# \x, \u or \U sequences. +# +# Arguments: +# s - string to transform +# +# Results: +# The transformed strings +# +# Side effects: +# None. + +proc tcltest::Asciify {s} { + set print "" + foreach c [split $s ""] { + set i [scan $c %c] + if {[string is print $c] && ($i <= 127)} { + append print $c + } elseif {$i <= 0xff} { + append print \\x[format %02X $i] + } elseif {$i <= 0xffff} { + append print \\u[format %04X $i] + } else { + append print \\U[format %08X $i] + } + } + return $print +} + # tcltest::ConstraintInitializer -- # # Get or set a script that when evaluated in the tcltest namespace @@ -2221,9 +2254,13 @@ proc tcltest::test {name description args} { if {$scriptCompare} { puts [outputChannel] "---- Error testing result: $scriptMatch" } else { - puts [outputChannel] "---- Result was:\n$actualAnswer" + if {[catch { + puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]" + } errMsg]} { + puts [outputChannel] "\n---- Result was:\n" + } puts [outputChannel] "---- Result should have been\ - ($match matching):\n$result" + ($match matching):\n[Asciify $result]" } } if {$errorCodeFailure} { -- cgit v0.12 From 9e4ce6c3b9c56c4d2bd3e8268208716eeeeaf764 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 11 Mar 2023 21:19:46 +0000 Subject: Fix last (hopefully) bugs in utf-16/utf-32 encoders --- generic/tclEncoding.c | 64 +++++++++++++++++++++++++++------------------------ tests/chanio.test | 2 +- tests/encoding.test | 10 +------- tests/io.test | 2 +- 4 files changed, 37 insertions(+), 41 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index ac65f49..609ddad 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2723,8 +2723,8 @@ Utf32ToUtfProc( /* * Check alignment with utf-32 (4 == sizeof(UTF-32)) */ + if (bytesLeft != 0) { - /* We have a truncated code unit */ result = TCL_CONVERT_MULTIBYTE; srcLen -= bytesLeft; } @@ -2771,7 +2771,13 @@ Utf32ToUtfProc( } #endif - if ((unsigned)ch > 0x10FFFF || SURROGATE(ch)) { + if ((unsigned)ch > 0x10FFFF) { + ch = 0xFFFD; + if (PROFILE_STRICT(flags)) { + result = TCL_CONVERT_SYNTAX; + break; + } + } else if (SURROGATE(ch)) { if (PROFILE_STRICT(flags)) { result = TCL_CONVERT_SYNTAX; #if TCL_UTF_MAX < 4 @@ -2794,7 +2800,7 @@ Utf32ToUtfProc( } else { dst += Tcl_UniCharToUtf(ch, dst); } - src += 4; + src += sizeof(unsigned int); } #if TCL_UTF_MAX < 4 @@ -2804,27 +2810,22 @@ Utf32ToUtfProc( } #endif - - /* - * If we had a truncated code unit at the end AND this is the last - * fragment AND profile is not "strict", stick FFFD in its place. - */ if ((flags & TCL_ENCODING_END) && (result == TCL_CONVERT_MULTIBYTE)) { + /* We have a single byte left-over at the end */ if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; } else { + /* destination is not full, so we really are at the end now */ if (PROFILE_STRICT(flags)) { result = TCL_CONVERT_SYNTAX; } else { - /* PROFILE_REPLACE or PROFILE_TCL8 */ result = TCL_OK; - dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst); + dst += Tcl_UniCharToUtf(0xFFFD, dst); numChars++; - src += bytesLeft; /* Go past truncated code unit */ + src += bytesLeft; } } } - *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; @@ -3019,6 +3020,12 @@ Utf16ToUtfProc( ch = (src[0] & 0xFF) << 8 | (src[1] & 0xFF); } if (((prev & ~0x3FF) == 0xD800) && ((ch & ~0x3FF) != 0xDC00)) { + if (PROFILE_STRICT(flags)) { + result = TCL_CONVERT_UNKNOWN; + src -= 2; /* Go back to before the high surrogate */ + dst--; /* Also undo writing a single byte too much */ + break; + } /* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */ dst += Tcl_UniCharToUtf(-1, dst); } @@ -3028,10 +3035,12 @@ Utf16ToUtfProc( * unsigned short-size data. */ - if (ch && ch < 0x80) { + if ((unsigned)ch - 1 < 0x7F) { *dst++ = (ch & 0xFF); - } else { + } else if (((prev & ~0x3FF) == 0xD800) || ((ch & ~0x3FF) == 0xD800)) { dst += Tcl_UniCharToUtf(ch | TCL_COMBINE, dst); + } else { + dst += Tcl_UniCharToUtf(ch, dst); } src += sizeof(unsigned short); } @@ -3040,27 +3049,22 @@ Utf16ToUtfProc( /* Bug [10c2c17c32]. If Hi surrogate, finish 3-byte UTF-8 */ dst += Tcl_UniCharToUtf(-1, dst); } - - /* - * If we had a truncated code unit at the end AND this is the last - * fragment AND profile is not "strict", stick FFFD in its place. - */ if ((flags & TCL_ENCODING_END) && (result == TCL_CONVERT_MULTIBYTE)) { + /* We have a single byte left-over at the end */ if (dst > dstEnd) { result = TCL_CONVERT_NOSPACE; } else { - if (PROFILE_STRICT(flags)) { - result = TCL_CONVERT_SYNTAX; - } else { - /* PROFILE_REPLACE or PROFILE_TCL8 */ - result = TCL_OK; - dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst); - numChars++; - src++; /* Go past truncated code unit */ - } - } + if (PROFILE_STRICT(flags)) { + result = TCL_CONVERT_SYNTAX; + } else { + /* PROFILE_REPLACE or PROFILE_TCL8 */ + result = TCL_OK; + dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst); + numChars++; + src++; /* Go past truncated code unit */ + } + } } - *srcReadPtr = src - srcStart; *dstWrotePtr = dst - dstStart; *dstCharsPtr = numChars; diff --git a/tests/chanio.test b/tests/chanio.test index a065fde..ee6133e 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -4982,7 +4982,7 @@ test chan-io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} -setup { test chan-io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} { # This test crashes the interp if Bug #427196 is not fixed set chan [open [info script] r] - chan configure $chan -buffersize 10 + chan configure $chan -buffersize 10 -encoding utf-8 set var [chan read $chan 2] chan configure $chan -buffersize 32 append var [chan read $chan] diff --git a/tests/encoding.test b/tests/encoding.test index df67af8..d954870 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -511,11 +511,9 @@ test encoding-16.7 {Utf32ToUtfProc} -body { set val [encoding convertfrom utf-32be \0\0NN] list $val [format %x [scan $val %c]] } -result "乎 4e4e" -test encoding-16.8 {Utf32ToUtfProc} -constraints knownBug -body { +test encoding-16.8 {Utf32ToUtfProc} -body { set val [encoding convertfrom -profile tcl8 utf-32 \x41\x00\x00\x41] list $val [format %x [scan $val %c]] -} -constraints { - encodingProfileTodo } -result "\uFFFD fffd" test encoding-16.9 {Utf32ToUtfProc} -constraints utf32 -body { encoding convertfrom -profile tcl8 utf-32le \x00\xD8\x00\x00 @@ -607,8 +605,6 @@ test encoding-17.10 {Utf32ToUtfProc} -body { test encoding-18.1 {TableToUtfProc on invalid input} -body { list [catch {encoding convertto jis0208 \\} res] $res -} -constraints { - encodingProfileTodo } -result {1 {unexpected character at index 0: 'U+00005C'}} test encoding-18.2 {TableToUtfProc on invalid input with -profile strict} -body { list [catch {encoding convertto -profile strict jis0208 \\} res] $res @@ -798,8 +794,6 @@ test encoding-24.18 {Parse valid or invalid utf-8} -constraints testbytestring - } -result "Z\xC3\xA0\xE2\x82\xACxxxxxx" test encoding-24.19 {Parse valid or invalid utf-8} -body { encoding convertto utf-8 "ZX\uD800" -} -constraints { - encodingProfileTodo } -returnCodes 1 -match glob -result "unexpected character at index 2: 'U+00D800'" test encoding-24.20 {Parse with -profile tcl8 but without providing encoding} -body { encoding convertfrom -profile tcl8 "\x20" @@ -857,8 +851,6 @@ test encoding-24.37 {Parse invalid utf-8 with -profile tcl8} -body { } -result \uD800 test encoding-24.38 {Try to generate invalid utf-8} -body { encoding convertto utf-8 \uD800 -} -constraints { - encodingProfileTodo } -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 diff --git a/tests/io.test b/tests/io.test index a8ec7e5..b077c52 100644 --- a/tests/io.test +++ b/tests/io.test @@ -5541,7 +5541,7 @@ test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} { # This test crashes the interp if Bug #427196 is not fixed set chan [open [info script] r] - fconfigure $chan -buffersize 10 + fconfigure $chan -buffersize 10 -encoding utf-8 set var [read $chan 2] fconfigure $chan -buffersize 32 append var [read $chan] -- cgit v0.12 From f5bd004df9a90f12fba3280692ffefd5ea3c9188 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 12 Mar 2023 11:51:17 +0000 Subject: Make testcase io-53.5 independant on system encoding --- tests/io.test | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/io.test b/tests/io.test index b077c52..795d91e 100644 --- a/tests/io.test +++ b/tests/io.test @@ -7919,6 +7919,8 @@ test io-53.5 {CopyData: error during fcopy} {socket fcopy} { set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]] catch {unset fcopyTestDone} close $listen ;# This means the socket open never really succeeds + fconfigure $in -encoding utf-8 + fconfigure $out -encoding utf-8 fcopy $in $out -command [namespace code FcopyTestDone] variable fcopyTestDone if {![info exists fcopyTestDone]} { -- cgit v0.12 From c43f6e9701ac22b32b3d075413317e79e8c8057b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 12 Mar 2023 13:45:51 +0000 Subject: More utf-16 bugfixing --- generic/tclEncoding.c | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 806a052..4fc4cbd 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -3024,6 +3024,7 @@ Utf16ToUtfProc( result = TCL_CONVERT_UNKNOWN; src -= 2; /* Go back to before the high surrogate */ dst--; /* Also undo writing a single byte too much */ + numChars--; break; } /* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */ @@ -3039,6 +3040,10 @@ Utf16ToUtfProc( *dst++ = (ch & 0xFF); } else if (((prev & ~0x3FF) == 0xD800) || ((ch & ~0x3FF) == 0xD800)) { dst += Tcl_UniCharToUtf(ch | TCL_COMBINE, dst); + } else if (((ch & ~0x3FF) == 0xDC00) && PROFILE_STRICT(flags)) { + /* Lo surrogate not preceded by Hi surrogate */ + result = TCL_CONVERT_UNKNOWN; + break; } else { dst += Tcl_UniCharToUtf(ch, dst); } @@ -3046,8 +3051,15 @@ Utf16ToUtfProc( } if ((ch & ~0x3FF) == 0xD800) { - /* Bug [10c2c17c32]. If Hi surrogate, finish 3-byte UTF-8 */ - dst += Tcl_UniCharToUtf(-1, dst); + if ((flags & TCL_ENCODING_STRICT) == TCL_ENCODING_STRICT) { + result = TCL_CONVERT_UNKNOWN; + src -= 2; + dst--; + numChars--; + } else { + /* Bug [10c2c17c32]. If Hi surrogate, finish 3-byte UTF-8 */ + dst += Tcl_UniCharToUtf(-1, dst); + } } if ((flags & TCL_ENCODING_END) && (result == TCL_CONVERT_MULTIBYTE)) { /* We have a single byte left-over at the end */ -- cgit v0.12 From 362a0e8ba6f8c6e7c937982a09b164ddf488caeb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 13 Mar 2023 17:24:22 +0000 Subject: Adapt more test expectation (since the default is now -profile strict) --- tests/encoding.test | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/encoding.test b/tests/encoding.test index d954870..91cd8ff 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -492,7 +492,7 @@ test encoding-16.2 {Utf16ToUtfProc} -body { list $val [format %x [scan $val %c]] } -result "\U460DC 460dc" test encoding-16.3 {Utf16ToUtfProc} -body { - set val [encoding convertfrom utf-16 "\xDC\xDC"] + set val [encoding convertfrom -profile tcl8 utf-16 "\xDC\xDC"] list $val [format %x [scan $val %c]] } -result "\uDCDC dcdc" test encoding-16.4 {Ucs2ToUtfProc} -body { @@ -528,16 +528,16 @@ test encoding-16.12 {Utf32ToUtfProc} -constraints utf32 -body { encoding convertfrom -profile tcl8 utf-32le \x00\xDC\x00\x00\x00\xD8\x00\x00 } -result \uDC00\uD800 test encoding-16.13 {Utf16ToUtfProc} -body { - encoding convertfrom utf-16le \x00\xD8 + encoding convertfrom -profile tcl8 utf-16le \x00\xD8 } -result \uD800 test encoding-16.14 {Utf16ToUtfProc} -body { - encoding convertfrom utf-16le \x00\xDC + encoding convertfrom -profile tcl8 utf-16le \x00\xDC } -result \uDC00 test encoding-16.15 {Utf16ToUtfProc} -body { encoding convertfrom utf-16le \x00\xD8\x00\xDC } -result \U010000 test encoding-16.16 {Utf16ToUtfProc} -body { - encoding convertfrom utf-16le \x00\xDC\x00\xD8 + encoding convertfrom -profile tcl8 utf-16le \x00\xDC\x00\xD8 } -result \uDC00\uD800 test encoding-16.17 {Utf32ToUtfProc} -body { list [encoding convertfrom -profile strict -failindex idx utf-32le \x41\x00\x00\x00\x00\xD8\x00\x00\x42\x00\x00\x00] [set idx] -- cgit v0.12 From d023df86238ba0a0020a0ddc064eb076dcac6702 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 14 Mar 2023 20:24:27 +0000 Subject: Implement return options for read/gets --- generic/tclIO.c | 12 +++++++++--- generic/tclIOCmd.c | 33 ++++++++++++++++++++++++++------- tests/io.test | 44 ++++++++++++++++++++++++++++++++++++++++++++ tests/winConsole.test | 4 ++-- 4 files changed, 81 insertions(+), 12 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 0d6c108..07bb15d 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -5006,6 +5006,13 @@ Tcl_GetsObj( } UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); + if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) && + (copiedTotal == 0 || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) { + Tcl_SetErrno(EILSEQ); + if (copiedTotal == 0) { + copiedTotal = -1; + } + } return copiedTotal; } @@ -6056,7 +6063,6 @@ DoReadChars( * like [read] can return an error. */ Tcl_SetErrno(EILSEQ); - copied = -1; goto finish; } } @@ -10231,11 +10237,11 @@ DoRead( && ((p == dst) || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) { Tcl_SetErrno(EILSEQ); if (p == dst) { - p = dst - 1; + p = dst - 1; } } TclChannelRelease((Tcl_Channel)chanPtr); - return (int)(p - dst); + return (Tcl_Size)(p - dst); } /* diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 6ec5891..29e52fb 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -315,14 +315,22 @@ Tcl_GetsObjCmd( */ if (!TclChanCaughtErrorBypass(interp, chan)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "error reading \"%s\": %s", - TclGetString(chanObjPtr), Tcl_PosixError(interp))); + goto getsError; } code = TCL_ERROR; goto done; } lineLen = TCL_IO_FAILURE; + } else if (Tcl_InputEncodingError(chan)) { + Tcl_Obj *returnOpts = Tcl_NewDictObj(); + Tcl_DictObjPut(NULL, returnOpts, Tcl_NewStringObj("-data", TCL_INDEX_NONE), linePtr); + Tcl_SetReturnOptions(interp, returnOpts); + getsError: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading \"%s\": %s", + TclGetString(chanObjPtr), Tcl_PosixError(interp))); + code = TCL_ERROR; + goto done; } if (objc == 3) { if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr, @@ -438,13 +446,24 @@ Tcl_ReadObjCmd( * regular message if nothing was found in the bypass. */ + Tcl_DecrRefCount(resultPtr); if (!TclChanCaughtErrorBypass(interp, chan)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "error reading \"%s\": %s", - TclGetString(chanObjPtr), Tcl_PosixError(interp))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading \"%s\": %s", + TclGetString(chanObjPtr), Tcl_PosixError(interp))); + goto readError; } TclChannelRelease(chan); - Tcl_DecrRefCount(resultPtr); + return TCL_ERROR; + } else if (Tcl_InputEncodingError(chan)) { + Tcl_Obj *returnOpts = Tcl_NewDictObj(); + Tcl_DictObjPut(NULL, returnOpts, Tcl_NewStringObj("-data", TCL_INDEX_NONE), resultPtr); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error reading \"%s\": %s", + TclGetString(chanObjPtr), Tcl_PosixError(interp))); + Tcl_SetReturnOptions(interp, returnOpts); + readError: + TclChannelRelease(chan); return TCL_ERROR; } diff --git a/tests/io.test b/tests/io.test index 454f5a4..b74423c 100644 --- a/tests/io.test +++ b/tests/io.test @@ -9216,6 +9216,50 @@ test io-75.5 {invalid utf-8 encoding read is ignored (-profile tcl8)} -setup { removeFile io-75.5 } -result 4181 +test io-75.6 {invalid utf-8 encoding read is not ignored (-profile strict)} -setup { + set fn [makeFile {} io-75.6] + set f [open $fn w+] + fconfigure $f -encoding binary + # \x81 is invalid in utf-8 + puts -nonewline $f A\x81 + flush $f + seek $f 0 + fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -profile strict +} -body { + try { + read $f + } on error {result options} { + set data [dict get $options -data] + } + lappend data $result +} -cleanup { + close $f + removeFile io-75.6 +} -match glob -result {A {error reading "*": illegal byte sequence}} + +test io-75.7 {invalid utf-8 encoding eof handling (-profile strict)} -setup { + set fn [makeFile {} io-75.7] + set f [open $fn w+] + fconfigure $f -encoding binary + # \x81 is invalid in utf-8 + puts -nonewline $f A\x81 + flush $f + seek $f 0 + fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -profile strict +} -body { + try { + read $f + } on error {result options} { + set data [dict get $options -data] + } + lappend data $result + fconfigure $f -encoding iso8859-1 + lappend data [read $f] +} -cleanup { + close $f + removeFile io-75.7 +} -match glob -result "A {error reading \"*\": illegal byte sequence} \x81" + test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup { set fn [makeFile {} io-75.8] set f [open $fn w+] diff --git a/tests/winConsole.test b/tests/winConsole.test index ede6e92..4eccf81 100644 --- a/tests/winConsole.test +++ b/tests/winConsole.test @@ -198,7 +198,7 @@ test console-fconfigure-get-1.0 { Console get stdin configuration } -constraints {win interactive} -body { lsort [dict keys [fconfigure stdin]] -} -result {-blocking -buffering -buffersize -encoding -profile -eofchar -inputmode -translation} +} -result {-blocking -buffering -buffersize -encoding -eofchar -profile -inputmode -translation} set testnum 0 foreach {opt result} { @@ -232,7 +232,7 @@ foreach chan {stdout stderr} major {2 3} { win interactive } -body { lsort [dict keys [fconfigure $chan]] - } -result {-blocking -buffering -buffersize -encoding -profile -eofchar -translation -winsize} + } -result {-blocking -buffering -buffersize -encoding -eofchar -profile -translation -winsize} set testnum 0 foreach {opt result} { -blocking 1 -- cgit v0.12 From 3ac0d72dd626a276424a1589dbe15228fc35615c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 16 Mar 2023 08:22:35 +0000 Subject: Allow -encoding to be shortened (again) --- generic/tclIO.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 9a846da..0fec0f2 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -7990,7 +7990,7 @@ Tcl_GetChannelOption( return TCL_OK; } } - if (len == 0 || HaveOpt(8, "-encoding")) { + if (len == 0 || HaveOpt(2, "-encoding")) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-encoding"); } -- cgit v0.12 From b6ccec9b3f11c4ad0aab561a0a86ec3320e8ee07 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 16 Mar 2023 21:03:28 +0000 Subject: Don't reset CHANNEL_ENCODING_ERROR here, otherwise Tcl_InputEncodingError() will give wrong result --- generic/tclIO.c | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 49500e3..d013679 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4618,7 +4618,6 @@ Tcl_GetsObj( if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { UpdateInterest(chanPtr); Tcl_SetErrno(EILSEQ); - ResetFlag(statePtr, CHANNEL_ENCODING_ERROR); return TCL_INDEX_NONE; } -- cgit v0.12 From 0625218c8505d265ee7d2da3d8c7f7aad6879cf7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 18 Mar 2023 13:36:10 +0000 Subject: See if less "-profile replace" suffices --- library/http/http.tcl | 15 +-------------- 1 file changed, 1 insertion(+), 14 deletions(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index 3410c46..c730eeb 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -1746,9 +1746,6 @@ proc http::OpenSocket {token DoLater} { } fconfigure $sock -translation {auto crlf} \ -buffersize $state(-blocksize) - if {[package vsatisfies [package provide Tcl] 9.0-]} { - fconfigure $sock -profile replace \ - } ##Log socket opened, DONE fconfigure - token $token } @@ -2167,9 +2164,6 @@ proc http::Connected {token proto phost srvurl} { lassign [fconfigure $sock -translation] trRead trWrite fconfigure $sock -translation [list $trRead crlf] \ -buffersize $state(-blocksize) - if {[package vsatisfies [package provide Tcl] 9.0-]} { - fconfigure $sock -profile replace \ - } # The following is disallowed in safe interpreters, but the socket is # already in non-blocking mode in that case. @@ -2560,9 +2554,6 @@ proc http::ReceiveResponse {token} { lassign [fconfigure $sock -translation] trRead trWrite fconfigure $sock -translation [list auto $trWrite] \ -buffersize $state(-blocksize) - if {[package vsatisfies [package provide Tcl] 9.0-]} { - fconfigure $sock -profile replace \ - } Log ^D$tk begin receiving response - token $token coroutine ${token}--EventCoroutine http::Event $sock $token @@ -4726,11 +4717,7 @@ proc http::quoteString {string} { # a pre-computed map and [string map] to do the conversion (much faster # than [regsub]/[subst]). [Bug 1020491] - if {[package vsatisfies [package provide Tcl] 9.0-]} { - set string [encoding convertto -profile replace $http(-urlencoding) $string] - } else { - set string [encoding convertto $http(-urlencoding) $string] - } + set string [encoding convertto $http(-urlencoding) $string] return [string map $formMap $string] } -- cgit v0.12 From 34ecddb6102a17c7771e30f8b9bb559adc312ea3 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 21 Mar 2023 17:47:33 +0000 Subject: exchange profile <-> eofchar output in "fconfigure". Fix some testcases, which depend on profile --- generic/tclIO.c | 28 ++++++++++++++-------------- tests/chanio.test | 2 +- tests/io.test | 2 +- tests/ioCmd.test | 12 ++++++------ tests/zlib.test | 4 ++-- 5 files changed, 24 insertions(+), 24 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index d013679..877e670 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -8005,6 +8005,20 @@ Tcl_GetChannelOption( return TCL_OK; } } + if (len == 0 || HaveOpt(2, "-eofchar")) { + char buf[4] = ""; + if (len == 0) { + Tcl_DStringAppendElement(dsPtr, "-eofchar"); + } + if ((flags & TCL_READABLE) && (statePtr->inEofChar != 0)) { + sprintf(buf, "%c", statePtr->inEofChar); + } + if (len > 0) { + Tcl_DStringAppend(dsPtr, buf, TCL_INDEX_NONE); + return TCL_OK; + } + Tcl_DStringAppendElement(dsPtr, buf); + } if (len == 0 || HaveOpt(1, "-profile")) { int profile; const char *profileName; @@ -8022,20 +8036,6 @@ Tcl_GetChannelOption( return TCL_OK; } } - if (len == 0 || HaveOpt(2, "-eofchar")) { - char buf[4] = ""; - if (len == 0) { - Tcl_DStringAppendElement(dsPtr, "-eofchar"); - } - if ((flags & TCL_READABLE) && (statePtr->inEofChar != 0)) { - sprintf(buf, "%c", statePtr->inEofChar); - } - if (len > 0) { - Tcl_DStringAppend(dsPtr, buf, TCL_INDEX_NONE); - return TCL_OK; - } - Tcl_DStringAppendElement(dsPtr, buf); - } if (len == 0 || HaveOpt(1, "-translation")) { if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-translation"); diff --git a/tests/chanio.test b/tests/chanio.test index ee6133e..8534b3b 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -1098,7 +1098,7 @@ test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup { chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82" chan close $f set f [open $path(test1)] - chan configure $f -encoding shiftjis + chan configure $f -encoding shiftjis -profile tcl8 lappend x [chan gets $f line] $line lappend x [chan tell $f] [testchannel inputbuffered $f] [chan eof $f] lappend x [chan gets $f line] $line diff --git a/tests/io.test b/tests/io.test index a2e4dc3..5fb2415 100644 --- a/tests/io.test +++ b/tests/io.test @@ -1195,7 +1195,7 @@ test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} { puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82" close $f set f [open $path(test1)] - fconfigure $f -encoding shiftjis + fconfigure $f -encoding shiftjis -profile tcl8 set x [list [gets $f line] $line] lappend x [tell $f] [testchannel inputbuffered $f] [eof $f] lappend x [gets $f line] $line diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 530c700..7148ad5 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -244,7 +244,7 @@ test iocmd-8.7 {fconfigure command} -setup { fconfigure $f1 } -cleanup { catch {close $f1} -} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -profile strict -eofchar {} -translation lf} +} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -profile strict -translation lf} test iocmd-8.8 {fconfigure command} -setup { file delete $path(test1) set x {} @@ -256,7 +256,7 @@ test iocmd-8.8 {fconfigure command} -setup { lappend x [fconfigure $f1] } -cleanup { catch {close $f1} -} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -profile tcl8 -eofchar {} -translation lf}} +} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -profile tcl8 -translation lf}} test iocmd-8.9 {fconfigure command} -setup { file delete $path(test1) } -body { @@ -266,7 +266,7 @@ test iocmd-8.9 {fconfigure command} -setup { fconfigure $f1 } -cleanup { catch {close $f1} -} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -profile strict -eofchar {} -translation lf} +} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -profile strict -translation lf} test iocmd-8.10 {fconfigure command} -returnCodes error -body { fconfigure a b } -result {can not find channel named "a"} @@ -1372,7 +1372,7 @@ test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body { close $c rename foo {} set res -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -profile * -eofchar {} -translation {auto *}}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -profile * -translation {auto *}}} test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} proc foo {args} {oninit cget cgetall; onfinal; track; return ""} @@ -1381,7 +1381,7 @@ test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body { close $c rename foo {} set res -} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -profile * -eofchar {} -translation {auto *}}} +} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -profile * -translation {auto *}}} test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} proc foo {args} { @@ -1393,7 +1393,7 @@ test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body { close $c rename foo {} set res -} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -profile * -eofchar {} -translation {auto *} -bar foo -snarf x}} +} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -profile * -translation {auto *} -bar foo -snarf x}} test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body { set res {} proc foo {args} { diff --git a/tests/zlib.test b/tests/zlib.test index b343c06..544e6d4 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -292,7 +292,7 @@ test zlib-8.6 {transformation and fconfigure} -setup { } -cleanup { catch {close $fd} removeFile $file -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -profile strict -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -profile strict -eofchar {} -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -profile strict -eofchar {} -translation lf}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile strict -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile strict -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile strict -translation lf}} test zlib-8.7 {transformation and fconfigure} -setup { set file [makeFile {} test.gz] set fd [open $file wb] @@ -302,7 +302,7 @@ test zlib-8.7 {transformation and fconfigure} -setup { } -cleanup { catch {close $fd} removeFile $file -} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -profile strict -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -profile strict -eofchar {} -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -profile strict -eofchar {} -translation lf}} +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile strict -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile strict -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -profile strict -translation lf}} # Input is headers from fetching SPDY draft # Dictionary is that which is proposed _in_ SPDY draft set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n" -- cgit v0.12 From 2ffd05e70358635a831fc16b449e0021c4c00c14 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 23 Mar 2023 17:31:37 +0000 Subject: documentation update --- doc/Encoding.3 | 2 +- doc/encoding.n | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 1f0dbdf..356f582 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -590,7 +590,7 @@ with at most one of \fBTCL_ENCODING_PROFILE_TCL8\fR, \fBTCL_ENCODING_PROFILE_STRICT\fR or \fBTCL_ENCODING_PROFILE_REPLACE\fR. These correspond to the \fBtcl8\fR, \fBstrict\fR and \fBreplace\fR profiles respectively. If none are specified, a version-dependent default profile is used. -For Tcl 8.7, the default profile is \fBtcl8\fR. +For Tcl 9.0, the default profile is \fBstrict\fR. .PP For details about profiles, see the \fBPROFILES\fR section in the documentation of the \fBencoding\fR command. diff --git a/doc/encoding.n b/doc/encoding.n index 8ede974..4c37b79 100644 --- a/doc/encoding.n +++ b/doc/encoding.n @@ -120,7 +120,7 @@ Continue further processing of the source data using a fallback strategy such as replacing or discarding the offending bytes in a profile-defined manner. .VE "TCL8.7 TIP656" .PP -The following profiles are currently implemented with \fBtcl8\fR being +The following profiles are currently implemented with \fBstrict\fR being the default if the \fB-profile\fR is not specified. .VS "TCL8.7 TIP656" .TP @@ -146,7 +146,7 @@ the question mark \fB?\fR. \fBstrict\fR . The \fBstrict\fR profile always stops processing when an conversion error is -encountered. The error is signalled via an exception or the \fB-failindex\fR +encountered. The error is signaled via an exception or the \fB-failindex\fR option mechanism. The \fBstrict\fR profile implements a Unicode standard conformant behavior. .TP @@ -206,7 +206,7 @@ unexpected byte sequence starting at index 1: '\ex80' Example 3: Get partial data and the error location: .PP .CS -% codepoints [encoding convertfrom -profile strict -failindex idx ascii AB\ex80] +% codepoints [encoding convertfrom -failindex idx ascii AB\ex80] U+000041 U+000042 % set idx 2 @@ -219,7 +219,7 @@ Example 4: Encode a character that is not representable in ISO8859-1: A? % encoding convertto -profile strict iso8859-1 A\eu0141 unexpected character at index 1: 'U+000141' -% encoding convertto -profile strict -failindex idx iso8859-1 A\eu0141 +% encoding convertto -failindex idx iso8859-1 A\eu0141 A % set idx 1 -- cgit v0.12 From 93cc703cc9fa8e027da0ed05719c9ec79bf93463 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 1 Apr 2023 15:09:11 +0000 Subject: Remove TCL_ENCODING_PROFILE_DEFAULT, since it isn't documented and is not used anywhere. --- generic/tcl.h | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/tcl.h b/generic/tcl.h index caa33b4..4d7ff7d 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1965,7 +1965,6 @@ typedef struct Tcl_EncodingType { #define TCL_ENCODING_PROFILE_STRICT TCL_ENCODING_STOPONERROR #define TCL_ENCODING_PROFILE_TCL8 0x01000000 #define TCL_ENCODING_PROFILE_REPLACE 0x02000000 -#define TCL_ENCODING_PROFILE_DEFAULT 0 /* * The following definitions are the error codes returned by the conversion -- cgit v0.12 From 534ac5196d20c1c44b06011a90ce64dbec4f0be0 Mon Sep 17 00:00:00 2001 From: pointsman Date: Fri, 21 Apr 2023 00:42:46 +0000 Subject: Updated disabletcl8api to post TIP 660. Changed the default while doing that. Now, without related configure option the tcl core will build without the compatibility macros (which also hides other type problems). To build the core with the complatibility macros configure with --enable-tcl8api. Jan claimed that with [fc9c3d7c3e009] disabledtcl8api was added to trunk but while I confess I didn't fully understand Jan changed the mechnism and missed to disables the tip 616 API functions. --- generic/tclDecls.h | 103 +++++++++++++++++++++++++++++++---------------------- unix/configure | 20 +++++++++++ unix/configure.ac | 10 ++++++ win/rules.vc | 18 +++++++++- 4 files changed, 107 insertions(+), 44 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 89ff26c..5ab10ad 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4037,66 +4037,79 @@ extern const TclStubs *tclStubsPtr; #undef TclGetByteArrayFromObj #undef Tcl_GetByteArrayFromObj #if defined(USE_TCL_STUBS) -# if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) -# define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ - tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (Tcl_Size *)(void *)(sizePtr))) -# define Tcl_GetStringFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \ - tclStubsPtr->tcl_GetStringFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr))) -# define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \ - tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr))) -# endif -#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ +# if defined(TCL_8_API) || TCL_MAJOR_VERSION == 8 +# define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ + tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (Tcl_Size *)(void *)(sizePtr))) +# define Tcl_GetStringFromObj(objPtr, sizePtr) \ + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + tclStubsPtr->tclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \ + tclStubsPtr->tcl_GetStringFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr))) +# if TCL_MAJOR_VERSION > 8 +# define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \ + tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))) +# else +# define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + tclStubsPtr->tclGetByteArrayFromObj(objPtr, (int *)(void *)(sizePtr)) : \ + tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr))) +# endif +# define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + tclStubsPtr->tclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \ + tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr))) +# else /* TCL_8_API */ +# if TCL_MAJOR_VERSION > 8 +# define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ + tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)) +# else +# define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ + tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)) +# endif /* TCL_MAJOR_VERSION > 8 */ +# endif /* TCL_8_API */ +# define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \ (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) -#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ +# define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) -#define Tcl_GetBoolean(interp, src, boolPtr) \ +# define Tcl_GetBoolean(interp, src, boolPtr) \ ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) -#if TCL_MAJOR_VERSION > 8 -#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \ - tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))) -#else -#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetByteArrayFromObj(objPtr, (int *)(void *)(sizePtr)) : \ - tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr))) -#endif #else -#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ +# if defined(TCL_8_API) || TCL_MAJOR_VERSION == 8 +# define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ (Tcl_GetBytesFromObj)(interp, objPtr, (Tcl_Size *)(void *)(sizePtr))) -#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ - ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \ - (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) -#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ - ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ - Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) -#define Tcl_GetBoolean(interp, src, boolPtr) \ - ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ - Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) -#define Tcl_GetStringFromObj(objPtr, sizePtr) \ +# define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \ (Tcl_GetStringFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr))) -#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ +# define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \ (Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))) -#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? \ +# define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ + (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \ (Tcl_GetUnicodeFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr))) +# else /* TCL_8_API */ +# define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ + Tcl_GetBytesFromObj(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)) +# endif /* TCL_8_API */ +# define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ + ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \ + (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) +# define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ + ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ + Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) +# define Tcl_GetBoolean(interp, src, boolPtr) \ + ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ + Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #endif #ifdef TCL_MEM_DEBUG @@ -4168,6 +4181,7 @@ extern const TclStubs *tclStubsPtr; # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) +#if defined(TCL_8_API) || TCL_MAJOR_VERSION == 8 # undef Tcl_ListObjGetElements # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \ ? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ @@ -4196,6 +4210,7 @@ extern const TclStubs *tclStubsPtr; # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \ ? tclStubsPtr->tclParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \ : tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) +#endif /* TCL_8_API */ #else # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_UniCharToUtfDString \ @@ -4209,7 +4224,8 @@ extern const TclStubs *tclStubsPtr; # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))Tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) -#if !defined(BUILD_tcl) && !defined(TCL_NO_DEPRECATED) +#if !defined(BUILD_tcl) +#if defined(TCL_8_API) || TCL_MAJOR_VERSION == 8 # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \ ? TclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ : (Tcl_ListObjGetElements)((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr))) @@ -4231,6 +4247,7 @@ extern const TclStubs *tclStubsPtr; # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \ ? TclParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \ : (Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) +#endif /* TCL_8_API */ #endif /* !defined(BUILD_tcl) */ #endif diff --git a/unix/configure b/unix/configure index 4c54fbe..1040bbd 100755 --- a/unix/configure +++ b/unix/configure @@ -810,6 +810,7 @@ enable_load enable_symbols enable_langinfo enable_dll_unloading +enable_tcl8api with_tzdata enable_dtrace enable_framework @@ -1460,6 +1461,7 @@ Optional Features: --enable-langinfo use nl_langinfo if possible to determine encoding at startup, otherwise use old heuristic (default: on) --enable-dll-unloading enable the 'unload' command (default: on) + --enable-tcl8api enable the Tcl 8 compatibility API (default: off) --enable-dtrace build with DTrace support (default: off) --enable-framework package shared libraries in MacOSX frameworks (default: off) @@ -10656,6 +10658,24 @@ fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5 printf "%s\n" "$tcl_ok" >&6; } +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to use Tcl 8 compatibility API" >&5 +printf %s "checking whether to use Tcl 8 compatibility API... " >&6; } +# Check whether --enable-tcl8api was given. +if test ${enable_tcl8api+y} +then : + enableval=$enable_tcl8api; tcl_ok=$enableval +else $as_nop + tcl_ok=no +fi + +if test $tcl_ok = yes; then + +printf "%s\n" "#define TCL_8_API 1" >>confdefs.h + +fi +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5 +printf "%s\n" "$tcl_ok" >&6; } + #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can diff --git a/unix/configure.ac b/unix/configure.ac index 238e47a..88dc137 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -666,6 +666,16 @@ if test $tcl_ok = yes; then fi AC_MSG_RESULT([$tcl_ok]) +AC_MSG_CHECKING([whether to use Tcl 8 compatibility API]) +AC_ARG_ENABLE(tcl8api, + AS_HELP_STRING([--enable-tcl8api], + [enable the Tcl 8 compatibility API (default: off)]), + [tcl_ok=$enableval], [tcl_ok=no]) +if test $tcl_ok = yes; then + AC_DEFINE(TCL_8_API, 1, [Tcl 8 compatibility API enabled?]) +fi +AC_MSG_RESULT([$tcl_ok]) + #------------------------------------------------------------------------ # Check whether the timezone data is supplied by the OS or has # to be installed by Tcl. The default is autodetection, but can diff --git a/win/rules.vc b/win/rules.vc index d8b3b12..d31765d 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -817,11 +817,14 @@ DOTSEPARATED=$(DOTSEPARATED:b=.) # _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build # (CRT library should support this, not needed for Tcl 9.x) # TCL_UTF_MAX=3 - forces a build using UTF-16 internally (not recommended). +# TCL_8_API - 0 -> Tcl 8 compatible API is disabled +# 1 -> Tcl 8 API enabled (default) # Further, LINKERFLAGS are modified based on above. # Default values for all the above STATIC_BUILD = 0 TCL_THREADS = 1 +TCL_8_API = 0 DEBUG = 0 SYMBOLS = 0 PROFILE = 0 @@ -877,10 +880,19 @@ TCL_THREADS = 0 USE_THREAD_ALLOC= 0 !endif +!if [nmakehlp -f $(OPTS) "tcl8api"] +!message *** Disable Tcl 8 API compatibility macros +TCL_8_API = 1 +!endif + +# NOTE: THIS MUST COME AFTER THE notcl8api CHECK ABOVE because the "-f" option +# does *substring* checks, not exact checks so "tcl8" will match "notcl8api" as well. +!if $(TCL_8_API) !if [nmakehlp -f $(OPTS) "tcl8"] !message *** Build for Tcl8 TCL_BUILD_FOR = 8 !endif +!endif !if $(TCL_MAJOR_VERSION) == 8 !if [nmakehlp -f $(OPTS) "time64bit"] @@ -1369,7 +1381,7 @@ INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\..\include # and switches are specific to it. # The following macros are defined, names are for historical compatibility: # OPTDEFINES - /Dxxx C macro flags based on user-specified OPTS -# COMPILERFLAGS - /Dxxx C macro flags independent of any configuration options +# COMPILERFLAGS - /Dxxx C macro flags independent of any configuration opttions # crt - Compiler switch that selects the appropriate C runtime # cdebug - Compiler switches related to debug AND optimizations # cwarn - Compiler switches that set warning levels @@ -1451,12 +1463,16 @@ OPTDEFINES = $(OPTDEFINES) /D_USE_64BIT_TIME_T=1 # _ATL_XP_TARGETING - Newer SDK's need this to build for XP COMPILERFLAGS = /D_ATL_XP_TARGETING !endif + !if "$(TCL_UTF_MAX)" == "3" OPTDEFINES = $(OPTDEFINES) /DTCL_UTF_MAX=3 !endif !if "$(TCL_BUILD_FOR)" == "8" OPTDEFINES = $(OPTDEFINES) /DTCL_MAJOR_VERSION=8 !endif +!if $(TCL_8_API) +OPTDEFINES = $(OPTDEFINES) /DTCL_8_API=1 +!endif # Like the TEA system only set this non empty for non-Tk extensions # Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME -- cgit v0.12 From cb008d57c8b1bfad27632a42f91a37637030ad96 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 4 May 2023 06:44:22 +0000 Subject: Some int -> Tcl_Size. Remove unnecessary knownBug constraint --- generic/tclIO.c | 4 ++-- tests/utfext.test | 2 +- tests/winConsole.test | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index e7e5b1b..c28a7f5 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4645,7 +4645,7 @@ Tcl_GetsObj( if (statePtr->encoding == GetBinaryEncoding() && ((statePtr->inputTranslation == TCL_TRANSLATE_LF) || (statePtr->inputTranslation == TCL_TRANSLATE_CR)) - && Tcl_GetByteArrayFromObj(objPtr, (size_t *)NULL) != NULL) { + && Tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)NULL) != NULL) { return TclGetsObjBinary(chan, objPtr); } @@ -5986,7 +5986,7 @@ DoReadChars( && (statePtr->inEofChar == '\0'); if (appendFlag) { - if (binaryMode && (NULL == Tcl_GetByteArrayFromObj(objPtr, (size_t *)NULL))) { + if (binaryMode && (NULL == Tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)NULL))) { binaryMode = 0; } } else { diff --git a/tests/utfext.test b/tests/utfext.test index de26b6f..b980800 100644 --- a/tests/utfext.test +++ b/tests/utfext.test @@ -84,7 +84,7 @@ foreach {enc utfhex hex} $utfExtMap { } # Test for insufficient space -test xx-bufferoverflow {buffer overflow Tcl_ExternalToUtf} -constraints knownBug -body { +test xx-bufferoverflow {buffer overflow Tcl_ExternalToUtf} -body { testencoding Tcl_UtfToExternal utf-16 A {start end} {} 1 } -result [list nospace {} \xFF] diff --git a/tests/winConsole.test b/tests/winConsole.test index 4eccf81..3104184 100644 --- a/tests/winConsole.test +++ b/tests/winConsole.test @@ -198,7 +198,7 @@ test console-fconfigure-get-1.0 { Console get stdin configuration } -constraints {win interactive} -body { lsort [dict keys [fconfigure stdin]] -} -result {-blocking -buffering -buffersize -encoding -eofchar -profile -inputmode -translation} +} -result {-blocking -buffering -buffersize -encoding -eofchar -inputmode -profile -translation} set testnum 0 foreach {opt result} { -- cgit v0.12 From 83776b137b93bcfcd1d24073608f1283bf839a65 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 4 May 2023 19:53:44 +0000 Subject: Tcl_InputEncodingError() -> TclInputEncodingError. It will be split off in a separate TIP --- doc/OpenFileChnl.3 | 11 ++--------- generic/tcl.decls | 5 ----- generic/tclDecls.h | 8 +++----- generic/tclIO.c | 4 ++-- generic/tclIOCmd.c | 2 +- generic/tclInt.h | 1 + generic/tclStubInit.c | 2 +- 7 files changed, 10 insertions(+), 23 deletions(-) diff --git a/doc/OpenFileChnl.3 b/doc/OpenFileChnl.3 index 8709c60..4f407b6 100644 --- a/doc/OpenFileChnl.3 +++ b/doc/OpenFileChnl.3 @@ -9,7 +9,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -Tcl_OpenFileChannel, Tcl_OpenCommandChannel, Tcl_MakeFileChannel, Tcl_GetChannel, Tcl_GetChannelNames, Tcl_GetChannelNamesEx, Tcl_RegisterChannel, Tcl_UnregisterChannel, Tcl_DetachChannel, Tcl_IsStandardChannel, Tcl_Close, Tcl_ReadChars, Tcl_Read, Tcl_GetsObj, Tcl_Gets, Tcl_WriteObj, Tcl_WriteChars, Tcl_Write, Tcl_Flush, Tcl_Seek, Tcl_Tell, Tcl_TruncateChannel, Tcl_GetChannelOption, Tcl_SetChannelOption, Tcl_Eof, Tcl_InputBlocked, Tcl_InputBuffered, Tcl_InputEncodingError, Tcl_OutputBuffered, Tcl_Ungets, Tcl_ReadRaw, Tcl_WriteRaw \- buffered I/O facilities using channels +Tcl_OpenFileChannel, Tcl_OpenCommandChannel, Tcl_MakeFileChannel, Tcl_GetChannel, Tcl_GetChannelNames, Tcl_GetChannelNamesEx, Tcl_RegisterChannel, Tcl_UnregisterChannel, Tcl_DetachChannel, Tcl_IsStandardChannel, Tcl_Close, Tcl_ReadChars, Tcl_Read, Tcl_GetsObj, Tcl_Gets, Tcl_WriteObj, Tcl_WriteChars, Tcl_Write, Tcl_Flush, Tcl_Seek, Tcl_Tell, Tcl_TruncateChannel, Tcl_GetChannelOption, Tcl_SetChannelOption, Tcl_Eof, Tcl_InputBlocked, Tcl_InputBuffered, Tcl_OutputBuffered, Tcl_Ungets, Tcl_ReadRaw, Tcl_WriteRaw \- buffered I/O facilities using channels .SH SYNOPSIS .nf \fB#include \fR @@ -90,9 +90,6 @@ int \fBTcl_InputBuffered\fR(\fIchannel\fR) .sp int -\fBTcl_InputEncodingError\fR(\fIchannel\fR) -.sp -int \fBTcl_OutputBuffered\fR(\fIchannel\fR) .sp long long @@ -487,11 +484,7 @@ of input unavailability. .PP If the channel is in blocking mode, it might be that there is data available but - at the same time - an encoding error occurred. In that case, the -POSIX error EILSEQ will be recorded, but - since \fBTcl_Gets\fR/\fBTcl_Read\fR -didn't return TCL_INDEX_NONE we cannot be sure if the POSIX error -maybe was a left-over from an earlier error. The only way to be sure -is calling the \fBTcl_InputEncodingError\fR procedure, it will -return 1 if the channel is at an encoding error position. +POSIX error EILSEQ will be recorded. .PP \fBTcl_Gets\fR is the same as \fBTcl_GetsObj\fR except the resulting characters are appended to the dynamic string given by diff --git a/generic/tcl.decls b/generic/tcl.decls index 30e4dea..d52b710 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2632,11 +2632,6 @@ declare 686 { Tcl_Size *sizePtr) } -# TIP 657 -declare 687 { - int Tcl_InputEncodingError(Tcl_Channel chan) -} - # ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- # declare 688 { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 2fa84c4..feb7a64 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1865,8 +1865,7 @@ EXTERN Tcl_Obj * Tcl_DStringToObj(Tcl_DString *dsPtr); /* 686 */ EXTERN int Tcl_GetSizeIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *sizePtr); -/* 687 */ -EXTERN int Tcl_InputEncodingError(Tcl_Channel chan); +/* Slot 687 is reserved */ /* 688 */ EXTERN void TclUnusedStubEntry(void); @@ -2567,7 +2566,7 @@ typedef struct TclStubs { int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */ Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */ int (*tcl_GetSizeIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *sizePtr); /* 686 */ - int (*tcl_InputEncodingError) (Tcl_Channel chan); /* 687 */ + void (*reserved687)(void); void (*tclUnusedStubEntry) (void); /* 688 */ } TclStubs; @@ -3895,8 +3894,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_DStringToObj) /* 685 */ #define Tcl_GetSizeIntFromObj \ (tclStubsPtr->tcl_GetSizeIntFromObj) /* 686 */ -#define Tcl_InputEncodingError \ - (tclStubsPtr->tcl_InputEncodingError) /* 687 */ +/* Slot 687 is reserved */ #define TclUnusedStubEntry \ (tclStubsPtr->tclUnusedStubEntry) /* 688 */ diff --git a/generic/tclIO.c b/generic/tclIO.c index c28a7f5..b7282c9 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -7612,7 +7612,7 @@ Tcl_InputBuffered( /* *---------------------------------------------------------------------- * - * Tcl_InputEncodingError -- + * TclInputEncodingError -- * * Returns 1 if input is in an encoding error position, 0 otherwise. * @@ -7626,7 +7626,7 @@ Tcl_InputBuffered( */ int -Tcl_InputEncodingError( +TclInputEncodingError( Tcl_Channel chan) /* Is this channel blocked? */ { ChannelState *statePtr = ((Channel *) chan)->state; diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 679fe5e..4cf4631 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -447,7 +447,7 @@ Tcl_ReadObjCmd( TclGetString(chanObjPtr), Tcl_PosixError(interp))); } goto readError; - } else if (Tcl_InputEncodingError(chan)) { + } else if (TclInputEncodingError(chan)) { Tcl_Obj *returnOpts = Tcl_NewDictObj(); Tcl_DictObjPut(NULL, returnOpts, Tcl_NewStringObj("-data", TCL_INDEX_NONE), resultPtr); Tcl_SetObjResult(interp, Tcl_ObjPrintf( diff --git a/generic/tclInt.h b/generic/tclInt.h index 436384e..03d3e22 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3224,6 +3224,7 @@ MODULE_SCOPE void TclInitNamespaceSubsystem(void); MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); +MODULE_SCOPE int TclInputEncodingError(Tcl_Channel chan); MODULE_SCOPE int TclIsDigitProc(int byte); MODULE_SCOPE int TclIsBareword(int byte); MODULE_SCOPE Tcl_Obj * TclJoinPath(Tcl_Size elements, Tcl_Obj * const objv[], diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index a77a958..92632e8 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1513,7 +1513,7 @@ const TclStubs tclStubs = { Tcl_GetWideUIntFromObj, /* 684 */ Tcl_DStringToObj, /* 685 */ Tcl_GetSizeIntFromObj, /* 686 */ - Tcl_InputEncodingError, /* 687 */ + 0, /* 687 */ TclUnusedStubEntry, /* 688 */ }; -- cgit v0.12 From 91c305a5f3924fdd07b574ce025113cec013fd06 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 5 May 2023 06:18:55 +0000 Subject: Remove more ... to be split off in separate TIP's --- doc/OpenFileChnl.3 | 4 -- generic/tclCmdAH.c | 4 -- generic/tclIO.c | 103 +++++++++++++++++----------------------------------- generic/tclIOCmd.c | 15 ++------ generic/tclInt.h | 1 - tests/encoding.test | 43 +++++++++++++++------- 6 files changed, 66 insertions(+), 104 deletions(-) diff --git a/doc/OpenFileChnl.3 b/doc/OpenFileChnl.3 index 4f407b6..3a7b6ae 100644 --- a/doc/OpenFileChnl.3 +++ b/doc/OpenFileChnl.3 @@ -482,10 +482,6 @@ end-of-line character. When -1 is returned, the \fBTcl_InputBlocked\fR procedure may be invoked to determine if the channel is blocked because of input unavailability. .PP -If the channel is in blocking mode, it might be that there is data available -but - at the same time - an encoding error occurred. In that case, the -POSIX error EILSEQ will be recorded. -.PP \fBTcl_Gets\fR is the same as \fBTcl_GetsObj\fR except the resulting characters are appended to the dynamic string given by \fIlineRead\fR rather than a Tcl value. diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index e8eb26a..ae1ba33 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -435,11 +435,7 @@ EncodingConvertParseOptions ( Tcl_Encoding encoding; Tcl_Obj *dataObj; Tcl_Obj *failVarObj; -#if TCL_MAJOR_VERSION > 8 || defined(TCL_NO_DEPRECATED) int profile = TCL_ENCODING_PROFILE_STRICT; -#else - int profile = TCL_ENCODING_PROFILE_TCL8; -#endif /* * Possible combinations: diff --git a/generic/tclIO.c b/generic/tclIO.c index b7282c9..fb399d4 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -223,8 +223,8 @@ static void StopCopy(CopyState *csPtr); static void TranslateInputEOL(ChannelState *statePtr, char *dst, const char *src, int *dstLenPtr, int *srcLenPtr); static void UpdateInterest(Channel *chanPtr); -static int Write(Channel *chanPtr, const char *src, - int srcLen, Tcl_Encoding encoding); +static Tcl_Size Write(Channel *chanPtr, const char *src, + Tcl_Size srcLen, Tcl_Encoding encoding); static Tcl_Obj * FixLevelCode(Tcl_Obj *msg); static void SpliceChannel(Tcl_Channel chan); static void CutChannel(Tcl_Channel chan); @@ -4189,6 +4189,7 @@ Tcl_WriteChars( } objPtr = Tcl_NewStringObj(src, len); + Tcl_IncrRefCount(objPtr); src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len); if (src == NULL) { Tcl_SetErrno(EILSEQ); @@ -4237,7 +4238,7 @@ Tcl_WriteObj( Channel *chanPtr; ChannelState *statePtr; /* State info for channel */ const char *src; - Tcl_Size srcLen; + Tcl_Size srcLen = 0; statePtr = ((Channel *) chan)->state; chanPtr = statePtr->topChanPtr; @@ -4246,31 +4247,20 @@ Tcl_WriteObj( return TCL_INDEX_NONE; } if (statePtr->encoding == NULL) { + Tcl_Size result; + src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen); if (src == NULL) { Tcl_SetErrno(EILSEQ); - return TCL_INDEX_NONE; + result = TCL_INDEX_NONE; + } else { + result = WriteBytes(chanPtr, src, srcLen); } + return result; } else { src = Tcl_GetStringFromObj(objPtr, &srcLen); + return WriteChars(chanPtr, src, srcLen); } - - size_t totalWritten = 0; - /* - * Note original code always called WriteChars even if srcLen 0 - * so we will too. - */ - do { - int chunkSize = srcLen > INT_MAX ? INT_MAX : srcLen; - int written; - written = WriteChars(chanPtr, src, chunkSize); - if (written < 0) { - return TCL_INDEX_NONE; - } - totalWritten += written; - srcLen -= chunkSize; - } while (srcLen); - return totalWritten; } static void @@ -4341,17 +4331,18 @@ WillRead( *---------------------------------------------------------------------- */ -static int +static Tcl_Size Write( Channel *chanPtr, /* The channel to buffer output for. */ const char *src, /* UTF-8 string to write. */ - int srcLen, /* Length of UTF-8 string in bytes. */ + Tcl_Size srcLen, /* Length of UTF-8 string in bytes. */ Tcl_Encoding encoding) { ChannelState *statePtr = chanPtr->state; /* State info for channel */ char *nextNewLine = NULL; - int endEncoding, saved = 0, total = 0, flushed = 0, needNlFlush = 0; + int endEncoding, needNlFlush = 0; + Tcl_Size saved = 0, total = 0, flushed = 0; char safe[BUFFER_PADDING]; int encodingError = 0; @@ -4364,7 +4355,6 @@ Write( */ endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0); - if (GotFlag(statePtr, CHANNEL_LINEBUFFERED) || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) { nextNewLine = (char *)memchr(src, '\n', srcLen); @@ -4373,7 +4363,8 @@ Write( while (srcLen + saved + endEncoding > 0 && !encodingError) { ChannelBuffer *bufPtr; char *dst; - int result, srcRead, dstLen, dstWrote, srcLimit = srcLen; + int result, srcRead, dstLen, dstWrote; + Tcl_Size srcLimit = srcLen; if (nextNewLine) { srcLimit = nextNewLine - src; @@ -4604,8 +4595,8 @@ Tcl_GetsObj( ChannelState *statePtr = chanPtr->state; /* State info for channel */ ChannelBuffer *bufPtr; - int inEofChar, skip, copiedTotal, oldFlags; - Tcl_Size oldLength, oldRemoved; + int inEofChar, skip, copiedTotal, oldFlags, oldRemoved; + Tcl_Size oldLength; Tcl_Encoding encoding; char *dst, *dstEnd, *eol, *eof; Tcl_EncodingState oldState; @@ -4995,13 +4986,11 @@ Tcl_GetsObj( UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) && gs.bytesWrote == 0) { - if (bufPtr->nextRemoved != oldRemoved) { - bufPtr->nextRemoved = oldRemoved; - ResetFlag(statePtr, CHANNEL_ENCODING_ERROR); - } + bufPtr->nextRemoved = oldRemoved; Tcl_SetErrno(EILSEQ); copiedTotal = -1; } + ResetFlag(statePtr, CHANNEL_ENCODING_ERROR); return copiedTotal; } @@ -5463,7 +5452,8 @@ FilterInputBytes( if (result == TCL_CONVERT_UNKNOWN || result == TCL_CONVERT_SYNTAX) { SetFlag(statePtr, CHANNEL_ENCODING_ERROR); - ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF); + ResetFlag(statePtr, CHANNEL_STICKY_EOF); + ResetFlag(statePtr, CHANNEL_EOF); result = TCL_OK; } @@ -5931,14 +5921,15 @@ DoReadChars( /* State info for channel */ ChannelBuffer *bufPtr; Tcl_Size copied; - int result, copiedNow; + int result; Tcl_Encoding encoding = statePtr->encoding; int binaryMode; #define UTF_EXPANSION_FACTOR 1024 int factor = UTF_EXPANSION_FACTOR; if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { - /* TODO: We don't need this call? */ + ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR); + /* TODO: UpdateInterest not needed here? */ UpdateInterest(chanPtr); Tcl_SetErrno(EILSEQ); return -1; @@ -5955,7 +5946,7 @@ DoReadChars( assert(statePtr->inputEncodingFlags & TCL_ENCODING_END); assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR)); - /* TODO: We don't need this call? */ + /* TODO: UpdateInterest not needed here? */ UpdateInterest(chanPtr); return 0; } @@ -5969,7 +5960,7 @@ DoReadChars( } ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; - /* TODO: We don't need this call? */ + /* TODO: UpdateInterest not needed here? */ UpdateInterest(chanPtr); return 0; } @@ -6007,7 +5998,7 @@ DoReadChars( ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF); statePtr->inputEncodingFlags &= ~TCL_ENCODING_END; for (copied = 0; toRead > 0 || toRead == TCL_INDEX_NONE; ) { - copiedNow = -1; + int copiedNow = -1; if (statePtr->inQueueHead != NULL) { if (binaryMode) { copiedNow = ReadBytes(statePtr, objPtr, toRead); @@ -6016,7 +6007,7 @@ DoReadChars( } /* - * If the current buffer is empty recycle it. + * Recycle current buffer if empty. */ bufPtr = statePtr->inQueueHead; @@ -6114,10 +6105,9 @@ finish: * succesfully red before the error. Return an error so that callers * like [read] can also return an error. */ + ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR); Tcl_SetErrno(EILSEQ); - if (!copied) { - copied = -1; - } + copied = -1; } TclChannelRelease((Tcl_Channel)chanPtr); return copied; @@ -7608,32 +7598,6 @@ Tcl_InputBuffered( return bytesBuffered; } - -/* - *---------------------------------------------------------------------- - * - * TclInputEncodingError -- - * - * Returns 1 if input is in an encoding error position, 0 otherwise. - * - * Results: - * 0 or 1, always. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -TclInputEncodingError( - Tcl_Channel chan) /* Is this channel blocked? */ -{ - ChannelState *statePtr = ((Channel *) chan)->state; - /* State of real channel structure. */ - - return GotFlag(statePtr, CHANNEL_ENCODING_ERROR) ? 1 : 0; -} /* *---------------------------------------------------------------------- @@ -10014,8 +9978,7 @@ CopyData( * - EOF is reached on the channel; or * - the channel is non-blocking, and we've read all we can * without blocking. - * - a channel reading error occurs (and we return TCL_INDEX_NONE - * or - in case of encoding error - the data so far) + * - a channel reading error occurs (and we return TCL_INDEX_NONE) * * Side effects: * May cause input to be buffered. diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 4cf4631..93c50ec 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -304,7 +304,7 @@ Tcl_GetsObjCmd( TclChannelPreserve(chan); TclNewObj(linePtr); lineLen = Tcl_GetsObj(chan, linePtr); - if (lineLen == TCL_INDEX_NONE) { + if (lineLen == TCL_IO_FAILURE) { if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) { Tcl_DecrRefCount(linePtr); @@ -323,7 +323,7 @@ Tcl_GetsObjCmd( code = TCL_ERROR; goto done; } - lineLen = TCL_INDEX_NONE; + lineLen = TCL_IO_FAILURE; } if (objc == 3) { if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr, @@ -432,7 +432,7 @@ Tcl_ReadObjCmd( TclNewObj(resultPtr); TclChannelPreserve(chan); charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0); - if (charactersRead == TCL_INDEX_NONE) { + if (charactersRead == TCL_IO_FAILURE) { Tcl_DecrRefCount(resultPtr); /* * TIP #219. @@ -446,15 +446,6 @@ Tcl_ReadObjCmd( "error reading \"%s\": %s", TclGetString(chanObjPtr), Tcl_PosixError(interp))); } - goto readError; - } else if (TclInputEncodingError(chan)) { - Tcl_Obj *returnOpts = Tcl_NewDictObj(); - Tcl_DictObjPut(NULL, returnOpts, Tcl_NewStringObj("-data", TCL_INDEX_NONE), resultPtr); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "error reading \"%s\": %s", - TclGetString(chanObjPtr), Tcl_PosixError(interp))); - Tcl_SetReturnOptions(interp, returnOpts); - readError: TclChannelRelease(chan); return TCL_ERROR; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 03d3e22..436384e 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3224,7 +3224,6 @@ MODULE_SCOPE void TclInitNamespaceSubsystem(void); MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); -MODULE_SCOPE int TclInputEncodingError(Tcl_Channel chan); MODULE_SCOPE int TclIsDigitProc(int byte); MODULE_SCOPE int TclIsBareword(int byte); MODULE_SCOPE Tcl_Obj * TclJoinPath(Tcl_Size elements, Tcl_Obj * const objv[], diff --git a/tests/encoding.test b/tests/encoding.test index 17bf6f5..506ab2c 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -464,7 +464,10 @@ test encoding-15.24 {UtfToUtfProc CESU-8 bug [048dd20b4171c8da]} { test encoding-15.25 {UtfToUtfProc CESU-8} { encoding convertfrom cesu-8 \x00 } \x00 -test encoding-15.26 {UtfToUtfProc CESU-8} { +test {encoding-15.26 cesu-8 tclnull strict} {UtfToUtfProc CESU-8} { + encoding convertfrom -profile tcl8 cesu-8 \xC0\x80 +} \x00 +test {encoding-15.26 cesu-8 tclnull tcl8} {UtfToUtfProc CESU-8} { encoding convertfrom -profile tcl8 cesu-8 \xC0\x80 } \x00 test encoding-15.27 {UtfToUtfProc -profile strict CESU-8} { @@ -562,24 +565,35 @@ test encoding-16.18 { return done } [namespace current]] } -result done -test encoding-16.19 {Utf16ToUtfProc, bug [d19fe0a5b]} -body { +test {encoding-16.19 strict} {Utf16ToUtfProc, bug [d19fe0a5b]} -body { + encoding convertfrom -profile strict utf-16 "\x41\x41\x41" +} -returnCodes 1 -result {unexpected byte sequence starting at index 2: '\x41'} +test {encoding-16.19 tcl8} {Utf16ToUtfProc, bug [d19fe0a5b]} -body { encoding convertfrom -profile tcl8 utf-16 "\x41\x41\x41" } -result \u4141\uFFFD -test encoding-16.20 {Utf16ToUtfProc, bug [d19fe0a5b]} -constraints deprecated -body { +test encoding-16.20 {utf16ToUtfProc, bug [d19fe0a5b]} \ + -constraints deprecated -body { encoding convertfrom utf-16 "\xD8\xD8" } -result \uD8D8 -test encoding-16.21 {Utf32ToUtfProc, bug [d19fe0a5b]} -body { +test encoding-16.21.tcl8 {Utf32ToUtfProc, bug [d19fe0a5b]} -body { encoding convertfrom -profile tcl8 utf-32 "\x00\x00\x00\x00\x41\x41" } -result \x00\uFFFD +test encoding-16.21.strict {Utf32ToUtfProc, bug [d19fe0a5b]} -body { + encoding convertfrom -profile strict utf-32 "\x00\x00\x00\x00\x41\x41" +} -returnCodes 1 -result {unexpected byte sequence starting at index 4: '\x41'} + test encoding-16.22 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body { encoding convertfrom -profile strict utf-16le \x00\xD8 } -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'} test encoding-16.23 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body { encoding convertfrom -profile strict utf-16le \x00\xDC } -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'} -test encoding-16.24 {Utf32ToUtfProc} -body { - encoding convertfrom -profile tcl8 utf-32 "\xFF\xFF\xFF\xFF" -} -result \uFFFD +test {encoding-24.4 utf-8 invalid strict} {Parse invalid utf-8, strict} -body { + string length [encoding convertfrom -profile strict utf-8 "\xC0\x80"] +} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'} +test {encoding-24.4 utf-8 invalid tcl8} {UtfToUtfProc utf-8} { + encoding convertfrom -profile tcl8 utf-8 \xC0\x80 +} \x00 test encoding-16.25 {Utf32ToUtfProc} -body { encoding convertfrom -profile tcl8 utf-32 "\x01\x00\x00\x01" } -result \uFFFD @@ -789,16 +803,19 @@ test encoding-24.10 {Parse valid or invalid utf-8} { test encoding-24.11 {Parse valid or invalid utf-8} { string length [encoding convertfrom -profile tcl8 utf-8 "\xEF\xBF\xBF"] } 1 -test encoding-24.12 {Parse valid or invalid utf-8} -body { +test encoding-24.12 {Parse invalid utf-8} -body { encoding convertfrom -profile strict utf-8 "\xC0\x81" } -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'} -test encoding-24.13 {Parse valid or invalid utf-8} -body { +test encoding-24.13 {Parse invalid utf-8} -body { encoding convertfrom -profile strict utf-8 "\xC1\xBF" } -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC1'} -test encoding-24.14 {Parse valid or invalid utf-8} { - string length [encoding convertfrom utf-8 "\xC2\x80"] +test encoding-24.14 {Parse valid utf-8} { + expr {[encoding convertfrom utf-8 "\xC2\x80"] eq "\u80"} } 1 -test encoding-24.15 {Parse valid or invalid utf-8} -body { +test encoding-24.15.strict {Parse invalid utf-8, -profile strict} -body { + encoding convertfrom -profile strict utf-8 "Z\xE0\x80" +} -returnCodes 1 -result "unexpected byte sequence starting at index 1: '\\xE0'" +test encoding-24.15.tcl8 {Parse invalid utf-8, -profile tcl8} -body { encoding convertfrom -profile tcl8 utf-8 "Z\xE0\x80" } -result Z\xE0\u20AC test encoding-24.16 {Parse valid or invalid utf-8} -constraints testbytestring -body { @@ -855,7 +872,7 @@ test encoding-24.31 {Parse invalid utf-8 with -profile tcl8} -body { test encoding-24.32 {Try to generate invalid utf-8} -body { encoding convertto utf-8 \uFFFF } -result \xEF\xBF\xBF -test encoding-24.33 {Try to generate noncharacter with -profile strict} -body { +test encoding-24.33 {Try to generate invalid utf-8} -body { encoding convertto -profile strict utf-8 \uFFFF } -result \xEF\xBF\xBF test encoding-24.34 {Try to generate invalid utf-8 with -profile tcl8} -body { -- cgit v0.12 From 92e4f94605891677aa7a8930d05c63eb220add80 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 29 May 2023 12:11:30 +0000 Subject: Basic implementation of TIP 670 --- library/foreachline.tcl | 22 ++++++++++++++++++++++ library/readfile.tcl | 23 +++++++++++++++++++++++ library/tclIndex | 3 +++ library/writefile.tcl | 36 ++++++++++++++++++++++++++++++++++++ 4 files changed, 84 insertions(+) create mode 100644 library/foreachline.tcl create mode 100644 library/readfile.tcl create mode 100644 library/writefile.tcl diff --git a/library/foreachline.tcl b/library/foreachline.tcl new file mode 100644 index 0000000..d619104 --- /dev/null +++ b/library/foreachline.tcl @@ -0,0 +1,22 @@ +# foreachLine: +# Iterate over the contents of a file, a line at a time. +# The body script is run for each, with variable varName set to the line +# contents. +# +# Copyright © 2023 Donal K Fellows. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# + +proc foreachLine {filename varName body} { + upvar 1 $varName line + set f [open $filename "r"] + try { + while {[gets $f line] >= 0} { + uplevel 1 $body + } + } finally { + close $f + } +} diff --git a/library/readfile.tcl b/library/readfile.tcl new file mode 100644 index 0000000..350bcd4 --- /dev/null +++ b/library/readfile.tcl @@ -0,0 +1,23 @@ +# readFile: +# Read the contents of a file. +# +# Copyright © 2023 Donal K Fellows. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# + +proc readFile {filename {mode text}} { + # Parse the arguments + set MODES {binary text} + set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]] + set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode] + + # Read the file + set f [open $filename [expr {$mode eq "text" ? "r" : "rb"}]] + try { + return [read $f] + } finally { + close $f + } +} diff --git a/library/tclIndex b/library/tclIndex index a8db3cb..8fd5a89 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -19,6 +19,7 @@ set auto_index(::auto_mkindex_parser::childhook) [list ::tcl::Pkg::source [file set auto_index(::auto_mkindex_parser::command) [list ::tcl::Pkg::source [file join $dir auto.tcl]] 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(foreachLine) [list ::tcl::Pkg::source [file join $dir foreachline.tcl]] set auto_index(history) [list ::tcl::Pkg::source [file join $dir history.tcl]] set auto_index(::tcl::HistAdd) [list ::tcl::Pkg::source [file join $dir history.tcl]] set auto_index(::tcl::HistKeep) [list ::tcl::Pkg::source [file join $dir history.tcl]] @@ -34,6 +35,7 @@ set auto_index(tclPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.t set auto_index(::tcl::MacOSXPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]] set auto_index(::pkg::create) [list ::tcl::Pkg::source [file join $dir package.tcl]] set auto_index(parray) [list ::tcl::Pkg::source [file join $dir parray.tcl]] +set auto_index(readFile) [list ::tcl::Pkg::source [file join $dir readfile.tcl]] set auto_index(::safe::InterpStatics) [list ::tcl::Pkg::source [file join $dir safe.tcl]] set auto_index(::safe::InterpNested) [list ::tcl::Pkg::source [file join $dir safe.tcl]] set auto_index(::safe::interpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]] @@ -67,6 +69,7 @@ set auto_index(tcl_wordBreakBefore) [list ::tcl::Pkg::source [file join $dir wor set auto_index(tcl_endOfWord) [list ::tcl::Pkg::source [file join $dir word.tcl]] set auto_index(tcl_startOfNextWord) [list ::tcl::Pkg::source [file join $dir word.tcl]] set auto_index(tcl_startOfPreviousWord) [list ::tcl::Pkg::source [file join $dir word.tcl]] +set auto_index(writeFile) [list ::tcl::Pkg::source [file join $dir writefile.tcl]] set auto_index(::tcl::tm::add) [list ::tcl::Pkg::source [file join $dir tm.tcl]] set auto_index(::tcl::tm::remove) [list ::tcl::Pkg::source [file join $dir tm.tcl]] set auto_index(::tcl::tm::list) [list ::tcl::Pkg::source [file join $dir tm.tcl]] diff --git a/library/writefile.tcl b/library/writefile.tcl new file mode 100644 index 0000000..ca3bbcc --- /dev/null +++ b/library/writefile.tcl @@ -0,0 +1,36 @@ +# writeFile: +# Write the contents of a file. +# +# Copyright © 2023 Donal K Fellows. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# + +proc writeFile {args} { + # Parse the arguments + switch [llength $args] { + 2 { + lassign $args filename data + set mode text + } + 3 { + lassign $args filename mode data + set MODES {binary text} + set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]] + set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode] + } + default { + return -code error -errorcode {TCL WRONGARGS} \ + "wrong # args: should be \"[lindex [info level 0] 0] filename ?mode? data\"" + } + } + + # Write the file + set f [open $filename [expr {$mode eq "text" ? "w" : "wb"}]] + try { + puts -nonewline $f $data + } finally { + close $f + } +} -- cgit v0.12 From 07f73b212befdc5ca59e4c7c7582f86fbc2b50aa Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 30 May 2023 08:39:23 +0000 Subject: Added docs --- doc/library.n | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/doc/library.n b/doc/library.n index 8aa8af7..ce1174c 100644 --- a/doc/library.n +++ b/doc/library.n @@ -25,6 +25,11 @@ auto_execok, auto_import, auto_load, auto_mkindex, auto_qualify, auto_reset, tcl \fBtcl_startOfPreviousWord \fIstr start\fR \fBtcl_wordBreakAfter \fIstr start\fR \fBtcl_wordBreakBefore \fIstr start\fR +.VS "Tcl 8.7, TIP 670" +\fBforeachLine \fIfilename varName body\fR +\fBreadFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR? +\fBwriteFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR? \fIcontents\fR +.VE "Tcl 8.7, TIP 670" .BE .SH INTRODUCTION .PP @@ -240,6 +245,38 @@ Returns the index of the first word boundary before the starting index boundaries before the starting point in the given string. The index returned refers to the second character of the pair that comprises a boundary. +.TP +\fBforeachLine \fIfilename varName body\fR +.VS "Tcl 8.7, TIP 670" +This reads in the text file named \fIfilename\fR one line at a time +(using system defaults for reading text files). It writes that line to the +variable named by \fIvarName\fR and then executes \fIbody\fR for that line. +The result value of \fIbody\fR is ignored, but \fBerror\fR, \fBreturn\fR, +\fBbreak\fR and \fBcontinue\fR may be used within it. +The overall result of \fBforeachLine\fR is the empty string; the file will be +closed prior to the procedure returning. +.VE "Tcl 8.7, TIP 670" +.TP +\fBreadFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR? +.VS "Tcl 8.7, TIP 670" +Reads in the file named in \fIfilename\fR and returns its contents. +The second argument says how to read in the file, either as \fBtext\fR +(using the system defaults for reading text files) or as \fBbinary\fR +(as uninterpreted bytes). The default is \fBtext\fR. When read as text, this +will include any trailing newline. +The file will be closed prior to the procedure returning. +.VE "Tcl 8.7, TIP 670" +.TP +\fBwriteFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR? \fIcontents\fR +.VS "Tcl 8.7, TIP 670" +Writes the \fIcontents\fR to the file named in \fIfilename\fR. +The optional second argument says how to write to the file, either as +\fBtext\fR (using the system defaults for writing text files) or as +\fBbinary\fR (as uninterpreted bytes). The default is \fBtext\fR. +If a trailing newline is required, it will need to be provided in +\fIcontents\fR. The result of this command is the empty string; the file will +be closed prior to the procedure returning. +.VE "Tcl 8.7, TIP 670" .SH "VARIABLES" .PP The following global variables are defined or used by the procedures in -- cgit v0.12 From b98da201c52dbb581e9c9604e2f9d81ed0ec73af Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 30 May 2023 11:59:21 +0000 Subject: start of test cases --- tests/ioCmd.test | 197 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 196 insertions(+), 1 deletion(-) diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 678700f..1eedcb1 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -1,6 +1,7 @@ # -*- tcl -*- # Commands covered: open, close, gets, read, puts, seek, tell, eof, flush, -# fblocked, fconfigure, open, channel, fcopy +# fblocked, fconfigure, open, channel, fcopy, +# readFile, writeFile, foreachLine # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and @@ -3927,6 +3928,200 @@ test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -mat } -constraints {testchannel thread notValgrind} \ -result {Owner lost} +# Tests of readFile + +set BIN_DATA "\u0000\u0001\u0002\u0003\u0004\u001a\u001b\u000d\u000a\u0000" + +test iocmd.readFile-1.1 "readFile procedure: syntax" -body { + readFile +} -returnCodes error -result {wrong # args: should be "readFile filename ?mode?"} +test iocmd.readFile-1.2 "readFile procedure: syntax" -body { + readFile a b c +} -returnCodes error -result {wrong # args: should be "readFile filename ?mode?"} +test iocmd.readFile-1.3 "readFile procedure: syntax" -body { + readFile gorp gorp2 +} -returnCodes error -result {bad mode "gorp2": must be binary or text} + +test iocmd.readFile-2.1 "readFile procedure: behaviour" -setup { + set f [makeFile readFile21.txt "File\nContents"] +} -body { + readFile $f +} -cleanup { + removeFile $f +} -result "File\nContents\n" +test iocmd.readFile-2.2 "readFile procedure: behaviour" -setup { + set f [makeFile readFile22.txt "File\nContents"] +} -body { + readFile $f text +} -cleanup { + removeFile $f +} -result "File\nContents\n" +test iocmd.readFile-2.3 "readFile procedure: behaviour" -setup { + set f [makeFile readFile23.bin ""] + apply {filename { + set ff [open $filename wb] + puts -nonewline $ff $BIN_DATA + close $ff + }} $f +} -body { + list [binary scan [readFile $f binary] c* x] $x +} -cleanup { + removeFile $f +} -result {1 {0 1 2 3 4 26 27 13 10 0}} +# Need to set up ahead of the test +set f [makeFile readFile24.txt ""] +removeFile $f +test iocmd.readFile-2.4 "readFile procedure: behaviour" -body { + readFile $f +} -returnCodes error -result "couldn't open \"$f\": no such file or directory" + +# Tests of writeFile + +test iocmd.writeFile-1.1 "writeFile procedure: syntax" -body { + writeFile +} -returnCodes error -result {wrong # args: should be "writeFile filename ?mode? data"} +test iocmd.writeFile-1.2 "writeFile procedure: syntax" -body { + writeFile a b c d +} -returnCodes error -result {wrong # args: should be "writeFile filename ?mode? data"} +test iocmd.writeFile-1.3 "writeFile procedure: syntax" -body { + writeFile gorp gorp2 gorp3 +} -returnCodes error -result {bad mode "gorp2": must be binary or text} + +test iocmd.writeFile-2.1 "readFile procedure: behaviour" -setup { + set f [makeFile writeFile21.txt ""] + removeFile $f +} -body { + list [writeFile $f "File\nContents\n"] [apply {filename { + set f [open $filename] + set text [read $f] + close $f + return $text + }} $f] +} -cleanup { + removeFile $f +} -result [list {} "File\nContents\n"] +test iocmd.writeFile-2.2 "readFile procedure: behaviour" -setup { + set f [makeFile writeFile22.txt ""] + removeFile $f +} -body { + writeFile $f text "File\nContents\n" + apply {filename { + set f [open $filename] + set text [read $f] + close $f + return $text + }} $f +} -cleanup { + removeFile $f +} -result "File\nContents\n" +test iocmd.writeFile-2.3 "readFile procedure: behaviour" -setup { + set f [makeFile writeFile23.txt ""] + removeFile $f +} -body { + writeFile $f binary $BIN_DATA + apply {filename { + set f [open $filename rb] + set bytes [read $f] + close $f + binary scan $bytes c* x + return $x + }} $f +} -cleanup { + removeFile $f +} -result {0 1 2 3 4 26 27 13 10 0} + +# Tests of foreachLine + +test iocmd.foreachLine-1.1 "foreachLine procedure: syntax" -returnCodes error -body { + foreachLine +} -result {wrong # args: should be "foreachLine filename varName body"} +test iocmd.foreachLine-1.2 "foreachLine procedure: syntax" -returnCodes error -body { + foreachLine a b c d +} -result {wrong # args: should be "foreachLine filename varName body"} +test iocmd.foreachLine-1.3 "foreachLine procedure: syntax" -setup { + set f [makeFile foreachLine13.txt ""] +} -body { + apply {filename { + array set b {1 1} + foreachLine $filename b {} + }} $f +} -cleanup { + removeFile $f +} -returnCodes error -result {can't set "line": variable is array} + +test iocmd.foreachLine-2.1 "foreachLine procedure: behaviour" -setup { + set f [makeFile foreachLine21.txt "a\nb\nc"] +} -body { + apply {filename { + set lines {} + foreachLine $filename v { + lappend lines $v + } + }} $f +} -cleanup { + removeFile $f +} -result {a b c} +test iocmd.foreachLine-2.2 "foreachLine procedure: behaviour" -setup { + set f [makeFile foreachLine22.txt "a\nbb\nc\ndd"] +} -body { + apply {filename { + set lines {} + foreachLine $filename v { + if {[string length $v] == 1} continue + lappend lines $v + } + return $lines + }} $f +} -cleanup { + removeFile $f +} -result {bb dd} +test iocmd.foreachLine-2.3 "foreachLine procedure: behaviour" -setup { + set f [makeFile foreachLine23.txt "a\nbb\nccc\ndd\ne"] +} -body { + apply {filename { + set lines {} + foreachLine $filename v { + if {[string length $v] > 2} break + lappend lines $v + } + return $lines + }} $f +} -cleanup { + removeFile $f +} -result {a bb} +test iocmd.foreachLine-2.4 "foreachLine procedure: behaviour" -setup { + set f [makeFile foreachLine24.txt "a\nbb\nccc\ndd\ne"] +} -body { + apply {filename { + set lines {} + foreachLine $filename v { + if {[string length $v] > 2} { + return $v + } + lappend lines $v + } + return $lines + }} $f +} -cleanup { + removeFile $f +} -result {ccc} +test iocmd.foreachLine-2.5 "foreachLine procedure: behaviour" -setup { + set f [makeFile foreachLine25.txt "a\nbb\nccc\ndd\ne"] +} -body { + apply {filename { + set lines {} + foreachLine $filename v { + if {[string length $v] > 2} { + error "line too long" + } + lappend lines $v + } + return $lines + }} $f +} -cleanup { + removeFile $f +} -returnCodes error -result {line too long} + # ### ### ### ######### ######### ######### # ### ### ### ######### ######### ######### -- cgit v0.12 From cc0a37c8b15ef75df258cd833823dae892c69507 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 30 May 2023 12:41:58 +0000 Subject: fix whitespace --- tests/ioCmd.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 1eedcb1..c7f58e6 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -4109,7 +4109,7 @@ test iocmd.foreachLine-2.5 "foreachLine procedure: behaviour" -setup { set f [makeFile foreachLine25.txt "a\nbb\nccc\ndd\ne"] } -body { apply {filename { - set lines {} + set lines {} foreachLine $filename v { if {[string length $v] > 2} { error "line too long" -- cgit v0.12 From d3acda84955821249bc38d697afe3cc890ac1bf2 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 30 May 2023 13:48:53 +0000 Subject: Get return stack correct when doing [return -code error] in the body --- library/foreachline.tcl | 3 +++ 1 file changed, 3 insertions(+) diff --git a/library/foreachline.tcl b/library/foreachline.tcl index d619104..06ad62a 100644 --- a/library/foreachline.tcl +++ b/library/foreachline.tcl @@ -16,6 +16,9 @@ proc foreachLine {filename varName body} { while {[gets $f line] >= 0} { uplevel 1 $body } + } on return {msg opt} { + dict incr opt -level + return -options $opt $msg } finally { close $f } -- cgit v0.12 From 38c9c34398bc61793d4794a1c4dadb3a36f23847 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 31 May 2023 10:33:01 +0000 Subject: Swapped foreachLine arg order, improved docs --- doc/library.n | 9 ++++++--- library/foreachline.tcl | 2 +- library/readfile.tcl | 2 +- library/writefile.tcl | 5 +++-- 4 files changed, 11 insertions(+), 7 deletions(-) diff --git a/doc/library.n b/doc/library.n index ce1174c..984dc8a 100644 --- a/doc/library.n +++ b/doc/library.n @@ -246,14 +246,17 @@ boundaries before the starting point in the given string. The index returned refers to the second character of the pair that comprises a boundary. .TP -\fBforeachLine \fIfilename varName body\fR +\fBforeachLine \fIvarName filename body\fR .VS "Tcl 8.7, TIP 670" This reads in the text file named \fIfilename\fR one line at a time (using system defaults for reading text files). It writes that line to the variable named by \fIvarName\fR and then executes \fIbody\fR for that line. The result value of \fIbody\fR is ignored, but \fBerror\fR, \fBreturn\fR, -\fBbreak\fR and \fBcontinue\fR may be used within it. -The overall result of \fBforeachLine\fR is the empty string; the file will be +\fBbreak\fR and \fBcontinue\fR may be used within it to produce an error, +return from the calling context, stop the loop, or go to the next line +respectively. +The overall result of \fBforeachLine\fR is the empty string (assuming no +errors from I/O or from evaluating the body of the loop); the file will be closed prior to the procedure returning. .VE "Tcl 8.7, TIP 670" .TP diff --git a/library/foreachline.tcl b/library/foreachline.tcl index 06ad62a..aacbd5b 100644 --- a/library/foreachline.tcl +++ b/library/foreachline.tcl @@ -9,7 +9,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -proc foreachLine {filename varName body} { +proc foreachLine {varName filename body} { upvar 1 $varName line set f [open $filename "r"] try { diff --git a/library/readfile.tcl b/library/readfile.tcl index 350bcd4..c1d5b84 100644 --- a/library/readfile.tcl +++ b/library/readfile.tcl @@ -14,7 +14,7 @@ proc readFile {filename {mode text}} { set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode] # Read the file - set f [open $filename [expr {$mode eq "text" ? "r" : "rb"}]] + set f [open $filename [dict get {text r binary rb} $mode]] try { return [read $f] } finally { diff --git a/library/writefile.tcl b/library/writefile.tcl index ca3bbcc..fbd9138 100644 --- a/library/writefile.tcl +++ b/library/writefile.tcl @@ -21,13 +21,14 @@ proc writeFile {args} { set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode] } default { + set COMMAND [lindex [info level 0] 0] return -code error -errorcode {TCL WRONGARGS} \ - "wrong # args: should be \"[lindex [info level 0] 0] filename ?mode? data\"" + "wrong # args: should be \"$COMMAND filename ?mode? data\"" } } # Write the file - set f [open $filename [expr {$mode eq "text" ? "w" : "wb"}]] + set f [open $filename [dict get {text w binary wb} $mode]] try { puts -nonewline $f $data } finally { -- cgit v0.12 From 18961ef11c430806656055c71158e9ac2e39e13e Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 31 May 2023 10:39:28 +0000 Subject: swap foreachLine argument order in tests --- tests/ioCmd.test | 45 ++++++++++++++++++++++++++------------------- 1 file changed, 26 insertions(+), 19 deletions(-) diff --git a/tests/ioCmd.test b/tests/ioCmd.test index c7f58e6..7138ecd 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -4034,28 +4034,35 @@ test iocmd.writeFile-2.3 "readFile procedure: behaviour" -setup { test iocmd.foreachLine-1.1 "foreachLine procedure: syntax" -returnCodes error -body { foreachLine -} -result {wrong # args: should be "foreachLine filename varName body"} +} -result {wrong # args: should be "foreachLine varName filename body"} test iocmd.foreachLine-1.2 "foreachLine procedure: syntax" -returnCodes error -body { foreachLine a b c d -} -result {wrong # args: should be "foreachLine filename varName body"} -test iocmd.foreachLine-1.3 "foreachLine procedure: syntax" -setup { +} -result {wrong # args: should be "foreachLine varName filename body"} +test iocmd.foreachLine-1.3 "foreachLine procedure: basic errors" -setup { set f [makeFile foreachLine13.txt ""] } -body { apply {filename { array set b {1 1} - foreachLine $filename b {} + foreachLine b $filename {} }} $f } -cleanup { removeFile $f } -returnCodes error -result {can't set "line": variable is array} +set f [makeFile foreachLine14.txt ""] +removeFile $f +test iocmd.foreachLine-1.4 "foreachLine procedure: basic errors" -body { + apply {filename { + foreachLine var $filename {} + }} $f +} -returnCodes error -result "couldn't open \"$f\": no such file or directory" test iocmd.foreachLine-2.1 "foreachLine procedure: behaviour" -setup { set f [makeFile foreachLine21.txt "a\nb\nc"] } -body { apply {filename { set lines {} - foreachLine $filename v { - lappend lines $v + foreachLine var $filename { + lappend lines $var } }} $f } -cleanup { @@ -4066,9 +4073,9 @@ test iocmd.foreachLine-2.2 "foreachLine procedure: behaviour" -setup { } -body { apply {filename { set lines {} - foreachLine $filename v { - if {[string length $v] == 1} continue - lappend lines $v + foreachLine var $filename { + if {[string length $var] == 1} continue + lappend lines $var } return $lines }} $f @@ -4080,9 +4087,9 @@ test iocmd.foreachLine-2.3 "foreachLine procedure: behaviour" -setup { } -body { apply {filename { set lines {} - foreachLine $filename v { - if {[string length $v] > 2} break - lappend lines $v + foreachLine var $filename { + if {[string length $var] > 2} break + lappend lines $var } return $lines }} $f @@ -4094,11 +4101,11 @@ test iocmd.foreachLine-2.4 "foreachLine procedure: behaviour" -setup { } -body { apply {filename { set lines {} - foreachLine $filename v { - if {[string length $v] > 2} { - return $v + foreachLine var $filename { + if {[string length $var] > 2} { + return $var } - lappend lines $v + lappend lines $var } return $lines }} $f @@ -4110,11 +4117,11 @@ test iocmd.foreachLine-2.5 "foreachLine procedure: behaviour" -setup { } -body { apply {filename { set lines {} - foreachLine $filename v { - if {[string length $v] > 2} { + foreachLine var $filename { + if {[string length $var] > 2} { error "line too long" } - lappend lines $v + lappend lines $var } return $lines }} $f -- cgit v0.12 From 28a15ce481fd0e4b90f5904a64c80aa1d4266c97 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 15 Jun 2023 15:44:04 +0000 Subject: TIP #653 implementation (with a lot of corrections compared to the py-b8f575aa23 or the other tip-653 branch) --- generic/tclIOCmd.c | 5 ++++- tests/io.test | 33 +++++++++++++++++---------------- 2 files changed, 21 insertions(+), 17 deletions(-) diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 5a0a8da..f93f11e 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -459,7 +459,9 @@ Tcl_ReadObjCmd( TclChannelPreserve(chan); charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0); if (charactersRead == TCL_IO_FAILURE) { - Tcl_DecrRefCount(resultPtr); + Tcl_Obj *returnOptsPtr = Tcl_NewDictObj(); + Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-data", -1), + resultPtr); /* * TIP #219. * Capture error messages put by the driver into the bypass area and @@ -473,6 +475,7 @@ Tcl_ReadObjCmd( TclGetString(chanObjPtr), Tcl_PosixError(interp))); } TclChannelRelease(chan); + Tcl_SetReturnOptions(interp, returnOptsPtr); return TCL_ERROR; } diff --git a/tests/io.test b/tests/io.test index 54ccaac..bc03656 100644 --- a/tests/io.test +++ b/tests/io.test @@ -9208,12 +9208,13 @@ test io-75.7 { fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf \ -profile strict } -body { - list [catch {read $f} msg] $msg + list [catch {read $f} msg data] $msg [dict get $data -data] } -cleanup { close $f removeFile io-75.7 + unset msg data } -match glob -result {1 {error reading "file*":\ - invalid or incomplete multibyte or wide character}} + invalid or incomplete multibyte or wide character} A} test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup { set fn [makeFile {} io-75.8] @@ -9249,18 +9250,17 @@ test io-75.8.eoflater {invalid utf-8 encoding eof handling (-profile strict)} -s fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \ -translation lf -profile strict } -body { - set res [list [catch {read $f} cres] [eof $f]] + set res [list [catch {read $f} msg data] [eof $f] [dict get $data -data]] chan configure $f -encoding iso8859-1 lappend res [read $f 1] chan configure $f -encoding utf-8 - catch {read $f 1} cres - lappend res $cres + lappend res [catch {read $f 1} msg data] $msg [dict get $data -data] close $f set res } -cleanup { removeFile io-75.8 -} -match glob -result "1 0 \x81 {error reading \"*\":\ - invalid or incomplete multibyte or wide character}" +} -match glob -result "1 0 A \x81 1 {error reading \"*\":\ + invalid or incomplete multibyte or wide character} {}" test io-strict-multibyte-eof { @@ -9268,7 +9268,6 @@ test io-strict-multibyte-eof { See issue 25cdcb7e8fb381fb } -setup { - set res {} set chan [file tempfile]; fconfigure $chan -encoding binary puts -nonewline $chan \x81\x1A @@ -9276,12 +9275,12 @@ test io-strict-multibyte-eof { seek $chan 0 chan configure $chan -encoding utf-8 -profile strict } -body { - list [catch {read $chan 1} cres] $cres + list [catch {read $chan 1} msg data] $msg [dict get $data -data] } -cleanup { close $chan - unset res + unset msg data } -match glob -result {1 {error reading "*":\ - invalid or incomplete multibyte or wide character}} + invalid or incomplete multibyte or wide character} {}} test io-75.9 {unrepresentable character write passes and is replaced by ?} -setup { set fn [makeFile {} io-75.9] @@ -9336,12 +9335,13 @@ test io-75.11 {shiftjis encoding error read results in raw bytes} -setup { } -body { set d [read $f] binary scan $d H* hd - lappend hd [catch {set d [read $f]} msg] $msg + lappend hd [catch {set d [read $f]} msg data] $msg [dict get $data -data] } -cleanup { close $f removeFile io-75.11 + unset d hd msg data } -match glob -result {41 1 {error reading "file*":\ - invalid or incomplete multibyte or wide character}} + invalid or incomplete multibyte or wide character} {}} test io-75.12 {invalid utf-8 encoding read is ignored} -setup { set fn [makeFile {} io-75.12] @@ -9376,12 +9376,13 @@ test io-75.13 { } -body { set d [read $f] binary scan $d H* hd - lappend hd [catch {read $f} msg] $msg + lappend hd [catch {read $f} msg data] $msg [dict get $data -data] } -cleanup { close $f removeFile io-75.13 + unset d hd msg data } -match glob -result {41 1 {error reading "file*":\ - invalid or incomplete multibyte or wide character}} + invalid or incomplete multibyte or wide character} {}} test io-75.14 { [gets] succesfully returns lines prior to error @@ -9397,7 +9398,7 @@ test io-75.14 { fconfigure $chan -encoding utf-8 -buffering none -eofchar {} \ -translation auto -profile strict } -body { - lappend res [gets $chan] + set res [gets $chan] lappend res [gets $chan] lappend res [catch {gets $chan} cres] $cres chan configure $chan -profile tcl8 -- cgit v0.12 From 650c2e23a9068846462a0f97329df7f4902fca6b Mon Sep 17 00:00:00 2001 From: bch Date: Thu, 29 Jun 2023 00:02:38 +0000 Subject: speeling --- doc/chan.n | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/chan.n b/doc/chan.n index 538f86d..93c23c1 100644 --- a/doc/chan.n +++ b/doc/chan.n @@ -397,7 +397,7 @@ was already reached, and 0 otherwise. .TP \fBchan event \fIchannelName event\fR ?\fIscript\fR? . -Arranges for the given script, called a \fBchannel event hndler\fR, to be +Arranges for the given script, called a \fBchannel event handler\fR, to be called whenever the given event, one of .QW \fBreadable\fR or -- cgit v0.12 From 77e78fb5371da671e9e19f7b2e86df5b78204e9d Mon Sep 17 00:00:00 2001 From: bch Date: Thu, 29 Jun 2023 00:09:52 +0000 Subject: ws --- generic/tcl.h | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index b43fcec..d004af7 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1370,14 +1370,12 @@ typedef struct Tcl_ChannelType { * type. */ Tcl_ChannelTypeVersion version; /* Version of the channel type. */ - void *closeProc; - /* Not used any more. */ + void *closeProc; /* Not used any more. */ Tcl_DriverInputProc *inputProc; /* Function to call for input on channel. */ Tcl_DriverOutputProc *outputProc; /* Function to call for output on channel. */ - void *seekProc; - /* Not used any more. */ + void *seekProc; /* Not used any more. */ Tcl_DriverSetOptionProc *setOptionProc; /* Set an option on a channel. */ Tcl_DriverGetOptionProc *getOptionProc; -- cgit v0.12 From e3a6968b93006d08f0e1dd834826e5f4b37fbd1a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 14 Jul 2023 11:13:30 +0000 Subject: Use "strict" in almost all commands. Only "glob" and environment variables are left out. (Experimental) --- generic/tclIOSock.c | 12 ++++- generic/tclZipfs.c | 12 ++++- tests/encoding.test | 2 +- tests/utfext.test | 6 +-- unix/tclLoadDl.c | 12 ++++- unix/tclUnixFCmd.c | 138 ++++++++++++++++++++++++++++++++++++---------------- unix/tclUnixFile.c | 70 ++++++++++++++++++++------ unix/tclUnixPipe.c | 23 +++++++-- win/tclWinPipe.c | 11 +++-- 9 files changed, 211 insertions(+), 75 deletions(-) diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index c6cef55..47fde36 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -75,7 +75,11 @@ TclSockGetPort( * Don't bother translating 'proto' to native. */ - native = Tcl_UtfToExternalDString(NULL, string, -1, &ds); + if (Tcl_UtfToExternalDStringEx(interp, NULL, string, -1, 0, &ds, NULL) != TCL_OK) { + Tcl_DStringFree(&ds); + return TCL_ERROR; + } + native = Tcl_DStringValue(&ds); sp = getservbyname(native, proto); /* INTL: Native. */ Tcl_DStringFree(&ds); if (sp != NULL) { @@ -184,7 +188,11 @@ TclCreateSocketAddress( int result; if (host != NULL) { - native = Tcl_UtfToExternalDString(NULL, host, -1, &ds); + if (Tcl_UtfToExternalDStringEx(interp, NULL, host, -1, 0, &ds, NULL) != TCL_OK) { + Tcl_DStringFree(&ds); + return 0; + } + native = Tcl_DStringValue(&ds); } /* diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index e9f7157..f5749c9 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -2541,7 +2541,11 @@ ZipAddFile( * crazy enough to embed NULs in filenames, they deserve what they get! */ - zpathExt = Tcl_UtfToExternalDString(ZipFS.utf8, zpathTcl, -1, &zpathDs); + if (Tcl_UtfToExternalDStringEx(interp, ZipFS.utf8, zpathTcl, TCL_INDEX_NONE, 0, &zpathDs, NULL) != TCL_OK) { + Tcl_DStringFree(&zpathDs); + return TCL_ERROR; + } + zpathExt = Tcl_DStringValue(&zpathDs); zpathlen = strlen(zpathExt); if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -3210,7 +3214,11 @@ ZipFSMkZipOrImg( } z = (ZipEntry *) Tcl_GetHashValue(hPtr); - name = Tcl_UtfToExternalDString(ZipFS.utf8, z->name, TCL_INDEX_NONE, &ds); + if (Tcl_UtfToExternalDStringEx(interp, ZipFS.utf8, z->name, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + ret = TCL_ERROR; + goto done; + } + name = Tcl_DStringValue(&ds); len = Tcl_DStringLength(&ds); SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf, z, len); diff --git a/tests/encoding.test b/tests/encoding.test index c7575cb..23d6b38 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -577,7 +577,7 @@ test encoding-16.23 {Utf16ToUtfProc, strict, bug [db7a085bd9]} -body { encoding convertfrom -profile strict utf-16le \x00\xDC } -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\x00'} test encoding-16.24 {Utf32ToUtfProc} -body { - encoding convertfrom utf-32 "\xFF\xFF\xFF\xFF" + encoding convertfrom -profile tcl8 utf-32 "\xFF\xFF\xFF\xFF" } -result \uFFFD test {encoding-16.25 strict} {Utf32ToUtfProc} -body { encoding convertfrom -profile strict utf-32 "\x01\x00\x00\x01" diff --git a/tests/utfext.test b/tests/utfext.test index 1ae2374..31ac392 100644 --- a/tests/utfext.test +++ b/tests/utfext.test @@ -76,9 +76,9 @@ test xx-bufferoverflow {buffer overflow Tcl_ExternalToUtf} -body { test TableToUtf-bug-5be203d6ca {Bug 5be203d6ca - truncated prefix in table encoding} -body { set src \x82\x4F\x82\x50\x82 - lassign [testencoding Tcl_ExternalToUtf shiftjis $src {start} 0 16 srcRead dstWritten charsWritten] buf - set result [list [testencoding Tcl_ExternalToUtf shiftjis $src {start} 0 16 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten] - lappend result {*}[list [testencoding Tcl_ExternalToUtf shiftjis [string range $src $srcRead end] {end} 0 10 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten] + lassign [testencoding Tcl_ExternalToUtf shiftjis $src {start profiletcl8} 0 16 srcRead dstWritten charsWritten] buf + set result [list [testencoding Tcl_ExternalToUtf shiftjis $src {start profiletcl8} 0 16 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten] + lappend result {*}[list [testencoding Tcl_ExternalToUtf shiftjis [string range $src $srcRead end] {end profiletcl8} 0 10 srcRead dstWritten charsWritten] $srcRead $dstWritten $charsWritten] } -result [list [list multibyte 0 \xEF\xBC\x90\xEF\xBC\x91\x00\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF] 4 6 2 [list ok 0 \xC2\x82\x00\xFF\xFF\xFF\xFF\xFF\xFF\xFF] 1 2 1] diff --git a/unix/tclLoadDl.c b/unix/tclLoadDl.c index 0913698..7ba580e 100644 --- a/unix/tclLoadDl.c +++ b/unix/tclLoadDl.c @@ -108,7 +108,11 @@ TclpDlopen( Tcl_DString ds; const char *fileName = TclGetString(pathPtr); - native = Tcl_UtfToExternalDString(NULL, fileName, TCL_INDEX_NONE, &ds); + if (Tcl_UtfToExternalDStringEx(interp, NULL, fileName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + Tcl_DStringFree(&ds); + return TCL_ERROR; + } + native = Tcl_DStringValue(&ds); /* * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070] */ @@ -179,7 +183,11 @@ FindSymbol( * the underscore. */ - native = Tcl_UtfToExternalDString(NULL, symbol, TCL_INDEX_NONE, &ds); + if (Tcl_UtfToExternalDStringEx(NULL, NULL, symbol, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + Tcl_DStringFree(&ds); + return NULL; + } + native = Tcl_DStringValue(&ds); proc = dlsym(handle, native); /* INTL: Native. */ if (proc == NULL) { Tcl_DStringInit(&newName); diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index b260cf4..8321db9 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -762,28 +762,35 @@ TclpObjCopyDirectory( Tcl_Obj *transPtr; transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr); - Tcl_UtfToExternalDStringEx(NULL, NULL, + ret = Tcl_UtfToExternalDStringEx(NULL, NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), - -1, TCL_ENCODING_PROFILE_TCL8, &srcString, NULL); + -1, 0, &srcString, NULL); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } - transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr); - Tcl_UtfToExternalDStringEx(NULL, NULL, + if (ret != TCL_OK) { + *errorPtr = srcPathPtr; + } else { + transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr); + ret = Tcl_UtfToExternalDStringEx(NULL, NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), -1, TCL_ENCODING_PROFILE_TCL8, &dstString, NULL); - if (transPtr != NULL) { - Tcl_DecrRefCount(transPtr); + if (transPtr != NULL) { + Tcl_DecrRefCount(transPtr); + } + if (ret != TCL_OK) { + *errorPtr = destPathPtr; + } else { + ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds, 0); + /* Note above call only sets ds on error */ + if (ret != TCL_OK) { + *errorPtr = Tcl_DStringToObj(&ds); + } + Tcl_DStringFree(&dstString); + } + Tcl_DStringFree(&srcString); } - - ret = TraverseUnixTree(TraversalCopy, &srcString, &dstString, &ds, 0); - - Tcl_DStringFree(&srcString); - Tcl_DStringFree(&dstString); - if (ret != TCL_OK) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), TCL_INDEX_NONE); - Tcl_DStringFree(&ds); Tcl_IncrRefCount(*errorPtr); } return ret; @@ -826,18 +833,24 @@ TclpObjRemoveDirectory( int ret; Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); - Tcl_UtfToExternalDStringEx(NULL, NULL, + ret = Tcl_UtfToExternalDStringEx(NULL, NULL, (transPtr != NULL ? TclGetString(transPtr) : NULL), -1, TCL_ENCODING_PROFILE_TCL8, &pathString, NULL); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } - ret = DoRemoveDirectory(&pathString, recursive, &ds); - Tcl_DStringFree(&pathString); + if (ret != TCL_OK) { + *errorPtr = pathPtr; + } else { + ret = DoRemoveDirectory(&pathString, recursive, &ds); + Tcl_DStringFree(&pathString); + /* Note above call only sets ds on error */ + if (ret != TCL_OK) { + *errorPtr = Tcl_DStringToObj(&ds); + } + } if (ret != TCL_OK) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), TCL_INDEX_NONE); - Tcl_DStringFree(&ds); Tcl_IncrRefCount(*errorPtr); } return ret; @@ -886,7 +899,7 @@ DoRemoveDirectory( result = TCL_OK; if ((errno != EEXIST) || (recursive == 0)) { if (errorPtr != NULL) { - Tcl_ExternalToUtfDStringEx(NULL, NULL, path, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL); + Tcl_ExternalToUtfDStringEx(NULL, NULL, path, TCL_INDEX_NONE, 0, errorPtr, NULL); } result = TCL_ERROR; } @@ -1135,7 +1148,7 @@ TraverseUnixTree( end: if (errfile != NULL) { if (errorPtr != NULL) { - Tcl_ExternalToUtfDStringEx(NULL, NULL, errfile, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL); + Tcl_ExternalToUtfDStringEx(NULL, NULL, errfile, TCL_INDEX_NONE, 0, errorPtr, NULL); } result = TCL_ERROR; } @@ -1206,7 +1219,7 @@ TraversalCopy( if (errorPtr != NULL) { Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(dstPtr), - Tcl_DStringLength(dstPtr), TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL); + Tcl_DStringLength(dstPtr), 0, errorPtr, NULL); } return TCL_ERROR; } @@ -1257,7 +1270,7 @@ TraversalDelete( } if (errorPtr != NULL) { Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(srcPtr), - Tcl_DStringLength(srcPtr), TCL_ENCODING_PROFILE_TCL8, errorPtr, NULL); + Tcl_DStringLength(srcPtr), 0, errorPtr, NULL); } return TCL_ERROR; } @@ -1424,7 +1437,7 @@ GetOwnerAttribute( } else { Tcl_DString ds; - Tcl_ExternalToUtfDStringEx(NULL, NULL, pwPtr->pw_name, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); + Tcl_ExternalToUtfDStringEx(NULL, NULL, pwPtr->pw_name, TCL_INDEX_NONE, 0, &ds, NULL); *attributePtrPtr = Tcl_DStringToObj(&ds); } return TCL_OK; @@ -1508,7 +1521,11 @@ SetGroupAttribute( string = Tcl_GetStringFromObj(attributePtr, &length); - native = Tcl_UtfToExternalDString(NULL, string, length, &ds); + if (Tcl_UtfToExternalDStringEx(interp, NULL, string, length, 0, &ds, NULL) != TCL_OK) { + Tcl_DStringFree(&ds); + return TCL_ERROR; + } + native = Tcl_DStringValue(&ds); groupPtr = TclpGetGrNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); @@ -1575,7 +1592,11 @@ SetOwnerAttribute( string = Tcl_GetStringFromObj(attributePtr, &length); - native = Tcl_UtfToExternalDString(NULL, string, length, &ds); + if (Tcl_UtfToExternalDStringEx(interp, NULL, string, length, 0, &ds, NULL) != TCL_OK) { + Tcl_DStringFree(&ds); + return TCL_ERROR; + } + native = Tcl_DStringValue(&ds); pwPtr = TclpGetPwNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); @@ -1935,7 +1956,7 @@ GetModeFromPermString( int TclpObjNormalizePath( - TCL_UNUSED(Tcl_Interp *), + Tcl_Interp *interp, Tcl_Obj *pathPtr, /* An unshared object containing the path to * normalize. */ int nextCheckpoint) /* offset to start at in pathPtr. Must either @@ -1969,8 +1990,12 @@ TclpObjNormalizePath( const char *lastDir = strrchr(currentPathEndPosition, '/'); if (lastDir != NULL) { - nativePath = Tcl_UtfToExternalDString(NULL, path, - lastDir-path, &ds); + if (Tcl_UtfToExternalDStringEx(interp, NULL, path, + lastDir-path, 0, &ds, NULL) != TCL_OK) { + Tcl_DStringFree(&ds); + return -1; + } + nativePath = Tcl_DStringValue(&ds); if (Realpath(nativePath, normPath) != NULL) { if (*nativePath != '/' && *normPath == '/') { /* @@ -2005,8 +2030,12 @@ TclpObjNormalizePath( int accessOk; - nativePath = Tcl_UtfToExternalDString(NULL, path, - currentPathEndPosition - path, &ds); + if (Tcl_UtfToExternalDStringEx(interp, NULL, path, + currentPathEndPosition - path, 0, &ds, NULL) != TCL_OK) { + Tcl_DStringFree(&ds); + return -1; + } + nativePath = Tcl_DStringValue(&ds); accessOk = access(nativePath, F_OK); Tcl_DStringFree(&ds); @@ -2050,7 +2079,11 @@ TclpObjNormalizePath( return 0; } - nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds); + if (Tcl_UtfToExternalDStringEx(interp, NULL, path,nextCheckpoint, 0, &ds, NULL)) { + Tcl_DStringFree(&ds); + return -1; + } + nativePath = Tcl_DStringValue(&ds); if (Realpath(nativePath, normPath) != NULL) { Tcl_Size newNormLen; @@ -2086,7 +2119,7 @@ TclpObjNormalizePath( */ Tcl_DStringFree(&ds); - Tcl_ExternalToUtfDStringEx(NULL, NULL, normPath, newNormLen, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); + Tcl_ExternalToUtfDStringEx(NULL, NULL, normPath, newNormLen, 0, &ds, NULL); if (path[nextCheckpoint] != '\0') { /* @@ -2174,12 +2207,14 @@ TclUnixOpenTemporaryFile( Tcl_Size length; /* - * We should also check against making more then TMP_MAX of these. + * We should also check against making more than TMP_MAX of these. */ if (dirObj) { string = Tcl_GetStringFromObj(dirObj, &length); - Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, TCL_ENCODING_PROFILE_TCL8, &templ, NULL); + if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, 0, &templ, NULL) != TCL_OK) { + return -1; + } } else { Tcl_DStringInit(&templ); Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */ @@ -2189,7 +2224,10 @@ TclUnixOpenTemporaryFile( if (basenameObj) { string = Tcl_GetStringFromObj(basenameObj, &length); - Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, TCL_ENCODING_PROFILE_TCL8, &tmp, NULL); + if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, 0, &tmp, NULL) != TCL_OK) { + Tcl_DStringFree(&tmp); + return -1; + } TclDStringAppendDString(&templ, &tmp); Tcl_DStringFree(&tmp); } else { @@ -2201,7 +2239,10 @@ TclUnixOpenTemporaryFile( #ifdef HAVE_MKSTEMPS if (extensionObj) { string = Tcl_GetStringFromObj(extensionObj, &length); - Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, TCL_ENCODING_PROFILE_TCL8, &tmp, NULL); + if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, length, 0, &tmp, NULL) != TCL_OK) { + Tcl_DStringFree(&templ); + return -1; + } TclDStringAppendDString(&templ, &tmp); fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&tmp); @@ -2217,8 +2258,11 @@ TclUnixOpenTemporaryFile( } if (resultingNameObj) { - Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&templ), - Tcl_DStringLength(&templ), TCL_ENCODING_PROFILE_TCL8, &tmp, NULL); + if (Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&templ), + Tcl_DStringLength(&templ), 0, &tmp, NULL) != TCL_OK) { + Tcl_DStringFree(&templ); + return -1; + } Tcl_SetStringObj(resultingNameObj, Tcl_DStringValue(&tmp), Tcl_DStringLength(&tmp)); Tcl_DStringFree(&tmp); @@ -2304,7 +2348,9 @@ TclpCreateTemporaryDirectory( if (dirObj) { string = TclGetString(dirObj); - Tcl_UtfToExternalDStringEx(NULL, NULL, string, dirObj->length, TCL_ENCODING_PROFILE_TCL8, &templ, NULL); + if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, dirObj->length, 0, &templ, NULL) != TCL_OK) { + return NULL; + } } else { Tcl_DStringInit(&templ); Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */ @@ -2317,7 +2363,10 @@ TclpCreateTemporaryDirectory( if (basenameObj) { string = TclGetString(basenameObj); if (basenameObj->length) { - Tcl_UtfToExternalDStringEx(NULL, NULL, string, basenameObj->length, TCL_ENCODING_PROFILE_TCL8, &tmp, NULL); + if (Tcl_UtfToExternalDStringEx(NULL, NULL, string, basenameObj->length, 0, &tmp, NULL) != TCL_OK) { + Tcl_DStringFree(&templ); + return NULL; + } TclDStringAppendDString(&templ, &tmp); Tcl_DStringFree(&tmp); } else { @@ -2342,8 +2391,11 @@ TclpCreateTemporaryDirectory( * The template has been updated. Tell the caller what it was. */ - Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&templ), - Tcl_DStringLength(&templ), TCL_ENCODING_PROFILE_TCL8, &tmp, NULL); + if (Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&templ), + Tcl_DStringLength(&templ), 0, &tmp, NULL) != TCL_OK) { + Tcl_DStringFree(&templ); + return NULL; + } Tcl_DStringFree(&templ); return Tcl_DStringToObj(&tmp); } diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 8606960..44c3078 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -308,7 +308,13 @@ TclpMatchInDirectory( * Now open the directory for reading and iterate over the contents. */ - native = Tcl_UtfToExternalDString(NULL, dirName, TCL_INDEX_NONE, &ds); + if (Tcl_UtfToExternalDStringEx(interp, NULL, dirName, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + Tcl_DStringFree(&dsOrig); + Tcl_DStringFree(&ds); + Tcl_DecrRefCount(fileNamePtr); + return TCL_ERROR; + } + native = Tcl_DStringValue(&ds); if ((TclOSstat(native, &statBuf) != 0) /* INTL: Native. */ || !S_ISDIR(statBuf.st_mode)) { @@ -372,8 +378,12 @@ TclpMatchInDirectory( * and pattern. If so, add the file to the result. */ - utfname = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, TCL_INDEX_NONE, - &utfDs); + if (Tcl_ExternalToUtfDStringEx(interp, NULL, entryPtr->d_name, TCL_INDEX_NONE, + 0, &utfDs, NULL) != TCL_OK) { + matchResult = -1; + break; + } + utfname = Tcl_DStringValue(&utfDs); if (Tcl_StringCaseMatch(utfname, pattern, 0)) { int typeOk = 1; @@ -599,7 +609,13 @@ TclpGetUserHome( { struct passwd *pwPtr; Tcl_DString ds; - const char *native = Tcl_UtfToExternalDString(NULL, name, TCL_INDEX_NONE, &ds); + const char *native; + + if (Tcl_UtfToExternalDStringEx(NULL, NULL, name, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + Tcl_DStringFree(&ds); + return NULL; + } + native = Tcl_DStringValue(&ds); pwPtr = TclpGetPwNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); @@ -607,7 +623,11 @@ TclpGetUserHome( if (pwPtr == NULL) { return NULL; } - return Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, TCL_INDEX_NONE, bufferPtr); + if (Tcl_ExternalToUtfDStringEx(NULL, NULL, pwPtr->pw_dir, TCL_INDEX_NONE, 0, bufferPtr, NULL) != TCL_OK) { + return NULL; + } else { + return Tcl_DStringValue(bufferPtr); + } } /* @@ -785,7 +805,10 @@ TclpGetCwd( } return NULL; } - return Tcl_ExternalToUtfDString(NULL, buffer, TCL_INDEX_NONE, bufferPtr); + if (Tcl_ExternalToUtfDStringEx(interp, NULL, buffer, TCL_INDEX_NONE, 0, bufferPtr, NULL) != TCL_OK) { + return NULL; + } + return Tcl_DStringValue(bufferPtr); } /* @@ -816,11 +839,15 @@ TclpReadlink( { #ifndef DJGPP char link[MAXPATHLEN]; - ssize_t length; + Tcl_Size length; const char *native; Tcl_DString ds; - native = Tcl_UtfToExternalDString(NULL, path, TCL_INDEX_NONE, &ds); + if (Tcl_UtfToExternalDStringEx(NULL, NULL, path, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + Tcl_DStringFree(&ds); + return NULL; + } + native = Tcl_DStringValue(&ds); length = readlink(native, link, sizeof(link)); /* INTL: Native. */ Tcl_DStringFree(&ds); @@ -828,11 +855,12 @@ TclpReadlink( return NULL; } - Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, TCL_ENCODING_PROFILE_TCL8, linkPtr, NULL); - return Tcl_DStringValue(linkPtr); -#else - return NULL; + if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, length, 0, linkPtr, NULL) == TCL_OK) { + return Tcl_DStringValue(linkPtr); + } #endif /* !DJGPP */ + + return NULL; } /* @@ -962,7 +990,11 @@ TclpObjLink( return NULL; } target = Tcl_GetStringFromObj(transPtr, &length); - target = Tcl_UtfToExternalDString(NULL, target, length, &ds); + if (Tcl_UtfToExternalDStringEx(NULL, NULL, target, length, 0, &ds, NULL) != TCL_OK) { + Tcl_DStringFree(&ds); + return NULL; + } + target = Tcl_DStringValue(&ds); Tcl_DecrRefCount(transPtr); if (symlink(target, src) != 0) { @@ -997,7 +1029,9 @@ TclpObjLink( return NULL; } - Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); + if (Tcl_ExternalToUtfDStringEx(NULL, NULL, link, (size_t)length, 0, &ds, NULL) != TCL_OK) { + return NULL; + } linkPtr = Tcl_DStringToObj(&ds); Tcl_IncrRefCount(linkPtr); return linkPtr; @@ -1062,7 +1096,7 @@ TclpNativeToNormalized( { Tcl_DString ds; - Tcl_ExternalToUtfDStringEx(NULL, NULL, (const char *) clientData, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); + Tcl_ExternalToUtfDStringEx(NULL, NULL, (const char *) clientData, TCL_INDEX_NONE, 0, &ds, NULL); return Tcl_DStringToObj(&ds); } @@ -1116,7 +1150,11 @@ TclNativeCreateNativeRep( } str = Tcl_GetStringFromObj(validPathPtr, &len); - Tcl_UtfToExternalDStringEx(NULL, NULL, str, len, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); + if (Tcl_UtfToExternalDStringEx(NULL, NULL, str, len, 0, &ds, NULL) != TCL_OK) { + Tcl_DecrRefCount(validPathPtr); + Tcl_DStringFree(&ds); + return NULL; + } len = Tcl_DStringLength(&ds) + sizeof(char); if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) { /* See bug [3118489]: NUL in filenames */ diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index c1fae5d..66839a5 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -141,7 +141,11 @@ TclpOpenFile( const char *native; Tcl_DString ds; - native = Tcl_UtfToExternalDString(NULL, fname, TCL_INDEX_NONE, &ds); + if (Tcl_UtfToExternalDStringEx(NULL, NULL, fname, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + Tcl_DStringFree(&ds); + return NULL; + } + native = Tcl_DStringValue(&ds); fd = TclOSopen(native, mode, 0666); /* INTL: Native. */ Tcl_DStringFree(&ds); if (fd != -1) { @@ -198,7 +202,12 @@ TclpCreateTempFile( Tcl_DString dstring; char *native; - native = Tcl_UtfToExternalDString(NULL, contents, TCL_INDEX_NONE, &dstring); + if (Tcl_UtfToExternalDStringEx(NULL, NULL, contents, TCL_INDEX_NONE, 0, &dstring, NULL) != TCL_OK) { + close(fd); + Tcl_DStringFree(&dstring); + return NULL; + } + native = Tcl_DStringValue(&dstring); if (write(fd, native, Tcl_DStringLength(&dstring)) == -1) { close(fd); Tcl_DStringFree(&dstring); @@ -437,7 +446,15 @@ TclpCreateProcess( newArgv = (char **)TclStackAlloc(interp, (argc+1) * sizeof(char *)); newArgv[argc] = NULL; for (i = 0; i < argc; i++) { - newArgv[i] = Tcl_UtfToExternalDString(NULL, argv[i], TCL_INDEX_NONE, &dsArray[i]); + if (Tcl_UtfToExternalDStringEx(interp, NULL, argv[i], TCL_INDEX_NONE, 0, &dsArray[i], NULL) != TCL_OK) { + while (i-- > 0) { + Tcl_DStringFree(&dsArray[i]); + } + TclStackFree(interp, newArgv); + TclStackFree(interp, dsArray); + goto error; + } + newArgv[i] = Tcl_DStringValue(&dsArray[i]); } #ifdef USE_VFORK diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index d9cee73..9f889b2 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -651,7 +651,7 @@ TclpCreateTempFile( const char *contents) /* String to write into temp file, or NULL. */ { WCHAR name[MAX_PATH]; - const char *native; + const char *native = NULL; Tcl_DString dstring; HANDLE handle; @@ -679,7 +679,10 @@ TclpCreateTempFile( * Convert the contents from UTF to native encoding */ - native = Tcl_UtfToExternalDString(NULL, contents, TCL_INDEX_NONE, &dstring); + if (Tcl_UtfToExternalDStringEx(NULL, NULL, contents, TCL_INDEX_NONE, 0, &dstring, NULL) != TCL_OK) { + goto error; + } + native = Tcl_DStringValue(&dstring); toCopy = Tcl_DStringLength(&dstring); for (p = native; toCopy > 0; p++, toCopy--) { @@ -719,7 +722,9 @@ TclpCreateTempFile( Tcl_DStringFree(&dstring); } - Tcl_WinConvertError(GetLastError()); + if (native != NULL) { + Tcl_WinConvertError(GetLastError()); + } CloseHandle(handle); DeleteFileW(name); return NULL; -- cgit v0.12 From 2542a8f81ee6278e9e3fa9937483bd2183fc3548 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 19 Jul 2023 11:18:30 +0000 Subject: Somewhat better error-reporting --- generic/tclEncoding.c | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 720c2a1..8c10ab9 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -202,12 +202,12 @@ static struct TclEncodingProfiles { #define PROFILE_TCL8(flags_) \ (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_TCL8) +#define PROFILE_REPLACE(flags_) \ + (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) + #define PROFILE_STRICT(flags_) \ (!PROFILE_TCL8(flags_) && !PROFILE_REPLACE(flags_)) -#define PROFILE_REPLACE(flags_) \ - (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) - #define UNICODE_REPLACE_CHAR ((Tcl_UniChar)0xFFFD) #define SURROGATE(c_) (((c_) & ~0x7FF) == 0xD800) #define HIGH_SURROGATE(c_) (((c_) & ~0x3FF) == 0xD800) @@ -1227,6 +1227,7 @@ Tcl_ExternalToUtfDStringEx( "Parameter error: TCL_ENCODING_{START,STOP} bits set in flags.", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALFLAGS", NULL); + errno = EINVAL; return TCL_ERROR; } @@ -1302,6 +1303,9 @@ Tcl_ExternalToUtfDStringEx( interp, "TCL", "ENCODING", "ILLEGALSEQUENCE", buf, NULL); } } + if (result != TCL_OK) { + errno = (result == TCL_CONVERT_NOSPACE) ? ENOMEM : EILSEQ; + } return result; } @@ -1492,7 +1496,7 @@ Tcl_UtfToExternalDString( * The parameter flags controls the behavior, if any of the bytes in * the source buffer are invalid or cannot be represented in the * target encoding. It should be composed by OR-ing the following: - * - *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT} + * - *At most one* of TCL_ENCODING_PROFILE_* * * Results: * The return value is one of @@ -1553,6 +1557,7 @@ Tcl_UtfToExternalDStringEx( "Parameter error: TCL_ENCODING_{START,STOP} bits set in flags.", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALFLAGS", NULL); + errno = EINVAL; return TCL_ERROR; } @@ -1632,6 +1637,9 @@ Tcl_UtfToExternalDStringEx( buf, NULL); } } + if (result != TCL_OK) { + errno = (result == TCL_CONVERT_NOSPACE) ? ENOMEM : EILSEQ; + } return result; } @@ -3599,7 +3607,7 @@ TableFromUtfProc( word = 0; } else #endif - word = fromUnicode[(ch >> 8)][ch & 0xFF]; + word = fromUnicode[(ch >> 8)][ch & 0xFF]; if ((word == 0) && (ch != 0)) { if (PROFILE_STRICT(flags)) { -- cgit v0.12 From 216559a0a69b0df8bb91006b20051801a6c745ea Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 20 Jul 2023 16:22:24 +0000 Subject: Make "cd" encoding-error-aware --- generic/tclCmdAH.c | 7 ++++++- unix/tclLoadDyld.c | 4 ++-- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index c860004..31e3a96 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -283,7 +283,12 @@ Tcl_CdObjCmd( if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) { result = TCL_ERROR; } else { - result = Tcl_FSChdir(dir); + Tcl_DString ds; + result = Tcl_UtfToExternalDStringEx(NULL, NULL, TclGetString(dir), -1, 0, &ds, NULL); + Tcl_DStringFree(&ds); + if (result == TCL_OK) { + result = Tcl_FSChdir(dir); + } if (result != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't change working directory to \"%s\": %s", diff --git a/unix/tclLoadDyld.c b/unix/tclLoadDyld.c index 0bb56c8..67e1682 100644 --- a/unix/tclLoadDyld.c +++ b/unix/tclLoadDyld.c @@ -189,7 +189,7 @@ TclpDlopen( Tcl_DStringFree(&ds); return TCL_ERROR; } - nativeFileName = Tcl_DStringValue(); + nativeFileName = Tcl_DStringValue(&ds); #if TCL_DYLD_USE_DLFCN /* @@ -347,7 +347,7 @@ FindSymbol( if (Tcl_UtfToExternalDStringEx(interp, NULL, symbol, TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { Tcl_DStringFree(&ds); - return TCL_ERROR; + return NULL; } native = Tcl_DStringValue(&ds); if (dyldLoadHandle->dlHandle) { -- cgit v0.12 From 68d6993ee8557df1d1a1f31ec76147b2704f0c44 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 20 Jul 2023 20:10:06 +0000 Subject: More Tcl_UtfToExternalDStringEx usage, for encoding-error checking --- generic/tclCmdAH.c | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 31e3a96..fb5859b 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -2239,10 +2239,16 @@ CheckAccess( * access(). */ { int value; + Tcl_DString ds; if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { value = 0; + } else if (Tcl_UtfToExternalDStringEx(NULL, NULL, TclGetString(pathPtr), + TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + value = 0; + Tcl_DStringFree(&ds); } else { + Tcl_DStringFree(&ds); value = (Tcl_FSAccess(pathPtr, mode) == 0); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); @@ -2280,12 +2286,19 @@ GetStatBuf( * calling (*statProc)(). */ { int status; + Tcl_DString ds; if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) { return TCL_ERROR; } - status = statProc(pathPtr, statPtr); + if (Tcl_UtfToExternalDStringEx(NULL, NULL, TclGetString(pathPtr), + TCL_INDEX_NONE, 0, &ds, NULL) != TCL_OK) { + status = -1; + } else { + status = statProc(pathPtr, statPtr); + } + Tcl_DStringFree(&ds); if (status < 0) { if (interp != NULL) { -- cgit v0.12 From 35c84a2b08c559301260d8ed048c9a63ad974bf4 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 11 Sep 2023 13:15:20 +0000 Subject: TIP 677 start. Define new flag for variables --- generic/tclInt.h | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 3ee3199..2886ec4 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -661,6 +661,11 @@ typedef struct VarInHash { * through "upvar" and "global" commands, or * through references to variables in enclosing * namespaces. + * VAR_CONSTANT - 1 means this is a constant "variable", and + * cannot be written to by ordinary commands. + * Structurally, it's the same as a scalar when + * being read, but writes are rejected. Constants + * are not supported inside arrays. * * Flags that indicate the type and status of storage; none is set for * compiled local variables (Var structs). @@ -725,6 +730,7 @@ typedef struct VarInHash { /* Type of value (0 is scalar) */ #define VAR_ARRAY 0x1 #define VAR_LINK 0x2 +#define VAR_CONSTANT 0x10000 /* Type of storage (0 is compiled local) */ #define VAR_IN_HASHTABLE 0x4 @@ -759,13 +765,14 @@ typedef struct VarInHash { * MODULE_SCOPE void TclSetVarScalar(Var *varPtr); * MODULE_SCOPE void TclSetVarArray(Var *varPtr); * MODULE_SCOPE void TclSetVarLink(Var *varPtr); + * MODULE_SCOPE void TclSetVarConstant(Var *varPtr); * MODULE_SCOPE void TclSetVarArrayElement(Var *varPtr); * MODULE_SCOPE void TclSetVarUndefined(Var *varPtr); * MODULE_SCOPE void TclClearVarUndefined(Var *varPtr); */ #define TclSetVarScalar(varPtr) \ - (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK) + (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK|VAR_CONSTANT) #define TclSetVarArray(varPtr) \ (varPtr)->flags = ((varPtr)->flags & ~VAR_LINK) | VAR_ARRAY @@ -773,11 +780,14 @@ typedef struct VarInHash { #define TclSetVarLink(varPtr) \ (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_LINK +#define TclSetVarConstant(varPtr) \ + (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_CONSTANT + #define TclSetVarArrayElement(varPtr) \ (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT #define TclSetVarUndefined(varPtr) \ - (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK);\ + (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK|VAR_CONSTANT);\ (varPtr)->value.objPtr = NULL #define TclClearVarUndefined(varPtr) @@ -809,6 +819,7 @@ typedef struct VarInHash { * The ANSI C "prototypes" for these macros are: * * MODULE_SCOPE int TclIsVarScalar(Var *varPtr); + * MODULE_SCOPE int TclIsVarConstant(Var *varPtr); * MODULE_SCOPE int TclIsVarLink(Var *varPtr); * MODULE_SCOPE int TclIsVarArray(Var *varPtr); * MODULE_SCOPE int TclIsVarUndefined(Var *varPtr); @@ -835,6 +846,10 @@ typedef struct VarInHash { #define TclIsVarArray(varPtr) \ ((varPtr)->flags & VAR_ARRAY) +/* Implies scalar as well. */ +#define TclIsVarConstant(varPtr) \ + ((varPtr)->flags & VAR_CONSTANT) + #define TclIsVarUndefined(varPtr) \ ((varPtr)->value.objPtr == NULL) @@ -894,13 +909,13 @@ typedef struct VarInHash { && (varPtr)->value.objPtr) #define TclIsVarDirectWritable(varPtr) \ - (!TclIsVarTricky(varPtr,VAR_TRACED_WRITE|VAR_DEAD_HASH)) + (!TclIsVarTricky(varPtr,VAR_TRACED_WRITE|VAR_DEAD_HASH|VAR_CONSTANT)) #define TclIsVarDirectUnsettable(varPtr) \ - (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH)) + (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH|VAR_CONSTANT)) #define TclIsVarDirectModifyable(varPtr) \ - ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE)) \ + ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_CONSTANT)) \ && (varPtr)->value.objPtr) #define TclIsVarDirectReadable2(varPtr, arrayPtr) \ -- cgit v0.12 From 2d8f75bb449a9a3fd3de32a2a8e009ce10a1709c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 15 Sep 2023 06:53:44 +0000 Subject: 3 places where TCLFSENCODING is not appropricate (use system-encoding, not utf-8, on Windows) --- generic/tclIOSock.c | 4 ++-- win/tclWinPipe.c | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 4b2c637..47fde36 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -75,7 +75,7 @@ TclSockGetPort( * Don't bother translating 'proto' to native. */ - if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, string, -1, 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, NULL, string, -1, 0, &ds, NULL) != TCL_OK) { Tcl_DStringFree(&ds); return TCL_ERROR; } @@ -188,7 +188,7 @@ TclCreateSocketAddress( int result; if (host != NULL) { - if (Tcl_UtfToExternalDStringEx(interp, TCLFSENCODING, host, -1, 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, NULL, host, -1, 0, &ds, NULL) != TCL_OK) { Tcl_DStringFree(&ds); return 0; } diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index fd183cf..9f889b2 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -679,7 +679,7 @@ TclpCreateTempFile( * Convert the contents from UTF to native encoding */ - if (Tcl_UtfToExternalDStringEx(NULL, TCLFSENCODING, contents, TCL_INDEX_NONE, 0, &dstring, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(NULL, NULL, contents, TCL_INDEX_NONE, 0, &dstring, NULL) != TCL_OK) { goto error; } native = Tcl_DStringValue(&dstring); -- cgit v0.12 From 051d4737923b15185d9c0c0365ef218c5328ced8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 28 Sep 2023 15:01:56 +0000 Subject: Improve error-message, in case of encoding error in stderr channel --- generic/tclMain.c | 33 +++++++++++++++++++++++++-------- 1 file changed, 25 insertions(+), 8 deletions(-) diff --git a/generic/tclMain.c b/generic/tclMain.c index 2833ca8..e604d6f 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -29,6 +29,7 @@ */ static const char DEFAULT_PRIMARY_PROMPT[] = "% "; +static const char ENCODING_ERROR[] = "\n\t(encoding error in stderr)"; /* * This file can be compiled on Windows in UNICODE mode, as well as on all @@ -249,7 +250,9 @@ Tcl_SourceRCFile( if (Tcl_EvalFile(interp, fullName) != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { - Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); + if (Tcl_WriteObj(chan, Tcl_GetObjResult(interp)) < 0) { + Tcl_WriteChars(chan, ENCODING_ERROR, -1); + } Tcl_WriteChars(chan, "\n", 1); } } @@ -377,7 +380,9 @@ Tcl_MainEx( if (chan) { Tcl_WriteChars(chan, "application-specific initialization failed: ", -1); - Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); + if (Tcl_WriteObj(chan, Tcl_GetObjResult(interp)) < 0) { + Tcl_WriteChars(chan, ENCODING_ERROR, -1); + } Tcl_WriteChars(chan, "\n", 1); } } @@ -417,7 +422,9 @@ Tcl_MainEx( Tcl_DecrRefCount(keyPtr); if (valuePtr) { - Tcl_WriteObj(chan, valuePtr); + if (Tcl_WriteObj(chan, valuePtr) < 0) { + Tcl_WriteChars(chan, ENCODING_ERROR, -1); + } } Tcl_WriteChars(chan, "\n", 1); Tcl_DecrRefCount(options); @@ -530,7 +537,9 @@ Tcl_MainEx( if (code != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { - Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); + if (Tcl_WriteObj(chan, Tcl_GetObjResult(interp)) < 0) { + Tcl_WriteChars(chan, ENCODING_ERROR, -1); + } Tcl_WriteChars(chan, "\n", 1); } } else if (is.tty) { @@ -539,7 +548,9 @@ Tcl_MainEx( (void)Tcl_GetStringFromObj(resultPtr, &length); chan = Tcl_GetStdChannel(TCL_STDOUT); if ((length > 0) && chan) { - Tcl_WriteObj(chan, resultPtr); + if (Tcl_WriteObj(chan, resultPtr) < 0) { + Tcl_WriteChars(chan, ENCODING_ERROR, -1); + } Tcl_WriteChars(chan, "\n", 1); } Tcl_DecrRefCount(resultPtr); @@ -804,7 +815,9 @@ StdinProc( chan = Tcl_GetStdChannel(TCL_STDERR); if (chan != NULL) { - Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); + if (Tcl_WriteObj(chan, Tcl_GetObjResult(interp)) < 0) { + Tcl_WriteChars(chan, ENCODING_ERROR, -1); + } Tcl_WriteChars(chan, "\n", 1); } } else if (isPtr->tty) { @@ -814,7 +827,9 @@ StdinProc( Tcl_IncrRefCount(resultPtr); (void)Tcl_GetStringFromObj(resultPtr, &length); if ((length > 0) && (chan != NULL)) { - Tcl_WriteObj(chan, resultPtr); + if (Tcl_WriteObj(chan, resultPtr) < 0) { + Tcl_WriteChars(chan, ENCODING_ERROR, -1); + } Tcl_WriteChars(chan, "\n", 1); } Tcl_DecrRefCount(resultPtr); @@ -885,7 +900,9 @@ Prompt( "\n (script that generates prompt)"); chan = Tcl_GetStdChannel(TCL_STDERR); if (chan != NULL) { - Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); + if (Tcl_WriteObj(chan, Tcl_GetObjResult(interp)) < 0) { + Tcl_WriteChars(chan, ENCODING_ERROR, -1); + } Tcl_WriteChars(chan, "\n", 1); } goto defaultPrompt; -- cgit v0.12 From 35d2a8013960a923e171c730d36430400813aa76 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 29 Sep 2023 09:53:49 +0000 Subject: Undo changes in tclVar.c: no longer necessary --- generic/tclVar.c | 14 +------------- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/generic/tclVar.c b/generic/tclVar.c index 231b09d..31312e1 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -5587,27 +5587,15 @@ TclObjVarErrMsg( * variable, or -1. Only used when part1Ptr is * NULL. */ { - const char *part2Str = NULL; if (!part1Ptr) { if (index == -1) { Tcl_Panic("invalid part1Ptr and invalid index together"); } part1Ptr = localName(((Interp *)interp)->varFramePtr, index); } - if (part2Ptr) { - Tcl_DString ds; - Tcl_DStringInit(&ds); - - part2Str = TclGetString(part2Ptr); - if (Tcl_UtfToExternalDStringEx(NULL, TCLFSENCODING, part2Str, -1, 0, &ds, NULL) != TCL_OK) { - /* part2Str is not printable to stdout, because of strict profile. Don't bother */ - part2Str = "???"; - } - Tcl_DStringFree(&ds); - } Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't %s \"%s%s%s%s\": %s", operation, TclGetString(part1Ptr), (part2Ptr ? "(" : ""), - (part2Ptr ? part2Str : ""), (part2Ptr ? ")" : ""), + (part2Ptr ? TclGetString(part2Ptr) : ""), (part2Ptr ? ")" : ""), reason)); } -- cgit v0.12 From d9534890046440144f5b06de2e748c8993b461bc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 13 Oct 2023 13:27:40 +0000 Subject: Proposed fix for [abd489a1c]: TclStringCmp() calls functions through pointer to incorrect type. Modified, swapping the wrapping-order --- generic/tclCmdMZ.c | 15 +++++++------- generic/tclIndexObj.c | 4 ++-- generic/tclInt.h | 15 ++++++++------ generic/tclOOCall.c | 2 +- generic/tclUtf.c | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++ unix/tclUnixChan.c | 14 ++++++------- 6 files changed, 83 insertions(+), 24 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index d769da8..9636528 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1240,7 +1240,7 @@ StringFirstCmd( */ if ((*p == *needleStr) && (TclUniCharNcmp(needleStr, p, - (unsigned long) needleLen) == 0)) { + needleLen) == 0)) { match = p - haystackStr; break; } @@ -1953,7 +1953,7 @@ StringMapCmd( } end = ustring1 + length1; - strCmpFn = (nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp); + strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp; /* * Force result to be Unicode @@ -2740,7 +2740,7 @@ TclStringCmp( if (nocase) { s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len); s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len); - memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp; + memCmpFn = TclUniCharNcasecmp; } else { s1len = Tcl_GetCharLength(value1Ptr); s2len = Tcl_GetCharLength(value2Ptr); @@ -2771,7 +2771,7 @@ TclStringCmp( reqlength *= sizeof(Tcl_UniChar); } } else { - memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp; + memCmpFn = TclUniCharNcmp; } } } @@ -2822,17 +2822,16 @@ TclStringCmp( /* * As a catch-all we will work with UTF-8. We cannot use memcmp() * as that is unsafe with any string containing NUL (\xC0\x80 in - * Tcl's utf rep). We can use the more efficient TclpUtfNcmp2 if + * Tcl's utf rep). We can use the more efficient TclUtfNcmp if * we are case-sensitive and no specific length was requested. */ if ((reqlength < 0) && !nocase) { - memCmpFn = (memCmpFn_t) TclpUtfNcmp2; + memCmpFn = TclUtfNcmp2; } else { s1len = Tcl_NumUtfChars(s1, s1len); s2len = Tcl_NumUtfChars(s2, s2len); - memCmpFn = (memCmpFn_t) - (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp); + memCmpFn = nocase ? TclUtfNcasecmp : TclUtfNcmp; } } } diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 89b19fd..c024b60 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -692,7 +692,7 @@ PrefixAllObjCmd( */ if (length <= elemLength) { - if (TclpUtfNcmp2(elemString, string, length) == 0) { + if (TclUtfNcmp2(elemString, string, length) == 0) { Tcl_ListObjAppendElement(interp, resultPtr, tableObjv[t]); } } @@ -752,7 +752,7 @@ PrefixLongestObjCmd( */ if ((length > elemLength) || - TclpUtfNcmp2(elemString, string, length) != 0) { + TclUtfNcmp2(elemString, string, length) != 0) { continue; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 103827f..18edac4 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3143,9 +3143,14 @@ MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, int numBytes); typedef int (*memCmpFn_t)(const void*, const void*, size_t); -MODULE_SCOPE int TclStringCmp (Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr, +MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr, int checkEq, int nocase, int reqlength); -MODULE_SCOPE int TclStringCmpOpts (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], +MODULE_SCOPE int TclUniCharNcasecmp(const void*, const void*, size_t); +MODULE_SCOPE int TclUtfNcasecmp(const void*, const void*, size_t); +MODULE_SCOPE int TclUtfNcmp(const void*, const void*, size_t); +MODULE_SCOPE int TclUniCharNcmp(const void*, const void*, size_t); +MODULE_SCOPE int TclUtfNcmp2(const void*, const void*, size_t); +MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int *nocase, int *reqlength); MODULE_SCOPE int TclStringMatch(const char *str, int strLen, const char *pattern, int ptnLen, int flags); @@ -4052,15 +4057,13 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, * lexically correct on little-endian systems. The ANSI C "prototype" for * this macro is: * - * MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *cs, - * const Tcl_UniChar *ct, unsigned long n); + * MODULE_SCOPE int TclUniCharNcmp(const void *cs, + * const void *ct, size_t n); *---------------------------------------------------------------- */ #if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX != 4) # define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar)) -#else /* !WORDS_BIGENDIAN */ -# define TclUniCharNcmp Tcl_UniCharNcmp #endif /* WORDS_BIGENDIAN */ /* diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 7ebde5e..aefd921 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -585,7 +585,7 @@ CmpStr( const char **strPtr1 = (const char **) ptr1; const char **strPtr2 = (const char **) ptr2; - return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1) + 1); + return TclUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1) + 1); } /* diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 9f32fcf..196c5fb 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -1231,6 +1231,17 @@ TclpUtfNcmp2( const char *ct, /* UTF string cs is compared to. */ unsigned long numBytes) /* Number of *bytes* to compare. */ { + return TclUtfNcmp2(cs, ct, numBytes); +} + +int +TclUtfNcmp2( + const void *csPtr, /* UTF string to compare to ct. */ + const void *ctPtr, /* UTF string cs is compared to. */ + size_t numBytes) /* Number of *bytes* to compare. */ +{ + const char *cs = (const char *)csPtr; + const char *ct = (const char *)ctPtr; /* * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to * check for Tcl's \xC0\x80 non-utf-8 null encoding. Otherwise utf-8 lexes @@ -1278,6 +1289,17 @@ Tcl_UtfNcmp( const char *ct, /* UTF string cs is compared to. */ unsigned long numChars) /* Number of UTF chars to compare. */ { + return TclUtfNcmp(cs, ct, numChars); +} + +int +TclUtfNcmp( + const void *csPtr, /* UTF string to compare to ct. */ + const void *ctPtr, /* UTF string cs is compared to. */ + size_t numChars) /* Number of UTF chars to compare. */ +{ + const char *cs = (const char *)csPtr; + const char *ct = (const char *)ctPtr; Tcl_UniChar ch1 = 0, ch2 = 0; /* @@ -1336,6 +1358,17 @@ Tcl_UtfNcasecmp( const char *ct, /* UTF string cs is compared to. */ unsigned long numChars) /* Number of UTF chars to compare. */ { + return TclUtfNcasecmp(cs, ct, numChars); +} + +int +TclUtfNcasecmp( + const void *csPtr, /* UTF string to compare to ct. */ + const void *ctPtr, /* UTF string cs is compared to. */ + size_t numChars) /* Number of UTF chars to compare. */ +{ + const char *cs = (const char *)csPtr; + const char *ct = (const char *)ctPtr; Tcl_UniChar ch1 = 0, ch2 = 0; while (numChars-- > 0) { @@ -1588,12 +1621,24 @@ Tcl_UniCharLen( *---------------------------------------------------------------------- */ +#undef TclUniCharNcmp int Tcl_UniCharNcmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ unsigned long numChars) /* Number of unichars to compare. */ { + return TclUniCharNcmp(ucs, uct, numChars); +} + +int +TclUniCharNcmp( + const void *ucsPtr, /* Unicode string to compare to uct. */ + const void *uctPtr, /* Unicode string ucs is compared to. */ + size_t numChars) /* Number of unichars to compare. */ +{ + const Tcl_UniChar *ucs = (const Tcl_UniChar *)ucsPtr; + const Tcl_UniChar *uct = (const Tcl_UniChar *)uctPtr; #if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX != 4) /* * We are definitely on a big-endian machine; memcmp() is safe @@ -1647,6 +1692,18 @@ Tcl_UniCharNcasecmp( const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ unsigned long numChars) /* Number of Unichars to compare. */ { + return TclUniCharNcasecmp(ucs, uct, numChars); +} + +int +TclUniCharNcasecmp( + const void *ucsPtr, /* Unicode string to compare to uct. */ + const void *uctPtr, /* Unicode string ucs is compared to. */ + size_t numChars) /* Number of Unichars to compare. */ +{ + const Tcl_UniChar *ucs = (const Tcl_UniChar *)ucsPtr; + const Tcl_UniChar *uct = (const Tcl_UniChar *)uctPtr; + for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs); diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 5742e9a..bd46191 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -646,20 +646,20 @@ TtySetOptionProc( #ifdef CRTSCTS CLEAR_BITS(iostate.c_cflag, CRTSCTS); #endif /* CRTSCTS */ - if (Tcl_UtfNcasecmp(value, "NONE", vlen) == 0) { + if (TclUtfNcasecmp(value, "NONE", vlen) == 0) { /* * Leave all handshake options disabled. */ - } else if (Tcl_UtfNcasecmp(value, "XONXOFF", vlen) == 0) { + } else if (TclUtfNcasecmp(value, "XONXOFF", vlen) == 0) { SET_BITS(iostate.c_iflag, IXON | IXOFF | IXANY); - } else if (Tcl_UtfNcasecmp(value, "RTSCTS", vlen) == 0) { + } else if (TclUtfNcasecmp(value, "RTSCTS", vlen) == 0) { #ifdef CRTSCTS SET_BITS(iostate.c_cflag, CRTSCTS); #else /* !CRTSTS */ UNSUPPORTED_OPTION("-handshake RTSCTS"); return TCL_ERROR; #endif /* CRTSCTS */ - } else if (Tcl_UtfNcasecmp(value, "DTRDSR", vlen) == 0) { + } else if (TclUtfNcasecmp(value, "DTRDSR", vlen) == 0) { UNSUPPORTED_OPTION("-handshake DTRDSR"); return TCL_ERROR; } else { @@ -759,19 +759,19 @@ TtySetOptionProc( ckfree(argv); return TCL_ERROR; } - if (Tcl_UtfNcasecmp(argv[i], "DTR", strlen(argv[i])) == 0) { + if (TclUtfNcasecmp(argv[i], "DTR", strlen(argv[i])) == 0) { if (flag) { SET_BITS(control, TIOCM_DTR); } else { CLEAR_BITS(control, TIOCM_DTR); } - } else if (Tcl_UtfNcasecmp(argv[i], "RTS", strlen(argv[i])) == 0) { + } else if (TclUtfNcasecmp(argv[i], "RTS", strlen(argv[i])) == 0) { if (flag) { SET_BITS(control, TIOCM_RTS); } else { CLEAR_BITS(control, TIOCM_RTS); } - } else if (Tcl_UtfNcasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) { + } else if (TclUtfNcasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) { #if defined(TIOCSBRK) && defined(TIOCCBRK) if (flag) { ioctl(fsPtr->fd, TIOCSBRK, NULL); -- cgit v0.12 From 7c3322a2ee80527c01e51cde6a9681d96228fab3 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 25 Oct 2023 17:57:00 +0000 Subject: Since TIP 258 (2005) and development efforts leading up to it (2004), the Tcltest package has not been a caller of routines Tcl(Get|Set)LibraryPath, so there's no longer a need for those to be in the internal stubs table. After they are removed from the table, they no longer need to exist at all. --- generic/tclEncoding.c | 48 +----------------------------------------------- generic/tclInt.decls | 13 +++++++------ generic/tclIntDecls.h | 16 ++++++---------- generic/tclStubInit.c | 4 ++-- 4 files changed, 16 insertions(+), 65 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index e461db2..b441bf63 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -409,52 +409,6 @@ Tcl_SetEncodingSearchPath( } /* - *---------------------------------------------------------------------- - * - * TclGetLibraryPath -- - * - * Keeps the per-thread copy of the library path current with changes to - * the global copy. - * - * Results: - * Returns a "list" (Tcl_Obj *) that contains the library path. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclGetLibraryPath(void) -{ - return TclGetProcessGlobalValue(&libraryPath); -} - -/* - *---------------------------------------------------------------------- - * - * TclSetLibraryPath -- - * - * Keeps the per-thread copy of the library path current with changes to - * the global copy. - * - * Since the result of this routine is void, if searchPath is not a valid - * list this routine silently does nothing. - * - *---------------------------------------------------------------------- - */ - -void -TclSetLibraryPath( - Tcl_Obj *path) -{ - Tcl_Size dummy; - - if (TCL_ERROR == TclListObjLengthM(NULL, path, &dummy)) { - return; - } - TclSetProcessGlobalValue(&libraryPath, path, NULL); -} - -/* *--------------------------------------------------------------------------- * * FillEncodingFileMap -- @@ -4382,7 +4336,7 @@ InitializeEncodingSearchPath( TclNewObj(searchPathObj); Tcl_IncrRefCount(encodingObj); Tcl_IncrRefCount(searchPathObj); - libPathObj = TclGetLibraryPath(); + libPathObj = TclGetProcessGlobalValue(&libraryPath); Tcl_IncrRefCount(libPathObj); TclListObjLengthM(NULL, libPathObj, &numDirs); diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 62f7580..b7b1703 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -364,12 +364,13 @@ declare 151 { void TclRegExpRangeUniChar(Tcl_RegExp re, Tcl_Size index, Tcl_Size *startPtr, Tcl_Size *endPtr) } -declare 152 { - void TclSetLibraryPath(Tcl_Obj *pathPtr) -} -declare 153 { - Tcl_Obj *TclGetLibraryPath(void) -} +# Tcl*LibraryPath routines were obsoleted in Tcl 8.5 +#declare 152 { +# void TclSetLibraryPath(Tcl_Obj *pathPtr) +#} +#declare 153 { +# Tcl_Obj *TclGetLibraryPath(void) +#} declare 156 { void TclRegError(Tcl_Interp *interp, const char *msg, int status) diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 3ebe2eb..d94dcb2 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -413,10 +413,8 @@ EXTERN int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re); /* 151 */ EXTERN void TclRegExpRangeUniChar(Tcl_RegExp re, Tcl_Size index, Tcl_Size *startPtr, Tcl_Size *endPtr); -/* 152 */ -EXTERN void TclSetLibraryPath(Tcl_Obj *pathPtr); -/* 153 */ -EXTERN Tcl_Obj * TclGetLibraryPath(void); +/* Slot 152 is reserved */ +/* Slot 153 is reserved */ /* Slot 154 is reserved */ /* Slot 155 is reserved */ /* 156 */ @@ -846,8 +844,8 @@ typedef struct TclIntStubs { void (*tclHandleRelease) (TclHandle handle); /* 149 */ int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */ void (*tclRegExpRangeUniChar) (Tcl_RegExp re, Tcl_Size index, Tcl_Size *startPtr, Tcl_Size *endPtr); /* 151 */ - void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */ - Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */ + void (*reserved152)(void); + void (*reserved153)(void); void (*reserved154)(void); void (*reserved155)(void); void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */ @@ -1217,10 +1215,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclRegAbout) /* 150 */ #define TclRegExpRangeUniChar \ (tclIntStubsPtr->tclRegExpRangeUniChar) /* 151 */ -#define TclSetLibraryPath \ - (tclIntStubsPtr->tclSetLibraryPath) /* 152 */ -#define TclGetLibraryPath \ - (tclIntStubsPtr->tclGetLibraryPath) /* 153 */ +/* Slot 152 is reserved */ +/* Slot 153 is reserved */ /* Slot 154 is reserved */ /* Slot 155 is reserved */ #define TclRegError \ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 97f37b0..8ba5e4e 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -932,8 +932,8 @@ static const TclIntStubs tclIntStubs = { TclHandleRelease, /* 149 */ TclRegAbout, /* 150 */ TclRegExpRangeUniChar, /* 151 */ - TclSetLibraryPath, /* 152 */ - TclGetLibraryPath, /* 153 */ + 0, /* 152 */ + 0, /* 153 */ 0, /* 154 */ 0, /* 155 */ TclRegError, /* 156 */ -- cgit v0.12 From 49e6cd0d8b91d20b36af82ee31045d19c38f9f8a Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 27 Oct 2023 10:26:15 +0000 Subject: better readability for winPipe.test (naming flags), no functional changes --- tests/winPipe.test | 42 ++++++++++++++++++++---------------------- 1 file changed, 20 insertions(+), 22 deletions(-) diff --git a/tests/winPipe.test b/tests/winPipe.test index ce786db..9aa84a9 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -34,7 +34,7 @@ testConstraint cat32 [file exists $cat32] testConstraint AllocConsole [catch {puts console1 ""}] testConstraint RealConsole [expr {![testConstraint AllocConsole]}] testConstraint testexcept [llength [info commands testexcept]] -testConstraint slowTest 0 +#testConstraint slowTest 0 set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n @@ -313,7 +313,7 @@ test winpipe-6.2 {PipeSetupProc & PipeCheckProc: write threads} \ lappend x [catch {close $f} msg] $msg } {writable timeout 0 {}} -proc _testExecArgs {single args} { +proc _testExecArgs {flags args} { variable path if {![info exists path(echoArgs.tcl)] || ![file exists $path(echoArgs.tcl)]} { set path(echoArgs.tcl) [makeFile { @@ -324,19 +324,21 @@ proc _testExecArgs {single args} { set path(echoArgs.bat) [makeFile "@[file native [interpreter]] $path(echoArgs.tcl) %*" "echoArgs.bat"] } set cmds [list [list [interpreter] $path(echoArgs.tcl)]] - if {!($single & 2)} { - lappend cmds [list $path(echoArgs.bat)] - } else { - if {![info exists path(echoArgs2.bat)] || ![file exists $path(echoArgs2.bat)]} { - set path(echoArgs2.bat) [makeFile \ - "@[file native [interpreter]] $path(echoArgs.tcl) %*" \ - "echo(Cmd)Test Args & Batch.bat" [makeDirectory test(Dir)Check]] + if {"exe-only" ni $flags} { + if {"batch2" ni $flags} { + lappend cmds [list $path(echoArgs.bat)] + } else { + if {![info exists path(echoArgs2.bat)] || ![file exists $path(echoArgs2.bat)]} { + set path(echoArgs2.bat) [makeFile \ + "@[file native [interpreter]] $path(echoArgs.tcl) %*" \ + "echo(Cmd)Test Args & Batch.bat" [makeDirectory test(Dir)Check]] + } + lappend cmds [list $path(echoArgs2.bat)] } - lappend cmds [list $path(echoArgs2.bat)] } set broken {} foreach args $args { - if {$single & 1} { + if {"enclose" in $flags} { # enclose single test-arg between 1st/3rd to be sure nothing is truncated # (e. g. to cover unexpected trim by nts-zero case, and args don't recombined): set args [list "1st" $args "3rd"] @@ -353,10 +355,6 @@ proc _testExecArgs {single args} { if {$r ne $e} { append broken "\[ERROR\]: exec [file extension [lindex $cmd 0]] on $args\n -- result:\n$r\n -- expected:\n$e\n" } - if {$single & 8} { - # if test exe only: - break - } } } return $broken @@ -489,7 +487,7 @@ set injectList { ### test winpipe-8.1 {BuildCommandLine/parse_cmdline pass-thru: dumped arguments are equal original} \ -constraints {win exec} -body { - _testExecArgs 0 \ + _testExecArgs {} \ [list foo "" bar] \ [list foo {} bar] \ [list foo "\"" bar] \ @@ -513,12 +511,12 @@ test winpipe-8.1 {BuildCommandLine/parse_cmdline pass-thru: dumped arguments are test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (particular)} \ -constraints {win exec slowTest} -body { - _testExecArgs 1 {*}$injectList + _testExecArgs enclose {*}$injectList } -result {} test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (jointly)} \ -constraints {win exec} -body { - _testExecArgs 0 \ + _testExecArgs {} \ [list START {*}$injectList END] \ [list "START\"" {*}$injectList END] \ [list START {*}$injectList "\"END"] \ @@ -527,7 +525,7 @@ test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: check injection on s test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (command/jointly args)} \ -constraints {win exec} -body { - _testExecArgs 2 \ + _testExecArgs batch2 \ [list START {*}$injectList END] \ [list "START\"" {*}$injectList END] \ [list START {*}$injectList "\"END"] \ @@ -559,7 +557,7 @@ test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: check injection on s } 20 lappend lst $args } 10 - _testExecArgs 0 {*}$lst + _testExecArgs {} {*}$lst } -result {} -cleanup { unset -nocomplain lst args a map maps } @@ -576,7 +574,7 @@ test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: check new-line quote -constraints {win exec} -body { # test exe only, because currently there is no proper way to escape a new-line char resp. # to supply a new-line to the batch-files within arguments (command line is truncated). - _testExecArgs 8 \ + _testExecArgs exe-only \ [list START {*}$injectList END] \ [list "START\"" {*}$injectList END] \ [list START {*}$injectList "\"END"] \ @@ -586,7 +584,7 @@ test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: check new-line quote test winpipe-8.7 {BuildCommandLine/parse_cmdline pass-thru: check new-line quoted in args (batch)} \ -constraints {win exec knownBug} -body { # this will fail if executed batch-file, because currently there is no proper way to escape a new-line char. - _testExecArgs 0 $injectList + _testExecArgs {} $injectList } -result {} -- cgit v0.12 From 4221d111bdf2f0077f8974317e441c30e8de959c Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 27 Oct 2023 10:46:17 +0000 Subject: fixes percent-subst regression [fb2fa9b3f6] introduced by fixing of vulnerability [21b0629c81]; warning (todo): since it'd reopen a injection-vector by execution of command processor/batch-files as described in [fb2fa9b3f6] (unexpected tripple/double quote), [exec] as well as [open |...] should get new option for safe escape (or no .bat/.cmd/comspec execution with arguments from foreign input can be considered as safe without extra parameters validation). --- tests/winPipe.test | 7 +++++++ win/tclWinPipe.c | 11 ++++++++++- 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/tests/winPipe.test b/tests/winPipe.test index 9aa84a9..5d3999e 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -352,6 +352,13 @@ proc _testExecArgs {flags args} { } r]} { set r "ERROR: $r" } + if {[file extension [lindex $cmd 0]] eq ".bat"} { + set evm {}; foreach ev [lsort -unique [regexp -inline -all {%[A-Z]+%} $e]] { + set ev [string range $ev 1 end-1] + if {[info exists ::env($ev)]} { lappend evm %$ev% $::env($ev) } + } + set e [string map $evm $e] + } if {$r ne $e} { append broken "\[ERROR\]: exec [file extension [lindex $cmd 0]] on $args\n -- result:\n$r\n -- expected:\n$e\n" } diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 8b707fa..b992536 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1557,12 +1557,20 @@ BuildCommandLine( const char *arg, *start, *special, *bspos; int quote = 0, i; Tcl_DString ds; +#ifdef TCL_WIN_PIPE_FULLESC + /* full escape inclusive %-subst avoidance */ static const char specMetaChars[] = "&|^<>!()%"; /* Characters to enclose in quotes if unpaired * quote flag set. */ static const char specMetaChars2[] = "%"; /* Character to enclose in quotes in any case * (regardless of unpaired-flag). */ +#else + /* escape considering quotation only (no %-subst avoidance) */ + static const char specMetaChars[] = "&|^<>!()"; + /* Characters to enclose in quotes if unpaired + * quote flag set. */ +#endif /* * Quote flags: * CL_ESCAPE - escape argument; @@ -1700,7 +1708,7 @@ BuildCommandLine( start = !bspos ? special : bspos; continue; } - +#ifdef TCL_WIN_PIPE_FULLESC /* * Special case for % - should be enclosed always (paired * also) @@ -1717,6 +1725,7 @@ BuildCommandLine( start = !bspos ? special : bspos; continue; } +#endif /* * Other not special (and not meta) character -- cgit v0.12 From 21e5eb5e3e51e0d244cc9dd876049dc25db27c49 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 30 Oct 2023 19:32:29 +0000 Subject: Testing commands [test(g|s)etencpath] have evolved themselves into functional duplicates of [encoding dirs]. We don't need them anymore. --- generic/tclTest.c | 72 ----------------------------------------------------- tests/encoding.test | 13 ++++------ tests/unixInit.test | 2 -- 3 files changed, 5 insertions(+), 82 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 6a90b67..895de64 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -321,8 +321,6 @@ static Tcl_ObjCmdProc TestFilesystemObjCmd; static Tcl_ObjCmdProc TestSimpleFilesystemObjCmd; static void TestReport(const char *cmd, Tcl_Obj *arg1, Tcl_Obj *arg2); -static Tcl_ObjCmdProc TestgetencpathObjCmd; -static Tcl_ObjCmdProc TestsetencpathObjCmd; static Tcl_Obj * TestReportGetNativePath(Tcl_Obj *pathPtr); static Tcl_FSStatProc TestReportStat; static Tcl_FSAccessProc TestReportAccess; @@ -749,10 +747,6 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd, - NULL, NULL); Tcl_CreateObjCommand(interp, "testapplylambda", TestApplyLambdaObjCmd, NULL, NULL); @@ -8418,72 +8412,6 @@ TestconcatobjCmd( /* *---------------------------------------------------------------------- * - * TestgetencpathObjCmd -- - * - * This function implements the "testgetencpath" command. It is used to - * test Tcl_GetEncodingSearchPath(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestgetencpathObjCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ -{ - if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, ""); - return TCL_ERROR; - } - - Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath()); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TestsetencpathCmd -- - * - * This function implements the "testsetencpath" command. It is used to - * test Tcl_SetDefaultEncodingDir(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestsetencpathObjCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ -{ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "defaultDir"); - return TCL_ERROR; - } - - Tcl_SetEncodingSearchPath(objv[1]); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * TestparseargsCmd -- * * This procedure implements the "testparseargs" command. It is used to diff --git a/tests/encoding.test b/tests/encoding.test index 76b5306..70aa99e 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -41,7 +41,6 @@ testConstraint testencoding [llength [info commands testencoding]] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint teststringbytes [llength [info commands teststringbytes]] testConstraint exec [llength [info commands exec]] -testConstraint testgetencpath [llength [info commands testgetencpath]] # TclInitEncodingSubsystem is tested by the rest of this file # TclFinalizeEncodingSubsystem is not currently tested @@ -1031,15 +1030,13 @@ foreach from {cp932 shiftjis euc-jp iso2022-jp} { } } -test encoding-26.0 {Tcl_GetEncodingSearchPath} -constraints { - testgetencpath -} -setup { - set origPath [testgetencpath] - testsetencpath slappy +test encoding-26.0 {Tcl_GetEncodingSearchPath} -setup { + set origPath [encoding dirs] + encoding dirs slappy } -body { - testgetencpath + encoding dirs } -cleanup { - testsetencpath $origPath + encoding dirs $origPath } -result slappy file delete {*}[glob -directory [temporaryDirectory] *.chars *.tcltestout] diff --git a/tests/unixInit.test b/tests/unixInit.test index 3a9fa6d..7c2c78c 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -18,8 +18,6 @@ unset -nocomplain path catch {set oldlang $env(LANG)} set env(LANG) C -# Some tests require the testgetencpath command -testConstraint testgetencpath [llength [info commands testgetencpath]] test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} { set x {} -- cgit v0.12 From b072039e2175a46e30af3538857dd83f656b5ea4 Mon Sep 17 00:00:00 2001 From: oehhar Date: Mon, 6 Nov 2023 15:47:32 +0000 Subject: Document tip-653 changes on read: Key "-data" for already decoded data on encoding error --- doc/read.n | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/doc/read.n b/doc/read.n index 2add683..7c0c155 100644 --- a/doc/read.n +++ b/doc/read.n @@ -61,13 +61,15 @@ An encoding error is reported by the POSIX error code \fBEILSEQ\fR. In blocking mode, the error is directly thrown, even, if there is a leading decodable data portion. The file pointer is advanced just before the encoding error. -An eventual well decoded data chunk before the encoding error is lost. -It is proposed to return this portion within the additional key \fB-data\fR -in the error dictionary. +An eventual well decoded data chunk before the encoding error is returned +in the error option dictionary key \fB-data\fR. +The value of the key contains the empty string, if the error arises at the +first data position. .PP In non blocking mode, first, any data without encoding error is returned (without error state). In the next call, no data is returned and the \fBEILSEQ\fR error state is set. +The key \fB-data\fR is not present. .PP Here is an example with an encoding error in UTF-8 encoding, which is then introspected by a switch to the binary encoding. The test file contains a not @@ -87,7 +89,7 @@ file35a65a0 % catch {read $f} e d 1 % set d --code 1 -level 0 +-data A -code 1 -level 0 -errorstack {INNER {invokeStk1 read file35a65a0}} -errorcode {POSIX EILSEQ {invalid or incomplete multibyte or wide character}} -errorinfo {...} -errorline 1 @@ -98,6 +100,11 @@ file35a65a0 ÃB % close $f .CE +The already decoded data "A" is returned in the error options dictionary key +\fB-data\fR. +The file position is advanced on the encoding error position 1. +The data at the error position is thus recovered by the next \fBread\fR command. +.PP Non blocking example . .CS -- cgit v0.12 From 436509ded2037b6ff1e430320e2f3cfddcfa937f Mon Sep 17 00:00:00 2001 From: oehhar Date: Tue, 7 Nov 2023 12:42:54 +0000 Subject: TIP 653: adopted implementation to new text to only return "-data" if potential data loss. Check for non-blocking missing --- generic/tclIOCmd.c | 14 ++++++++------ tests/io.test | 20 ++++++++++---------- 2 files changed, 18 insertions(+), 16 deletions(-) diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index cd7fbff..0827858 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -318,9 +318,7 @@ Tcl_GetsObjCmd( lineLen = Tcl_GetsObj(chan, linePtr); if (lineLen == TCL_IO_FAILURE) { if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) { - Tcl_Obj *returnOptsPtr = Tcl_NewDictObj(); - Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-data", -1), - linePtr); + Tcl_DecrRefCount(linePtr); /* * TIP #219. @@ -335,7 +333,6 @@ Tcl_GetsObjCmd( TclGetString(chanObjPtr), Tcl_PosixError(interp))); } code = TCL_ERROR; - Tcl_SetReturnOptions(interp, returnOptsPtr); goto done; } lineLen = TCL_IO_FAILURE; @@ -462,9 +459,14 @@ Tcl_ReadObjCmd( TclChannelPreserve(chan); charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0); if (charactersRead == TCL_IO_FAILURE) { + Tcl_Obj *returnOptsPtr = Tcl_NewDictObj(); - Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-data", -1), - resultPtr); + /* check for blocking and encoding error */ + /* TODO: check for blocking missing */ + if ( Tcl_GetErrno() == EILSEQ ) { + Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-data", -1), + resultPtr); + } /* * TIP #219. * Capture error messages put by the driver into the bypass area and diff --git a/tests/io.test b/tests/io.test index 997dadd..a427541 100644 --- a/tests/io.test +++ b/tests/io.test @@ -1560,7 +1560,7 @@ test io-12.9 {ReadChars: multibyte chars split} -body { read $f scan [string index $in end] %c } -cleanup { - close $f + catch {close $f} } -result 194 test io-12.10 {ReadChars: multibyte chars split} -body { set f [open $path(test1) w] @@ -9212,7 +9212,7 @@ test io-75.6 {invalid utf-8 encoding, gets is not ignored (-profile strict)} -se invalid or incomplete multibyte or wide character} test io-75.7 { - invalid utf-8 encoding gets is not ignored (-profile strict) + invalid utf-8 encoding read is not ignored (-profile strict) } -setup { set fn [makeFile {} io-75.7] set f [open $fn w+] @@ -9340,7 +9340,7 @@ test io-75.10 {incomplete multibyte encoding read is ignored} -setup { # As utf-8 has a special treatment in multi-byte decoding, also test another # one. -test io-75.11 {shiftjis encoding error read results in raw bytes} -setup { +test io-75.11 {shiftjis encoding error read results in error (strict profile)} -setup { set fn [makeFile {} io-75.11] set f [open $fn w+] fconfigure $f -encoding binary @@ -9395,13 +9395,13 @@ test io-75.13 { } -body { set d [read $f] binary scan $d H* hd - lappend hd [catch {read $f} msg data] $msg [dict get $data -data] + lappend hd [catch {read $f} msg data] $msg [dict exists $data -data] } -cleanup { close $f removeFile io-75.13 unset d hd msg data f fn } -match glob -result {41 1 {error reading "file*":\ - invalid or incomplete multibyte or wide character} {}} + invalid or incomplete multibyte or wide character} 0} test io-75.14 { [gets] succesfully returns lines prior to error @@ -9419,7 +9419,7 @@ test io-75.14 { } -body { set res [gets $chan] lappend res [gets $chan] - lappend res [catch {gets $chan} msg data] $msg [dict get $data -data] + lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data] chan configure $chan -profile tcl8 lappend res [gets $chan] lappend res [gets $chan] @@ -9428,7 +9428,7 @@ test io-75.14 { close $chan unset chan res msg data } -match glob -result {a b 1 {error reading "*":\ - invalid or incomplete multibyte or wide character} c cÀ d} + invalid or incomplete multibyte or wide character} 0 cÀ d} test io-75.15 { invalid utf-8 encoding strict @@ -9446,8 +9446,8 @@ test io-75.15 { fconfigure $chan -encoding utf-8 -profile strict lappend res [gets $chan] lappend res [gets $chan] - lappend res [catch {gets $chan} msg data] $msg [dict get $data -data] - lappend res [catch {gets $chan} msg data] $msg [dict get $data -data] + lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data] + lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data] chan configure $chan -translation binary set data [read $chan 4] foreach char [split $data {}] { @@ -9462,7 +9462,7 @@ test io-75.15 { close $chan unset chan res msg data } -match glob -result {hello AB 1 {error reading "*": invalid or incomplete multibyte or wide character}\ - CD 1 {error reading "*": invalid or incomplete multibyte or wide character} CD 43 44 c0 40 EF GHI} + 0 1 {error reading "*": invalid or incomplete multibyte or wide character} 0 43 44 c0 40 EF GHI} # ### ### ### ######### ######### ######### -- cgit v0.12 From b50cf76d6fd8274a93a5d041ec2a568a549293fe Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 8 Nov 2023 21:46:48 +0000 Subject: In the zipfs archive initialization, use Tcl_SetPreInitScript() to equip the creation of every interp by the Tcl library with the knowledge of where in the archive the script library is to be found. This is the **documented example usage** for Tcl_SetPreInitScript. POSTSCRIPT: Moved to development branch. Still needs some verification. --- generic/tclZipfs.c | 58 ++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 45 insertions(+), 13 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 842d51a..4d95973 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -91,6 +91,17 @@ static const z_crc_t* crc32tab; #define ZIPFS_VOLUME_LEN 9 #define ZIPFS_APP_MOUNT ZIPFS_VOLUME "app" #define ZIPFS_ZIP_MOUNT ZIPFS_VOLUME "lib/tcl" + +#define ZIPFS_SCRIPT_PREFIX "set ::tcl_library " +#define ZIPFS_TCL_LIBRARY_1 ZIPFS_APP_MOUNT "/tcl_library" +#define ZIPFS_INIT_SCRIPT_1 ZIPFS_SCRIPT_PREFIX ZIPFS_TCL_LIBRARY_1 + +#define ZIPFS_TCL_LIBRARY_2 ZIPFS_ZIP_MOUNT +#define ZIPFS_INIT_SCRIPT_2 ZIPFS_SCRIPT_PREFIX ZIPFS_TCL_LIBRARY_2 + +#define ZIPFS_TCL_LIBRARY_3 ZIPFS_ZIP_MOUNT "/tcl_library" +#define ZIPFS_INIT_SCRIPT_3 ZIPFS_SCRIPT_PREFIX ZIPFS_TCL_LIBRARY_3 + #define ZIPFS_FALLBACK_ENCODING "cp437" /* @@ -313,6 +324,7 @@ static const char pwrot[17] = "\x10\x90\x50\xD0\x30\xB0\x70\xF0"; static const char *zipfs_literal_tcl_library = NULL; +static const char *zipfs_init_script = NULL; /* Function prototypes */ @@ -4231,6 +4243,28 @@ ScriptLibrarySetup( Tcl_Obj *libDirObj = Tcl_NewStringObj(dirName, -1); Tcl_Obj *subDirObj, *searchPathObj; + /* + * We know where the init.tcl is located in the attached script library + * archive. Use a pre-init script to tell every Tcl interp as it gets + * created where that is, so none of them need to construct and then + * iterate through some search path. That's the literal documented + * purpose of Tcl_SetPreInitScript(). Use it. + * + * TODO: Examine why we need so many variations and eliminate as many + * as possible. + */ + + if (0 == strcmp(zipfs_literal_tcl_library, ZIPFS_TCL_LIBRARY_1)) { + zipfs_init_script = ZIPFS_INIT_SCRIPT_1; + } else if (0 == strcmp(zipfs_literal_tcl_library, ZIPFS_TCL_LIBRARY_2)) { + zipfs_init_script = ZIPFS_INIT_SCRIPT_2; + } else if (0 == strcmp(zipfs_literal_tcl_library, ZIPFS_TCL_LIBRARY_3)) { + zipfs_init_script = ZIPFS_INIT_SCRIPT_3; + } + if (zipfs_init_script) { + Tcl_SetPreInitScript(zipfs_init_script); + } + TclNewLiteralStringObj(subDirObj, "encoding"); Tcl_IncrRefCount(subDirObj); TclNewObj(searchPathObj); @@ -4268,13 +4302,12 @@ TclZipfs_TclLibrary(void) * Look for the library file system within the executable. */ - vfsInitScript = Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl", - -1); + vfsInitScript = Tcl_NewStringObj(ZIPFS_TCL_LIBRARY_1 "/init.tcl", -1); Tcl_IncrRefCount(vfsInitScript); found = Tcl_FSAccess(vfsInitScript, F_OK); Tcl_DecrRefCount(vfsInitScript); if (found == TCL_OK) { - zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library"; + zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1; return ScriptLibrarySetup(zipfs_literal_tcl_library); } @@ -6283,22 +6316,21 @@ ZipfsAppHookFindTclInit( return TCL_ERROR; } - TclNewLiteralStringObj(vfsInitScript, ZIPFS_ZIP_MOUNT "/init.tcl"); + TclNewLiteralStringObj(vfsInitScript, ZIPFS_TCL_LIBRARY_2 "/init.tcl"); Tcl_IncrRefCount(vfsInitScript); found = Tcl_FSAccess(vfsInitScript, F_OK); Tcl_DecrRefCount(vfsInitScript); if (found == 0) { - zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT; + zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_2; return TCL_OK; } - TclNewLiteralStringObj(vfsInitScript, - ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl"); + TclNewLiteralStringObj(vfsInitScript, ZIPFS_TCL_LIBRARY_3 "/init.tcl"); Tcl_IncrRefCount(vfsInitScript); found = Tcl_FSAccess(vfsInitScript, F_OK); Tcl_DecrRefCount(vfsInitScript); if (found == 0) { - zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT "/tcl_library"; + zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_3; return TCL_OK; } @@ -6415,12 +6447,12 @@ TclZipfs_AppHook( if (!zipfs_literal_tcl_library) { TclNewLiteralStringObj(vfsInitScript, - ZIPFS_APP_MOUNT "/tcl_library/init.tcl"); + ZIPFS_TCL_LIBRARY_1 "/init.tcl"); Tcl_IncrRefCount(vfsInitScript); found = Tcl_FSAccess(vfsInitScript, F_OK); Tcl_DecrRefCount(vfsInitScript); if (found == TCL_OK) { - zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library"; + zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1; return version; } } @@ -6449,7 +6481,7 @@ TclZipfs_AppHook( TclZipfs_TclLibrary(); TclNewLiteralStringObj(vfsInitScript, - ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl"); + ZIPFS_TCL_LIBRARY_3 "install.tcl"); Tcl_IncrRefCount(vfsInitScript); if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) { Tcl_SetStartupScript(vfsInitScript, NULL); @@ -6472,12 +6504,12 @@ TclZipfs_AppHook( } /* Set Tcl Encodings */ TclNewLiteralStringObj(vfsInitScript, - ZIPFS_APP_MOUNT "/tcl_library/init.tcl"); + ZIPFS_TCL_LIBRARY_1 "/init.tcl"); Tcl_IncrRefCount(vfsInitScript); found = Tcl_FSAccess(vfsInitScript, F_OK); Tcl_DecrRefCount(vfsInitScript); if (found == TCL_OK) { - zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library"; + zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1; return version; } } -- cgit v0.12 From b62a3d44eaf5682d190fb17bc414e45ed3b11901 Mon Sep 17 00:00:00 2001 From: oehhar Date: Sun, 12 Nov 2023 18:55:01 +0000 Subject: Bug [c4eb46a1]: endless loop on gets, non blocking, profile strict, encoding error: remove non-blocking exit condition and add test case --- generic/tclIO.c | 13 +++++++++++-- tests/io.test | 25 ++++++++++++++++++++++--- 2 files changed, 33 insertions(+), 5 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 6461909..c92fb64 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4918,8 +4918,17 @@ Tcl_GetsObj( } goto gotEOL; } else if (gs.bytesWrote == 0 - && GotFlag(statePtr, CHANNEL_ENCODING_ERROR) - && !GotFlag(statePtr, CHANNEL_NONBLOCKING)) { + && GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { + /* Ticket c4eb46a1 Harald Oehlmann 2023-11-12 debugging session. + * In non blocking mode we loop indifenitly on a decoding error in + * this while-loop. + * Removed the following from the upper condition: + * "&& !GotFlag(statePtr, CHANNEL_NONBLOCKING)" + * In case of an encoding error with leading correct bytes, we pass here + * two times, as gs.bytesWrote is not 0 on the first pass. This feels + * once to much, as the data is anyway not used. + */ + /* Set eol to the position that caused the encoding error, and then * continue to gotEOL, which stores the data that was decoded * without error to objPtr. This allows the caller to do something diff --git a/tests/io.test b/tests/io.test index 9f731ad..a6683c8 100644 --- a/tests/io.test +++ b/tests/io.test @@ -9193,7 +9193,7 @@ test io-75.5 {invalid utf-8 encoding read is ignored (-profile tcl8)} -setup { removeFile io-75.5 } -result 4181 -test io-75.6 {invalid utf-8 encoding, gets is not ignored (-profile strict)} -setup { +test io-75.6 {invalid utf-8 encoding, blocking gets is not ignored (-profile strict)} -setup { set fn [makeFile {} io-75.6] set f [open $fn w+] fconfigure $f -encoding binary @@ -9211,6 +9211,25 @@ test io-75.6 {invalid utf-8 encoding, gets is not ignored (-profile strict)} -se } -match glob -returnCodes 1 -result {error reading "file*":\ invalid or incomplete multibyte or wide character} +# TCL ticket c4eb46a196: non blocking case had endless loop, so test it +test io-75.6.2 {invalid utf-8 encoding, non blocking gets is not ignored (-profile strict)} -setup { + set fn [makeFile {} io-75.6.2] + set f [open $fn w+] + fconfigure $f -encoding binary + # \x81 is an incomplete byte sequence in utf-8 + puts -nonewline $f A\x81 + flush $f + seek $f 0 + fconfigure $f -encoding utf-8 -buffering none -eofchar {} \ + -translation lf -profile strict -blocking 0 +} -body { + gets $f +} -cleanup { + close $f + removeFile io-75.6.2 +} -match glob -returnCodes 1 -result {error reading "file*":\ + invalid or incomplete multibyte or wide character} + test io-75.7 { invalid utf-8 encoding read is not ignored (-profile strict) } -setup { @@ -9232,7 +9251,7 @@ test io-75.7 { } -match glob -result {1 {error reading "file*":\ invalid or incomplete multibyte or wide character}} -test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup { +test io-75.8 {invalid utf-8 encoding eof first handling (-profile strict)} -setup { set fn [makeFile {} io-75.8] set f [open $fn w+] fconfigure $f -encoding binary @@ -9254,7 +9273,7 @@ test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup { removeFile io-75.8 } -result {41 1 {}} -test io-75.8.eoflater {invalid utf-8 encoding eof handling (-profile strict)} -setup { +test io-75.8.eoflater {invalid utf-8 encoding eof after handling (-profile strict)} -setup { set fn [makeFile {} io-75.8] set f [open $fn w+] # This also configures the channel encoding profile as strict. -- cgit v0.12 From 44f9c28e418b785e842ac8b986daa9120d2a4b37 Mon Sep 17 00:00:00 2001 From: oehhar Date: Sun, 12 Nov 2023 19:32:07 +0000 Subject: bug [c4eb46a1]: fix was effective for test sequence "A\xC3B", but not for "A\x81". So add test io-75.6.1 with first sequence, io-75.6.2 is currently failing, as the gets does not return with an error. --- tests/io.test | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/tests/io.test b/tests/io.test index a6683c8..1078a50 100644 --- a/tests/io.test +++ b/tests/io.test @@ -9212,8 +9212,27 @@ test io-75.6 {invalid utf-8 encoding, blocking gets is not ignored (-profile str invalid or incomplete multibyte or wide character} # TCL ticket c4eb46a196: non blocking case had endless loop, so test it +# The first fix was successful with the test data A\xC3B, but not with A\x81. So, test both +test io-75.6.1 {invalid utf-8 encoding "A xc3 B", non blocking gets is not ignored (-profile strict)} -setup { + set fn [makeFile {} io-75.6.1] + set f [open $fn w+] + fconfigure $f -encoding binary + # utf-8: \xC3 requires a 2nd byte > x80, but Date: Mon, 13 Nov 2023 12:36:34 +0000 Subject: Simplify TIP #656: "A revised proposal for encodings". Make TCL_ENCODING_PROFILE_??? values the same as in Tcl 9.0 after TIP #657: Make "-profile strict" the default in Tcl 9.0 --- generic/tcl.h | 5 ++-- generic/tclCmdAH.c | 2 +- generic/tclEncoding.c | 67 +++------------------------------------------------ generic/tclInt.h | 13 +++++----- generic/tclTest.c | 2 +- generic/tclZipfs.c | 2 +- 6 files changed, 15 insertions(+), 76 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 2f1f793..5769cbd 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2180,10 +2180,9 @@ typedef struct Tcl_EncodingType { * changes, ensure ENCODING_PROFILE_* macros in tclInt.h are modified if * necessary. */ +#define TCL_ENCODING_PROFILE_STRICT TCL_ENCODING_STOPONERROR #define TCL_ENCODING_PROFILE_TCL8 0x01000000 -#define TCL_ENCODING_PROFILE_STRICT 0x02000000 -#define TCL_ENCODING_PROFILE_REPLACE 0x03000000 -#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_TCL8 +#define TCL_ENCODING_PROFILE_REPLACE 0x02000000 /* * The following definitions are the error codes returned by the conversion diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index c4b210c..e7e929f 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -673,7 +673,7 @@ EncodingConvertfromObjCmd( /* * Convert the string into a byte array in 'ds'. */ -#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9) +#if !defined(TCL_NO_DEPRECATED) if (ENCODING_PROFILE_GET(flags) == TCL_ENCODING_PROFILE_TCL8) { /* Permits high bits to be non-0 in byte array (Tcl 8 style) */ bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length); diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index e461db2..262dd01 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -192,7 +192,7 @@ Tcl_Encoding tclUtf8Encoding = NULL; * Names of encoding profiles and corresponding integer values. * Keep alphabetical order for error messages. */ -static struct TclEncodingProfiles { +static const struct TclEncodingProfiles { const char *name; int value; } encodingProfiles[] = { @@ -201,10 +201,10 @@ static struct TclEncodingProfiles { {"tcl8", TCL_ENCODING_PROFILE_TCL8}, }; #define PROFILE_STRICT(flags_) \ - (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_STRICT) + ((flags_) & TCL_ENCODING_PROFILE_STRICT) #define PROFILE_REPLACE(flags_) \ - (ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) + ((ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) && !PROFILE_STRICT(flags_)) #define UNICODE_REPLACE_CHAR ((Tcl_UniChar)0xFFFD) #define SURROGATE(c_) (((c_) & ~0x7FF) == 0xD800) @@ -1229,10 +1229,6 @@ Tcl_ExternalToUtfDString( * Possible flags values: * target encoding. It should be composed by OR-ing the following: * - *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT} - * - TCL_ENCODING_STOPONERROR: Backward compatibility. Sets the profile - * to TCL_ENCODING_PROFILE_STRICT overriding any specified profile flags - * Any other flag bits will cause an error to be returned (for future - * compatibility) * * Results: * The return value is one of @@ -1535,8 +1531,6 @@ Tcl_UtfToExternalDString( * the source buffer are invalid or cannot be represented in the * target encoding. It should be composed by OR-ing the following: * - *At most one* of TCL_ENCODING_PROFILE_* - * - TCL_ENCODING_STOPONERROR: Backward compatibility. Sets the profile - * to TCL_ENCODING_PROFILE_STRICT overriding any specified profile flags * * Results: * The return value is one of @@ -2459,7 +2453,6 @@ BinaryProc( if (dstLen < 0) { dstLen = 0; } - flags = TclEncodingSetProfileFlags(flags); if ((flags & TCL_ENCODING_CHAR_LIMIT) && srcLen > *dstCharsPtr) { srcLen = *dstCharsPtr; } @@ -2527,7 +2520,6 @@ UtfToUtfProc( srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; - flags = TclEncodingSetProfileFlags(flags); if ((flags & TCL_ENCODING_END) == 0) { srcClose -= 6; } @@ -2743,7 +2735,6 @@ Utf32ToUtfProc( int result, numChars, charLimit = INT_MAX; int ch = 0, bytesLeft = srcLen % 4; - flags = TclEncodingSetProfileFlags(flags); flags |= PTR2INT(clientData); if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; @@ -2900,7 +2891,6 @@ UtfToUtf32Proc( srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; - flags = TclEncodingSetProfileFlags(flags); if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } @@ -2998,7 +2988,6 @@ Utf16ToUtfProc( int result, numChars, charLimit = INT_MAX; unsigned short ch = 0; - flags = TclEncodingSetProfileFlags(flags); flags |= PTR2INT(clientData); if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; @@ -3159,7 +3148,6 @@ UtfToUtf16Proc( srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; - flags = TclEncodingSetProfileFlags(flags); if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } @@ -3265,7 +3253,6 @@ UtfToUcs2Proc( int result, numChars, len; Tcl_UniChar ch = 0; - flags = TclEncodingSetProfileFlags(flags); flags |= PTR2INT(clientData); srcStart = src; srcEnd = src + srcLen; @@ -3375,7 +3362,6 @@ TableToUtfProc( const unsigned short *pageZero; TableEncodingData *dataPtr = (TableEncodingData *)clientData; - flags = TclEncodingSetProfileFlags(flags); if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } @@ -3508,7 +3494,6 @@ TableFromUtfProc( srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; - flags = TclEncodingSetProfileFlags(flags); if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } @@ -3609,7 +3594,6 @@ Iso88591ToUtfProc( const char *dstEnd, *dstStart; int result, numChars, charLimit = INT_MAX; - flags = TclEncodingSetProfileFlags(flags); if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } @@ -3694,7 +3678,6 @@ Iso88591FromUtfProc( srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; - flags = TclEncodingSetProfileFlags(flags); if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } @@ -3834,7 +3817,6 @@ EscapeToUtfProc( int state, result, numChars, charLimit = INT_MAX; const char *dstStart, *dstEnd; - flags = TclEncodingSetProfileFlags(flags); if (flags & TCL_ENCODING_CHAR_LIMIT) { charLimit = *dstCharsPtr; } @@ -4056,7 +4038,6 @@ EscapeFromUtfProc( srcStart = src; srcEnd = src + srcLen; srcClose = srcEnd; - flags = TclEncodingSetProfileFlags(flags); if ((flags & TCL_ENCODING_END) == 0) { srcClose -= TCL_UTF_MAX; } @@ -4505,48 +4486,6 @@ TclEncodingProfileIdToName( /* *------------------------------------------------------------------------ * - * TclEncodingSetProfileFlags -- - * - * Maps the flags supported in the encoding C API's to internal flags. - * - * For backward compatibility reasons, TCL_ENCODING_STOPONERROR is - * is mapped to the TCL_ENCODING_PROFILE_STRICT overwriting any profile - * specified. - * - * If no profile or an invalid profile is specified, it is set to - * the default. - * - * Results: - * Internal encoding flag mask. - * - * Side effects: - * None. - * - *------------------------------------------------------------------------ - */ -int TclEncodingSetProfileFlags(int flags) -{ - if (flags & TCL_ENCODING_STOPONERROR) { - ENCODING_PROFILE_SET(flags, TCL_ENCODING_PROFILE_STRICT); - } else { - int profile = ENCODING_PROFILE_GET(flags); - switch (profile) { - case TCL_ENCODING_PROFILE_TCL8: - case TCL_ENCODING_PROFILE_STRICT: - case TCL_ENCODING_PROFILE_REPLACE: - break; - case 0: /* Unspecified by caller */ - default: - ENCODING_PROFILE_SET(flags, TCL_ENCODING_PROFILE_TCL8); - break; - } - } - return flags; -} - -/* - *------------------------------------------------------------------------ - * * TclGetEncodingProfiles -- * * Get the list of supported encoding profiles. diff --git a/generic/tclInt.h b/generic/tclInt.h index 0b46184..3d8a702 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2886,11 +2886,13 @@ typedef struct ProcessGlobalValue { */ #define ENCODING_PROFILE_MASK 0xFF000000 -#define ENCODING_PROFILE_GET(flags_) ((flags_) & ENCODING_PROFILE_MASK) -#define ENCODING_PROFILE_SET(flags_, profile_) \ - do { \ - (flags_) &= ~ENCODING_PROFILE_MASK; \ - (flags_) |= profile_; \ +#define ENCODING_PROFILE_GET(flags_) (((flags_) & TCL_ENCODING_PROFILE_STRICT) ? \ + TCL_ENCODING_PROFILE_STRICT : (((flags_) & ENCODING_PROFILE_MASK) ? \ + ((flags_) & ENCODING_PROFILE_MASK) : TCL_ENCODING_PROFILE_TCL8)) +#define ENCODING_PROFILE_SET(flags_, profile_) \ + do { \ + (flags_) &= ~(ENCODING_PROFILE_MASK|TCL_ENCODING_PROFILE_STRICT); \ + (flags_) |= (profile_) & (ENCODING_PROFILE_MASK|TCL_ENCODING_PROFILE_STRICT); \ } while (0) /* @@ -2916,7 +2918,6 @@ TclEncodingProfileNameToId(Tcl_Interp *interp, int *profilePtr); MODULE_SCOPE const char *TclEncodingProfileIdToName(Tcl_Interp *interp, int profileId); -MODULE_SCOPE int TclEncodingSetProfileFlags(int flags); MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp); /* diff --git a/generic/tclTest.c b/generic/tclTest.c index 6a90b67..0decc21 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -2092,7 +2092,7 @@ static int UtfExtWrapper( } flagMap[] = { {"start", TCL_ENCODING_START}, {"end", TCL_ENCODING_END}, - {"stoponerror", TCL_ENCODING_STOPONERROR}, + {"stoponerror", TCL_ENCODING_PROFILE_STRICT}, {"noterminate", TCL_ENCODING_NO_TERMINATE}, {"charlimit", TCL_ENCODING_CHAR_LIMIT}, {"profiletcl8", TCL_ENCODING_PROFILE_TCL8}, diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 842d51a..5df300a 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -906,7 +906,7 @@ DecodeZipEntryText( dst = Tcl_DStringValue(dstPtr); dstLen = dstPtr->spaceAvl - 1; flags = TCL_ENCODING_START | TCL_ENCODING_END | - TCL_ENCODING_STOPONERROR; /* Special flag! */ + TCL_ENCODING_PROFILE_STRICT; /* Special flag! */ while (1) { int srcRead, dstWrote; -- cgit v0.12 From f2f65837424c0c2203228c46a3274edff4eb9265 Mon Sep 17 00:00:00 2001 From: oehhar Date: Mon, 13 Nov 2023 12:48:06 +0000 Subject: Bug [c4eb46a1]: non-blocking gets fires the error on 2nd call when sequence is incomplete. Added some test cases. --- generic/tclIO.c | 6 ++++++ tests/io.test | 56 ++++++++++++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 54 insertions(+), 8 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index c92fb64..bc1b1c6 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4749,6 +4749,12 @@ Tcl_GetsObj( ResetFlag(statePtr, CHANNEL_BLOCKED); while (1) { if (dst >= dstEnd) { + /* + * In case of encoding errors, state gets flag + * CHANNEL_ENCODING_ERROR set in the call below. First, the + * EOF/EOL condition is checked, as we may have valid data with + * EOF/EOL before the encoding error. + */ if (FilterInputBytes(chanPtr, &gs) != 0) { goto restore; } diff --git a/tests/io.test b/tests/io.test index 1078a50..7e62e6b 100644 --- a/tests/io.test +++ b/tests/io.test @@ -9193,7 +9193,7 @@ test io-75.5 {invalid utf-8 encoding read is ignored (-profile tcl8)} -setup { removeFile io-75.5 } -result 4181 -test io-75.6 {invalid utf-8 encoding, blocking gets is not ignored (-profile strict)} -setup { +test io-75.6 {incomplete utf-8 encoding, blocking gets is not ignored (-profile strict)} -setup { set fn [makeFile {} io-75.6] set f [open $fn w+] fconfigure $f -encoding binary @@ -9211,9 +9211,7 @@ test io-75.6 {invalid utf-8 encoding, blocking gets is not ignored (-profile str } -match glob -returnCodes 1 -result {error reading "file*":\ invalid or incomplete multibyte or wide character} -# TCL ticket c4eb46a196: non blocking case had endless loop, so test it -# The first fix was successful with the test data A\xC3B, but not with A\x81. So, test both -test io-75.6.1 {invalid utf-8 encoding "A xc3 B", non blocking gets is not ignored (-profile strict)} -setup { +test io-75.6.1 {invalid utf-8 encoding, blocking gets is not ignored (-profile strict)} -setup { set fn [makeFile {} io-75.6.1] set f [open $fn w+] fconfigure $f -encoding binary @@ -9222,7 +9220,7 @@ test io-75.6.1 {invalid utf-8 encoding "A xc3 B", non blocking gets is not ignor flush $f seek $f 0 fconfigure $f -encoding utf-8 -buffering none -eofchar {} \ - -translation lf -profile strict -blocking 0 + -translation lf -profile strict } -body { gets $f } -cleanup { @@ -9231,8 +9229,48 @@ test io-75.6.1 {invalid utf-8 encoding "A xc3 B", non blocking gets is not ignor } -match glob -returnCodes 1 -result {error reading "file*":\ invalid or incomplete multibyte or wide character} -test io-75.6.2 {invalid utf-8 encoding, non blocking gets is not ignored (-profile strict)} -setup { - set fn [makeFile {} io-75.6.1] +test io-75.6.2 {invalid utf-8 encoding, blocking gets is not ignored (-profile strict), recover functionality} -setup { + set fn [makeFile {} io-75.6.2] + set f [open $fn w+] + fconfigure $f -encoding binary + # utf-8: \xC3 requires a 2nd byte > x80, but x80, but Date: Mon, 13 Nov 2023 13:46:31 +0000 Subject: Fix for TIP #641: If sizeof(*(boolPtr)) > sizeof(int), generate a compiler-error. Requested by @pointsman --- generic/tclDecls.h | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 0fe582e..5768233 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4331,23 +4331,29 @@ extern const TclStubs *tclStubsPtr; #undef Tcl_GetIndexFromObjStruct #undef Tcl_GetBooleanFromObj #undef Tcl_GetBoolean +#ifdef __GNUC__ + /* If this gives: "error: size of array ‘_boolVar’ is negative", it means that sizeof(*boolPtr)>sizeof(int), which is not allowed */ +# define TCLBOOLWARNING(boolPtr) ({__attribute__((unused)) char _bool_Var[sizeof(*(boolPtr)) > sizeof(int) ? -1 : 1];}), +#else +# define TCLBOOLWARNING(boolPtr) +#endif #if defined(USE_TCL_STUBS) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ - (sizeof(*(boolPtr)) == sizeof(int) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ + (sizeof(*(boolPtr)) >= sizeof(int) ? (TCLBOOLWARNING(boolPtr)tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr))) : \ Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #define Tcl_GetBoolean(interp, src, boolPtr) \ - (sizeof(*(boolPtr)) == sizeof(int) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ + (sizeof(*(boolPtr)) >= sizeof(int) ? (TCLBOOLWARNING(boolPtr)tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr))) : \ Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #else #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ - (sizeof(*(boolPtr)) == sizeof(int) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ + (sizeof(*(boolPtr)) >= sizeof(int) ? (TCLBOOLWARNING(boolPtr)Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr))) : \ Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #define Tcl_GetBoolean(interp, src, boolPtr) \ - (sizeof(*(boolPtr)) == sizeof(int) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ + (sizeof(*(boolPtr)) >= sizeof(int) ? (TCLBOOLWARNING(boolPtr)Tcl_GetBoolean(interp, src, (int *)(boolPtr))) : \ Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #endif -- cgit v0.12 From 323c70e2f7d531aa7305d0ffaa3b9ed3087ea178 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 13 Nov 2023 14:16:41 +0000 Subject: Remnants from TIP 567's implementation. The feature was done ages ago. --- generic/tclOODefineCmds.c | 42 +++++++++++++++++++++++++---- tests/oo.test | 69 ++++++++++++++++++++++++++++++----------------- tests/ooUtil.test | 23 ++++++++++++++++ 3 files changed, 105 insertions(+), 29 deletions(-) diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 034c877..a88a27e 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -2455,9 +2455,13 @@ ClassMixinSet( Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - int mixinc, i; + int mixinc, i, isNew; Tcl_Obj **mixinv; - Class **mixins; + Class **mixins;; /* The references to the classes to actually + * install. */ + Tcl_HashTable uniqueCheck; /* Note that this hash table is just used as a + * set of class references; it has no payload + * values and keys are always pointers. */ if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, @@ -2479,6 +2483,7 @@ ClassMixinSet( } mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc); + Tcl_InitHashTable(&uniqueCheck, TCL_ONE_WORD_KEYS); for (i = 0; i < mixinc; i++) { mixins[i] = GetClassInOuterContext(interp, mixinv[i], @@ -2487,6 +2492,13 @@ ClassMixinSet( i--; goto freeAndError; } + (void) Tcl_CreateHashEntry(&uniqueCheck, (void *) mixins[i], &isNew); + if (!isNew) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "class should only be a direct mixin once", -1)); + Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL); + goto freeAndError; + } if (TclOOIsReachable(oPtr->classPtr, mixins[i])) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not mix a class into itself", -1)); @@ -2496,10 +2508,12 @@ ClassMixinSet( } TclOOClassSetMixins(interp, oPtr->classPtr, mixinc, mixins); + Tcl_DeleteHashTable(&uniqueCheck); TclStackFree(interp, mixins); return TCL_OK; freeAndError: + Tcl_DeleteHashTable(&uniqueCheck); TclStackFree(interp, mixins); return TCL_ERROR; } @@ -2906,10 +2920,15 @@ ObjMixinSet( Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - int mixinc; + int mixinc, i, isNew; Tcl_Obj **mixinv; Class **mixins; int i; + Class **mixins; /* The references to the classes to actually + * install. */ + Tcl_HashTable uniqueCheck; /* Note that this hash table is just used as a + * set of class references; it has no payload + * values and keys are always pointers. */ if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, @@ -2925,19 +2944,32 @@ ObjMixinSet( } mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc); + Tcl_InitHashTable(&uniqueCheck, TCL_ONE_WORD_KEYS); for (i = 0; i < mixinc; i++) { mixins[i] = GetClassInOuterContext(interp, mixinv[i], "may only mix in classes"); if (mixins[i] == NULL) { - TclStackFree(interp, mixins); - return TCL_ERROR; + goto freeAndError; + } + (void) Tcl_CreateHashEntry(&uniqueCheck, (void *) mixins[i], &isNew); + if (!isNew) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "class should only be a direct mixin once", -1)); + Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL); + goto freeAndError; } } TclOOObjectSetMixins(oPtr, mixinc, mixins); TclStackFree(interp, mixins); + Tcl_DeleteHashTable(&uniqueCheck); return TCL_OK; + + freeAndError: + TclStackFree(interp, mixins); + Tcl_DeleteHashTable(&uniqueCheck); + return TCL_ERROR; } /* diff --git a/tests/oo.test b/tests/oo.test index 291060d..cf8b710 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -1685,9 +1685,7 @@ test oo-11.5 {OO: cleanup} { return done } done -test oo-11.6.1 { - OO: cleanup of when an class is mixed into itself -} -constraints memory -body { +test oo-11.6.1 {OO: cleanup of when an class is mixed into itself} -constraints memory -body { leaktest { interp create interp1 oo::class create obj1 @@ -1695,13 +1693,8 @@ test oo-11.6.1 { rename obj1 {} interp delete interp1 } -} -result 0 -cleanup { -} - -test oo-11.6.2 { - OO: cleanup ReleaseClassContents() where class is mixed into one of its - instances -} -constraints memory -body { +} -result 0 +test oo-11.6.2 {OO: cleanup ReleaseClassContents() where class is mixed into one of its instances} -constraints memory -body { leaktest { interp create interp1 interp1 eval { @@ -1712,13 +1705,8 @@ test oo-11.6.2 { } interp delete interp1 } -} -result 0 -cleanup { -} - -test oo-11.6.3 { - OO: cleanup ReleaseClassContents() where class is mixed into one of its - instances -} -constraints memory -body { +} -result 0 +test oo-11.6.3 {OO: cleanup ReleaseClassContents() where class is mixed into one of its instances} -constraints memory -body { leaktest { interp create interp1 interp1 eval { @@ -1731,13 +1719,8 @@ test oo-11.6.3 { } interp delete interp1 } -} -result 0 -cleanup { -} - -test oo-11.6.4 { - OO: cleanup ReleaseClassContents() where class is mixed into one of its - instances -} -body { +} -result 0 +test oo-11.6.4 {OO: cleanup ReleaseClassContents() where class is mixed into one of its instances} -body { oo::class create obj1 ::oo::define obj1 {self mixin [self]} @@ -2218,6 +2201,31 @@ test oo-14.8 {OO: class mixin order - Bug 1998221} -setup { } [cls new] test } -result {mix cls} +test oo-14.9 {OO: class mixins must be unique in list} -setup { + oo::class create parent +} -body { + oo::class create A {superclass parent} + oo::class create B { + superclass parent + mixin A + } + oo::define B mixin -append A +} -returnCodes error -cleanup { + parent destroy +} -result {class should only be a direct mixin once} +test oo-14.10 {OO: instance mixins must be unique in list} -setup { + oo::class create parent +} -body { + oo::class create A {superclass parent} + oo::class create B { + superclass parent + constructor {} {oo::objdefine [self] mixin A} + } + B create obj + oo::objdefine obj {mixin -append A} +} -returnCodes error -cleanup { + parent destroy +} -result {class should only be a direct mixin once} test oo-15.1 {OO: object cloning} { oo::class create Aclass @@ -4198,6 +4206,19 @@ test oo-33.4 {TIP 380: slots - errors} -setup [SampleSlotSetup { rename $s {} }] -result \ {unknown method "-grill": must be -append, -appendifnew, -clear, -prepend, -remove, -set, contents or ops} +test oo-33.5 {TIP 567: slots -appendifnew} -setup [SampleSlotSetup { + set s [SampleSlot new] +}] -body { + list \ + [$s -clear + $s contents] \ + [$s -append p q r + $s contents] \ + [$s -appendifnew q s r t p + $s contents] +} -cleanup [SampleSlotCleanup { + rename $s {} +}] -result {{} {p q r} {p q r s t}} test oo-34.1 {TIP 380: slots - presence} -setup { set obj [oo::object new] diff --git a/tests/ooUtil.test b/tests/ooUtil.test index f41c668..9e1de8f 100644 --- a/tests/ooUtil.test +++ b/tests/ooUtil.test @@ -527,6 +527,29 @@ test ooUtil-7.2 {TIP 478: link removed when [my] disappears} -setup { parent destroy } -result {{in foo of ::o} {in foo of ::o} {} 1 {invalid command name "pqr"}} +# Tests a very weird combination of things (with a key problem locus in +# MixinClassDelegates) that TIP 567 fixes +test ooUtil-8.1 {TIP 567: call oo::define twice from metaclass constructor} -setup { + oo::class create parent +} -body { + ::oo::class create A { + superclass parent + } + ::oo::class create B { + superclass ::oo::class parent + constructor {{definitionScript ""}} { + next $definitionScript + next {superclass ::A} + } + } + B create C { + superclass A + } + C create instance +} -cleanup { + parent destroy +} -result ::instance + # Tests that verify issues detected with the tcllib version of the code test ooUtil-tcllib-ticket-b3577ed586 {test scoping of delegation in oo::class.Delegate } -setup { oo::class create animal {} -- cgit v0.12 From da8146f9dd5831b776f3369cd9e4d15ca8698f45 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 13 Nov 2023 14:49:45 +0000 Subject: Blooperfix --- generic/tclOODefineCmds.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index a88a27e..5f10475 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -2922,8 +2922,6 @@ ObjMixinSet( Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); int mixinc, i, isNew; Tcl_Obj **mixinv; - Class **mixins; - int i; Class **mixins; /* The references to the classes to actually * install. */ Tcl_HashTable uniqueCheck; /* Note that this hash table is just used as a -- cgit v0.12 From a71edde2eaa93e4663f869fc1301d702a6eaef61 Mon Sep 17 00:00:00 2001 From: oehhar Date: Mon, 13 Nov 2023 17:38:29 +0000 Subject: Bug [a173f922]: fcopy encoding error file position issues: read error test (failing currently) --- tests/io.test | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/tests/io.test b/tests/io.test index 7e62e6b..f3402f3 100644 --- a/tests/io.test +++ b/tests/io.test @@ -7654,6 +7654,37 @@ test io-52.20 {TclCopyChannel & encodings} -setup { close $in close $out } -returnCodes 1 -match glob -result {error reading "file*": invalid or incomplete multibyte or wide character} + +test io-52.20.1 {TclCopyChannel & read encoding error & tell position} -setup { + set out [open $path(utf8-fcopy.txt) w] + fconfigure $out -encoding utf-8 -translation lf + puts $out "AÁ" + close $out +} -constraints {fcopy} -body { + # binary to encoding => the input has to be + # in utf-8 to make sense to the encoder + + set in [open $path(utf8-fcopy.txt) r] + set out [open $path(kyrillic.txt) w] + + # Using "-encoding ascii" means reading the "Á" gives an error + fconfigure $in -encoding ascii -profile strict + fconfigure $out -encoding koi8-r -translation lf + + set l {} + # should fail, so 1 is added + lappend l [catch {fcopy $in $out}] + # should be at position 1, after the first correct byte, so 1 is read. + lappend l [tell $in] + # not sure, if flush required, but anyway + flush $out + # should be at position 1, after the first correct byte, so 1 is written. + lappend l [tell $out] +} -cleanup { + close $in + close $out +} -returnCodes 0 -result {1 1 1} + test io-52.21 {TclCopyChannel & encodings} -setup { set out [open $path(utf8-fcopy.txt) w] fconfigure $out -encoding utf-8 -translation lf -- cgit v0.12 From 4c391a13ae96bbc5307b97af37bafa4e58ab5b86 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 13 Nov 2023 19:24:20 +0000 Subject: Make calls early to find the script library in zipfs archive and alert the Tcl library to its location so that all interps find it when created. --- generic/tclZipfs.c | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index adb7802..36fc82a 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -6453,6 +6453,7 @@ TclZipfs_AppHook( Tcl_DecrRefCount(vfsInitScript); if (found == TCL_OK) { zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1; + Tcl_DecrRefCount(TclZipfs_TclLibrary()); return version; } } @@ -6479,7 +6480,7 @@ TclZipfs_AppHook( * wants it. */ - TclZipfs_TclLibrary(); + Tcl_DecrRefCount(TclZipfs_TclLibrary()); TclNewLiteralStringObj(vfsInitScript, ZIPFS_TCL_LIBRARY_3 "install.tcl"); Tcl_IncrRefCount(vfsInitScript); @@ -6491,6 +6492,17 @@ TclZipfs_AppHook( int found; Tcl_Obj *vfsInitScript; + /* Set Tcl Encodings */ + TclNewLiteralStringObj(vfsInitScript, + ZIPFS_TCL_LIBRARY_1 "/init.tcl"); + Tcl_IncrRefCount(vfsInitScript); + found = Tcl_FSAccess(vfsInitScript, F_OK); + Tcl_DecrRefCount(vfsInitScript); + if (found == TCL_OK) { + zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1; + Tcl_DecrRefCount(TclZipfs_TclLibrary()); + } + TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl"); Tcl_IncrRefCount(vfsInitScript); if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) { @@ -6502,14 +6514,8 @@ TclZipfs_AppHook( } else { Tcl_DecrRefCount(vfsInitScript); } - /* Set Tcl Encodings */ - TclNewLiteralStringObj(vfsInitScript, - ZIPFS_TCL_LIBRARY_1 "/init.tcl"); - Tcl_IncrRefCount(vfsInitScript); - found = Tcl_FSAccess(vfsInitScript, F_OK); - Tcl_DecrRefCount(vfsInitScript); + if (found == TCL_OK) { - zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1; return version; } } -- cgit v0.12 From 480e67920e6d8c3b9c536cfc1683f6349a9b319a Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 13 Nov 2023 19:36:30 +0000 Subject: Now that the robust, early method of directing Tcl to find its script library in the zipfs archive is in place, we can yank out the hacky approach of defining a semi-secret command to extend a search path. Re-open the feature branch. Integration was pulled back when some reports of failures on some build configurations came in. --- generic/tclInterp.c | 1 - generic/tclZipfs.c | 40 ---------------------------------------- 2 files changed, 41 deletions(-) diff --git a/generic/tclInterp.c b/generic/tclInterp.c index ed3c527..b023615 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -402,7 +402,6 @@ Tcl_Init( "if {$tail eq [info tclversion]} continue\n" "file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n" " }\n" -" lappend scripts {::tcl::zipfs::tcl_library_init}\n" " if {[info exists tclDefaultLibrary]} {\n" " lappend scripts {set tclDefaultLibrary}\n" " } else {\n" diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 36fc82a..adabcda 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -4356,44 +4356,6 @@ TclZipfs_TclLibrary(void) /* *------------------------------------------------------------------------- * - * ZipFSTclLibraryObjCmd -- - * - * This procedure is invoked to process the - * [::tcl::zipfs::tcl_library_init] command, usually called during the - * execution of Tcl's interpreter startup. It returns the root that Tcl's - * library files are mounted under. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * May initialise the cache of where such library files are to be found. - * This cache is never cleared. - * - *------------------------------------------------------------------------- - */ - -static int -ZipFSTclLibraryObjCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - TCL_UNUSED(int) /*objc*/, - TCL_UNUSED(Tcl_Obj *const *)) /*objv*/ -{ - if (!Tcl_IsSafe(interp)) { - Tcl_Obj *pResult = TclZipfs_TclLibrary(); - - if (!pResult) { - TclNewObj(pResult); - } - Tcl_SetObjResult(interp, pResult); - } - return TCL_OK; -} - -/* - *------------------------------------------------------------------------- - * * ZipChannelClose -- * * This function is called to close a channel. @@ -6286,8 +6248,6 @@ TclZipfs_Init( Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj); Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1), Tcl_NewStringObj("::tcl::zipfs::find", -1)); - Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init", - ZipFSTclLibraryObjCmd, NULL, NULL); Tcl_PkgProvide(interp, "tcl::zipfs", "2.0"); } return TCL_OK; -- cgit v0.12 From 097954529a4f7cbc2bba17841f07a4283b68f1cc Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 13 Nov 2023 20:10:15 +0000 Subject: remove debugs --- generic/tclCmdAH.c | 2 -- generic/tclEncoding.c | 6 ------ generic/tclInterp.c | 8 -------- generic/tclZipfs.c | 1 - 4 files changed, 17 deletions(-) diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 86f1cda..e7e929f 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -865,13 +865,11 @@ EncodingDirsObjCmd( return TCL_ERROR; } if (objc == 1) { -fprintf(stdout, "ED GET CALLER\n"); fflush(stdout); Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath()); return TCL_OK; } dirListObj = objv[1]; -fprintf(stdout, "ED SET CALLER\n"); fflush(stdout); if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected directory list but got \"%s\"", diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index ff73904..1d87622 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -439,7 +439,6 @@ FillEncodingFileMap(void) Tcl_Size i, numDirs = 0; Tcl_Obj *map, *searchPath; -fprintf(stdout, "FEFM CALLER\n"); fflush(stdout); searchPath = Tcl_GetEncodingSearchPath(); Tcl_IncrRefCount(searchPath); TclListObjLengthM(NULL, searchPath, &numDirs); @@ -723,7 +722,6 @@ Tcl_GetDefaultEncodingDir(void) { int numDirs; Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath(); -fprintf(stdout, "GDE CALLER\n"); fflush(stdout); TclListObjLengthM(NULL, searchPath, &numDirs); if (numDirs == 0) { @@ -760,7 +758,6 @@ Tcl_SetDefaultEncodingDir( searchPath = Tcl_DuplicateObj(searchPath); Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory); -fprintf(stdout, "SDE CALLER\n"); fflush(stdout); Tcl_SetEncodingSearchPath(searchPath); } #endif @@ -1775,7 +1772,6 @@ OpenEncodingFileChannel( Tcl_Obj **dir, *path, *directory = NULL; Tcl_Channel chan = NULL; Tcl_Size i, numDirs; -fprintf(stdout, "OEFC CALLER\n"); fflush(stdout); TclListObjGetElementsM(NULL, searchPath, &numDirs, &dir); Tcl_IncrRefCount(nameObj); @@ -4317,8 +4313,6 @@ InitializeEncodingSearchPath( Tcl_Size i, numDirs, numBytes; Tcl_Obj *libPathObj, *encodingObj, *searchPathObj; -fprintf(stdout, "IESP\n"); fflush(stdout); - TclNewLiteralStringObj(encodingObj, "encoding"); TclNewObj(searchPathObj); Tcl_IncrRefCount(encodingObj); diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 0325091..b023615 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -393,25 +393,19 @@ Tcl_Init( " rename tclInit {}\n" " if {[info exists tcl_library]} {\n" " set scripts {{set tcl_library}}\n" -"puts A-SCRIPTS:$scripts\n" " } else {\n" " set scripts {}\n" " if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n" " lappend scripts {set env(TCL_LIBRARY)}\n" -"puts B-SCRIPTS:$scripts\n" " lappend scripts {\n" "if {[regexp ^tcl(.*)$ [file tail $env(TCL_LIBRARY)] -> tail] == 0} continue\n" "if {$tail eq [info tclversion]} continue\n" "file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n" -"puts C-SCRIPTS:$scripts\n" " }\n" -"puts D-SCRIPTS:$scripts\n" " if {[info exists tclDefaultLibrary]} {\n" " lappend scripts {set tclDefaultLibrary}\n" -"puts E-SCRIPTS:$scripts\n" " } else {\n" " lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n" -"puts F-SCRIPTS:$scripts\n" " }\n" " lappend scripts {\n" "set parentDir [file dirname [file dirname [info nameofexecutable]]]\n" @@ -430,14 +424,12 @@ Tcl_Init( " lappend scripts [list lindex \\$tcl_libPath $i]\n" " }\n" " }\n" -"puts G-SCRIPTS:$scripts\n" " }\n" " set dirs {}\n" " set errors {}\n" " foreach script $scripts {\n" " lappend dirs [eval $script]\n" " set tcl_library [lindex $dirs end]\n" -"puts TRIAL:$tcl_library\n" " set tclfile [file join $tcl_library init.tcl]\n" " if {[file exists $tclfile]} {\n" " if {[catch {uplevel #0 [list source $tclfile]} msg opts]} {\n" diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 5400f92..adabcda 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -4272,7 +4272,6 @@ ScriptLibrarySetup( Tcl_FSJoinToPath(libDirObj, 1, &subDirObj)); Tcl_DecrRefCount(subDirObj); Tcl_IncrRefCount(searchPathObj); -fprintf(stdout, "AH CALLER\n"); fflush(stdout); Tcl_SetEncodingSearchPath(searchPathObj); Tcl_DecrRefCount(searchPathObj); return libDirObj; -- cgit v0.12 From 2e628b79d9fe0fe590cbab9bea27c1fdf11082f9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 14 Nov 2023 11:07:13 +0000 Subject: Add test for blocking mode --- generic/tclIO.c | 29 ++++++++++++++++++++++++++++- generic/tclIOCmd.c | 12 ++++++------ generic/tclInt.h | 1 + tests/io.test | 4 ++-- 4 files changed, 37 insertions(+), 9 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index bc1b1c6..0047f0b 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -4934,7 +4934,7 @@ Tcl_GetsObj( * two times, as gs.bytesWrote is not 0 on the first pass. This feels * once to much, as the data is anyway not used. */ - + /* Set eol to the position that caused the encoding error, and then * continue to gotEOL, which stores the data that was decoded * without error to objPtr. This allows the caller to do something @@ -7616,6 +7616,33 @@ Tcl_Eof( return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0; } + +/* + *---------------------------------------------------------------------- + * + * TclChannelGetBlockingMode -- + * + * Returns 1 if the channel is in blocking mode (default), 0 otherwise. + * + * Results: + * 1 or 0, always. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclChannelGetBlockingMode( + Tcl_Channel chan) +{ + ChannelState *statePtr = ((Channel *) chan)->state; + /* State of real channel structure. */ + + return GotFlag(statePtr, CHANNEL_NONBLOCKING) ? 0 : 1; +} + /* *---------------------------------------------------------------------- * diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 0827858..9667419 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -459,11 +459,9 @@ Tcl_ReadObjCmd( TclChannelPreserve(chan); charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0); if (charactersRead == TCL_IO_FAILURE) { - - Tcl_Obj *returnOptsPtr = Tcl_NewDictObj(); - /* check for blocking and encoding error */ - /* TODO: check for blocking missing */ - if ( Tcl_GetErrno() == EILSEQ ) { + Tcl_Obj *returnOptsPtr = NULL; + if (TclChannelGetBlockingMode(chan)) { + returnOptsPtr = Tcl_NewDictObj(); Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-data", -1), resultPtr); } @@ -480,7 +478,9 @@ Tcl_ReadObjCmd( TclGetString(chanObjPtr), Tcl_PosixError(interp))); } TclChannelRelease(chan); - Tcl_SetReturnOptions(interp, returnOptsPtr); + if (returnOptsPtr) { + Tcl_SetReturnOptions(interp, returnOptsPtr); + } return TCL_ERROR; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 3d8a702..f696ad2 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3112,6 +3112,7 @@ MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, MODULE_SCOPE double TclCeil(const void *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); +MODULE_SCOPE int TclChannelGetBlockingMode(Tcl_Channel chan); MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr, Var *arrayPtr, Tcl_Obj *name, int index); MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp, diff --git a/tests/io.test b/tests/io.test index 0737c2d..75e30aa 100644 --- a/tests/io.test +++ b/tests/io.test @@ -9432,13 +9432,13 @@ test io-75.11 {shiftjis encoding error read results in error (strict profile)} - } -body { set d [read $f] binary scan $d H* hd - lappend hd [catch {set d [read $f]} msg data] $msg [dict get $data -data] + lappend hd [catch {set d [read $f]} msg data] $msg [dict exists $data -data] } -cleanup { close $f removeFile io-75.11 unset d hd msg data f } -match glob -result {41 1 {error reading "file*":\ - invalid or incomplete multibyte or wide character} {}} + invalid or incomplete multibyte or wide character} 0} test io-75.12 {invalid utf-8 encoding read is ignored} -setup { set fn [makeFile {} io-75.12] -- cgit v0.12 From 456e424004de1693404ba54320c66a3852fc43e6 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 14 Nov 2023 18:48:38 +0000 Subject: Missing/broken test constraints --- tests/abstractlist.test | 99 +++++++++++++++++++++++++------------------------ tests/binary.test | 2 +- tests/dict.test | 12 +++--- 3 files changed, 59 insertions(+), 54 deletions(-) diff --git a/tests/abstractlist.test b/tests/abstractlist.test index e7e02eb..79c30fb 100644 --- a/tests/abstractlist.test +++ b/tests/abstractlist.test @@ -16,6 +16,9 @@ catch { } testConstraint testevalex [llength [info commands testevalex]] +testConstraint testobj [llength [info commands testobj]] +testConstraint lstring [llength [info commands lstring]] +testConstraint lgen [llength [info commands lgegenn]] set abstractlisttestvars [info var *] @@ -30,18 +33,18 @@ proc value-cmp {vara varb} { set str "If you can keep your head when all about you Are losing theirs and blaming it on you," set str2 "If you can trust yourself when all men doubt you, But make allowance for their doubting, too." -test abstractlist-1.0 {error cases} -body { +test abstractlist-1.0 {error cases} -constraints lstring -body { lstring } \ -returnCodes 1 \ -result {wrong # args: should be "lstring string"} -test abstractlist-1.1 {error cases} -body { +test abstractlist-1.1 {error cases} -constraints lstring -body { lstring a b c } -returnCodes 1 \ -result {wrong # args: should be "lstring string"} -test abstractlist-2.0 {no shimmer llength} -body { +test abstractlist-2.0 {no shimmer llength} -constraints {testobj lstring} -body { set l [lstring $str] set l-isa [testobj objtype $l] set len [llength $l] @@ -51,7 +54,7 @@ test abstractlist-2.0 {no shimmer llength} -body { unset l } -result {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring 85 lstring} -test abstractlist-2.1 {no shimmer lindex} { +test abstractlist-2.1 {no shimmer lindex} {testobj lstring} { set l [lstring $str] set l-isa [testobj objtype $l] set ele [lindex $l 22] @@ -59,7 +62,7 @@ test abstractlist-2.1 {no shimmer lindex} { list $l ${l-isa} ${ele} ${l-isa2} } {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring e lstring} -test abstractlist-2.2 {no shimmer lreverse} { +test abstractlist-2.2 {no shimmer lreverse} {testobj lstring} { set l [lstring $str] set l-isa [testobj objtype $l] set r [lreverse $l] @@ -68,7 +71,7 @@ test abstractlist-2.2 {no shimmer lreverse} { list $r ${l-isa} ${r-isa} ${l-isa2} } {{, u o y { } n o { } t i { } g n i m a l b { } d n a { } s r i e h t { } g n i s o l { } e r A { } u o y { } t u o b a { } l l a { } n e h w { } d a e h { } r u o y { } p e e k { } n a c { } u o y { } f I} lstring lstring lstring} -test abstractlist-2.3 {no shimmer lrange} { +test abstractlist-2.3 {no shimmer lrange} {testobj lstring} { set l [lstring $str] set l-isa [testobj objtype $l] set il [lsearch -all [lstring $str] { }] @@ -84,7 +87,7 @@ test abstractlist-2.3 {no shimmer lrange} { list ${l-isa} $il ${l-isa2} ${l-isa3} $words } {lstring {2 6 10 15 20 25 30 34 40 44 48 55 62 66 74 77 80 85} lstring lstring {If you can keep your head when all about you Are losing theirs and blaming it on you,}} -test abstractlist-2.4 {no shimmer foreach} { +test abstractlist-2.4 {no shimmer foreach} {testobj lstring} { set l [lstring $str] set l-isa [testobj objtype $l] set word {} @@ -107,7 +110,7 @@ test abstractlist-2.4 {no shimmer foreach} { # # The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m list, not an lstring. # -test abstractlist-2.5 {!no shimmer lreplace} { +test abstractlist-2.5 {!no shimmer lreplace} {testobj lstring} { set l [lstring $str2] set l-isa [testobj objtype $l] set m [lreplace $l 78 86 { } f a i l i n g] @@ -116,7 +119,7 @@ test abstractlist-2.5 {!no shimmer lreplace} { list ${l-isa} $m ${m-isa} ${l-isa1} } {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } f a i l i n g , { } t o o .} lstring lstring} -test abstractlist-2.6 {no shimmer ledit} { +test abstractlist-2.6 {no shimmer ledit} {testobj lstring} { # "ledit m 9 8 S" set l [lstring $str2] set l-isa [testobj objtype $l] @@ -125,7 +128,7 @@ test abstractlist-2.6 {no shimmer ledit} { list ${l-isa} $e ${e-isa} } {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e s { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring} -test abstractlist-2.7 {no shimmer linsert} -body { +test abstractlist-2.7 {no shimmer linsert} -constraints {testobj lstring} -body { # "ledit m 9 8 S" set l [lstring $str2] set l-isa [testobj objtype $l] @@ -140,7 +143,7 @@ test abstractlist-2.7 {no shimmer linsert} -body { unset l i l-isa i-isa res p p-isa } -result {lstring {I f { } y o u { } c a n { } t r u l y { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring y none {I f { } y o u { } c a n { } t r u l y { } t r u s t { } o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring} -test abstractlist-2.8 {shimmer lassign} { +test abstractlist-2.8 {shimmer lassign} {testobj lstring} { set l [lstring Inconceivable] set l-isa [testobj objtype $l] set l2 [lassign $l i n c] @@ -149,7 +152,7 @@ test abstractlist-2.8 {shimmer lassign} { list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} lstring {o n c e i v a b l e} lstring lstring} -test abstractlist-2.9 {no shimmer lremove} { +test abstractlist-2.9 {no shimmer lremove} {testobj lstring} { set l [lstring Inconceivable] set l-isa [testobj objtype $l] set l2 [lremove $l 0 1] @@ -158,7 +161,7 @@ test abstractlist-2.9 {no shimmer lremove} { list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} lstring {c o n c e i v a b l e} lstring lstring} -test abstractlist-2.10 {shimmer lreverse} { +test abstractlist-2.10 {shimmer lreverse} {testobj lstring} { set l [lstring Inconceivable] set l-isa [testobj objtype $l] set l2 [lreverse $l] @@ -167,7 +170,7 @@ test abstractlist-2.10 {shimmer lreverse} { list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} lstring {e l b a v i e c n o c n I} lstring lstring} -test abstractlist-2.11 {shimmer lset} { +test abstractlist-2.11 {shimmer lset} {testobj lstring} { set l [lstring Inconceivable] set l-isa [testobj objtype $l] set m [lset l 2 k] @@ -176,7 +179,7 @@ test abstractlist-2.11 {shimmer lset} { } {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0} # lrepeat -test abstractlist-2.12 {shimmer lrepeat} { +test abstractlist-2.12 {shimmer lrepeat} {testobj lstring} { set l [lstring Inconceivable] set l-isa [testobj objtype $l] set m [lrepeat 3 $l] @@ -185,7 +188,7 @@ test abstractlist-2.12 {shimmer lrepeat} { list $l ${l-isa} $m ${m-isa} [testobj objtype $n] [value-cmp l n] } {{I n c o n c e i v a b l e} lstring {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} list lstring 0} -test abstractlist-2.13 {no shimmer join llength==1} { +test abstractlist-2.13 {no shimmer join llength==1} {testobj lstring} { set l [lstring G] set l-isa [testobj objtype $l] set j [join $l :] @@ -193,7 +196,7 @@ test abstractlist-2.13 {no shimmer join llength==1} { list ${l-isa} $l ${j-isa} $j } {lstring G none G} -test abstractlist-2.14 {error case lset multiple indicies} -body { +test abstractlist-2.14 {error case lset multiple indicies} -constraints {testobj lstring} -body { set l [lstring Inconceivable] set l-isa [testobj objtype $l] set m [lset l 2 0 1 k] @@ -204,7 +207,7 @@ test abstractlist-2.14 {error case lset multiple indicies} -body { # lsort -test abstractlist-3.0 {no shimmer llength} { +test abstractlist-3.0 {no shimmer llength} {testobj lstring} { set l [lstring -not SLICE $str] set l-isa [testobj objtype $l] set len [llength $l] @@ -212,7 +215,7 @@ test abstractlist-3.0 {no shimmer llength} { list $l ${l-isa} ${len} ${l-isa2} } {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring 85 lstring} -test abstractlist-3.1 {no shimmer lindex} { +test abstractlist-3.1 {no shimmer lindex} {testobj lstring} { set l [lstring -not SLICE $str] set l-isa [testobj objtype $l] set n 22 @@ -221,7 +224,7 @@ test abstractlist-3.1 {no shimmer lindex} { list $l ${l-isa} ${ele} ${l-isa2} } {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring e lstring} -test abstractlist-3.2 {no shimmer lreverse} { +test abstractlist-3.2 {no shimmer lreverse} {testobj lstring} { set l [lstring -not SLICE $str] set l-isa [testobj objtype $l] set r [lreverse $l] @@ -230,7 +233,7 @@ test abstractlist-3.2 {no shimmer lreverse} { list $r ${l-isa} ${r-isa} ${l-isa2} } {{, u o y { } n o { } t i { } g n i m a l b { } d n a { } s r i e h t { } g n i s o l { } e r A { } u o y { } t u o b a { } l l a { } n e h w { } d a e h { } r u o y { } p e e k { } n a c { } u o y { } f I} lstring lstring lstring} -test abstractlist-3.3 {shimmer lrange} { +test abstractlist-3.3 {shimmer lrange} {testobj lstring} { set l [lstring -not SLICE $str] set l-isa [testobj objtype $l] set il [lsearch -all [lstring -not SLICE $str] { }] @@ -246,7 +249,7 @@ test abstractlist-3.3 {shimmer lrange} { list ${l-isa} $il ${l-isa2} ${l-isa3} $words } {lstring {2 6 10 15 20 25 30 34 40 44 48 55 62 66 74 77 80 85} lstring list {If you can keep your head when all about you Are losing theirs and blaming it on you,}} -test abstractlist-3.4 {no shimmer foreach} { +test abstractlist-3.4 {no shimmer foreach} {testobj lstring} { set l [lstring -not SLICE $str] set l-isa [testobj objtype $l] set word {} @@ -269,7 +272,7 @@ test abstractlist-3.4 {no shimmer foreach} { # # The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m list, not an lstring. # -test abstractlist-3.5 {!no shimmer lreplace} { +test abstractlist-3.5 {!no shimmer lreplace} {testobj lstring} { set l [lstring -not SLICE $str2] set l-isa [testobj objtype $l] set m [lreplace $l 79 86 f a i l i n g] @@ -278,7 +281,7 @@ test abstractlist-3.5 {!no shimmer lreplace} { list ${l-isa} $m ${m-isa} ${l-isa1} } {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } f a i l i n g , { } t o o .} lstring lstring} -test abstractlist-3.6 {no shimmer ledit} { +test abstractlist-3.6 {no shimmer ledit} {testobj lstring} { # "ledit m 9 8 S" set l [lstring -not SLICE $str2] set l-isa [testobj objtype $l] @@ -287,7 +290,7 @@ test abstractlist-3.6 {no shimmer ledit} { list ${l-isa} $e ${e-isa} } {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e s { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring} -test abstractlist-3.7 {no shimmer linsert} { +test abstractlist-3.7 {no shimmer linsert} {testobj lstring} { # "ledit m 9 8 S" set res {} set l [lstring -not SLICE $str2] @@ -301,7 +304,7 @@ test abstractlist-3.7 {no shimmer linsert} { lappend res $p ${p-isa} $i ${i-isa2} } {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } w o m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring l none {I f { } y o u { } c a n { } t r u s t { } y o u r s e f { } w h e n { } a l l { } w o m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring} -test abstractlist-3.8 {shimmer lassign} { +test abstractlist-3.8 {shimmer lassign} {testobj lstring} { set l [lstring -not SLICE Inconceivable] set l-isa [testobj objtype $l] set l2 [lassign $l i n c] ;# must be using lrange internally @@ -310,7 +313,7 @@ test abstractlist-3.8 {shimmer lassign} { list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} lstring {o n c e i v a b l e} list list} -test abstractlist-3.9 {no shimmer lremove} { +test abstractlist-3.9 {no shimmer lremove} {testobj lstring} { set l [lstring -not SLICE Inconceivable] set l-isa [testobj objtype $l] set l2 [lremove $l 0 1] @@ -319,7 +322,7 @@ test abstractlist-3.9 {no shimmer lremove} { list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} lstring {c o n c e i v a b l e} lstring lstring} -test abstractlist-3.10 {shimmer lreverse} { +test abstractlist-3.10 {shimmer lreverse} {testobj lstring} { set l [lstring -not SLICE Inconceivable] set l-isa [testobj objtype $l] set l2 [lreverse $l] @@ -328,7 +331,7 @@ test abstractlist-3.10 {shimmer lreverse} { list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} lstring {e l b a v i e c n o c n I} lstring lstring} -test abstractlist-3.11 {shimmer lset} { +test abstractlist-3.11 {shimmer lset} {testobj lstring} { set l [lstring -not SLICE Inconceivable] set l-isa [testobj objtype $l] set four 4 @@ -338,7 +341,7 @@ test abstractlist-3.11 {shimmer lset} { } {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0} # lrepeat -test abstractlist-3.12 {shimmer lrepeat} { +test abstractlist-3.12 {shimmer lrepeat} {testobj lstring} { set l [lstring -not SLICE Inconceivable] set l-isa [testobj objtype $l] set m [lrepeat 3 $l] @@ -353,7 +356,7 @@ foreach not {{} REVERSE SLICE SETELEMENT REPLACE GETELEMENTS} { testConstraint [format "%sShimmer" [string totitle $not]] [expr {$not eq ""}] set options [expr {$not ne "" ? "-not $not" : ""}] -test abstractlist-$not-4.0 {no shimmer llength} { +test abstractlist-$not-4.0 {no shimmer llength} {testobj lstring} { set l [lstring {*}$options $str] set l-isa [testobj objtype $l] set len [llength $l] @@ -361,7 +364,7 @@ test abstractlist-$not-4.0 {no shimmer llength} { list $l ${l-isa} ${len} ${l-isa2} } {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring 85 lstring} -test abstractlist-$not-4.1 {no shimmer lindex} { +test abstractlist-$not-4.1 {no shimmer lindex} {testobj lstring} { set l [lstring {*}$options $str] set l-isa [testobj objtype $l] set ele [lindex $l 22] @@ -369,7 +372,7 @@ test abstractlist-$not-4.1 {no shimmer lindex} { list $l ${l-isa} ${ele} ${l-isa2} } {{I f { } y o u { } c a n { } k e e p { } y o u r { } h e a d { } w h e n { } a l l { } a b o u t { } y o u { } A r e { } l o s i n g { } t h e i r s { } a n d { } b l a m i n g { } i t { } o n { } y o u ,} lstring e lstring} -test abstractlist-$not-4.2 {lreverse} ReverseShimmer { +test abstractlist-$not-4.2 {lreverse} {ReverseShimmer testobj lstring} { set l [lstring {*}$options $str] set l-isa [testobj objtype $l] set r [lreverse $l] @@ -378,7 +381,7 @@ test abstractlist-$not-4.2 {lreverse} ReverseShimmer { list $r ${l-isa} ${r-isa} ${l-isa2} } {{, u o y { } n o { } t i { } g n i m a l b { } d n a { } s r i e h t { } g n i s o l { } e r A { } u o y { } t u o b a { } l l a { } n e h w { } d a e h { } r u o y { } p e e k { } n a c { } u o y { } f I} lstring lstring lstring} -test abstractlist-$not-4.3 {no shimmer lrange} RangeShimmer { +test abstractlist-$not-4.3 {no shimmer lrange} {RangeShimmer testobj lstring} { set l [lstring {*}$options $str] set l-isa [testobj objtype $l] set il [lsearch -all [lstring {*}$options $str] { }] @@ -394,7 +397,7 @@ test abstractlist-$not-4.3 {no shimmer lrange} RangeShimmer { list ${l-isa} $il ${l-isa2} ${l-isa3} $words } {lstring {2 7 10 16 25 29 36 39 47 55 58 63} lstring lstring {If you can keep your head when all about you Are losing theirs and blaming it on you,}} -test abstractlist-$not-4.4 {no shimmer foreach} { +test abstractlist-$not-4.4 {no shimmer foreach} {testobj lstring} { set l [lstring {*}$options $str] set l-isa [testobj objtype $l] set word {} @@ -417,7 +420,7 @@ test abstractlist-$not-4.4 {no shimmer foreach} { # # The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m list, not an lstring. # -test abstractlist-$not-4.5 {!no shimmer lreplace} RangeShimmer { +test abstractlist-$not-4.5 {!no shimmer lreplace} {RangeShimmer testobj lstring} { set l [lstring {*}$options $str2] set l-isa [testobj objtype $l] set m [lreplace $l 18 23 { } f a i l ?] @@ -426,7 +429,7 @@ test abstractlist-$not-4.5 {!no shimmer lreplace} RangeShimmer { list ${l-isa} $m ${m-isa} ${l-isa1} } {lstring {} list lstring} -test abstractlist-$not-4.6 {no shimmer ledit} {SetelementShimmer ReplaceShimmer} { +test abstractlist-$not-4.6 {no shimmer ledit} {SetelementShimmer ReplaceShimmer testobj lstring} { set l [lstring {*}$options $str2] set l-isa [testobj objtype $l] set e [ledit l 68 67 s] @@ -434,7 +437,7 @@ test abstractlist-$not-4.6 {no shimmer ledit} {SetelementShimmer ReplaceShimmer} list ${l-isa} $e ${e-isa} } {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e s { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring} -test abstractlist-$not-4.7 {no shimmer linsert} {ReplaceShimmer GetelementsShimmer} { +test abstractlist-$not-4.7 {no shimmer linsert} {ReplaceShimmer GetelementsShimmer testobj lstring} { set l [lstring {*}$options $str2] set l-isa [testobj objtype $l] set i [linsert $l 12 {*}[split "almost " {}]] @@ -447,7 +450,7 @@ test abstractlist-$not-4.7 {no shimmer linsert} {ReplaceShimmer GetelementsShimm } {lstring {I f { } y o u { } c a n { } t r u s t { } y o u r s e l f { } w h e n { } a l l { } m e n { } d o u b t { } y o u , { } B u t { } m a k e { } a l l o w a n c e { } f o r { } t h e i r { } d o u b t i n g , { } t o o .} lstring} # lassign probably uses lrange internally -test abstractlist-$not-4.8 {shimmer lassign} RangeShimmer { +test abstractlist-$not-4.8 {shimmer lassign} {RangeShimmer testobj lstring} { set l [lstring {*}$options Inconceivable] set l-isa [testobj objtype $l] set l2 [lassign $l i n c] @@ -456,7 +459,7 @@ test abstractlist-$not-4.8 {shimmer lassign} RangeShimmer { list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} lstring {o n c e i v a b l e} lstring lstring} -test abstractlist-$not-4.9 {no shimmer lremove} ReplaceShimmer { +test abstractlist-$not-4.9 {no shimmer lremove} {ReplaceShimmer testobj lstring} { set l [lstring {*}$options Inconceivable] set l-isa [testobj objtype $l] set l2 [lremove $l 0 1] @@ -465,7 +468,7 @@ test abstractlist-$not-4.9 {no shimmer lremove} ReplaceShimmer { list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} lstring {c o n c e i v a b l e} lstring lstring} -test abstractlist-$not-4.10 {shimmer lreverse} ReverseShimmer { +test abstractlist-$not-4.10 {shimmer lreverse} {ReverseShimmer testobj lstring} { set l [lstring {*}$options Inconceivable] set l-isa [testobj objtype $l] set l2 [lreverse $l] @@ -474,7 +477,7 @@ test abstractlist-$not-4.10 {shimmer lreverse} ReverseShimmer { list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} lstring {e l b a v i e c n o c n I} lstring lstring} -test abstractlist-$not-4.11 {shimmer lset} SetelementShimmer { +test abstractlist-$not-4.11 {shimmer lset} {SetelementShimmer testobj lstring} { set l [lstring {*}$options Inconceivable] set l-isa [testobj objtype $l] set m [lset l 2 k] @@ -482,7 +485,7 @@ test abstractlist-$not-4.11 {shimmer lset} SetelementShimmer { list $l ${l-isa} $m ${m-isa} [value-cmp l m] } {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0} -test abstractlist-$not-4.11x {lset not compiled} {SetelementShimmer testevalex} { +test abstractlist-$not-4.11x {lset not compiled} {SetelementShimmer testobj lstring testevalex} { set l [lstring {*}$options Inconceivable] set l-isa [testobj objtype $l] set m [testevalex {lset l 2 k}] @@ -491,7 +494,7 @@ test abstractlist-$not-4.11x {lset not compiled} {SetelementShimmer testevalex} } {{I n k o n c e i v a b l e} lstring {I n k o n c e i v a b l e} lstring 0} test abstractlist-$not-4.11e {error case lset multiple indicies} \ - -constraints {SetelementShimmer testevalex} -body { + -constraints {SetelementShimmer testobj lstring testevalex} -body { set l [lstring Inconceivable] set l-isa [testobj objtype $l] set m [testevalex {lset l 2 0 1 k}] @@ -501,7 +504,7 @@ test abstractlist-$not-4.11e {error case lset multiple indicies} \ -result {Multiple indicies not supported by lstring.} # lrepeat -test abstractlist-$not-4.12 {shimmer lrepeat} -body { +test abstractlist-$not-4.12 {shimmer lrepeat} -constraints {testobj lstring} -body { set l [lstring {*}$options Inconceivable] set l-isa [testobj objtype $l] set m [lrepeat 3 $l] @@ -522,7 +525,7 @@ testConstraint [format "%sShimmer" [string totitle $not]] 1 # This example abstract list (lgen) causes a rescursive call in TEBC, # stack management was not included for these instructions in TEBC. # -test abstractlist-lgen-bug {bug in str concat and list operations} -setup { +test abstractlist-lgen-bug {bug in str concat and list operations} -constraints lgen -setup { set lgenfile [makeFile { # Test TIP 192 - Lazy Lists @@ -583,7 +586,7 @@ test abstractlist-lgen-bug {bug in str concat and list operations} -setup { unset res } -result {Index*2:0:-- {0 -> 0} {1 -> 6} {2 -> 12} {3 -> 18} {4 -> 24} {5 -> 30} {6 -> 36} {7 -> 42} {8 -> 48} {9 -> 54} {10 -> 60} {11 -> 66} {12 -> 72} {13 -> 78} {14 -> 84} {15 -> 90} {16 -> 96} my_expr(3):3 {7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} {s2:Index+7: {7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} :--} {foo:Index-8: {-8 -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6} :--} 9len=15 9(3)=10 {bar:Index+7: {7 8 9 10 11 12 13 14 15 16 17 18 19 20 21} :--} {Index+7:7 8 9 10 11 12 13 14 15 16 17 18 19 20 21:--} {Index+7:7 8 9 10 11 12 13 14 15 16 17 18 19 20 21:--} {fib:0 1 1 2 3} {First 20 fibbinacci:0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181} {First 20 fibbinacci from x :0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181} Good-Bye!} -test abstractlist-lgen-bug2 {bug in foreach} -body { +test abstractlist-lgen-bug2 {bug in foreach} -constraints lgen -body { set x [lseq 17] set y [lgen 17 expr 6*] @@ -601,7 +604,7 @@ test abstractlist-lgen-bug2 {bug in foreach} -body { } -result {{x-value is a arithseries} {y-value is a lgenseries} {0 -> 0} {1 -> 6} {2 -> 12} {3 -> 18} {4 -> 24} {5 -> 30} {6 -> 36} {7 -> 42} {8 -> 48} {9 -> 54} {10 -> 60} {11 -> 66} {12 -> 72} {13 -> 78} {14 -> 84} {15 -> 90} {16 -> 96} {x-value is a arithseries} {y-value is a lgenseries}} # scalar values -test abstractlist-int {TclLengthOne: anti-shimmer of boolean, int, double, bignum} { +test abstractlist-int {TclLengthOne: anti-shimmer of boolean, int, double, bignum} testobj { set res {} foreach i [list [expr {1+0}] [expr {true}] [expr {3.141592}] [expr {round(double(0x7fffffffffffffff))}]] { lappend res [testobj objtype $i] diff --git a/tests/binary.test b/tests/binary.test index fbc95f1..299e1e0 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -3048,7 +3048,7 @@ 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 -constraints {pointerIs64bit deprecated} -body { +test binary-80.5 {Tcl_GetBytesFromObj} -constraints {testbytestring pointerIs64bit deprecated} -body { testbytestring [string repeat A [expr 2**31]] } -returnCodes 1 -result "byte sequence length exceeds INT_MAX" diff --git a/tests/dict.test b/tests/dict.test index f0e11fb..59b600e 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -19,6 +19,8 @@ catch { package require -exact tcl::test [info patchlevel] } +testConstraint testobj [llength [info commands testobj]] + # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] if {[testConstraint memory]} { @@ -144,12 +146,12 @@ test dict-3.15 {compiled dict get error cleanliness - Bug 2431847} -body { dict get $a(z) d }} } -returnCodes error -result {key "d" not known in dictionary} -test dict-3.16 {dict/list shimmering - Bug 3004007} { +test dict-3.16 {dict/list shimmering - Bug 3004007} testobj { set l [list p 1 p 2 q 3] dict get $l q list $l [testobj objtype $l] } {{p 1 p 2 q 3} dict} -test dict-3.17 {dict/list shimmering - Bug 3004007} { +test dict-3.17 {dict/list shimmering - Bug 3004007} testobj { set l [list p 1 p 2 q 3] dict get $l q list [llength $l] [testobj objtype $l] @@ -671,7 +673,7 @@ test dict-14.13 {dict for command: script results} { error "return didn't go far enough" }} } ok,a,b -test dict-14.14 {dict for command: handle representation loss} -body { +test dict-14.14 {dict for command: handle representation loss} -constraints testobj -body { set dictVar {a b c d e f g h} set keys {} set values {} @@ -1816,7 +1818,7 @@ test dict-24.13 {dict map command: script results} { error "return didn't go far enough" }} } ok,a,b -test dict-24.14 {dict map command: handle representation loss} -setup { +test dict-24.14 {dict map command: handle representation loss} -constraints testobj -setup { set keys {} set values {} } -body { @@ -1831,7 +1833,7 @@ test dict-24.14 {dict map command: handle representation loss} -setup { } -cleanup { unset dictVar keys values k v } -result {4 {a c e g} {b d f h} string} -test dict-24.14a {dict map command: handle representation loss} -body { +test dict-24.14a {dict map command: handle representation loss} -constraints testobj -body { apply {{} { set dictVar {a b c d e f g h} list [dict size [dict map {k v} $dictVar { -- cgit v0.12 From ceffda607532e8635894db86b93d1e02e4754505 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 15 Nov 2023 16:07:34 +0000 Subject: Fix broken tests --- tests/ioCmd.test | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 7138ecd..619db31 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -3943,22 +3943,23 @@ test iocmd.readFile-1.3 "readFile procedure: syntax" -body { } -returnCodes error -result {bad mode "gorp2": must be binary or text} test iocmd.readFile-2.1 "readFile procedure: behaviour" -setup { - set f [makeFile readFile21.txt "File\nContents"] + set f [makeFile "File\nContents" readFile21.txt] } -body { readFile $f } -cleanup { removeFile $f } -result "File\nContents\n" test iocmd.readFile-2.2 "readFile procedure: behaviour" -setup { - set f [makeFile readFile22.txt "File\nContents"] + set f [makeFile "File\nContents" readFile22.txt] } -body { readFile $f text } -cleanup { removeFile $f } -result "File\nContents\n" test iocmd.readFile-2.3 "readFile procedure: behaviour" -setup { - set f [makeFile readFile23.bin ""] + set f [makeFile "" readFile23.bindata] apply {filename { + global BIN_DATA set ff [open $filename wb] puts -nonewline $ff $BIN_DATA close $ff @@ -3969,7 +3970,7 @@ test iocmd.readFile-2.3 "readFile procedure: behaviour" -setup { removeFile $f } -result {1 {0 1 2 3 4 26 27 13 10 0}} # Need to set up ahead of the test -set f [makeFile readFile24.txt ""] +set f [makeFile "" readFile24.txt] removeFile $f test iocmd.readFile-2.4 "readFile procedure: behaviour" -body { readFile $f @@ -3988,7 +3989,7 @@ test iocmd.writeFile-1.3 "writeFile procedure: syntax" -body { } -returnCodes error -result {bad mode "gorp2": must be binary or text} test iocmd.writeFile-2.1 "readFile procedure: behaviour" -setup { - set f [makeFile writeFile21.txt ""] + set f [makeFile "" writeFile21.txt] removeFile $f } -body { list [writeFile $f "File\nContents\n"] [apply {filename { @@ -4001,7 +4002,7 @@ test iocmd.writeFile-2.1 "readFile procedure: behaviour" -setup { removeFile $f } -result [list {} "File\nContents\n"] test iocmd.writeFile-2.2 "readFile procedure: behaviour" -setup { - set f [makeFile writeFile22.txt ""] + set f [makeFile "" writeFile22.txt] removeFile $f } -body { writeFile $f text "File\nContents\n" @@ -4015,7 +4016,7 @@ test iocmd.writeFile-2.2 "readFile procedure: behaviour" -setup { removeFile $f } -result "File\nContents\n" test iocmd.writeFile-2.3 "readFile procedure: behaviour" -setup { - set f [makeFile writeFile23.txt ""] + set f [makeFile "" writeFile23.txt] removeFile $f } -body { writeFile $f binary $BIN_DATA @@ -4039,7 +4040,7 @@ test iocmd.foreachLine-1.2 "foreachLine procedure: syntax" -returnCodes error -b foreachLine a b c d } -result {wrong # args: should be "foreachLine varName filename body"} test iocmd.foreachLine-1.3 "foreachLine procedure: basic errors" -setup { - set f [makeFile foreachLine13.txt ""] + set f [makeFile "" foreachLine13.txt] } -body { apply {filename { array set b {1 1} @@ -4048,7 +4049,7 @@ test iocmd.foreachLine-1.3 "foreachLine procedure: basic errors" -setup { } -cleanup { removeFile $f } -returnCodes error -result {can't set "line": variable is array} -set f [makeFile foreachLine14.txt ""] +set f [makeFile "" foreachLine14.txt] removeFile $f test iocmd.foreachLine-1.4 "foreachLine procedure: basic errors" -body { apply {filename { @@ -4057,19 +4058,20 @@ test iocmd.foreachLine-1.4 "foreachLine procedure: basic errors" -body { } -returnCodes error -result "couldn't open \"$f\": no such file or directory" test iocmd.foreachLine-2.1 "foreachLine procedure: behaviour" -setup { - set f [makeFile foreachLine21.txt "a\nb\nc"] + set f [makeFile "a\nb\nc" foreachLine21.txt] } -body { apply {filename { set lines {} foreachLine var $filename { lappend lines $var } + return $lines }} $f } -cleanup { removeFile $f } -result {a b c} test iocmd.foreachLine-2.2 "foreachLine procedure: behaviour" -setup { - set f [makeFile foreachLine22.txt "a\nbb\nc\ndd"] + set f [makeFile "a\nbb\nc\ndd" foreachLine22.txt] } -body { apply {filename { set lines {} @@ -4083,7 +4085,7 @@ test iocmd.foreachLine-2.2 "foreachLine procedure: behaviour" -setup { removeFile $f } -result {bb dd} test iocmd.foreachLine-2.3 "foreachLine procedure: behaviour" -setup { - set f [makeFile foreachLine23.txt "a\nbb\nccc\ndd\ne"] + set f [makeFile "a\nbb\nccc\ndd\ne" foreachLine23.txt] } -body { apply {filename { set lines {} @@ -4097,7 +4099,7 @@ test iocmd.foreachLine-2.3 "foreachLine procedure: behaviour" -setup { removeFile $f } -result {a bb} test iocmd.foreachLine-2.4 "foreachLine procedure: behaviour" -setup { - set f [makeFile foreachLine24.txt "a\nbb\nccc\ndd\ne"] + set f [makeFile "a\nbb\nccc\ndd\ne" foreachLine24.txt] } -body { apply {filename { set lines {} @@ -4113,7 +4115,7 @@ test iocmd.foreachLine-2.4 "foreachLine procedure: behaviour" -setup { removeFile $f } -result {ccc} test iocmd.foreachLine-2.5 "foreachLine procedure: behaviour" -setup { - set f [makeFile foreachLine25.txt "a\nbb\nccc\ndd\ne"] + set f [makeFile "a\nbb\nccc\ndd\ne" foreachLine25.txt] } -body { apply {filename { set lines {} -- cgit v0.12 From 20afa1b3e54d039a160aea8b14be9ed6fd1f7ec7 Mon Sep 17 00:00:00 2001 From: griffin Date: Thu, 16 Nov 2023 00:05:25 +0000 Subject: Add missing test files. A partial fix for bug [31c54e6a591ea]. --- unix/Makefile.in | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/unix/Makefile.in b/unix/Makefile.in index 95a2b58..da73560 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -2360,6 +2360,14 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in gen $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/auto0/$$i/*.tm \ $(DISTDIR)/tests/auto0/$$i; \ done; + @mkdir $(DISTDIR)/tests/zipfiles + $(INSTALL_DATA_DIR) $(DISTDIR)/tests/zipfiles + $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/zipfiles/*.zip \ + $(DISTDIR)/tests/zipfiles + $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/zipfiles/README \ + $(DISTDIR)/tests/zipfiles + $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/zipfiles/LICENSE-libzip \ + $(DISTDIR)/tests/zipfiles $(INSTALL_DATA_DIR) $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/configure.ac \ -- cgit v0.12 From bde854f794edc2436b9676018f5a4352cc679e3c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 16 Nov 2023 19:26:36 +0000 Subject: Fix binary/format/string testcase failures on 32-bit platforms. Reported by Harald Oehlmann. --- generic/tclBinary.c | 4 ++-- generic/tclCmdMZ.c | 17 +++++++++++++---- generic/tclStringObj.c | 20 +++++++++----------- 3 files changed, 24 insertions(+), 17 deletions(-) diff --git a/generic/tclBinary.c b/generic/tclBinary.c index f14685a..545ff7d 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -2609,7 +2609,7 @@ BinaryEncode64( { Tcl_Obj *resultObj; unsigned char *data, *limit; - Tcl_Size maxlen = 0; + Tcl_WideInt maxlen = 0; const char *wrapchar = "\n"; Tcl_Size wrapcharlen = 1; int index, purewrap = 1; @@ -2629,7 +2629,7 @@ BinaryEncode64( } switch (index) { case OPT_MAXLEN: - if (TclGetSizeIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) { return TCL_ERROR; } if (maxlen < 0) { diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index eecf675..7231548 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2642,7 +2642,8 @@ StringEqualCmd( const char *string2; int i, match, nocase = 0; - Tcl_Size length, reqlength = -1; + Tcl_Size length; + Tcl_WideInt reqlength = -1; if (objc < 3 || objc > 6) { str_cmp_args: @@ -2661,9 +2662,12 @@ StringEqualCmd( goto str_cmp_args; } i++; - if (TclGetSizeIntFromObj(interp, objv[i], &reqlength) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[i], &reqlength) != TCL_OK) { return TCL_ERROR; } + if ((Tcl_WideUInt)reqlength > TCL_SIZE_MAX) { + reqlength = -1; + } } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\": must be -nocase or -length", @@ -2741,8 +2745,8 @@ StringCmpOpts( int i; Tcl_Size length; const char *string; + Tcl_WideInt wreqlength = -1; - *reqlength = -1; *nocase = 0; if (objc < 3 || objc > 6) { str_cmp_args: @@ -2761,9 +2765,14 @@ StringCmpOpts( goto str_cmp_args; } i++; - if (TclGetSizeIntFromObj(interp, objv[i], reqlength) != TCL_OK) { + if (Tcl_GetWideIntFromObj(interp, objv[i], &wreqlength) != TCL_OK) { return TCL_ERROR; } + if ((Tcl_WideUInt)wreqlength > TCL_SIZE_MAX) { + *reqlength = -1; + } else { + *reqlength = wreqlength; + } } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad option \"%s\": must be -nocase or -length", diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 598a2e5..8c78f2b 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1848,7 +1848,7 @@ Tcl_AppendFormatToObj( char *end; int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0; int gotPrecision, sawFlag, useShort = 0, useBig = 0; - Tcl_Size width, precision; + Tcl_WideInt width, precision; #ifndef TCL_WIDE_INT_IS_LONG int useWide = 0; #endif @@ -1964,12 +1964,12 @@ Tcl_AppendFormatToObj( unsigned long long ull; ull = strtoull(format, &end, 10); /* Comparison is >=, not >, to leave room for nul */ - if (ull >= TCL_SIZE_MAX) { + if (ull >= WIDE_MAX) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } - width = (Tcl_Size)ull; + width = (Tcl_WideInt)ull; format = end; step = TclUtfToUniChar(format, &ch); } else if (ch == '*') { @@ -1978,7 +1978,7 @@ Tcl_AppendFormatToObj( errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg; } - if (TclGetSizeIntFromObj(interp, objv[objIndex], &width) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[objIndex], &width) != TCL_OK) { goto error; } if (width < 0) { @@ -2010,12 +2010,12 @@ Tcl_AppendFormatToObj( unsigned long long ull; ull = strtoull(format, &end, 10); /* Comparison is >=, not >, to leave room for nul */ - if (ull >= TCL_SIZE_MAX) { + if (ull >= WIDE_MAX) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } - precision = (Tcl_Size)ull; + precision = (Tcl_WideInt)ull; format = end; step = TclUtfToUniChar(format, &ch); } else if (ch == '*') { @@ -2024,7 +2024,7 @@ Tcl_AppendFormatToObj( errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg; } - if (TclGetSizeIntFromObj(interp, objv[objIndex], &precision) + if (TclGetWideIntFromObj(interp, objv[objIndex], &precision) != TCL_OK) { goto error; } @@ -2471,16 +2471,14 @@ Tcl_AppendFormatToObj( *p++ = '+'; } if (width) { - p += snprintf( - p, TCL_INTEGER_SPACE, "%" TCL_SIZE_MODIFIER "d", width); + p += snprintf(p, TCL_INTEGER_SPACE, "%" TCL_LL_MODIFIER "d", width); if (width > length) { length = width; } } if (gotPrecision) { *p++ = '.'; - p += snprintf( - p, TCL_INTEGER_SPACE, "%" TCL_SIZE_MODIFIER "d", precision); + p += snprintf(p, TCL_INTEGER_SPACE, "%" TCL_LL_MODIFIER "d", precision); if (precision > TCL_SIZE_MAX - length) { msg = overflow; errCode = "OVERFLOW"; -- cgit v0.12 From 23ef4b9219d9a38e633ea4a33d3d24446a6d6623 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 16 Nov 2023 19:37:35 +0000 Subject: Remove "Dummy entry for stubs table backwards compatibility" code. No longer needed in Tcl 9.0 --- tools/genStubs.tcl | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 89e4ccc..b02bd9f 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -811,21 +811,6 @@ proc genStubs::forAllStubs {name slotProc onAll textVar set temp {} set plat aqua if {!$slot(unix) && !$slot(macosx)} { - if {[string range $skipString 1 2] ne "/*"} { - # genStubs.tcl previously had a bug here causing it to - # erroneously generate both a unix entry and an aqua - # entry for a given stubs table slot. To preserve - # backwards compatibility, generate a dummy stubs entry - # before every aqua entry (note that this breaks the - # correspondence between emitted entry number and - # actual position of the entry in the stubs table, e.g. - # 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] /*\ - Dummy entry for stubs table backwards\ - compatibility */\n" - } if {$slot($plat)} { append temp [$slotProc $name $stubs($name,$plat,$i) $i] } elseif {$onAll} { -- cgit v0.12 From 61862789a20edc7649464d1cee5fac35b9995849 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 16 Nov 2023 23:21:20 +0000 Subject: Revise macro usage --- generic/tclBinary.c | 2 +- generic/tclCkalloc.c | 4 ++-- generic/tclCmdIL.c | 4 ++-- generic/tclCmdMZ.c | 9 +++++---- generic/tclIO.c | 2 +- generic/tclIOCmd.c | 6 +++--- generic/tclIORChan.c | 4 ++-- generic/tclInt.h | 30 ------------------------------ generic/tclLink.c | 2 +- generic/tclObj.c | 13 +++++++++++-- generic/tclProc.c | 2 +- generic/tclScan.c | 2 +- generic/tclTimer.c | 2 +- generic/tclZlib.c | 8 ++++---- unix/tclUnixFCmd.c | 8 ++++---- 15 files changed, 39 insertions(+), 59 deletions(-) diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 545ff7d..429f7c1 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -2629,7 +2629,7 @@ BinaryEncode64( } switch (index) { case OPT_MAXLEN: - if (Tcl_GetWideIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) { return TCL_ERROR; } if (maxlen < 0) { diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 324755d..6b989c9 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -837,7 +837,7 @@ MemoryCmd( if (objc != 3) { goto argError; } - if (Tcl_GetWideIntFromObj(interp, objv[2], &value) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[2], &value) != TCL_OK) { return TCL_ERROR; } break_on_malloc = value; @@ -922,7 +922,7 @@ MemoryCmd( if (objc != 3) { goto argError; } - if (Tcl_GetWideIntFromObj(interp, objv[2], &value) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[2], &value) != TCL_OK) { return TCL_ERROR; } trace_on_at_malloc = value; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 6644d45..fb31d44 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -3468,7 +3468,7 @@ Tcl_LsearchObjCmd( result = TCL_ERROR; goto done; } - if (Tcl_GetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) { result = TCL_ERROR; goto done; } @@ -4722,7 +4722,7 @@ Tcl_LsortObjCmd( sortInfo.resultCode = TCL_ERROR; goto done; } - if (Tcl_GetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 7231548..74d6a83 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2662,7 +2662,7 @@ StringEqualCmd( goto str_cmp_args; } i++; - if (Tcl_GetWideIntFromObj(interp, objv[i], &reqlength) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[i], &reqlength) != TCL_OK) { return TCL_ERROR; } if ((Tcl_WideUInt)reqlength > TCL_SIZE_MAX) { @@ -2765,7 +2765,7 @@ StringCmpOpts( goto str_cmp_args; } i++; - if (Tcl_GetWideIntFromObj(interp, objv[i], &wreqlength) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[i], &wreqlength) != TCL_OK) { return TCL_ERROR; } if ((Tcl_WideUInt)wreqlength > TCL_SIZE_MAX) { @@ -4202,14 +4202,15 @@ Tcl_TimeRateObjCmd( } objPtr = objv[i++]; if (i < objc) { /* max-time */ - result = Tcl_GetWideIntFromObj(interp, objv[i++], &maxms); + result = TclGetWideIntFromObj(interp, objv[i], &maxms); + i++; // Keep this separate from TclGetWideIntFromObj macro above! if (result != TCL_OK) { return result; } if (i < objc) { /* max-count*/ Tcl_WideInt v; - result = Tcl_GetWideIntFromObj(interp, objv[i], &v); + result = TclGetWideIntFromObj(interp, objv[i], &v); if (result != TCL_OK) { return result; } diff --git a/generic/tclIO.c b/generic/tclIO.c index 1234946..635144f 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -8170,7 +8170,7 @@ Tcl_SetChannelOption( obj.length = strlen(newValue); obj.typePtr = NULL; - code = Tcl_GetWideIntFromObj(interp, &obj, &newBufferSize); + code = TclGetWideIntFromObj(interp, &obj, &newBufferSize); TclFreeInternalRep(&obj); if (code == TCL_ERROR) { diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index a664893..7a180e6 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -510,7 +510,7 @@ Tcl_SeekObjCmd( if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) { return TCL_ERROR; } - if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) { return TCL_ERROR; } mode = SEEK_SET; @@ -1738,7 +1738,7 @@ Tcl_FcopyObjCmd( } switch (index) { case FcopySize: - if (Tcl_GetWideIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) { return TCL_ERROR; } if (toRead < 0) { @@ -1865,7 +1865,7 @@ ChanTruncateObjCmd( * User is supplying an explicit length. */ - if (Tcl_GetWideIntFromObj(interp, objv[2], &length) != TCL_OK) { + if (TclGetWideIntFromObj(interp, objv[2], &length) != TCL_OK) { return TCL_ERROR; } if (length < 0) { diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 93a8b5a..4a86c11 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -1617,7 +1617,7 @@ ReflectSeekWide( goto invalid; } - if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) { + if (TclGetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) { Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp)); goto invalid; } @@ -3212,7 +3212,7 @@ ForwardProc( Tcl_WideInt newLoc; - if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) { + if (TclGetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) { if (newLoc < 0) { ForwardSetStaticError(paramPtr, msg_seek_beforestart); paramPtr->seek.offset = -1; diff --git a/generic/tclInt.h b/generic/tclInt.h index 984b5c5..6dc35c3 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4061,36 +4061,6 @@ MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count); #define TCL_INDEX_START ((Tcl_Size)0) /* - *------------------------------------------------------------------------ - * - * TclGetSizeIntFromObj -- - * - * Extract a Tcl_Size from a Tcl_Obj - * - * Results: - * TCL_OK / TCL_ERROR - * - * Side effects: - * On success, the integer value is stored in *sizePtr. On error, - * an error message in interp it it is not NULL. - * - *------------------------------------------------------------------------ - */ -static inline int TclGetSizeIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *sizePtr) { - if (sizeof(Tcl_Size) == sizeof(int)) { - return TclGetIntFromObj(interp, objPtr, (int *)sizePtr); - } else { - Tcl_WideInt wide; - if (TclGetWideIntFromObj(interp, objPtr, &wide) != TCL_OK) { - return TCL_ERROR; - } - *sizePtr = (Tcl_Size)wide; - return TCL_OK; - } -} - - -/* *---------------------------------------------------------------------- * * TclScaleTime -- diff --git a/generic/tclLink.c b/generic/tclLink.c index cb56bd6..05692db 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -511,7 +511,7 @@ GetWide( Tcl_Obj *objPtr, Tcl_WideInt *widePtr) { - if (Tcl_GetWideIntFromObj(NULL, objPtr, widePtr) != TCL_OK) { + if (TclGetWideIntFromObj(NULL, objPtr, widePtr) != TCL_OK) { int intValue; if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) { diff --git a/generic/tclObj.c b/generic/tclObj.c index aed24cd..b929592 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -2592,7 +2592,7 @@ SetIntFromAny( Tcl_Obj *objPtr) /* Pointer to the object to convert */ { Tcl_WideInt w; - return Tcl_GetWideIntFromObj(interp, objPtr, &w); + return TclGetWideIntFromObj(interp, objPtr, &w); } /* @@ -3147,7 +3147,16 @@ Tcl_GetSizeIntFromObj( Tcl_Obj *objPtr, /* The object from which to get a int. */ Tcl_Size *sizePtr) /* Place to store resulting int. */ { - return TclGetSizeIntFromObj(interp, objPtr, sizePtr); + if (sizeof(Tcl_Size) == sizeof(int)) { + return TclGetIntFromObj(interp, objPtr, (int *)sizePtr); + } else { + Tcl_WideInt wide; + if (TclGetWideIntFromObj(interp, objPtr, &wide) != TCL_OK) { + return TCL_ERROR; + } + *sizePtr = (Tcl_Size)wide; + return TCL_OK; + } } /* diff --git a/generic/tclProc.c b/generic/tclProc.c index c789768..1633a09 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -784,7 +784,7 @@ TclObjGetFrame( if (objPtr == NULL) { /* Do nothing */ } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)) { - Tcl_GetWideIntFromObj(NULL, objPtr, &w); + TclGetWideIntFromObj(NULL, objPtr, &w); if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) { result = -1; } else { diff --git a/generic/tclScan.c b/generic/tclScan.c index 222b06d..3dcc9ea 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -942,7 +942,7 @@ Tcl_ScanObjCmd( break; } if (flags & SCAN_LONGER) { - if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) { + if (TclGetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) { if (TclGetString(objPtr)[0] == '-') { wideValue = WIDE_MIN; } else { diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 528958c..c1d4d7d 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -817,7 +817,7 @@ Tcl_AfterObjCmd( * First lets see if the command was passed a number as the first argument. */ - if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { + if (TclGetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index) != TCL_OK) { const char *arg = TclGetString(objv[1]); diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 739e506..8ec9303 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -518,7 +518,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; } @@ -2146,7 +2146,7 @@ ZlibCmd( return TCL_ERROR; } if (objc > 3) { - if (Tcl_GetWideIntFromObj(interp, objv[3], + if (TclGetWideIntFromObj(interp, objv[3], &wideLen) != TCL_OK) { return TCL_ERROR; } @@ -2166,7 +2166,7 @@ ZlibCmd( return TCL_ERROR; } if (objc > 3) { - if (Tcl_GetWideIntFromObj(interp, objv[3], + if (TclGetWideIntFromObj(interp, objv[3], &wideLen) != TCL_OK) { return TCL_ERROR; } @@ -2198,7 +2198,7 @@ ZlibCmd( } switch (option) { case 0: - if (Tcl_GetWideIntFromObj(interp, objv[i+1], + if (TclGetWideIntFromObj(interp, objv[i+1], &wideLen) != TCL_OK) { return TCL_ERROR; } diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index ec936e0..48023b1 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -1510,7 +1510,7 @@ SetGroupAttribute( int result; const char *native; - if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) { + if (TclGetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) { Tcl_DString ds; struct group *groupPtr = NULL; const char *string; @@ -1581,7 +1581,7 @@ SetOwnerAttribute( int result; const char *native; - if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) { + if (TclGetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) { Tcl_DString ds; struct passwd *pwPtr = NULL; const char *string; @@ -1667,11 +1667,11 @@ SetPermissionsAttribute( TclNewLiteralStringObj(modeObj, "0o"); Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, TCL_INDEX_NONE); - result = Tcl_GetWideIntFromObj(NULL, modeObj, &mode); + result = TclGetWideIntFromObj(NULL, modeObj, &mode); Tcl_DecrRefCount(modeObj); } if (result == TCL_OK - || Tcl_GetWideIntFromObj(NULL, attributePtr, &mode) == TCL_OK) { + || TclGetWideIntFromObj(NULL, attributePtr, &mode) == TCL_OK) { newMode = (mode_t) (mode & 0x00007FFF); } else { Tcl_StatBuf buf; -- cgit v0.12 From 67bbadafbae88f80f3ed23b4a0d0dec7e9cac82b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 17 Nov 2023 07:58:25 +0000 Subject: make Tcl_GetByteArrayFromObj() macro work without stubs as well (in statically linked extensions) --- generic/tclDecls.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 9055a14..a62aeb6 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4304,7 +4304,7 @@ extern const TclStubs *tclStubsPtr; #else /* defined(TCL_NO_DEPRECATED) */ # undef Tcl_GetByteArrayFromObj # define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ - tclStubsPtr->tcl_GetBytesFromObj(NULL, (objPtr), (sizePtr)) + Tcl_GetBytesFromObj(NULL, (objPtr), (sizePtr)) #endif /* !defined(TCL_NO_DEPRECATED) */ #endif /* _TCLDECLS */ -- cgit v0.12 From ecd68b90c6406241b80d97c6691812d24bcec707 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 17 Nov 2023 08:01:29 +0000 Subject: Don't bother testing the compatibility macro's any more. --- generic/tclTest.c | 29 +++-------------------------- 1 file changed, 3 insertions(+), 26 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index e5f3650..3fa2dc7 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -5769,20 +5769,7 @@ TestbytestringObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - struct { -#if !defined(TCL_NO_DEPRECATED) -# if defined(_MSC_VER) && !defined(NDEBUG) -# pragma warning(disable:4133) -# elif defined(__clang__) -# pragma clang diagnostic push -# pragma clang diagnostic ignored "-Wincompatible-pointer-types" -# endif - int n; /* On purpose, not Tcl_Size, in order to demonstrate what happens */ -#else - Tcl_Size n; -#endif - int m; /* This variable should not be overwritten */ - } x = {0, 1}; + Tcl_Size n; const char *p; if (objc != 2) { @@ -5790,21 +5777,11 @@ TestbytestringObjCmd( return TCL_ERROR; } - /* Next line produces a "warning: passing argument 3 of ... from incompatible pointer type", - * but that's on purpose: It's exactly what we are testing here */ - p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &x.n); + p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &n); if (p == NULL) { return TCL_ERROR; } -#if !defined(TCL_NO_DEPRECATED) && defined(__clang__) -# pragma clang diagnostic pop -#endif - - if (x.m != 1) { - Tcl_AppendResult(interp, "Tcl_GetBytesFromObj() overwrites variable", (void *)NULL); - return TCL_ERROR; - } - Tcl_SetObjResult(interp, Tcl_NewStringObj(p, x.n)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n)); return TCL_OK; } -- cgit v0.12 From 0d75817bea5cb6ff2ce05f74d915a609b00f04de Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 17 Nov 2023 12:15:57 +0000 Subject: Add "knownBug" constraint to new testcase: io-52.20.1 --- tests/io.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/io.test b/tests/io.test index f3402f3..c2a82b0 100644 --- a/tests/io.test +++ b/tests/io.test @@ -7655,12 +7655,12 @@ test io-52.20 {TclCopyChannel & encodings} -setup { close $out } -returnCodes 1 -match glob -result {error reading "file*": invalid or incomplete multibyte or wide character} -test io-52.20.1 {TclCopyChannel & read encoding error & tell position} -setup { +test io-52.20.1 {TclCopyChannel & read encoding error & tell position, bug [a173f9229]} -setup { set out [open $path(utf8-fcopy.txt) w] fconfigure $out -encoding utf-8 -translation lf puts $out "AÁ" close $out -} -constraints {fcopy} -body { +} -constraints {fcopy knownBug} -body { # binary to encoding => the input has to be # in utf-8 to make sense to the encoder -- cgit v0.12 From 5dd218ca607b888641a28ce7ec6ec5f9a0535305 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 17 Nov 2023 15:19:36 +0000 Subject: silence compiler warning --- generic/tclInterp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclInterp.c b/generic/tclInterp.c index ed3c527..3d2c009 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -3604,7 +3604,7 @@ static void WrapFree( void *ptr) { - Tcl_Free(ptr); + ckfree(ptr); } void -- cgit v0.12 From b286637e28ec3f7a0cb2808088840ac7c2a0e613 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 17 Nov 2023 15:35:13 +0000 Subject: Cherry-pick [90e09ca320]: silence compiler warning --- generic/tclInterp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 42d8ec3..f33aeed 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -3504,7 +3504,7 @@ static void WrapFree( void *ptr) { - Tcl_Free(ptr); + ckfree(ptr); } void -- cgit v0.12 From 64b0714cce3dbecaa78cd113cdf1dfe4da5d1ef5 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 17 Nov 2023 15:49:56 +0000 Subject: test suite debugging. [removeFile] matches [makeFile] and not [writeFile]. --- tests/ioCmd.test | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 619db31..2b9aed6 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -3999,7 +3999,7 @@ test iocmd.writeFile-2.1 "readFile procedure: behaviour" -setup { return $text }} $f] } -cleanup { - removeFile $f + file delete $f } -result [list {} "File\nContents\n"] test iocmd.writeFile-2.2 "readFile procedure: behaviour" -setup { set f [makeFile "" writeFile22.txt] @@ -4013,7 +4013,7 @@ test iocmd.writeFile-2.2 "readFile procedure: behaviour" -setup { return $text }} $f } -cleanup { - removeFile $f + file delete $f } -result "File\nContents\n" test iocmd.writeFile-2.3 "readFile procedure: behaviour" -setup { set f [makeFile "" writeFile23.txt] @@ -4028,7 +4028,7 @@ test iocmd.writeFile-2.3 "readFile procedure: behaviour" -setup { return $x }} $f } -cleanup { - removeFile $f + file delete $f } -result {0 1 2 3 4 26 27 13 10 0} # Tests of foreachLine -- cgit v0.12 From 0650f4e76a34cf5f5f5f21de00ebbe34748c5377 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 17 Nov 2023 21:58:53 +0000 Subject: Remove binary-80.5 testcase. This testcase was testing the error-reporting capability of the 32-bit compabitility function. Will be useless after TIP #661 --- tests/binary.test | 3 --- 1 file changed, 3 deletions(-) diff --git a/tests/binary.test b/tests/binary.test index 299e1e0..d6a8195 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -3048,9 +3048,6 @@ 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 { - testbytestring [string repeat A [expr 2**31]] -} -returnCodes 1 -result "byte sequence length exceeds INT_MAX" # ---------------------------------------------------------------------- # cleanup -- cgit v0.12 From df18d9393c3f1336334fa37742e09461296575e7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 17 Nov 2023 22:43:58 +0000 Subject: [f8c52a8c53]: CI: Add 32-bit Linux job --- .github/workflows/linux-build.yml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml index 65ca764..f881b47 100644 --- a/.github/workflows/linux-build.yml +++ b/.github/workflows/linux-build.yml @@ -23,6 +23,8 @@ jobs: - "CFLAGS=-ftrapv" - "CFLAGS=-DTCL_UTF_MAX=4" - "CFLAGS=-DTCL_UTF_MAX=6" + # Duplicated below + - "CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit" defaults: run: shell: bash @@ -30,6 +32,11 @@ jobs: steps: - name: Checkout uses: actions/checkout@v4 + - name: Install 32-bit dependencies if needed + # Duplicated from above + if: ${{ matrix.cfgopt == 'CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit' }} + run: | + sudo apt install gcc-multilib libc6-dev-i386 - name: Prepare run: | touch tclStubInit.c tclOOStubInit.c -- cgit v0.12 From 44259e9b29f0a9923c3f251c3c1f7115b0196a96 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 18 Nov 2023 15:17:45 +0000 Subject: "stoponerror" == "profilestrict" (and not used anyway) --- generic/tclTest.c | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 0decc21..2f244a2 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -2092,7 +2092,6 @@ static int UtfExtWrapper( } flagMap[] = { {"start", TCL_ENCODING_START}, {"end", TCL_ENCODING_END}, - {"stoponerror", TCL_ENCODING_PROFILE_STRICT}, {"noterminate", TCL_ENCODING_NO_TERMINATE}, {"charlimit", TCL_ENCODING_CHAR_LIMIT}, {"profiletcl8", TCL_ENCODING_PROFILE_TCL8}, -- cgit v0.12 From 6a9b725dfc4ae4fdcd33bbb1273d05df6aae843b Mon Sep 17 00:00:00 2001 From: oehhar Date: Sat, 18 Nov 2023 17:18:42 +0000 Subject: Remove currently failing test io-52.20.1 to check right file position after fcopy encoding read error --- tests/io.test | 30 ------------------------------ 1 file changed, 30 deletions(-) diff --git a/tests/io.test b/tests/io.test index c2a82b0..341eee0 100644 --- a/tests/io.test +++ b/tests/io.test @@ -7655,36 +7655,6 @@ test io-52.20 {TclCopyChannel & encodings} -setup { close $out } -returnCodes 1 -match glob -result {error reading "file*": invalid or incomplete multibyte or wide character} -test io-52.20.1 {TclCopyChannel & read encoding error & tell position, bug [a173f9229]} -setup { - set out [open $path(utf8-fcopy.txt) w] - fconfigure $out -encoding utf-8 -translation lf - puts $out "AÁ" - close $out -} -constraints {fcopy knownBug} -body { - # binary to encoding => the input has to be - # in utf-8 to make sense to the encoder - - set in [open $path(utf8-fcopy.txt) r] - set out [open $path(kyrillic.txt) w] - - # Using "-encoding ascii" means reading the "Á" gives an error - fconfigure $in -encoding ascii -profile strict - fconfigure $out -encoding koi8-r -translation lf - - set l {} - # should fail, so 1 is added - lappend l [catch {fcopy $in $out}] - # should be at position 1, after the first correct byte, so 1 is read. - lappend l [tell $in] - # not sure, if flush required, but anyway - flush $out - # should be at position 1, after the first correct byte, so 1 is written. - lappend l [tell $out] -} -cleanup { - close $in - close $out -} -returnCodes 0 -result {1 1 1} - test io-52.21 {TclCopyChannel & encodings} -setup { set out [open $path(utf8-fcopy.txt) w] fconfigure $out -encoding utf-8 -translation lf -- cgit v0.12 From a540f5d65f4c3b63c4d92a6511e5664a744affa5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Nov 2023 10:40:12 +0000 Subject: Remove some macro's that don't make much sense any more (Noted by Massimo Manghi, thanks!) --- generic/tclDecls.h | 9 --------- 1 file changed, 9 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index a62aeb6..659058c 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -3962,15 +3962,6 @@ extern const TclStubs *tclStubsPtr; } \ } while(0) -#undef Tcl_UtfToExternalDString -#define Tcl_UtfToExternalDString(encoding, src, len, ds) \ - (Tcl_UtfToExternalDStringEx(NULL, (encoding), (src), (len), \ - TCL_ENCODING_PROFILE_TCL8, (ds), NULL), Tcl_DStringValue(ds)) -#undef Tcl_ExternalToUtfDString -#define Tcl_ExternalToUtfDString(encoding, src, len, ds) \ - (Tcl_ExternalToUtfDStringEx(NULL, (encoding), (src), (len), \ - TCL_ENCODING_PROFILE_TCL8, (ds), NULL), Tcl_DStringValue(ds)) - #if defined(USE_TCL_STUBS) # if defined(_WIN32) && defined(_WIN64) && TCL_MAJOR_VERSION < 9 # undef Tcl_GetTime -- cgit v0.12 From befd279ddd1ec6d3223626ed463a2570d6abfbb2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Nov 2023 10:58:35 +0000 Subject: Remove legacy stuff related to Tcl_LinkVar() --- generic/tcl.h | 5 --- generic/tclLink.c | 109 ------------------------------------------------------ 2 files changed, 114 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 6f6b6ae..e015f7a 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1033,13 +1033,8 @@ typedef struct Tcl_DString { #define TCL_LINK_SHORT 8 #define TCL_LINK_USHORT 9 #define TCL_LINK_UINT 10 -#if defined(TCL_WIDE_INT_IS_LONG) || defined(_WIN32) || defined(__CYGWIN__) #define TCL_LINK_LONG ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_INT : TCL_LINK_INT) #define TCL_LINK_ULONG ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_UINT : TCL_LINK_UINT) -#else -#define TCL_LINK_LONG 11 -#define TCL_LINK_ULONG 12 -#endif #define TCL_LINK_FLOAT 13 #define TCL_LINK_WIDE_UINT 14 #define TCL_LINK_CHARS 15 diff --git a/generic/tclLink.c b/generic/tclLink.c index 05692db..bb7b6ba 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -179,14 +179,6 @@ Tcl_LinkVar( Tcl_IncrRefCount(linkPtr->varName); linkPtr->addr = addr; linkPtr->type = type & ~TCL_LINK_READ_ONLY; -#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \ - || defined(_WIN32) || defined(__CYGWIN__)) - if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) { - linkPtr->type = TCL_LINK_LONG; - } else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) { - linkPtr->type = TCL_LINK_ULONG; - } -#endif if (type & TCL_LINK_READ_ONLY) { linkPtr->flags = LINK_READ_ONLY; } else { @@ -262,14 +254,6 @@ Tcl_LinkArray( linkPtr = (Link *)Tcl_Alloc(sizeof(Link)); linkPtr->type = type & ~TCL_LINK_READ_ONLY; -#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \ - || defined(_WIN32) || defined(__CYGWIN__)) - if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) { - linkPtr->type = TCL_LINK_LONG; - } else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) { - linkPtr->type = TCL_LINK_ULONG; - } -#endif linkPtr->numElems = size; if (type & TCL_LINK_READ_ONLY) { linkPtr->flags = LINK_READ_ONLY; @@ -306,14 +290,6 @@ Tcl_LinkArray( case TCL_LINK_UINT: linkPtr->bytes = size * sizeof(unsigned int); break; -#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__) - case TCL_LINK_LONG: - linkPtr->bytes = size * sizeof(long); - break; - case TCL_LINK_ULONG: - linkPtr->bytes = size * sizeof(unsigned long); - break; -#endif case TCL_LINK_FLOAT: linkPtr->bytes = size * sizeof(float); break; @@ -799,14 +775,6 @@ LinkTraceProc( case TCL_LINK_UINT: changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui); break; -#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__) - case TCL_LINK_LONG: - changed = (LinkedVar(long) != linkPtr->lastValue.l); - break; - case TCL_LINK_ULONG: - changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul); - break; -#endif case TCL_LINK_FLOAT: changed = !EqualDouble(LinkedVar(float), linkPtr->lastValue.f); break; @@ -1121,55 +1089,6 @@ LinkTraceProc( (unsigned int) valueWide; } break; - -#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__) - case TCL_LINK_LONG: - if (linkPtr->flags & LINK_ALLOC_LAST) { - for (i=0; i < objc; i++) { - if (GetWide(objv[i], &valueWide) - || !InRange(LONG_MIN, valueWide, LONG_MAX)) { - Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, - ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable array must have long value"; - } - linkPtr->lastValue.lPtr[i] = (long) valueWide; - } - } else { - if (GetWide(valueObj, &valueWide) - || !InRange(LONG_MIN, valueWide, LONG_MAX)) { - Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, - ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable must have long value"; - } - LinkedVar(long) = linkPtr->lastValue.l = (long) valueWide; - } - break; - - case TCL_LINK_ULONG: - if (linkPtr->flags & LINK_ALLOC_LAST) { - for (i=0; i < objc; i++) { - if (GetUWide(objv[i], &valueUWide) - || (valueUWide > ULONG_MAX)) { - Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, - ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) - "variable array must have unsigned long value"; - } - linkPtr->lastValue.ulPtr[i] = (unsigned long) valueUWide; - } - } else { - if (GetUWide(valueObj, &valueUWide) - || (valueUWide > ULONG_MAX)) { - Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, - ObjValue(linkPtr), TCL_GLOBAL_ONLY); - return (char *) "variable must have unsigned long value"; - } - LinkedVar(unsigned long) = linkPtr->lastValue.ul = - (unsigned long) valueUWide; - } - break; -#endif - case TCL_LINK_WIDE_UINT: if (linkPtr->flags & LINK_ALLOC_LAST) { for (i=0; i < objc; i++) { @@ -1369,34 +1288,6 @@ ObjValue( } linkPtr->lastValue.ui = LinkedVar(unsigned int); return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui); -#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__) - case TCL_LINK_LONG: - if (linkPtr->flags & LINK_ALLOC_LAST) { - memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); - for (i=0; i < linkPtr->numElems; i++) { - TclNewIntObj(objv[i], linkPtr->lastValue.lPtr[i]); - } - resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - Tcl_Free(objv); - return resultObj; - } - linkPtr->lastValue.l = LinkedVar(long); - return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l); - case TCL_LINK_ULONG: - if (linkPtr->flags & LINK_ALLOC_LAST) { - memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); - objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *)); - for (i=0; i < linkPtr->numElems; i++) { - TclNewIntObj(objv[i], linkPtr->lastValue.ulPtr[i]); - } - resultObj = Tcl_NewListObj(linkPtr->numElems, objv); - Tcl_Free(objv); - return resultObj; - } - linkPtr->lastValue.ul = LinkedVar(unsigned long); - return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul); -#endif case TCL_LINK_FLOAT: if (linkPtr->flags & LINK_ALLOC_LAST) { memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes); -- cgit v0.12 From ee8ac648cb65c6e491229e0192fa5b7b4b6e3d06 Mon Sep 17 00:00:00 2001 From: oehhar Date: Mon, 20 Nov 2023 13:15:41 +0000 Subject: Bug [a173f922]: fix bug: fcopy does not write leading correct chars on later encoding error. --- generic/tclIO.c | 18 ++++++++++++++++++ tests/io.test | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 70 insertions(+), 1 deletion(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index bc1b1c6..884f4a8 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -9802,6 +9802,7 @@ CopyData( ChannelState *inStatePtr, *outStatePtr; int result = TCL_OK; Tcl_Size sizeb; + Tcl_Size sizePart; Tcl_WideInt total; int size; const char *buffer; @@ -9888,6 +9889,23 @@ CopyData( size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, !GotFlag(inStatePtr, CHANNEL_NONBLOCKING) ,0 /* No append */); + /* + * In case of a recoverable encoding error, any data before + * the error should be written. This data is in the bufObj. + * Program flow for this case: + * - Check, if there are any remaining bytes to write + * - If yes, simulate a successful read to write them out + * - Come back here by the outer loop and read again + * - Do not enter in the if below, as there are no pending + * writes + * - Fail below with a read error + */ + if (size < 0 && Tcl_GetErrno() == EILSEQ) { + Tcl_GetStringFromObj(bufObj, &sizePart); + if (sizePart > 0) { + size = sizePart; + } + } } underflow = (size >= 0) && (size < sizeb); /* Input underflow */ } diff --git a/tests/io.test b/tests/io.test index f3402f3..1525d39 100644 --- a/tests/io.test +++ b/tests/io.test @@ -7685,6 +7685,28 @@ test io-52.20.1 {TclCopyChannel & read encoding error & tell position} -setup { close $out } -returnCodes 0 -result {1 1 1} +test io-52.20.2 {TclCopyChannel & encoding error on same encoding} -setup { + set out [open $path(utf8-fcopy.txt) w] + fconfigure $out -encoding utf-8 -translation lf + puts $out "AÁ" + close $out +} -constraints {fcopy} -body { + # binary to encoding => the input has to be + # in utf-8 to make sense to the encoder + + set in [open $path(utf8-fcopy.txt) r] + set out [open $path(kyrillic.txt) w] + + # Using "-encoding ascii" means reading the "Á" gives an error + fconfigure $in -encoding ascii -profile strict + fconfigure $out -encoding ascii -translation lf + + fcopy $in $out +} -cleanup { + close $in + close $out +} -returnCodes 1 -match glob -result {error reading "file*": invalid or incomplete multibyte or wide character} + test io-52.21 {TclCopyChannel & encodings} -setup { set out [open $path(utf8-fcopy.txt) w] fconfigure $out -encoding utf-8 -translation lf @@ -7706,6 +7728,7 @@ test io-52.21 {TclCopyChannel & encodings} -setup { close $in close $out } -returnCodes 1 -match glob -result {error writing "file*": invalid or incomplete multibyte or wide character} + test io-52.22 {TclCopyChannel & encodings} -setup { set out [open $path(utf8-fcopy.txt) w] fconfigure $out -encoding utf-8 -translation lf @@ -7733,6 +7756,35 @@ test io-52.22 {TclCopyChannel & encodings} -setup { close $out unset ::s0 } -match glob -result {0 {error reading "file*": invalid or incomplete multibyte or wide character}} + +test io-52.22.1 {TclCopyChannel & encodings & tell position} -setup { + set out [open $path(utf8-fcopy.txt) w] + fconfigure $out -encoding utf-8 -translation lf + puts $out "AÁ" + close $out +} -constraints {fcopy} -body { + # binary to encoding => the input has to be + # in utf-8 to make sense to the encoder + + set in [open $path(utf8-fcopy.txt) r] + set out [open $path(kyrillic.txt) w] + + # Using "-encoding ascii" means reading the "Á" gives an error + fconfigure $in -encoding ascii -profile strict + fconfigure $out -encoding koi8-r -translation lf + proc ::xxx args { + set ::s0 $args + } + + fcopy $in $out -command ::xxx + vwait ::s0 + list [tell $in] [tell $out] {*}[set ::s0] +} -cleanup { + close $in + close $out + unset ::s0 +} -match glob -result {1 1 1 {error reading "file*": invalid or incomplete multibyte or wide character}} + test io-52.23 {TclCopyChannel & encodings} -setup { set out [open $path(utf8-fcopy.txt) w] fconfigure $out -encoding utf-8 -translation lf @@ -7761,7 +7813,6 @@ test io-52.23 {TclCopyChannel & encodings} -setup { unset ::s0 } -match glob -result {0 {error writing "file*": invalid or incomplete multibyte or wide character}} - test io-53.1 {CopyData} {fcopy} { file delete $path(test1) set f1 [open $thisScript] -- cgit v0.12 From 4cef082ec68f86f881ba8bed90075ca7b3707f55 Mon Sep 17 00:00:00 2001 From: oehhar Date: Mon, 20 Nov 2023 16:31:09 +0000 Subject: Ticket [a173f9229f]: fcopy man page: document encoding error behaviour. Depreciate tcl8 encoding profile and same encoding = binary mode. --- doc/fcopy.n | 53 +++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 39 insertions(+), 14 deletions(-) diff --git a/doc/fcopy.n b/doc/fcopy.n index 57f9968..ce15854 100644 --- a/doc/fcopy.n +++ b/doc/fcopy.n @@ -20,22 +20,31 @@ fcopy \- Copy data from one channel to another The \fBfcopy\fR command copies data from one I/O channel, \fIinchan\fR to another I/O channel, \fIoutchan\fR. The \fBfcopy\fR command leverages the buffering in the Tcl I/O system to avoid extra copies and to avoid buffering too much data in -main memory when copying large files to slow destinations like +main memory when copying large files to destinations like network sockets. .PP The \fBfcopy\fR -command transfers data from \fIinchan\fR until end of file -or \fIsize\fR bytes or characters have been -transferred; \fIsize\fR is in bytes if the input channel is in binary mode, -or if the two channels are using the same encoding and -strict is not specified. -Otherwise, size is in characters. -If no \fB\-size\fR argument is given, -then the copy goes until end of file. -All the data read from \fIinchan\fR is copied to \fIoutchan\fR. +command transfers data from \fIinchan\fR to \fIoutchan\fR. +. +.SS "DATA QUANTITY" +All data until \fIEOF\fR is copied. +In addition, the quantity of copied data may be specified by the option \fB-size\fR. +The given size is in bytes, if the input channel is in binary mode. +Otherwise, it is in characters. +.PP +Depreciated feature: the transfer is treated as a binary transfer, if the encoding +profile is set to +.QW tcl8 +and the input encoding matches the output encoding. +In this case, eventual encoding errors are not handled. +An eventually given size is in bytes in this case. +This feature exists for TCL 8 compatibility. +.PP Without the \fB\-command\fR option, \fBfcopy\fR blocks until the copy is complete and returns the number of bytes or characters (using the same rules as for the \fB\-size\fR option) written to \fIoutchan\fR. -.PP +. +.SS "BACKGROUND OPERATION MODE" The \fB\-command\fR argument makes \fBfcopy\fR work in the background. In this case it returns immediately and the \fIcallback\fR is invoked later when the copy completes. @@ -67,7 +76,8 @@ copy so those handlers do not interfere with the copy. Any wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) will get a .QW "channel busy" error. -.PP +. +.SS "CHANNEL TRANSLATION OPTIONS" \fBFcopy\fR translates end-of-line sequences in \fIinchan\fR and \fIoutchan\fR according to the \fB\-translation\fR option for these channels. @@ -78,13 +88,13 @@ can be different than the number of bytes written to \fIoutchan\fR. Only the number of bytes written to \fIoutchan\fR is reported, either as the return value of a synchronous \fBfcopy\fR or as the argument to the callback for an asynchronous \fBfcopy\fR. -.PP -\fBFcopy\fR obeys the encodings and character translations configured +.SS "CHANNEL ENCODING OPTIONS" +\fBFcopy\fR obeys the encodings, profiles and character translations configured for the channels. This means that the incoming characters are converted internally first UTF-8 and then into the encoding of the channel \fBfcopy\fR writes to. See the manual entry for \fBfconfigure\fR for details on the -\fB\-encoding\fR and \fB\-translation\fR options. No conversion is +\fB\-encoding\fR and \fB\-profile\fR options. No conversion is done if both channels are set to encoding .QW binary @@ -97,6 +107,21 @@ the system will assume that the incoming bytes are valid UTF-8 characters and convert them according to the output encoding. The behaviour of the system for bytes which are not valid UTF-8 characters is undefined in this case. +.PP +\fBFcopy\fR may throw encoding errors (error code \fBEILSEQ\fR), if input or output +channel is configured to the +.QW strict +encoding profile. +.PP +If an encoding error arises on the input channel, any data before the error byte is +written to the output channel. The input file pointer is located just before the +values causing the encoding error. +Error inspection or recovery is possible by changing the encoding parameters and +invoking a file command (\fBread\fR, \fBfcopy\fR). +.PP +If an encoding error arises on the output channel, the errorneous data is lost. +To make the difference between the input error case and the output error case, only the +error message may be inspected (read or write), as both throw the error code \fIEILSEQ\fR. .SH EXAMPLES .PP The first example transfers the contents of one channel exactly to -- cgit v0.12 From 52e8a706727c83e06fe9ef2a02b24e9223a702ba Mon Sep 17 00:00:00 2001 From: oehhar Date: Mon, 20 Nov 2023 16:54:38 +0000 Subject: fcopy doc: remove depreciation in tcl9, this is 8.7. --- doc/fcopy.n | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/doc/fcopy.n b/doc/fcopy.n index ce15854..dc6d8ea 100644 --- a/doc/fcopy.n +++ b/doc/fcopy.n @@ -12,7 +12,7 @@ .SH NAME fcopy \- Copy data from one channel to another .SH SYNOPSIS -\fBfcopy \fIinchan\fR \fIoutchan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR? +\fBfcopy \fIinputChan\fR \fIoutputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR? .BE .SH DESCRIPTION @@ -22,9 +22,6 @@ The \fBfcopy\fR command leverages the buffering in the Tcl I/O system to avoid extra copies and to avoid buffering too much data in main memory when copying large files to destinations like network sockets. -.PP -The \fBfcopy\fR -command transfers data from \fIinchan\fR to \fIoutchan\fR. . .SS "DATA QUANTITY" All data until \fIEOF\fR is copied. @@ -32,14 +29,15 @@ In addition, the quantity of copied data may be specified by the option \fB-size The given size is in bytes, if the input channel is in binary mode. Otherwise, it is in characters. .PP -Depreciated feature: the transfer is treated as a binary transfer, if the encoding +The transfer is treated as a binary transfer, if the encoding profile is set to .QW tcl8 and the input encoding matches the output encoding. In this case, eventual encoding errors are not handled. An eventually given size is in bytes in this case. -This feature exists for TCL 8 compatibility. -.PP +This feature is depreciated in TCL 9. +. +.SS "BLOCKING OPERATION MODE" Without the \fB\-command\fR option, \fBfcopy\fR blocks until the copy is complete and returns the number of bytes or characters (using the same rules as for the \fB\-size\fR option) written to \fIoutchan\fR. -- cgit v0.12 From 24ad51e42eebea61f020a5895b6bbe3101c5d2e1 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 20 Nov 2023 19:52:31 +0000 Subject: Add TCL_INDEX_TEMP_TABLE to avoid storing pointers to a table on the stack that will not live long enough to stay valid. Crash hazard. --- generic/tclTestObj.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 3b958dd..1f8f73d 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -920,7 +920,7 @@ TestlistobjCmd( return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command", - 0, &cmdIndex) != TCL_OK) { + TCL_INDEX_TEMP_TABLE, &cmdIndex) != TCL_OK) { return TCL_ERROR; } switch(cmdIndex) { -- cgit v0.12 From 7f501d47e49a907edfed23308a3ee312b1f197ae Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Nov 2023 20:07:43 +0000 Subject: Fix TclpGetPid() signature (should use Tcl_Size, not size_t) --- generic/tclInt.decls | 4 ++-- generic/tclIntPlatDecls.h | 8 ++++---- generic/tclPipe.c | 2 +- generic/tclProcess.c | 10 +++++----- generic/tclStubInit.c | 6 +++--- unix/tclUnixPipe.c | 4 ++-- win/tclWinPipe.c | 16 ++++++++-------- 7 files changed, 25 insertions(+), 25 deletions(-) diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 36c6159..7c8ea15 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -759,7 +759,7 @@ declare 7 { TclFile TclpOpenFile(const char *fname, int mode) } declare 8 { - size_t TclpGetPid(Tcl_Pid pid) + Tcl_Size TclpGetPid(Tcl_Pid pid) } declare 9 { TclFile TclpCreateTempFile(const char *contents) @@ -780,7 +780,7 @@ declare 17 { const Tcl_StatBuf *statBufPtr, int dontCopyAtts) } declare 20 { - void TclWinAddProcess(void *hProcess, size_t id) + void TclWinAddProcess(void *hProcess, Tcl_Size id) } declare 24 { char *TclWinNoBackslash(char *path) diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index c935302..eb27932 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -587,7 +587,7 @@ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 8 */ -EXTERN size_t TclpGetPid(Tcl_Pid pid); +EXTERN Tcl_Size TclpGetPid(Tcl_Pid pid); /* 9 */ EXTERN TclFile TclpCreateTempFile(const char *contents); /* Slot 10 is reserved */ @@ -611,7 +611,7 @@ EXTERN int TclUnixCopyFile(const char *src, const char *dst, /* Slot 18 is reserved */ /* Slot 19 is reserved */ /* 20 */ -EXTERN void TclWinAddProcess(void *hProcess, size_t id); +EXTERN void TclWinAddProcess(void *hProcess, Tcl_Size id); /* Slot 21 is reserved */ /* Slot 22 is reserved */ /* Slot 23 is reserved */ @@ -641,7 +641,7 @@ typedef struct TclIntPlatStubs { int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */ TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ - size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */ + Tcl_Size (*tclpGetPid) (Tcl_Pid pid); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ void (*reserved10)(void); void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ @@ -653,7 +653,7 @@ typedef struct TclIntPlatStubs { int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */ void (*reserved18)(void); void (*reserved19)(void); - void (*tclWinAddProcess) (void *hProcess, size_t id); /* 20 */ + void (*tclWinAddProcess) (void *hProcess, Tcl_Size id); /* 20 */ void (*reserved21)(void); void (*reserved22)(void); void (*reserved23)(void); diff --git a/generic/tclPipe.c b/generic/tclPipe.c index 7e51d57..854ecd5 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -975,7 +975,7 @@ TclCreatePipeline( } if (pidPtr != NULL) { for (i = 0; i < numPids; i++) { - if (pidPtr[i] != (Tcl_Pid) -1) { + if (pidPtr[i] != (Tcl_Pid)-1) { Tcl_DetachPids(1, &pidPtr[i]); } } diff --git a/generic/tclProcess.c b/generic/tclProcess.c index b621e31..b16c73d 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -44,10 +44,10 @@ TCL_DECLARE_MUTEX(infoTablesMutex) */ static void InitProcessInfo(ProcessInfo *info, Tcl_Pid pid, - int resolvedPid); + Tcl_Size resolvedPid); static void FreeProcessInfo(ProcessInfo *info); static int RefreshProcessInfo(ProcessInfo *info, int options); -static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, size_t resolvedPid, +static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, Tcl_Size resolvedPid, int options, int *codePtr, Tcl_Obj **msgPtr, Tcl_Obj **errorObjPtr); static Tcl_Obj * BuildProcessStatusObj(ProcessInfo *info); @@ -76,7 +76,7 @@ void InitProcessInfo( ProcessInfo *info, /* Structure to initialize. */ Tcl_Pid pid, /* Process id. */ - int resolvedPid) /* Resolved process id. */ + Tcl_Size resolvedPid) /* Resolved process id. */ { info->pid = pid; info->resolvedPid = resolvedPid; @@ -185,7 +185,7 @@ RefreshProcessInfo( TclProcessWaitStatus WaitProcessStatus( Tcl_Pid pid, /* Process id. */ - size_t resolvedPid, /* Resolved process id. */ + Tcl_Size resolvedPid, /* Resolved process id. */ int options, /* Options passed to Tcl_WaitPid. */ int *codePtr, /* If non-NULL, will receive either: * - 0 for normal exit. @@ -789,7 +789,7 @@ void TclProcessCreated( Tcl_Pid pid) /* Process id. */ { - size_t resolvedPid; + Tcl_Size resolvedPid; Tcl_HashEntry *entry, *entry2; int isNew; ProcessInfo *info; diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 754023c..6ee2c7a 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -294,7 +294,7 @@ doNothing(void) { /* dummy implementation, no need to do anything */ } -# define TclWinAddProcess (void (*) (void *, size_t)) doNothing +# define TclWinAddProcess (void (*) (void *, Tcl_Size)) doNothing # define TclWinFlushDirtyChannels doNothing #define TclWinNoBackslash winNoBackslash @@ -319,10 +319,10 @@ void *TclWinGetTclInstance() return hInstance; } -size_t +Tcl_Size TclpGetPid(Tcl_Pid pid) { - return (size_t)pid; + return (Tcl_Size)PTR2INT(pid); } #if defined(TCL_WIDE_INT_IS_LONG) diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 08f60b2..a889f1d 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -638,7 +638,7 @@ TclpCreateProcess( } TclpCloseFile(errPipeIn); - *pidPtr = (Tcl_Pid) INT2PTR(pid); + *pidPtr = (Tcl_Pid)INT2PTR(pid); return TCL_OK; error: @@ -1342,7 +1342,7 @@ Tcl_WaitPid( while (1) { result = (int) waitpid(real_pid, statPtr, options); if ((result != -1) || (errno != EINTR)) { - return (Tcl_Pid) INT2PTR(result); + return (Tcl_Pid)INT2PTR(result); } } } diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 9f889b2..157547f 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -61,7 +61,7 @@ typedef struct { typedef struct ProcInfo { HANDLE hProcess; - size_t dwProcessId; + int dwProcessId; struct ProcInfo *nextPtr; } ProcInfo; @@ -864,7 +864,7 @@ TclpCloseFile( *-------------------------------------------------------------------------- */ -size_t +Tcl_Size TclpGetPid( Tcl_Pid pid) /* The HANDLE of the child process. */ { @@ -874,13 +874,13 @@ TclpGetPid( Tcl_MutexLock(&pipeMutex); for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) { - if (infoPtr->dwProcessId == (size_t)pid) { + if (infoPtr->dwProcessId == (Tcl_Size)pid) { Tcl_MutexUnlock(&pipeMutex); return infoPtr->dwProcessId; } } Tcl_MutexUnlock(&pipeMutex); - return TCL_INDEX_NONE; + return -1; } /* @@ -1168,7 +1168,7 @@ TclpCreateProcess( WaitForInputIdle(procInfo.hProcess, 5000); CloseHandle(procInfo.hThread); - *pidPtr = (Tcl_Pid) (size_t) procInfo.dwProcessId; + *pidPtr = (Tcl_Pid)INT2PTR(procInfo.dwProcessId); if (*pidPtr != 0) { TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId); } @@ -2564,7 +2564,7 @@ Tcl_WaitPid( prevPtrPtr = &procList; for (infoPtr = procList; infoPtr != NULL; prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) { - if (infoPtr->dwProcessId == (size_t) pid) { + if (infoPtr->dwProcessId == (Tcl_Size)pid) { *prevPtrPtr = infoPtr->nextPtr; break; } @@ -2674,7 +2674,7 @@ Tcl_WaitPid( } else { errno = ECHILD; *statPtr = 0xC0000000 | ECHILD; - result = (Tcl_Pid) -1; + result = (Tcl_Pid)-1; } /* @@ -2708,7 +2708,7 @@ Tcl_WaitPid( void TclWinAddProcess( void *hProcess, /* Handle to process */ - size_t id) /* Global process identifier */ + Tcl_Size id) /* Global process identifier */ { ProcInfo *procPtr = (ProcInfo *)Tcl_Alloc(sizeof(ProcInfo)); -- cgit v0.12 From 9cbafa1d343820da7ce2df18ef7b780f5d928052 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Nov 2023 20:24:19 +0000 Subject: More (internal) stub table cleanup --- generic/tclIntPlatDecls.h | 160 +++++++++++++++------------------------------- generic/tclStubInit.c | 6 -- 2 files changed, 50 insertions(+), 116 deletions(-) diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index eb27932..c777278 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -57,8 +57,7 @@ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); -/* 5 */ -EXTERN int TclUnixWaitForFile_(int fd, int mask, int timeout); +/* Slot 5 is reserved */ /* 6 */ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ @@ -69,12 +68,9 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); EXTERN TclFile TclpCreateTempFile(const char *contents); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir); -/* 11 */ -EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); -/* 12 */ -EXTERN struct tm * TclpGmtime_unix(const time_t *clock); -/* 13 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ /* 14 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, @@ -101,8 +97,7 @@ EXTERN void TclMacOSXNotifierAddRunLoopMode( const void *runLoopMode); /* Slot 20 is reserved */ /* Slot 21 is reserved */ -/* 22 */ -EXTERN TclFile TclpCreateTempFile_(const char *contents); +/* Slot 22 is reserved */ /* Slot 23 is reserved */ /* Slot 24 is reserved */ /* Slot 25 is reserved */ @@ -117,29 +112,20 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *resultingNameObj); #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ -/* 0 */ -EXTERN void TclWinConvertError(DWORD errCode); -/* 1 */ -EXTERN void TclWinConvertWSAError(DWORD errCode); -/* 2 */ -EXTERN struct servent * TclWinGetServByName(const char *nm, - const char *proto); -/* 3 */ -EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname, - char *optval, int *optlen); +/* Slot 0 is reserved */ +/* Slot 1 is reserved */ +/* Slot 2 is reserved */ +/* Slot 3 is reserved */ /* 4 */ EXTERN HINSTANCE TclWinGetTclInstance(void); /* 5 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); -/* 6 */ -EXTERN unsigned short TclWinNToHS(unsigned short ns); -/* 7 */ -EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname, - const char *optval, int optlen); +/* Slot 6 is reserved */ +/* Slot 7 is reserved */ /* 8 */ -EXTERN int TclpGetPid(Tcl_Pid pid); -/* 9 */ -EXTERN int TclWinGetPlatformId(void); +EXTERN Tcl_Size TclpGetPid(Tcl_Pid pid); +/* Slot 9 is reserved */ +/* Slot 10 is reserved */ /* 11 */ EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); @@ -168,20 +154,17 @@ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); EXTERN TclFile TclpOpenFile(const char *fname, int mode); /* 20 */ EXTERN void TclWinAddProcess(void *hProcess, Tcl_Size id); -/* 21 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +/* Slot 21 is reserved */ /* 22 */ EXTERN TclFile TclpCreateTempFile(const char *contents); /* Slot 23 is reserved */ /* 24 */ EXTERN char * TclWinNoBackslash(char *path); /* Slot 25 is reserved */ -/* 26 */ -EXTERN void TclWinSetInterfaces(int wide); +/* Slot 26 is reserved */ /* 27 */ EXTERN void TclWinFlushDirtyChannels(void); -/* 28 */ -EXTERN void TclWinResetInterfaces(void); +/* Slot 28 is reserved */ /* 29 */ EXTERN int TclWinCPUID(int index, int *regs); /* 30 */ @@ -206,8 +189,7 @@ EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); -/* 5 */ -EXTERN int TclUnixWaitForFile_(int fd, int mask, int timeout); +/* Slot 5 is reserved */ /* 6 */ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ @@ -218,12 +200,7 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); EXTERN TclFile TclpCreateTempFile(const char *contents); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir); -/* 11 */ -EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); -/* 12 */ -EXTERN struct tm * TclpGmtime_unix(const time_t *clock); -/* 13 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +/* Slot 13 is reserved */ /* 14 */ EXTERN int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, @@ -250,8 +227,7 @@ EXTERN void TclMacOSXNotifierAddRunLoopMode( const void *runLoopMode); /* Slot 20 is reserved */ /* Slot 21 is reserved */ -/* 22 */ -EXTERN TclFile TclpCreateTempFile_(const char *contents); +/* Slot 22 is reserved */ /* Slot 23 is reserved */ /* Slot 24 is reserved */ /* Slot 25 is reserved */ @@ -282,8 +258,8 @@ typedef struct TclIntPlatStubs { int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ - struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ - struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ + void (*reserved11)(void); + void (*reserved12)(void); char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */ @@ -348,8 +324,8 @@ typedef struct TclIntPlatStubs { int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ - struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ - struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ + void (*reserved11)(void); + void (*reserved12)(void); char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */ @@ -394,8 +370,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */ #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */ -#define TclUnixWaitForFile_ \ - (tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */ +/* Slot 5 is reserved */ #define TclpMakeFile \ (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #define TclpOpenFile \ @@ -406,12 +381,9 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -#define TclpLocaltime_unix \ - (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ -#define TclpGmtime_unix \ - (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ #define TclMacOSXGetFileAttribute \ @@ -426,8 +398,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */ /* Slot 20 is reserved */ /* Slot 21 is reserved */ -#define TclpCreateTempFile_ \ - (tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */ +/* Slot 22 is reserved */ /* Slot 23 is reserved */ /* Slot 24 is reserved */ /* Slot 25 is reserved */ @@ -440,26 +411,20 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ -#define TclWinConvertError \ - (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ -#define TclWinConvertWSAError \ - (tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */ -#define TclWinGetServByName \ - (tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */ -#define TclWinGetSockOpt \ - (tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */ +/* Slot 0 is reserved */ +/* Slot 1 is reserved */ +/* Slot 2 is reserved */ +/* Slot 3 is reserved */ #define TclWinGetTclInstance \ (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ -#define TclWinNToHS \ - (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ -#define TclWinSetSockOpt \ - (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */ +/* Slot 6 is reserved */ +/* Slot 7 is reserved */ #define TclpGetPid \ (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ -#define TclWinGetPlatformId \ - (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ +/* Slot 9 is reserved */ +/* Slot 10 is reserved */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ #define TclpCloseFile \ @@ -480,20 +445,17 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpOpenFile) /* 19 */ #define TclWinAddProcess \ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */ +/* Slot 21 is reserved */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ /* Slot 23 is reserved */ #define TclWinNoBackslash \ (tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */ /* Slot 25 is reserved */ -#define TclWinSetInterfaces \ - (tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */ +/* Slot 26 is reserved */ #define TclWinFlushDirtyChannels \ (tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */ -#define TclWinResetInterfaces \ - (tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */ +/* Slot 28 is reserved */ #define TclWinCPUID \ (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ #define TclUnixOpenTemporaryFile \ @@ -510,8 +472,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */ #define TclpCreateProcess \ (tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */ -#define TclUnixWaitForFile_ \ - (tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */ +/* Slot 5 is reserved */ #define TclpMakeFile \ (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */ #define TclpOpenFile \ @@ -522,12 +483,9 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -#define TclpLocaltime_unix \ - (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ -#define TclpGmtime_unix \ - (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ #define TclMacOSXGetFileAttribute \ @@ -542,8 +500,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */ /* Slot 20 is reserved */ /* Slot 21 is reserved */ -#define TclpCreateTempFile_ \ - (tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */ +/* Slot 22 is reserved */ /* Slot 23 is reserved */ /* Slot 24 is reserved */ /* Slot 25 is reserved */ @@ -735,20 +692,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#undef TclpLocaltime_unix -#undef TclpGmtime_unix -#undef TclWinConvertWSAError -#define TclWinConvertWSAError TclWinConvertError -#if !defined(USE_TCL_STUBS) && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 -# undef TclWinConvertError -# define TclWinConvertError Tcl_WinConvertError -#endif - -#undef TclpInetNtoa -#define TclpInetNtoa inet_ntoa -#undef TclpCreateTempFile_ -#undef TclUnixWaitForFile_ #ifdef MAC_OSX_TCL /* not accessible on Win32/UNIX */ MODULE_SCOPE int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, @@ -775,15 +719,11 @@ MODULE_SCOPE int TclMacOSXMatchType(Tcl_Interp *interp, #endif #if defined(_WIN32) -# undef TclWinNToHS -# undef TclWinGetServByName -# undef TclWinGetSockOpt -# undef TclWinSetSockOpt -# undef TclWinGetPlatformId -# undef TclWinResetInterfaces -# undef TclWinSetInterfaces -# if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 +# if !defined(TCL_NO_DEPRECATED) +# define TclWinConvertError Tcl_WinConvertError +# define TclWinConvertWSAError Tcl_WinConvertError # define TclWinNToHS ntohs +# define TclpInetNtoa inet_ntoa # define TclWinGetServByName getservbyname # define TclWinGetSockOpt getsockopt # define TclWinSetSockOpt setsockopt @@ -793,7 +733,7 @@ MODULE_SCOPE int TclMacOSXMatchType(Tcl_Interp *interp, # endif /* TCL_NO_DEPRECATED */ #else # undef TclpGetPid -# define TclpGetPid(pid) ((size_t)(pid)) +# define TclpGetPid(pid) ((Tcl_Size)(pid)) #endif #endif /* _TCLINTPLATDECLS */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 6ee2c7a..1e734dc 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -62,13 +62,7 @@ #undef Tcl_SplitPath #undef Tcl_FSSplitPath #undef Tcl_ParseArgsObjv -#undef TclpInetNtoa -#undef TclWinGetServByName -#undef TclWinGetSockOpt -#undef TclWinSetSockOpt -#undef TclWinNToHS #undef TclStaticLibrary -#undef Tcl_BackgroundError #define TclStaticLibrary Tcl_StaticLibrary #undef Tcl_UniCharToUtfDString #undef Tcl_UtfToUniCharDString -- cgit v0.12 From 58b64de3bfbcd0cb114139833a8c029273fb7637 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Nov 2023 20:36:04 +0000 Subject: Undo previous commit. Add "static" keywords in various places instead. This should fix the problem too. --- generic/tclTest.c | 2 +- generic/tclTestObj.c | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 2f244a2..a07d449 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -3818,7 +3818,7 @@ TestlistrepCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { /* Subcommands supported by this command */ - const char* subcommands[] = { + static const char *const subcommands[] = { "new", "describe", "config", diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 1f8f73d..9f31cff 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -153,7 +153,7 @@ TestbignumobjCmd( int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ { - const char *const subcmds[] = { + static const char *const subcmds[] = { "set", "get", "mult10", "div10", "iseven", "radixsize", NULL }; enum options { @@ -887,7 +887,7 @@ TestlistobjCmd( Tcl_Obj *const objv[]) /* Argument objects */ { /* Subcommands supported by this command */ - const char* const subcommands[] = { + static const char* const subcommands[] = { "set", "get", "replace", @@ -920,7 +920,7 @@ TestlistobjCmd( return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command", - TCL_INDEX_TEMP_TABLE, &cmdIndex) != TCL_OK) { + 0, &cmdIndex) != TCL_OK) { return TCL_ERROR; } switch(cmdIndex) { @@ -1062,7 +1062,7 @@ TestobjCmd( int i; const Tcl_ObjType *targetType; Tcl_Obj **varPtr; - const char *subcommands[] = { + static const char *const subcommands[] = { "freeallvars", "bug3598580", "types", "objtype", "newobj", "set", "assign", "convert", "duplicate", -- cgit v0.12 From 092703d99668fb06f01c3515abfb0fa27f9e42df Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Nov 2023 20:45:14 +0000 Subject: Fix [32b88975f7]: clock format returns spurious errors --- generic/tclClock.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclClock.c b/generic/tclClock.c index 38c4ec0..7d54edd 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -913,7 +913,7 @@ ConvertLocalToUTCUsingC( Tcl_MutexLock(&clockMutex); errno = 0; fields->seconds = (Tcl_WideInt) mktime(&timeVal); - localErrno = errno; + localErrno = (fields->seconds == -1) ? errno : 0; Tcl_MutexUnlock(&clockMutex); /* -- cgit v0.12 From e92f56554cd9888d3a41bdecfd11773828688d4b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Nov 2023 21:09:58 +0000 Subject: Missing "static" keywords in various places. --- generic/tclTestObj.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 3003487..914c6f0 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -151,7 +151,7 @@ TestbignumobjCmd( int objc, /* Argument count */ Tcl_Obj *const objv[]) /* Argument vector */ { - const char *const subcmds[] = { + static const char *const subcmds[] = { "set", "get", "mult10", "div10", "iseven", "radixsize", NULL }; enum options { @@ -876,7 +876,7 @@ TestlistobjCmd( Tcl_Obj *const objv[]) /* Argument objects */ { /* Subcommands supported by this command */ - const char* subcommands[] = { + static const char *const subcommands[] = { "set", "get", "replace" -- cgit v0.12 From dbbc7b0a4a854025613eae805fb64bf562bda5d6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Nov 2023 22:13:38 +0000 Subject: Experimental fix for [4ed788c618]: regexp \U not fully implemented - unclear in docs --- generic/regc_lex.c | 5 ----- 1 file changed, 5 deletions(-) diff --git a/generic/regc_lex.c b/generic/regc_lex.c index eb068b4..28ae821 100644 --- a/generic/regc_lex.c +++ b/generic/regc_lex.c @@ -843,11 +843,6 @@ lexescape( if (ISERR()) { FAILW(REG_EESCAPE); } - if (i > 0xFFFF) { - /* TODO: output a Surrogate pair - */ - i = 0xFFFD; - } RETV(PLAIN, (uchr) i); break; case CHR('v'): -- cgit v0.12 From edcbd92630507c129000dfd668f858ca603e0b1e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 22 Nov 2023 12:03:09 +0000 Subject: Fix testcases for previous commit --- tests/reg.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/reg.test b/tests/reg.test index b6198d8..5860a34 100644 --- a/tests/reg.test +++ b/tests/reg.test @@ -643,8 +643,8 @@ expectMatch 13.29 P "a\\U0001234x" "a\u1234x" "a\u1234x" expectMatch 13.30 P {a\U0001234x} "a\u1234x" "a\u1234x" expectMatch 13.31 P "a\\U000012345x" "a\u12345x" "a\u12345x" expectMatch 13.32 P {a\U000012345x} "a\u12345x" "a\u12345x" -expectMatch 13.33 P "a\\U1000000x" "a\uFFFD0x" "a\uFFFD0x" -expectMatch 13.34 P {a\U1000000x} "a\uFFFD0x" "a\uFFFD0x" +expectMatch 13.33 P "a\\U100000x" "a\U100000x" "a\U100000" +expectMatch 13.34 P {a\U100000x} "a\U100000x" "a\U100000" doing 14 "back references" -- cgit v0.12 From 51607eaa4f7bf07cd36ba1ec5809208d22591a3e Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 22 Nov 2023 12:13:02 +0000 Subject: Added missing paragraph fragment. --- doc/coroutine.n | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/doc/coroutine.n b/doc/coroutine.n index 11f9069..8110628 100644 --- a/doc/coroutine.n +++ b/doc/coroutine.n @@ -119,7 +119,10 @@ The injection is a one-off. It is not retained once it has been executed. It may \fByield\fR or \fByieldto\fR as part of its execution. .PP Note that running coroutines may be neither probed nor injected; the -operations may only be applied to +operations may only be applied to coroutines that are suspended. (If a +coroutine is running then any introspection code would be merely inspecting +the state of where it is currently running; \fBcoroinject\fR/\fBcoroprobe\fR +are unnecessary in that case.) .VE "8.7, TIP383" .SH EXAMPLES .PP -- cgit v0.12 From 49de1ec9b59bc25ffab3c127fafbbc0a81e4cc8c Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 22 Nov 2023 16:56:52 +0000 Subject: Test edits to correct failures. --- tests/reg.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/reg.test b/tests/reg.test index 5860a34..67973ea 100644 --- a/tests/reg.test +++ b/tests/reg.test @@ -643,8 +643,8 @@ expectMatch 13.29 P "a\\U0001234x" "a\u1234x" "a\u1234x" expectMatch 13.30 P {a\U0001234x} "a\u1234x" "a\u1234x" expectMatch 13.31 P "a\\U000012345x" "a\u12345x" "a\u12345x" expectMatch 13.32 P {a\U000012345x} "a\u12345x" "a\u12345x" -expectMatch 13.33 P "a\\U100000x" "a\U100000x" "a\U100000" -expectMatch 13.34 P {a\U100000x} "a\U100000x" "a\U100000" +expectMatch 13.33 P "a\\U100000x" "a\U100000x" "a\U100000x" +expectMatch 13.34 P {a\U100000x} "a\U100000x" "a\U100000x" doing 14 "back references" -- cgit v0.12 From 613ad6861bdef8e2bfcde5630c0b34af183c6f56 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 23 Nov 2023 13:17:57 +0000 Subject: Fix [b8a30af3da]: test failures in reg.test. Now works with -DTCL_NO_DEPRECATED and without it. --- generic/tclTest.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index a07d449..e9a0a40 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -4629,11 +4629,11 @@ TestregexpObjCmd( } else { if (ii == TCL_INDEX_NONE) { TclRegExpRangeUniChar(regExpr, ii, &start, &end); - newPtr = Tcl_GetRange(objPtr, start, end); + newPtr = TclGetRange(objPtr, start, end); } else if (ii > info.nsubs || info.matches[ii].end <= 0) { newPtr = Tcl_NewObj(); } else { - newPtr = Tcl_GetRange(objPtr, info.matches[ii].start, + newPtr = TclGetRange(objPtr, info.matches[ii].start, info.matches[ii].end - 1); } } -- cgit v0.12 From c06af67a15fe0eef8a17ff3d89d0f88193d5a6d6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 23 Nov 2023 13:48:05 +0000 Subject: Remove testgetencpath/testsetencpath test commands: Testcase can use "encoding dirs" as well. (borrowed from bug-2a0966cdc9 branch, testcase only) --- generic/tclTest.c | 72 ----------------------------------------------------- tests/encoding.test | 13 ++++------ tests/unixInit.test | 3 --- 3 files changed, 5 insertions(+), 83 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index e9a0a40..02e1fac 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -321,8 +321,6 @@ static Tcl_ObjCmdProc TestFilesystemObjCmd; static Tcl_ObjCmdProc TestSimpleFilesystemObjCmd; static void TestReport(const char *cmd, Tcl_Obj *arg1, Tcl_Obj *arg2); -static Tcl_ObjCmdProc TestgetencpathObjCmd; -static Tcl_ObjCmdProc TestsetencpathObjCmd; static Tcl_Obj * TestReportGetNativePath(Tcl_Obj *pathPtr); static Tcl_FSStatProc TestReportStat; static Tcl_FSAccessProc TestReportAccess; @@ -749,10 +747,6 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd, NULL, NULL); - Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd, - NULL, NULL); - Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd, - NULL, NULL); Tcl_CreateObjCommand(interp, "testapplylambda", TestApplyLambdaObjCmd, NULL, NULL); @@ -8417,72 +8411,6 @@ TestconcatobjCmd( /* *---------------------------------------------------------------------- * - * TestgetencpathObjCmd -- - * - * This function implements the "testgetencpath" command. It is used to - * test Tcl_GetEncodingSearchPath(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestgetencpathObjCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ -{ - if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, ""); - return TCL_ERROR; - } - - Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath()); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TestsetencpathCmd -- - * - * This function implements the "testsetencpath" command. It is used to - * test Tcl_SetDefaultEncodingDir(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestsetencpathObjCmd( - TCL_UNUSED(void *), - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const *objv) /* Argument strings. */ -{ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "defaultDir"); - return TCL_ERROR; - } - - Tcl_SetEncodingSearchPath(objv[1]); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * TestparseargsCmd -- * * This procedure implements the "testparseargs" command. It is used to diff --git a/tests/encoding.test b/tests/encoding.test index 76b5306..70aa99e 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -41,7 +41,6 @@ testConstraint testencoding [llength [info commands testencoding]] testConstraint testbytestring [llength [info commands testbytestring]] testConstraint teststringbytes [llength [info commands teststringbytes]] testConstraint exec [llength [info commands exec]] -testConstraint testgetencpath [llength [info commands testgetencpath]] # TclInitEncodingSubsystem is tested by the rest of this file # TclFinalizeEncodingSubsystem is not currently tested @@ -1031,15 +1030,13 @@ foreach from {cp932 shiftjis euc-jp iso2022-jp} { } } -test encoding-26.0 {Tcl_GetEncodingSearchPath} -constraints { - testgetencpath -} -setup { - set origPath [testgetencpath] - testsetencpath slappy +test encoding-26.0 {Tcl_GetEncodingSearchPath} -setup { + set origPath [encoding dirs] + encoding dirs slappy } -body { - testgetencpath + encoding dirs } -cleanup { - testsetencpath $origPath + encoding dirs $origPath } -result slappy file delete {*}[glob -directory [temporaryDirectory] *.chars *.tcltestout] diff --git a/tests/unixInit.test b/tests/unixInit.test index 3a9fa6d..3bbe1e9 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -17,9 +17,6 @@ if {"::tcltest" ni [namespace children]} { unset -nocomplain path catch {set oldlang $env(LANG)} set env(LANG) C - -# Some tests require the testgetencpath command -testConstraint testgetencpath [llength [info commands testgetencpath]] test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} { set x {} -- cgit v0.12 From dd3a7a69f2bbdb7a118e205a3b71085403b28a91 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 23 Nov 2023 15:01:28 +0000 Subject: Fixes to parsing of patchlevel --- .github/workflows/onefiledist.yml | 27 +++++++++++++++++++++------ 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/.github/workflows/onefiledist.yml b/.github/workflows/onefiledist.yml index 8fec3e1..d271fc1 100644 --- a/.github/workflows/onefiledist.yml +++ b/.github/workflows/onefiledist.yml @@ -26,8 +26,11 @@ jobs: echo "VER_PATH=$(cd tools; pwd)/addVerToFile.tcl" >> $GITHUB_ENV working-directory: . - name: Configure - run: ./configure --disable-symbols --disable-shared --enable-zipfs + run: | + ./configure --disable-symbols --disable-shared --enable-zipfs + sed -n '/^PATCH_LEVEL/{s/.*= /patchlevel=/;p}' < Makefile >> $GITHUB_OUTPUT working-directory: unix + id: cfg - name: Build run: | make tclsh @@ -40,10 +43,12 @@ jobs: chmod +x tclsh${TCL_PATCHLEVEL}_snapshot tar -cf tclsh${TCL_PATCHLEVEL}_snapshot.tar tclsh${TCL_PATCHLEVEL}_snapshot working-directory: 1dist + env: + TCL_PATCHLEVEL: ${{ steps.cfg.outputs.patchlevel }} - name: Upload uses: actions/upload-artifact@v3 with: - name: Tclsh ${{ env.TCL_PATCHLEVEL }} Linux single-file build (snapshot) + name: Tclsh ${{ steps.cfg.outputs.patchlevel }} Linux single-file build (snapshot) path: 1dist/*.tar macos: name: macOS @@ -72,8 +77,11 @@ jobs: echo "CREATE_DMG=$(cd create-dmg;pwd)/create-dmg" >> $GITHUB_ENV echo "CFLAGS=-arch x86_64 -arch arm64" >> $GITHUB_ENV - name: Configure - run: ./configure --disable-symbols --disable-shared --enable-zipfs + run: | + ./configure --disable-symbols --disable-shared --enable-zipfs + sed -n '/^PATCH_LEVEL/{s/.*= /patchlevel=/;p}' < Makefile >> $GITHUB_OUTPUT working-directory: unix + id: cfg - name: Build run: | make tclsh @@ -103,10 +111,12 @@ jobs: "Tcl-$TCL_PATCHLEVEL-(snapshot).dmg" \ "contents/" working-directory: 1dist + env: + TCL_PATCHLEVEL: ${{ steps.cfg.outputs.patchlevel }} - name: Upload uses: actions/upload-artifact@v3 with: - name: Tclsh ${{ env.TCL_PATCHLEVEL }} macOS single-file build (snapshot) + name: Tclsh ${{ steps.cfg.outputs.patchlevel }} macOS single-file build (snapshot) path: 1dist/*.dmg win: name: Windows @@ -133,8 +143,11 @@ jobs: mkdir 1dist working-directory: . - name: Configure - run: ./configure $CFGOPT + run: | + ./configure $CFGOPT + sed -n '/^PATCH_LEVEL/{s/.*= /patchlevel=/;p}' < Makefile >> $GITHUB_OUTPUT working-directory: win + id: cfg - name: Build run: | make binaries libraries @@ -148,8 +161,10 @@ jobs: run: | cp ../win/tclsh*.exe tclsh${TCL_PATCHLEVEL}_snapshot.exe working-directory: 1dist + env: + TCL_PATCHLEVEL: ${{ steps.cfg.outputs.patchlevel }} - name: Upload uses: actions/upload-artifact@v3 with: - name: Tclsh ${{ env.TCL_PATCHLEVEL }} Windows single-file build (snapshot) + name: Tclsh ${{ steps.cfg.outputs.patchlevel }} Windows single-file build (snapshot) path: '1dist/*_snapshot.exe' -- cgit v0.12 From 752a2a1cf22d2b378c0911cc36942bab516d5cd4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 23 Nov 2023 15:07:09 +0000 Subject: Fix [e653408972]: autoconf warning --- unix/configure.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unix/configure.in b/unix/configure.in index 3e80626..39eba16 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -199,7 +199,7 @@ SC_TCL_64BIT_FLAGS # Tcl_UniChar strings to memcmp on big-endian systems. #-------------------------------------------------------------------- -AC_C_BIGENDIAN +AC_C_BIGENDIAN(,,,[#]) #-------------------------------------------------------------------- # Supply substitutes for missing POSIX library procedures, or -- cgit v0.12 From 1d843db999916abc372edea0af5aa47250f32cc0 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 23 Nov 2023 17:19:21 +0000 Subject: Added code signing step for Windows --- .github/workflows/onefiledist.yml | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/.github/workflows/onefiledist.yml b/.github/workflows/onefiledist.yml index d271fc1..3a0e908 100644 --- a/.github/workflows/onefiledist.yml +++ b/.github/workflows/onefiledist.yml @@ -163,6 +163,26 @@ jobs: working-directory: 1dist env: TCL_PATCHLEVEL: ${{ steps.cfg.outputs.patchlevel }} + - name: Sign Executable + # Adapted from https://federicoterzi.com/blog/automatic-codesigning-on-windows-using-github-actions/ + env: + CODESIGN_PWD: ${{ secrets.CODESIGN_PWD}} + CODESIGN_INTERMEDIATE_BASE64: ${{ secrets.CODESIGN_INTERMEDIATE_BASE64 }} + CODESIGN_BASE64: ${{ secrets.CODESIGN_BASE64}} + TCL_PATCHLEVEL: ${{ steps.cfg.outputs.patchlevel }} + if: env.CODESIGN_BASE64 + run: | + New-Item -ItemType directory -Path certificate + Set-Content -Path certificate\certificate.txt -Value $env:CODESIGN_BASE64 + certutil -decode certificate\certificate.txt certificate\certificate.pfx + Set-Content -Path certificate\intermediate.txt -Value $env:CODESIGN_INTERMEDIATE_BASE64 + certutil -decode certificate\intermediate.txt certificate\intermediate.crt + + & signtool sign /fd SHA256 /p $env:CODESIGN_PWD /ac certificate\intermediate.crt /f certificate\certificate.pfx /tr "http://timestamp.sectigo.com/rfc3161" /td sha256 tclsh${TCL_PATCHLEVEL}_snapshot.exe + + Remove-Item -Recurse -Force certificate + working-directory: 1dist + shell: pwsh - name: Upload uses: actions/upload-artifact@v3 with: -- cgit v0.12 From 040d9e7cb39e24375a3eb05fcd15dd958f0fff4c Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 24 Nov 2023 12:50:32 +0000 Subject: Simpler to use an existing action --- .github/workflows/onefiledist.yml | 38 ++++++++++++++++---------------------- 1 file changed, 16 insertions(+), 22 deletions(-) diff --git a/.github/workflows/onefiledist.yml b/.github/workflows/onefiledist.yml index 3a0e908..2b56934 100644 --- a/.github/workflows/onefiledist.yml +++ b/.github/workflows/onefiledist.yml @@ -156,35 +156,29 @@ jobs: - name: Get Exact Version run: | ./tclsh*.exe $VER_PATH $GITHUB_ENV + echo "target=tclsh${TCL_PATCHLEVEL}_snapshot.exe" >> $GITHUB_OUTPUT working-directory: win + id: exe + env: + TCL_PATCHLEVEL: ${{ steps.cfg.outputs.patchlevel }} - name: Set Executable Name run: | - cp ../win/tclsh*.exe tclsh${TCL_PATCHLEVEL}_snapshot.exe + cp ../win/tclsh*.exe "$TARGET_EXE" working-directory: 1dist env: - TCL_PATCHLEVEL: ${{ steps.cfg.outputs.patchlevel }} - - name: Sign Executable - # Adapted from https://federicoterzi.com/blog/automatic-codesigning-on-windows-using-github-actions/ + TARGET_EXE: ${{ steps.exe.outputs.target }} + - name: Sign + if: ${{ env.HAVE_CAPABILITY }} + uses: dlemstra/code-sign-action@v1 + with: + certificate: '${{ secrets.Windows_Certificate_base64 }}' + password: '${{ secrets.Windows_Certificate_password }}' + folder: 1dist + files: ${{ steps.exe.outputs.target }} env: - CODESIGN_PWD: ${{ secrets.CODESIGN_PWD}} - CODESIGN_INTERMEDIATE_BASE64: ${{ secrets.CODESIGN_INTERMEDIATE_BASE64 }} - CODESIGN_BASE64: ${{ secrets.CODESIGN_BASE64}} - TCL_PATCHLEVEL: ${{ steps.cfg.outputs.patchlevel }} - if: env.CODESIGN_BASE64 - run: | - New-Item -ItemType directory -Path certificate - Set-Content -Path certificate\certificate.txt -Value $env:CODESIGN_BASE64 - certutil -decode certificate\certificate.txt certificate\certificate.pfx - Set-Content -Path certificate\intermediate.txt -Value $env:CODESIGN_INTERMEDIATE_BASE64 - certutil -decode certificate\intermediate.txt certificate\intermediate.crt - - & signtool sign /fd SHA256 /p $env:CODESIGN_PWD /ac certificate\intermediate.crt /f certificate\certificate.pfx /tr "http://timestamp.sectigo.com/rfc3161" /td sha256 tclsh${TCL_PATCHLEVEL}_snapshot.exe - - Remove-Item -Recurse -Force certificate - working-directory: 1dist - shell: pwsh + HAVE_CAPABILITY: ${{ secrets.Windows_Certificate_base64 != '' && secrets.Windows_Certificate_password != '' }} - name: Upload uses: actions/upload-artifact@v3 with: name: Tclsh ${{ steps.cfg.outputs.patchlevel }} Windows single-file build (snapshot) - path: '1dist/*_snapshot.exe' + path: 1dist/${{ steps.exe.outputs.target }} -- cgit v0.12 From bcfce523279518d8515487f26f87ad34241746b5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 24 Nov 2023 14:04:21 +0000 Subject: Update dde and registry (int -> Tcl_Size) --- win/tclWinDde.c | 38 +++++++++++++++++++------------------- win/tclWinReg.c | 42 +++++++++++++++++++++--------------------- 2 files changed, 40 insertions(+), 40 deletions(-) diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 7db5312..7cb2480 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -114,7 +114,7 @@ static int MakeDdeConnection(Tcl_Interp *interp, const WCHAR *name, HCONV *ddeConvPtr); static void SetDdeError(Tcl_Interp *interp); static int DdeObjCmd(void *clientData, - Tcl_Interp *interp, int objc, + Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); #if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) @@ -126,7 +126,7 @@ static int DdeObjCmd(void *clientData, # define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString # endif #define Tcl_Size int -#define TCL_INDEX_NONE -1 +#define Tcl_CreateObjCommand2 Tcl_CreateObjCommand #endif #ifdef __cplusplus @@ -167,7 +167,7 @@ Dde_Init( return TCL_ERROR; } - Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); + Tcl_CreateObjCommand2(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL); } @@ -415,7 +415,7 @@ DdeSetServerName( Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); Tcl_DStringInit(&ds); - Tcl_UtfToWCharDString(Tcl_GetString(namePtr), TCL_INDEX_NONE, &ds); + Tcl_UtfToWCharDString(Tcl_GetString(namePtr), -1, &ds); if (wcscmp(actualName, (WCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; Tcl_DStringFree(&ds); @@ -445,7 +445,7 @@ DdeSetServerName( Tcl_ExposeCommand(interp, "dde", "dde"); } - Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, + Tcl_CreateObjCommand2(interp, "dde", DdeObjCmd, riPtr, DeleteProc); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "dde", "dde"); @@ -573,7 +573,7 @@ ExecuteRemoteObject( if ((riPtr->handlerPtr == NULL) && Tcl_IsSafe(riPtr->interp)) { Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: " "a handler procedure must be defined for use in a safe " - "interp", TCL_INDEX_NONE)); + "interp", -1)); Tcl_SetErrorCode(riPtr->interp, "TCL", "DDE", "SECURITY_CHECK", (void *)NULL); result = TCL_ERROR; } @@ -855,7 +855,7 @@ DdeServerProc( Tcl_WCharToUtfDString(utilString, wcslen(utilString), &ds2); utilString = (WCHAR *) Tcl_DStringValue(&ds2); } - variableObjPtr = Tcl_NewStringObj((char *)utilString, TCL_INDEX_NONE); + variableObjPtr = Tcl_NewStringObj((char *)utilString, -1); Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, variableObjPtr, TCL_GLOBAL_ONLY); @@ -1153,12 +1153,12 @@ DdeServicesOnAck( GlobalGetAtomNameW(service, sz, 255); Tcl_DStringInit(&dString); Tcl_WCharToUtfDString(sz, wcslen(sz), &dString); - Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), TCL_INDEX_NONE)); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); Tcl_DStringFree(&dString); GlobalGetAtomNameW(topic, sz, 255); Tcl_DStringInit(&dString); Tcl_WCharToUtfDString(sz, wcslen(sz), &dString); - Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), TCL_INDEX_NONE)); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(Tcl_DStringValue(&dString), -1)); Tcl_DStringFree(&dString); /* @@ -1276,7 +1276,7 @@ SetDdeError( errorCode = "FAILED"; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", errorCode, (void *)NULL); } @@ -1301,7 +1301,7 @@ static int DdeObjCmd( void *dummy, /* Not used. */ Tcl_Interp *interp, /* The interp we are sending from */ - int objc, /* Number of arguments */ + Tcl_Size objc, /* Number of arguments */ Tcl_Obj *const *objv) /* The arguments */ { static const char *const ddeCommands[] = { @@ -1329,8 +1329,8 @@ DdeObjCmd( "-binary", NULL }; - int index, i, argIndex; - Tcl_Size length; + int index, argIndex; + Tcl_Size length, i; int flags = 0, result = TCL_OK, firstArg = 0; HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; @@ -1562,7 +1562,7 @@ DdeObjCmd( if (dataLength + 1 < 2) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("cannot execute null data", TCL_INDEX_NONE)); + Tcl_NewStringObj("cannot execute null data", -1)); Tcl_DStringFree(&dsBuf); Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (void *)NULL); result = TCL_ERROR; @@ -1613,7 +1613,7 @@ DdeObjCmd( if (length == 0) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("cannot request value of null data", TCL_INDEX_NONE)); + Tcl_NewStringObj("cannot request value of null data", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (void *)NULL); result = TCL_ERROR; goto cleanup; @@ -1679,7 +1679,7 @@ DdeObjCmd( length = Tcl_DStringLength(&itemBuf) / sizeof(WCHAR); if (length == 0) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("cannot have a null item", TCL_INDEX_NONE)); + Tcl_NewStringObj("cannot have a null item", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", (void *)NULL); result = TCL_ERROR; goto cleanup; @@ -1733,7 +1733,7 @@ DdeObjCmd( if (serviceName == NULL) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("invalid service name \"\"", TCL_INDEX_NONE)); + Tcl_NewStringObj("invalid service name \"\"", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "NO_SERVER", (void *)NULL); result = TCL_ERROR; goto cleanup; @@ -1781,7 +1781,7 @@ DdeObjCmd( if (Tcl_IsSafe(riPtr->interp) && (riPtr->handlerPtr == NULL)) { Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj( "permission denied: a handler procedure must be" - " defined for use in a safe interp", TCL_INDEX_NONE)); + " defined for use in a safe interp", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "SECURITY_CHECK", (void *)NULL); result = TCL_ERROR; @@ -1847,7 +1847,7 @@ DdeObjCmd( if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) { invalidServerResponse: Tcl_SetObjResult(interp, - Tcl_NewStringObj("invalid data returned from server", TCL_INDEX_NONE)); + Tcl_NewStringObj("invalid data returned from server", -1)); Tcl_SetErrorCode(interp, "TCL", "DDE", "BAD_RESPONSE", (void *)NULL); result = TCL_ERROR; goto cleanup; diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 4157380..650e88e 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -91,7 +91,7 @@ static DWORD lastType = REG_RESOURCE_LIST; */ static void AppendSystemError(Tcl_Interp *interp, DWORD error); -static int BroadcastValue(Tcl_Interp *interp, int objc, +static int BroadcastValue(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); static DWORD ConvertDWORD(DWORD type, DWORD value); static void DeleteCmd(void *clientData); @@ -118,7 +118,7 @@ static int ParseKeyName(Tcl_Interp *interp, char *name, static DWORD RecursiveDeleteKey(HKEY hStartKey, const WCHAR * pKeyName, REGSAM mode); static int RegistryObjCmd(void *clientData, - Tcl_Interp *interp, int objc, + Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, @@ -133,7 +133,7 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, # define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString # endif #define Tcl_Size int -#define TCL_INDEX_NONE -1 +#define Tcl_CreateObjCommand2 Tcl_CreateObjCommand #endif #ifdef __cplusplus @@ -176,7 +176,7 @@ Registry_Init( return TCL_ERROR; } - cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, + cmd = Tcl_CreateObjCommand2(interp, "registry", RegistryObjCmd, interp, DeleteCmd); Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); return Tcl_PkgProvideEx(interp, "registry", "1.3.7", NULL); @@ -219,9 +219,9 @@ Registry_Unload( * Unregister the registry package. There is no Tcl_PkgForget() */ - objv[0] = Tcl_NewStringObj("package", TCL_INDEX_NONE); - objv[1] = Tcl_NewStringObj("forget", TCL_INDEX_NONE); - objv[2] = Tcl_NewStringObj("registry", TCL_INDEX_NONE); + objv[0] = Tcl_NewStringObj("package", -1); + objv[1] = Tcl_NewStringObj("forget", -1); + objv[2] = Tcl_NewStringObj("registry", -1); Tcl_EvalObjv(interp, 3, objv, TCL_EVAL_GLOBAL); /* @@ -291,11 +291,11 @@ static int RegistryObjCmd( void *dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { - int n = 1; - int index, argc; + Tcl_Size n = 1, argc; + int index; REGSAM mode = 0; const char *errString = NULL; @@ -461,7 +461,7 @@ DeleteKey( if (*keyName == '\0') { Tcl_SetObjResult(interp, - Tcl_NewStringObj("bad key: cannot delete root keys", TCL_INDEX_NONE)); + Tcl_NewStringObj("bad key: cannot delete root keys", -1)); Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", (void *)NULL); Tcl_Free(buffer); return TCL_ERROR; @@ -483,7 +483,7 @@ DeleteKey( return TCL_OK; } Tcl_SetObjResult(interp, - Tcl_NewStringObj("unable to delete key: ", TCL_INDEX_NONE)); + Tcl_NewStringObj("unable to delete key: ", -1)); AppendSystemError(interp, result); return TCL_ERROR; } @@ -493,13 +493,13 @@ DeleteKey( */ Tcl_DStringInit(&buf); - nativeTail = Tcl_UtfToWCharDString(tail, TCL_INDEX_NONE, &buf); + nativeTail = Tcl_UtfToWCharDString(tail, -1, &buf); result = RecursiveDeleteKey(subkey, nativeTail, saveMode); Tcl_DStringFree(&buf); if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("unable to delete key: ", TCL_INDEX_NONE)); + Tcl_NewStringObj("unable to delete key: ", -1)); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -731,7 +731,7 @@ GetType( if (type > lastType) { Tcl_SetObjResult(interp, Tcl_NewIntObj((int) type)); } else { - Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], -1)); } return TCL_OK; } @@ -995,7 +995,7 @@ OpenKey( result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr); if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("unable to open key: ", TCL_INDEX_NONE)); + Tcl_NewStringObj("unable to open key: ", -1)); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -1043,7 +1043,7 @@ OpenSubKey( if (hostName) { Tcl_DStringInit(&buf); - hostName = (char *) Tcl_UtfToWCharDString(hostName, TCL_INDEX_NONE, &buf); + hostName = (char *) Tcl_UtfToWCharDString(hostName, -1, &buf); result = RegConnectRegistryW((WCHAR *)hostName, rootKey, &rootKey); Tcl_DStringFree(&buf); @@ -1059,7 +1059,7 @@ OpenSubKey( if (keyName) { Tcl_DStringInit(&buf); - keyName = (char *) Tcl_UtfToWCharDString(keyName, TCL_INDEX_NONE, &buf); + keyName = (char *) Tcl_UtfToWCharDString(keyName, -1, &buf); } if (flags & REG_CREATE) { DWORD create; @@ -1163,7 +1163,7 @@ ParseKeyName( * Look for a matching root name. */ - rootObj = Tcl_NewStringObj(rootName, TCL_INDEX_NONE); + rootObj = Tcl_NewStringObj(rootName, -1); result = Tcl_GetIndexFromObj(interp, rootObj, rootKeyNames, "root name", TCL_EXACT, &index); Tcl_DecrRefCount(rootObj); @@ -1399,7 +1399,7 @@ SetValue( if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("unable to set value: ", TCL_INDEX_NONE)); + Tcl_NewStringObj("unable to set value: ", -1)); AppendSystemError(interp, result); return TCL_ERROR; } @@ -1426,7 +1426,7 @@ SetValue( static int BroadcastValue( Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { LRESULT result; -- cgit v0.12 From d9c6dc348fad6ac07712e4a0999158b0ae2fda28 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 24 Nov 2023 14:28:02 +0000 Subject: Need Tcl_Size #define a little earlier (for 8.6) --- win/tclWinDde.c | 32 ++++++++++++++++++-------------- win/tclWinReg.c | 30 +++++++++++++++++------------- 2 files changed, 35 insertions(+), 27 deletions(-) diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 7cb2480..d883bac 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -90,8 +90,24 @@ static int ddeIsServer = 0; TCL_DECLARE_MUTEX(ddeMutex) +#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) +# if TCL_UTF_MAX > 3 +# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) +# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) +# else +# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString +# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString +# endif +#ifndef Tcl_Size +# define Tcl_Size int +#endif +#ifndef Tcl_CreateObjCommand2 +# define Tcl_CreateObjCommand2 Tcl_CreateObjCommand +#endif +#endif + /* - * Forward declarations for functions defined later in this file. + * Declarations for functions defined in this file. */ static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, @@ -117,25 +133,13 @@ static int DdeObjCmd(void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); -#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) -# if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) -# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) -# else -# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString -# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString -# endif -#define Tcl_Size int -#define Tcl_CreateObjCommand2 Tcl_CreateObjCommand -#endif - #ifdef __cplusplus extern "C" { #endif DLLEXPORT int Dde_Init(Tcl_Interp *interp); DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); #if TCL_MAJOR_VERSION < 9 -/* With those additional entries, "load dde14.dll" works without 3th argument */ +/* With those additional entries, "load tcldde14.dll" works without 3th argument */ DLLEXPORT int Tcldde_Init(Tcl_Interp *interp); DLLEXPORT int Tcldde_SafeInit(Tcl_Interp *interp); #endif diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 650e88e..9ef62c6 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -86,6 +86,22 @@ static const char *const typeNames[] = { static DWORD lastType = REG_RESOURCE_LIST; +#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) +# if TCL_UTF_MAX > 3 +# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) +# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) +# else +# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString +# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString +# endif +#ifndef Tcl_Size +# define Tcl_Size int +#endif +#ifndef Tcl_CreateObjCommand2 +# define Tcl_CreateObjCommand2 Tcl_CreateObjCommand +#endif +#endif + /* * Declarations for functions defined in this file. */ @@ -124,25 +140,13 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, Tcl_Obj *typeObj, REGSAM mode); -#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) -# if TCL_UTF_MAX > 3 -# define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c) -# define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c) -# else -# define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString -# define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString -# endif -#define Tcl_Size int -#define Tcl_CreateObjCommand2 Tcl_CreateObjCommand -#endif - #ifdef __cplusplus extern "C" { #endif DLLEXPORT int Registry_Init(Tcl_Interp *interp); DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags); #if TCL_MAJOR_VERSION < 9 -/* With those additional entries, "load registry13.dll" works without 3th argument */ +/* With those additional entries, "load tclregistry13.dll" works without 3th argument */ DLLEXPORT int Tclregistry_Init(Tcl_Interp *interp); DLLEXPORT int Tclregistry_Unload(Tcl_Interp *interp, int flags); #endif -- cgit v0.12 From 5daaf944bf40da0d52f79c64188838fa4ae6ab6b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 26 Nov 2023 22:21:08 +0000 Subject: Fix [a606b0a528]: Tcl 9.0 fails to build from source for big-endian architectures --- generic/tclInt.h | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index f3c3f91..6b95992 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4601,22 +4601,6 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); /* *---------------------------------------------------------------- - * Macro used by the Tcl core to compare Unicode strings. On big-endian - * systems we can use the more efficient memcmp, but this would not be - * lexically correct on little-endian systems. The ANSI C "prototype" for - * this macro is: - * - * MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *cs, - * const Tcl_UniChar *ct, unsigned long n); - *---------------------------------------------------------------- - */ - -#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3) -# define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar)) -#endif /* WORDS_BIGENDIAN */ - -/* - *---------------------------------------------------------------- * Macro used by the Tcl core to increment a namespace's export epoch * counter. The ANSI C "prototype" for this macro is: * -- cgit v0.12 From 1923195c9a4f2efcbd18cb8255079aaf94b68593 Mon Sep 17 00:00:00 2001 From: Torsten Berg Date: Mon, 27 Nov 2023 07:10:19 +0000 Subject: Corrected synopsis of namespace manual page where the subcommand was wrongly declared optional --- doc/namespace.n | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/namespace.n b/doc/namespace.n index 1773555..4be0a3a 100644 --- a/doc/namespace.n +++ b/doc/namespace.n @@ -14,7 +14,7 @@ .SH NAME namespace \- create and manipulate contexts for commands and variables .SH SYNOPSIS -\fBnamespace \fR?\fIsubcommand\fR? ?\fIarg ...\fR? +\fBnamespace \fR\fIsubcommand\fR ?\fIarg ...\fR? .BE .SH DESCRIPTION .PP -- cgit v0.12 From a7b3d763333065aa11b920d8f1c2529370c1c693 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 27 Nov 2023 09:48:05 +0000 Subject: Constants can't be written to or unset --- generic/tclVar.c | 38 ++++++++++++++++++++++++++++++++++++-- 1 file changed, 36 insertions(+), 2 deletions(-) diff --git a/generic/tclVar.c b/generic/tclVar.c index 5bb4db3..e952614 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -128,6 +128,7 @@ static const char BADNAMESPACE[] = "parent namespace doesn't exist"; static const char MISSINGNAME[] = "missing variable name"; static const char ISARRAYELEMENT[] = "name refers to an element in an array"; +static const char ISCONST[] = "variable is a constant"; /* * A test to see if we are in a call frame that has local variables. This is @@ -1942,6 +1943,17 @@ TclPtrSetVarIdx( } /* + * It's an error to try to set a constant. + */ + if (TclIsVarConstant(varPtr)) { + if (flags & TCL_LEAVE_ERR_MSG) { + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISCONST,index); + Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL); + } + goto earlyError; + } + + /* * It's an error to try to set an array variable itself. */ @@ -2221,6 +2233,17 @@ TclPtrIncrObjVarIdx( { Tcl_Obj *varValuePtr; + /* + * It's an error to try to increment a constant. + */ + if (TclIsVarConstant(varPtr)) { + if (flags & TCL_LEAVE_ERR_MSG) { + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "incr", ISCONST,index); + Tcl_SetErrorCode(interp, "TCL", "WRITE", "CONST", (void *)NULL); + } + return NULL; + } + if (TclIsVarInHash(varPtr)) { VarHashRefCount(varPtr)++; } @@ -2429,14 +2452,14 @@ int TclPtrUnsetVarIdx( Tcl_Interp *interp, /* Command interpreter in which varName is to * be looked up. */ - Var *varPtr, /* The variable to be unset. */ + Var *varPtr, /* The variable to be unset. */ Var *arrayPtr, /* NULL for scalar variables, pointer to the * containing array otherwise. */ Tcl_Obj *part1Ptr, /* Name of an array (if part2 is non-NULL) or * the name of a variable. */ Tcl_Obj *part2Ptr, /* If non-NULL, gives the name of an element * in the array part1. */ - int flags, /* OR-ed combination of any of + int flags, /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, * TCL_LEAVE_ERR_MSG. */ int index) /* Index into the local variable table of the @@ -2448,6 +2471,17 @@ TclPtrUnsetVarIdx( Var *initialArrayPtr = arrayPtr; /* + * It's an error to try to unset a constant. + */ + if (TclIsVarConstant(varPtr)) { + if (flags & TCL_LEAVE_ERR_MSG) { + TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset", ISCONST,index); + Tcl_SetErrorCode(interp, "TCL", "UNSET", "CONST", (void *)NULL); + } + return TCL_ERROR; + } + + /* * Keep the variable alive until we're done with it. We used to * increase/decrease the refCount for each operation, making it hard to * find [Bug 735335] - caused by unsetting the variable whose value was -- cgit v0.12 From a130f70eb1c958b938a9d63a055fc64141903155 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 27 Nov 2023 12:01:09 +0000 Subject: (cherry-pick) Corrected synopsis of namespace manual page where the subcommand was wrongly declared optional --- doc/namespace.n | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/namespace.n b/doc/namespace.n index f7775b4..120c0a3 100644 --- a/doc/namespace.n +++ b/doc/namespace.n @@ -14,7 +14,7 @@ .SH NAME namespace \- create and manipulate contexts for commands and variables .SH SYNOPSIS -\fBnamespace \fR?\fIsubcommand\fR? ?\fIarg ...\fR? +\fBnamespace \fR\fIsubcommand\fR ?\fIarg ...\fR? .BE .SH DESCRIPTION .PP -- cgit v0.12 From d71e5affa9eebdc4bf1fc2be762e80404b9a5fe8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 27 Nov 2023 12:29:09 +0000 Subject: typo --- generic/tclBasic.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b6cbd89..60941b0 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -6898,7 +6898,7 @@ Tcl_Size Tcl_SetRecursionLimit( Tcl_Interp *interp, /* Interpreter whose nesting limit is to be * set. */ - Tcl_Size depth) /* New value for maximimum depth. */ + Tcl_Size depth) /* New value for maximum depth. */ { Interp *iPtr = (Interp *) interp; Tcl_Size old; -- cgit v0.12 From 94fa36b500d631786ffa4e12d09ed3f431441dde Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 27 Nov 2023 15:22:39 +0000 Subject: Command defined. It does nothing yet. --- doc/const.n | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclBasic.c | 3 +- generic/tclInt.h | 1 + generic/tclVar.c | 34 ++++++++++++++++++++++ 4 files changed, 120 insertions(+), 1 deletion(-) create mode 100644 doc/const.n diff --git a/doc/const.n b/doc/const.n new file mode 100644 index 0000000..e388a4d --- /dev/null +++ b/doc/const.n @@ -0,0 +1,83 @@ +'\" +'\" Copyright (c) 2023 Donal K. Fellows +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH const n 9.0 Tcl "Tcl Built-In Commands" +.so man.macros +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +const \- create and initialize a constant +.SH SYNOPSIS +\fBconst \fIvarName value\fR +.BE +.SH DESCRIPTION +.PP +This command is normally used within a procedure body (or method body, +or lambda term) to create a constant within that procedure, or within a +\fBnamespace eval\fR body to create a constant within that namespace. +The constant is an unmodifiable variable, called \fIvarName\fR, that is +initialized with \fIvalue\fR. +.PP +If a variable \fIvarName\fR does not exist, it is created. +If the variable already exists, it is set to \fIvalue\fR. +The variable is marked as a constant; this means that no other command +(e.g., \fBset\fR, \fBappend\fR, \fBincr\fR, \fBunset\fR) +may modify or remove the variable; variables are checked for whether they +are constants before any traces are called. +.PP +The \fIvarName\fR may not be a qualified name or reference an element of an +array by any means. If the variable exists and is an array, that is an error. +.PP +Constants are normally only removed by their containing procedure exiting or +their namespace being deleted. +.SH EXAMPLES +.PP +Create a constant in a procedure: +.PP +.CS +proc foo {a b} { + \fBconst\fR BAR 12345 + return [expr {$a + $b + $BAR}] +} +.CE +.PP +Create a constant in a namespace to factor out a regular expression: +.PP +.CS +namespace eval someNS { + \fBconst\fR FOO_MATCHER {(?i)}\emfoo\eM} + + proc findFoos str { + variable FOO_MATCHER + regexp -all $FOO_MATCHER $str + } + + proc findFooIndices str { + variable FOO_MATCHER + regexp -all -indices $FOO_MATCHER $str + } +} +.CE +.PP +Making a constant in a loop doesn't error: +.PP +.CS +proc foo {n} { + set result {} + for {set i 0} {$i < $n} {incr i} { + \fBconst\fR X 123 + lappend result [expr {$X + $i**2}] + } +} +.CE +.SH "SEE ALSO" +proc(n), namespace(n), set(n), unset(n) +.SH KEYWORDS +namespace, procedure, variable, constant +.\" Local variables: +.\" mode: nroff +.\" fill-column: 78 +.\" End: diff --git a/generic/tclBasic.c b/generic/tclBasic.c index b6cbd89..eab810d 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -316,6 +316,7 @@ static const CmdInfo builtInCmds[] = { {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE}, + {"const", Tcl_ConstObjCmd, NULL, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, {"coroinject", NULL, NULL, TclNRCoroInjectObjCmd, CMD_IS_SAFE}, {"coroprobe", NULL, NULL, TclNRCoroProbeObjCmd, CMD_IS_SAFE}, @@ -333,7 +334,7 @@ static const CmdInfo builtInCmds[] = { {"join", Tcl_JoinObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE}, {"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE}, - {"ledit", Tcl_LeditObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"ledit", Tcl_LeditObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE}, {"linsert", Tcl_LinsertObjCmd, TclCompileLinsertCmd, NULL, CMD_IS_SAFE}, {"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED}, diff --git a/generic/tclInt.h b/generic/tclInt.h index 8835060..cee419a 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3658,6 +3658,7 @@ MODULE_SCOPE void TclClockInit(Tcl_Interp *interp); MODULE_SCOPE Tcl_ObjCmdProc TclClockOldscanObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_CloseObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConcatObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConstObjCmd; MODULE_SCOPE Tcl_ObjCmdProc Tcl_ContinueObjCmd; MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler( Tcl_Time *timePtr, Tcl_TimerProc *proc, diff --git a/generic/tclVar.c b/generic/tclVar.c index e952614..7922a69 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -4842,6 +4842,40 @@ Tcl_GetVariableFullName( /* *---------------------------------------------------------------------- * + * Tcl_ConstObjCmd -- + * + * This function is invoked to process the "const" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl object result value. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_ConstObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "varName value"); + return TCL_ERROR; + } + + /* FIXME: implement this! */ + Tcl_SetObjResult(interp, Tcl_ObjPrintf("not yet implemented")); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_GlobalObjCmd -- * * This object-based function is invoked to process the "global" Tcl -- cgit v0.12 From 73c58292b557f8847fb3291cc5159a64945593b2 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 29 Nov 2023 14:26:50 +0000 Subject: Start of tests --- tests/var.test | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/tests/var.test b/tests/var.test index d4369b3..afa39b5 100644 --- a/tests/var.test +++ b/tests/var.test @@ -1480,6 +1480,38 @@ test var-24.24 {array default unset: errors} -setup { } -returnCodes error -cleanup { unset -nocomplain ary } -result * -match glob + +# The const command +test var-25.1 {const: no argument} -body { + apply {{} { + const + return $X + }} +} -returnCodes error -result {wrong # args: should be "const varName value"} +test var-25.2 {const: single argument} -body { + apply {{} { + const X + return $X + }} +} -returnCodes error -result {wrong # args: should be "const varName value"} +test var-25.3 {const: two arguments (basic correct usage)} knownBug { + apply {{} { + const X gorp + return $X + }} +} gorp +test var-25.4 {const: three arguments} -body { + apply {{} { + const X gorp foo + return $X + }} +} -returnCodes error -result {wrong # args: should be "const varName value"} +test var-25.5 {const: four arguments} -body { + apply {{} { + const X gorp foo bar + return $X + }} +} -returnCodes error -result {wrong # args: should be "const varName value"} catch {namespace delete ns} catch {unset arr} -- cgit v0.12 From b67b2a8dc3cc99ff9a0659d395a519f07ac1ebf4 Mon Sep 17 00:00:00 2001 From: oehhar Date: Thu, 30 Nov 2023 18:12:44 +0000 Subject: Remove comment sign from winPipe slowtest. I suppose, this is not intentionaly. --- tests/winPipe.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/winPipe.test b/tests/winPipe.test index 5d3999e..a04366b 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -34,7 +34,7 @@ testConstraint cat32 [file exists $cat32] testConstraint AllocConsole [catch {puts console1 ""}] testConstraint RealConsole [expr {![testConstraint AllocConsole]}] testConstraint testexcept [llength [info commands testexcept]] -#testConstraint slowTest 0 +testConstraint slowTest 0 set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n -- cgit v0.12 From 516659e2fccead0e1588df36883c1386e5ad6a82 Mon Sep 17 00:00:00 2001 From: oehhar Date: Thu, 30 Nov 2023 19:23:50 +0000 Subject: MS-Win: document the exec %var% re-allowance. Ticket [fb2fa9b3f6] --- doc/exec.n | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/doc/exec.n b/doc/exec.n index a0008ad..eb97072 100644 --- a/doc/exec.n +++ b/doc/exec.n @@ -254,22 +254,21 @@ Examples are: ENV X: CONTENT OF X .CE The following formatting is automatically performed on any -argument item: -.IP \(bu 3 -Avoid subprogram execution: +argument item to avoid subprogram execution: Any special character argument containing a special character (\fB&\fR, \fB|\fR, \fB^\fR, \fB<\fR, \fB>\fR, \fB!\fR, \fB(\fR, \fB)\fR, \fB(\fR, \fB%\fR) is automatically enclosed in quotes (\fB"\fR). Any data quote is escaped by insertion of backslash characters. -.IP \(bu 3 -Avoid environment variable replacement: -Any appearence of environment variable reference (\fB%\fR) is individually quoted -by \fB"\fR. +.PP +The automatic resolving of environment variables using "\fB%var%\fR" is critical, +but has more use than danger and is not escaped. .PP TCL 8.6.10 refined this quoting by adding quoting for data quotes and individual quoting of "\fB%\fR". This may break present scripts which rely on the replacement functionality of environment variables. +Thus, the individual quoting of "\fB%\fR" was removed in TCL 8.6.14, as environment +variables are seen more helpful than a problem. A solution with command parameters is envisaged for a future release of TCL. .RE .PP -- cgit v0.12 From bd5d002701c54c470d91697f06ea2f2c2703d8c4 Mon Sep 17 00:00:00 2001 From: oehhar Date: Thu, 30 Nov 2023 19:28:20 +0000 Subject: Remove 8.6 specific documentation --- doc/exec.n | 8 -------- 1 file changed, 8 deletions(-) diff --git a/doc/exec.n b/doc/exec.n index 91f37e1..becb130 100644 --- a/doc/exec.n +++ b/doc/exec.n @@ -262,14 +262,6 @@ insertion of backslash characters. .PP The automatic resolving of environment variables using "\fB%var%\fR" is critical, but has more use than danger and is not escaped. -.PP -TCL 8.6.10 refined this quoting by adding quoting for data quotes and individual -quoting of "\fB%\fR". -This may break present scripts which rely on the replacement functionality of -environment variables. -Thus, the individual quoting of "\fB%\fR" was removed in TCL 8.6.14, as environment -variables are seen more helpful than a problem. -A solution with command parameters is envisaged for a future release of TCL. .RE .PP The Tk console text widget does not provide real standard IO capabilities. -- cgit v0.12 From d878951391f7cd4e82d2e0d86acb57515db0100e Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 1 Dec 2023 16:22:34 +0000 Subject: We're doing TDD here! --- generic/tclVar.c | 16 ++++++++++++++++ tests/var.test | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 73 insertions(+), 1 deletion(-) diff --git a/generic/tclVar.c b/generic/tclVar.c index 7922a69..83c7ce6 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -4863,11 +4863,27 @@ Tcl_ConstObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + Var *varPtr, *arrayPtr; + if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "varName value"); return TCL_ERROR; } + varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG, + "const", /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr); + if (arrayPtr) { + // FIXME: What if we got an array? + } + if (!varPtr->value.objPtr) { + if (TclPtrSetVar(interp, (Tcl_Var) varPtr, NULL, objv[1], NULL, + objv[2], TCL_LEAVE_ERR_MSG) == NULL) { + return TCL_ERROR; + }; + varPtr->flags |= VAR_CONSTANT; + return TCL_OK; + } + /* FIXME: implement this! */ Tcl_SetObjResult(interp, Tcl_ObjPrintf("not yet implemented")); return TCL_ERROR; diff --git a/tests/var.test b/tests/var.test index afa39b5..6e5ff7f 100644 --- a/tests/var.test +++ b/tests/var.test @@ -1494,7 +1494,7 @@ test var-25.2 {const: single argument} -body { return $X }} } -returnCodes error -result {wrong # args: should be "const varName value"} -test var-25.3 {const: two arguments (basic correct usage)} knownBug { +test var-25.3 {const: two arguments (basic correct usage)} { apply {{} { const X gorp return $X @@ -1512,6 +1512,62 @@ test var-25.5 {const: four arguments} -body { return $X }} } -returnCodes error -result {wrong # args: should be "const varName value"} + +test var-26.1 {const: unmodifiable by set} -body { + apply {{} { + const X 123 + set X gorp + }} +} -returnCodes error -result {can't set "X": variable is a constant} +test var-26.2 {const: unmodifiable by append} -body { + apply {{} { + const X 123 + append X gorp + }} +} -returnCodes error -result {can't set "X": variable is a constant} +test var-26.3 {const: unmodifiable by lappend} -body { + apply {{} { + const X 123 + lappend X gorp + }} +} -returnCodes error -result {can't set "X": variable is a constant} +test var-26.4 {const: unmodifiable by incr} -body { + apply {{} { + const X 123 + incr X + }} +} -returnCodes error -result {can't incr "X": variable is a constant} +test var-26.5 {const: unmodifiable by dict set} -body { + apply {{} { + const X {a 123} + dict set X a gorp + }} +} -returnCodes error -result {can't set "X": variable is a constant} +test var-26.6 {const: unmodifiable by regsub} -body { + apply {{} { + const X abcabc + regsub -all {a(.)} $X {\1\1} X + }} +} -returnCodes error -result {can't set "X": variable is a constant} +test var-26.7 {const: unmodifiable by gets} -setup { + set file [makeFile foo var26.7.txt] + set f [open $file] +} -body { + apply {f { + const X abcabc + gets $f X + }} $f +} -returnCodes error -cleanup { + close $f + removeFile $file +} -result {can't set "X": variable is a constant} +test var-26.8 {const: modifiable by const} knownBug { + apply {{} { + const X 1 + const X 2 + return $X + }} +} 2 catch {namespace delete ns} catch {unset arr} -- cgit v0.12 From 1a022cd6633ccf0eb2d9ca267203d2a6297aee72 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 2 Dec 2023 20:32:03 +0000 Subject: Implementation of reasonable set of tests --- generic/tclVar.c | 46 ++++++++++++++++++++++---------- tests/var.test | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 111 insertions(+), 15 deletions(-) diff --git a/generic/tclVar.c b/generic/tclVar.c index 83c7ce6..1f73316 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -4864,29 +4864,47 @@ Tcl_ConstObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Var *varPtr, *arrayPtr; + Tcl_Obj *part1Ptr; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "varName value"); return TCL_ERROR; } - varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG, - "const", /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr); - if (arrayPtr) { - // FIXME: What if we got an array? + part1Ptr = objv[1]; + varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, TCL_LEAVE_ERR_MSG, + "const", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); + if (TclIsVarArray(varPtr)) { + TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", ISARRAY, -1); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VAR", (void *)NULL); + return TCL_ERROR; } - if (!varPtr->value.objPtr) { - if (TclPtrSetVar(interp, (Tcl_Var) varPtr, NULL, objv[1], NULL, - objv[2], TCL_LEAVE_ERR_MSG) == NULL) { - return TCL_ERROR; - }; - varPtr->flags |= VAR_CONSTANT; - return TCL_OK; + if (TclIsVarArrayElement(varPtr)) { + if (!varPtr->value.objPtr) { + CleanupVar(varPtr, arrayPtr); + } + TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", ISARRAYELEMENT, -1); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", (void *)NULL); + return TCL_ERROR; } - /* FIXME: implement this! */ - Tcl_SetObjResult(interp, Tcl_ObjPrintf("not yet implemented")); - return TCL_ERROR; + /* + * TODO: Check if the variable is the same as it was, to match TIP feature. + * Or make const's ability to write to the variable a documented feature. + */ + if (!TclIsVarUndefined(varPtr) && TclIsVarConstant(varPtr)) { + varPtr->flags &= !VAR_CONSTANT; + } + if (TclPtrSetVar(interp, (Tcl_Var) varPtr, NULL, objv[1], NULL, + objv[2], TCL_LEAVE_ERR_MSG) == NULL) { + varPtr->flags |= VAR_CONSTANT; + if (TclIsVarUndefined(varPtr)) { + CleanupVar(varPtr, arrayPtr); + } + return TCL_ERROR; + }; + varPtr->flags |= VAR_CONSTANT; + return TCL_OK; } /* diff --git a/tests/var.test b/tests/var.test index 6e5ff7f..bbb7832 100644 --- a/tests/var.test +++ b/tests/var.test @@ -1561,13 +1561,91 @@ test var-26.7 {const: unmodifiable by gets} -setup { close $f removeFile $file } -result {can't set "X": variable is a constant} -test var-26.8 {const: modifiable by const} knownBug { +test var-26.8 {const: may not be array} -body { + apply {{} { + array set X {a b} + const X 1 + return $X + }} +} -returnCodes error -result {can't make constant "X": variable is array} +test var-26.9 {const: may not be array element} -body { + apply {{} { + array set X {a b} + const X(a) 1 + return $X(a) + }} +} -returnCodes error -result {can't make constant "X(a)": name refers to an element in an array} +test var-26.10 {const: modifiable by const} { apply {{} { const X 1 const X 2 return $X }} } 2 +test var-26.11 {const: may not be unset} -body { + apply {{} { + const X 1 + unset X + }} +} -returnCodes error -result {can't unset "X": variable is a constant} + +test var-27.1 {const: in a namespace} -setup { + namespace eval var27 {} +} -body { + namespace eval var27 { + variable X + const X gorp + return $X + } +} -cleanup { + namespace delete var27 +} -result gorp +test var-27.2 {const: in a namespace} -setup { + namespace eval var27 {} +} -body { + namespace eval var27 { + variable X + const X gorp + } + apply {{} { + variable X + set X 123 + } var27} +} -cleanup { + namespace delete var27 +} -returnCodes error -result {can't set "X": variable is a constant} +test var-27.3 {const: in a namespace} -setup { + namespace eval var27 {} +} -body { + namespace eval var27 { + variable X + const X gorp + } + apply {{} { + variable X + unset X + } var27} +} -cleanup { + namespace delete var27 +} -returnCodes error -result {can't unset "X": variable is a constant} +test var-27.4 {const: in a namespace} -setup { + namespace eval var27 {} +} -body { + namespace eval var27 { + variable X + const X gorp + } + namespace delete var27 + namespace eval var27 { + variable X abc + } + apply {{} { + variable X + return $X + } var27} +} -cleanup { + namespace delete var27 +} -result abc catch {namespace delete ns} catch {unset arr} -- cgit v0.12 -- cgit v0.12 From 12c773ffa82f614800146c0c9d3fc57195cbee11 Mon Sep 17 00:00:00 2001 From: kjnash Date: Sun, 3 Dec 2023 13:25:47 +0000 Subject: Fix for ticket [bbaf69c3dd] (test http-4.15.*). Do not rely on tk TLD. Increase timeout to 30s. More precise comments. --- tests/http.test | 30 +++++++++++++++++++++++------- 1 file changed, 23 insertions(+), 7 deletions(-) diff --git a/tests/http.test b/tests/http.test index e9a0b31..657465f 100644 --- a/tests/http.test +++ b/tests/http.test @@ -481,7 +481,7 @@ test http-3.33.$ThreadLevel {http::geturl application/xml is text} -body { } -result {test 4660 /test} test http-3.34.$ThreadLevel {http::geturl -headers not a list} -returnCodes error -body { http::geturl http://test/t -headers \" -} -result {Bad value for -headers ("), must be list} +} -result "Bad value for -headers (\"), must be list" test http-3.35.$ThreadLevel {http::geturl -headers not even number of elements} -returnCodes error -body { http::geturl http://test/t -headers {List Length 3} } -result {Bad value for -headers (List Length 3), number of list elements must be even} @@ -634,13 +634,29 @@ test http-4.14.$ThreadLevel {http::Event} -body { # Bogus host test http-4.15.$ThreadLevel {http::Event} -body { - # This test may fail if you use a proxy server. That is to be - # expected and is not a problem with Tcl. - # With http::config -threadlevel 1 or 2, the script enters the event loop - # during the DNS lookup, and has the opportunity to time out. - # Increase -timeout from 3000 to 10000 to prevent this. - set token [http::geturl //not_a_host.tcl.tk -timeout 10000 -command \#] + # 1. The test assumes that http is not using a proxy server. + # If http is using a proxy server, the latter is responsible for the DNS + # lookup of the non-existent host. Squid responds with + # "503 Service Unavailable" and an explanatory response body; but other + # proxies may respond differently. + # 2. The [socket] command blocks during the DNS lookup. + # - When [socket] runs in the main thread (i.e. when -threadlevel is 0 or + # (if Thread package not available) 1), the script cannot time out + # during a prolonged DNS lookup. + # - When [socket] runs in a separate thread (i.e. when the Thread package + # is available and [http::config -threadlevel] is 1 or 2), the main + # thread enters the event loop and has the opportunity to time out + # during the DNS lookup. This causes the test to fail. + # - The test uses a long -timeout so that it is not confounded by a slow + # DNS lookup. + # - If the error result is "timeout", this suggests a problem with + # negative DNS lookups on the test host. Compare the timings for + # different values of threadLevel. + # set t0 [clock milliseconds] + set token [http::geturl //not-a-host.nodns. -timeout 30000 -command \#] http::wait $token + # set t1 [clock milliseconds] + # puts "Test http-4.15.$ThreadLevel - time taken: [expr {$t1 - $t0}] ms" set result "[http::status $token] -- [lindex [http::error $token] 0]" # error codes vary among platforms. } -cleanup { -- cgit v0.12 From 29a2ae99530a0d3934ece8ede3bd462f81e8c7d4 Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 4 Dec 2023 13:33:22 +0000 Subject: Much more testing, semantic tweak --- doc/const.n | 8 ++-- generic/tclVar.c | 22 ++++++--- tests/var.test | 133 ++++++++++++++++++++++++++++++++++++++++++++++++++++--- 3 files changed, 147 insertions(+), 16 deletions(-) diff --git a/doc/const.n b/doc/const.n index e388a4d..b432655 100644 --- a/doc/const.n +++ b/doc/const.n @@ -20,13 +20,15 @@ or lambda term) to create a constant within that procedure, or within a \fBnamespace eval\fR body to create a constant within that namespace. The constant is an unmodifiable variable, called \fIvarName\fR, that is initialized with \fIvalue\fR. +The result of \fBconst\fR is always the empty string on success. .PP -If a variable \fIvarName\fR does not exist, it is created. -If the variable already exists, it is set to \fIvalue\fR. -The variable is marked as a constant; this means that no other command +If a variable \fIvarName\fR does not exist, it is created with its value set +to \fIvalue\fR and marked as a constant; this means that no other command (e.g., \fBset\fR, \fBappend\fR, \fBincr\fR, \fBunset\fR) may modify or remove the variable; variables are checked for whether they are constants before any traces are called. +If a variable \fIvarName\fR already exists, it is an error unless that +variable is marked as a constant (in which case \fBconst\fR is a no-op). .PP The \fIvarName\fR may not be a qualified name or reference an element of an array by any means. If the variable exists and is an array, that is an error. diff --git a/generic/tclVar.c b/generic/tclVar.c index 1f73316..854f9e6 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -129,6 +129,7 @@ static const char MISSINGNAME[] = "missing variable name"; static const char ISARRAYELEMENT[] = "name refers to an element in an array"; static const char ISCONST[] = "variable is a constant"; +static const char EXISTS[] = "variable already exists"; /* * A test to see if we are in a call frame that has local variables. This is @@ -4880,7 +4881,7 @@ Tcl_ConstObjCmd( return TCL_ERROR; } if (TclIsVarArrayElement(varPtr)) { - if (!varPtr->value.objPtr) { + if (TclIsVarUndefined(varPtr)) { CleanupVar(varPtr, arrayPtr); } TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", ISARRAYELEMENT, -1); @@ -4889,21 +4890,28 @@ Tcl_ConstObjCmd( } /* - * TODO: Check if the variable is the same as it was, to match TIP feature. - * Or make const's ability to write to the variable a documented feature. + * If already exists, either a constant (no problem) or an error. */ - if (!TclIsVarUndefined(varPtr) && TclIsVarConstant(varPtr)) { - varPtr->flags &= !VAR_CONSTANT; + if (!TclIsVarUndefined(varPtr)) { + if (TclIsVarConstant(varPtr)) { + return TCL_OK; + } + TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", EXISTS, -1); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VAR", (void *)NULL); + return TCL_ERROR; } + + /* + * Make the variable and flag it as a constant. + */ if (TclPtrSetVar(interp, (Tcl_Var) varPtr, NULL, objv[1], NULL, objv[2], TCL_LEAVE_ERR_MSG) == NULL) { - varPtr->flags |= VAR_CONSTANT; if (TclIsVarUndefined(varPtr)) { CleanupVar(varPtr, arrayPtr); } return TCL_ERROR; }; - varPtr->flags |= VAR_CONSTANT; + TclSetVarConstant(varPtr); return TCL_OK; } diff --git a/tests/var.test b/tests/var.test index bbb7832..26a2e11 100644 --- a/tests/var.test +++ b/tests/var.test @@ -1496,10 +1496,10 @@ test var-25.2 {const: single argument} -body { } -returnCodes error -result {wrong # args: should be "const varName value"} test var-25.3 {const: two arguments (basic correct usage)} { apply {{} { - const X gorp - return $X + set res [const X gorp] + return [list $res $X] }} -} gorp +} {{} gorp} test var-25.4 {const: three arguments} -body { apply {{} { const X gorp foo @@ -1568,26 +1568,118 @@ test var-26.8 {const: may not be array} -body { return $X }} } -returnCodes error -result {can't make constant "X": variable is array} -test var-26.9 {const: may not be array element} -body { +test var-26.9.1 {const: may not be array element} -body { apply {{} { array set X {a b} const X(a) 1 return $X(a) }} } -returnCodes error -result {can't make constant "X(a)": name refers to an element in an array} -test var-26.10 {const: modifiable by const} { +test var-26.9.2 {const: may not be array element} -body { + apply {{} { + array set X {a b} + const X(b) 1 + return $X(b) + }} +} -returnCodes error -result {can't make constant "X(b)": name refers to an element in an array} +test var-26.10.1 {const: unmodifiable by const but not an error} { apply {{} { const X 1 const X 2 return $X }} -} 2 +} 1 +test var-26.10.2 {const: unmodifiable by const but not an error} { + apply {{} { + lmap x {1 2 3} { + const A 2 + const B 3 + const C 5 + expr {$A * $x**2 + $B * $x + $C} + } + }} +} {10 19 32} test var-26.11 {const: may not be unset} -body { apply {{} { const X 1 unset X }} } -returnCodes error -result {can't unset "X": variable is a constant} +test var-26.12 {const: may not be unset, but -nocomplain doesn't complain} { + apply {{} { + const X 1 + unset -nocomplain X + return $X + }} +} 1 +test var-26.13 {const and traces: write trace causes fail} -body { + apply {{} { + trace add variable X write {apply {args { + error "ERR: $args" + }}} + const X gorp + return $X + }} +} -returnCodes error -result {can't set "X": ERR: X {} write} +test var-26.14 {const and traces: write trace err causes no const} -body { + apply {{} { + set trace {apply {args { + error "ERR: $args" + }}} + trace add variable X write $trace + catch { + const X gorp + } + trace remove variable X write $trace + set X 123 + return $X + }} +} -result 123 +test var-26.15 {const and traces: read traces} -setup { + unset -nocomplain traces + set traces {} +} -body { + apply {{} { + trace add variable X read {apply {args { + lappend ::traces $args + }}} + const X gorp + list $X $X $::traces + }} +} -result {gorp gorp {{X {} read} {X {} read}}} -cleanup { + unset -nocomplain traces +} +test var-26.16 {const and traces: write traces} -setup { + unset -nocomplain traces + set traces {} +} -body { + apply {{} { + trace add variable X write {apply {args { + lappend ::traces $args + }}} + const X gorp + const X foo + catch {set X bar} + list $X $::traces + }} +} -result {gorp {{X {} write}}} -cleanup { + unset -nocomplain traces +} +test var-26.17 {const and traces: unset traces} -setup { + unset -nocomplain traces + set traces {} +} -body { + list {*}[apply {{} { + trace add variable X unset {apply {args { + lappend ::traces $args + }}} + const X gorp + unset -nocomplain X + list $X $::traces + }}] $traces +} -result {gorp {} {{X {} unset}}} -cleanup { + unset -nocomplain traces +} test var-27.1 {const: in a namespace} -setup { namespace eval var27 {} @@ -1646,6 +1738,35 @@ test var-27.4 {const: in a namespace} -setup { } -cleanup { namespace delete var27 } -result abc +test var-27.5 {const: in a namespace, direct access from proc} -setup { + namespace eval var27 {} +} -body { + set result [apply {{} { + const ::var27::X abc + # Constant in namespace, NOT locally! + info exists X + }}] + apply {res { + variable X + list $res [catch {unset X} msg] $msg $X + } var27} $result +} -cleanup { + namespace delete var27 +} -result {0 1 {can't unset "X": variable is a constant} abc} + +test var-28.1 {const: globally} -setup { + set int [interp create] +} -body { + $int eval { + const X gorp + apply {{} { + global X + return $X + }} + } +} -cleanup { + interp delete $int +} -result gorp catch {namespace delete ns} catch {unset arr} -- cgit v0.12 From bcd1b60f83b72d5be224321218164a8988d8a201 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 5 Dec 2023 09:27:04 +0000 Subject: Revert TIP #664 (put back the type-casts) --- generic/tclDecls.h | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 7ed799d..c376dc6 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4235,71 +4235,71 @@ extern const TclStubs *tclStubsPtr; # if !defined(USE_TCL_STUBS) # define Tcl_GetByteArrayFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetBytesFromObj(NULL, (objPtr), (sizePtr)) : \ - (Tcl_GetBytesFromObj)(NULL, (objPtr), (sizePtr))) + (Tcl_GetBytesFromObj)(NULL, (objPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetBytesFromObj((interp), (objPtr), (sizePtr)) : \ - (Tcl_GetBytesFromObj)((interp), (objPtr), (sizePtr))) + (Tcl_GetBytesFromObj)((interp), (objPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetStringFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetStringFromObj((objPtr), (sizePtr)) : \ - (Tcl_GetStringFromObj)((objPtr), (sizePtr))) + (Tcl_GetStringFromObj)((objPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetUnicodeFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetUnicodeFromObj((objPtr), (sizePtr)) : \ - (Tcl_GetUnicodeFromObj)((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)) : \ - (Tcl_ListObjGetElements)((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)) : \ - (Tcl_ListObjLength)((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)) : \ - (Tcl_DictObjSize)((interp), (dictPtr), (sizePtr))) + (Tcl_DictObjSize)((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) <= sizeof(int) ? \ TclSplitList((interp), (listStr), (argcPtr), (argvPtr)) : \ - (Tcl_SplitList)((interp), (listStr), (argcPtr), (argvPtr))) + (Tcl_SplitList)((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) <= sizeof(int) ? \ TclSplitPath((path), (argcPtr), (argvPtr)) : \ - (Tcl_SplitPath)((path), (argcPtr), (argvPtr))) + (Tcl_SplitPath)((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) <= sizeof(int) ? \ TclFSSplitPath((pathPtr), (lenPtr)) : \ - (Tcl_FSSplitPath)((pathPtr), (lenPtr))) + (Tcl_FSSplitPath)((pathPtr), (Tcl_Size *)(void *)(lenPtr))) # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) <= sizeof(int) ? \ TclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) : \ - (Tcl_ParseArgsObjv)((interp), (argTable), (objcPtr), (objv), (remObjv))) + (Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) # elif !defined(BUILD_tcl) # define Tcl_GetByteArrayFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetBytesFromObj(NULL, (objPtr), (sizePtr)) : \ - tclStubsPtr->tcl_GetBytesFromObj(NULL, (objPtr), (sizePtr))) + tclStubsPtr->tcl_GetBytesFromObj(NULL, (objPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetBytesFromObj((interp), (objPtr), (sizePtr)) : \ - tclStubsPtr->tcl_GetBytesFromObj((interp), (objPtr), (sizePtr))) + tclStubsPtr->tcl_GetBytesFromObj((interp), (objPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetStringFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetStringFromObj((objPtr), (sizePtr)) : \ - tclStubsPtr->tcl_GetStringFromObj((objPtr), (sizePtr))) + tclStubsPtr->tcl_GetStringFromObj((objPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetUnicodeFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetUnicodeFromObj((objPtr), (sizePtr)) : \ - tclStubsPtr->tcl_GetUnicodeFromObj((objPtr), (sizePtr))) + tclStubsPtr->tcl_GetUnicodeFromObj((objPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) <= sizeof(int) ? \ tclStubsPtr->tclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) : \ - tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr))) + tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr))) # define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) <= sizeof(int) ? \ tclStubsPtr->tclListObjLength((interp), (listPtr), (lengthPtr)) : \ - tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (lengthPtr))) + tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr))) # define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclDictObjSize((interp), (dictPtr), (sizePtr)) : \ - tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (sizePtr))) + tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) <= sizeof(int) ? \ tclStubsPtr->tclSplitList((interp), (listStr), (argcPtr), (argvPtr)) : \ - tclStubsPtr->tcl_SplitList((interp), (listStr), (argcPtr), (argvPtr))) + tclStubsPtr->tcl_SplitList((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) <= sizeof(int) ? \ tclStubsPtr->tclSplitPath((path), (argcPtr), (argvPtr)) : \ - tclStubsPtr->tcl_SplitPath((path), (argcPtr), (argvPtr))) + tclStubsPtr->tcl_SplitPath((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) <= sizeof(int) ? \ tclStubsPtr->tclFSSplitPath((pathPtr), (lenPtr)) : \ - tclStubsPtr->tcl_FSSplitPath((pathPtr), (lenPtr))) + tclStubsPtr->tcl_FSSplitPath((pathPtr), (Tcl_Size *)(void *)(lenPtr))) # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) <= sizeof(int) ? \ tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) : \ - tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv))) + tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) # endif /* defined(USE_TCL_STUBS) */ #else /* !defined(TCL_8_API) */ # undef Tcl_GetByteArrayFromObj -- cgit v0.12 From b173cdb0df35d0f23f95418be623293e4d07bfe0 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 5 Dec 2023 10:29:46 +0000 Subject: Added introspection --- doc/info.n | 13 +++ generic/tclCmdIL.c | 2 + generic/tclInt.h | 2 + generic/tclVar.c | 251 +++++++++++++++++++++++++++++++++++++++++++++++++++-- tests/var.test | 66 ++++++++++++++ 5 files changed, 329 insertions(+), 5 deletions(-) diff --git a/doc/info.n b/doc/info.n index b84b2c7..24ed3b8 100644 --- a/doc/info.n +++ b/doc/info.n @@ -85,6 +85,19 @@ Returns 1 if \fIcommand\fR is a complete command, and \fB0\fR otherwise. Typically used in line-oriented input environments to allow users to type in commands that span multiple lines. .TP +\fBinfo constant \fIvarName\fR +.VS "TIP 677" +Returns 1 if \fIvarName\fR is a constant variable (see \fBconst\fR) and 0 +otherwise. +.VE "TIP 677" +.TP +\fBinfo consts\fR ?\fIpattern\fR? +.VS "TIP 677" +Returns the list of constant variables (see \fBconst\fR) in the current scope, +or the list of constant variables matching \fIpattern\fR (if that is provided) +in a manner similar to \fBinfo vars\fR. +.VE "TIP 677" +.TP \fBinfo coroutine\fR . Returns the name of the current \fBcoroutine\fR, or the empty diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index fb31d44..18842a1 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -160,6 +160,8 @@ static const EnsembleImplMap defaultInfoMap[] = { {"cmdtype", InfoCmdTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {"commands", InfoCommandsCmd, TclCompileInfoCommandsCmd, NULL, NULL, 0}, {"complete", InfoCompleteCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"constant", TclInfoConstantCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"consts", TclInfoConstsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"coroutine", TclInfoCoroutineCmd, TclCompileInfoCoroutineCmd, NULL, NULL, 0}, {"default", InfoDefaultCmd, TclCompileBasic3ArgCmd, NULL, NULL, 0}, {"errorstack", InfoErrorStackCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, diff --git a/generic/tclInt.h b/generic/tclInt.h index cee419a..e9d3006 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3376,6 +3376,8 @@ MODULE_SCOPE Tcl_Obj * TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr); MODULE_SCOPE Tcl_ObjCmdProc TclInfoGlobalsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclInfoLocalsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclInfoVarsCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclInfoConstsCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclInfoConstantCmd; MODULE_SCOPE void TclInitAlloc(void); MODULE_SCOPE void TclInitDbCkalloc(void); MODULE_SCOPE void TclInitDoubleConversion(void); diff --git a/generic/tclVar.c b/generic/tclVar.c index 854f9e6..de7e374 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -180,7 +180,8 @@ typedef struct ArrayVarHashTable { */ static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr, - Tcl_Obj *patternPtr, int includeLinks); + Tcl_Obj *patternPtr, int includeLinks, + int justConstants); static void ArrayPopulateSearch(Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Var *varPtr, ArraySearch *searchPtr); @@ -6145,7 +6146,7 @@ TclInfoVarsCmd( } } } else if (iPtr->varFramePtr->procPtr != NULL) { - AppendLocals(interp, listPtr, simplePatternPtr, 1); + AppendLocals(interp, listPtr, simplePatternPtr, 1, 0); } if (simplePatternPtr) { @@ -6299,7 +6300,201 @@ TclInfoLocalsCmd( */ listPtr = Tcl_NewListObj(0, NULL); - AppendLocals(interp, listPtr, patternPtr, 0); + AppendLocals(interp, listPtr, patternPtr, 0, 0); + Tcl_SetObjResult(interp, listPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclInfoConstsCmd -- + * + * Called to implement the "info consts" command that returns the list of + * constants in the interpreter that match an optional pattern. The + * pattern, if any, consists of an optional sequence of namespace names + * separated by "::" qualifiers, which is followed by a glob-style + * pattern that restricts which variables are returned. Handles the + * following syntax: + * + * info consts ?pattern? + * + * Results: + * Returns TCL_OK if successful and TCL_ERROR if there is an error. + * + * Side effects: + * Returns a result in the interpreter's result object. If there is an + * error, the result is an error message. + * + *---------------------------------------------------------------------- + */ + +int +TclInfoConstsCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Interp *iPtr = (Interp *) interp; + const char *varName, *pattern, *simplePattern; + Tcl_HashSearch search; + Var *varPtr; + Namespace *nsPtr; + Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); + Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + Tcl_Obj *listPtr, *elemObjPtr, *varNamePtr; + int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ + Tcl_Obj *simplePatternPtr = NULL; + + /* + * Get the pattern and find the "effective namespace" in which to list + * variables. We only use this effective namespace if there's no active + * Tcl procedure frame. + */ + + if (objc == 1) { + simplePattern = NULL; + nsPtr = currNsPtr; + specificNsInPattern = 0; + } else if (objc == 2) { + /* + * From the pattern, get the effective namespace and the simple + * pattern (no namespace qualifiers or ::'s) at the end. If an error + * was found while parsing the pattern, return it. Otherwise, if the + * namespace wasn't found, just leave nsPtr NULL: we will return an + * empty list since no variables there can be found. + */ + + Namespace *dummy1NsPtr, *dummy2NsPtr; + + pattern = TclGetString(objv[1]); + TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0, + &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern); + + if (nsPtr != NULL) { /* We successfully found the pattern's ns. */ + specificNsInPattern = (strcmp(simplePattern, pattern) != 0); + if (simplePattern == pattern) { + simplePatternPtr = objv[1]; + } else { + simplePatternPtr = Tcl_NewStringObj(simplePattern, -1); + } + Tcl_IncrRefCount(simplePatternPtr); + } + } else { + Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); + return TCL_ERROR; + } + + /* + * If the namespace specified in the pattern wasn't found, just return. + */ + + if (nsPtr == NULL) { + return TCL_OK; + } + + listPtr = Tcl_NewListObj(0, NULL); + + if (!HasLocalVars(iPtr->varFramePtr) || specificNsInPattern) { + /* + * There is no frame pointer, the frame pointer was pushed only to + * activate a namespace, or we are in a procedure call frame but a + * specific namespace was specified. Create a list containing only the + * variables in the effective namespace's variable table. + */ + + if (simplePattern && TclMatchIsTrivial(simplePattern)) { + /* + * If we can just do hash lookups, that simplifies things a lot. + */ + + varPtr = VarHashFindVar(&nsPtr->varTable, simplePatternPtr); + if (varPtr && TclIsVarConstant(varPtr)) { + if (!TclIsVarUndefined(varPtr) + || TclIsVarNamespaceVar(varPtr)) { + if (specificNsInPattern) { + TclNewObj(elemObjPtr); + Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, + elemObjPtr); + } else { + elemObjPtr = VarHashGetKey(varPtr); + } + Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); + } + } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) { + varPtr = VarHashFindVar(&globalNsPtr->varTable, + simplePatternPtr); + if (varPtr && TclIsVarConstant(varPtr)) { + if (!TclIsVarUndefined(varPtr) + || TclIsVarNamespaceVar(varPtr)) { + Tcl_ListObjAppendElement(interp, listPtr, + VarHashGetKey(varPtr)); + } + } + } + } else { + /* + * Have to scan the tables of variables. + */ + + varPtr = VarHashFirstVar(&nsPtr->varTable, &search); + while (varPtr) { + if (TclIsVarConstant(varPtr) && (!TclIsVarUndefined(varPtr) + || TclIsVarNamespaceVar(varPtr))) { + varNamePtr = VarHashGetKey(varPtr); + varName = TclGetString(varNamePtr); + if ((simplePattern == NULL) + || Tcl_StringMatch(varName, simplePattern)) { + if (specificNsInPattern) { + TclNewObj(elemObjPtr); + Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, + elemObjPtr); + } else { + elemObjPtr = varNamePtr; + } + Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); + } + } + varPtr = VarHashNextVar(&search); + } + + /* + * If the effective namespace isn't the global :: namespace, and a + * specific namespace wasn't requested in the pattern (i.e., the + * pattern only specifies variable names), then add in all global + * :: variables that match the simple pattern. Of course, add in + * only those variables that aren't hidden by a variable in the + * effective namespace. + */ + + if ((nsPtr != globalNsPtr) && !specificNsInPattern) { + varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search); + while (varPtr) { + if (TclIsVarConstant(varPtr) && (!TclIsVarUndefined(varPtr) + || TclIsVarNamespaceVar(varPtr))) { + varNamePtr = VarHashGetKey(varPtr); + varName = TclGetString(varNamePtr); + if ((simplePattern == NULL) + || Tcl_StringMatch(varName, simplePattern)) { + if (VarHashFindVar(&nsPtr->varTable, + varNamePtr) == NULL) { + Tcl_ListObjAppendElement(interp, listPtr, + varNamePtr); + } + } + } + varPtr = VarHashNextVar(&search); + } + } + } + } else if (iPtr->varFramePtr->procPtr != NULL) { + AppendLocals(interp, listPtr, simplePatternPtr, 1, 1); + } + + if (simplePatternPtr) { + Tcl_DecrRefCount(simplePatternPtr); + } Tcl_SetObjResult(interp, listPtr); return TCL_OK; } @@ -6326,7 +6521,8 @@ AppendLocals( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Obj *listPtr, /* List object to append names to. */ Tcl_Obj *patternPtr, /* Pattern to match against. */ - int includeLinks) /* 1 if upvars should be included, else 0. */ + int includeLinks, /* 1 if upvars should be included, else 0. */ + int justConstants) /* 1 if just constants should be included. */ { Interp *iPtr = (Interp *) interp; Var *varPtr; @@ -6355,7 +6551,8 @@ AppendLocals( */ if (*varNamePtr && !TclIsVarUndefined(varPtr) - && (includeLinks || !TclIsVarLink(varPtr))) { + && (!justConstants || TclIsVarConstant(varPtr)) + && (includeLinks || !TclIsVarLink(varPtr))) { varName = TclGetString(*varNamePtr); if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) { Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr); @@ -6384,6 +6581,7 @@ AppendLocals( varPtr = VarHashFindVar(localVarTablePtr, patternPtr); if (varPtr != NULL) { if (!TclIsVarUndefined(varPtr) + && (!justConstants || TclIsVarConstant(varPtr)) && (includeLinks || !TclIsVarLink(varPtr))) { Tcl_ListObjAppendElement(interp, listPtr, VarHashGetKey(varPtr)); @@ -6404,6 +6602,7 @@ AppendLocals( varPtr != NULL; varPtr = VarHashNextVar(&search)) { if (!TclIsVarUndefined(varPtr) + && (!justConstants || TclIsVarConstant(varPtr)) && (includeLinks || !TclIsVarLink(varPtr))) { objNamePtr = VarHashGetKey(varPtr); varName = TclGetString(objNamePtr); @@ -6421,6 +6620,7 @@ AppendLocals( return; } + /* TODO: Handle how constants interact with objects. */ if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD) { Method *mPtr = (Method *) Tcl_ObjectContextMethod((Tcl_ObjectContext)iPtr->varFramePtr->clientData); @@ -6472,6 +6672,47 @@ AppendLocals( } /* + *---------------------------------------------------------------------- + * + * TclInfoConstantCmd -- + * + * Called to implement the "info constant" command that wests whether a + * specific variable is a constant. Handles the following syntax: + * + * info constant varName + * + * Results: + * Returns TCL_OK if successful and TCL_ERROR if there is an error. + * + * Side effects: + * Returns a result in the interpreter's result object. If there is an + * error, the result is an error message. + * + *---------------------------------------------------------------------- + */ + +int +TclInfoConstantCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Var *varPtr, *arrayPtr; + int result; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "varName"); + return TCL_ERROR; + } + varPtr = TclObjLookupVar(interp, objv[1], NULL, 0, "lookup", 0, 0, + &arrayPtr); + result = (varPtr && TclIsVarConstant(varPtr)); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); + return TCL_OK; +} + +/* * Hash table implementation - first, just copy and adapt the obj key stuff */ diff --git a/tests/var.test b/tests/var.test index 26a2e11..0aca974 100644 --- a/tests/var.test +++ b/tests/var.test @@ -1767,6 +1767,72 @@ test var-28.1 {const: globally} -setup { } -cleanup { interp delete $int } -result gorp + +test var-29.1 {info constant and info consts} { + apply {{} { + lappend consts [lsort [info consts]] [info constant X] + const X 1 + lappend consts [lsort [info consts]] [info constant X] + const Y 2 + lappend consts [lsort [info consts]] + const X 3 + lappend consts [lsort [info consts]] + }} +} {{} 0 X 1 {X Y} {X Y}} +test var-29.2 {const and info consts} { + apply {{} { + lappend consts [lsort [info consts X]] + const X 1 + lappend consts [lsort [info consts X]] + const Y 2 + lappend consts [lsort [info consts X]] + const X 3 + lappend consts [lsort [info consts X]] + }} +} {{} X X X} +test var-29.3 {const and info consts} { + apply {{} { + lappend consts [lsort [info consts ?]] + const X 1 + lappend consts [lsort [info consts ?]] + const Y 2 + lappend consts [lsort [info consts ?]] + const XX 3 + lappend consts [lsort [info consts ?]] + }} +} {{} X {X Y} {X Y}} +test var-29.4 {const and info consts} { + apply {{} { + lappend consts [lsort [info consts X]] + set X 1 + lappend consts [lsort [info consts X]] + set Y 2 + lappend consts [lsort [info consts X]] + set X 3 + lappend consts [lsort [info consts X]] + }} +} {{} {} {} {}} +test var-29.5 {const: in a namespace} -setup { + namespace eval var29 {} +} -body { + namespace eval var29 { + const X gorp + info consts + } +} -cleanup { + namespace delete var29 +} -result X +test var-29.6 {const: in a namespace} -setup { + namespace eval var29 {} +} -body { + namespace eval var29 { + const X gorp + variable Y foo + } + info consts var29::* +} -cleanup { + namespace delete var29 +} -result ::var29::X catch {namespace delete ns} catch {unset arr} -- cgit v0.12 From f306b32b6c6df6ac6b9ba0853e3aa130e61c70d0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 5 Dec 2023 10:41:22 +0000 Subject: Add (back) testcases for the compabitiliby macro's (which need TCL_8_API now) --- generic/tclTest.c | 19 ++++++++++++++++--- tests/binary.test | 3 +++ 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 968556b..6db99c9 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -15,6 +15,7 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#define TCL_8_API #undef BUILD_tcl #undef STATIC_BUILD #ifndef USE_TCL_STUBS @@ -5762,7 +5763,14 @@ TestbytestringObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - Tcl_Size n; + struct { +#if !defined(TCL_NO_DEPRECATED) + int n; /* On purpose, not Tcl_Size, in order to demonstrate what happens */ +#else + Tcl_Size n; +#endif + int m; /* This variable should not be overwritten */ + } x = {0, 1}; const char *p; if (objc != 2) { @@ -5770,11 +5778,16 @@ TestbytestringObjCmd( return TCL_ERROR; } - p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &n); + p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &x.n); if (p == NULL) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n)); + + if (x.m != 1) { + Tcl_AppendResult(interp, "Tcl_GetBytesFromObj() overwrites variable", (void *)NULL); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewStringObj(p, x.n)); return TCL_OK; } diff --git a/tests/binary.test b/tests/binary.test index d6a8195..299e1e0 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -3048,6 +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 { + testbytestring [string repeat A [expr 2**31]] +} -returnCodes 1 -result "byte sequence length exceeds INT_MAX" # ---------------------------------------------------------------------- # cleanup -- cgit v0.12 From bf24bac3c948a0bf1435cd57fcb68e14bdc63256 Mon Sep 17 00:00:00 2001 From: kjnash Date: Tue, 5 Dec 2023 11:55:14 +0000 Subject: Define http(usingThread) more precisely --- library/http/http.tcl | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index 6c3c068..da345e3 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -5293,13 +5293,17 @@ proc http::socket {args} { # value 1 => operate as if -threadlevel 0 # value 2 => error return # +# The command assigns a value to http(usingThread), which records whether +# command http::socket can use a separate thread. +# # Arguments: none # Return Value: none # ------------------------------------------------------------------------------ proc http::LoadThreadIfNeeded {} { variable http - if {$http(usingThread) || ($http(-threadlevel) == 0)} { + if {$http(-threadlevel) == 0} { + set http(usingThread) 0 return } if {[catch {package require Thread}]} { @@ -5308,6 +5312,7 @@ proc http::LoadThreadIfNeeded {} { but the Thread package is not available} return -code error $msg } + set http(usingThread) 0 return } set http(usingThread) 1 -- cgit v0.12 From f4ef2c9d913205c71c019269db52fea0c49804db Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 5 Dec 2023 12:38:35 +0000 Subject: Prepping to work on compilation --- tests/var.test | 301 +++++++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 260 insertions(+), 41 deletions(-) diff --git a/tests/var.test b/tests/var.test index 0aca974..3eae527 100644 --- a/tests/var.test +++ b/tests/var.test @@ -1681,80 +1681,249 @@ test var-26.17 {const and traces: unset traces} -setup { unset -nocomplain traces } -test var-27.1 {const: in a namespace} -setup { - namespace eval var27 {} +# Same [const], but definitely not compiled +test var-27.1 {const: unmodifiable by set} -body { + apply {const { + $const X 123 + set X gorp + }} const +} -returnCodes error -result {can't set "X": variable is a constant} +test var-27.2 {const: unmodifiable by append} -body { + apply {const { + $const X 123 + append X gorp + }} const +} -returnCodes error -result {can't set "X": variable is a constant} +test var-27.3 {const: unmodifiable by lappend} -body { + apply {const { + $const X 123 + lappend X gorp + }} const +} -returnCodes error -result {can't set "X": variable is a constant} +test var-27.4 {const: unmodifiable by incr} -body { + apply {const { + $const X 123 + incr X + }} const +} -returnCodes error -result {can't incr "X": variable is a constant} +test var-27.5 {const: unmodifiable by dict set} -body { + apply {const { + $const X {a 123} + dict set X a gorp + }} const +} -returnCodes error -result {can't set "X": variable is a constant} +test var-27.6 {const: unmodifiable by regsub} -body { + apply {const { + $const X abcabc + regsub -all {a(.)} $X {\1\1} X + }} const +} -returnCodes error -result {can't set "X": variable is a constant} +test var-27.7 {const: unmodifiable by gets} -setup { + set file [makeFile foo var27.7.txt] + set f [open $file] +} -body { + apply {{const f} { + $const X abcabc + gets $f X + }} const $f +} -returnCodes error -cleanup { + close $f + removeFile $file +} -result {can't set "X": variable is a constant} +test var-27.8 {const: may not be array} -body { + apply {const { + array set X {a b} + $const X 1 + return $X + }} const +} -returnCodes error -result {can't make constant "X": variable is array} +test var-27.9.1 {const: may not be array element} -body { + apply {const { + array set X {a b} + $const X(a) 1 + return $X(a) + }} const +} -returnCodes error -result {can't make constant "X(a)": name refers to an element in an array} +test var-27.9.2 {const: may not be array element} -body { + apply {const { + array set X {a b} + $const X(b) 1 + return $X(b) + }} const +} -returnCodes error -result {can't make constant "X(b)": name refers to an element in an array} +test var-27.10.1 {const: unmodifiable by const but not an error} { + apply {const { + $const X 1 + $const X 2 + return $X + }} const +} 1 +test var-27.10.2 {const: unmodifiable by const but not an error} { + apply {const { + lmap x {1 2 3} { + $const A 2 + $const B 3 + $const C 5 + expr {$A * $x**2 + $B * $x + $C} + } + }} const +} {10 19 32} +test var-27.11 {const: may not be unset} -body { + apply {const { + $const X 1 + unset X + }} const +} -returnCodes error -result {can't unset "X": variable is a constant} +test var-27.12 {const: may not be unset, but -nocomplain doesn't complain} { + apply {const { + $const X 1 + unset -nocomplain X + return $X + }} const +} 1 +test var-27.13 {const and traces: write trace causes fail} -body { + apply {const { + trace add variable X write {apply {args { + error "ERR: $args" + }}} + $const X gorp + return $X + }} const +} -returnCodes error -result {can't set "X": ERR: X {} write} +test var-27.14 {const and traces: write trace err causes no const} -body { + apply {const { + set trace {apply {args { + error "ERR: $args" + }}} + trace add variable X write $trace + catch { + $const X gorp + } + trace remove variable X write $trace + set X 123 + return $X + }} const +} -result 123 +test var-27.15 {const and traces: read traces} -setup { + unset -nocomplain traces + set traces {} +} -body { + apply {const { + trace add variable X read {apply {args { + lappend ::traces $args + }}} + $const X gorp + list $X $X $::traces + }} const +} -result {gorp gorp {{X {} read} {X {} read}}} -cleanup { + unset -nocomplain traces +} +test var-27.16 {const and traces: write traces} -setup { + unset -nocomplain traces + set traces {} +} -body { + apply {const { + trace add variable X write {apply {args { + lappend ::traces $args + }}} + $const X gorp + $const X foo + catch {set X bar} + list $X $::traces + }} const +} -result {gorp {{X {} write}}} -cleanup { + unset -nocomplain traces +} +test var-27.17 {const and traces: unset traces} -setup { + unset -nocomplain traces + set traces {} } -body { - namespace eval var27 { + list {*}[apply {const { + trace add variable X unset {apply {args { + lappend ::traces $args + }}} + $const X gorp + unset -nocomplain X + list $X $::traces + }} const] $traces +} -result {gorp {} {{X {} unset}}} -cleanup { + unset -nocomplain traces +} + +test var-28.1 {const: in a namespace} -setup { + namespace eval var28 {} +} -body { + namespace eval var28 { variable X const X gorp return $X } } -cleanup { - namespace delete var27 + namespace delete var28 } -result gorp -test var-27.2 {const: in a namespace} -setup { - namespace eval var27 {} +test var-28.2 {const: in a namespace} -setup { + namespace eval var28 {} } -body { - namespace eval var27 { + namespace eval var28 { variable X const X gorp } apply {{} { variable X set X 123 - } var27} + } var28} } -cleanup { - namespace delete var27 + namespace delete var28 } -returnCodes error -result {can't set "X": variable is a constant} -test var-27.3 {const: in a namespace} -setup { - namespace eval var27 {} +test var-28.3 {const: in a namespace} -setup { + namespace eval var28 {} } -body { - namespace eval var27 { + namespace eval var28 { variable X const X gorp } apply {{} { variable X unset X - } var27} + } var28} } -cleanup { - namespace delete var27 + namespace delete var28 } -returnCodes error -result {can't unset "X": variable is a constant} -test var-27.4 {const: in a namespace} -setup { - namespace eval var27 {} +test var-28.4 {const: in a namespace} -setup { + namespace eval var28 {} } -body { - namespace eval var27 { + namespace eval var28 { variable X const X gorp } - namespace delete var27 - namespace eval var27 { + namespace delete var28 + namespace eval var28 { variable X abc } apply {{} { variable X return $X - } var27} + } var28} } -cleanup { - namespace delete var27 + namespace delete var28 } -result abc -test var-27.5 {const: in a namespace, direct access from proc} -setup { - namespace eval var27 {} +test var-28.5 {const: in a namespace, direct access from proc} -setup { + namespace eval var28 {} } -body { set result [apply {{} { - const ::var27::X abc + const ::var28::X abc # Constant in namespace, NOT locally! info exists X }}] apply {res { variable X list $res [catch {unset X} msg] $msg $X - } var27} $result + } var28} $result } -cleanup { - namespace delete var27 + namespace delete var28 } -result {0 1 {can't unset "X": variable is a constant} abc} -test var-28.1 {const: globally} -setup { +test var-29.1 {const: globally} -setup { set int [interp create] } -body { $int eval { @@ -1768,7 +1937,8 @@ test var-28.1 {const: globally} -setup { interp delete $int } -result gorp -test var-29.1 {info constant and info consts} { +# The info constant and info consts commands +test var-30.1 {info constant and info consts} { apply {{} { lappend consts [lsort [info consts]] [info constant X] const X 1 @@ -1779,7 +1949,7 @@ test var-29.1 {info constant and info consts} { lappend consts [lsort [info consts]] }} } {{} 0 X 1 {X Y} {X Y}} -test var-29.2 {const and info consts} { +test var-30.2 {info constant and info consts} { apply {{} { lappend consts [lsort [info consts X]] const X 1 @@ -1790,7 +1960,7 @@ test var-29.2 {const and info consts} { lappend consts [lsort [info consts X]] }} } {{} X X X} -test var-29.3 {const and info consts} { +test var-30.3 {info constant and info consts} { apply {{} { lappend consts [lsort [info consts ?]] const X 1 @@ -1801,7 +1971,7 @@ test var-29.3 {const and info consts} { lappend consts [lsort [info consts ?]] }} } {{} X {X Y} {X Y}} -test var-29.4 {const and info consts} { +test var-30.4 {info constant and info consts} { apply {{} { lappend consts [lsort [info consts X]] set X 1 @@ -1812,27 +1982,76 @@ test var-29.4 {const and info consts} { lappend consts [lsort [info consts X]] }} } {{} {} {} {}} -test var-29.5 {const: in a namespace} -setup { - namespace eval var29 {} +test var-30.5 {info consts: in a namespace} -setup { + namespace eval var30 {} } -body { - namespace eval var29 { + namespace eval var30 { const X gorp info consts } } -cleanup { - namespace delete var29 + namespace delete var30 } -result X -test var-29.6 {const: in a namespace} -setup { - namespace eval var29 {} +test var-30.6 {info consts: in a namespace} -setup { + namespace eval var30 {} } -body { - namespace eval var29 { + namespace eval var30 { const X gorp variable Y foo } - info consts var29::* + info consts var30::* } -cleanup { - namespace delete var29 -} -result ::var29::X + namespace delete var30 +} -result ::var30::X +test var-30.7 {info constant: bad constant names: array element} { + apply {{} { + info constant a(b) + }} +} 0 +test var-30.8 {info constant: bad constant names: array} { + apply {{} { + array set a {} + info constant a + }} +} 0 +test var-30.9 {info constant: bad constant names: no var} { + apply {{} { + info constant a + }} +} 0 +test var-30.10 {info constant: bad constant names: no namespace} { + apply {{} { + info constant ::var29::no::such::ns::a + }} +} 0 +test var-30.11 {info constant: bad constant names: dangling upvar} { + apply {{} { + upvar 0 no_var a + info constant a + }} +} 0 +test var-30.12 {info constant: bad constant names: bad name} { + apply {{} { + info constant a(b + }} +} 0 +test var-30.13 {info constant: bad constant names: nesting} { + apply {{} { + array set b {c d} + upvar 0 b(c) a + info constant a(d) + }} +} 0 + +test var-31.1 {info constant: syntax} -returnCodes error -body { + info constant +} -result {wrong # args: should be "info constant varName"} +test var-31.2 {info constant: syntax} -returnCodes error -body { + info constant foo bar +} -result {wrong # args: should be "info constant varName"} +test var-31.3 {info consts: syntax} -returnCodes error -body { + info consts foo bar +} -result {wrong # args: should be "info consts ?pattern?"} catch {namespace delete ns} catch {unset arr} -- cgit v0.12 From c309515849734e2bc355fd285f71382b4bb33a9b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 5 Dec 2023 12:55:48 +0000 Subject: Documentation update --- doc/ByteArrObj.3 | 2 +- doc/DictObj.3 | 2 +- doc/FileSystem.3 | 2 +- doc/ListObj.3 | 7 ++----- doc/ParseArgs.3 | 2 +- doc/SplitList.3 | 2 +- doc/SplitPath.3 | 4 ++-- doc/StringObj.3 | 10 +++------- 8 files changed, 12 insertions(+), 19 deletions(-) diff --git a/doc/ByteArrObj.3 b/doc/ByteArrObj.3 index 5aa541b..3dd626a 100644 --- a/doc/ByteArrObj.3 +++ b/doc/ByteArrObj.3 @@ -48,7 +48,7 @@ Points to space where the number of bytes in the array may be written. May be (Tcl_Size *)NULL when not used. If it points to a variable which type is not \fBTcl_Size\fR, a compiler warning will be generated. If your extensions is compiled with -DTCL_8_API, this function will return -NULL if the size of the byte array is larger than INT_MAX (which should +NULL for byte arrays larger than INT_MAX (which should trigger proper error-handling), otherwise expect it to crash. .BE .SH DESCRIPTION diff --git a/doc/DictObj.3 b/doc/DictObj.3 index 7469a78..4a25d84 100644 --- a/doc/DictObj.3 +++ b/doc/DictObj.3 @@ -76,7 +76,7 @@ contained within the dictionary placed within it. May be (Tcl_Size *)NULL when not used. If it points to a variable which type is not \fBTcl_Size\fR, a compiler warning will be generated. If your extensions is compiled with -DTCL_8_API, this function will return -NULL if the size of the dictionary is larger than INT_MAX (which should +NULL for dictionaries larger than INT_MAX (which should trigger proper error-handling), otherwise expect it to crash. .AP Tcl_DictSearch *searchPtr in/out Pointer to record to use to keep track of progress in enumerating all diff --git a/doc/FileSystem.3 b/doc/FileSystem.3 index b8766e7..2076c96 100644 --- a/doc/FileSystem.3 +++ b/doc/FileSystem.3 @@ -274,7 +274,7 @@ Filled with the number of elements in the split path. May be (Tcl_Size *)NULL when not used. If it points to a variable which type is not \fBTcl_Size\fR, a compiler warning will be generated. If your extensions is compiled with -DTCL_8_API, this function will return -NULL if the number of elements is larger than INT_MAX (which should +NULL for paths having more than INT_MAX elements (which should trigger proper error-handling), otherwise expect it to crash. .AP Tcl_Obj *basePtr in The base path on to which to join the given elements. May be NULL. diff --git a/doc/ListObj.3 b/doc/ListObj.3 index 220cd08..74cbe9a 100644 --- a/doc/ListObj.3 +++ b/doc/ListObj.3 @@ -65,7 +65,7 @@ stores the number of element values in \fIlistPtr\fR. May be (Tcl_Size *)NULL when not used. If it points to a variable which type is not \fBTcl_Size\fR, a compiler warning will be generated. If your extensions is compiled with -DTCL_8_API, this function will return -NULL if the list size is larger than INT_MAX (which should +NULL for lists with more than INT_MAX elements (which should trigger proper error-handling), otherwise expect it to crash. .AP Tcl_Obj ***objvPtr out A location where \fBTcl_ListObjGetElements\fR stores a pointer to an array @@ -87,7 +87,7 @@ stores the length of the list. May be (Tcl_Size *)NULL when not used. If it points to a variable which type is not \fBTcl_Size\fR, a compiler warning will be generated. If your extensions is compiled with -DTCL_8_API, this function will return -NULL if the list size is larger than INT_MAX (which should +TCL_ERROR for lists with more than INT_MAX elements (which should trigger proper error-handling), otherwise expect it to crash. .AP Tcl_Size index in Index of the list element that \fBTcl_ListObjIndex\fR @@ -174,9 +174,6 @@ Otherwise it returns \fBTCL_OK\fR after storing the count and array pointer. .PP \fBTcl_ListObjLength\fR returns the number of elements in the list value referenced by \fIlistPtr\fR. -It returns this count by storing a value in the address \fIlengthPtr\fR. -If \fIlengthPtr\fR points to a variable of type \fBint\fR and the list -contains more than 2**31 elements, the function returns \fBTCL_ERROR\fR. If the value is not already a list value, \fBTcl_ListObjLength\fR will attempt to convert it to one; if the conversion fails, it returns \fBTCL_ERROR\fR diff --git a/doc/ParseArgs.3 b/doc/ParseArgs.3 index ca6f52d..4fdf0b0 100644 --- a/doc/ParseArgs.3 +++ b/doc/ParseArgs.3 @@ -28,7 +28,7 @@ stored in \fIremObjv\fR. May be (Tcl_Size *)NULL when not used. If it points to a variable which type is not \fBTcl_Size\fR, a compiler warning will be generated. If your extensions is compiled with -DTCL_8_API, this function will return -NULL if the number of elements is larger than INT_MAX (which should +NULL for argument lists with more than INT_MAX elements (which should trigger proper error-handling), otherwise expect it to crash. .AP "Tcl_Obj *const" *objv in The array of arguments to be parsed. diff --git a/doc/SplitList.3 b/doc/SplitList.3 index 9f43731..0036333 100644 --- a/doc/SplitList.3 +++ b/doc/SplitList.3 @@ -43,7 +43,7 @@ Filled in with number of elements in \fIlist\fR. May be (Tcl_Size *)NULL when not used. If it points to a variable which type is not \fBTcl_Size\fR, a compiler warning will be generated. If your extensions is compiled with -DTCL_8_API, this function will return -NULL if the list size is larger than INT_MAX (which should +TCL_ERROR for lists with more than INT_MAX elements (which should trigger proper error-handling), otherwise expect it to crash. .AP "const char" ***argvPtr out \fI*argvPtr\fR will be filled in with the address of an array of diff --git a/doc/SplitPath.3 b/doc/SplitPath.3 index f55ee3c..663b336 100644 --- a/doc/SplitPath.3 +++ b/doc/SplitPath.3 @@ -29,8 +29,8 @@ File path in a form appropriate for the current platform (see the Filled in with number of path elements in \fIpath\fR. May be (Tcl_Size *)NULL when not used. If it points to a variable which type is not \fBTcl_Size\fR, a compiler warning will be generated. -If your extensions is compiled with -DTCL_8_API, this function will return -NULL if the number of elements is larger than INT_MAX (which should +If your extensions is compiled with -DTCL_8_API, argcPtr will be filled +with -1 for paths with more than INT_MAX elements (which should trigger proper error-handling), otherwise expect it to crash. .AP "const char" ***argvPtr out \fI*argvPtr\fR will be filled in with the address of an array of diff --git a/doc/StringObj.3 b/doc/StringObj.3 index 305af9a..fc5f5d6 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -124,8 +124,7 @@ of a value's string representation. May be (Tcl_Size *)NULL when not used. If it points to a variable which type is not \fBTcl_Size\fR, a compiler warning will be generated. If your extensions is compiled with -DTCL_8_API, this function will -panic if the number of elements is larger than INT_MAX (which should -trigger proper error-handling), otherwise expect it to crash. +panic for strings with more than INT_MAX bytes/characters, otherwise expect it to crash. .AP "const char" *string in Null-terminated string value to append to \fIobjPtr\fR. .AP Tcl_Size limit in @@ -190,9 +189,7 @@ Even in the limited situations where writing to this pointer is acceptable, one should take care to respect the copy-on-write semantics required by \fBTcl_Obj\fR's, with appropriate calls to \fBTcl_IsShared\fR and \fBTcl_DuplicateObj\fR prior to any -in-place modification of the string representation. If \fIlengthPtr\fR -points to an \fBint\fR variable, and the string has more than 2^31 bytes, -a panic will result. +in-place modification of the string representation. The procedure \fBTcl_GetString\fR is used in the common case where the caller does not need the length of the string representation. @@ -204,8 +201,7 @@ value as a Unicode string. This is given by the returned pointer and byte pointer is owned by the value manager and should not be modified by the caller. The procedure \fBTcl_GetUnicode\fR is used in the common case where the caller does not need the length of the unicode string -representation. If \fIlengthPtr\fR points to an \fBint\fR variable, -and the string has more than 2^31 unicode characters, a panic will result. +representation. .PP \fBTcl_GetUniChar\fR returns the \fIindex\fR'th character in the value's Unicode representation. If the index is out of range or -- cgit v0.12 From b844b819dc474968b15fb4c891ded3fd57ea1184 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Tue, 5 Dec 2023 13:09:22 +0000 Subject: Test case for bug --- tests/exec.test | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/tests/exec.test b/tests/exec.test index 5a640b0..7f40a38 100644 --- a/tests/exec.test +++ b/tests/exec.test @@ -712,6 +712,22 @@ test exec-20.1 {exec .CMD file} -constraints {win} -body { exec [makeFile "echo %1> $log" exec201.CMD] "Testing exec-20.1" viewFile $log } -result "\"Testing exec-20.1\"" + +# Test with encoding mismatches (Bug 0f1ddc0df7fb7) +test exec-21.1 {exec encoding mismatch} -setup { + set path(script) [makeFile { + fconfigure stdout -translation binary + puts a\xe9b + } script] + set enc [encoding system] + encoding system utf-8 +} -cleanup { + removeFile $path(script) + encoding system $enc +} -body { + exec [info nameofexecutable] $path(script) +} -result a\uFFFDb + # ---------------------------------------------------------------------- # cleanup -- cgit v0.12 From 85e3751c642a33bb65b2fa23fb103961fa2436c3 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Tue, 5 Dec 2023 13:44:15 +0000 Subject: Proposed fix for [0f1ddc0df7]. --- generic/tclIOCmd.c | 5 +++++ tests/io.test | 33 +++++++++++++++++++++++++++++++++ 2 files changed, 38 insertions(+) diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index b6fd799..40cf074 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -944,6 +944,11 @@ Tcl_ExecObjCmd( return TCL_ERROR; } + /* Bug [0f1ddc0df7] - encoding errors - use replace profile */ + if (Tcl_SetChannelOption(NULL, chan, "-profile", "replace") != TCL_OK) { + return TCL_ERROR; + } + if (background) { /* * Store the list of PIDs from the pipeline in interp's result and diff --git a/tests/io.test b/tests/io.test index 8fb2a99..c11f325 100644 --- a/tests/io.test +++ b/tests/io.test @@ -9824,6 +9824,39 @@ test io-76.10 {channel mode dropping} -setup { } -match glob -result {Tcl_RemoveChannelMode error:\ Bad mode, would make channel inacessible. Channel: "*"} +# Encoding errors on pipeline +# Ensures fix for exec bug [0f1ddc0df7] does not affect open +# It should still fail unless -profile is explicitly set to replace +test io-77.1 {open pipe encoding mismatch} -setup { + set scriptFile [makeFile { + fconfigure stdout -translation binary + puts -nonewline a\xe9b + flush stdout + } script] +} -cleanup { + close $fd + removeFile $scriptFile +} -body { + set fd [open |[list [info nameofexecutable] $scriptFile r+]] + fconfigure $fd -encoding utf-8 + list [catch {read $fd} result opts] [string match {error reading "*": invalid or incomplete multibyte or wide character} $result] [dict get $opts -errorcode] +} -result [list 1 1 {POSIX EILSEQ {invalid or incomplete multibyte or wide character}}] +test io-77.2 {open pipe encoding mismatch - use replace profile} -setup { + set scriptFile [makeFile { + fconfigure stdout -translation binary + puts -nonewline a\xe9b + flush stdout + } script] +} -cleanup { + close $fd + removeFile $scriptFile +} -body { + set fd [open |[list [info nameofexecutable] $scriptFile r+]] + fconfigure $fd -encoding utf-8 -profile replace + read $fd +} -result a\uFFFDb + + # cleanup foreach file [list fooBar longfile script script2 output test1 pipe my_script \ test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { -- cgit v0.12 From 0d5fe7203bfc74417fdbfab19b3df96925d6d2f7 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 5 Dec 2023 15:48:03 +0000 Subject: Bytecode implementation --- generic/tclBasic.c | 2 +- generic/tclCompCmds.c | 78 +++++++++++++++++++++++++++++++++++++++++++++++++++ generic/tclCompile.c | 7 +++++ generic/tclCompile.h | 4 +++ generic/tclExecute.c | 71 ++++++++++++++++++++++++++++++++++++++++++++++ generic/tclInt.h | 1 + generic/tclVar.c | 6 ++-- 7 files changed, 165 insertions(+), 4 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index eab810d..f33469b 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -316,7 +316,7 @@ static const CmdInfo builtInCmds[] = { {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE}, - {"const", Tcl_ConstObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"const", Tcl_ConstObjCmd, TclCompileConstCmd, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, {"coroinject", NULL, NULL, TclNRCoroInjectObjCmd, CMD_IS_SAFE}, {"coroprobe", NULL, NULL, TclNRCoroProbeObjCmd, CMD_IS_SAFE}, diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index f86de84..2536ba7 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -919,6 +919,84 @@ TclCompileConcatCmd( /* *---------------------------------------------------------------------- * + * TclCompileConstCmd -- + * + * Procedure called to compile the "const" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "const" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileConstCmd( + Tcl_Interp *interp, /* The interpreter. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + TCL_UNUSED(Command *), + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *varTokenPtr, *valueTokenPtr; + int isScalar, localIndex; + + /* + * Need exactly two arguments. + */ + if (parsePtr->numWords != 3) { + return TCL_ERROR; + } + + /* + * Decide if we can use a frame slot for the var/array name or if we need + * to emit code to compute and push the name at runtime. We use a frame + * slot (entry in the array of local vars) if we are compiling a procedure + * body and if the name is simple text that does not include namespace + * qualifiers. + */ + + varTokenPtr = TokenAfter(parsePtr->tokenPtr); + PushVarNameWord(interp, varTokenPtr, envPtr, 0, + &localIndex, &isScalar, 1); + + /* + * If the user specified an array element, we don't bother handling + * that. + */ + if (!isScalar) { + return TCL_ERROR; + } + + /* + * We are doing an assignment to set the value of the constant. This will + * need to be extended to push a value for each argument. + */ + + valueTokenPtr = TokenAfter(varTokenPtr); + CompileWord(envPtr, valueTokenPtr, interp, 2); + + if (localIndex < 0) { + TclEmitOpcode(INST_CONST_STK, envPtr); + } else { + TclEmitInstInt4(INST_CONST_IMM, localIndex, envPtr); + } + + /* + * The const command's result is an empty string. + */ + PushStringLiteral(envPtr, ""); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TclCompileContinueCmd -- * * Procedure called to compile the "continue" command. diff --git a/generic/tclCompile.c b/generic/tclCompile.c index e93fd4a..e321fc7 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -665,6 +665,13 @@ InstructionDesc const tclInstructionTable[] = { * set in flags. */ + {"constImm", 5, -1, 1, {OPERAND_LVT4}}, + /* Create constant. Index into LVT is immediate, value is on stack. + * Stack: ... value => ... */ + {"constStk", 1, -2, 0, {OPERAND_NONE}}, + /* Create constant. Variable name and value on stack. + * Stack: ... varName value => ... */ + {NULL, 0, 0, 0, {OPERAND_NONE}} }; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 161ea62..560d144 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -837,6 +837,10 @@ enum TclInstruction { INST_LREPLACE4, + /* TIP 667: const */ + INST_CONST_IMM, + INST_CONST_STK, + /* The last opcode */ LAST_INST_OPCODE }; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 8149532..8cce3ba 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -3926,6 +3926,77 @@ TEBCresume( /* * End of INST_UNSET instructions. * ----------------------------------------------------------------- + * Start of INST_CONST instructions. + */ + { + const char *msgPart; + + case INST_CONST_IMM: + opnd = TclGetUInt4AtPtr(pc+1); + pcAdjustment = 5; + cleanup = 1; + part1Ptr = NULL; + objPtr = OBJ_AT_TOS; + TRACE(("%u "\"%.30s\" => \n", opnd, O2S(objPtr))); + varPtr = LOCAL(opnd); + arrayPtr = NULL; + while (TclIsVarLink(varPtr)) { + varPtr = varPtr->value.linkPtr; + } + goto doConst; + case INST_CONST_STK: + opnd = -1; + pcAdjustment = 1; + cleanup = 2; + part1Ptr = OBJ_UNDER_TOS; + objPtr = OBJ_AT_TOS; + TRACE(("\"%.30s\" \"%.30s\" => ", O2S(part1Ptr), O2S(objPtr))); + varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, 0, NULL, + /*createPart1*/1, /*createPart2*/0, &arrayPtr); + doConst: + if (TclIsVarConstant(varPtr)) { + TRACE_APPEND(("\n")); + NEXT_INST_V(pcAdjustment, cleanup, 0); + } + if (TclIsVarArray(varPtr)) { + msgPart = "variable is array"; + goto constError; + } else if (TclIsVarArrayElement(varPtr)) { + msgPart = "name refers to an element in an array"; + goto constError; + } else if (!TclIsVarUndefined(varPtr)) { + msgPart = "variable already exists"; + goto constError; + } + if (TclIsVarDirectModifyable(varPtr)) { + varPtr->value.objPtr = objPtr; + Tcl_IncrRefCount(objPtr); + } else { + Tcl_Obj *resPtr; + + DECACHE_STACK_INFO(); + resPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, NULL, + objPtr, TCL_LEAVE_ERR_MSG, opnd); + CACHE_STACK_INFO(); + if (resPtr == NULL) { + TRACE_ERROR(interp); + goto gotError; + } + } + TclSetVarConstant(varPtr); + TRACE_APPEND(("\n")); + NEXT_INST_V(pcAdjustment, cleanup, 0); + + constError: + TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", msgPart, opnd); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONST", (void *)NULL); + TRACE_ERROR(interp); + goto gotError; + } + + /* + * End of INST_CONST instructions. + * ----------------------------------------------------------------- * Start of INST_ARRAY instructions. */ diff --git a/generic/tclInt.h b/generic/tclInt.h index e9d3006..a9dcb01 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3774,6 +3774,7 @@ MODULE_SCOPE CompileProc TclCompileCatchCmd; MODULE_SCOPE CompileProc TclCompileClockClicksCmd; MODULE_SCOPE CompileProc TclCompileClockReadingCmd; MODULE_SCOPE CompileProc TclCompileConcatCmd; +MODULE_SCOPE CompileProc TclCompileConstCmd; MODULE_SCOPE CompileProc TclCompileContinueCmd; MODULE_SCOPE CompileProc TclCompileDictAppendCmd; MODULE_SCOPE CompileProc TclCompileDictCreateCmd; diff --git a/generic/tclVar.c b/generic/tclVar.c index de7e374..d0523c4 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -4878,7 +4878,7 @@ Tcl_ConstObjCmd( "const", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (TclIsVarArray(varPtr)) { TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", ISARRAY, -1); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VAR", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONST", (void *)NULL); return TCL_ERROR; } if (TclIsVarArrayElement(varPtr)) { @@ -4886,7 +4886,7 @@ Tcl_ConstObjCmd( CleanupVar(varPtr, arrayPtr); } TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", ISARRAYELEMENT, -1); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONST", (void *)NULL); return TCL_ERROR; } @@ -4898,7 +4898,7 @@ Tcl_ConstObjCmd( return TCL_OK; } TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", EXISTS, -1); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VAR", (void *)NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONST", (void *)NULL); return TCL_ERROR; } -- cgit v0.12 From 4f1e1c42b0e26190057bb915acf701907f82ff63 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Tue, 5 Dec 2023 16:57:32 +0000 Subject: Also ensure no encoding exceptions raised when reading pipe stderr --- tests/exec.test | 15 ++++++++++++++- unix/tclUnixPipe.c | 2 ++ win/tclWinPipe.c | 4 +++- 3 files changed, 19 insertions(+), 2 deletions(-) diff --git a/tests/exec.test b/tests/exec.test index 7f40a38..4f7a1a8 100644 --- a/tests/exec.test +++ b/tests/exec.test @@ -714,7 +714,7 @@ test exec-20.1 {exec .CMD file} -constraints {win} -body { } -result "\"Testing exec-20.1\"" # Test with encoding mismatches (Bug 0f1ddc0df7fb7) -test exec-21.1 {exec encoding mismatch} -setup { +test exec-21.1 {exec encoding mismatch on stdout} -setup { set path(script) [makeFile { fconfigure stdout -translation binary puts a\xe9b @@ -727,6 +727,19 @@ test exec-21.1 {exec encoding mismatch} -setup { } -body { exec [info nameofexecutable] $path(script) } -result a\uFFFDb +test exec-21.2 {exec encoding mismatch on stderr} -setup { + set path(script) [makeFile { + fconfigure stderr -translation binary + puts stderr a\xe9b + } script] + set enc [encoding system] + encoding system utf-8 +} -cleanup { + removeFile $path(script) + encoding system $enc +} -body { + list [catch {exec [info nameofexecutable] $path(script)} r] $r +} -result [list 1 a\uFFFDb] # ---------------------------------------------------------------------- diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index a889f1d..f1e3fb8 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -1102,6 +1102,8 @@ PipeClose2Proc( errChan = Tcl_MakeFileChannel( INT2PTR(GetFd(pipePtr->errorFile)), TCL_READABLE); + /* Error channels should raise encoding errors */ + Tcl_SetChannelOption(NULL, errChan, "-profile", "replace"); } else { errChan = NULL; } diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 600c146..5a18ee3 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -2123,7 +2123,9 @@ PipeClose2Proc( errChan = Tcl_MakeFileChannel((void *) filePtr->handle, TCL_READABLE); Tcl_Free(filePtr); - } else { + Tcl_SetChannelOption(NULL, errChan, "-profile", "replace"); + } + else { errChan = NULL; } -- cgit v0.12 From 0c49de41ba7190b215cf6a58ce24be67af70d57e Mon Sep 17 00:00:00 2001 From: oehhar Date: Tue, 5 Dec 2023 17:29:53 +0000 Subject: Comment correction: Error channels should *not* raise encoding errors --- unix/tclUnixPipe.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index f1e3fb8..64dd8baf 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -1102,7 +1102,7 @@ PipeClose2Proc( errChan = Tcl_MakeFileChannel( INT2PTR(GetFd(pipePtr->errorFile)), TCL_READABLE); - /* Error channels should raise encoding errors */ + /* Error channels should not raise encoding errors */ Tcl_SetChannelOption(NULL, errChan, "-profile", "replace"); } else { errChan = NULL; -- cgit v0.12 From 4d875416454b0f5f02a034920cf98e0cd733fe3c Mon Sep 17 00:00:00 2001 From: kjnash Date: Tue, 5 Dec 2023 17:32:45 +0000 Subject: Generalise http::register etc and revise recent changes that were tls-only. --- doc/http.n | 48 +++++++++++++++++++++++------ library/http/http.tcl | 84 ++++++++++++++++++++++++++++++++++++++++----------- tests/http.test | 1 + tests/http11.test | 1 + tests/httpProxy.test | 3 +- 5 files changed, 109 insertions(+), 28 deletions(-) diff --git a/doc/http.n b/doc/http.n index ff2307e..9231945 100644 --- a/doc/http.n +++ b/doc/http.n @@ -58,9 +58,9 @@ http \- Client-side implementation of the HTTP/1.1 protocol .sp \fB::http::responseBody\fR \fItoken\fR .sp -\fB::http::register \fIproto port command\fR +\fB::http::register \fIproto port command\fR ?\fIsocketCmdVarName\fR? ?\fIuseSockThread\fR? ?\fIendToEndProxy\fR? .sp -\fB::http::registerError \fIport\fR ?\fImessage\fR? +\fB::http::registerError \fIsock\fR ?\fImessage\fR? .sp \fB::http::unregister \fIproto\fR .sp @@ -789,24 +789,53 @@ Other terms for "message body after decoding", "content(s)", and "file". .RE .TP -\fB::http::register\fR \fIproto port command\fR +\fB::http::register\fR \fIproto port command\fR ?\fIsocketCmdVarName\fR? ?\fIuseSockThread\fR? ?\fIendToEndProxy\fR? . This procedure allows one to provide custom HTTP transport types such as HTTPS, by registering a prefix, the default port, and the -command to execute to create the Tcl \fBchannel\fR. E.g.: +command to execute to create the Tcl \fBchannel\fR. The optional +arguments configure how \fBhttp\fR uses the custom transport, and have +default values that are compatible with older versions of \fBhttp\fR +in which \fB::http::register\fR has no optional arguments. +.RS +.PP +Argument \fIsocketCmdVarName\fR is the name of a variable provided by +the transport, whose value is the command used by the transport to open +a socket. Its default value is set by the transport and is "::socket", +but if the name of the variable is supplied to \fB::http::register\fR, +then \fBhttp\fR will set a new value in order to make optional +facilities available. These facilities are enabled by the optional +arguments \fIuseSockThread\fR, \fIendToEndProxy\fR, which take boolean +values with default value \fIfalse\fR. +.PP +Iff argument \fIuseSockThread\fR is supplied and is boolean \fItrue\fR, +then iff permitted by the value [\fBhttp::config\fR \fI-threadlevel\fR] +and by the availability of package \fBThread\fR, sockets created for +the transport will be opened in a different thread so that a slow DNS +lookup will not cause the script to block. +.PP +Iff argument \fIendToEndProxy\fR is supplied and is boolean \fItrue\fR, +then when \fBhttp::geturl\fR accesses a server via a proxy, it will +open a channel by sending a CONNECT request to the proxy, and it will +then make its request over this channel. This allows end-to-end +encryption for HTTPS requests made through a proxy. +.PP +For example, .RS .PP .CS package require http + package require tls -::http::register https 443 ::tls::socket +::http::register https 443 ::tls::socket ::tls::socketCmd 1 1 set token [::http::geturl https://my.secure.site/] .CE .RE +.RE .TP -\fB::http::registerError\fR \fIport\fR ?\fImessage\fR? +\fB::http::registerError\fR \fIsock\fR ?\fImessage\fR? . This procedure allows a registered protocol handler to deliver an error message for use by \fBhttp\fR. Calling this command does not raise an @@ -820,10 +849,9 @@ string if no such call has been made. \fB::http::unregister\fR \fIproto\fR . This procedure unregisters a protocol handler that was previously -registered via \fB::http::register\fR, returning a two-item list of -the default port and handler command that was previously installed -(via \fB::http::register\fR) if there was such a handler, and an error if -there was no such handler. +registered via \fB::http::register\fR, returning a six-item list of +the values that were previously supplied to \fB::http::register\fR +if there was such a handler, and an error if there was no such handler. .TP \fB::http::code\fR \fItoken\fR . diff --git a/library/http/http.tcl b/library/http/http.tcl index da345e3..d45f16f 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -119,7 +119,7 @@ namespace eval http { variable urlTypes if {![info exists urlTypes]} { - set urlTypes(http) [list 80 ::http::socket] + set urlTypes(http) [list 80 ::http::socket {} 1 0] } variable encodings [string tolower [encoding names]] @@ -282,15 +282,34 @@ if {[info command http::Log] eq {}} {proc http::Log {args} {}} # See documentation for details. # # Arguments: -# proto URL protocol prefix, e.g. https -# port Default port for protocol -# command Command to use to create socket +# proto URL protocol prefix, e.g. https +# port Default port for protocol +# command Command to use to create socket +# socketCmdVarName (optional) name of variable provided by the protocol +# handler whose value is the callback used by argument +# "command" to open a socket. The default value "::socket" +# will be overwritten by http. +# useSockThread (optional, boolean) +# endToEndProxy (optional, boolean) # Results: -# list of port and command that was registered. +# list of port, command, variable name, (boolean) threadability, +# and (boolean) endToEndProxy that was registered. -proc http::register {proto port command} { +proc http::register {proto port command {socketCmdVarName {}} {useSockThread 0} {endToEndProxy 0}} { variable urlTypes - set urlTypes([string tolower $proto]) [list $port $command] + set lower [string tolower $proto] + if {[info exists urlTypes($lower)]} { + unregister $lower + } + set urlTypes($lower) [list $port $command $socketCmdVarName $useSockThread $endToEndProxy] + + # If the external handler for protocol $proto has given $socketCmdVarName the expected + # value "::socket", overwrite it with the new value. + if {($socketCmdVarName ne {}) && ([set $socketCmdVarName] eq {::socket})} { + set $socketCmdVarName ::http::socketForTls + } + + return $urlTypes($lower) } # http::unregister -- @@ -300,7 +319,8 @@ proc http::register {proto port command} { # Arguments: # proto URL protocol prefix, e.g. https # Results: -# list of port and command that was unregistered. +# list of port, command, variable name, (boolean) useSockThread, +# and (boolean) endToEndProxy that was unregistered. proc http::unregister {proto} { variable urlTypes @@ -309,6 +329,13 @@ proc http::unregister {proto} { return -code error "unsupported url type \"$proto\"" } set old $urlTypes($lower) + + # Restore the external handler's original value for $socketCmdVarName. + lassign $old defport defcmd socketCmdVarName useSockThread endToEndProxy + if {($socketCmdVarName ne {}) && ([set $socketCmdVarName] eq {::http::socketForTls})} { + set $socketCmdVarName ::socket + } + unset urlTypes($lower) return $old } @@ -941,10 +968,6 @@ proc http::geturl {url args} { # - ::http::socketForTls - as ::http::socket, but can also open a socket # for HTTPS/TLS through a proxy. - if {[info exists ::tls::socketCmd] && ($::tls::socketCmd eq {::socket})} { - set ::tls::socketCmd ::http::socketForTls - } - set token [CreateToken $url {*}$args] variable $token upvar 0 $token state @@ -1067,6 +1090,8 @@ proc http::CreateToken {url args} { requestLine {} transfer {} proxyUsed none + protoSockThread 0 + protoProxyConn 0 } set state(-keepalive) $defaultKeepalive set state(-strict) $strict @@ -1261,8 +1286,16 @@ proc http::CreateToken {url args} { unset $token return -code error "Unsupported URL type \"$proto\"" } - set defport [lindex $urlTypes($lower) 0] - set defcmd [lindex $urlTypes($lower) 1] + lassign $urlTypes($lower) defport defcmd socketCmdVarName useSockThread end2EndProxy + + # If the external handler for protocol $proto has given $socketCmdVarName the expected + # value "::socket", overwrite it with the new value. + if {($socketCmdVarName ne {}) && ([set $socketCmdVarName] eq {::socket})} { + set $socketCmdVarName ::http::socketForTls + } + + set state(protoSockThread) $useSockThread + set state(protoProxyConn) $end2EndProxy if {$port eq ""} { set port $defport @@ -1349,7 +1382,7 @@ proc http::CreateToken {url args} { # including the server name. # The *tls* test below attempts to describe protocols in addition to # "https on port 443" that use HTTP over TLS. - if {($phost ne "") && (![string match -nocase *tls* $defcmd])} { + if {($phost ne "") && (!$end2EndProxy)} { set srvurl $url set targetAddr [list $phost $pport] set state(proxyUsed) HttpProxy @@ -1369,8 +1402,13 @@ proc http::CreateToken {url args} { lappend sockopts -myaddr $state(-myaddr) } + if {$useSockThread} { + set targs [list -type $token] + } else { + set targs {} + } set state(connArgs) [list $proto $phost $srvurl] - set state(openCmd) [list {*}$defcmd {*}$sockopts -type $token {*}$targetAddr] + set state(openCmd) [list {*}$defcmd {*}$sockopts {*}$targs {*}$targetAddr] # See if we are supposed to use a previously opened channel. # - In principle, ANY call to http::geturl could use a previously opened @@ -4969,10 +5007,21 @@ interp alias {} http::ncode {} http::responseCode proc http::socketForTls {args} { variable http + + set targ [lsearch -exact $args -type] + if {$targ != -1} { + set token [lindex $args $targ+1] + upvar 0 ${token} state + set protoProxyConn $state(protoProxyConn) + } else { + set protoProxyConn 0 + } + set host [lindex $args end-1] set port [lindex $args end] if { ($http(-proxyfilter) ne {}) && (![catch {$http(-proxyfilter) $host} proxy]) + && $protoProxyConn } { set phost [lindex $proxy 0] set pport [lindex $proxy 1] @@ -5225,7 +5274,8 @@ proc http::socket {args} { upvar 0 $token state } - if {!$http(usingThread)} { + if {$http(usingThread) && [info exists state] && $state(protoSockThread)} { + } else { # Use plain "::socket". This is the default. return [eval ::socket $args] } diff --git a/tests/http.test b/tests/http.test index 657465f..2240d41 100644 --- a/tests/http.test +++ b/tests/http.test @@ -18,6 +18,7 @@ if {"::tcltest" ni [namespace children]} { source [file join [file dirname [info script]] tcltests.tcl] package require http 2.10 +#http::register http 80 ::socket proc bgerror {args} { global errorInfo diff --git a/tests/http11.test b/tests/http11.test index 55e7d39..af35763 100644 --- a/tests/http11.test +++ b/tests/http11.test @@ -13,6 +13,7 @@ if {"::tcltest" ni [namespace children]} { } package require http 2.10 +#http::register http 80 ::socket # start the server variable httpd_output diff --git a/tests/httpProxy.test b/tests/httpProxy.test index d8bd6b7..ae926ff 100644 --- a/tests/httpProxy.test +++ b/tests/httpProxy.test @@ -18,6 +18,7 @@ if {"::tcltest" ni [namespace children]} { } package require http 2.10 +#http::register http 80 ::socket proc bgerror {args} { global errorInfo @@ -57,7 +58,7 @@ http::config -threadlevel $ThreadLevel if {[testConstraint needsTls]} { package require tls http::register https 443 [list ::tls::socket -ssl2 0 -ssl3 0 \ - -tls1 0 -tls1.1 0 -tls1.2 1 -tls1.3 0 -autoservername 1] + -tls1 0 -tls1.1 0 -tls1.2 1 -tls1.3 0 -autoservername 1] ::tls::socketCmd 1 1 } # Testing with Squid -- cgit v0.12 From cbaebdf42b45a9ddcf12c2e2c0ebfad3e0e18ecb Mon Sep 17 00:00:00 2001 From: bch Date: Tue, 5 Dec 2023 21:22:19 +0000 Subject: Fix DTrace-enabled (--enable-dtrace) build on NetBSD. vis: dtrace: failed to link script /home/bch/work/tcl/generic/tclDTrace.d: an error was encountered while processing tclBasic.o Bisecting led me to: katy$ fossil bisect status 2023-10-11 10:28:31 a19b5c1f83 BAD 2023-10-11 05:26:06 b82abeca2e GOOD --- generic/tclBasic.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 60941b0..9a0cc4b 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -176,7 +176,7 @@ static int CancelEvalProc(void *clientData, Tcl_Interp *interp, int code); static int CheckDoubleResult(Tcl_Interp *interp, double dResult); static void DeleteCoroutine(void *clientData); -static Tcl_FreeProc DeleteInterpProc; +static void DeleteInterpProc(Tcl_Interp * interp); static void DeleteOpCmdClientData(void *clientData); #ifdef USE_DTRACE static Tcl_ObjCmdProc DTraceObjCmd; @@ -1822,10 +1822,8 @@ Tcl_DeleteInterp( */ static void -DeleteInterpProc( - void *blockPtr) /* Interpreter to delete. */ +DeleteInterpProc(Tcl_Interp * interp) { - Tcl_Interp *interp = (Tcl_Interp *) blockPtr; Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hPtr; Tcl_HashSearch search; -- cgit v0.12 From 552ef1ca02c0b71c2c1cda3d1330a4fabc93b3c1 Mon Sep 17 00:00:00 2001 From: sebres Date: Tue, 5 Dec 2023 22:42:02 +0000 Subject: closes [db4f2843cd]: fixes SF by BO in ReadChars (and Tcl_ReadChars with append) caused by wrong buffer enlarge if objPtr shimmering to unicode for whatever reason, since Tcl_AppendToObj prefers unicode to bytes, whereas Tcl_SetObjLength prefers bytes (like the ReadChars) --- generic/tclIO.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 0f79f1e..0153646 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -6112,7 +6112,7 @@ ReadChars( int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR; (void) TclGetStringFromObj(objPtr, &numBytes); - Tcl_AppendToObj(objPtr, NULL, dstLimit); + Tcl_SetObjLength(objPtr, numBytes + dstLimit); if (toRead == srcLen) { unsigned int size; -- cgit v0.12 From 9596e30dfda01be9be7b1601b88f31fc519331b8 Mon Sep 17 00:00:00 2001 From: kjnash Date: Wed, 6 Dec 2023 01:37:11 +0000 Subject: Rename commands http::socketForTls -> http::socketAsCallback, http::socket -> http::AltSocket. --- library/http/http.tcl | 59 ++++++++++++++++++++++++++------------------------- 1 file changed, 30 insertions(+), 29 deletions(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index d45f16f..563e5ad 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -119,7 +119,7 @@ namespace eval http { variable urlTypes if {![info exists urlTypes]} { - set urlTypes(http) [list 80 ::http::socket {} 1 0] + set urlTypes(http) [list 80 ::http::AltSocket {} 1 0] } variable encodings [string tolower [encoding names]] @@ -306,7 +306,7 @@ proc http::register {proto port command {socketCmdVarName {}} {useSockThread 0} # If the external handler for protocol $proto has given $socketCmdVarName the expected # value "::socket", overwrite it with the new value. if {($socketCmdVarName ne {}) && ([set $socketCmdVarName] eq {::socket})} { - set $socketCmdVarName ::http::socketForTls + set $socketCmdVarName ::http::socketAsCallback } return $urlTypes($lower) @@ -332,7 +332,7 @@ proc http::unregister {proto} { # Restore the external handler's original value for $socketCmdVarName. lassign $old defport defcmd socketCmdVarName useSockThread endToEndProxy - if {($socketCmdVarName ne {}) && ([set $socketCmdVarName] eq {::http::socketForTls})} { + if {($socketCmdVarName ne {}) && ([set $socketCmdVarName] eq {::http::socketAsCallback})} { set $socketCmdVarName ::socket } @@ -955,18 +955,19 @@ proc http::geturl {url args} { variable urlTypes # - If ::tls::socketCmd has its default value "::socket", change it to the - # new value ::http::socketForTls. + # new value ::http::socketAsCallback. # - If the old value is different, then it has been modified either by the # script or by the Tcl installation, and replaced by a new command. The # script or installation that modified ::tls::socketCmd is also - # responsible for integrating ::http::socketForTls into its own "new" + # responsible for integrating ::http::socketAsCallback into its own "new" # command, if it wishes to do so. # - Commands that open a socket: - # - ::socket - basic - # - ::http::socket - can use a thread to avoid blockage by slow DNS - # lookup. See http::config option -threadlevel. - # - ::http::socketForTls - as ::http::socket, but can also open a socket - # for HTTPS/TLS through a proxy. + # - ::socket - basic + # - ::http::AltSocket - can use a thread to avoid blockage by slow + # DNS lookup. See http::config option + # -threadlevel. + # - ::http::socketAsCallback - as ::http::AltSocket, but can also open a + # socket for HTTPS/TLS through a proxy. set token [CreateToken $url {*}$args] variable $token @@ -1291,7 +1292,7 @@ proc http::CreateToken {url args} { # If the external handler for protocol $proto has given $socketCmdVarName the expected # value "::socket", overwrite it with the new value. if {($socketCmdVarName ne {}) && ([set $socketCmdVarName] eq {::socket})} { - set $socketCmdVarName ::http::socketForTls + set $socketCmdVarName ::http::socketAsCallback } set state(protoSockThread) $useSockThread @@ -1377,7 +1378,7 @@ proc http::CreateToken {url args} { } # Handle proxy requests here for http:// but not for https:// - # The proxying for https is done in the ::http::socketForTls command. + # The proxying for https is done in the ::http::socketAsCallback command. # A proxy request for http:// needs the full URL in the HTTP request line, # including the server name. # The *tls* test below attempts to describe protocols in addition to @@ -4984,11 +4985,11 @@ interp alias {} http::ncode {} http::responseCode # ------------------------------------------------------------------------------ -# Proc http::socketForTls +# Proc http::socketAsCallback # ------------------------------------------------------------------------------ # Command to use in place of ::socket as the value of ::tls::socketCmd. -# This command does the same as http::socket, and also handles https connections -# through a proxy server. +# This command does the same as http::AltSocket, and also handles https +# connections through a proxy server. # # Notes. # - The proxy server works differently for https and http. This implementation @@ -5005,7 +5006,7 @@ interp alias {} http::ncode {} http::responseCode # Return Value: a socket identifier # ------------------------------------------------------------------------------ -proc http::socketForTls {args} { +proc http::socketAsCallback {args} { variable http set targ [lsearch -exact $args -type] @@ -5030,7 +5031,7 @@ proc http::socketForTls {args} { set pport {} } if {$phost eq ""} { - set sock [::http::socket {*}$args] + set sock [::http::AltSocket {*}$args] } else { set sock [::http::SecureProxyConnect {*}$args $phost $pport] } @@ -5085,8 +5086,8 @@ proc http::SecureProxyConnect {args} { # Elements of args other than host and port are not used when # AsyncTransaction opens a socket. Those elements are -async and the # -type $tokenName for the https transaction. Option -async is used by - # AsyncTransaction anyway, and -type $tokenName should not be propagated: - # the proxy request adds its own -type value. + # AsyncTransaction anyway, and -type $tokenName should not be + # propagated: the proxy request adds its own -type value. set targ [lsearch -exact $args -type] if {$targ != -1} { @@ -5231,14 +5232,14 @@ proc http::AllDone {varName args} { # ------------------------------------------------------------------------------ -# Proc http::socket +# Proc http::AltSocket # ------------------------------------------------------------------------------ # This command is a drop-in replacement for ::socket. # Arguments and return value as for ::socket. # # Notes. -# - http::socket is specified in place of ::socket by the definition of urlTypes -# in the namespace header of this file (http.tcl). +# - http::AltSocket is specified in place of ::socket by the definition of +# urlTypes in the namespace header of this file (http.tcl). # - The command makes a simple call to ::socket unless the user has called # http::config to change the value of -threadlevel from the default value 0. # - For -threadlevel 1 or 2, if the Thread package is available, the command @@ -5249,9 +5250,9 @@ proc http::AllDone {varName args} { # - FIXME The peer thread can transfer the socket only to the main interpreter # in the present thread. Therefore this code works only if this script runs # in the main interpreter. In a child interpreter, the parent must alias a -# command to ::http::socket in the child, run http::socket in the parent, -# and then transfer the socket to the child. -# - The http::socket command is simple, and can easily be replaced with an +# command to ::http::AltSocket in the child, run http::AltSocket in the +# parent, and then transfer the socket to the child. +# - The http::AltSocket command is simple, and can easily be replaced with an # alternative command that uses a different technique to open a socket while # entering the event loop. # - Unexpected behaviour by thread::send -async (Thread 2.8.6). @@ -5260,7 +5261,7 @@ proc http::AllDone {varName args} { # Hence wrap the command with catch as a precaution. # ------------------------------------------------------------------------------ -proc http::socket {args} { +proc http::AltSocket {args} { variable ThreadVar variable ThreadCounter variable http @@ -5331,7 +5332,7 @@ proc http::socket {args} { return -options $errdict -code $catchCode $sock } -# The commands below are dependencies of http::socket and +# The commands below are dependencies of http::AltSocket and # http::SecureProxyConnect and are not used elsewhere. # ------------------------------------------------------------------------------ @@ -5344,7 +5345,7 @@ proc http::socket {args} { # value 2 => error return # # The command assigns a value to http(usingThread), which records whether -# command http::socket can use a separate thread. +# command http::AltSocket can use a separate thread. # # Arguments: none # Return Value: none @@ -5373,7 +5374,7 @@ proc http::LoadThreadIfNeeded {} { # ------------------------------------------------------------------------------ # Proc http::SockInThread # ------------------------------------------------------------------------------ -# Command http::socket is a ::socket replacement. It defines and runs this +# Command http::AltSocket is a ::socket replacement. It defines and runs this # command, http::SockInThread, in a peer thread. # # Arguments: -- cgit v0.12 From abb41660f5db5c8055f12b391aa696e8a12b528f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 6 Dec 2023 08:52:41 +0000 Subject: =?UTF-8?q?Fix:=20/tclBasic.c:1800:32:=20warning:=20passing=20argu?= =?UTF-8?q?ment=202=20of=20=E2=80=98Tcl=5FEventuallyFree=E2=80=99=20from?= =?UTF-8?q?=20incompatible=20pointer=20type=20[-Wincompatible-pointer-type?= =?UTF-8?q?s]=20by=20reverting=20the=20DTrace=20'fix':=20this=20cannot=20b?= =?UTF-8?q?e=20a=20correct=20fix=20for=20Dtrace=20(Sorry!)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- generic/tclBasic.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 9a0cc4b..60941b0 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -176,7 +176,7 @@ static int CancelEvalProc(void *clientData, Tcl_Interp *interp, int code); static int CheckDoubleResult(Tcl_Interp *interp, double dResult); static void DeleteCoroutine(void *clientData); -static void DeleteInterpProc(Tcl_Interp * interp); +static Tcl_FreeProc DeleteInterpProc; static void DeleteOpCmdClientData(void *clientData); #ifdef USE_DTRACE static Tcl_ObjCmdProc DTraceObjCmd; @@ -1822,8 +1822,10 @@ Tcl_DeleteInterp( */ static void -DeleteInterpProc(Tcl_Interp * interp) +DeleteInterpProc( + void *blockPtr) /* Interpreter to delete. */ { + Tcl_Interp *interp = (Tcl_Interp *) blockPtr; Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hPtr; Tcl_HashSearch search; -- cgit v0.12 From 1ece2c6535e3e5805e75552b33651c61a149e4dc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 6 Dec 2023 09:08:59 +0000 Subject: WIP: Let's try to make DTrace work for Tcl 9.0 --- generic/tclDTrace.d | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/generic/tclDTrace.d b/generic/tclDTrace.d index 9d1adc0..751ceca 100644 --- a/generic/tclDTrace.d +++ b/generic/tclDTrace.d @@ -10,6 +10,8 @@ */ typedef struct Tcl_Obj Tcl_Obj; + +typedef ptrdiff_t Tcl_Size /* * Tcl DTrace probes @@ -21,10 +23,10 @@ provider tcl { * tcl*:::proc-entry probe * triggered immediately before proc bytecode execution * arg0: proc name (string) - * arg1: number of arguments (int) + * arg1: number of arguments (Tcl_Size) * arg2: array of proc argument objects (Tcl_Obj**) */ - probe proc__entry(const char *name, int objc, struct Tcl_Obj **objv); + probe proc__entry(const char *name, Tcl_Size objc, struct Tcl_Obj **objv); /* * tcl*:::proc-return probe * triggered immediately after proc bytecode execution @@ -75,10 +77,10 @@ provider tcl { * tcl*:::cmd-entry probe * triggered immediately before commmand execution * arg0: command name (string) - * arg1: number of arguments (int) + * arg1: number of arguments (Tcl_Size) * arg2: array of command argument objects (Tcl_Obj**) */ - probe cmd__entry(const char *name, int objc, struct Tcl_Obj **objv); + probe cmd__entry(const char *name, Tcl_Size objc, struct Tcl_Obj **objv); /* * tcl*:::cmd-return probe * triggered immediately after commmand execution @@ -181,9 +183,9 @@ typedef struct Tcl_ObjType { } Tcl_ObjType; struct Tcl_Obj { - size_t refCount; + Tcl_Size refCount; char *bytes; - size_t length; + Tcl_Size length; const Tcl_ObjType *typePtr; union { long longValue; -- cgit v0.12 From b6be6f6e5a5ea975e9d12b1774c2fdf374ee2699 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 6 Dec 2023 09:28:41 +0000 Subject: typo --- doc/chan.n | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/chan.n b/doc/chan.n index b184b00..d78c445 100644 --- a/doc/chan.n +++ b/doc/chan.n @@ -337,7 +337,7 @@ was already reached, and 0 otherwise. .TP \fBchan event \fIchannelName event\fR ?\fIscript\fR? . -Arranges for the given script, called a \fBchannel event hndler\fR, to be +Arranges for the given script, called a \fBchannel event handler\fR, to be called whenever the given event, one of .QW \fBreadable\fR or -- cgit v0.12 From 8323bc690eada7dacb85bdf1c39b7a4390633e0b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 6 Dec 2023 13:14:15 +0000 Subject: Fix [0110923366]: some (wish package) is leaving a global variable "test" set --- library/manifest.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/library/manifest.txt b/library/manifest.txt index 5a999f4..988d267 100644 --- a/library/manifest.txt +++ b/library/manifest.txt @@ -2,7 +2,6 @@ # Package manifest for all Tcl packages included in the /library file system ### apply {{dir} { - set ::test [info script] set isafe [interp issafe] foreach {safe package version file} { 0 http 2.10b1 {http http.tcl} -- cgit v0.12 From 246ecb63b54d6799b07077f4926e9227cac59206 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 6 Dec 2023 15:01:18 +0000 Subject: Fix introspection with TclOO resolution of consts --- generic/tclVar.c | 57 +++++++++++++--- tests/info.test | 8 +-- tests/var.test | 203 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 254 insertions(+), 14 deletions(-) diff --git a/generic/tclVar.c b/generic/tclVar.c index d0523c4..4ab9dd5 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -6516,6 +6516,24 @@ TclInfoConstsCmd( *---------------------------------------------------------------------- */ +static int +ContextObjectContainsConstant( + Tcl_ObjectContext context, + Tcl_Obj *varNamePtr) +{ + /* + * Helper for AppendLocals to check if an object contains a variable + * that is a constant. It's too complicated without factoring this + * check out! + */ + + Object *oPtr = (Object *) Tcl_ObjectContextObject(context); + Namespace *nsPtr = (Namespace *) oPtr->namespacePtr; + Var *varPtr = VarHashFindVar(&nsPtr->varTable, varNamePtr); + + return !TclIsVarUndefined(varPtr) && TclIsVarConstant(varPtr); +} + static void AppendLocals( Tcl_Interp *interp, /* Current interpreter. */ @@ -6551,11 +6569,12 @@ AppendLocals( */ if (*varNamePtr && !TclIsVarUndefined(varPtr) - && (!justConstants || TclIsVarConstant(varPtr)) && (includeLinks || !TclIsVarLink(varPtr))) { varName = TclGetString(*varNamePtr); if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) { - Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr); + if (!justConstants || TclIsVarConstant(varPtr)) { + Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr); + } if (includeLinks) { Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added); } @@ -6581,10 +6600,11 @@ AppendLocals( varPtr = VarHashFindVar(localVarTablePtr, patternPtr); if (varPtr != NULL) { if (!TclIsVarUndefined(varPtr) - && (!justConstants || TclIsVarConstant(varPtr)) && (includeLinks || !TclIsVarLink(varPtr))) { - Tcl_ListObjAppendElement(interp, listPtr, - VarHashGetKey(varPtr)); + if ((!justConstants || TclIsVarConstant(varPtr))) { + Tcl_ListObjAppendElement(interp, listPtr, + VarHashGetKey(varPtr)); + } if (includeLinks) { Tcl_CreateHashEntry(&addedTable, VarHashGetKey(varPtr), &added); @@ -6602,12 +6622,13 @@ AppendLocals( varPtr != NULL; varPtr = VarHashNextVar(&search)) { if (!TclIsVarUndefined(varPtr) - && (!justConstants || TclIsVarConstant(varPtr)) && (includeLinks || !TclIsVarLink(varPtr))) { objNamePtr = VarHashGetKey(varPtr); varName = TclGetString(objNamePtr); if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) { - Tcl_ListObjAppendElement(interp, listPtr, objNamePtr); + if (!justConstants || TclIsVarConstant(varPtr)) { + Tcl_ListObjAppendElement(interp, listPtr, objNamePtr); + } if (includeLinks) { Tcl_CreateHashEntry(&addedTable, objNamePtr, &added); } @@ -6620,10 +6641,10 @@ AppendLocals( return; } - /* TODO: Handle how constants interact with objects. */ if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD) { - Method *mPtr = (Method *) - Tcl_ObjectContextMethod((Tcl_ObjectContext)iPtr->varFramePtr->clientData); + Tcl_ObjectContext context = (Tcl_ObjectContext) + iPtr->varFramePtr->clientData; + Method *mPtr = (Method *) Tcl_ObjectContextMethod(context); PrivateVariableMapping *privatePtr; if (mPtr->declaringObjectPtr) { @@ -6631,6 +6652,10 @@ AppendLocals( FOREACH(objNamePtr, oPtr->variables) { Tcl_CreateHashEntry(&addedTable, objNamePtr, &added); + if (justConstants && !ContextObjectContainsConstant(context, + objNamePtr)) { + continue; + } if (added && (!pattern || Tcl_StringMatch(TclGetString(objNamePtr), pattern))) { Tcl_ListObjAppendElement(interp, listPtr, objNamePtr); @@ -6639,6 +6664,10 @@ AppendLocals( FOREACH_STRUCT(privatePtr, oPtr->privateVariables) { Tcl_CreateHashEntry(&addedTable, privatePtr->variableObj, &added); + if (justConstants && !ContextObjectContainsConstant(context, + privatePtr->fullNameObj)) { + continue; + } if (added && (!pattern || Tcl_StringMatch(TclGetString(privatePtr->variableObj), pattern))) { @@ -6651,6 +6680,10 @@ AppendLocals( FOREACH(objNamePtr, clsPtr->variables) { Tcl_CreateHashEntry(&addedTable, objNamePtr, &added); + if (justConstants && !ContextObjectContainsConstant(context, + objNamePtr)) { + continue; + } if (added && (!pattern || Tcl_StringMatch(TclGetString(objNamePtr), pattern))) { Tcl_ListObjAppendElement(interp, listPtr, objNamePtr); @@ -6659,6 +6692,10 @@ AppendLocals( FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) { Tcl_CreateHashEntry(&addedTable, privatePtr->variableObj, &added); + if (justConstants && !ContextObjectContainsConstant(context, + privatePtr->fullNameObj)) { + continue; + } if (added && (!pattern || Tcl_StringMatch(TclGetString(privatePtr->variableObj), pattern))) { diff --git a/tests/info.test b/tests/info.test index 40a4746..6c49b2d 100644 --- a/tests/info.test +++ b/tests/info.test @@ -678,16 +678,16 @@ test info-21.1 {miscellaneous error conditions} -returnCodes error -body { } -result {wrong # args: should be "info subcommand ?arg ...?"} test info-21.2 {miscellaneous error conditions} -returnCodes error -body { info gorp -} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, cmdtype, commands, complete, constant, consts, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} test info-21.3 {miscellaneous error conditions} -returnCodes error -body { info c -} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, cmdtype, commands, complete, constant, consts, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} test info-21.4 {miscellaneous error conditions} -returnCodes error -body { info l -} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, cmdtype, commands, complete, constant, consts, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} test info-21.5 {miscellaneous error conditions} -returnCodes error -body { info s -} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, cmdtype, commands, complete, constant, consts, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} ## # ### ### ### ######### ######### ######### diff --git a/tests/var.test b/tests/var.test index 3eae527..a42f6cb 100644 --- a/tests/var.test +++ b/tests/var.test @@ -1936,6 +1936,209 @@ test var-29.1 {const: globally} -setup { } -cleanup { interp delete $int } -result gorp +test var-29.2 {const: TclOO variable resolution} -setup { + oo::class create Parent +} -body { + oo::class create C { + superclass Parent + variable X + constructor {} { + const X 123 + } + method checkRead {} { + return $X + } + method checkWrite {} { + list [catch { + set X abc + } msg] $msg + } + method checkUnset {} { + list [catch { + unset X + } msg] $msg + } + method checkProbe {} { + info constant X + } + method checkList {} { + info consts + } + } + set c [C new] + list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList] +} -cleanup { + Parent destroy +} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X} +test var-29.3 {const: TclOO variable resolution} -setup { + oo::class create Parent +} -body { + oo::class create C { + superclass Parent + private variable X + constructor {} { + const X 123 + } + method checkRead {} { + return $X + } + method checkWrite {} { + list [catch { + set X abc + } msg] $msg + } + method checkUnset {} { + list [catch { + unset X + } msg] $msg + } + method checkProbe {} { + info constant X + } + method checkList {} { + info consts + } + } + set c [C new] + list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList] +} -cleanup { + Parent destroy +} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X} +test var-29.4 {const: TclOO variable resolution} -setup { + oo::class create Parent +} -body { + oo::class create C { + superclass Parent + variable X + constructor {} { + set X 123 + } + method checkRead {} { + return $X + } + method checkWrite {} { + list [catch { + set X abc + } msg] $msg + } + method checkUnset {} { + list [catch { + unset X + set X gorp + } msg] $msg + } + method checkProbe {} { + info constant X + } + method checkList {} { + info consts + } + } + set c [C new] + list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList] +} -cleanup { + Parent destroy +} -result {123 {0 abc} {0 gorp} 0 {}} +test var-29.5 {const: TclOO variable resolution} -setup { + set c [oo::object create Instance] +} -body { + oo::objdefine $c { + variable X + method init {} { + const X 123 + } + method checkRead {} { + return $X + } + method checkWrite {} { + list [catch { + set X abc + } msg] $msg + } + method checkUnset {} { + list [catch { + unset X + } msg] $msg + } + method checkProbe {} { + info constant X + } + method checkList {} { + info consts + } + } + $c init + list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList] +} -cleanup { + Instance destroy +} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X} +test var-29.6 {const: TclOO variable resolution} -setup { + set c [oo::object create Instance] +} -body { + oo::objdefine $c { + private variable X + method init {} { + const X 123 + } + method checkRead {} { + return $X + } + method checkWrite {} { + list [catch { + set X abc + } msg] $msg + } + method checkUnset {} { + list [catch { + unset X + } msg] $msg + } + method checkProbe {} { + info constant X + } + method checkList {} { + info consts + } + } + $c init + list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList] +} -cleanup { + Instance destroy +} -result {123 {1 {can't set "X": variable is a constant}} {1 {can't unset "X": variable is a constant}} 1 X} +test var-29.7 {const: TclOO variable resolution} -setup { + set c [oo::object create Instance] +} -body { + oo::objdefine $c { + variable X + method init {} { + set X 123 + } + method checkRead {} { + return $X + } + method checkWrite {} { + list [catch { + set X abc + } msg] $msg + } + method checkUnset {} { + list [catch { + unset X + set X gorp + } msg] $msg + } + method checkProbe {} { + info constant X + } + method checkList {} { + info consts + } + } + $c init + list [$c checkRead] [$c checkWrite] [$c checkUnset] [$c checkProbe] [$c checkList] +} -cleanup { + Instance destroy +} -result {123 {0 abc} {0 gorp} 0 {}} # The info constant and info consts commands test var-30.1 {info constant and info consts} { -- cgit v0.12 From 398266b21844c072602a7c05ed5259d517f2acef Mon Sep 17 00:00:00 2001 From: bch Date: Wed, 6 Dec 2023 19:44:00 +0000 Subject: ; termination --- generic/tclDTrace.d | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclDTrace.d b/generic/tclDTrace.d index 751ceca..b88f184 100644 --- a/generic/tclDTrace.d +++ b/generic/tclDTrace.d @@ -11,7 +11,7 @@ typedef struct Tcl_Obj Tcl_Obj; -typedef ptrdiff_t Tcl_Size +typedef ptrdiff_t Tcl_Size; /* * Tcl DTrace probes -- cgit v0.12 From e0e22956f48e72c9c8cb328dee9574084a63e7c6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 6 Dec 2023 23:06:58 +0000 Subject: int -> Tcl_Size for DTrace --- generic/tclBasic.c | 10 +++++----- generic/tclCompile.h | 10 +++++----- generic/tclDTrace.d | 23 ++++++++++++++++------- generic/tclProc.c | 2 +- 4 files changed, 27 insertions(+), 18 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 60941b0..e371677 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4559,14 +4559,14 @@ Dispatch( { Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *)data[0]; void *clientData = data[1]; - int objc = PTR2INT(data[2]); + Tcl_Size objc = PTR2INT(data[2]); Tcl_Obj **objv = (Tcl_Obj **)data[3]; Interp *iPtr = (Interp *) interp; #ifdef USE_DTRACE if (TCL_DTRACE_CMD_ARGS_ENABLED()) { const char *a[10]; - int i = 0; + Tcl_Size i = 0; while (i < 10) { a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++; @@ -4576,7 +4576,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]); @@ -8346,7 +8346,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; @@ -8386,7 +8386,7 @@ TclDTraceInfo( for (i = 0; i < 2; i++) { Tcl_DictObjGet(NULL, info, *k++, &val); if (val) { - TclGetIntFromObj(NULL, val, &argsi[i]); + Tcl_GetSizeIntFromObj(NULL, val, &argsi[i]); } else { argsi[i] = 0; } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 161ea62..12ba7b7 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1754,7 +1754,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 */ @@ -1809,7 +1809,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; \ @@ -1847,7 +1847,7 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi); #define TCL_DTRACE_PROC_INFO_ENABLED() 1 #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \ tclDTraceDebugIndent++; \ - TclDTraceDbgMsg("-> proc-entry", "%s %d %p", a0, a1, a2) + TclDTraceDbgMsg("-> proc-entry", "%s %" TCL_SIZE_MODIFIER "d %p", a0, a1, a2) #define TCL_DTRACE_PROC_RETURN(a0, a1) \ TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \ tclDTraceDebugIndent-- @@ -1867,7 +1867,7 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi); #define TCL_DTRACE_CMD_INFO_ENABLED() 1 #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) \ tclDTraceDebugIndent++; \ - TclDTraceDbgMsg("-> cmd-entry", "%s %d %p", a0, a1, a2) + TclDTraceDbgMsg("-> cmd-entry", "%s %" TCL_SIZE_MODIFIER "d %p", a0, a1, a2) #define TCL_DTRACE_CMD_RETURN(a0, a1) \ TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \ tclDTraceDebugIndent-- @@ -1877,7 +1877,7 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi); TclDTraceDbgMsg(" | cmd-args", "%s %s %s %s %s %s %s %s %s %s", a0, \ a1, a2, a3, a4, a5, a6, a7, a8, a9) #define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \ - TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %d %d %s %s", a0, a1, \ + TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %" TCL_SIZE_MODIFIER "d %" TCL_SIZE_MODIFIER "d %s %s", a0, a1, \ a2, a3, a4, a5, a6, a7) #define TCL_DTRACE_INST_START_ENABLED() TCL_DTRACE_DEBUG_INST_PROBES diff --git a/generic/tclDTrace.d b/generic/tclDTrace.d index b88f184..c0ef517 100644 --- a/generic/tclDTrace.d +++ b/generic/tclDTrace.d @@ -64,12 +64,12 @@ provider tcl { * arg2: TIP 280 proc (string) * arg3: TIP 280 file (string) * arg4: TIP 280 line (int) - * arg5: TIP 280 level (int) + * arg5: TIP 280 level (Tcl_Size) * arg6: TclOO method (string) * arg7: TclOO class/object (string) */ probe proc__info(const char *cmd, const char *type, const char *proc, - const char *file, int line, int level, const char *method, + const char *file, int line, Tcl_Size level, const char *method, const char *class); /***************************** cmd probes ******************************/ @@ -123,7 +123,7 @@ provider tcl { * arg7: TclOO class/object (string) */ probe cmd__info(const char *cmd, const char *type, const char *proc, - const char *file, int line, int level, const char *method, + const char *file, int line, Tcl_Size level, const char *method, const char *class); /***************************** inst probes *****************************/ @@ -131,18 +131,18 @@ provider tcl { * tcl*:::inst-start probe * triggered immediately before execution of a bytecode * arg0: bytecode name (string) - * arg1: depth of stack (int) + * arg1: depth of stack (Tcl_Size) * arg2: top of stack (Tcl_Obj**) */ - probe inst__start(const char *name, int depth, struct Tcl_Obj **stack); + probe inst__start(const char *name, Tcl_Size depth, struct Tcl_Obj **stack); /* * tcl*:::inst-done probe * triggered immediately after execution of a bytecode * arg0: bytecode name (string) - * arg1: depth of stack (int) + * arg1: depth of stack (Tcl_Size) * arg2: top of stack (Tcl_Obj**) */ - probe inst__done(const char *name, int depth, struct Tcl_Obj **stack); + probe inst__done(const char *name, Tcl_Size depth, struct Tcl_Obj **stack); /***************************** obj probes ******************************/ /* @@ -180,6 +180,15 @@ typedef struct Tcl_ObjType { void *dupIntRepProc; void *updateStringProc; void *setFromAnyProc; + size_t version; + void *lengthProc; + void *indexProc; + void *sliceProc; + void *reverseProc; + void *getElementsProc; + void *setElementProc; + void *replaceProc; + void *inOperProc; } Tcl_ObjType; struct Tcl_Obj { diff --git a/generic/tclProc.c b/generic/tclProc.c index 1633a09..daf8284 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1749,7 +1749,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 b89ef7b124e6eb08af98b65ce1dae1026922da9a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 8 Dec 2023 09:57:26 +0000 Subject: Backout [b88bac358d]: "Experimental: update automatic build instructions". Build is already broken for 2 weeks now, no visible activity for fixing this. --- .github/workflows/onefiledist.yml | 45 +++++++-------------------------------- 1 file changed, 8 insertions(+), 37 deletions(-) diff --git a/.github/workflows/onefiledist.yml b/.github/workflows/onefiledist.yml index 2b56934..8fec3e1 100644 --- a/.github/workflows/onefiledist.yml +++ b/.github/workflows/onefiledist.yml @@ -26,11 +26,8 @@ jobs: echo "VER_PATH=$(cd tools; pwd)/addVerToFile.tcl" >> $GITHUB_ENV working-directory: . - name: Configure - run: | - ./configure --disable-symbols --disable-shared --enable-zipfs - sed -n '/^PATCH_LEVEL/{s/.*= /patchlevel=/;p}' < Makefile >> $GITHUB_OUTPUT + run: ./configure --disable-symbols --disable-shared --enable-zipfs working-directory: unix - id: cfg - name: Build run: | make tclsh @@ -43,12 +40,10 @@ jobs: chmod +x tclsh${TCL_PATCHLEVEL}_snapshot tar -cf tclsh${TCL_PATCHLEVEL}_snapshot.tar tclsh${TCL_PATCHLEVEL}_snapshot working-directory: 1dist - env: - TCL_PATCHLEVEL: ${{ steps.cfg.outputs.patchlevel }} - name: Upload uses: actions/upload-artifact@v3 with: - name: Tclsh ${{ steps.cfg.outputs.patchlevel }} Linux single-file build (snapshot) + name: Tclsh ${{ env.TCL_PATCHLEVEL }} Linux single-file build (snapshot) path: 1dist/*.tar macos: name: macOS @@ -77,11 +72,8 @@ jobs: echo "CREATE_DMG=$(cd create-dmg;pwd)/create-dmg" >> $GITHUB_ENV echo "CFLAGS=-arch x86_64 -arch arm64" >> $GITHUB_ENV - name: Configure - run: | - ./configure --disable-symbols --disable-shared --enable-zipfs - sed -n '/^PATCH_LEVEL/{s/.*= /patchlevel=/;p}' < Makefile >> $GITHUB_OUTPUT + run: ./configure --disable-symbols --disable-shared --enable-zipfs working-directory: unix - id: cfg - name: Build run: | make tclsh @@ -111,12 +103,10 @@ jobs: "Tcl-$TCL_PATCHLEVEL-(snapshot).dmg" \ "contents/" working-directory: 1dist - env: - TCL_PATCHLEVEL: ${{ steps.cfg.outputs.patchlevel }} - name: Upload uses: actions/upload-artifact@v3 with: - name: Tclsh ${{ steps.cfg.outputs.patchlevel }} macOS single-file build (snapshot) + name: Tclsh ${{ env.TCL_PATCHLEVEL }} macOS single-file build (snapshot) path: 1dist/*.dmg win: name: Windows @@ -143,11 +133,8 @@ jobs: mkdir 1dist working-directory: . - name: Configure - run: | - ./configure $CFGOPT - sed -n '/^PATCH_LEVEL/{s/.*= /patchlevel=/;p}' < Makefile >> $GITHUB_OUTPUT + run: ./configure $CFGOPT working-directory: win - id: cfg - name: Build run: | make binaries libraries @@ -156,29 +143,13 @@ jobs: - name: Get Exact Version run: | ./tclsh*.exe $VER_PATH $GITHUB_ENV - echo "target=tclsh${TCL_PATCHLEVEL}_snapshot.exe" >> $GITHUB_OUTPUT working-directory: win - id: exe - env: - TCL_PATCHLEVEL: ${{ steps.cfg.outputs.patchlevel }} - name: Set Executable Name run: | - cp ../win/tclsh*.exe "$TARGET_EXE" + cp ../win/tclsh*.exe tclsh${TCL_PATCHLEVEL}_snapshot.exe working-directory: 1dist - env: - TARGET_EXE: ${{ steps.exe.outputs.target }} - - name: Sign - if: ${{ env.HAVE_CAPABILITY }} - uses: dlemstra/code-sign-action@v1 - with: - certificate: '${{ secrets.Windows_Certificate_base64 }}' - password: '${{ secrets.Windows_Certificate_password }}' - folder: 1dist - files: ${{ steps.exe.outputs.target }} - env: - HAVE_CAPABILITY: ${{ secrets.Windows_Certificate_base64 != '' && secrets.Windows_Certificate_password != '' }} - name: Upload uses: actions/upload-artifact@v3 with: - name: Tclsh ${{ steps.cfg.outputs.patchlevel }} Windows single-file build (snapshot) - path: 1dist/${{ steps.exe.outputs.target }} + name: Tclsh ${{ env.TCL_PATCHLEVEL }} Windows single-file build (snapshot) + path: '1dist/*_snapshot.exe' -- cgit v0.12 From b021637b916ce6d470cfd37964d3730f3825a76a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 8 Dec 2023 11:04:27 +0000 Subject: Fix [31c54e6a59]: Add missing test files. Put back excluded_pages in tcltk-man2html.tcl: As long as Tk 8.7b1 is not updated, this is needed to make the Tk 8.7b1 build work at all. --- tools/tcltk-man2html.tcl | 2 +- unix/Makefile.in | 15 +++++++++++++-- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index e5580c1..2b35bd8 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -578,7 +578,7 @@ proc plus-pkgs {type args} { ## Set up some special cases. It would be nice if we didn't have them, ## but we do... ## -set excluded_pages {} +set excluded_pages {case menubar pack-old} set forced_index_pages {GetDash} set process_first_patterns {*/ttk_widget.n */options.n} set ensemble_commands { diff --git a/unix/Makefile.in b/unix/Makefile.in index a081bb8..3f05a27 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -2326,6 +2326,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in gen $(INSTALL_DATA_DIR) $(DISTDIR)/tests $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/tests $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \ + $(TOP_DIR)/tests/*.bench $(TOP_DIR)/tests/*.tar.gz \ $(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \ $(TOP_DIR)/tests/auto-files.zip $(DISTDIR)/tests @mkdir $(DISTDIR)/tests/auto0 @@ -2341,6 +2342,16 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in gen $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/auto0/$$i/*.tm \ $(DISTDIR)/tests/auto0/$$i; \ done; + @mkdir $(DISTDIR)/tests/zipfiles + $(INSTALL_DATA_DIR) $(DISTDIR)/tests/zipfiles + $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/zipfiles/*.zip \ + $(DISTDIR)/tests/zipfiles + $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/zipfiles/README \ + $(DISTDIR)/tests/zipfiles + $(DIST_INSTALL_DATA) $(TOP_DIR)/tests/zipfiles/LICENSE-libzip \ + $(DISTDIR)/tests/zipfiles + $(INSTALL_DATA_DIR) $(DISTDIR)/tests-perf + $(DIST_INSTALL_DATA) $(TOP_DIR)/tests-perf/*.tcl $(DISTDIR)/tests-perf $(INSTALL_DATA_DIR) $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win $(DIST_INSTALL_DATA) $(TOP_DIR)/win/configure.ac \ @@ -2374,8 +2385,8 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in gen $(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest $(INSTALL_DATA_DIR) $(DISTDIR)/tools $(DIST_INSTALL_DATA) $(TOOL_DIR)/README $(TOOL_DIR)/*.c $(TOOL_DIR)/*.svg \ - $(TOOL_DIR)/*.tcl $(TOOL_DIR)/*.bmp \ - $(TOOL_DIR)/valgrind_suppress $(DISTDIR)/tools + $(TOOL_DIR)/*.tcl $(TOOL_DIR)/*.bmp $(TOOL_DIR)/valgrind_suppress \ + $(TOOL_DIR)/valgrind_check_success $(DISTDIR)/tools chmod 755 $(DISTDIR)/tools/checkLibraryDoc.tcl \ $(DISTDIR)/tools/findBadExternals.tcl \ $(DISTDIR)/tools/loadICU.tcl \ -- cgit v0.12 From 6c17e586130f8dfcead34a2865ecea7d75914a0d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 8 Dec 2023 12:00:06 +0000 Subject: Add (back) DL_LIBS, matching the UNIX version of tcl.m4 --- win/configure | 3 +++ win/tcl.m4 | 2 ++ 2 files changed, 5 insertions(+) diff --git a/win/configure b/win/configure index 80d42d4..95c7ec8 100755 --- a/win/configure +++ b/win/configure @@ -744,6 +744,7 @@ CFLAGS_NOLTO CFLAGS_WARNING CFLAGS_OPTIMIZE CFLAGS_DEBUG +DL_LIBS WINE CYGPATH SHARED_BUILD @@ -4824,6 +4825,8 @@ printf "%s\n" "#define HAVE_CAST_TO_UNION 1" >>confdefs.h fi fi + # DL_LIBS is empty, but then we match the Unix version + diff --git a/win/tcl.m4 b/win/tcl.m4 index 5daeb74..4bac910 100644 --- a/win/tcl.m4 +++ b/win/tcl.m4 @@ -959,6 +959,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ fi fi + # DL_LIBS is empty, but then we match the Unix version + AC_SUBST(DL_LIBS) AC_SUBST(CFLAGS_DEBUG) AC_SUBST(CFLAGS_OPTIMIZE) AC_SUBST(CFLAGS_WARNING) -- cgit v0.12 From 0077a18280e7ef871faa97686078d45b34287588 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 8 Dec 2023 15:20:09 +0000 Subject: Use "(char *)NULL" as sentinel in documentation. See: [26870862f0] --- doc/AddErrInfo.3 | 2 +- doc/Eval.3 | 2 +- doc/SetResult.3 | 2 +- doc/StringObj.3 | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3 index 404382e..99ec904 100644 --- a/doc/AddErrInfo.3 +++ b/doc/AddErrInfo.3 @@ -28,7 +28,7 @@ int .sp \fBTcl_SetObjErrorCode\fR(\fIinterp, errorObjPtr\fR) .sp -\fBTcl_SetErrorCode\fR(\fIinterp, element, element, ... \fBNULL\fR) +\fBTcl_SetErrorCode\fR(\fIinterp, element, element, ... \fB(char *)NULL\fR) .sp \fBTcl_SetErrorCodeVA\fR(\fIinterp, argList\fR) .sp diff --git a/doc/Eval.3 b/doc/Eval.3 index f5cd87f..277d028 100644 --- a/doc/Eval.3 +++ b/doc/Eval.3 @@ -37,7 +37,7 @@ int \fBTcl_GlobalEvalObj\fR(\fIinterp, objPtr\fR) .sp int -\fBTcl_VarEval\fR(\fIinterp, part, part, ... \fBNULL\fR) +\fBTcl_VarEval\fR(\fIinterp, part, part, ... \fB(char *)NULL\fR) .sp int \fBTcl_VarEvalVA\fR(\fIinterp, argList\fR) diff --git a/doc/SetResult.3 b/doc/SetResult.3 index c98401f..0b0697a 100644 --- a/doc/SetResult.3 +++ b/doc/SetResult.3 @@ -24,7 +24,7 @@ Tcl_Obj * const char * \fBTcl_GetStringResult\fR(\fIinterp\fR) .sp -\fBTcl_AppendResult\fR(\fIinterp, result, result, ... , \fBNULL\fR) +\fBTcl_AppendResult\fR(\fIinterp, result, result, ... , \fB(char *)NULL\fR) .sp \fBTcl_AppendResultVA\fR(\fIinterp, argList\fR) .sp diff --git a/doc/StringObj.3 b/doc/StringObj.3 index f016c48..e569e62 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -56,7 +56,7 @@ void \fBTcl_AppendObjToObj\fR(\fIobjPtr, appendObjPtr\fR) .sp void -\fBTcl_AppendStringsToObj\fR(\fIobjPtr, string, string, ... \fBNULL\fR) +\fBTcl_AppendStringsToObj\fR(\fIobjPtr, string, string, ... \fB(char *)NULL\fR) .sp void \fBTcl_AppendStringsToObjVA\fR(\fIobjPtr, argList\fR) -- cgit v0.12 From fb9a422a5141fc6c23ea086354d697f5e2e2c864 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 9 Dec 2023 17:53:17 +0000 Subject: Try "sudo apt-get update" first --- .github/workflows/linux-build.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml index f881b47..69580c2 100644 --- a/.github/workflows/linux-build.yml +++ b/.github/workflows/linux-build.yml @@ -36,7 +36,8 @@ jobs: # Duplicated from above if: ${{ matrix.cfgopt == 'CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit' }} run: | - sudo apt install gcc-multilib libc6-dev-i386 + sudo apt-get update + sudo apt-get install gcc-multilib libc6-dev-i386 - name: Prepare run: | touch tclStubInit.c tclOOStubInit.c -- cgit v0.12 From b6285db0a4f1f84bb4cb425b6ed433a995781f8d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 12 Dec 2023 13:21:28 +0000 Subject: Fix compiler error in TIP #677 implementation --- generic/tclExecute.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 8cce3ba..f4ea875 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -3937,7 +3937,7 @@ TEBCresume( cleanup = 1; part1Ptr = NULL; objPtr = OBJ_AT_TOS; - TRACE(("%u "\"%.30s\" => \n", opnd, O2S(objPtr))); + TRACE(("%u \"%.30s\" => \n", opnd, O2S(objPtr))); varPtr = LOCAL(opnd); arrayPtr = NULL; while (TclIsVarLink(varPtr)) { @@ -9618,9 +9618,9 @@ EvalStatsCmd( double strBytesSharedMultX, strBytesSharedOnce; double numInstructions, currentHeaderBytes; size_t numCurrentByteCodes, numByteCodeLits; - size_t refCountSum, literalMgmtBytes, sum, decadeHigh, length; + size_t refCountSum, literalMgmtBytes, sum, decadeHigh; size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade; - Tcl_Size i; + Tcl_Size i, length; size_t ui; char *litTableStats; LiteralEntry *entryPtr; -- cgit v0.12 From f89c8c3045b87e6504fd248f5691ccd3bf38b4bb Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 12 Dec 2023 13:49:48 +0000 Subject: Shuffle typedef's/#defined around --- generic/tcl.h | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 8644413..b74daed 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -558,29 +558,21 @@ typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp, typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); -#if TCL_MAJOR_VERSION > 8 -typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp, - Tcl_Size level, const char *command, Tcl_Command commandInfo, Tcl_Size objc, - struct Tcl_Obj *const *objv); -#else -#define Tcl_CmdObjTraceProc2 Tcl_CmdObjTraceProc -#endif typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr); typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); -#define Tcl_EncodingFreeProc Tcl_FreeProc +typedef void (Tcl_EncodingFreeProc) (void *clientData); typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags); typedef void (Tcl_EventCheckProc) (void *clientData, int flags); typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, void *clientData); typedef void (Tcl_EventSetupProc) (void *clientData, int flags); -#define Tcl_ExitProc Tcl_FreeProc +typedef void (Tcl_ExitProc) (void *clientData); typedef void (Tcl_FileProc) (void *clientData, int mask); -#define Tcl_FileFreeProc Tcl_FreeProc +typedef void (Tcl_FileFreeProc) (void *clientData); typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr); -typedef void (Tcl_FreeProc) (void *blockPtr); typedef void (Tcl_IdleProc) (void *clientData); typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); @@ -590,8 +582,18 @@ typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, #if TCL_MAJOR_VERSION > 8 typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp, Tcl_Size objc, struct Tcl_Obj *const *objv); +typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp, + Tcl_Size level, const char *command, Tcl_Command commandInfo, Tcl_Size objc, + struct Tcl_Obj *const *objv); +typedef void (Tcl_FreeProc) (void *blockPtr); +#define Tcl_ExitProc Tcl_FreeProc +#define Tcl_FileFreeProc Tcl_FreeProc +#define Tcl_FileFreeProc Tcl_FreeProc +#define Tcl_EncodingFreeProc Tcl_FreeProc #else #define Tcl_ObjCmdProc2 Tcl_ObjCmdProc +#define Tcl_CmdObjTraceProc2 Tcl_CmdObjTraceProc +typedef void (Tcl_FreeProc) (char *blockPtr); #endif typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp); typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags); @@ -750,6 +752,7 @@ typedef struct Tcl_Obj { Tcl_ObjInternalRep internalRep; /* The internal representation: */ } Tcl_Obj; + /* *---------------------------------------------------------------------------- * The following definitions support Tcl's namespace facility. Note: the first -- cgit v0.12 From 5b5534576f6149d37e22bc30b41e4cdcad891d13 Mon Sep 17 00:00:00 2001 From: kjnash Date: Tue, 12 Dec 2023 15:52:00 +0000 Subject: When http.tcl uses Thread, require Thread 2.8.9- to avoid failure of r/w operations on 2.8.8 thread::transfer socket on Windows. --- library/http/http.tcl | 8 ++- tests/httpProxy.test | 154 +++++++++++++++++++++++++++++++------------------- 2 files changed, 101 insertions(+), 61 deletions(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index 563e5ad..bc0eeba 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -5259,6 +5259,8 @@ proc http::AllDone {varName args} { # An error in thread::send -async causes return of just the error message # (not the expected 3 elements), and raises a bgerror in the main thread. # Hence wrap the command with catch as a precaution. +# - Bug in Thread 2.8.8 - on Windows, read/write operations fail on a socket +# moved from another thread by thread::transfer. # ------------------------------------------------------------------------------ proc http::AltSocket {args} { @@ -5357,10 +5359,10 @@ proc http::LoadThreadIfNeeded {} { set http(usingThread) 0 return } - if {[catch {package require Thread}]} { + if {[catch {package require Thread 2.8.9-}]} { if {$http(-threadlevel) == 2} { set msg {[http::config -threadlevel] has value 2,\ - but the Thread package is not available} + but the Thread package (2.8.9 or above) is not available} return -code error $msg } set http(usingThread) 0 @@ -5387,7 +5389,7 @@ proc http::LoadThreadIfNeeded {} { # ------------------------------------------------------------------------------ proc http::SockInThread {caller defcmd sockargs} { - package require Thread + package require Thread 2.8.9- set catchCode [catch {eval $defcmd $sockargs} sock errdict] if {$catchCode == 0} { diff --git a/tests/httpProxy.test b/tests/httpProxy.test index ae926ff..24b6e8c 100644 --- a/tests/httpProxy.test +++ b/tests/httpProxy.test @@ -7,7 +7,7 @@ # Copyright © 1991-1993 The Regents of the University of California. # Copyright © 1994-1996 Sun Microsystems, Inc. # Copyright © 1998-2000 Ajuba Solutions. -# Copyright © 2022 Keith Nash. +# Copyright © 2022-2023 Keith Nash. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -30,9 +30,9 @@ proc bgerror {args} { proc stopMe {token} { set ${token}(z) done } - +#set ThreadLevel 0 if {![info exists ThreadLevel]} { - if {[catch {package require Thread}] == 0} { + if {[catch {package require Thread 2.8.9-}] == 0} { set ValueRange {0 1 2} } else { set ValueRange {0 1} @@ -51,14 +51,52 @@ if {![info exists ThreadLevel]} { catch {puts "==== Test with ThreadLevel $ThreadLevel ===="} http::config -threadlevel $ThreadLevel - -#testConstraint needsSquid 1 -#testConstraint needsTls 1 - -if {[testConstraint needsTls]} { +testConstraint needsSquidNoAuth 0 +testConstraint needsSquidAuth 0 +testConstraint needsTclTls 0 +testConstraint needsTwapi 0 +testConstraint needsTwapiFull 0 +testConstraint needsTls [expr { [testConstraint needsTclTls] + || [testConstraint needsTwapi] + || [testConstraint needsTwapiFull] + }] + +if {[testConstraint needsTclTls]} { package require tls http::register https 443 [list ::tls::socket -ssl2 0 -ssl3 0 \ -tls1 0 -tls1.1 0 -tls1.2 1 -tls1.3 0 -autoservername 1] ::tls::socketCmd 1 1 +} elseif {[testConstraint needsTwapi]} { + # "Original" http::register with 3 arguments has the same capabilities as + # in http 2.9 and earlier. This means that: + # (1) it cannot open a socket in a background thread (this option stops a + # slow DNS lookup from blocking a [socket -async] command); and + # (2) it cannot use a https proxy. + # + testConstraint needsSquidNoAuth 0 + testConstraint needsSquidAuth 0 + package require twapi + http::register https 443 ::twapi::tls_socket +} elseif {[testConstraint needsTwapiFull]} { + # (Any revisions to TWAPI, and the contents/existence of the twapiTlsPlus + # wrapper, can be negotiated if the bugs listed below can be fixed.) + # Use a temporary wrapper package twapiTlsPlus to present a suitable API. + # + # N.B. MUST EDIT twapi*/tls.tcl so that + #- set so [$socketcmd {*}$socket_args {*}$args] + #+ set so [{*}$socketcmd {*}$socket_args {*}$args] + # + # Bug with https, threadLevel 1,2, no proxy: try test 'httpProxy-2.2.*' + # Bug with https, threadLevel 0, with proxy: try test 'httpProxy-3.4.0' + # In both cases (using TWAPI 4.7.2 25d8bc), the result is: + # ---- Test generated error; Return code was: 1 + # ---- Return code should have been one of: 0 2 + # ---- errorInfo: cannot yield: C stack busy + # while executing + # "http::geturl https://www.google.com/" + # + package require twapiTlsPlus + http::register https 443 ::twapiTlsPlus::socket ::twapiTlsPlus::socketCmd 1 1 +} else { } # Testing with Squid @@ -86,7 +124,7 @@ set aliceCreds {Basic YWxpY2U6YWxpY2lh} # concat Basic [base64::encode intruder:intruder] set badCreds {Basic aW50cnVkZXI6aW50cnVkZXI=} -test httpProxy-1.1.$ThreadLevel {squid is running - ipv4 noauth} -constraints {needsSquid} -setup { +test httpProxy-1.1.$ThreadLevel {squid is running - ipv4 no-auth} -constraints {needsSquidNoAuth} -setup { } -body { set token [http::geturl http://$n4host:$n4port/] set ri [http::responseInfo $token] @@ -97,7 +135,7 @@ test httpProxy-1.1.$ThreadLevel {squid is running - ipv4 noauth} -constraints {n unset -nocomplain token ri res } -test httpProxy-1.2.$ThreadLevel {squid is running - ipv6 noauth} -constraints {needsSquid} -setup { +test httpProxy-1.2.$ThreadLevel {squid is running - ipv6 no-auth} -constraints {needsSquidNoAuth} -setup { } -body { set token [http::geturl http://\[$n6host\]:$n6port/] set ri [http::responseInfo $token] @@ -108,7 +146,7 @@ test httpProxy-1.2.$ThreadLevel {squid is running - ipv6 noauth} -constraints {n unset -nocomplain token ri res } -test httpProxy-1.3.$ThreadLevel {squid is running - ipv4 auth} -constraints {needsSquid} -setup { +test httpProxy-1.3.$ThreadLevel {squid is running - ipv4 with-auth} -constraints {needsSquidAuth} -setup { } -body { set token [http::geturl http://$a4host:$a4port/] set ri [http::responseInfo $token] @@ -119,7 +157,7 @@ test httpProxy-1.3.$ThreadLevel {squid is running - ipv4 auth} -constraints {nee unset -nocomplain token ri res } -test httpProxy-1.4.$ThreadLevel {squid is running - ipv6 auth} -constraints {needsSquid} -setup { +test httpProxy-1.4.$ThreadLevel {squid is running - ipv6 with-auth} -constraints {needsSquidAuth} -setup { } -body { set token [http::geturl http://\[$a6host\]:$a6port/] set ri [http::responseInfo $token] @@ -130,7 +168,7 @@ test httpProxy-1.4.$ThreadLevel {squid is running - ipv6 auth} -constraints {nee unset -nocomplain token ri res } -test httpProxy-2.1.$ThreadLevel {http no-proxy no-auth} -constraints {needsSquid} -setup { +test httpProxy-2.1.$ThreadLevel {http no-proxy no-auth} -constraints {} -setup { http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -body { set token [http::geturl http://www.google.com/] @@ -143,7 +181,7 @@ test httpProxy-2.1.$ThreadLevel {http no-proxy no-auth} -constraints {needsSquid unset -nocomplain token ri res } -test httpProxy-2.2.$ThreadLevel {https no-proxy no-auth} -constraints {needsSquid needsTls} -setup { +test httpProxy-2.2.$ThreadLevel {https no-proxy no-auth} -constraints {needsTls} -setup { http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -body { set token [http::geturl https://www.google.com/] @@ -156,7 +194,7 @@ test httpProxy-2.2.$ThreadLevel {https no-proxy no-auth} -constraints {needsSqui unset -nocomplain token ri res } -test httpProxy-2.3.$ThreadLevel {http with-proxy ipv4 no-auth} -constraints {needsSquid} -setup { +test httpProxy-2.3.$ThreadLevel {http with-proxy ipv4 no-auth} -constraints {needsSquidNoAuth} -setup { http::config -proxyhost $n4host -proxyport $n4port -proxynot {127.0.0.1 localhost} -proxyauth {} } -body { set token [http::geturl http://www.google.com/] @@ -170,7 +208,7 @@ test httpProxy-2.3.$ThreadLevel {http with-proxy ipv4 no-auth} -constraints {nee http::config -proxyhost {} -proxyport {} -proxynot {} } -test httpProxy-2.4.$ThreadLevel {https with-proxy ipv4 no-auth} -constraints {needsSquid needsTls} -setup { +test httpProxy-2.4.$ThreadLevel {https with-proxy ipv4 no-auth} -constraints {needsSquidNoAuth needsTls} -setup { http::config -proxyhost $n4host -proxyport $n4port -proxynot {127.0.0.1 localhost} -proxyauth {} } -body { set token [http::geturl https://www.google.com/] @@ -184,7 +222,7 @@ test httpProxy-2.4.$ThreadLevel {https with-proxy ipv4 no-auth} -constraints {ne http::config -proxyhost {} -proxyport {} -proxynot {} } -test httpProxy-2.5.$ThreadLevel {http with-proxy ipv6 no-auth} -constraints {needsSquid} -setup { +test httpProxy-2.5.$ThreadLevel {http with-proxy ipv6 no-auth} -constraints {needsSquidNoAuth} -setup { http::config -proxyhost $n6host -proxyport $n6port -proxynot {::1 localhost} -proxyauth {} } -body { set token [http::geturl http://www.google.com/] @@ -198,7 +236,7 @@ test httpProxy-2.5.$ThreadLevel {http with-proxy ipv6 no-auth} -constraints {nee http::config -proxyhost {} -proxyport {} -proxynot {} } -test httpProxy-2.6.$ThreadLevel {https with-proxy ipv6 no-auth} -constraints {needsSquid needsTls} -setup { +test httpProxy-2.6.$ThreadLevel {https with-proxy ipv6 no-auth} -constraints {needsSquidNoAuth needsTls} -setup { http::config -proxyhost $n6host -proxyport $n6port -proxynot {::1 localhost} -proxyauth {} } -body { set token [http::geturl https://www.google.com/] @@ -212,7 +250,7 @@ test httpProxy-2.6.$ThreadLevel {https with-proxy ipv6 no-auth} -constraints {ne http::config -proxyhost {} -proxyport {} -proxynot {} } -test httpProxy-3.1.$ThreadLevel {http no-proxy with-auth valid-creds-provided} -constraints {needsSquid} -setup { +test httpProxy-3.1.$ThreadLevel {http no-proxy with-auth valid-creds-provided} -constraints {} -setup { http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds } -body { set token [http::geturl http://www.google.com/] @@ -228,7 +266,7 @@ test httpProxy-3.1.$ThreadLevel {http no-proxy with-auth valid-creds-provided} - http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.2.$ThreadLevel {https no-proxy with-auth valid-creds-provided} -constraints {needsSquid needsTls} -setup { +test httpProxy-3.2.$ThreadLevel {https no-proxy with-auth valid-creds-provided} -constraints {needsTls} -setup { http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds } -body { set token [http::geturl https://www.google.com/] @@ -244,7 +282,7 @@ test httpProxy-3.2.$ThreadLevel {https no-proxy with-auth valid-creds-provided} http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.3.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-provided} -constraints {needsSquid} -setup { +test httpProxy-3.3.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-provided} -constraints {needsSquidAuth} -setup { http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds } -body { set token [http::geturl http://www.google.com/] @@ -260,7 +298,7 @@ test httpProxy-3.3.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-prov http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.4.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-provided} -constraints {needsSquid needsTls} -setup { +test httpProxy-3.4.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-provided} -constraints {needsSquidAuth needsTls} -setup { http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds } -body { set token [http::geturl https://www.google.com/] @@ -276,7 +314,7 @@ test httpProxy-3.4.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-pro http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.5.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-provided} -constraints {needsSquid} -setup { +test httpProxy-3.5.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-provided} -constraints {needsSquidAuth} -setup { http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds } -body { set token [http::geturl http://www.google.com/] @@ -292,7 +330,7 @@ test httpProxy-3.5.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-prov http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.6.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided} -constraints {needsSquid needsTls} -setup { +test httpProxy-3.6.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided} -constraints {needsSquidAuth needsTls} -setup { http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds } -body { set token [http::geturl https://www.google.com/] @@ -308,7 +346,7 @@ test httpProxy-3.6.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-pro http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.7.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquid} -setup { +test httpProxy-3.7.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] @@ -334,7 +372,7 @@ test httpProxy-3.7.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-prov http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.7x.$ThreadLevel {http with-proxy ipv4 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquid} -setup { +test httpProxy-3.7x.$ThreadLevel {http with-proxy ipv4 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] @@ -362,7 +400,7 @@ test httpProxy-3.7x.$ThreadLevel {http with-proxy ipv4 with-auth 1st request no- http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.8.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquid needsTls} -setup { +test httpProxy-3.8.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquidAuth needsTls} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] @@ -390,7 +428,7 @@ test httpProxy-3.8.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-pro http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.8x.$ThreadLevel {https with-proxy ipv4 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquid needsTls} -setup { +test httpProxy-3.8x.$ThreadLevel {https with-proxy ipv4 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquidAuth needsTls} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] @@ -420,7 +458,7 @@ test httpProxy-3.8x.$ThreadLevel {https with-proxy ipv4 with-auth 1st request no http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.9.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquid} -setup { +test httpProxy-3.9.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] @@ -446,7 +484,7 @@ test httpProxy-3.9.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-prov http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.9p.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works, pipelining requested and possible} -constraints {needsSquid} -setup { +test httpProxy-3.9p.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works, pipelining requested and possible} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds } -body { @@ -477,7 +515,7 @@ after idle { http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.9x.$ThreadLevel {http with-proxy ipv6 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquid} -setup { +test httpProxy-3.9x.$ThreadLevel {http with-proxy ipv6 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] @@ -505,7 +543,7 @@ test httpProxy-3.9x.$ThreadLevel {http with-proxy ipv6 with-auth 1st request no- http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.10.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquid needsTls} -setup { +test httpProxy-3.10.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquidAuth needsTls} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] @@ -533,7 +571,7 @@ test httpProxy-3.10.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-pr http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.10p.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works, pipelining requested and possible} -constraints {needsSquid needsTls} -setup { +test httpProxy-3.10p.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works, pipelining requested and possible} -constraints {needsSquidAuth needsTls} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds } -body { @@ -566,7 +604,7 @@ after idle { http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.10x.$ThreadLevel {https with-proxy ipv6 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquid needsTls} -setup { +test httpProxy-3.10x.$ThreadLevel {https with-proxy ipv6 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquidAuth needsTls} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] @@ -596,7 +634,7 @@ test httpProxy-3.10x.$ThreadLevel {https with-proxy ipv6 with-auth 1st request n http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.1.$ThreadLevel {http no-proxy with-auth no-creds-provided} -constraints {needsSquid} -setup { +test httpProxy-4.1.$ThreadLevel {http no-proxy with-auth no-creds-provided} -constraints {} -setup { http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} } -body { set token [http::geturl http://www.google.com/] @@ -612,7 +650,7 @@ test httpProxy-4.1.$ThreadLevel {http no-proxy with-auth no-creds-provided} -con http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.2.$ThreadLevel {https no-proxy with-auth no-creds-provided} -constraints {needsSquid needsTls} -setup { +test httpProxy-4.2.$ThreadLevel {https no-proxy with-auth no-creds-provided} -constraints {needsTls} -setup { http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} } -body { set token [http::geturl https://www.google.com/] @@ -628,7 +666,7 @@ test httpProxy-4.2.$ThreadLevel {https no-proxy with-auth no-creds-provided} -co http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.3.$ThreadLevel {http with-proxy ipv4 with-auth no-creds-provided} -constraints {needsSquid} -setup { +test httpProxy-4.3.$ThreadLevel {http with-proxy ipv4 with-auth no-creds-provided} -constraints {needsSquidAuth} -setup { http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} } -body { set token [http::geturl http://www.google.com/] @@ -644,7 +682,7 @@ test httpProxy-4.3.$ThreadLevel {http with-proxy ipv4 with-auth no-creds-provide http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.4.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provided} -constraints {needsSquid needsTls} -setup { +test httpProxy-4.4.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provided} -constraints {needsSquidAuth needsTls} -setup { http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} } -body { set token [http::geturl https://www.google.com/] @@ -660,7 +698,7 @@ test httpProxy-4.4.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provid http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.5.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provided} -constraints {needsSquid} -setup { +test httpProxy-4.5.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provided} -constraints {needsSquidAuth} -setup { http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} } -body { set token [http::geturl http://www.google.com/] @@ -676,7 +714,7 @@ test httpProxy-4.5.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provide http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.6.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided} -constraints {needsSquid needsTls} -setup { +test httpProxy-4.6.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided} -constraints {needsSquidAuth needsTls} -setup { http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} } -body { set token [http::geturl https://www.google.com/] @@ -692,7 +730,7 @@ test httpProxy-4.6.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provid http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.7.$ThreadLevel {http with-proxy ipv4 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquid} -setup { +test httpProxy-4.7.$ThreadLevel {http with-proxy ipv4 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] @@ -718,7 +756,7 @@ test httpProxy-4.7.$ThreadLevel {http with-proxy ipv4 with-auth no-creds-provide http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.8.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquid needsTls} -setup { +test httpProxy-4.8.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth needsTls} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] @@ -746,7 +784,7 @@ test httpProxy-4.8.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provid http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.9.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquid} -setup { +test httpProxy-4.9.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] @@ -772,7 +810,7 @@ test httpProxy-4.9.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provide http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.9p.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible, pipelining requested and possible} -constraints {needsSquid} -setup { +test httpProxy-4.9p.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible, pipelining requested and possible} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} } -body { @@ -803,7 +841,7 @@ after idle { http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.10.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquid needsTls} -setup { +test httpProxy-4.10.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth needsTls} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] @@ -831,7 +869,7 @@ test httpProxy-4.10.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provi http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.10p.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible, pipelining requested but not possible} -constraints {needsSquid needsTls} -setup { +test httpProxy-4.10p.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible, pipelining requested but not possible} -constraints {needsSquidAuth needsTls} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} } -body { @@ -865,7 +903,7 @@ after idle { http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.1.$ThreadLevel {http no-proxy with-auth bad-creds-provided} -constraints {needsSquid} -setup { +test httpProxy-5.1.$ThreadLevel {http no-proxy with-auth bad-creds-provided} -constraints {} -setup { http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds } -body { set token [http::geturl http://www.google.com/] @@ -881,7 +919,7 @@ test httpProxy-5.1.$ThreadLevel {http no-proxy with-auth bad-creds-provided} -co http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.2.$ThreadLevel {https no-proxy with-auth bad-creds-provided} -constraints {needsSquid needsTls} -setup { +test httpProxy-5.2.$ThreadLevel {https no-proxy with-auth bad-creds-provided} -constraints {needsTls} -setup { http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds } -body { set token [http::geturl https://www.google.com/] @@ -897,7 +935,7 @@ test httpProxy-5.2.$ThreadLevel {https no-proxy with-auth bad-creds-provided} -c http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.3.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provided} -constraints {needsSquid} -setup { +test httpProxy-5.3.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provided} -constraints {needsSquidAuth} -setup { http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds } -body { set token [http::geturl http://www.google.com/] @@ -913,7 +951,7 @@ test httpProxy-5.3.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provid http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.4.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided} -constraints {needsSquid needsTls} -setup { +test httpProxy-5.4.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided} -constraints {needsSquidAuth needsTls} -setup { http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds } -body { set token [http::geturl https://www.google.com/] @@ -929,7 +967,7 @@ test httpProxy-5.4.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provi http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.5.$ThreadLevel {http with-proxy ipv6 with-auth bad-creds-provided} -constraints {needsSquid} -setup { +test httpProxy-5.5.$ThreadLevel {http with-proxy ipv6 with-auth bad-creds-provided} -constraints {needsSquidAuth} -setup { http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds } -body { set token [http::geturl http://www.google.com/] @@ -945,7 +983,7 @@ test httpProxy-5.5.$ThreadLevel {http with-proxy ipv6 with-auth bad-creds-provid http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.6.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provided} -constraints {needsSquid needsTls} -setup { +test httpProxy-5.6.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provided} -constraints {needsSquidAuth needsTls} -setup { http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds } -body { set token [http::geturl https://www.google.com/] @@ -961,7 +999,7 @@ test httpProxy-5.6.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provi http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.7.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquid} -setup { +test httpProxy-5.7.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] @@ -987,7 +1025,7 @@ test httpProxy-5.7.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provid http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.7p.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible, pipelining requested and possible} -constraints {needsSquid} -setup { +test httpProxy-5.7p.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible, pipelining requested and possible} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds } -body { @@ -1018,7 +1056,7 @@ after idle { http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.8.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquid needsTls} -setup { +test httpProxy-5.8.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth needsTls} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] @@ -1046,7 +1084,7 @@ test httpProxy-5.8.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provi http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.8p.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible, pipelining requested but not possible} -constraints {needsSquid needsTls} -setup { +test httpProxy-5.8p.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible, pipelining requested but not possible} -constraints {needsSquidAuth needsTls} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds } -body { @@ -1079,7 +1117,7 @@ after idle { http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.9.$ThreadLevel {http with-proxy ipv6 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquid} -setup { +test httpProxy-5.9.$ThreadLevel {http with-proxy ipv6 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] @@ -1105,7 +1143,7 @@ test httpProxy-5.9.$ThreadLevel {http with-proxy ipv6 with-auth bad-creds-provid http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.10.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquid needsTls} -setup { +test httpProxy-5.10.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth needsTls} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] -- cgit v0.12 From 067f32ee6679577192be41b0bfef2f6179097586 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 13 Dec 2023 12:19:01 +0000 Subject: twice ClientData -> void * (for consistancy) --- generic/tclCmdIL.c | 2 +- win/tclWinChan.c | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 18842a1..c759a54 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -4470,7 +4470,7 @@ Tcl_LseqObjCmd( int Tcl_LsetObjCmd( - TCL_UNUSED(ClientData), + TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 7b4caf0..8743afe 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -80,7 +80,7 @@ static int FileCloseProc(void *instanceData, static int FileEventProc(Tcl_Event *evPtr, int flags); static int FileGetHandleProc(void *instanceData, int direction, void **handlePtr); -static int FileGetOptionProc(ClientData instanceData, +static int FileGetOptionProc(void *instanceData, Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); static ThreadSpecificData *FileInit(void); @@ -894,7 +894,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. */ -- cgit v0.12 From 6738c19e8a8fd9fa35867ece49a1ef7121fd81ea Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 13 Dec 2023 16:29:49 +0000 Subject: [f6f93c3b39] Missing refcount decrement to cleanup read space on io error. --- generic/tclIOCmd.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 9667419..808ce97 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -464,6 +464,8 @@ Tcl_ReadObjCmd( returnOptsPtr = Tcl_NewDictObj(); Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-data", -1), resultPtr); + } else { + Tcl_DecrRefCount(resultPtr); } /* * TIP #219. -- cgit v0.12 From 3a1aabd4bc89f8d49699ff091844e22ea49293d6 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 15 Dec 2023 17:55:50 +0000 Subject: test suite debugging --- tests/fileSystem.test | 2 +- tests/io.test | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/fileSystem.test b/tests/fileSystem.test index da3eb35..5f841b5 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -281,7 +281,7 @@ test filesystem-1.30.3 {file normalization should distinguish between ~ and ~use set olduserhome [file home $::tcl_platform(user)] set ::env(HOME) [file join $oldhome temp] } -cleanup { - set env(HOME) $oldhome + set ::env(HOME) $oldhome } -body { list [string equal [file home] $::env(HOME)] \ [string equal $olduserhome [file home $::tcl_platform(user)]] diff --git a/tests/io.test b/tests/io.test index c11f325..86a871b 100644 --- a/tests/io.test +++ b/tests/io.test @@ -9858,7 +9858,7 @@ test io-77.2 {open pipe encoding mismatch - use replace profile} -setup { # cleanup -foreach file [list fooBar longfile script script2 output test1 pipe my_script \ +foreach file [list fooBar longfile script2 output test1 pipe my_script \ test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { removeFile $file } -- cgit v0.12 From 319ab9635ed6687cd536c1cd0d4dcbd18b3c08d6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 15 Dec 2023 22:05:09 +0000 Subject: (cherry-pick) test suite debugging --- tests/fileSystem.test | 2 +- tests/io.test | 572 +++++++++++++++++++++++++------------------------- 2 files changed, 287 insertions(+), 287 deletions(-) diff --git a/tests/fileSystem.test b/tests/fileSystem.test index f825e2b..4c406a1 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -282,7 +282,7 @@ test filesystem-1.30.3 {file normalization should distinguish between ~ and ~use set olduserhome [file normalize ~$::tcl_platform(user)] set ::env(HOME) [file join $oldhome temp] } -cleanup { - set env(HOME) $oldhome + set ::env(HOME) $oldhome } -body { list [string equal [file normalize ~] $::env(HOME)] \ [string equal $olduserhome [file normalize ~$::tcl_platform(user)]] diff --git a/tests/io.test b/tests/io.test index 50a6018..6a31308 100644 --- a/tests/io.test +++ b/tests/io.test @@ -117,7 +117,7 @@ test io-1.6 {Tcl_WriteChars: WriteBytes} { test io-1.7 {Tcl_WriteChars: WriteChars} { set f [open $path(test1) w] fconfigure $f -encoding shiftjis - puts -nonewline $f "a\u4e4d\x00" + puts -nonewline $f "a\u4E4D\x00" close $f contents $path(test1) } "a\x93\xE1\x00" @@ -1474,67 +1474,67 @@ test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} { } "{} timeout {} timeout \u7266 {} eof 0 {}" test io-12.6 {ReadChars: too many chars read} { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [encoding convertto utf-8 \ - [string repeat \uBEEF 20][string repeat . 20]] - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + [string repeat \uBEEF 20][string repeat . 20]] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 while {![eof $c]} { - read $c 15 + read $c 15 } close $c } {} test io-12.7 {ReadChars: too many chars read [bc5b790099]} { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [encoding convertto utf-8 \ - [string repeat \uBEEF 10]....\uBEEF] - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + [string repeat \uBEEF 10]....\uBEEF] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 while {![eof $c]} { - read $c 7 + read $c 7 } close $c } {} @@ -1925,7 +1925,7 @@ test io-14.9 {reuse of stdio special channels} {stdio fileevent} { file delete $path(test1) set f [open $path(script) w] puts $f { - array set path [lindex $argv 0] + array set path [lindex $argv 0] set f [open $path(test1) w] puts $f hello close $f @@ -2272,7 +2272,7 @@ test io-27.6 {FlushChannel, async flushing, async close} \ close $f set x 01234567890123456789012345678901 for {set i 0} {$i < 11} {incr i} { - set x "$x$x" + set x "$x$x" } set f [open $path(output) w] close $f @@ -2286,9 +2286,9 @@ test io-27.6 {FlushChannel, async flushing, async close} \ vwait [namespace which -variable counter] } if {$counter == 1000} { - set result "file size only [file size $path(output)]" + set result "file size only [file size $path(output)]" } else { - set result ok + set result ok } } ok @@ -2347,7 +2347,7 @@ test io-28.3 {CloseChannel, not called before output queue is empty} \ close $f set x 01234567890123456789012345678901 for {set i 0} {$i < 11} {incr i} { - set x "$x$x" + set x "$x$x" } set f [open $path(output) w] close $f @@ -2362,9 +2362,9 @@ test io-28.3 {CloseChannel, not called before output queue is empty} \ vwait [namespace which -variable counter] } if {$counter == 1000} { - set result probably_broken + set result probably_broken } else { - set result ok + set result ok } } ok test io-28.4 Tcl_Close testchannel { @@ -4484,29 +4484,29 @@ test io-33.10 {Tcl_Gets, exercising double buffering} { } 300 test io-33.11 {TclGetsObjBinary, [10dc6daa37]} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) ....... - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) ....... + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] if {$n > 3} {set n 3} - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } } -body { set c [chan create read [namespace which driver]] @@ -4518,29 +4518,29 @@ test io-33.11 {TclGetsObjBinary, [10dc6daa37]} -setup { } -result {{} {} {} .......} test io-33.12 {Tcl_GetsObj, [10dc6daa37]} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) ....... - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) ....... + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] if {$n > 3} {set n 3} - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } } -body { set c [chan create read [namespace which driver]] @@ -4552,30 +4552,30 @@ test io-33.12 {Tcl_GetsObj, [10dc6daa37]} -setup { } -result {{} {} {} .......} test io-33.13 {Tcl_GetsObj, [10dc6daa37]} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [string repeat \ - [string repeat . 64]\n[string repeat . 25] 2] - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] - if {$n > 65} {set n 65} - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [string repeat \ + [string repeat . 64]\n[string repeat . 25] 2] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + if {$n > 65} {set n 65} + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } } -body { set c [chan create read [namespace which driver]] @@ -5296,8 +5296,8 @@ test io-36.3 {Tcl_InputBlocked vs files, short read} { } {0 abc 0 defghijklmnop 0 1} test io-36.4 {Tcl_InputBlocked vs files, event driven read} {fileevent} { proc in {f} { - variable l - variable x + variable l + variable x lappend l [read $f 3] if {[eof $f]} {lappend l eof; close $f; set x done} } @@ -5332,8 +5332,8 @@ test io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles } {0 abc 0 defghijklmnop 0 1} test io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles fileevent} { proc in {f} { - variable l - variable x + variable l + variable x lappend l [read $f 3] if {[eof $f]} {lappend l eof; close $f; set x done} } @@ -5722,7 +5722,7 @@ test io-39.22a {Tcl_SetChannelOption, invariance} { set l } {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}} test io-39.23 {Tcl_GetChannelOption, server socket is not readable or - writable, it should still have valid -eofchar and -translation options } { + writable, it should still have valid -eofchar and -translation options } { set l [list] set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0] lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation] @@ -5730,7 +5730,7 @@ test io-39.23 {Tcl_GetChannelOption, server socket is not readable or set l } {{{}} auto} test io-39.24 {Tcl_SetChannelOption, server socket is not readable or - writable so we can't change -eofchar or -translation } { + writable so we can't change -eofchar or -translation } { set l [list] set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0] fconfigure $sock -eofchar D -translation lf @@ -6164,23 +6164,23 @@ test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent not test io-46.2 {Tcl event loop vs multiple interpreters} testfevent { testfevent create testfevent cmd { - variable x 0 - after 100 {set x triggered} - vwait [namespace which -variable x] - set x + variable x 0 + after 100 {set x triggered} + vwait [namespace which -variable x] + set x } } {triggered} test io-46.3 {Tcl event loop vs multiple interpreters} testfevent { testfevent create testfevent cmd { - set x 0 - after 10 {lappend x timer} - after 30 - set result $x - update idletasks - lappend result $x - update - lappend result $x + set x 0 + after 10 {lappend x timer} + after 30 + set result $x + update idletasks + lappend result $x + update + lappend result $x } } {0 0 {0 timer}} @@ -6197,7 +6197,7 @@ test io-47.1 {fileevent vs multiple interpreters} {testfevent fileevent} { lappend x [fileevent $f2 readable] testfevent delete lappend x [fileevent $f readable] [fileevent $f2 readable] \ - [fileevent $f3 readable] + [fileevent $f3 readable] close $f close $f2 close $f3 @@ -6213,11 +6213,11 @@ test io-47.2 {deleting fileevent on interpreter delete} {testfevent fileevent} { testfevent share $f2 testfevent share $f3 testfevent cmd "fileevent $f2 readable {script 2} - fileevent $f3 readable {script 3}" + fileevent $f3 readable {script 3}" fileevent $f4 readable {script 4} testfevent delete set x [list [fileevent $f readable] [fileevent $f2 readable] \ - [fileevent $f3 readable] [fileevent $f4 readable]] + [fileevent $f3 readable] [fileevent $f4 readable]] close $f close $f2 close $f3 @@ -6235,10 +6235,10 @@ test io-47.3 {deleting fileevent on interpreter delete} {testfevent fileevent} { fileevent $f readable {script 1} fileevent $f2 readable {script 2} testfevent cmd "fileevent $f3 readable {script 3} - fileevent $f4 readable {script 4}" + fileevent $f4 readable {script 4}" testfevent delete set x [list [fileevent $f readable] [fileevent $f2 readable] \ - [fileevent $f3 readable] [fileevent $f4 readable]] + [fileevent $f3 readable] [fileevent $f4 readable]] close $f close $f2 close $f3 @@ -6254,8 +6254,8 @@ test io-47.4 {file events on shared files and multiple interpreters} {testfevent fileevent $f readable {script 2} fileevent $f2 readable {script 3} set x [list [fileevent $f2 readable] \ - [testfevent cmd "fileevent $f readable"] \ - [fileevent $f readable]] + [testfevent cmd "fileevent $f readable"] \ + [fileevent $f readable]] testfevent delete close $f close $f2 @@ -6269,7 +6269,7 @@ test io-47.5 {file events on shared files, deleting file events} {testfevent fil fileevent $f readable {script 2} testfevent cmd "fileevent $f readable {}" set x [list [testfevent cmd "fileevent $f readable"] \ - [fileevent $f readable]] + [fileevent $f readable]] testfevent delete close $f set x @@ -6282,7 +6282,7 @@ test io-47.6 {file events on shared files, deleting file events} {testfevent fil fileevent $f readable {script 2} fileevent $f readable {} set x [list [testfevent cmd "fileevent $f readable"] \ - [fileevent $f readable]] + [fileevent $f readable]] testfevent delete close $f set x @@ -7125,7 +7125,7 @@ test io-52.3 {TclCopyChannel} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {("$s1" == "$s2") && ($s0 == $s1)} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7166,7 +7166,7 @@ test io-52.5 {TclCopyChannel, all} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {"$s1" == "$s2"} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7183,7 +7183,7 @@ test io-52.5a {TclCopyChannel, all, other negative value} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {"$s1" == "$s2"} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7200,7 +7200,7 @@ test io-52.5b {TclCopyChannel, all, wrap to negative value} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {"$s1" == "$s2"} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7217,7 +7217,7 @@ test io-52.6 {TclCopyChannel} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {("$s1" == "$s2") && ($s0 == $s1)} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7234,7 +7234,7 @@ test io-52.7 {TclCopyChannel} {fcopy} { close $f1 close $f2 if {"$s1" == "$s2"} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7514,7 +7514,7 @@ test io-53.2 {CopyData} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {("$s1" == "$s2") && ($s0 == $s1)} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7669,8 +7669,8 @@ proc doFcopy {in out {bytes 0} {error {}}} { } elseif {[eof $in]} { set fcopyTestDone 0 } else { - # Delay next fcopy to wait for size>0 input bytes - after 100 [list fcopy $in $out -size 1000 \ + # Delay next fcopy to wait for size>0 input bytes + after 100 [list fcopy $in $out -size 1000 \ -command [namespace code [list doFcopy $in $out]]] } } @@ -7685,9 +7685,9 @@ test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio fcopy} { proc Write {count} { puts -nonewline "1234567890" if {[incr count -1]} { - after 10 [list Write $count] + after 10 [list Write $count] } else { - set ::ready 1 + set ::ready 1 } } fconfigure stdout -buffering none @@ -7915,7 +7915,7 @@ test io-53.10 {Bug 1350564, multi-directional fcopy} -setup { puts stderr SRV set l {} set srv [socket -server new -myaddr 127.0.0.1 0] - set port [lindex [fconfigure $srv -sockname] 2] + set port [lindex [fconfigure $srv -sockname] 2] puts stderr WAITING fileevent stdin readable bye puts "OK $port" @@ -8004,21 +8004,21 @@ test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix fc } {ok A} test io-53.13 {TclCopyChannel: read error reporting} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - return {initialize finalize watch read} - } - finalize { - return - } - watch {} - read { + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + return {initialize finalize watch read} + } + finalize { + return + } + watch {} + read { error FAIL - } - } + } + } } set outFile [makeFile {} out] } -body { @@ -8034,21 +8034,21 @@ test io-53.13 {TclCopyChannel: read error reporting} -setup { } -result {error reading "*": *} -returnCodes error -match glob test io-53.14 {TclCopyChannel: write error reporting} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - return {initialize finalize watch write} - } - finalize { - return - } - watch {} - write { - error FAIL - } - } + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + return {initialize finalize watch write} + } + finalize { + return + } + watch {} + write { + error FAIL + } + } } set inFile [makeFile {aaa} in] } -body { @@ -8064,35 +8064,35 @@ test io-53.14 {TclCopyChannel: write error reporting} -setup { } -result {error writing "*": *} -returnCodes error -match glob test io-53.15 {[ed29c4da21] DoRead: fblocked seen as error} -setup { proc driver {cmd args} { - variable buffer - variable index - variable blocked - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [encoding convertto utf-8 \ - [string repeat a 100]] - set blocked($chan) 1 - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) blocked($chan) - return - } - watch {} - read { - if {$blocked($chan)} { - set blocked($chan) [expr {!$blocked($chan)}] - return -code error EAGAIN - } - set n [lindex $args 1] - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + variable blocked + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + [string repeat a 100]] + set blocked($chan) 1 + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) blocked($chan) + return + } + watch {} + read { + if {$blocked($chan)} { + set blocked($chan) [expr {!$blocked($chan)}] + return -code error EAGAIN + } + set n [lindex $args 1] + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 @@ -8108,35 +8108,35 @@ test io-53.15 {[ed29c4da21] DoRead: fblocked seen as error} -setup { } -result 100 test io-53.16 {[ed29c4da21] MBRead: fblocked seen as error} -setup { proc driver {cmd args} { - variable buffer - variable index - variable blocked - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [encoding convertto utf-8 \ - [string repeat a 100]] - set blocked($chan) 1 - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) blocked($chan) - return - } - watch {} - read { - if {$blocked($chan)} { - set blocked($chan) [expr {!$blocked($chan)}] - return -code error EAGAIN - } - set n [lindex $args 1] - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + variable blocked + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + [string repeat a 100]] + set blocked($chan) 1 + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) blocked($chan) + return + } + watch {} + read { + if {$blocked($chan)} { + set blocked($chan) [expr {!$blocked($chan)}] + return -code error EAGAIN + } + set n [lindex $args 1] + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 -translation lf @@ -8152,29 +8152,29 @@ test io-53.16 {[ed29c4da21] MBRead: fblocked seen as error} -setup { } -result 100 test io-53.17 {[7c187a3773] MBWrite: proper inQueueTail handling} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [encoding convertto utf-8 \ - line\n[string repeat a 100]line\n] - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + line\n[string repeat a 100]line\n] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 -translation lf -buffersize 107 @@ -8802,7 +8802,7 @@ test io-73.5 {effect of eof on encoding end flags} -setup { read $rfd } -body { set result [eof $rfd] - puts -nonewline $wfd "more\u00C2\u00A0data" + puts -nonewline $wfd more\u00C2\u00A0data lappend result [eof $rfd] lappend result [read $rfd] lappend result [eof $rfd] @@ -8839,7 +8839,7 @@ test io-75.1 {multibyte encoding error read results in raw bytes} -setup { fconfigure $f -encoding binary # In UTF-8, a byte 0xCx starts a multibyte sequence and must be followed # by a byte > 0x7F. This is violated to get an invalid sequence. - puts -nonewline $f "A\xC0\x40" + puts -nonewline $f A\xC0\x40 flush $f seek $f 0 fconfigure $f -encoding utf-8 -buffering none @@ -8850,7 +8850,7 @@ test io-75.1 {multibyte encoding error read results in raw bytes} -setup { } -cleanup { close $f removeFile io-75.1 -} -result "41c040" +} -result 41c040 test io-75.2 {unrepresentable character write passes and is replaced by ?} -setup { set fn [makeFile {} io-75.2] @@ -8864,7 +8864,7 @@ test io-75.2 {unrepresentable character write passes and is replaced by ?} -setu } -cleanup { close $f removeFile io-75.2 -} -result "A?" +} -result A? # Incomplete sequence test. # This error may IMHO only be detected with the close. @@ -8879,12 +8879,12 @@ test io-75.3 {incomplete multibyte encoding read is ignored} -setup { fconfigure $f -encoding utf-8 -buffering none } -body { set d [read $f] - close $f binary scan $d H* hd set hd } -cleanup { + close $f removeFile io-75.3 -} -result "41c0" +} -result 41c0 # As utf-8 has a special treatment in multi-byte decoding, also test another # one. @@ -8894,7 +8894,7 @@ test io-75.4 {shiftjis encoding error read results in raw bytes} -setup { fconfigure $f -encoding binary # In shiftjis, \x81 starts a two-byte sequence. # But 2nd byte \xFF is not allowed - puts -nonewline $f "A\x81\xFFA" + puts -nonewline $f A\x81\xFFA flush $f seek $f 0 fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf @@ -8905,31 +8905,31 @@ test io-75.4 {shiftjis encoding error read results in raw bytes} -setup { } -cleanup { close $f removeFile io-75.4 -} -result "4181ff41" +} -result 4181ff41 -test io-75.5 {incomplete shiftjis encoding read is ignored} -setup { +test io-75.5 {invalid utf-8 encoding read is ignored} -setup { set fn [makeFile {} io-75.5] set f [open $fn w+] fconfigure $f -encoding binary # \x81 announces a two byte sequence. - puts -nonewline $f "A\x81" + puts -nonewline $f A\x81 flush $f seek $f 0 fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf } -body { set d [read $f] - close $f binary scan $d H* hd set hd } -cleanup { + close $f removeFile io-75.5 -} -result "4181" +} -result 4181 # ### ### ### ######### ######### ######### # cleanup -foreach file [list fooBar longfile script script2 output test1 pipe my_script \ +foreach file [list fooBar longfile script2 output test1 pipe my_script \ test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { removeFile $file } -- cgit v0.12 From 9d9ff7dff34db6542329244eb036ee5830225c12 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 15 Dec 2023 22:16:21 +0000 Subject: Merge 8.6 --- tests/fileSystem.test | 2 +- tests/io.test | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 7512504..be17717 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -282,7 +282,7 @@ test filesystem-1.30.3 {file normalization should distinguish between ~ and ~use set olduserhome [file normalize ~$::tcl_platform(user)] set ::env(HOME) [file join $oldhome temp] } -cleanup { - set env(HOME) $oldhome + set ::env(HOME) $oldhome } -body { list [string equal [file normalize ~] $::env(HOME)] \ [string equal $olduserhome [file normalize ~$::tcl_platform(user)]] diff --git a/tests/io.test b/tests/io.test index 00ae8f86..0bc5c0b 100644 --- a/tests/io.test +++ b/tests/io.test @@ -9719,7 +9719,7 @@ test io-76.10 {channel mode dropping} -setup { Bad mode, would make channel inacessible. Channel: "*"} # cleanup -foreach file [list fooBar longfile script script2 output test1 pipe my_script \ +foreach file [list fooBar longfile script2 output test1 pipe my_script \ test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { removeFile $file } -- cgit v0.12 From 282b5b88290d3781ca6e9d08fa4ea998e93bb409 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 18 Dec 2023 14:34:37 +0000 Subject: Restore [removeFile script]. It is needed in this branch. --- tests/io.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/io.test b/tests/io.test index 6a31308..4bb8c1f 100644 --- a/tests/io.test +++ b/tests/io.test @@ -8929,7 +8929,7 @@ test io-75.5 {invalid utf-8 encoding read is ignored} -setup { # ### ### ### ######### ######### ######### # cleanup -foreach file [list fooBar longfile script2 output test1 pipe my_script \ +foreach file [list fooBar longfile script script2 output test1 pipe my_script \ test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { removeFile $file } -- cgit v0.12 From 3ac1f180d095e427e5a820647d7a62ec49001cb9 Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 18 Dec 2023 17:08:41 +0000 Subject: Reverse the 2.8.9- fix for an apparent bug in Thread on Windows - the "bug" vanished after a Windows reboot. --- library/http/http.tcl | 6 +++--- tests/httpProxy.test | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index bc0eeba..2d75cb0 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -5359,10 +5359,10 @@ proc http::LoadThreadIfNeeded {} { set http(usingThread) 0 return } - if {[catch {package require Thread 2.8.9-}]} { + if {[catch {package require Thread}]} { if {$http(-threadlevel) == 2} { set msg {[http::config -threadlevel] has value 2,\ - but the Thread package (2.8.9 or above) is not available} + but the Thread package is not available} return -code error $msg } set http(usingThread) 0 @@ -5389,7 +5389,7 @@ proc http::LoadThreadIfNeeded {} { # ------------------------------------------------------------------------------ proc http::SockInThread {caller defcmd sockargs} { - package require Thread 2.8.9- + package require Thread set catchCode [catch {eval $defcmd $sockargs} sock errdict] if {$catchCode == 0} { diff --git a/tests/httpProxy.test b/tests/httpProxy.test index 24b6e8c..7e6ca22 100644 --- a/tests/httpProxy.test +++ b/tests/httpProxy.test @@ -32,7 +32,7 @@ proc stopMe {token} { } #set ThreadLevel 0 if {![info exists ThreadLevel]} { - if {[catch {package require Thread 2.8.9-}] == 0} { + if {[catch {package require Thread}] == 0} { set ValueRange {0 1 2} } else { set ValueRange {0 1} -- cgit v0.12 From a42a36b61bf9941c98c21f6d9a66883293509dcd Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 18 Dec 2023 17:30:26 +0000 Subject: Improve tests/httpProxy.test. Use constraints and print a message on their usage. Catch unimportant cleanup errors. Use knownBug to control test failures. Print full-file summary by default (not per-ThreadLevel). Pause between tests to avoid flooding the server. Add module twapiTlsPlus and load it when needed. Add example configuration files for Diladele Squid on Windows. --- tests/httpProxy.test | 411 +++++++++++++++++------ tests/httpProxySquidConfigForWindowsDiladele.zip | Bin 0 -> 2733 bytes tests/twapiTlsPlus.tcl | 48 +++ 3 files changed, 353 insertions(+), 106 deletions(-) create mode 100644 tests/httpProxySquidConfigForWindowsDiladele.zip create mode 100644 tests/twapiTlsPlus.tcl diff --git a/tests/httpProxy.test b/tests/httpProxy.test index 7e6ca22..2429811 100644 --- a/tests/httpProxy.test +++ b/tests/httpProxy.test @@ -18,7 +18,17 @@ if {"::tcltest" ni [namespace children]} { } package require http 2.10 -#http::register http 80 ::socket + +# To write a separate summary for each value of ThreadLevel, set constraint ThreadLevelSummary. +#testConstraint ThreadLevelSummary 0 +#testConstraint needsSquidNoAuth 0 +#testConstraint needsSquidAuth 0 +#testConstraint needsTclTls 0 +#testConstraint needsTwapi 0 +#testConstraint needsTwapiFull 0 +#testConstraint knownBug 0 +# +# The values of constraints needsTls, knownTwapiFullBugThreadlevelAny, knownTwapiFullBugThreadUsed are always generated by this script. proc bgerror {args} { global errorInfo @@ -30,7 +40,20 @@ proc bgerror {args} { proc stopMe {token} { set ${token}(z) done } -#set ThreadLevel 0 +proc putsBlurb {} { + puts {- Constraints needsTls, knownTwapiFullBugThreadlevelAny, knownTwapiFullBugThreadUsed are} + puts { always set by the script, not by the caller.} + puts {- Set one of needsTclTls, needsTwapi, needsTwapiFull instead of needsTls.} + puts {- Set knownBug instead of knownTwapiFullBugThreadlevelAny, knownTwapiFullBugThreadUsed.} + puts {- If the caller sets constraint needsTwapi, the script forces needsSquidNoAuth and needsSquidAuth to 0.} + return +} + +if 0 { + # Run with a single velue of ThreadLevel: 0|1|2 + set ThreadLevel 0 + testConstraint ThreadLevelSummary 1 +} if {![info exists ThreadLevel]} { if {[catch {package require Thread}] == 0} { set ValueRange {0 1 2} @@ -45,17 +68,17 @@ if {![info exists ThreadLevel]} { } catch {unset ThreadLevel} catch {unset ValueRange} + if {![testConstraint ThreadLevelSummary] + } { + ::tcltest::cleanupTests + putsBlurb + } return } catch {puts "==== Test with ThreadLevel $ThreadLevel ===="} http::config -threadlevel $ThreadLevel - -testConstraint needsSquidNoAuth 0 -testConstraint needsSquidAuth 0 -testConstraint needsTclTls 0 -testConstraint needsTwapi 0 -testConstraint needsTwapiFull 0 + testConstraint needsTls [expr { [testConstraint needsTclTls] || [testConstraint needsTwapi] || [testConstraint needsTwapiFull] @@ -65,6 +88,8 @@ if {[testConstraint needsTclTls]} { package require tls http::register https 443 [list ::tls::socket -ssl2 0 -ssl3 0 \ -tls1 0 -tls1.1 0 -tls1.2 1 -tls1.3 0 -autoservername 1] ::tls::socketCmd 1 1 + testConstraint knownTwapiFullBugThreadlevelAny 1 + testConstraint knownTwapiFullBugThreadUsed 1 } elseif {[testConstraint needsTwapi]} { # "Original" http::register with 3 arguments has the same capabilities as # in http 2.9 and earlier. This means that: @@ -76,6 +101,8 @@ if {[testConstraint needsTclTls]} { testConstraint needsSquidAuth 0 package require twapi http::register https 443 ::twapi::tls_socket + testConstraint knownTwapiFullBugThreadlevelAny 1 + testConstraint knownTwapiFullBugThreadUsed 1 } elseif {[testConstraint needsTwapiFull]} { # (Any revisions to TWAPI, and the contents/existence of the twapiTlsPlus # wrapper, can be negotiated if the bugs listed below can be fixed.) @@ -94,17 +121,39 @@ if {[testConstraint needsTclTls]} { # while executing # "http::geturl https://www.google.com/" # + source [file join [file dirname [info script]] twapiTlsPlus.tcl] package require twapiTlsPlus http::register https 443 ::twapiTlsPlus::socket ::twapiTlsPlus::socketCmd 1 1 + testConstraint knownTwapiFullBugThreadlevelAny [testConstraint knownBug] + + if {($ThreadLevel == 1)} { + if {[catch {package require Thread}]} { + set usingThread 0 + } else { + set usingThread 2 + } + } else { + set usingThread $ThreadLevel + } + if {$usingThread} { + testConstraint knownTwapiFullBugThreadUsed [testConstraint knownBug] + } else { + testConstraint knownTwapiFullBugThreadUsed 1 + } } else { } # Testing with Squid # - Example Squid configuration for Enterprise Linux 8 (Red Hat, Oracle, Rocky, # Alma, ...) is in file tests/httpProxySquidConfigForEL8.tar.gz. +# - Example Squid configuration for Diladele Squid on Windows is in +# file tests/httpProxySquidConfigForWindowsDiladele.zip. +# # - Two instances of Squid are launched, one that needs authentication and one # that does not. # - Each instance of Squid listens on IPv4 and IPv6, on different ports. +# - If only one instance of Squid can be launched at a time, use the separate +# constraints needsSquidNoAuth, needsSquidAuth when testing. # Instance of Squid that does not need authentication. set n4host 127.0.0.1 @@ -124,100 +173,134 @@ set aliceCreds {Basic YWxpY2U6YWxpY2lh} # concat Basic [base64::encode intruder:intruder] set badCreds {Basic aW50cnVkZXI6aW50cnVkZXI=} +# For the benefit of the target server, have a short delay between tests. +set fetchPause 200 + +foreach constr { + ThreadLevelSummary + needsSquidNoAuth + needsSquidAuth + needsTclTls + needsTwapi + needsTwapiFull + needsTls + knownTwapiFullBugThreadlevelAny + knownTwapiFullBugThreadUsed +} { + puts [list testConstraint $constr [testConstraint $constr]] +} +putsBlurb + test httpProxy-1.1.$ThreadLevel {squid is running - ipv4 no-auth} -constraints {needsSquidNoAuth} -setup { } -body { + after $fetchPause + set token [http::geturl http://$n4host:$n4port/] set ri [http::responseInfo $token] set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ [dict get $ri proxyUsed]" } -result {complete ok 400 -- none} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res } test httpProxy-1.2.$ThreadLevel {squid is running - ipv6 no-auth} -constraints {needsSquidNoAuth} -setup { } -body { + after $fetchPause + set token [http::geturl http://\[$n6host\]:$n6port/] set ri [http::responseInfo $token] set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ [dict get $ri proxyUsed]" } -result {complete ok 400 -- none} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res } test httpProxy-1.3.$ThreadLevel {squid is running - ipv4 with-auth} -constraints {needsSquidAuth} -setup { } -body { + after $fetchPause + set token [http::geturl http://$a4host:$a4port/] set ri [http::responseInfo $token] set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ [dict get $ri proxyUsed]" } -result {complete ok 400 -- none} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res } test httpProxy-1.4.$ThreadLevel {squid is running - ipv6 with-auth} -constraints {needsSquidAuth} -setup { } -body { + after $fetchPause + set token [http::geturl http://\[$a6host\]:$a6port/] set ri [http::responseInfo $token] set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ [dict get $ri proxyUsed]" } -result {complete ok 400 -- none} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res } test httpProxy-2.1.$ThreadLevel {http no-proxy no-auth} -constraints {} -setup { http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -body { + after $fetchPause + set token [http::geturl http://www.google.com/] set ri [http::responseInfo $token] set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ [dict get $ri proxyUsed] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- none -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res } -test httpProxy-2.2.$ThreadLevel {https no-proxy no-auth} -constraints {needsTls} -setup { +test httpProxy-2.2.$ThreadLevel {https no-proxy no-auth} -constraints {needsTls knownTwapiFullBugThreadUsed} -setup { http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -body { + after $fetchPause + set token [http::geturl https://www.google.com/] set ri [http::responseInfo $token] set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ [dict get $ri proxyUsed] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- none -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res } test httpProxy-2.3.$ThreadLevel {http with-proxy ipv4 no-auth} -constraints {needsSquidNoAuth} -setup { http::config -proxyhost $n4host -proxyport $n4port -proxynot {127.0.0.1 localhost} -proxyauth {} } -body { + after $fetchPause + set token [http::geturl http://www.google.com/] set ri [http::responseInfo $token] set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ [dict get $ri proxyUsed] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- HttpProxy -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res http::config -proxyhost {} -proxyport {} -proxynot {} } -test httpProxy-2.4.$ThreadLevel {https with-proxy ipv4 no-auth} -constraints {needsSquidNoAuth needsTls} -setup { +test httpProxy-2.4.$ThreadLevel {https with-proxy ipv4 no-auth} -constraints {needsSquidNoAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { http::config -proxyhost $n4host -proxyport $n4port -proxynot {127.0.0.1 localhost} -proxyauth {} } -body { + after $fetchPause + set token [http::geturl https://www.google.com/] set ri [http::responseInfo $token] set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ [dict get $ri proxyUsed] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- SecureProxy -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res http::config -proxyhost {} -proxyport {} -proxynot {} } @@ -225,27 +308,31 @@ test httpProxy-2.4.$ThreadLevel {https with-proxy ipv4 no-auth} -constraints {ne test httpProxy-2.5.$ThreadLevel {http with-proxy ipv6 no-auth} -constraints {needsSquidNoAuth} -setup { http::config -proxyhost $n6host -proxyport $n6port -proxynot {::1 localhost} -proxyauth {} } -body { + after $fetchPause + set token [http::geturl http://www.google.com/] set ri [http::responseInfo $token] set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ [dict get $ri proxyUsed] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- HttpProxy -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res http::config -proxyhost {} -proxyport {} -proxynot {} } -test httpProxy-2.6.$ThreadLevel {https with-proxy ipv6 no-auth} -constraints {needsSquidNoAuth needsTls} -setup { +test httpProxy-2.6.$ThreadLevel {https with-proxy ipv6 no-auth} -constraints {needsSquidNoAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { http::config -proxyhost $n6host -proxyport $n6port -proxynot {::1 localhost} -proxyauth {} } -body { + after $fetchPause + set token [http::geturl https://www.google.com/] set ri [http::responseInfo $token] set res "[dict get $ri stage] [dict get $ri status] [dict get $ri responseCode] --\ [dict get $ri proxyUsed] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- SecureProxy -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res http::config -proxyhost {} -proxyport {} -proxynot {} } @@ -253,6 +340,8 @@ test httpProxy-2.6.$ThreadLevel {https with-proxy ipv6 no-auth} -constraints {ne test httpProxy-3.1.$ThreadLevel {http no-proxy with-auth valid-creds-provided} -constraints {} -setup { http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds } -body { + after $fetchPause + set token [http::geturl http://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -261,14 +350,16 @@ test httpProxy-3.1.$ThreadLevel {http no-proxy with-auth valid-creds-provided} - [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- none 0 0 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.2.$ThreadLevel {https no-proxy with-auth valid-creds-provided} -constraints {needsTls} -setup { +test httpProxy-3.2.$ThreadLevel {https no-proxy with-auth valid-creds-provided} -constraints {needsTls knownTwapiFullBugThreadUsed} -setup { http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds } -body { + after $fetchPause + set token [http::geturl https://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -277,7 +368,7 @@ test httpProxy-3.2.$ThreadLevel {https no-proxy with-auth valid-creds-provided} [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- none 0 0 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } @@ -285,6 +376,8 @@ test httpProxy-3.2.$ThreadLevel {https no-proxy with-auth valid-creds-provided} test httpProxy-3.3.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-provided} -constraints {needsSquidAuth} -setup { http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds } -body { + after $fetchPause + set token [http::geturl http://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -293,14 +386,16 @@ test httpProxy-3.3.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-prov [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- HttpProxy 1 1 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.4.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-provided} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-3.4.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-provided} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds } -body { + after $fetchPause + set token [http::geturl https://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -309,7 +404,7 @@ test httpProxy-3.4.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-pro [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- SecureProxy 0 0 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } @@ -317,6 +412,8 @@ test httpProxy-3.4.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-pro test httpProxy-3.5.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-provided} -constraints {needsSquidAuth} -setup { http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds } -body { + after $fetchPause + set token [http::geturl http://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -325,14 +422,16 @@ test httpProxy-3.5.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-prov [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- HttpProxy 1 1 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.6.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-3.6.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds } -body { + after $fetchPause + set token [http::geturl https://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -341,7 +440,7 @@ test httpProxy-3.6.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-pro [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- SecureProxy 0 0 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } @@ -349,8 +448,11 @@ test httpProxy-3.6.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-pro test httpProxy-3.7.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds + after $fetchPause set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] } -body { + after $fetchPause + # Use the same caution as for the corresponding https test. set can [after 6000 {http::reset $token; set ${token}(z) timeout}] set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] @@ -365,8 +467,8 @@ test httpProxy-3.7.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-prov [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 200 -- HttpProxy 1 1 -- -1 done 1} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} @@ -375,10 +477,13 @@ test httpProxy-3.7.$ThreadLevel {http with-proxy ipv4 with-auth valid-creds-prov test httpProxy-3.7x.$ThreadLevel {http with-proxy ipv4 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} + after $fetchPause set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] http::config -proxyauth $aliceCreds } -body { + after $fetchPause + # Use the same caution as for the corresponding https test. set can [after 6000 {http::reset $token; set ${token}(z) timeout}] set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] @@ -393,18 +498,21 @@ test httpProxy-3.7x.$ThreadLevel {http with-proxy ipv4 with-auth 1st request no- [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 200 -- HttpProxy 1 1 -- -1 done 1} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.8.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-3.8.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $aliceCreds + after $fetchPause set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] } -body { + after $fetchPause + # If a bug passes the socket of a failed CONNECT to the main request, an infinite # wait can occur despite -timeout. Fix this with http::reset; to do this the call # to http::geturl must be async so we have $token for use as argument of reset. @@ -421,20 +529,23 @@ test httpProxy-3.8.$ThreadLevel {https with-proxy ipv4 with-auth valid-creds-pro [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 200 -- SecureProxy 0 0 -- -1 done 1} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.8x.$ThreadLevel {https with-proxy ipv4 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-3.8x.$ThreadLevel {https with-proxy ipv4 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} + after $fetchPause set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] http::config -proxyauth $aliceCreds } -body { + after $fetchPause + # If a bug passes the socket of a failed CONNECT to the main request, an infinite # wait can occur despite -timeout. Fix this with http::reset; to do this the call # to http::geturl must be async so we have $token for use as argument of reset. @@ -451,8 +562,8 @@ test httpProxy-3.8x.$ThreadLevel {https with-proxy ipv4 with-auth 1st request no [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 200 -- SecureProxy 0 0 -- -1 done 0} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} @@ -461,8 +572,11 @@ test httpProxy-3.8x.$ThreadLevel {https with-proxy ipv4 with-auth 1st request no test httpProxy-3.9.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds + after $fetchPause set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] } -body { + after $fetchPause + # Use the same caution as for the corresponding https test. set can [after 6000 {http::reset $token; set ${token}(z) timeout}] set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] @@ -477,8 +591,8 @@ test httpProxy-3.9.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-prov [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 200 -- HttpProxy 1 1 -- -1 done 1} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} @@ -488,9 +602,13 @@ test httpProxy-3.9p.$ThreadLevel {http with-proxy ipv6 with-auth valid-creds-pro array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds } -body { + after $fetchPause + set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}] set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] after idle { + after $fetchPause + # Use the same caution as for the corresponding https test. set can [after 6000 {http::reset $token; set ${token}(z) timeout}] set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] @@ -508,8 +626,8 @@ after idle { [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 200 -- HttpProxy 1 1 -- -1 done 1} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can0 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} @@ -518,10 +636,13 @@ after idle { test httpProxy-3.9x.$ThreadLevel {http with-proxy ipv6 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} + after $fetchPause set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] http::config -proxyauth $aliceCreds } -body { + after $fetchPause + # Use the same caution as for the corresponding https test. set can [after 6000 {http::reset $token; set ${token}(z) timeout}] set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] @@ -536,18 +657,21 @@ test httpProxy-3.9x.$ThreadLevel {http with-proxy ipv6 with-auth 1st request no- [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 200 -- HttpProxy 1 1 -- -1 done 1} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.10.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-3.10.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds + after $fetchPause set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] } -body { + after $fetchPause + # If a bug passes the socket of a failed CONNECT to the main request, an infinite # wait can occur despite -timeout. Fix this with http::reset; to do this the call # to http::geturl must be async so we have $token for use as argument of reset. @@ -564,20 +688,24 @@ test httpProxy-3.10.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-pr [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 200 -- SecureProxy 0 0 -- -1 done 1} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.10p.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works, pipelining requested and possible} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-3.10p.$ThreadLevel {https with-proxy ipv6 with-auth valid-creds-provided; check that 2nd valid request with creds is possible, and keep-alive works, pipelining requested and possible} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $aliceCreds } -body { + after $fetchPause + set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}] set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] after idle { + after $fetchPause + # If a bug passes the socket of a failed CONNECT to the main request, an infinite # wait can occur despite -timeout. Fix this with http::reset; to do this the call # to http::geturl must be async so we have $token for use as argument of reset. @@ -597,20 +725,24 @@ after idle { [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 200 -- SecureProxy 0 0 -- -1 done 1} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can0 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-3.10x.$ThreadLevel {https with-proxy ipv6 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-3.10x.$ThreadLevel {https with-proxy ipv6 with-auth 1st request no-creds-provided; check that 2nd request with creds is possible} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} + after $fetchPause + set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] http::config -proxyauth $aliceCreds } -body { + after $fetchPause + # If a bug passes the socket of a failed CONNECT to the main request, an infinite # wait can occur despite -timeout. Fix this with http::reset; to do this the call # to http::geturl must be async so we have $token for use as argument of reset. @@ -627,8 +759,8 @@ test httpProxy-3.10x.$ThreadLevel {https with-proxy ipv6 with-auth 1st request n [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 200 -- SecureProxy 0 0 -- -1 done 0} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} @@ -637,6 +769,8 @@ test httpProxy-3.10x.$ThreadLevel {https with-proxy ipv6 with-auth 1st request n test httpProxy-4.1.$ThreadLevel {http no-proxy with-auth no-creds-provided} -constraints {} -setup { http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} } -body { + after $fetchPause + set token [http::geturl http://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -645,14 +779,16 @@ test httpProxy-4.1.$ThreadLevel {http no-proxy with-auth no-creds-provided} -con [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- none 0 0 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.2.$ThreadLevel {https no-proxy with-auth no-creds-provided} -constraints {needsTls} -setup { +test httpProxy-4.2.$ThreadLevel {https no-proxy with-auth no-creds-provided} -constraints {needsTls knownTwapiFullBugThreadUsed} -setup { http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} } -body { + after $fetchPause + set token [http::geturl https://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -661,7 +797,7 @@ test httpProxy-4.2.$ThreadLevel {https no-proxy with-auth no-creds-provided} -co [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- none 0 0 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } @@ -669,6 +805,8 @@ test httpProxy-4.2.$ThreadLevel {https no-proxy with-auth no-creds-provided} -co test httpProxy-4.3.$ThreadLevel {http with-proxy ipv4 with-auth no-creds-provided} -constraints {needsSquidAuth} -setup { http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} } -body { + after $fetchPause + set token [http::geturl http://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -677,14 +815,16 @@ test httpProxy-4.3.$ThreadLevel {http with-proxy ipv4 with-auth no-creds-provide [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 407 -- HttpProxy 0 0 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.4.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provided} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-4.4.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provided} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} } -body { + after $fetchPause + set token [http::geturl https://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -693,7 +833,7 @@ test httpProxy-4.4.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provid [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 407 -- SecureProxyFailed 0 0 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } @@ -701,6 +841,8 @@ test httpProxy-4.4.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provid test httpProxy-4.5.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provided} -constraints {needsSquidAuth} -setup { http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} } -body { + after $fetchPause + set token [http::geturl http://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -709,14 +851,16 @@ test httpProxy-4.5.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provide [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 407 -- HttpProxy 0 0 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.6.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-4.6.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} } -body { + after $fetchPause + set token [http::geturl https://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -725,7 +869,7 @@ test httpProxy-4.6.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provid [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 407 -- SecureProxyFailed 0 0 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } @@ -733,8 +877,11 @@ test httpProxy-4.6.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provid test httpProxy-4.7.$ThreadLevel {http with-proxy ipv4 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} + after $fetchPause set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] } -body { + after $fetchPause + # Use the same caution as for the corresponding https test. set can [after 6000 {http::reset $token; set ${token}(z) timeout}] set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] @@ -749,18 +896,21 @@ test httpProxy-4.7.$ThreadLevel {http with-proxy ipv4 with-auth no-creds-provide [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 407 -- HttpProxy 0 0 -- -1 done 1} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.8.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-4.8.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth {} + after $fetchPause set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] } -body { + after $fetchPause + # If a bug passes the socket of a failed CONNECT to the main request, an infinite # wait can occur despite -timeout. Fix this with http::reset; to do this the call # to http::geturl must be async so we have $token for use as argument of reset. @@ -777,8 +927,8 @@ test httpProxy-4.8.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provid [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 407 -- SecureProxyFailed 0 0 -- -1 done 0} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} @@ -787,8 +937,11 @@ test httpProxy-4.8.$ThreadLevel {https with-proxy ipv4 with-auth no-creds-provid test httpProxy-4.9.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} + after $fetchPause set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] } -body { + after $fetchPause + # Use the same caution as for the corresponding https test. set can [after 6000 {http::reset $token; set ${token}(z) timeout}] set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] @@ -803,8 +956,8 @@ test httpProxy-4.9.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provide [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 407 -- HttpProxy 0 0 -- -1 done 1} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} @@ -814,9 +967,13 @@ test httpProxy-4.9p.$ThreadLevel {http with-proxy ipv6 with-auth no-creds-provid array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} } -body { + after $fetchPause + set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}] set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] after idle { + after $fetchPause + # Use the same caution as for the corresponding https test. set can [after 6000 {http::reset $token0; set ${token}(z) timeout}] set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] @@ -834,18 +991,21 @@ after idle { [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 407 -- HttpProxy 0 0 -- -1 done 1} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can0 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.10.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-4.10.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} + after $fetchPause set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] } -body { + after $fetchPause + # If a bug passes the socket of a failed CONNECT to the main request, an infinite # wait can occur despite -timeout. Fix this with http::reset; to do this the call # to http::geturl must be async so we have $token for use as argument of reset. @@ -862,21 +1022,24 @@ test httpProxy-4.10.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provi [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 407 -- SecureProxyFailed 0 0 -- -1 done 0} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-4.10p.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible, pipelining requested but not possible} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-4.10p.$ThreadLevel {https with-proxy ipv6 with-auth no-creds-provided; check that 2nd request is possible, pipelining requested but not possible} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth {} } -body { + after $fetchPause + set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}] set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] - after idle { + after $fetchPause + # If a bug passes the socket of a failed CONNECT to the main request, an infinite # wait can occur despite -timeout. Fix this with http::reset; to do this the call # to http::geturl must be async so we have $token for use as argument of reset. @@ -896,8 +1059,8 @@ after idle { [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 407 -- SecureProxyFailed 0 0 -- -1 done 0} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can0 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} @@ -906,6 +1069,8 @@ after idle { test httpProxy-5.1.$ThreadLevel {http no-proxy with-auth bad-creds-provided} -constraints {} -setup { http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds } -body { + after $fetchPause + set token [http::geturl http://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -914,14 +1079,16 @@ test httpProxy-5.1.$ThreadLevel {http no-proxy with-auth bad-creds-provided} -co [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- none 0 0 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.2.$ThreadLevel {https no-proxy with-auth bad-creds-provided} -constraints {needsTls} -setup { +test httpProxy-5.2.$ThreadLevel {https no-proxy with-auth bad-creds-provided} -constraints {needsTls knownTwapiFullBugThreadUsed} -setup { http::config -proxyhost {} -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds } -body { + after $fetchPause + set token [http::geturl https://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -930,7 +1097,7 @@ test httpProxy-5.2.$ThreadLevel {https no-proxy with-auth bad-creds-provided} -c [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 200 -- none 0 0 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } @@ -938,6 +1105,8 @@ test httpProxy-5.2.$ThreadLevel {https no-proxy with-auth bad-creds-provided} -c test httpProxy-5.3.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provided} -constraints {needsSquidAuth} -setup { http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds } -body { + after $fetchPause + set token [http::geturl http://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -946,14 +1115,16 @@ test httpProxy-5.3.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provid [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 407 -- HttpProxy 1 1 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.4.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-5.4.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds } -body { + after $fetchPause + set token [http::geturl https://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -962,7 +1133,7 @@ test httpProxy-5.4.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provi [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 407 -- SecureProxyFailed 1 1 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } @@ -970,6 +1141,8 @@ test httpProxy-5.4.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provi test httpProxy-5.5.$ThreadLevel {http with-proxy ipv6 with-auth bad-creds-provided} -constraints {needsSquidAuth} -setup { http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds } -body { + after $fetchPause + set token [http::geturl http://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -978,14 +1151,16 @@ test httpProxy-5.5.$ThreadLevel {http with-proxy ipv6 with-auth bad-creds-provid [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 407 -- HttpProxy 1 1 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.6.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provided} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-5.6.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provided} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds } -body { + after $fetchPause + set token [http::geturl https://www.google.com/] set ri [http::responseInfo $token] set pos1 [lsearch -exact [string tolower [set ${token}(requestHeaders)]] proxy-authorization] @@ -994,7 +1169,7 @@ test httpProxy-5.6.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provi [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*]" } -result {complete ok 407 -- SecureProxyFailed 1 1 -- -1} -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain token ri res pos1 pos2 http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } @@ -1002,8 +1177,11 @@ test httpProxy-5.6.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provi test httpProxy-5.7.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds + after $fetchPause set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] } -body { + after $fetchPause + # Use the same caution as for the corresponding https test. set can [after 6000 {http::reset $token; set ${token}(z) timeout}] set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] @@ -1018,8 +1196,8 @@ test httpProxy-5.7.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provid [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 407 -- HttpProxy 1 1 -- -1 done 1} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} @@ -1029,10 +1207,14 @@ test httpProxy-5.7p.$ThreadLevel {http with-proxy ipv4 with-auth bad-creds-provi array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds } -body { + after $fetchPause + set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}] set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] # Use the same caution as for the corresponding https test. after idle { + after $fetchPause + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] vwait ${token}(z) @@ -1049,18 +1231,21 @@ after idle { [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 407 -- HttpProxy 1 1 -- -1 done 1} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can0 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.8.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-5.8.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds + after $fetchPause set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] } -body { + after $fetchPause + # If a bug passes the socket of a failed CONNECT to the main request, an infinite # wait can occur despite -timeout. Fix this with http::reset; to do this the call # to http::geturl must be async so we have $token for use as argument of reset. @@ -1077,23 +1262,27 @@ test httpProxy-5.8.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provi [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 407 -- SecureProxyFailed 1 1 -- -1 done 0} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.8p.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible, pipelining requested but not possible} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-5.8p.$ThreadLevel {https with-proxy ipv4 with-auth bad-creds-provided; check that 2nd request is possible, pipelining requested but not possible} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { array unset ::http::socketMapping http::config -proxyhost $a4host -proxyport $a4port -proxynot {127.0.0.1 localhost} -proxyauth $badCreds } -body { + after $fetchPause + set can0 [after 6000 {http::reset $token0; set ${token0}(z) timeout}] set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] # If a bug passes the socket of a failed CONNECT to the main request, an infinite # wait can occur despite -timeout. Fix this with http::reset; to do this the call # to http::geturl must be async so we have $token for use as argument of reset. after idle { + after $fetchPause + set can [after 6000 {http::reset $token; set ${token}(z) timeout}] set token [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] vwait ${token}(z) @@ -1110,8 +1299,8 @@ after idle { [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 407 -- SecureProxyFailed 1 1 -- -1 done 0} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can0 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} @@ -1120,8 +1309,11 @@ after idle { test httpProxy-5.9.$ThreadLevel {http with-proxy ipv6 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds + after $fetchPause set token0 [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000] } -body { + after $fetchPause + # Use the same caution as for the corresponding https test. set can [after 6000 {http::reset $token; set ${token}(z) timeout}] set token [http::geturl http://www.google.com/ -keepalive 1 -timeout 5000 -command stopMe] @@ -1136,18 +1328,21 @@ test httpProxy-5.9.$ThreadLevel {http with-proxy ipv6 with-auth bad-creds-provid [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 407 -- HttpProxy 1 1 -- -1 done 1} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } -test httpProxy-5.10.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth needsTls} -setup { +test httpProxy-5.10.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-provided; check that 2nd request is possible} -constraints {needsSquidAuth needsTls knownTwapiFullBugThreadlevelAny} -setup { array unset ::http::socketMapping http::config -proxyhost $a6host -proxyport $a6port -proxynot {::1 localhost} -proxyauth $badCreds + after $fetchPause set token0 [http::geturl https://www.google.com/ -keepalive 1 -timeout 5000] } -body { + after $fetchPause + # If a bug passes the socket of a failed CONNECT to the main request, an infinite # wait can occur despite -timeout. Fix this with http::reset; to do this the call # to http::geturl must be async so we have $token for use as argument of reset. @@ -1164,20 +1359,24 @@ test httpProxy-5.10.$ThreadLevel {https with-proxy ipv6 with-auth bad-creds-prov [dict get $ri proxyUsed] [expr {$pos1 > -1}] [expr {$pos2 > -1}] --\ [lsearch -glob [array get ::http::socketMapping] HTTP_PLACEHOLDER_*] [set ${token}(z)] $same" } -result {complete ok 407 -- SecureProxyFailed 1 1 -- -1 done 0} -cleanup { - http::cleanup $token0 - http::cleanup $token + catch {http::cleanup $token0} + catch {http::cleanup $token} unset -nocomplain token0 token ri res pos1 pos2 can same array unset ::http::socketMapping http::config -proxyhost {} -proxyport {} -proxynot {} -proxyauth {} } # cleanup -unset -nocomplain n4host n6host n4port n6port a4host a6host a4port a6port aliceCreds badCreds +unset -nocomplain n4host n6host n4port n6port a4host a6host a4port a6port aliceCreds badCreds fetchPause rename bgerror {} rename stopMe {} -::tcltest::cleanupTests +if {[testConstraint ThreadLevelSummary]} { + ::tcltest::cleanupTests + putsBlurb +} + # Local variables: # mode: tcl diff --git a/tests/httpProxySquidConfigForWindowsDiladele.zip b/tests/httpProxySquidConfigForWindowsDiladele.zip new file mode 100644 index 0000000..714baa1 Binary files /dev/null and b/tests/httpProxySquidConfigForWindowsDiladele.zip differ diff --git a/tests/twapiTlsPlus.tcl b/tests/twapiTlsPlus.tcl new file mode 100644 index 0000000..9901afa --- /dev/null +++ b/tests/twapiTlsPlus.tcl @@ -0,0 +1,48 @@ +# Module twapiTlsPlus +# +# Temporary wrapper for package twapi, to expose the same API as package tls. +# - Command twapiTlsPlus::socket, cf. tls::socket, replacement for ::socket, for +# use with http::register. +# - Variable twapiTlsPlus::socketCmd, cf. tls::socketCmd, holds the value of the +# callback command used by twapi to open a socket. +# +# Intended to allow twapi TLS to use an https proxy server, and a background +# thread for evaluation of ::socket. +# +# For twapiTlsPlus to work correctly, twapi*/tls.tcl must be edited so that +#- set so [$socketcmd {*}$socket_args {*}$args] +#+ set so [{*}$socketcmd {*}$socket_args {*}$args] + +package require http +package require twapi + +namespace eval twapiTlsPlus { + variable socketCmd [::twapi::tls_socket_command] + namespace export socket +} + +# Proc twapiTlsPlus::socket +# Replacement for ::socket, use with http::register. + +proc twapiTlsPlus::socket {args} { + variable socketCmd + + set targ [lsearch -exact $args -type] + if {$targ != -1} { + set token [lindex $args $targ+1] + set args [lreplace $args $targ $targ+1 -socketcmd [list {*}$socketCmd -type $token]] + } + ::twapi::tls_socket {*}$args +} + +# Variable twapi::tls::_socket_cmd does it. + +proc twapiTlsPlus::TraceSocketCmd {args} { + variable socketCmd + ::twapi::tls_socket_command $socketCmd + return +} + +trace add variable ::twapiTlsPlus::socketCmd write ::twapiTlsPlus::TraceSocketCmd + +package provide twapiTlsPlus 0.1 -- cgit v0.12 From a38fd9b4891b61be086f838c00a78c936cf58a6d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 19 Dec 2023 08:33:25 +0000 Subject: GITHUB upload-artifact @3 -> @4 --- .github/workflows/onefiledist.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/onefiledist.yml b/.github/workflows/onefiledist.yml index a9f02c9..5c444f0 100644 --- a/.github/workflows/onefiledist.yml +++ b/.github/workflows/onefiledist.yml @@ -40,7 +40,7 @@ jobs: tar -cf tclsh${TCL_PATCHLEVEL}_snapshot.tar tclsh${TCL_PATCHLEVEL}_snapshot working-directory: 1dist - name: Upload - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: Tclsh ${{ env.TCL_PATCHLEVEL }} Linux single-file build (snapshot) path: 1dist/*.tar @@ -102,7 +102,7 @@ jobs: "contents/" working-directory: 1dist - name: Upload - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: Tclsh ${{ env.TCL_PATCHLEVEL }} macOS single-file build (snapshot) path: 1dist/*.dmg @@ -146,7 +146,7 @@ jobs: cp ../win/tclsh*.exe tclsh${TCL_PATCHLEVEL}_snapshot.exe working-directory: 1dist - name: Upload - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: Tclsh ${{ env.TCL_PATCHLEVEL }} Windows single-file build (snapshot) path: '1dist/*_snapshot.exe' -- cgit v0.12 From 6cc6c680eab743827028033e485e9f380c2b13a4 Mon Sep 17 00:00:00 2001 From: kjnash Date: Tue, 19 Dec 2023 17:26:09 +0000 Subject: Improve tests/http.test, tests/http11.test, tests/httpPipeline.test. Catch unimportant cleanup errors. Print full-file summary by default (not per-ThreadLevel). --- tests/http.test | 124 +++++++++++++++++++++++++++--------------------- tests/http11.test | 115 ++++++++++++++++++++++++-------------------- tests/httpPipeline.test | 15 +++++- tests/httpProxy.test | 18 +++---- 4 files changed, 157 insertions(+), 115 deletions(-) diff --git a/tests/http.test b/tests/http.test index 2240d41..c77dceb 100644 --- a/tests/http.test +++ b/tests/http.test @@ -20,6 +20,9 @@ source [file join [file dirname [info script]] tcltests.tcl] package require http 2.10 #http::register http 80 ::socket +# To write a separate summary for each value of ThreadLevel, set constraint ThreadLevelSummary. +#testConstraint ThreadLevelSummary 0 + proc bgerror {args} { global errorInfo puts stderr "http.test bgerror" @@ -69,6 +72,11 @@ if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} { set threadStack {} } +if 0 { + # For debugging: run with a single value of ThreadLevel: 0|1|2 + set ThreadLevel 0 + testConstraint ThreadLevelSummary 1 +} if {![info exists ThreadLevel]} { if {[catch {package require Thread}] == 0} { set ValueRange {0 1 2} @@ -86,6 +94,9 @@ if {![info exists ThreadLevel]} { } catch {unset ThreadLevel} catch {unset ValueRange} + if {![testConstraint ThreadLevelSummary]} { + ::tcltest::cleanupTests + } return } @@ -163,7 +174,7 @@ test http-3.3.$ThreadLevel {http::geturl} -body { set token [http::geturl $url] http::data $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result "HTTP/1.0 TEST

Hello, World!

GET /

@@ -183,7 +194,7 @@ test http-3.4.$ThreadLevel {http::geturl} -body { set token [http::geturl $url] http::data $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result "HTTP/1.0 TEST

Hello, World!

GET $tail

@@ -198,7 +209,7 @@ test http-3.5.$ThreadLevel {http::geturl} -body { http::data $token } -cleanup { http::config -proxyfilter http::ProxyRequired - http::cleanup $token + catch {http::cleanup $token} } -result "HTTP/1.0 TEST

Hello, World!

GET http:$url

@@ -209,7 +220,7 @@ test http-3.6.$ThreadLevel {http::geturl} -body { http::data $token } -cleanup { http::config -proxyfilter http::ProxyRequired - http::cleanup $token + catch {http::cleanup $token} } -result "HTTP/1.0 TEST

Hello, World!

GET $tail

@@ -218,7 +229,7 @@ test http-3.7.$ThreadLevel {http::geturl} -body { set token [http::geturl $url -headers {Pragma no-cache}] http::data $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result "HTTP/1.0 TEST

Hello, World!

GET $tail

@@ -227,7 +238,7 @@ test http-3.8.$ThreadLevel {http::geturl} -body { set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 3000] http::data $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result "HTTP/1.0 TEST

Hello, World!

POST $tail

@@ -241,7 +252,7 @@ test http-3.9.$ThreadLevel {http::geturl} -body { set token [http::geturl $url -validate 1] http::code $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result "HTTP/1.0 200 OK" test http-3.10.$ThreadLevel {http::geturl queryprogress} -setup { set query foo=bar @@ -254,17 +265,17 @@ test http-3.10.$ThreadLevel {http::geturl queryprogress} -setup { set sep & } } -body { - proc postProgress {token x y} { + proc postProgress {tok x y} { global postProgress lappend postProgress $y } set postProgress {} - set t [http::geturl $posturl -keepalive 0 -query $query \ + set token [http::geturl $posturl -keepalive 0 -query $query \ -queryprogress postProgress -queryblocksize 16384] - http::wait $t - list [http::status $t] [string length $query] $postProgress [http::data $t] + http::wait $token + list [http::status $token] [string length $query] $postProgress [http::data $token] } -cleanup { - http::cleanup $t + catch {http::cleanup $token} } -result {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}} test http-3.11.$ThreadLevel {http::geturl querychannel with -command} -setup { set query foo=bar @@ -279,26 +290,26 @@ test http-3.11.$ThreadLevel {http::geturl querychannel with -command} -setup { set file [makeFile $query outdata] } -body { set fp [open $file] - proc asyncCB {token} { + proc asyncCB {tok} { global postResult - lappend postResult [http::data $token] + lappend postResult [http::data $tok] } set postResult [list ] - set t [http::geturl $posturl -querychannel $fp] - http::wait $t - set testRes [list [http::status $t] [string length $query] [http::data $t]] + set token [http::geturl $posturl -querychannel $fp] + http::wait $token + set testRes [list [http::status $token] [string length $query] [http::data $token]] # Now do async - http::cleanup $t + http::cleanup $token close $fp set fp [open $file] - set t [http::geturl $posturl -querychannel $fp -command asyncCB] + set token [http::geturl $posturl -querychannel $fp -command asyncCB] set postResult [list PostStart] - http::wait $t + http::wait $token close $fp - lappend testRes [http::status $t] $postResult + lappend testRes [http::status $token] $postResult } -cleanup { removeFile outdata - http::cleanup $t + catch {http::cleanup $token} } -result {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}} # On Linux platforms when the client and server are on the same host, the # client is unable to read the server's response one it hits the write error. @@ -318,11 +329,11 @@ test http-3.12.$ThreadLevel {http::geturl querychannel with aborted request} -se set file [makeFile $query outdata] } -constraints {nonPortable} -body { set fp [open $file] - proc asyncCB {token} { + proc asyncCB {tok} { global postResult - lappend postResult [http::data $token] + lappend postResult [http::data $tok] } - proc postProgress {token x y} { + proc postProgress {tok x y} { global postProgress lappend postProgress $y } @@ -330,18 +341,18 @@ test http-3.12.$ThreadLevel {http::geturl querychannel with aborted request} -se # Now do async set postResult [list PostStart] if {[catch { - set t [http::geturl $badposturl -querychannel $fp -command asyncCB \ + set token [http::geturl $badposturl -querychannel $fp -command asyncCB \ -queryprogress postProgress] - http::wait $t - upvar #0 $t state + http::wait $token + upvar #0 $token state } err]} { puts $::errorInfo error $err } - list [http::status $t] [http::code $t] + list [http::status $token] [http::code $token] } -cleanup { removeFile outdata - http::cleanup $t + catch {http::cleanup $token} } -result {ok {HTTP/1.0 200 Data follows}} test http-3.13.$ThreadLevel {http::geturl socket leak test} { set chanCount [llength [file channels]] @@ -355,7 +366,7 @@ test http-3.14.$ThreadLevel "http::geturl $fullurl" -body { set token [http::geturl $fullurl -validate 1] http::code $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result "HTTP/1.0 200 OK" test http-3.15.$ThreadLevel {http::geturl parse failures} -body { http::geturl "{invalid}:url" @@ -394,7 +405,7 @@ test http-3.25.$ThreadLevel {http::meta} -setup { array set m [http::meta $token] lsort [array names m] } -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain m token } -result {content-length content-type date} test http-3.26.$ThreadLevel {http::meta} -setup { @@ -404,7 +415,7 @@ test http-3.26.$ThreadLevel {http::meta} -setup { array set m [http::meta $token] lsort [array names m] } -cleanup { - http::cleanup $token + catch {http::cleanup $token} unset -nocomplain m token } -result {content-length content-type date x-check} test http-3.27.$ThreadLevel {http::geturl: -headers override -type} -body { @@ -412,7 +423,7 @@ test http-3.27.$ThreadLevel {http::geturl: -headers override -type} -body { -headers [list "Content-Type" "text/plain;charset=utf-8"]] http::data $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -match regexp -result {(?n)Host .* User-Agent .* Content-Type {text/plain;charset=utf-8} @@ -425,7 +436,7 @@ test http-3.28.$ThreadLevel {http::geturl: -headers override -type default} -bod -headers [list "Content-Type" "text/plain;charset=utf-8"]] http::data $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -match regexp -result {(?n)Host .* User-Agent .* Content-Type {text/plain;charset=utf-8} @@ -445,19 +456,19 @@ test http-3.29.$ThreadLevel {http::geturl IPv6 address} -body { } set error } -cleanup { - catch { http::cleanup $token } + catch {http::cleanup $token} } -result 0 test http-3.30.$ThreadLevel {http::geturl query without path} -body { set token [http::geturl $authorityurl?var=val] http::ncode $token } -cleanup { - catch { http::cleanup $token } + catch {http::cleanup $token} } -result 200 test http-3.31.$ThreadLevel {http::geturl fragment without path} -body { set token [http::geturl "$authorityurl#fragment42"] http::ncode $token } -cleanup { - catch { http::cleanup $token } + catch {http::cleanup $token} } -result 200 # Bug c11a51c482 test http-3.32.$ThreadLevel {http::geturl: -headers override -accept default} -body { @@ -465,7 +476,7 @@ test http-3.32.$ThreadLevel {http::geturl: -headers override -accept default} -b -headers [list "Accept" "text/plain,application/tcl-test-value"]] http::data $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -match regexp -result {(?n)Host .* User-Agent .* Accept text/plain,application/tcl-test-value @@ -478,7 +489,7 @@ test http-3.33.$ThreadLevel {http::geturl application/xml is text} -body { set token [http::geturl "$xmlurl"] scan [http::data $token] "<%\[^>]>%c<%\[^>]>" } -cleanup { - catch { http::cleanup $token } + catch {http::cleanup $token} } -result {test 4660 /test} test http-3.34.$ThreadLevel {http::geturl -headers not a list} -returnCodes error -body { http::geturl http://test/t -headers \" @@ -493,7 +504,7 @@ test http-4.1.$ThreadLevel {http::Event} -body { array set meta $data(meta) expr {($data(totalsize) == $meta(content-length))} } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result 1 test http-4.2.$ThreadLevel {http::Event} -body { set token [http::geturl $url] @@ -501,13 +512,13 @@ test http-4.2.$ThreadLevel {http::Event} -body { array set meta $data(meta) string compare $data(type) [string trim $meta(content-type)] } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result 0 test http-4.3.$ThreadLevel {http::Event} -body { set token [http::geturl $url] http::code $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result {HTTP/1.0 200 Data follows} test http-4.4.$ThreadLevel {http::Event} -setup { set testfile [makeFile "" testfile] @@ -521,7 +532,7 @@ test http-4.4.$ThreadLevel {http::Event} -setup { catch {close $in} catch {close $out} removeFile $testfile - http::cleanup $token + catch {http::cleanup $token} } -result "HTTP/1.0 TEST

Hello, World!

GET $tail

@@ -537,7 +548,7 @@ test http-4.5.$ThreadLevel {http::Event} -setup { expr {$data(currentsize) == $data(totalsize)} } -cleanup { removeFile $testfile - http::cleanup $token + catch {http::cleanup $token} } -result 1 test http-4.6.$ThreadLevel {http::Event} -setup { set testfile [makeFile "" testfile] @@ -552,7 +563,7 @@ test http-4.6.$ThreadLevel {http::Event} -setup { catch {close $in} catch {close $out} removeFile $testfile - http::cleanup $token + catch {http::cleanup $token} } -result "$bindata[string trimleft $binurl /]" proc myProgress {token total current} { global progress httpLog @@ -569,25 +580,25 @@ test http-4.7.$ThreadLevel {http::Event} -body { set token [http::geturl $url -keepalive 0 -progress myProgress] return $progress } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result {111 111} test http-4.8.$ThreadLevel {http::Event} -body { set token [http::geturl $url] http::status $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result {ok} test http-4.9.$ThreadLevel {http::Event} -body { set token [http::geturl $url -progress myProgress] http::code $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result {HTTP/1.0 200 Data follows} test http-4.10.$ThreadLevel {http::Event} -body { set token [http::geturl $url -progress myProgress] http::size $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result {111} # Timeout cases @@ -598,7 +609,7 @@ test http-4.11.$ThreadLevel {http::Event} -body { http::reset $token http::status $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result {reset} # Longer timeout with reset. @@ -607,7 +618,7 @@ test http-4.12.$ThreadLevel {http::Event} -body { http::reset $token http::status $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result {reset} # Medium timeout to working server that waits even longer. The timeout @@ -617,7 +628,7 @@ test http-4.13.$ThreadLevel {http::Event} -body { http::wait $token http::status $token } -cleanup { - http::cleanup $token + catch {http::cleanup $token} } -result {timeout} # Longer timeout to good host, bad port, gets an error after the @@ -705,7 +716,7 @@ test http-6.1.$ThreadLevel {http::ProxyRequired} -body { set data(body) } -cleanup { http::config -proxyhost {} -proxyport {} - http::cleanup $token + catch {http::cleanup $token} } -result "HTTP/1.0 TEST

Hello, World!

GET http:$url

@@ -1201,7 +1212,10 @@ if {[info exists removeHttpd]} { } rename bgerror {} -::tcltest::cleanupTests + +if {[testConstraint ThreadLevelSummary]} { + ::tcltest::cleanupTests +} # Local variables: # mode: tcl diff --git a/tests/http11.test b/tests/http11.test index af35763..0b3c560 100644 --- a/tests/http11.test +++ b/tests/http11.test @@ -87,6 +87,14 @@ makeFile "test

this is a test

\n[st makeFile "test

this is a test

\n[string repeat {

This is a tcl test file.

} 5000]\n" largedoc.html +# To write a separate summary for each value of ThreadLevel, set constraint ThreadLevelSummary. +#testConstraint ThreadLevelSummary 0 + +if 0 { + # For debugging: run with a single value of ThreadLevel: 0|1|2 + set ThreadLevel 0 + testConstraint ThreadLevelSummary 1 +} if {![info exists ThreadLevel]} { if {[catch {package require Thread}] == 0} { set ValueRange {0 1 2} @@ -101,6 +109,9 @@ if {![info exists ThreadLevel]} { } catch {unset ThreadLevel} catch {unset ValueRange} + if {![testConstraint ThreadLevelSummary]} { + ::tcltest::cleanupTests + } return } @@ -116,7 +127,7 @@ test http11-1.0.$ThreadLevel "normal request for document " -setup { http::wait $tok list [http::status $tok] [http::code $tok] [check_crc $tok] [meta $tok connection] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close} @@ -130,7 +141,7 @@ test http11-1.1.$ThreadLevel "normal,gzip,non-chunked" -setup { [meta $tok content-encoding] [meta $tok transfer-encoding] \ [http::meta $tok content-encoding] [http::meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {ok {HTTP/1.1 200 OK} ok gzip {} {content-encoding gzip} {}} @@ -143,7 +154,7 @@ test http11-1.2.$ThreadLevel "normal,deflated,non-chunked" -setup { list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {ok {HTTP/1.1 200 OK} ok deflate {}} @@ -156,7 +167,7 @@ test http11-1.2.1.$ThreadLevel "normal,deflated,non-chunked,msdeflate" -setup { list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {ok {HTTP/1.1 200 OK} ok deflate {}} @@ -171,7 +182,7 @@ test http11-1.3.$ThreadLevel "normal,compressed,non-chunked" -constraints badCom list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {ok {HTTP/1.1 200 OK} ok compress {}} @@ -184,7 +195,7 @@ test http11-1.4.$ThreadLevel "normal,identity,non-chunked" -setup { list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} {}} @@ -197,7 +208,7 @@ test http11-1.5.$ThreadLevel "normal request for document, unsupported coding" - list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {}} @@ -211,7 +222,7 @@ test http11-1.6.$ThreadLevel "normal, specify 1.1 " -setup { [meta $tok connection] [meta $tok transfer-encoding] \ [http::meta $tok connection] [http::meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close chunked {connection close} {transfer-encoding chunked}} @@ -224,7 +235,7 @@ test http11-1.7.$ThreadLevel "normal, 1.1 and keepalive " -setup { list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok connection] [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} chunked} @@ -237,7 +248,7 @@ test http11-1.8.$ThreadLevel "normal, 1.1 and keepalive, server close" -setup { list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok connection] [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {}} @@ -250,7 +261,7 @@ test http11-1.9.$ThreadLevel "normal,gzip,chunked" -setup { list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {ok {HTTP/1.1 200 OK} ok gzip chunked} @@ -263,7 +274,7 @@ test http11-1.10.$ThreadLevel "normal,deflate,chunked" -setup { list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {ok {HTTP/1.1 200 OK} ok deflate chunked} @@ -276,7 +287,7 @@ test http11-1.10.1.$ThreadLevel "normal,deflate,chunked,msdeflate" -setup { list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {ok {HTTP/1.1 200 OK} ok deflate chunked} @@ -291,7 +302,7 @@ test http11-1.11.$ThreadLevel "normal,compress,chunked" -constraints badCompress list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {ok {HTTP/1.1 200 OK} ok compress chunked} @@ -304,7 +315,7 @@ test http11-1.12.$ThreadLevel "normal,identity,chunked" -setup { list [http::status $tok] [http::code $tok] [check_crc $tok] \ [meta $tok content-encoding] [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {ok {HTTP/1.1 200 OK} ok {} chunked} @@ -325,8 +336,8 @@ test http11-1.13.$ThreadLevel "normal, 1.1 and keepalive as server default, no z [meta $toj connection] [meta $toj transfer-encoding] [state $toj reusing] [state $toj connection]] concat $res1 -- $res2 } -cleanup { - http::cleanup $tok - http::cleanup $toj + catch {http::cleanup $tok} + catch {http::cleanup $toj} halt_httpd http::config -zip $zipTmp } -result {ok {HTTP/1.1 200 OK} ok {} {} 0 keep-alive -- ok {HTTP/1.1 200 OK} ok {} {} 1 keep-alive} @@ -359,7 +370,7 @@ test http11-2.0.$ThreadLevel "-channel" -setup { list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ [meta $tok connection] [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -379,7 +390,7 @@ test http11-2.1.$ThreadLevel "-channel, encoding gzip" -setup { [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] -- $diff bytes lost } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -403,7 +414,7 @@ test http11-2.1.1.$ThreadLevel "-channel, encoding gzip" -setup { [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] -- $diff bytes lost } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -422,7 +433,7 @@ test http11-2.2.$ThreadLevel "-channel, encoding deflate" -setup { [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -441,7 +452,7 @@ test http11-2.2.1.$ThreadLevel "-channel, encoding deflate,msdeflate" -setup { [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -463,7 +474,7 @@ test http11-2.3.$ThreadLevel "-channel,encoding compress" -constraints badCompre [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -483,7 +494,7 @@ test http11-2.4.$ThreadLevel "-channel,encoding identity" -setup { [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -508,7 +519,7 @@ test http11-2.4.1.$ThreadLevel "-channel,encoding identity with -progress" -setu [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ [expr {[lindex $logdata 0] - [string length $data]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -534,7 +545,7 @@ test http11-2.4.2.$ThreadLevel "-channel,encoding identity with -progress progre [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ [expr {[lindex $logdata 0] - [string length $data]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -555,7 +566,7 @@ test http11-2.5.$ThreadLevel "-channel,encoding unsupported" -setup { [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -575,7 +586,7 @@ test http11-2.6.$ThreadLevel "-channel,encoding gzip,non-chunked" -setup { [meta $tok transfer-encoding]\ [expr {[file size testdoc.html]-[file size testfile.tmp]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -595,7 +606,7 @@ test http11-2.7.$ThreadLevel "-channel,encoding deflate,non-chunked" -setup { [meta $tok transfer-encoding]\ [expr {[file size testdoc.html]-[file size testfile.tmp]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -618,7 +629,7 @@ test http11-2.7.1.$ThreadLevel "-channel,encoding deflate,non-chunked,msdeflate" [meta $tok transfer-encoding]\ [expr {[file size testdoc.html]-[file size testfile.tmp]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -640,7 +651,7 @@ test http11-2.8.$ThreadLevel "-channel,encoding compress,non-chunked" -constrain [meta $tok transfer-encoding]\ [expr {[file size testdoc.html]-[file size testfile.tmp]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -660,7 +671,7 @@ test http11-2.9.$ThreadLevel "-channel,encoding identity,non-chunked" -setup { [meta $tok transfer-encoding]\ [expr {[file size testdoc.html]-[file size testfile.tmp]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -681,7 +692,7 @@ test http11-2.10.$ThreadLevel "-channel,deflate,keepalive" -setup { [meta $tok transfer-encoding]\ [expr {[file size testdoc.html]-[file size testfile.tmp]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -702,7 +713,7 @@ test http11-2.10.1.$ThreadLevel "-channel,deflate,keepalive,msdeflate" -setup { [meta $tok transfer-encoding]\ [expr {[file size testdoc.html]-[file size testfile.tmp]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -722,7 +733,7 @@ test http11-2.11.$ThreadLevel "-channel,identity,keepalive" -setup { [meta $tok connection] [meta $tok content-encoding]\ [meta $tok transfer-encoding] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -742,7 +753,7 @@ test http11-2.12.$ThreadLevel "-channel,negotiate,keepalive" -setup { [meta $tok transfer-encoding] [meta $tok x-requested-encodings]\ [expr {[file size testdoc.html]-[file size testfile.tmp]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -788,7 +799,7 @@ test http11-3.0.$ThreadLevel "-handler,close,identity" -setup { [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length $testdata]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} unset -nocomplain testdata halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} @@ -806,7 +817,7 @@ test http11-3.1.$ThreadLevel "-handler,protocol1.0" -setup { [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length $testdata]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} unset -nocomplain testdata halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} @@ -824,7 +835,7 @@ test http11-3.2.$ThreadLevel "-handler,close,chunked" -setup { [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length $testdata]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} unset -nocomplain testdata halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} @@ -842,7 +853,7 @@ test http11-3.3.$ThreadLevel "-handler,keepalive,chunked" -setup { [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length $testdata]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} unset -nocomplain testdata halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} @@ -869,7 +880,7 @@ test http11-3.4.$ThreadLevel "-handler,close,identity; HTTP/1.0 server does not [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length $testdata]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} unset -nocomplain testdata halt_httpd } -result {ok {HTTP/1.0 200 OK} ok {} {} {} 0} @@ -887,7 +898,7 @@ test http11-3.5.$ThreadLevel "-handler,close,identity as http11-3.0 but handlerP [meta $tok transfer-encoding] \ [expr {[file size testdoc.html]-[string length $testdata]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} unset -nocomplain testdata ::WaitHere halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} @@ -908,7 +919,7 @@ test http11-3.6.$ThreadLevel "-handler,close,identity as http11-3.0 but with -pr [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ [expr {[lindex $logdata 0] - [string length $testdata]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} unset -nocomplain testdata logdata ::WaitHere halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0} @@ -929,7 +940,7 @@ test http11-3.7.$ThreadLevel "-handler,close,identity as http11-3.0 but with -pr [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ [expr {[lindex $logdata 0] - [string length $testdata]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} unset -nocomplain testdata logdata ::WaitHere halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0} @@ -950,7 +961,7 @@ test http11-3.8.$ThreadLevel "close,identity no -handler but with -progress" -se [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ [expr {[lindex $logdata 0] - [string length [http::data $tok]]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} unset -nocomplain logdata ::WaitHere halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0} @@ -971,7 +982,7 @@ test http11-3.9.$ThreadLevel "close,identity no -handler but with -progress prog [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ [expr {[lindex $logdata 0] - [string length [http::data $tok]]}] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} unset -nocomplain logdata ::WaitHere halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0} @@ -988,7 +999,7 @@ test http11-4.0.$ThreadLevel "normal post request" -setup { connection [meta $tok connection]\ query-length [meta $tok x-query-length] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7} @@ -1005,7 +1016,7 @@ test http11-4.1.$ThreadLevel "normal post request, check query length" -setup { connection [meta $tok connection]\ query-length [meta $tok x-query-length] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7} @@ -1022,7 +1033,7 @@ test http11-4.2.$ThreadLevel "normal post request, check long query length" -set connection [meta $tok connection]\ query-length [meta $tok x-query-length] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} halt_httpd } -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 24576} @@ -1042,7 +1053,7 @@ test http11-4.3.$ThreadLevel "normal post request, check channel query length" - connection [meta $tok connection]\ query-length [meta $tok x-query-length] } -cleanup { - http::cleanup $tok + catch {http::cleanup $tok} close $chan removeFile testfile.tmp halt_httpd @@ -1064,4 +1075,6 @@ removeFile testdoc.html removeFile largedoc.html unset -nocomplain httpd_port httpd p -::tcltest::cleanupTests +if {[testConstraint ThreadLevelSummary]} { + ::tcltest::cleanupTests +} diff --git a/tests/httpPipeline.test b/tests/httpPipeline.test index 491aae0..ef62aa3 100644 --- a/tests/httpPipeline.test +++ b/tests/httpPipeline.test @@ -19,6 +19,14 @@ package require http 2.10 # (0) Socket Creation in Thread, which triples the number of tests. # ------------------------------------------------------------------------------ +# To write a separate summary for each value of ThreadLevel, set constraint ThreadLevelSummary. +#testConstraint ThreadLevelSummary 0 + +if 0 { + # For debugging: run with a single value of ThreadLevel: 0|1|2 + set ThreadLevel 0 + testConstraint ThreadLevelSummary 1 +} if {![info exists ThreadLevel]} { if {[catch {package require Thread}] == 0} { set ValueRange {0 1 2} @@ -33,6 +41,9 @@ if {![info exists ThreadLevel]} { } catch {unset ThreadLevel} catch {unset ValueRange} + if {![testConstraint ThreadLevelSummary]} { + ::tcltest::cleanupTests + } return } @@ -889,4 +900,6 @@ unset header footer delay label suffix match cons name te namespace delete ::httpTest namespace delete ::httpTestScript -::tcltest::cleanupTests +if {[testConstraint ThreadLevelSummary]} { + ::tcltest::cleanupTests +} diff --git a/tests/httpProxy.test b/tests/httpProxy.test index 2429811..49818c9 100644 --- a/tests/httpProxy.test +++ b/tests/httpProxy.test @@ -41,16 +41,18 @@ proc stopMe {token} { set ${token}(z) done } proc putsBlurb {} { + puts {} puts {- Constraints needsTls, knownTwapiFullBugThreadlevelAny, knownTwapiFullBugThreadUsed are} puts { always set by the script, not by the caller.} puts {- Set one of needsTclTls, needsTwapi, needsTwapiFull instead of needsTls.} puts {- Set knownBug instead of knownTwapiFullBugThreadlevelAny, knownTwapiFullBugThreadUsed.} puts {- If the caller sets constraint needsTwapi, the script forces needsSquidNoAuth and needsSquidAuth to 0.} + puts {} return } if 0 { - # Run with a single velue of ThreadLevel: 0|1|2 + # For debugging: run with a single value of ThreadLevel: 0|1|2 set ThreadLevel 0 testConstraint ThreadLevelSummary 1 } @@ -68,10 +70,9 @@ if {![info exists ThreadLevel]} { } catch {unset ThreadLevel} catch {unset ValueRange} - if {![testConstraint ThreadLevelSummary] - } { - ::tcltest::cleanupTests + if {![testConstraint ThreadLevelSummary]} { putsBlurb + ::tcltest::cleanupTests } return } @@ -187,9 +188,10 @@ foreach constr { knownTwapiFullBugThreadlevelAny knownTwapiFullBugThreadUsed } { - puts [list testConstraint $constr [testConstraint $constr]] + # For debugging. + # puts [list testConstraint $constr [testConstraint $constr]] } -putsBlurb +#putsBlurb test httpProxy-1.1.$ThreadLevel {squid is running - ipv4 no-auth} -constraints {needsSquidNoAuth} -setup { } -body { @@ -1373,11 +1375,11 @@ rename bgerror {} rename stopMe {} if {[testConstraint ThreadLevelSummary]} { - ::tcltest::cleanupTests putsBlurb + ::tcltest::cleanupTests + rename putsBlurb {} } - # Local variables: # mode: tcl # End: -- cgit v0.12 From 3ecf9e8deba13e0cf0e0a6e7494cde610be0a6c4 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 20 Dec 2023 19:31:13 +0000 Subject: Spacing --- doc/const.n | 18 +++++++++--------- generic/tclCompCmds.c | 4 ++-- generic/tclExecute.c | 2 +- generic/tclInt.h | 4 ++-- generic/tclVar.c | 20 ++++++++++---------- tests/var.test | 24 ++++++++++++------------ 6 files changed, 36 insertions(+), 36 deletions(-) diff --git a/doc/const.n b/doc/const.n index b432655..9bc77ba 100644 --- a/doc/const.n +++ b/doc/const.n @@ -15,25 +15,25 @@ const \- create and initialize a constant .BE .SH DESCRIPTION .PP -This command is normally used within a procedure body (or method body, -or lambda term) to create a constant within that procedure, or within a -\fBnamespace eval\fR body to create a constant within that namespace. -The constant is an unmodifiable variable, called \fIvarName\fR, that is +This command is normally used within a procedure body (or method body, +or lambda term) to create a constant within that procedure, or within a +\fBnamespace eval\fR body to create a constant within that namespace. +The constant is an unmodifiable variable, called \fIvarName\fR, that is initialized with \fIvalue\fR. The result of \fBconst\fR is always the empty string on success. .PP -If a variable \fIvarName\fR does not exist, it is created with its value set +If a variable \fIvarName\fR does not exist, it is created with its value set to \fIvalue\fR and marked as a constant; this means that no other command (e.g., \fBset\fR, \fBappend\fR, \fBincr\fR, \fBunset\fR) -may modify or remove the variable; variables are checked for whether they +may modify or remove the variable; variables are checked for whether they are constants before any traces are called. -If a variable \fIvarName\fR already exists, it is an error unless that +If a variable \fIvarName\fR already exists, it is an error unless that variable is marked as a constant (in which case \fBconst\fR is a no-op). .PP -The \fIvarName\fR may not be a qualified name or reference an element of an +The \fIvarName\fR may not be a qualified name or reference an element of an array by any means. If the variable exists and is an array, that is an error. .PP -Constants are normally only removed by their containing procedure exiting or +Constants are normally only removed by their containing procedure exiting or their namespace being deleted. .SH EXAMPLES .PP diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 2536ba7..495c307 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -947,7 +947,7 @@ TclCompileConstCmd( int isScalar, localIndex; /* - * Need exactly two arguments. + * Need exactly two arguments. */ if (parsePtr->numWords != 3) { return TCL_ERROR; @@ -967,7 +967,7 @@ TclCompileConstCmd( /* * If the user specified an array element, we don't bother handling - * that. + * that. */ if (!isScalar) { return TCL_ERROR; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index f4ea875..225cc53 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -3975,7 +3975,7 @@ TEBCresume( Tcl_Obj *resPtr; DECACHE_STACK_INFO(); - resPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, NULL, + resPtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, NULL, objPtr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); if (resPtr == NULL) { diff --git a/generic/tclInt.h b/generic/tclInt.h index 95374eb..c9b4814 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -661,8 +661,8 @@ typedef struct VarInHash { * through "upvar" and "global" commands, or * through references to variables in enclosing * namespaces. - * VAR_CONSTANT - 1 means this is a constant "variable", and - * cannot be written to by ordinary commands. + * VAR_CONSTANT - 1 means this is a constant "variable", and + * cannot be written to by ordinary commands. * Structurally, it's the same as a scalar when * being read, but writes are rejected. Constants * are not supported inside arrays. diff --git a/generic/tclVar.c b/generic/tclVar.c index 4ab9dd5..125091a 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -180,7 +180,7 @@ typedef struct ArrayVarHashTable { */ static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr, - Tcl_Obj *patternPtr, int includeLinks, + Tcl_Obj *patternPtr, int includeLinks, int justConstants); static void ArrayPopulateSearch(Tcl_Interp *interp, Tcl_Obj *arrayNameObj, Var *varPtr, @@ -4845,7 +4845,7 @@ Tcl_GetVariableFullName( *---------------------------------------------------------------------- * * Tcl_ConstObjCmd -- - * + * * This function is invoked to process the "const" Tcl command. * See the user documentation for details on what it does. * @@ -4854,7 +4854,7 @@ Tcl_GetVariableFullName( * * Side effects: * See the user documentation. - * + * *---------------------------------------------------------------------- */ @@ -4874,7 +4874,7 @@ Tcl_ConstObjCmd( } part1Ptr = objv[1]; - varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, TCL_LEAVE_ERR_MSG, + varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, TCL_LEAVE_ERR_MSG, "const", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (TclIsVarArray(varPtr)) { TclObjVarErrMsg(interp, part1Ptr, NULL, "make constant", ISARRAY, -1); @@ -4891,7 +4891,7 @@ Tcl_ConstObjCmd( } /* - * If already exists, either a constant (no problem) or an error. + * If already exists, either a constant (no problem) or an error. */ if (!TclIsVarUndefined(varPtr)) { if (TclIsVarConstant(varPtr)) { @@ -4905,7 +4905,7 @@ Tcl_ConstObjCmd( /* * Make the variable and flag it as a constant. */ - if (TclPtrSetVar(interp, (Tcl_Var) varPtr, NULL, objv[1], NULL, + if (TclPtrSetVar(interp, (Tcl_Var) varPtr, NULL, objv[1], NULL, objv[2], TCL_LEAVE_ERR_MSG) == NULL) { if (TclIsVarUndefined(varPtr)) { CleanupVar(varPtr, arrayPtr); @@ -6522,8 +6522,8 @@ ContextObjectContainsConstant( Tcl_Obj *varNamePtr) { /* - * Helper for AppendLocals to check if an object contains a variable - * that is a constant. It's too complicated without factoring this + * Helper for AppendLocals to check if an object contains a variable + * that is a constant. It's too complicated without factoring this * check out! */ @@ -6642,7 +6642,7 @@ AppendLocals( } if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD) { - Tcl_ObjectContext context = (Tcl_ObjectContext) + Tcl_ObjectContext context = (Tcl_ObjectContext) iPtr->varFramePtr->clientData; Method *mPtr = (Method *) Tcl_ObjectContextMethod(context); PrivateVariableMapping *privatePtr; @@ -6652,7 +6652,7 @@ AppendLocals( FOREACH(objNamePtr, oPtr->variables) { Tcl_CreateHashEntry(&addedTable, objNamePtr, &added); - if (justConstants && !ContextObjectContainsConstant(context, + if (justConstants && !ContextObjectContainsConstant(context, objNamePtr)) { continue; } diff --git a/tests/var.test b/tests/var.test index a42f6cb..405a4b8 100644 --- a/tests/var.test +++ b/tests/var.test @@ -1951,12 +1951,12 @@ test var-29.2 {const: TclOO variable resolution} -setup { method checkWrite {} { list [catch { set X abc - } msg] $msg + } msg] $msg } method checkUnset {} { list [catch { unset X - } msg] $msg + } msg] $msg } method checkProbe {} { info constant X @@ -1985,12 +1985,12 @@ test var-29.3 {const: TclOO variable resolution} -setup { method checkWrite {} { list [catch { set X abc - } msg] $msg + } msg] $msg } method checkUnset {} { list [catch { unset X - } msg] $msg + } msg] $msg } method checkProbe {} { info constant X @@ -2019,13 +2019,13 @@ test var-29.4 {const: TclOO variable resolution} -setup { method checkWrite {} { list [catch { set X abc - } msg] $msg + } msg] $msg } method checkUnset {} { list [catch { unset X set X gorp - } msg] $msg + } msg] $msg } method checkProbe {} { info constant X @@ -2053,12 +2053,12 @@ test var-29.5 {const: TclOO variable resolution} -setup { method checkWrite {} { list [catch { set X abc - } msg] $msg + } msg] $msg } method checkUnset {} { list [catch { unset X - } msg] $msg + } msg] $msg } method checkProbe {} { info constant X @@ -2086,12 +2086,12 @@ test var-29.6 {const: TclOO variable resolution} -setup { method checkWrite {} { list [catch { set X abc - } msg] $msg + } msg] $msg } method checkUnset {} { list [catch { unset X - } msg] $msg + } msg] $msg } method checkProbe {} { info constant X @@ -2119,13 +2119,13 @@ test var-29.7 {const: TclOO variable resolution} -setup { method checkWrite {} { list [catch { set X abc - } msg] $msg + } msg] $msg } method checkUnset {} { list [catch { unset X set X gorp - } msg] $msg + } msg] $msg } method checkProbe {} { info constant X -- cgit v0.12 From 5e27dadda3ad29730ff4d460b798b561cfaaba56 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 20 Dec 2023 19:50:44 +0000 Subject: Convert tests/twapiTlsPlus.tcl from CRLF -> LF --- tests/twapiTlsPlus.tcl | 96 +++++++++++++++++++++++++------------------------- 1 file changed, 48 insertions(+), 48 deletions(-) diff --git a/tests/twapiTlsPlus.tcl b/tests/twapiTlsPlus.tcl index 9901afa..d254e86 100644 --- a/tests/twapiTlsPlus.tcl +++ b/tests/twapiTlsPlus.tcl @@ -1,48 +1,48 @@ -# Module twapiTlsPlus -# -# Temporary wrapper for package twapi, to expose the same API as package tls. -# - Command twapiTlsPlus::socket, cf. tls::socket, replacement for ::socket, for -# use with http::register. -# - Variable twapiTlsPlus::socketCmd, cf. tls::socketCmd, holds the value of the -# callback command used by twapi to open a socket. -# -# Intended to allow twapi TLS to use an https proxy server, and a background -# thread for evaluation of ::socket. -# -# For twapiTlsPlus to work correctly, twapi*/tls.tcl must be edited so that -#- set so [$socketcmd {*}$socket_args {*}$args] -#+ set so [{*}$socketcmd {*}$socket_args {*}$args] - -package require http -package require twapi - -namespace eval twapiTlsPlus { - variable socketCmd [::twapi::tls_socket_command] - namespace export socket -} - -# Proc twapiTlsPlus::socket -# Replacement for ::socket, use with http::register. - -proc twapiTlsPlus::socket {args} { - variable socketCmd - - set targ [lsearch -exact $args -type] - if {$targ != -1} { - set token [lindex $args $targ+1] - set args [lreplace $args $targ $targ+1 -socketcmd [list {*}$socketCmd -type $token]] - } - ::twapi::tls_socket {*}$args -} - -# Variable twapi::tls::_socket_cmd does it. - -proc twapiTlsPlus::TraceSocketCmd {args} { - variable socketCmd - ::twapi::tls_socket_command $socketCmd - return -} - -trace add variable ::twapiTlsPlus::socketCmd write ::twapiTlsPlus::TraceSocketCmd - -package provide twapiTlsPlus 0.1 +# Module twapiTlsPlus +# +# Temporary wrapper for package twapi, to expose the same API as package tls. +# - Command twapiTlsPlus::socket, cf. tls::socket, replacement for ::socket, for +# use with http::register. +# - Variable twapiTlsPlus::socketCmd, cf. tls::socketCmd, holds the value of the +# callback command used by twapi to open a socket. +# +# Intended to allow twapi TLS to use an https proxy server, and a background +# thread for evaluation of ::socket. +# +# For twapiTlsPlus to work correctly, twapi*/tls.tcl must be edited so that +#- set so [$socketcmd {*}$socket_args {*}$args] +#+ set so [{*}$socketcmd {*}$socket_args {*}$args] + +package require http +package require twapi + +namespace eval twapiTlsPlus { + variable socketCmd [::twapi::tls_socket_command] + namespace export socket +} + +# Proc twapiTlsPlus::socket +# Replacement for ::socket, use with http::register. + +proc twapiTlsPlus::socket {args} { + variable socketCmd + + set targ [lsearch -exact $args -type] + if {$targ != -1} { + set token [lindex $args $targ+1] + set args [lreplace $args $targ $targ+1 -socketcmd [list {*}$socketCmd -type $token]] + } + ::twapi::tls_socket {*}$args +} + +# Variable twapi::tls::_socket_cmd does it. + +proc twapiTlsPlus::TraceSocketCmd {args} { + variable socketCmd + ::twapi::tls_socket_command $socketCmd + return +} + +trace add variable ::twapiTlsPlus::socketCmd write ::twapiTlsPlus::TraceSocketCmd + +package provide twapiTlsPlus 0.1 -- cgit v0.12 From 8bfca08a31e48b9d6b6dd15fe6b917ff5d131b25 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 20 Dec 2023 19:51:49 +0000 Subject: spacing --- tests/httpProxy.test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/httpProxy.test b/tests/httpProxy.test index 49818c9..5fdc326 100644 --- a/tests/httpProxy.test +++ b/tests/httpProxy.test @@ -147,7 +147,7 @@ if {[testConstraint needsTclTls]} { # Testing with Squid # - Example Squid configuration for Enterprise Linux 8 (Red Hat, Oracle, Rocky, # Alma, ...) is in file tests/httpProxySquidConfigForEL8.tar.gz. -# - Example Squid configuration for Diladele Squid on Windows is in +# - Example Squid configuration for Diladele Squid on Windows is in # file tests/httpProxySquidConfigForWindowsDiladele.zip. # # - Two instances of Squid are launched, one that needs authentication and one -- cgit v0.12 From fdd31f01af097ec28840719500e10429efc2d1da Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 20 Dec 2023 22:27:58 +0000 Subject: Teach tcl+pkgs harness how to build/install packages for both Tcl 8 and Tcl 9 --- unix/Makefile.in | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/unix/Makefile.in b/unix/Makefile.in index 64a7496..3da7199 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -2023,6 +2023,7 @@ PKG_CFG_ARGS = @PKG_CFG_ARGS@ # cannot use absolute paths due to issues in nested configure when path to # build dir contains spaces). PKG_DIR = ./pkgs +PKG8_DIR = ./pkgs8 configure-packages: @for i in $(PKGS_DIR)/*; do \ @@ -2030,6 +2031,14 @@ configure-packages: if [ -x $$i/configure ] ; then \ pkg=`basename $$i`; \ echo "Configuring package '$$pkg'"; \ + mkdir -p $(PKG8_DIR)/$$pkg; \ + if [ ! -f $(PKG8_DIR)/$$pkg/Makefile ] ; then \ + ( cd $(PKG8_DIR)/$$pkg; \ + $$i/configure --with-tcl8 --with-tcl=../.. \ + --with-tclinclude=$(GENERIC_DIR) \ + $(PKG_CFG_ARGS) --libdir=$(PACKAGE_DIR) \ + --enable-shared; ) || exit $$?; \ + fi; \ mkdir -p $(PKG_DIR)/$$pkg; \ if [ ! -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ ( cd $(PKG_DIR)/$$pkg; \ @@ -2046,6 +2055,10 @@ packages: configure-packages ${STUB_LIB_FILE} @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ + if [ -f $(PKG8_DIR)/$$pkg/Makefile ] ; then \ + echo "Building package '$$pkg' for Tcl 8"; \ + ( cd $(PKG8_DIR)/$$pkg; $(MAKE); ) || exit $$?; \ + fi; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ echo "Building package '$$pkg'"; \ ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) || exit $$?; \ @@ -2057,6 +2070,11 @@ install-packages: packages @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ + if [ -f $(PKG8_DIR)/$$pkg/Makefile ] ; then \ + echo "Installing package '$$pkg' for Tcl 8"; \ + ( cd $(PKG8_DIR)/$$pkg; $(MAKE) install \ + "DESTDIR=$(INSTALL_ROOT)"; ) || exit $$?; \ + fi; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ echo "Installing package '$$pkg'"; \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) install \ @@ -2084,6 +2102,9 @@ clean-packages: @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ + if [ -f $(PKG8_DIR)/$$pkg/Makefile ] ; then \ + ( cd $(PKG8_DIR)/$$pkg; $(MAKE) clean; ) \ + fi; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \ fi; \ @@ -2094,12 +2115,17 @@ distclean-packages: @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ] ; then \ pkg=`basename $$i`; \ + if [ -f $(PKG8_DIR)/$$pkg/Makefile ] ; then \ + ( cd $(PKG8_DIR)/$$pkg; $(MAKE) distclean; ) \ + fi; \ + rm -rf $(PKG8_DIR)/$$pkg; \ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \ ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \ fi; \ rm -rf $(PKG_DIR)/$$pkg; \ fi; \ done; \ + rm -rf $(PKG8_DIR) rm -rf $(PKG_DIR) dist-packages: configure-packages -- cgit v0.12 From 8f1502f35075298537e0a5f19fd343c071bcf89f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 21 Dec 2023 10:37:52 +0000 Subject: Fix superfluous ';' --- generic/tclOO.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclOO.h b/generic/tclOO.h index 638947e..7cda876 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -116,7 +116,7 @@ typedef struct { * be copied directly. */ } Tcl_MethodType2; #else -#define Tcl_MethodType2 Tcl_MethodType; +#define Tcl_MethodType2 Tcl_MethodType #endif /* -- cgit v0.12 From 65738aa5d9f77cfc19ecdb1f2061afd6e457c0e1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 21 Dec 2023 13:28:07 +0000 Subject: Remove many (8.6-compatibility)-stub entries which are not in use any more. --- generic/tclIntPlatDecls.h | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index c777278..aab3737 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -117,7 +117,7 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, /* Slot 2 is reserved */ /* Slot 3 is reserved */ /* 4 */ -EXTERN HINSTANCE TclWinGetTclInstance(void); +EXTERN void * TclWinGetTclInstance(void); /* 5 */ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); /* Slot 6 is reserved */ @@ -260,7 +260,7 @@ typedef struct TclIntPlatStubs { Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ void (*reserved11)(void); void (*reserved12)(void); - char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ + void (*reserved13)(void); int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */ int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */ @@ -280,16 +280,16 @@ typedef struct TclIntPlatStubs { int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ - void (*tclWinConvertError) (DWORD errCode); /* 0 */ - void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */ - struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */ - int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */ - HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */ + void (*reserved0)(void); + void (*reserved1)(void); + void (*reserved2)(void); + void (*reserved3)(void); + void * (*tclWinGetTclInstance) (void); /* 4 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */ - unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */ - int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */ + void (*reserved6)(void); + void (*reserved7)(void); Tcl_Size (*tclpGetPid) (Tcl_Pid pid); /* 8 */ - int (*tclWinGetPlatformId) (void); /* 9 */ + void (*reserved9)(void); void *(*tclpReaddir) (void *dir); /* 10 */ void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ int (*tclpCloseFile) (TclFile file); /* 12 */ @@ -301,14 +301,14 @@ typedef struct TclIntPlatStubs { TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */ void (*tclWinAddProcess) (void *hProcess, Tcl_Size id); /* 20 */ - char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */ + void (*reserved21)(void); TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */ void (*reserved23)(void); char * (*tclWinNoBackslash) (char *path); /* 24 */ void (*reserved25)(void); - void (*tclWinSetInterfaces) (int wide); /* 26 */ + void (*reserved26)(void); void (*tclWinFlushDirtyChannels) (void); /* 27 */ - void (*tclWinResetInterfaces) (void); /* 28 */ + void (*reserved28)(void); int (*tclWinCPUID) (int index, int *regs); /* 29 */ int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */ #endif /* WIN */ @@ -326,7 +326,7 @@ typedef struct TclIntPlatStubs { Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */ void (*reserved11)(void); void (*reserved12)(void); - char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ + void (*reserved13)(void); int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */ int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */ -- cgit v0.12 From e10b13e99a40050fd20e158ab043f356db43aba3 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 21 Dec 2023 14:39:08 +0000 Subject: off-by-one doc error --- generic/tclStubCall.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclStubCall.c b/generic/tclStubCall.c index e0d85a6..29af44c 100644 --- a/generic/tclStubCall.c +++ b/generic/tclStubCall.c @@ -39,7 +39,7 @@ MODULE_SCOPE void *tclStubsHandle; /* Table containing which function will be returned, depending on the "arg" */ static const char PROCNAME[][24] = { - "_Tcl_SetPanicProc", /* Default, whenever "arg" <= 0 or "arg" > 8 */ + "_Tcl_SetPanicProc", /* Default, whenever "arg" <= 0 or "arg" > 9 */ "_Tcl_InitSubsystems", /* "arg" == (void *)1 */ "_Tcl_FindExecutable", /* "arg" == (void *)2 */ "_TclZipfs_AppHook", /* "arg" == (void *)3 */ -- cgit v0.12 From 86ec1937ecf8a9472114efa2a76b3a039f14f797 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 22 Dec 2023 08:06:36 +0000 Subject: Document "string is unicode" --- doc/string.n | 2 ++ 1 file changed, 2 insertions(+) diff --git a/doc/string.n b/doc/string.n index aefe485..6a9a8e1 100644 --- a/doc/string.n +++ b/doc/string.n @@ -174,6 +174,8 @@ 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 .IP \fBupper\fR 12 Any upper case alphabet character in the Unicode character set. .IP \fBwideinteger\fR 12 -- cgit v0.12 From a60836ba34f8f92853ce8dfa0f8ab67fa40b2309 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 24 Dec 2023 12:41:28 +0000 Subject: update to TZDATA 2023d --- library/tzdata/America/Nuuk | 2 +- library/tzdata/America/Scoresbysund | 304 ++++++++++++++++++------------------ library/tzdata/Antarctica/Casey | 5 + library/tzdata/Antarctica/Vostok | 10 +- library/tzdata/Asia/Gaza | 9 +- library/tzdata/Asia/Hebron | 9 +- 6 files changed, 177 insertions(+), 162 deletions(-) diff --git a/library/tzdata/America/Nuuk b/library/tzdata/America/Nuuk index 06b472c..cb136da 100644 --- a/library/tzdata/America/Nuuk +++ b/library/tzdata/America/Nuuk @@ -89,7 +89,7 @@ set TZData(:America/Nuuk) { {1635642000 -10800 0 -03} {1648342800 -7200 1 -02} {1667091600 -10800 0 -03} - {1679792400 -7200 1 -02} + {1679792400 -7200 0 -02} {1698541200 -7200 0 -02} {1711846800 -3600 1 -01} {1729990800 -7200 0 -02} diff --git a/library/tzdata/America/Scoresbysund b/library/tzdata/America/Scoresbysund index 7430635..77dbe49 100644 --- a/library/tzdata/America/Scoresbysund +++ b/library/tzdata/America/Scoresbysund @@ -91,156 +91,156 @@ set TZData(:America/Scoresbysund) { {1667091600 -3600 0 -01} {1679792400 0 1 +00} {1698541200 -3600 0 -01} - {1711846800 0 1 +00} - {1729990800 -3600 0 -01} - {1743296400 0 1 +00} - {1761440400 -3600 0 -01} - {1774746000 0 1 +00} - {1792890000 -3600 0 -01} - {1806195600 0 1 +00} - {1824944400 -3600 0 -01} - {1837645200 0 1 +00} - {1856394000 -3600 0 -01} - {1869094800 0 1 +00} - {1887843600 -3600 0 -01} - {1901149200 0 1 +00} - {1919293200 -3600 0 -01} - {1932598800 0 1 +00} - {1950742800 -3600 0 -01} - {1964048400 0 1 +00} - {1982797200 -3600 0 -01} - {1995498000 0 1 +00} - {2014246800 -3600 0 -01} - {2026947600 0 1 +00} - {2045696400 -3600 0 -01} - {2058397200 0 1 +00} - {2077146000 -3600 0 -01} - {2090451600 0 1 +00} - {2108595600 -3600 0 -01} - {2121901200 0 1 +00} - {2140045200 -3600 0 -01} - {2153350800 0 1 +00} - {2172099600 -3600 0 -01} - {2184800400 0 1 +00} - {2203549200 -3600 0 -01} - {2216250000 0 1 +00} - {2234998800 -3600 0 -01} - {2248304400 0 1 +00} - {2266448400 -3600 0 -01} - {2279754000 0 1 +00} - {2297898000 -3600 0 -01} - {2311203600 0 1 +00} - {2329347600 -3600 0 -01} - {2342653200 0 1 +00} - {2361402000 -3600 0 -01} - {2374102800 0 1 +00} - {2392851600 -3600 0 -01} - {2405552400 0 1 +00} - {2424301200 -3600 0 -01} - {2437606800 0 1 +00} - {2455750800 -3600 0 -01} - {2469056400 0 1 +00} - {2487200400 -3600 0 -01} - {2500506000 0 1 +00} - {2519254800 -3600 0 -01} - {2531955600 0 1 +00} - {2550704400 -3600 0 -01} - {2563405200 0 1 +00} - {2582154000 -3600 0 -01} - {2595459600 0 1 +00} - {2613603600 -3600 0 -01} - {2626909200 0 1 +00} - {2645053200 -3600 0 -01} - {2658358800 0 1 +00} - {2676502800 -3600 0 -01} - {2689808400 0 1 +00} - {2708557200 -3600 0 -01} - {2721258000 0 1 +00} - {2740006800 -3600 0 -01} - {2752707600 0 1 +00} - {2771456400 -3600 0 -01} - {2784762000 0 1 +00} - {2802906000 -3600 0 -01} - {2816211600 0 1 +00} - {2834355600 -3600 0 -01} - {2847661200 0 1 +00} - {2866410000 -3600 0 -01} - {2879110800 0 1 +00} - {2897859600 -3600 0 -01} - {2910560400 0 1 +00} - {2929309200 -3600 0 -01} - {2942010000 0 1 +00} - {2960758800 -3600 0 -01} - {2974064400 0 1 +00} - {2992208400 -3600 0 -01} - {3005514000 0 1 +00} - {3023658000 -3600 0 -01} - {3036963600 0 1 +00} - {3055712400 -3600 0 -01} - {3068413200 0 1 +00} - {3087162000 -3600 0 -01} - {3099862800 0 1 +00} - {3118611600 -3600 0 -01} - {3131917200 0 1 +00} - {3150061200 -3600 0 -01} - {3163366800 0 1 +00} - {3181510800 -3600 0 -01} - {3194816400 0 1 +00} - {3212960400 -3600 0 -01} - {3226266000 0 1 +00} - {3245014800 -3600 0 -01} - {3257715600 0 1 +00} - {3276464400 -3600 0 -01} - {3289165200 0 1 +00} - {3307914000 -3600 0 -01} - {3321219600 0 1 +00} - {3339363600 -3600 0 -01} - {3352669200 0 1 +00} - {3370813200 -3600 0 -01} - {3384118800 0 1 +00} - {3402867600 -3600 0 -01} - {3415568400 0 1 +00} - {3434317200 -3600 0 -01} - {3447018000 0 1 +00} - {3465766800 -3600 0 -01} - {3479072400 0 1 +00} - {3497216400 -3600 0 -01} - {3510522000 0 1 +00} - {3528666000 -3600 0 -01} - {3541971600 0 1 +00} - {3560115600 -3600 0 -01} - {3573421200 0 1 +00} - {3592170000 -3600 0 -01} - {3604870800 0 1 +00} - {3623619600 -3600 0 -01} - {3636320400 0 1 +00} - {3655069200 -3600 0 -01} - {3668374800 0 1 +00} - {3686518800 -3600 0 -01} - {3699824400 0 1 +00} - {3717968400 -3600 0 -01} - {3731274000 0 1 +00} - {3750022800 -3600 0 -01} - {3762723600 0 1 +00} - {3781472400 -3600 0 -01} - {3794173200 0 1 +00} - {3812922000 -3600 0 -01} - {3825622800 0 1 +00} - {3844371600 -3600 0 -01} - {3857677200 0 1 +00} - {3875821200 -3600 0 -01} - {3889126800 0 1 +00} - {3907270800 -3600 0 -01} - {3920576400 0 1 +00} - {3939325200 -3600 0 -01} - {3952026000 0 1 +00} - {3970774800 -3600 0 -01} - {3983475600 0 1 +00} - {4002224400 -3600 0 -01} - {4015530000 0 1 +00} - {4033674000 -3600 0 -01} - {4046979600 0 1 +00} - {4065123600 -3600 0 -01} - {4078429200 0 1 +00} - {4096573200 -3600 0 -01} + {1711846800 -3600 0 -01} + {1729990800 -7200 0 -02} + {1743296400 -3600 1 -01} + {1761440400 -7200 0 -02} + {1774746000 -3600 1 -01} + {1792890000 -7200 0 -02} + {1806195600 -3600 1 -01} + {1824944400 -7200 0 -02} + {1837645200 -3600 1 -01} + {1856394000 -7200 0 -02} + {1869094800 -3600 1 -01} + {1887843600 -7200 0 -02} + {1901149200 -3600 1 -01} + {1919293200 -7200 0 -02} + {1932598800 -3600 1 -01} + {1950742800 -7200 0 -02} + {1964048400 -3600 1 -01} + {1982797200 -7200 0 -02} + {1995498000 -3600 1 -01} + {2014246800 -7200 0 -02} + {2026947600 -3600 1 -01} + {2045696400 -7200 0 -02} + {2058397200 -3600 1 -01} + {2077146000 -7200 0 -02} + {2090451600 -3600 1 -01} + {2108595600 -7200 0 -02} + {2121901200 -3600 1 -01} + {2140045200 -7200 0 -02} + {2153350800 -3600 1 -01} + {2172099600 -7200 0 -02} + {2184800400 -3600 1 -01} + {2203549200 -7200 0 -02} + {2216250000 -3600 1 -01} + {2234998800 -7200 0 -02} + {2248304400 -3600 1 -01} + {2266448400 -7200 0 -02} + {2279754000 -3600 1 -01} + {2297898000 -7200 0 -02} + {2311203600 -3600 1 -01} + {2329347600 -7200 0 -02} + {2342653200 -3600 1 -01} + {2361402000 -7200 0 -02} + {2374102800 -3600 1 -01} + {2392851600 -7200 0 -02} + {2405552400 -3600 1 -01} + {2424301200 -7200 0 -02} + {2437606800 -3600 1 -01} + {2455750800 -7200 0 -02} + {2469056400 -3600 1 -01} + {2487200400 -7200 0 -02} + {2500506000 -3600 1 -01} + {2519254800 -7200 0 -02} + {2531955600 -3600 1 -01} + {2550704400 -7200 0 -02} + {2563405200 -3600 1 -01} + {2582154000 -7200 0 -02} + {2595459600 -3600 1 -01} + {2613603600 -7200 0 -02} + {2626909200 -3600 1 -01} + {2645053200 -7200 0 -02} + {2658358800 -3600 1 -01} + {2676502800 -7200 0 -02} + {2689808400 -3600 1 -01} + {2708557200 -7200 0 -02} + {2721258000 -3600 1 -01} + {2740006800 -7200 0 -02} + {2752707600 -3600 1 -01} + {2771456400 -7200 0 -02} + {2784762000 -3600 1 -01} + {2802906000 -7200 0 -02} + {2816211600 -3600 1 -01} + {2834355600 -7200 0 -02} + {2847661200 -3600 1 -01} + {2866410000 -7200 0 -02} + {2879110800 -3600 1 -01} + {2897859600 -7200 0 -02} + {2910560400 -3600 1 -01} + {2929309200 -7200 0 -02} + {2942010000 -3600 1 -01} + {2960758800 -7200 0 -02} + {2974064400 -3600 1 -01} + {2992208400 -7200 0 -02} + {3005514000 -3600 1 -01} + {3023658000 -7200 0 -02} + {3036963600 -3600 1 -01} + {3055712400 -7200 0 -02} + {3068413200 -3600 1 -01} + {3087162000 -7200 0 -02} + {3099862800 -3600 1 -01} + {3118611600 -7200 0 -02} + {3131917200 -3600 1 -01} + {3150061200 -7200 0 -02} + {3163366800 -3600 1 -01} + {3181510800 -7200 0 -02} + {3194816400 -3600 1 -01} + {3212960400 -7200 0 -02} + {3226266000 -3600 1 -01} + {3245014800 -7200 0 -02} + {3257715600 -3600 1 -01} + {3276464400 -7200 0 -02} + {3289165200 -3600 1 -01} + {3307914000 -7200 0 -02} + {3321219600 -3600 1 -01} + {3339363600 -7200 0 -02} + {3352669200 -3600 1 -01} + {3370813200 -7200 0 -02} + {3384118800 -3600 1 -01} + {3402867600 -7200 0 -02} + {3415568400 -3600 1 -01} + {3434317200 -7200 0 -02} + {3447018000 -3600 1 -01} + {3465766800 -7200 0 -02} + {3479072400 -3600 1 -01} + {3497216400 -7200 0 -02} + {3510522000 -3600 1 -01} + {3528666000 -7200 0 -02} + {3541971600 -3600 1 -01} + {3560115600 -7200 0 -02} + {3573421200 -3600 1 -01} + {3592170000 -7200 0 -02} + {3604870800 -3600 1 -01} + {3623619600 -7200 0 -02} + {3636320400 -3600 1 -01} + {3655069200 -7200 0 -02} + {3668374800 -3600 1 -01} + {3686518800 -7200 0 -02} + {3699824400 -3600 1 -01} + {3717968400 -7200 0 -02} + {3731274000 -3600 1 -01} + {3750022800 -7200 0 -02} + {3762723600 -3600 1 -01} + {3781472400 -7200 0 -02} + {3794173200 -3600 1 -01} + {3812922000 -7200 0 -02} + {3825622800 -3600 1 -01} + {3844371600 -7200 0 -02} + {3857677200 -3600 1 -01} + {3875821200 -7200 0 -02} + {3889126800 -3600 1 -01} + {3907270800 -7200 0 -02} + {3920576400 -3600 1 -01} + {3939325200 -7200 0 -02} + {3952026000 -3600 1 -01} + {3970774800 -7200 0 -02} + {3983475600 -3600 1 -01} + {4002224400 -7200 0 -02} + {4015530000 -3600 1 -01} + {4033674000 -7200 0 -02} + {4046979600 -3600 1 -01} + {4065123600 -7200 0 -02} + {4078429200 -3600 1 -01} + {4096573200 -7200 0 -02} } diff --git a/library/tzdata/Antarctica/Casey b/library/tzdata/Antarctica/Casey index 56935e3..644a6a1 100644 --- a/library/tzdata/Antarctica/Casey +++ b/library/tzdata/Antarctica/Casey @@ -14,4 +14,9 @@ set TZData(:Antarctica/Casey) { {1570129200 39600 0 +11} {1583596800 28800 0 +08} {1601740860 39600 0 +11} + {1615640400 28800 0 +08} + {1633190460 39600 0 +11} + {1647090000 28800 0 +08} + {1664640060 39600 0 +11} + {1678291200 28800 0 +08} } diff --git a/library/tzdata/Antarctica/Vostok b/library/tzdata/Antarctica/Vostok index 1a19a5d..bc1ea7b 100644 --- a/library/tzdata/Antarctica/Vostok +++ b/library/tzdata/Antarctica/Vostok @@ -1,5 +1,9 @@ # created by tools/tclZIC.tcl - do not edit -if {![info exists TZData(Asia/Urumqi)]} { - LoadTimeZoneFile Asia/Urumqi + +set TZData(:Antarctica/Vostok) { + {-9223372036854775808 0 0 -00} + {-380073600 25200 0 +07} + {760035600 0 0 -00} + {783648000 25200 0 +07} + {1702839600 18000 0 +05} } -set TZData(:Antarctica/Vostok) $TZData(:Asia/Urumqi) diff --git a/library/tzdata/Asia/Gaza b/library/tzdata/Asia/Gaza index d3789d3..c92bb05 100644 --- a/library/tzdata/Asia/Gaza +++ b/library/tzdata/Asia/Gaza @@ -260,13 +260,16 @@ set TZData(:Asia/Gaza) { {3226176000 10800 1 EEST} {3240687600 7200 0 EET} {3243715200 10800 1 EEST} - {3257622000 10800 1 EEST} + {3244921200 7200 0 EET} + {3257625600 10800 1 EEST} {3271532400 7200 0 EET} {3274560000 10800 1 EEST} - {3289071600 10800 1 EEST} + {3276370800 7200 0 EET} + {3289075200 10800 1 EEST} {3301772400 7200 0 EET} {3305404800 10800 1 EEST} - {3321126000 10800 1 EEST} + {3307820400 7200 0 EET} + {3321129600 10800 1 EEST} {3332617200 7200 0 EET} {3335644800 10800 1 EEST} {3339270000 7200 0 EET} diff --git a/library/tzdata/Asia/Hebron b/library/tzdata/Asia/Hebron index 140c841..be62148 100644 --- a/library/tzdata/Asia/Hebron +++ b/library/tzdata/Asia/Hebron @@ -259,13 +259,16 @@ set TZData(:Asia/Hebron) { {3226176000 10800 1 EEST} {3240687600 7200 0 EET} {3243715200 10800 1 EEST} - {3257622000 10800 1 EEST} + {3244921200 7200 0 EET} + {3257625600 10800 1 EEST} {3271532400 7200 0 EET} {3274560000 10800 1 EEST} - {3289071600 10800 1 EEST} + {3276370800 7200 0 EET} + {3289075200 10800 1 EEST} {3301772400 7200 0 EET} {3305404800 10800 1 EEST} - {3321126000 10800 1 EEST} + {3307820400 7200 0 EET} + {3321129600 10800 1 EEST} {3332617200 7200 0 EET} {3335644800 10800 1 EEST} {3339270000 7200 0 EET} -- cgit v0.12 From 4c97b25f81b1f2cbabe7f084e86e539bcbdbc21a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 26 Dec 2023 16:31:27 +0000 Subject: Don't use TCL_SIZE_MODIFIER "u", since Tcl_Size can be negative --- generic/tclDisassemble.c | 36 ++++++++++++++++++------------------ generic/tclEncoding.c | 8 ++++---- generic/tclIORChan.c | 7 +++++-- generic/tclListObj.c | 23 ++++++++++++++--------- generic/tclProc.c | 8 ++++---- 5 files changed, 45 insertions(+), 37 deletions(-) diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index cc13ce9..adbae1d 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -56,7 +56,7 @@ static const Tcl_ObjType instNameType = { const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep((objPtr), &instNameType); \ assert(irPtr != NULL); \ - (inst) = (size_t)irPtr->wideValue; \ + (inst) = irPtr->wideValue; \ } while (0) @@ -278,7 +278,7 @@ DisassembleByteCodeObj( */ Tcl_AppendPrintfToObj(bufferObj, - "ByteCode %p, refCt %" TCL_SIZE_MODIFIER "u, epoch %" TCL_SIZE_MODIFIER "u, interp %p (epoch %" TCL_SIZE_MODIFIER "u)\n", + "ByteCode %p, refCt %" TCL_SIZE_MODIFIER "d, epoch %" TCL_SIZE_MODIFIER "d, interp %p (epoch %" TCL_SIZE_MODIFIER "d)\n", codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch); Tcl_AppendToObj(bufferObj, " Source ", -1); PrintSourceToObj(bufferObj, codePtr->source, @@ -289,7 +289,7 @@ DisassembleByteCodeObj( TclGetString(fileObj), line); } Tcl_AppendPrintfToObj(bufferObj, - "\n Cmds %d, src %" TCL_SIZE_MODIFIER "u, inst %" TCL_SIZE_MODIFIER "u, litObjs %" TCL_SIZE_MODIFIER "u, aux %" TCL_SIZE_MODIFIER "u, stkDepth %" TCL_SIZE_MODIFIER "u, code/src %.2f\n", + "\n Cmds %d, src %" TCL_SIZE_MODIFIER "d, inst %" TCL_SIZE_MODIFIER "d, litObjs %" TCL_SIZE_MODIFIER "d, aux %" TCL_SIZE_MODIFIER "d, stkDepth %" TCL_SIZE_MODIFIER "d, code/src %.2f\n", numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes, codePtr->numLitObjects, codePtr->numAuxDataItems, codePtr->maxStackDepth, @@ -301,8 +301,8 @@ DisassembleByteCodeObj( #ifdef TCL_COMPILE_STATS Tcl_AppendPrintfToObj(bufferObj, - " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_SIZE_MODIFIER "u+litObj %" - TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_SIZE_MODIFIER "u\n", + " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_SIZE_MODIFIER "d+litObj %" + TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_SIZE_MODIFIER "d\n", codePtr->structureSize, offsetof(ByteCode, localCachePtr), codePtr->numCodeBytes, @@ -323,7 +323,7 @@ DisassembleByteCodeObj( Tcl_Size numCompiledLocals = procPtr->numCompiledLocals; Tcl_AppendPrintfToObj(bufferObj, - " Proc %p, refCt %" TCL_SIZE_MODIFIER "u, args %" TCL_SIZE_MODIFIER "u, compiled locals %" TCL_SIZE_MODIFIER "u\n", + " Proc %p, refCt %" TCL_SIZE_MODIFIER "d, args %" TCL_SIZE_MODIFIER "d, compiled locals %" TCL_SIZE_MODIFIER "d\n", procPtr, procPtr->refCount, procPtr->numArgs, numCompiledLocals); if (numCompiledLocals > 0) { @@ -331,7 +331,7 @@ DisassembleByteCodeObj( for (i = 0; i < numCompiledLocals; i++) { Tcl_AppendPrintfToObj(bufferObj, - " slot %" TCL_SIZE_MODIFIER "u%s%s%s%s%s%s", i, + " slot %" TCL_SIZE_MODIFIER "d%s%s%s%s%s%s", i, (localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar", (localPtr->flags & VAR_ARRAY) ? ", array" : "", (localPtr->flags & VAR_LINK) ? ", link" : "", @@ -354,24 +354,24 @@ DisassembleByteCodeObj( */ if (codePtr->numExceptRanges > 0) { - Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %" TCL_SIZE_MODIFIER "u, depth %" TCL_SIZE_MODIFIER "u:\n", + Tcl_AppendPrintfToObj(bufferObj, " Exception ranges %" TCL_SIZE_MODIFIER "d, depth %" TCL_SIZE_MODIFIER "d:\n", codePtr->numExceptRanges, codePtr->maxExceptDepth); for (i = 0; i < codePtr->numExceptRanges; i++) { ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i]; Tcl_AppendPrintfToObj(bufferObj, - " %" TCL_SIZE_MODIFIER "u: level %" TCL_SIZE_MODIFIER "u, %s, pc %" TCL_SIZE_MODIFIER "u-%" TCL_SIZE_MODIFIER "u, ", + " %" TCL_SIZE_MODIFIER "d: level %" TCL_SIZE_MODIFIER "d, %s, pc %" TCL_SIZE_MODIFIER "d-%" TCL_SIZE_MODIFIER "d, ", i, rangePtr->nestingLevel, (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"), rangePtr->codeOffset, (rangePtr->codeOffset + rangePtr->numCodeBytes - 1)); switch (rangePtr->type) { case LOOP_EXCEPTION_RANGE: - Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_SIZE_MODIFIER "u, break %" TCL_SIZE_MODIFIER "u\n", + Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_SIZE_MODIFIER "d, break %" TCL_SIZE_MODIFIER "d\n", rangePtr->continueOffset, rangePtr->breakOffset); break; case CATCH_EXCEPTION_RANGE: - Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_SIZE_MODIFIER "u\n", + Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_SIZE_MODIFIER "d\n", rangePtr->catchOffset); break; default: @@ -445,7 +445,7 @@ DisassembleByteCodeObj( srcLengthNext++; } - Tcl_AppendPrintfToObj(bufferObj, "%s%4" TCL_SIZE_MODIFIER "u: pc %d-%d, src %d-%d", + Tcl_AppendPrintfToObj(bufferObj, "%s%4" TCL_SIZE_MODIFIER "d: pc %d-%d, src %d-%d", ((i % 2)? " " : "\n "), (i+1), codeOffset, (codeOffset + codeLen - 1), srcOffset, (srcOffset + srcLen - 1)); @@ -504,7 +504,7 @@ DisassembleByteCodeObj( pc += FormatInstruction(codePtr, pc, bufferObj); } - Tcl_AppendPrintfToObj(bufferObj, " Command %" TCL_SIZE_MODIFIER "u: ", i+1); + Tcl_AppendPrintfToObj(bufferObj, " Command %" TCL_SIZE_MODIFIER "d: ", i+1); PrintSourceToObj(bufferObj, (codePtr->source + srcOffset), TclMin(srcLen, 55)); Tcl_AppendToObj(bufferObj, "\n", -1); @@ -625,7 +625,7 @@ FormatInstruction( printLVTindex: if (localPtr != NULL) { if (opnd >= localCt) { - Tcl_Panic("FormatInstruction: bad local var index %u (%" TCL_SIZE_MODIFIER "u locals)", + Tcl_Panic("FormatInstruction: bad local var index %u (%" TCL_SIZE_MODIFIER "d locals)", opnd, localCt); } for (j = 0; j < opnd; j++) { @@ -840,7 +840,7 @@ UpdateStringOfInstName( (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } else { const char *s = tclInstructionTable[inst].name; - unsigned int len = strlen(s); + size_t len = strlen(s); dst = Tcl_InitStringRep(objPtr, s, len); TclOOM(dst, len); } @@ -1146,14 +1146,14 @@ DisassembleByteCodeAsDicts( switch (rangePtr->type) { case LOOP_EXCEPTION_RANGE: Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf( - "type %s level %" TCL_SIZE_MODIFIER "u from %" TCL_SIZE_MODIFIER "u to %" TCL_SIZE_MODIFIER "u break %" TCL_SIZE_MODIFIER "u continue %" TCL_SIZE_MODIFIER "u", + "type %s level %" TCL_SIZE_MODIFIER "d from %" TCL_SIZE_MODIFIER "d to %" TCL_SIZE_MODIFIER "d break %" TCL_SIZE_MODIFIER "d continue %" TCL_SIZE_MODIFIER "d", "loop", rangePtr->nestingLevel, rangePtr->codeOffset, rangePtr->codeOffset + rangePtr->numCodeBytes - 1, rangePtr->breakOffset, rangePtr->continueOffset)); break; case CATCH_EXCEPTION_RANGE: Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf( - "type %s level %" TCL_SIZE_MODIFIER "u from %" TCL_SIZE_MODIFIER "u to %" TCL_SIZE_MODIFIER "u catch %" TCL_SIZE_MODIFIER "u", + "type %s level %" TCL_SIZE_MODIFIER "d from %" TCL_SIZE_MODIFIER "d to %" TCL_SIZE_MODIFIER "d catch %" TCL_SIZE_MODIFIER "d", "catch", rangePtr->nestingLevel, rangePtr->codeOffset, rangePtr->codeOffset + rangePtr->numCodeBytes - 1, rangePtr->catchOffset)); @@ -1268,7 +1268,7 @@ DisassembleByteCodeAsDicts( int Tcl_DisassembleObjCmd( - ClientData clientData, /* What type of operation. */ + void *clientData, /* What type of operation. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 262dd01..2d1c983 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -1224,7 +1224,7 @@ Tcl_ExternalToUtfDString( * Tcl_ExternalToUtfDStringEx -- * * Convert a source buffer from the specified encoding into UTF-8. - * The parameter flags controls the behavior, if any of the bytes in + * "flags" controls the behavior if any of the bytes in * the source buffer are invalid or cannot be represented in utf-8. * Possible flags values: * target encoding. It should be composed by OR-ing the following: @@ -1333,11 +1333,11 @@ Tcl_ExternalToUtfDStringEx( /* Caller wants error message on failure */ if (result != TCL_OK && interp != NULL) { char buf[TCL_INTEGER_SPACE]; - snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "u", nBytesProcessed); + snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "d", nBytesProcessed); Tcl_SetObjResult( interp, Tcl_ObjPrintf("unexpected byte sequence starting at index %" - TCL_SIZE_MODIFIER "u: '\\x%02X'", + TCL_SIZE_MODIFIER "d: '\\x%02X'", nBytesProcessed, UCHAR(srcStart[nBytesProcessed]))); Tcl_SetErrorCode( @@ -1636,7 +1636,7 @@ Tcl_UtfToExternalDStringEx( int ucs4; char buf[TCL_INTEGER_SPACE]; Tcl_UtfToUniChar(&srcStart[nBytesProcessed], &ucs4); - snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "u", nBytesProcessed); + snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "d", nBytesProcessed); Tcl_SetObjResult( interp, Tcl_ObjPrintf( diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index e342126..41e9e88 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -587,6 +587,9 @@ TclChanCreateObjCmd( rcId = NextHandle(); rcPtr = NewReflectedChannel(interp, cmdObj, mode, rcId); + if (!rcPtr) { + return TCL_ERROR; + } /* * Invoke 'initialize' and validate that the handler is present and ok. @@ -1402,7 +1405,7 @@ ReflectInput( if (toRead < bytec) { SetChannelErrorStr(rcPtr->chan, msg_read_toomuch); - goto invalid; + goto invalid; } *errorCodePtr = EOK; @@ -3344,7 +3347,7 @@ ForwardProc( char *buf = (char *)ckalloc(200); snprintf(buf, 200, - "{Expected list with even number of elements, got %d %s instead}", + "{Expected list with even number of elements, got %" TCL_SIZE_MODIFIER "d %s instead}", listc, (listc == 1 ? "element" : "elements")); ForwardSetDynamicError(paramPtr, buf); diff --git a/generic/tclListObj.c b/generic/tclListObj.c index d9f13d0..94322f2 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -394,7 +394,7 @@ ObjArrayIncrRefs( Tcl_Size startIdx, /* Starting index of subarray within objv */ Tcl_Size count) /* Number of elements in the subarray */ { - Tcl_Obj * const *end; + Tcl_Obj *const *end; LIST_INDEX_ASSERT(startIdx); LIST_COUNT_ASSERT(count); objv += startIdx; @@ -492,9 +492,9 @@ MemoryAllocationError( Tcl_SetObjResult( interp, Tcl_ObjPrintf( - "list construction failed: unable to alloc %" TCL_LL_MODIFIER + "list construction failed: unable to alloc %" TCL_Z_MODIFIER "u bytes", - (Tcl_WideInt)size)); + size)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", (void *)NULL); } return TCL_ERROR; @@ -1764,7 +1764,7 @@ Tcl_ListObjAppendList( if (TclListObjGetRep(interp, toObj, &listRep) != TCL_OK) return TCL_ERROR; /* Cannot be converted to a list */ - if (elemCount == 0) + if (elemCount <= 0) return TCL_OK; /* Nothing to do. Note AFTER check for list above */ ListRepElements(&listRep, toLen, toObjv); @@ -1852,7 +1852,7 @@ Tcl_ListObjAppendList( : LISTREP_SPACE_ONLY_BACK, &listRep) != TCL_OK) { - return TCL_ERROR; + return MemoryAllocationError(interp, finalLen); } LIST_ASSERT(listRep.storePtr->numAllocated >= finalLen); @@ -2765,7 +2765,7 @@ TclLsetList( */ if (!TclHasInternalRep(indexArgObj, &tclListType) - && TclGetIntForIndexM(NULL, indexArgObj, TCL_SIZE_MAX - 1, &index) + && TclGetIntForIndexM(NULL, indexArgObj, TCL_SIZE_MAX - 1, &index) == TCL_OK) { /* indexArgPtr designates a single index. */ @@ -2933,6 +2933,11 @@ TclLsetFlat( } indexArray++; + /* + * Special case 0-length lists. The Tcl indexing function treat + * will return any value beyond length as TCL_SIZE_MAX for this + * case. + */ if ((index == TCL_SIZE_MAX) && (elemCount == 0)) { index = 0; } @@ -3133,10 +3138,10 @@ TclListObjSetElement( elemCount = ListRepLength(&listRep); /* Ensure that the index is in bounds. */ - if (index<0 || index>=elemCount) { + if ((index < 0) || (index >= elemCount)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "index \"%" TCL_SIZE_MODIFIER "u\" out of range", index)); + "index \"%" TCL_SIZE_MODIFIER "d\" out of range", index)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "OUTOFRANGE", (void *)NULL); } @@ -3568,7 +3573,7 @@ TclListTestObj(size_t length, size_t leadingSpace, size_t endSpace) return NULL; } - ListRepInit(capacity, NULL, 0, &listRep); + ListRepInit(capacity, NULL, LISTREP_PANIC_ON_FAIL, &listRep); ListStore *storePtr = listRep.storePtr; size_t i; diff --git a/generic/tclProc.c b/generic/tclProc.c index adb69ba..4ea10ad 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -493,8 +493,8 @@ TclCreateProc( if (precompiled) { if (numArgs > procPtr->numArgs) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "procedure \"%s\": arg list contains %" TCL_SIZE_MODIFIER "u entries, " - "precompiled header expects %" TCL_SIZE_MODIFIER "u", procName, numArgs, + "procedure \"%s\": arg list contains %" TCL_SIZE_MODIFIER "d entries, " + "precompiled header expects %" TCL_SIZE_MODIFIER "d", procName, numArgs, procPtr->numArgs)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "BYTECODELIES", (void *)NULL); @@ -588,7 +588,7 @@ TclCreateProc( || (localPtr->defValuePtr == NULL && fieldCount == 2) || (localPtr->defValuePtr != NULL && fieldCount != 2)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "procedure \"%s\": formal parameter %" TCL_SIZE_MODIFIER "u is " + "procedure \"%s\": formal parameter %" TCL_SIZE_MODIFIER "d is " "inconsistent with precompiled body", procName, i)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "BYTECODELIES", (void *)NULL); @@ -2277,7 +2277,7 @@ TclUpdateReturnInfo( * * TclGetObjInterpProc -- * - * Returns a pointer to the TclObjInterpProc functions; + * Returns a pointer to the TclObjInterpProc function; * this is different from the value obtained from the TclObjInterpProc * reference on systems like Windows where import and export versions * of a function exported by a DLL exist. -- cgit v0.12 From 00fd838ed3f9189b84f541227ce2679d951813d1 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 28 Dec 2023 17:08:33 +0000 Subject: update to TZDATA 2023d --- library/tzdata/America/Nuuk | 2 +- library/tzdata/America/Scoresbysund | 304 ++++++++++++++++++------------------ library/tzdata/Antarctica/Casey | 5 + library/tzdata/Antarctica/Vostok | 10 +- library/tzdata/Asia/Gaza | 9 +- library/tzdata/Asia/Hebron | 9 +- 6 files changed, 177 insertions(+), 162 deletions(-) diff --git a/library/tzdata/America/Nuuk b/library/tzdata/America/Nuuk index 06b472c..cb136da 100644 --- a/library/tzdata/America/Nuuk +++ b/library/tzdata/America/Nuuk @@ -89,7 +89,7 @@ set TZData(:America/Nuuk) { {1635642000 -10800 0 -03} {1648342800 -7200 1 -02} {1667091600 -10800 0 -03} - {1679792400 -7200 1 -02} + {1679792400 -7200 0 -02} {1698541200 -7200 0 -02} {1711846800 -3600 1 -01} {1729990800 -7200 0 -02} diff --git a/library/tzdata/America/Scoresbysund b/library/tzdata/America/Scoresbysund index 7430635..77dbe49 100644 --- a/library/tzdata/America/Scoresbysund +++ b/library/tzdata/America/Scoresbysund @@ -91,156 +91,156 @@ set TZData(:America/Scoresbysund) { {1667091600 -3600 0 -01} {1679792400 0 1 +00} {1698541200 -3600 0 -01} - {1711846800 0 1 +00} - {1729990800 -3600 0 -01} - {1743296400 0 1 +00} - {1761440400 -3600 0 -01} - {1774746000 0 1 +00} - {1792890000 -3600 0 -01} - {1806195600 0 1 +00} - {1824944400 -3600 0 -01} - {1837645200 0 1 +00} - {1856394000 -3600 0 -01} - {1869094800 0 1 +00} - {1887843600 -3600 0 -01} - {1901149200 0 1 +00} - {1919293200 -3600 0 -01} - {1932598800 0 1 +00} - {1950742800 -3600 0 -01} - {1964048400 0 1 +00} - {1982797200 -3600 0 -01} - {1995498000 0 1 +00} - {2014246800 -3600 0 -01} - {2026947600 0 1 +00} - {2045696400 -3600 0 -01} - {2058397200 0 1 +00} - {2077146000 -3600 0 -01} - {2090451600 0 1 +00} - {2108595600 -3600 0 -01} - {2121901200 0 1 +00} - {2140045200 -3600 0 -01} - {2153350800 0 1 +00} - {2172099600 -3600 0 -01} - {2184800400 0 1 +00} - {2203549200 -3600 0 -01} - {2216250000 0 1 +00} - {2234998800 -3600 0 -01} - {2248304400 0 1 +00} - {2266448400 -3600 0 -01} - {2279754000 0 1 +00} - {2297898000 -3600 0 -01} - {2311203600 0 1 +00} - {2329347600 -3600 0 -01} - {2342653200 0 1 +00} - {2361402000 -3600 0 -01} - {2374102800 0 1 +00} - {2392851600 -3600 0 -01} - {2405552400 0 1 +00} - {2424301200 -3600 0 -01} - {2437606800 0 1 +00} - {2455750800 -3600 0 -01} - {2469056400 0 1 +00} - {2487200400 -3600 0 -01} - {2500506000 0 1 +00} - {2519254800 -3600 0 -01} - {2531955600 0 1 +00} - {2550704400 -3600 0 -01} - {2563405200 0 1 +00} - {2582154000 -3600 0 -01} - {2595459600 0 1 +00} - {2613603600 -3600 0 -01} - {2626909200 0 1 +00} - {2645053200 -3600 0 -01} - {2658358800 0 1 +00} - {2676502800 -3600 0 -01} - {2689808400 0 1 +00} - {2708557200 -3600 0 -01} - {2721258000 0 1 +00} - {2740006800 -3600 0 -01} - {2752707600 0 1 +00} - {2771456400 -3600 0 -01} - {2784762000 0 1 +00} - {2802906000 -3600 0 -01} - {2816211600 0 1 +00} - {2834355600 -3600 0 -01} - {2847661200 0 1 +00} - {2866410000 -3600 0 -01} - {2879110800 0 1 +00} - {2897859600 -3600 0 -01} - {2910560400 0 1 +00} - {2929309200 -3600 0 -01} - {2942010000 0 1 +00} - {2960758800 -3600 0 -01} - {2974064400 0 1 +00} - {2992208400 -3600 0 -01} - {3005514000 0 1 +00} - {3023658000 -3600 0 -01} - {3036963600 0 1 +00} - {3055712400 -3600 0 -01} - {3068413200 0 1 +00} - {3087162000 -3600 0 -01} - {3099862800 0 1 +00} - {3118611600 -3600 0 -01} - {3131917200 0 1 +00} - {3150061200 -3600 0 -01} - {3163366800 0 1 +00} - {3181510800 -3600 0 -01} - {3194816400 0 1 +00} - {3212960400 -3600 0 -01} - {3226266000 0 1 +00} - {3245014800 -3600 0 -01} - {3257715600 0 1 +00} - {3276464400 -3600 0 -01} - {3289165200 0 1 +00} - {3307914000 -3600 0 -01} - {3321219600 0 1 +00} - {3339363600 -3600 0 -01} - {3352669200 0 1 +00} - {3370813200 -3600 0 -01} - {3384118800 0 1 +00} - {3402867600 -3600 0 -01} - {3415568400 0 1 +00} - {3434317200 -3600 0 -01} - {3447018000 0 1 +00} - {3465766800 -3600 0 -01} - {3479072400 0 1 +00} - {3497216400 -3600 0 -01} - {3510522000 0 1 +00} - {3528666000 -3600 0 -01} - {3541971600 0 1 +00} - {3560115600 -3600 0 -01} - {3573421200 0 1 +00} - {3592170000 -3600 0 -01} - {3604870800 0 1 +00} - {3623619600 -3600 0 -01} - {3636320400 0 1 +00} - {3655069200 -3600 0 -01} - {3668374800 0 1 +00} - {3686518800 -3600 0 -01} - {3699824400 0 1 +00} - {3717968400 -3600 0 -01} - {3731274000 0 1 +00} - {3750022800 -3600 0 -01} - {3762723600 0 1 +00} - {3781472400 -3600 0 -01} - {3794173200 0 1 +00} - {3812922000 -3600 0 -01} - {3825622800 0 1 +00} - {3844371600 -3600 0 -01} - {3857677200 0 1 +00} - {3875821200 -3600 0 -01} - {3889126800 0 1 +00} - {3907270800 -3600 0 -01} - {3920576400 0 1 +00} - {3939325200 -3600 0 -01} - {3952026000 0 1 +00} - {3970774800 -3600 0 -01} - {3983475600 0 1 +00} - {4002224400 -3600 0 -01} - {4015530000 0 1 +00} - {4033674000 -3600 0 -01} - {4046979600 0 1 +00} - {4065123600 -3600 0 -01} - {4078429200 0 1 +00} - {4096573200 -3600 0 -01} + {1711846800 -3600 0 -01} + {1729990800 -7200 0 -02} + {1743296400 -3600 1 -01} + {1761440400 -7200 0 -02} + {1774746000 -3600 1 -01} + {1792890000 -7200 0 -02} + {1806195600 -3600 1 -01} + {1824944400 -7200 0 -02} + {1837645200 -3600 1 -01} + {1856394000 -7200 0 -02} + {1869094800 -3600 1 -01} + {1887843600 -7200 0 -02} + {1901149200 -3600 1 -01} + {1919293200 -7200 0 -02} + {1932598800 -3600 1 -01} + {1950742800 -7200 0 -02} + {1964048400 -3600 1 -01} + {1982797200 -7200 0 -02} + {1995498000 -3600 1 -01} + {2014246800 -7200 0 -02} + {2026947600 -3600 1 -01} + {2045696400 -7200 0 -02} + {2058397200 -3600 1 -01} + {2077146000 -7200 0 -02} + {2090451600 -3600 1 -01} + {2108595600 -7200 0 -02} + {2121901200 -3600 1 -01} + {2140045200 -7200 0 -02} + {2153350800 -3600 1 -01} + {2172099600 -7200 0 -02} + {2184800400 -3600 1 -01} + {2203549200 -7200 0 -02} + {2216250000 -3600 1 -01} + {2234998800 -7200 0 -02} + {2248304400 -3600 1 -01} + {2266448400 -7200 0 -02} + {2279754000 -3600 1 -01} + {2297898000 -7200 0 -02} + {2311203600 -3600 1 -01} + {2329347600 -7200 0 -02} + {2342653200 -3600 1 -01} + {2361402000 -7200 0 -02} + {2374102800 -3600 1 -01} + {2392851600 -7200 0 -02} + {2405552400 -3600 1 -01} + {2424301200 -7200 0 -02} + {2437606800 -3600 1 -01} + {2455750800 -7200 0 -02} + {2469056400 -3600 1 -01} + {2487200400 -7200 0 -02} + {2500506000 -3600 1 -01} + {2519254800 -7200 0 -02} + {2531955600 -3600 1 -01} + {2550704400 -7200 0 -02} + {2563405200 -3600 1 -01} + {2582154000 -7200 0 -02} + {2595459600 -3600 1 -01} + {2613603600 -7200 0 -02} + {2626909200 -3600 1 -01} + {2645053200 -7200 0 -02} + {2658358800 -3600 1 -01} + {2676502800 -7200 0 -02} + {2689808400 -3600 1 -01} + {2708557200 -7200 0 -02} + {2721258000 -3600 1 -01} + {2740006800 -7200 0 -02} + {2752707600 -3600 1 -01} + {2771456400 -7200 0 -02} + {2784762000 -3600 1 -01} + {2802906000 -7200 0 -02} + {2816211600 -3600 1 -01} + {2834355600 -7200 0 -02} + {2847661200 -3600 1 -01} + {2866410000 -7200 0 -02} + {2879110800 -3600 1 -01} + {2897859600 -7200 0 -02} + {2910560400 -3600 1 -01} + {2929309200 -7200 0 -02} + {2942010000 -3600 1 -01} + {2960758800 -7200 0 -02} + {2974064400 -3600 1 -01} + {2992208400 -7200 0 -02} + {3005514000 -3600 1 -01} + {3023658000 -7200 0 -02} + {3036963600 -3600 1 -01} + {3055712400 -7200 0 -02} + {3068413200 -3600 1 -01} + {3087162000 -7200 0 -02} + {3099862800 -3600 1 -01} + {3118611600 -7200 0 -02} + {3131917200 -3600 1 -01} + {3150061200 -7200 0 -02} + {3163366800 -3600 1 -01} + {3181510800 -7200 0 -02} + {3194816400 -3600 1 -01} + {3212960400 -7200 0 -02} + {3226266000 -3600 1 -01} + {3245014800 -7200 0 -02} + {3257715600 -3600 1 -01} + {3276464400 -7200 0 -02} + {3289165200 -3600 1 -01} + {3307914000 -7200 0 -02} + {3321219600 -3600 1 -01} + {3339363600 -7200 0 -02} + {3352669200 -3600 1 -01} + {3370813200 -7200 0 -02} + {3384118800 -3600 1 -01} + {3402867600 -7200 0 -02} + {3415568400 -3600 1 -01} + {3434317200 -7200 0 -02} + {3447018000 -3600 1 -01} + {3465766800 -7200 0 -02} + {3479072400 -3600 1 -01} + {3497216400 -7200 0 -02} + {3510522000 -3600 1 -01} + {3528666000 -7200 0 -02} + {3541971600 -3600 1 -01} + {3560115600 -7200 0 -02} + {3573421200 -3600 1 -01} + {3592170000 -7200 0 -02} + {3604870800 -3600 1 -01} + {3623619600 -7200 0 -02} + {3636320400 -3600 1 -01} + {3655069200 -7200 0 -02} + {3668374800 -3600 1 -01} + {3686518800 -7200 0 -02} + {3699824400 -3600 1 -01} + {3717968400 -7200 0 -02} + {3731274000 -3600 1 -01} + {3750022800 -7200 0 -02} + {3762723600 -3600 1 -01} + {3781472400 -7200 0 -02} + {3794173200 -3600 1 -01} + {3812922000 -7200 0 -02} + {3825622800 -3600 1 -01} + {3844371600 -7200 0 -02} + {3857677200 -3600 1 -01} + {3875821200 -7200 0 -02} + {3889126800 -3600 1 -01} + {3907270800 -7200 0 -02} + {3920576400 -3600 1 -01} + {3939325200 -7200 0 -02} + {3952026000 -3600 1 -01} + {3970774800 -7200 0 -02} + {3983475600 -3600 1 -01} + {4002224400 -7200 0 -02} + {4015530000 -3600 1 -01} + {4033674000 -7200 0 -02} + {4046979600 -3600 1 -01} + {4065123600 -7200 0 -02} + {4078429200 -3600 1 -01} + {4096573200 -7200 0 -02} } diff --git a/library/tzdata/Antarctica/Casey b/library/tzdata/Antarctica/Casey index 56935e3..644a6a1 100644 --- a/library/tzdata/Antarctica/Casey +++ b/library/tzdata/Antarctica/Casey @@ -14,4 +14,9 @@ set TZData(:Antarctica/Casey) { {1570129200 39600 0 +11} {1583596800 28800 0 +08} {1601740860 39600 0 +11} + {1615640400 28800 0 +08} + {1633190460 39600 0 +11} + {1647090000 28800 0 +08} + {1664640060 39600 0 +11} + {1678291200 28800 0 +08} } diff --git a/library/tzdata/Antarctica/Vostok b/library/tzdata/Antarctica/Vostok index 1a19a5d..bc1ea7b 100644 --- a/library/tzdata/Antarctica/Vostok +++ b/library/tzdata/Antarctica/Vostok @@ -1,5 +1,9 @@ # created by tools/tclZIC.tcl - do not edit -if {![info exists TZData(Asia/Urumqi)]} { - LoadTimeZoneFile Asia/Urumqi + +set TZData(:Antarctica/Vostok) { + {-9223372036854775808 0 0 -00} + {-380073600 25200 0 +07} + {760035600 0 0 -00} + {783648000 25200 0 +07} + {1702839600 18000 0 +05} } -set TZData(:Antarctica/Vostok) $TZData(:Asia/Urumqi) diff --git a/library/tzdata/Asia/Gaza b/library/tzdata/Asia/Gaza index d3789d3..c92bb05 100644 --- a/library/tzdata/Asia/Gaza +++ b/library/tzdata/Asia/Gaza @@ -260,13 +260,16 @@ set TZData(:Asia/Gaza) { {3226176000 10800 1 EEST} {3240687600 7200 0 EET} {3243715200 10800 1 EEST} - {3257622000 10800 1 EEST} + {3244921200 7200 0 EET} + {3257625600 10800 1 EEST} {3271532400 7200 0 EET} {3274560000 10800 1 EEST} - {3289071600 10800 1 EEST} + {3276370800 7200 0 EET} + {3289075200 10800 1 EEST} {3301772400 7200 0 EET} {3305404800 10800 1 EEST} - {3321126000 10800 1 EEST} + {3307820400 7200 0 EET} + {3321129600 10800 1 EEST} {3332617200 7200 0 EET} {3335644800 10800 1 EEST} {3339270000 7200 0 EET} diff --git a/library/tzdata/Asia/Hebron b/library/tzdata/Asia/Hebron index 140c841..be62148 100644 --- a/library/tzdata/Asia/Hebron +++ b/library/tzdata/Asia/Hebron @@ -259,13 +259,16 @@ set TZData(:Asia/Hebron) { {3226176000 10800 1 EEST} {3240687600 7200 0 EET} {3243715200 10800 1 EEST} - {3257622000 10800 1 EEST} + {3244921200 7200 0 EET} + {3257625600 10800 1 EEST} {3271532400 7200 0 EET} {3274560000 10800 1 EEST} - {3289071600 10800 1 EEST} + {3276370800 7200 0 EET} + {3289075200 10800 1 EEST} {3301772400 7200 0 EET} {3305404800 10800 1 EEST} - {3321126000 10800 1 EEST} + {3307820400 7200 0 EET} + {3321129600 10800 1 EEST} {3332617200 7200 0 EET} {3335644800 10800 1 EEST} {3339270000 7200 0 EET} -- cgit v0.12 From b41ee879346fd5fd483d4bc6ebc92e6c9a021002 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 29 Dec 2023 14:57:01 +0000 Subject: Unneeded #undef's. Testcase/comment cleanup --- generic/tclUtf.c | 25 ++++++++----------------- tests/utf.test | 20 ++++++++++---------- 2 files changed, 18 insertions(+), 27 deletions(-) diff --git a/generic/tclUtf.c b/generic/tclUtf.c index ba5948f..c554b98 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -204,11 +204,10 @@ Invalid( *--------------------------------------------------------------------------- */ -#undef Tcl_UniCharToUtf Tcl_Size Tcl_UniCharToUtf( int ch, /* The Tcl_UniChar to be stored in the - * buffer. Can be or'ed with flag TCL_COMBINE + * buffer. Can be or'ed with flag TCL_COMBINE. */ char *buf) /* Buffer in which the UTF-8 representation of * ch is stored. Must be large enough to hold the UTF-8 @@ -231,8 +230,7 @@ Tcl_UniCharToUtf( return 2; } if (ch <= 0xFFFF) { - if ( - (flags & TCL_COMBINE) && + if ((flags & TCL_COMBINE) && ((ch & 0xF800) == 0xD800)) { if (ch & 0x0400) { /* Low surrogate */ @@ -310,12 +308,11 @@ three: *--------------------------------------------------------------------------- */ -#undef Tcl_UniCharToUtfDString char * Tcl_UniCharToUtfDString( const int *uniStr, /* Unicode string to convert to UTF-8. */ Tcl_Size uniLength, /* Length of Unicode string. Negative for nul - * nul terminated string */ + * terminated string */ Tcl_DString *dsPtr) /* UTF-8 representation of string is appended * to this previously initialized DString. */ { @@ -363,7 +360,7 @@ Tcl_Char16ToUtfDString( { const unsigned short *w, *wEnd; char *p, *string; - size_t oldLength; + Tcl_Size oldLength; int len = 1; /* @@ -442,7 +439,6 @@ static const unsigned short cp1252[32] = { 0x2DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x9D, 0x017E, 0x0178 }; -#undef Tcl_UtfToUniChar Tcl_Size Tcl_UtfToUniChar( const char *src, /* The UTF-8 string. */ @@ -643,7 +639,6 @@ Tcl_UtfToChar16( *--------------------------------------------------------------------------- */ -#undef Tcl_UtfToUniCharDString int * Tcl_UtfToUniCharDString( const char *src, /* UTF-8 string to convert to Unicode. */ @@ -1011,7 +1006,7 @@ const char * Tcl_UtfNext( const char *src) /* The current location in the string. */ { - size_t left; + int left; const char *next; if (((*src) & 0xC0) == 0x80) { @@ -1222,13 +1217,10 @@ Tcl_UtfAtIndex( const char *src, /* The UTF-8 string. */ Tcl_Size index) /* The position of the desired character. */ { - int ch = 0; + Tcl_UniChar ch = 0; - if (index > 0) { - while (index--) { - /* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */ - src += Tcl_UtfToUniChar(src, &ch); - } + while (index-- > 0) { + src += Tcl_UtfToUniChar(src, &ch); } return src; } @@ -1843,7 +1835,6 @@ Tcl_Char16Len( *---------------------------------------------------------------------- */ -#undef Tcl_UniCharLen Tcl_Size Tcl_UniCharLen( const int *uniStr) /* Unicode string to find length of. */ diff --git a/tests/utf.test b/tests/utf.test index b2e34c8..b7f3468 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -62,12 +62,12 @@ test utf-1.10 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring test utf-1.11 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring { expr {[format %c 0xDC42] eq [testbytestring \xED\xB1\x82]} } 1 -test utf-1.12 {Tcl_UniCharToUtf: Invalid surrogate} { - expr {"\UD842" eq "\uD842"} -} 1 -test utf-1.13 {Tcl_UniCharToUtf: Invalid surrogate} testbytestring { +test utf-1.12 {Tcl_UniCharToUtf: Invalid surrogate} testbytestring { expr {"\UD842" eq [testbytestring \xED\xA1\x82]} } 1 +test utf-1.13 {Tcl_UniCharToUtf: Invalid surrogate} { + expr {"\UD842" eq "\uD842"} +} 1 test utf-1.14 {Tcl_UniCharToUtf: surrogate pairs from concat} { set lo \uDE02 return \uD83D$lo @@ -163,7 +163,7 @@ test utf-4.10 {Tcl_NumUtfChars: #x00, calc len, overcomplete} {testnumutfchars t test utf-4.11 {Tcl_NumUtfChars: 3 bytes of 4-byte UTF-8 characater} {testnumutfchars testbytestring} { testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end-1 } 3 -test utf-4.12.1 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring} { +test utf-4.12 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring} { testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end } 1 test utf-4.13 {Tcl_NumUtfChars: end of string} {testnumutfchars testbytestring} { @@ -212,7 +212,7 @@ test utf-6.9 {Tcl_UtfNext} {testutfnext testbytestring} { test utf-6.10 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xA0]G } 1 -test utf-6.11.1 {Tcl_UtfNext} {testutfnext testbytestring} { +test utf-6.11 {Tcl_UtfNext} {testutfnext testbytestring} { testutfnext [testbytestring \xA0\xA0\x00] } 2 test utf-6.12 {Tcl_UtfNext} {testutfnext testbytestring} { @@ -531,7 +531,7 @@ test utf-7.9.1 {Tcl_UtfPrev} {testutfprev testbytestring} { test utf-7.9.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF8\xA0\xF8\xA0] 3 } 2 -test utf-7.10.0 {Tcl_UtfPrev} {testutfprev testbytestring} { +test utf-7.10 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF2\xA0] } 1 test utf-7.10.1 {Tcl_UtfPrev} {testutfprev testbytestring} { @@ -579,7 +579,7 @@ test utf-7.14.1 {Tcl_UtfPrev} {testutfprev testbytestring} { test utf-7.14.2 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF8\xA0\xA0\xF8] 4 } 3 -test utf-7.15.0 {Tcl_UtfPrev} {testutfprev testbytestring} { +test utf-7.15 {Tcl_UtfPrev} {testutfprev testbytestring} { testutfprev A[testbytestring \xF2\xA0\xA0] } 1 test utf-7.15.1 {Tcl_UtfPrev} {testutfprev testbytestring} { @@ -714,7 +714,7 @@ test utf-7.47.1 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} tes test utf-7.47.2 {Tcl_UtfPrev, pointing to 3th byte of 3-byte invalid sequence} {testutfprev testbytestring} { testutfprev [testbytestring \xE8\xA0\x00] 2 } 0 -test utf-7.48.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring } { +test utf-7.48.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { testutfprev A[testbytestring \xF4\x8F\xBF\xBF] } 1 test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} { @@ -1026,7 +1026,7 @@ test utf-19.1 {TclUniCharLen} -body { test utf-20.1 {TclUniCharNcmp} { string compare [string range [format %c 0xFFFF] 0 0] [string range [format %c 0x10000] 0 0] } -1 -test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} { +test utf-20.2 {[4c591fa487] Tcl_UniCharNcmp/Tcl_UtfNcmp} { set one [format %c 0xFFFF] set two [format %c 0x10000] set first [string compare $one $two] -- cgit v0.12 From 74f2d36b9860906dc703a767164efa02b1cfe2b7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 29 Dec 2023 16:26:46 +0000 Subject: Fix incorrect TclUtfNcasecmp() usage (since len is in bytes, not characters here) --- unix/tclUnixChan.c | 51 +++++++++++++++++++++++++-------------------------- 1 file changed, 25 insertions(+), 26 deletions(-) diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index bd46191..fe36972 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -89,7 +89,7 @@ typedef struct TtyAttrs { if (interp) { \ Tcl_SetObjResult(interp, Tcl_ObjPrintf( \ "%s not supported for this platform", (detail))); \ - Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL); \ + Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", (char *)NULL); \ } /* @@ -487,7 +487,7 @@ FileWatchNotifyChannelWrapper( ClientData clientData, int mask) { - Tcl_Channel channel = clientData; + Tcl_Channel channel = (Tcl_Channel)clientData; Tcl_NotifyChannel(channel, mask); } @@ -606,7 +606,7 @@ TtySetOptionProc( const char *value) /* New value for option. */ { FileState *fsPtr = (FileState *)instanceData; - unsigned int len, vlen; + size_t len, vlen; TtyAttrs tty; int argc; const char **argv; @@ -646,20 +646,20 @@ TtySetOptionProc( #ifdef CRTSCTS CLEAR_BITS(iostate.c_cflag, CRTSCTS); #endif /* CRTSCTS */ - if (TclUtfNcasecmp(value, "NONE", vlen) == 0) { + if (strncasecmp(value, "NONE", vlen) == 0) { /* * Leave all handshake options disabled. */ - } else if (TclUtfNcasecmp(value, "XONXOFF", vlen) == 0) { + } else if (strncasecmp(value, "XONXOFF", vlen) == 0) { SET_BITS(iostate.c_iflag, IXON | IXOFF | IXANY); - } else if (TclUtfNcasecmp(value, "RTSCTS", vlen) == 0) { + } else if (strncasecmp(value, "RTSCTS", vlen) == 0) { #ifdef CRTSCTS SET_BITS(iostate.c_cflag, CRTSCTS); #else /* !CRTSTS */ UNSUPPORTED_OPTION("-handshake RTSCTS"); return TCL_ERROR; #endif /* CRTSCTS */ - } else if (TclUtfNcasecmp(value, "DTRDSR", vlen) == 0) { + } else if (strncasecmp(value, "DTRDSR", vlen) == 0) { UNSUPPORTED_OPTION("-handshake DTRDSR"); return TCL_ERROR; } else { @@ -668,7 +668,7 @@ TtySetOptionProc( "bad value for -handshake: must be one of" " xonxoff, rtscts, dtrdsr or none", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", - "VALUE", NULL); + "VALUE", (char *)NULL); } return TCL_ERROR; } @@ -747,7 +747,7 @@ TtySetOptionProc( "bad value for -ttycontrol: should be a list of" " signal,value pairs", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", - "VALUE", NULL); + "VALUE", (char *)NULL); } ckfree(argv); return TCL_ERROR; @@ -759,19 +759,19 @@ TtySetOptionProc( ckfree(argv); return TCL_ERROR; } - if (TclUtfNcasecmp(argv[i], "DTR", strlen(argv[i])) == 0) { + if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) { if (flag) { SET_BITS(control, TIOCM_DTR); } else { CLEAR_BITS(control, TIOCM_DTR); } - } else if (TclUtfNcasecmp(argv[i], "RTS", strlen(argv[i])) == 0) { + } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) { if (flag) { SET_BITS(control, TIOCM_RTS); } else { CLEAR_BITS(control, TIOCM_RTS); } - } else if (TclUtfNcasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) { + } else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) { #if defined(TIOCSBRK) && defined(TIOCCBRK) if (flag) { ioctl(fsPtr->fd, TIOCSBRK, NULL); @@ -789,7 +789,7 @@ TtySetOptionProc( "bad signal \"%s\" for -ttycontrol: must be" " DTR, RTS or BREAK", argv[i])); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE", - "VALUE", NULL); + "VALUE", (char *)NULL); } ckfree(argv); return TCL_ERROR; @@ -834,7 +834,7 @@ TtyGetOptionProc( Tcl_DString *dsPtr) /* Where to store value(s). */ { FileState *fsPtr = (FileState *)instanceData; - unsigned int len; + size_t len; char buf[3*TCL_INTEGER_SPACE + 16]; int valid = 0; /* Flag if valid option parsed. */ @@ -923,9 +923,8 @@ TtyGetOptionProc( if (valid) { return TCL_OK; } - return Tcl_BadChannelOption(interp, optionName, "mode" - " queue ttystatus xchar" - ); + return Tcl_BadChannelOption(interp, optionName, + "mode queue ttystatus xchar"); } static const struct {int baud; speed_t speed;} speeds[] = { @@ -1271,7 +1270,7 @@ TtyParseMode( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s: should be baud,parity,data,stop", bad)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL); } return TCL_ERROR; } @@ -1301,7 +1300,7 @@ TtyParseMode( "n, o, or e" #endif /* PAREXT */ )); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL); } return TCL_ERROR; } @@ -1310,7 +1309,7 @@ TtyParseMode( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s data: should be 5, 6, 7, or 8", bad)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL); } return TCL_ERROR; } @@ -1318,7 +1317,7 @@ TtyParseMode( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "%s stop: should be 1 or 2", bad)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", (char *)NULL); } return TCL_ERROR; } @@ -1425,7 +1424,7 @@ TclpOpenFileChannel( if (interp != (Tcl_Interp *) NULL) { Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr), "\": filename is invalid on this platform", - NULL); + (char *)NULL); } return NULL; } @@ -1701,13 +1700,13 @@ Tcl_GetOpenFile( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" wasn't opened for writing", chanID)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NOT_WRITABLE", - NULL); + (char *)NULL); return TCL_ERROR; } else if (!forWriting && !(chanMode & TCL_READABLE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" wasn't opened for reading", chanID)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NOT_READABLE", - NULL); + (char *)NULL); return TCL_ERROR; } @@ -1739,7 +1738,7 @@ Tcl_GetOpenFile( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "cannot get a FILE * for \"%s\"", chanID)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", - "FILE_FAILURE", NULL); + "FILE_FAILURE", (char *)NULL); return TCL_ERROR; } *filePtr = f; @@ -1750,7 +1749,7 @@ Tcl_GetOpenFile( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"%s\" cannot be used to get a FILE *", chanID)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NO_DESCRIPTOR", - NULL); + (char *)NULL); return TCL_ERROR; } -- cgit v0.12 From 09ddbde6daf827df0d55d28bde43c60696f88506 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 30 Dec 2023 21:32:22 +0000 Subject: (cherry-pick) Don't call getsockname(2) in Tcl_MakeFileChannel(3) unless absolutely necessary. Closes RFE [0ac9d06895]. Permits better constraining of Tcl/tclsh via OpenBSD's pledge(2) or similar mechanisms. Minor rewrite --- unix/tclUnixChan.c | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 0957282..132f690 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -1975,27 +1975,29 @@ Tcl_MakeFileChannel( char channelName[16 + TCL_INTEGER_SPACE]; int fd = PTR2INT(handle); const Tcl_ChannelType *channelTypePtr; - struct sockaddr sockaddr; - socklen_t sockaddrLen = sizeof(sockaddr); + Tcl_StatBuf buf; if (mode == 0) { return NULL; } - sockaddr.sa_family = AF_UNSPEC; - #ifdef SUPPORTS_TTY if (isatty(fd)) { channelTypePtr = &ttyChannelType; snprintf(channelName, sizeof(channelName), "serial%d", fd); } else #endif /* SUPPORTS_TTY */ - if ((getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0) + if (TclOSfstat(fd, &buf) == 0 && S_ISSOCK(buf.st_mode)) { + struct sockaddr sockaddr; + socklen_t sockaddrLen = sizeof(sockaddr); + + sockaddr.sa_family = AF_UNSPEC; + if ((getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0) && (sockaddrLen > 0) && (sockaddr.sa_family == AF_INET || sockaddr.sa_family == AF_INET6)) { - return (Tcl_Channel)TclpMakeTcpClientChannelMode(INT2PTR(fd), mode); - } else { + return (Tcl_Channel)TclpMakeTcpClientChannelMode(INT2PTR(fd), mode); + } channelTypePtr = &fileChannelType; snprintf(channelName, sizeof(channelName), "file%d", fd); } -- cgit v0.12 From 69102d9afb30ff314706eea8ebad3c5206be8739 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 30 Dec 2023 21:47:24 +0000 Subject: missing goto --- unix/tclUnixChan.c | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 132f690..fc2280a 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -1985,6 +1985,7 @@ Tcl_MakeFileChannel( if (isatty(fd)) { channelTypePtr = &ttyChannelType; snprintf(channelName, sizeof(channelName), "serial%d", fd); + goto final; } else #endif /* SUPPORTS_TTY */ if (TclOSfstat(fd, &buf) == 0 && S_ISSOCK(buf.st_mode)) { @@ -1998,10 +1999,10 @@ Tcl_MakeFileChannel( || sockaddr.sa_family == AF_INET6)) { return (Tcl_Channel)TclpMakeTcpClientChannelMode(INT2PTR(fd), mode); } - channelTypePtr = &fileChannelType; - snprintf(channelName, sizeof(channelName), "file%d", fd); } - + channelTypePtr = &fileChannelType; + snprintf(channelName, sizeof(channelName), "file%d", fd); +final: fsPtr = (TtyState *)ckalloc(sizeof(TtyState)); fsPtr->fileState.fd = fd; fsPtr->fileState.validMask = mode | TCL_EXCEPTION; -- cgit v0.12 From 2c2578a0600e14b28846874c3019c830176f3fe6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 30 Dec 2023 23:59:43 +0000 Subject: (cherry-pick) Don't call getsockname(2) in Tcl_MakeFileChannel(3) unless absolutely necessary. Closes RFE [0ac9d06895]. Permits better constraining of Tcl/tclsh via OpenBSD's pledge(2) or similar mechanisms. Minor rewrite --- unix/tclUnixChan.c | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index fe36972..f83a213 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -1531,30 +1531,34 @@ Tcl_MakeFileChannel( char channelName[16 + TCL_INTEGER_SPACE]; int fd = PTR2INT(handle); const Tcl_ChannelType *channelTypePtr; - struct sockaddr sockaddr; - socklen_t sockaddrLen = sizeof(sockaddr); + struct stat buf; if (mode == 0) { return NULL; } - sockaddr.sa_family = AF_UNSPEC; - #ifdef SUPPORTS_TTY if (isatty(fd)) { channelTypePtr = &ttyChannelType; snprintf(channelName, sizeof(channelName), "serial%d", fd); + goto final; } else #endif /* SUPPORTS_TTY */ - if ((getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0) - && (sockaddrLen > 0) - && (sockaddr.sa_family == AF_INET || sockaddr.sa_family == AF_INET6)) { - return TclpMakeTcpClientChannelMode(INT2PTR(fd), mode); - } else { - channelTypePtr = &fileChannelType; - snprintf(channelName, sizeof(channelName), "file%d", fd); + if (fstat(fd, &buf) == 0 && S_ISSOCK(buf.st_mode)) { + struct sockaddr sockaddr; + socklen_t sockaddrLen = sizeof(sockaddr); + + sockaddr.sa_family = AF_UNSPEC; + if ((getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0) + && (sockaddrLen > 0) + && (sockaddr.sa_family == AF_INET + || sockaddr.sa_family == AF_INET6)) { + return (Tcl_Channel)TclpMakeTcpClientChannelMode(INT2PTR(fd), mode); + } } - + channelTypePtr = &fileChannelType; + snprintf(channelName, sizeof(channelName), "file%d", fd); +final: fsPtr = (FileState *)ckalloc(sizeof(FileState)); fsPtr->fd = fd; fsPtr->validMask = mode | TCL_EXCEPTION; -- cgit v0.12 From 6d0b4fcfad9da2898dff20f7ba29f0ed45e5e5ae Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 4 Jan 2024 11:47:58 +0000 Subject: Sync *.yml changes with Tk. Add OPTS=static,staticpkg Windows build --- .github/workflows/linux-build.yml | 8 ++++---- .github/workflows/mac-build.yml | 6 +++--- .github/workflows/win-build.yml | 23 ++++++++++++----------- 3 files changed, 19 insertions(+), 18 deletions(-) diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml index 69580c2..4aedf41 100644 --- a/.github/workflows/linux-build.yml +++ b/.github/workflows/linux-build.yml @@ -14,7 +14,7 @@ jobs: runs-on: ubuntu-22.04 strategy: matrix: - cfgopt: + config: - "" - "--disable-shared" - "--enable-symbols" @@ -34,7 +34,7 @@ jobs: uses: actions/checkout@v4 - name: Install 32-bit dependencies if needed # Duplicated from above - if: ${{ matrix.cfgopt == 'CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit' }} + if: ${{ matrix.config == 'CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit' }} run: | sudo apt-get update sudo apt-get install gcc-multilib libc6-dev-i386 @@ -42,12 +42,12 @@ jobs: run: | touch tclStubInit.c tclOOStubInit.c working-directory: generic - - name: Configure ${{ matrix.cfgopt }} + - name: Configure ${{ matrix.config }} run: | mkdir "${HOME}/install dir" ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1) env: - CFGOPT: ${{ matrix.cfgopt }} + CFGOPT: ${{ matrix.config }} - name: Build run: | make all diff --git a/.github/workflows/mac-build.yml b/.github/workflows/mac-build.yml index 1645bc7..db91343 100644 --- a/.github/workflows/mac-build.yml +++ b/.github/workflows/mac-build.yml @@ -34,7 +34,7 @@ jobs: runs-on: macos-11 strategy: matrix: - cfgopt: + config: - "" - "--disable-shared" - "--enable-symbols" @@ -52,11 +52,11 @@ jobs: touch tclStubInit.c tclOOStubInit.c mkdir "$HOME/install dir" working-directory: generic - - name: Configure ${{ matrix.cfgopt }} + - name: Configure ${{ matrix.config }} # Note that macOS is always a 64 bit platform run: ./configure --enable-64bit --enable-dtrace --enable-framework ${CFGOPT} "--prefix=$HOME/install" || (cat config.log && exit 1) env: - CFGOPT: ${{ matrix.cfgopt }} + CFGOPT: ${{ matrix.config }} - name: Build run: | make all tcltest diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml index 29ea421..6966891 100644 --- a/.github/workflows/win-build.yml +++ b/.github/workflows/win-build.yml @@ -20,32 +20,33 @@ jobs: working-directory: win strategy: matrix: - cfgopt: + config: - "" - - "OPTS=static,msvcrt" - "OPTS=symbols" - "OPTS=symbols STATS=compdbg,memdbg" + - "OPTS=static,msvcrt" + - "OPTS=static,staticpkg,msvcrt" # Using powershell means we need to explicitly stop on failure steps: - name: Checkout uses: actions/checkout@v4 - name: Init MSVC uses: ilammy/msvc-dev-cmd@v1 - - name: Build ${{ matrix.cfgopt }} + - name: Build ${{ matrix.config }} run: | - &nmake -f makefile.vc ${{ matrix.cfgopt }} all + &nmake -f makefile.vc ${{ matrix.config }} all if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } - - name: Build Test Harness ${{ matrix.cfgopt }} + - name: Build Test Harness ${{ matrix.config }} run: | - &nmake -f makefile.vc ${{ matrix.cfgopt }} tcltest + &nmake -f makefile.vc ${{ matrix.config }} tcltest if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } - - name: Run Tests ${{ matrix.cfgopt }} + - name: Run Tests ${{ matrix.config }} run: | - &nmake -f makefile.vc ${{ matrix.cfgopt }} test + &nmake -f makefile.vc ${{ matrix.config }} test if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } @@ -57,7 +58,7 @@ jobs: working-directory: win strategy: matrix: - cfgopt: + config: - "" - "--disable-shared" - "--enable-symbols" @@ -77,11 +78,11 @@ jobs: touch tclStubInit.c tclOOStubInit.c mkdir "${HOME}/install dir" working-directory: generic - - name: Configure ${{ matrix.cfgopt }} + - name: Configure ${{ matrix.config }} run: | ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1) env: - CFGOPT: --enable-64bit ${{ matrix.cfgopt }} + CFGOPT: --enable-64bit ${{ matrix.config }} - name: Build run: make all - name: Build Test Harness -- cgit v0.12 From 56f9606593935963d5700ffa302d17be045d94b9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 4 Jan 2024 12:22:57 +0000 Subject: Add generation of tcltest.res for tcltest.exe, which should function the same as tclsh.exe --- win/makefile.vc | 10 +++++- win/tcltest.exe.manifest.in | 53 ++++++++++++++++++++++++++++++++ win/tcltest.rc | 75 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 137 insertions(+), 1 deletion(-) create mode 100644 win/tcltest.exe.manifest.in create mode 100644 win/tcltest.rc diff --git a/win/makefile.vc b/win/makefile.vc index 8ee2fcb..dc5b2fc 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -212,7 +212,8 @@ TCLTESTOBJS = \ $(TMP_DIR)\tclWinDde.obj \ !endif !endif - $(TMP_DIR)\testMain.obj + $(TMP_DIR)\testMain.obj \ + $(TMP_DIR)\tcltest.res COREOBJS = \ $(TMP_DIR)\regcomp.obj \ @@ -831,6 +832,12 @@ $(TMP_DIR)\tclsh.exe.manifest: $(WIN_DIR)\tclsh.exe.manifest.in @TCL_WIN_VERSION@ $(DOTVERSION).0.0 << +$(TMP_DIR)\tcltest.exe.manifest: $(WIN_DIR)\tcltest.exe.manifest.in + @nmakehlp -s << $** >$@ +@MACHINE@ $(MACHINE:IX86=X86) +@TCL_WIN_VERSION@ $(DOTVERSION).0.0 +<< + #--------------------------------------------------------------------- # Generate the source dependencies. Having dependency rules will # improve incremental build accuracy without having to resort to a @@ -884,6 +891,7 @@ $< $(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest $(WIN_DIR)\tclsh.rc +$(TMP_DIR)\tcltest.res: $(TMP_DIR)\tcltest.exe.manifest $(WIN_DIR)\tcltest.rc #--------------------------------------------------------------------- # Installation. diff --git a/win/tcltest.exe.manifest.in b/win/tcltest.exe.manifest.in new file mode 100644 index 0000000..9021d43 --- /dev/null +++ b/win/tcltest.exe.manifest.in @@ -0,0 +1,53 @@ + + + + Tcl test command line shell (tcltest) + + + + + + + + + + + + + + + + + + + + + + + + true + + + + + + + + diff --git a/win/tcltest.rc b/win/tcltest.rc new file mode 100644 index 0000000..bf82c0f --- /dev/null +++ b/win/tcltest.rc @@ -0,0 +1,75 @@ +// +// Version Resource Script +// + +#include +#include + +// +// build-up the name suffix that defines the type of build this is. +// +#if STATIC_BUILD +#define SUFFIX_STATIC "s" +#else +#define SUFFIX_STATIC "" +#endif + +#if DEBUG && !UNCHECKED +#define SUFFIX_DEBUG "g" +#else +#define SUFFIX_DEBUG "" +#endif + +#define SUFFIX SUFFIX_STATIC SUFFIX_DEBUG + + +LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */ + +VS_VERSION_INFO VERSIONINFO + FILEVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL + PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL + FILEFLAGSMASK 0x3fL +#ifdef DEBUG + FILEFLAGS VS_FF_DEBUG +#else + FILEFLAGS 0x0L +#endif + FILEOS VOS__WINDOWS32 + FILETYPE VFT_APP + FILESUBTYPE 0x0L +BEGIN + BLOCK "StringFileInfo" + BEGIN + BLOCK "040904b0" + BEGIN + VALUE "FileDescription", "Tcltest Application\0" + VALUE "OriginalFilename", "tcltest" SUFFIX ".exe\0" + VALUE "FileVersion", TCL_PATCH_LEVEL + VALUE "LegalCopyright", "Copyright \251 1987-2022 Regents of the University of California and other parties\0" + VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0" + VALUE "ProductVersion", TCL_PATCH_LEVEL + END + END + BLOCK "VarFileInfo" + BEGIN + VALUE "Translation", 0x409, 1200 + END +END + +// +// Icon +// + +tclsh ICON DISCARDABLE "tclsh.ico" + +// +// This is needed for Windows 8.1 onwards. +// + +#ifndef RT_MANIFEST +#define RT_MANIFEST 24 +#endif +#ifndef CREATEPROCESS_MANIFEST_RESOURCE_ID +#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1 +#endif +CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "tcltest.exe.manifest" -- cgit v0.12 From 1a032a0dea9e95b990ec0d7d93dde3764714facd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 4 Jan 2024 12:42:36 +0000 Subject: Make _VC_MANIFEST_EMBED_EXE function work for tclsh.exe/tcltest.exe --- win/makefile.vc | 2 ++ 1 file changed, 2 insertions(+) diff --git a/win/makefile.vc b/win/makefile.vc index dc5b2fc..bc6fba9 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -494,10 +494,12 @@ $(TCLSTUBLIB): $(TCLSTUBOBJS) $(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB) $(CONEXECMD) -stack:2300000 $** + copy $(TMP_DIR)\tclsh.exe.manifest $(TCLSH).manifest $(_VC_MANIFEST_EMBED_EXE) $(TCLTEST): $(TCLTESTOBJS) $(TCLSTUBLIB) $(TCLIMPLIB) $(CONEXECMD) -stack:2300000 $** + copy $(TMP_DIR)\tcltest.exe.manifest $(TCLTEST).manifest $(_VC_MANIFEST_EMBED_EXE) !if $(STATIC_BUILD) -- cgit v0.12 From 7d0431e5792db7e2a6d89bdadc591759c44981fe Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 4 Jan 2024 15:38:11 +0000 Subject: There's no need to give tcltest.exe it's own maniifest. Give tcltest.exe a version-number (as tclsh) --- win/makefile.vc | 12 +++--------- win/tcltest.rc | 2 +- 2 files changed, 4 insertions(+), 10 deletions(-) diff --git a/win/makefile.vc b/win/makefile.vc index bc6fba9..f1da0f9 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -187,7 +187,7 @@ TCLREGLIB = $(OUT_DIR)\$(TCLREGLIBNAME) TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT) TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME) -TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe +TCLTEST = $(OUT_DIR)\$(PROJECT)test$(VERSION)$(SUFX:t=).exe CAT32 = $(OUT_DIR)\cat32.exe TCLSHOBJS = \ @@ -499,7 +499,7 @@ $(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB) $(TCLTEST): $(TCLTESTOBJS) $(TCLSTUBLIB) $(TCLIMPLIB) $(CONEXECMD) -stack:2300000 $** - copy $(TMP_DIR)\tcltest.exe.manifest $(TCLTEST).manifest + copy $(TMP_DIR)\tclsh.exe.manifest $(TCLTEST).manifest $(_VC_MANIFEST_EMBED_EXE) !if $(STATIC_BUILD) @@ -834,12 +834,6 @@ $(TMP_DIR)\tclsh.exe.manifest: $(WIN_DIR)\tclsh.exe.manifest.in @TCL_WIN_VERSION@ $(DOTVERSION).0.0 << -$(TMP_DIR)\tcltest.exe.manifest: $(WIN_DIR)\tcltest.exe.manifest.in - @nmakehlp -s << $** >$@ -@MACHINE@ $(MACHINE:IX86=X86) -@TCL_WIN_VERSION@ $(DOTVERSION).0.0 -<< - #--------------------------------------------------------------------- # Generate the source dependencies. Having dependency rules will # improve incremental build accuracy without having to resort to a @@ -893,7 +887,7 @@ $< $(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest $(WIN_DIR)\tclsh.rc -$(TMP_DIR)\tcltest.res: $(TMP_DIR)\tcltest.exe.manifest $(WIN_DIR)\tcltest.rc +$(TMP_DIR)\tcltest.res: $(TMP_DIR)\tclsh.exe.manifest $(WIN_DIR)\tcltest.rc #--------------------------------------------------------------------- # Installation. diff --git a/win/tcltest.rc b/win/tcltest.rc index bf82c0f..4ff1402 100644 --- a/win/tcltest.rc +++ b/win/tcltest.rc @@ -72,4 +72,4 @@ tclsh ICON DISCARDABLE "tclsh.ico" #ifndef CREATEPROCESS_MANIFEST_RESOURCE_ID #define CREATEPROCESS_MANIFEST_RESOURCE_ID 1 #endif -CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "tcltest.exe.manifest" +CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "tclsh.exe.manifest" -- cgit v0.12 From f6c05909e3838a853d9dc699e0f13c36a768bd43 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 4 Jan 2024 16:06:06 +0000 Subject: Fix [https://core.tcl-lang.org/tk/info/1ca3c8d9da|1ca3c8d9da]: nmake build with OPTS=static --- win/rules.vc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/rules.vc b/win/rules.vc index fc816ac..1b0693f 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -1588,7 +1588,7 @@ DLLCMD = $(link32) $(dlllflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs) CONEXECMD = $(link32) $(conlflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs) GUIEXECMD = $(link32) $(guilflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs) RESCMD = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \ - $(TCL_INCLUDES) \ + $(TCL_INCLUDES) /DSTATIC_BUILD=$(STATIC_BUILD) \ /DDEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \ /DCOMMAVERSION=$(RCCOMMAVERSION) \ /DDOTVERSION=\"$(DOTVERSION)\" \ -- cgit v0.12 From 2703da73f996d6e3ac1091f08414630233b8c8e5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 4 Jan 2024 17:28:29 +0000 Subject: Add many timeouts, add --disable-zipfs build (backported from 9.0) --- .github/workflows/linux-build.yml | 9 +++++++++ .github/workflows/mac-build.yml | 8 ++++++++ .github/workflows/onefiledist.yml | 3 +++ .github/workflows/win-build.yml | 15 +++++++++++++-- 4 files changed, 33 insertions(+), 2 deletions(-) diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml index 469a4b6..b6dafba 100644 --- a/.github/workflows/linux-build.yml +++ b/.github/workflows/linux-build.yml @@ -18,6 +18,7 @@ jobs: - "" - "CFLAGS=-DTCL_NO_DEPRECATED=1" - "--disable-shared" + - "--disable-zipfs" - "--enable-symbols" - "--enable-symbols=mem" - "--enable-symbols=all" @@ -31,6 +32,7 @@ jobs: steps: - name: Checkout uses: actions/checkout@v4 + timeout-minutes: 5 - name: Install 32-bit dependencies if needed # Duplicated from above if: ${{ matrix.config == 'CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit' }} @@ -47,23 +49,30 @@ jobs: ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1) env: CFGOPT: ${{ matrix.config }} + timeout-minutes: 5 - name: Build run: | make all + timeout-minutes: 5 - name: Build Test Harness run: | make tcltest + timeout-minutes: 5 - name: Run Tests run: | make test env: ERROR_ON_FAILURES: 1 + timeout-minutes: 30 - name: Test-Drive Installation run: | make install + timeout-minutes: 5 - name: Create Distribution Package run: | make dist + timeout-minutes: 5 - name: Convert Documentation to HTML run: | make html-tcl + timeout-minutes: 5 diff --git a/.github/workflows/mac-build.yml b/.github/workflows/mac-build.yml index beadff8..0ac275e 100644 --- a/.github/workflows/mac-build.yml +++ b/.github/workflows/mac-build.yml @@ -19,6 +19,7 @@ jobs: steps: - name: Checkout uses: actions/checkout@v4 + timeout-minutes: 5 - name: Prepare run: | touch tclStubInit.c tclOOStubInit.c tclOOScript.h @@ -27,11 +28,13 @@ jobs: run: make all env: CFLAGS: -arch x86_64 -arch arm64 + timeout-minutes: 15 - name: Run Tests run: make test styles=develop env: ERROR_ON_FAILURES: 1 MAC_CI: 1 + timeout-minutes: 15 clang: runs-on: macos-11 strategy: @@ -39,6 +42,7 @@ jobs: config: - "" - "--disable-shared" + - "--disable-zipfs" - "--enable-symbols" - "--enable-symbols=mem" - "--enable-symbols=all" @@ -49,6 +53,7 @@ jobs: steps: - name: Checkout uses: actions/checkout@v4 + timeout-minutes: 5 - name: Prepare run: | touch tclStubInit.c tclOOStubInit.c tclOOScript.h @@ -60,14 +65,17 @@ jobs: env: CFLAGS: -arch x86_64 -arch arm64 CFGOPT: ${{ matrix.config }} + timeout-minutes: 5 - name: Build run: | make all tcltest env: CFLAGS: -arch x86_64 -arch arm64 + timeout-minutes: 15 - name: Run Tests run: | make test env: ERROR_ON_FAILURES: 1 MAC_CI: 1 + timeout-minutes: 15 diff --git a/.github/workflows/onefiledist.yml b/.github/workflows/onefiledist.yml index 5c444f0..976b42b 100644 --- a/.github/workflows/onefiledist.yml +++ b/.github/workflows/onefiledist.yml @@ -15,6 +15,7 @@ jobs: defaults: run: shell: bash + timeout-minutes: 10 steps: - name: Checkout uses: actions/checkout@v4 @@ -50,6 +51,7 @@ jobs: defaults: run: shell: bash + timeout-minutes: 10 steps: - name: Checkout uses: actions/checkout@v4 @@ -112,6 +114,7 @@ jobs: defaults: run: shell: msys2 {0} + timeout-minutes: 10 env: CC: gcc CFGOPT: --disable-symbols --disable-shared diff --git a/.github/workflows/win-build.yml b/.github/workflows/win-build.yml index 47413f1..36160bc 100644 --- a/.github/workflows/win-build.yml +++ b/.github/workflows/win-build.yml @@ -24,34 +24,38 @@ jobs: - "" - "CHECKS=nodep" - "OPTS=static" + - "OPTS=noembed" - "OPTS=symbols" - "OPTS=symbols STATS=compdbg,memdbg" - - "OPTS=static,msvcrt" - - "OPTS=static,staticpkg,msvcrt" # Using powershell means we need to explicitly stop on failure steps: - name: Checkout uses: actions/checkout@v4 + timeout-minutes: 5 - name: Init MSVC uses: ilammy/msvc-dev-cmd@v1 + timeout-minutes: 5 - name: Build ${{ matrix.config }} run: | &nmake -f makefile.vc ${{ matrix.config }} all if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } + timeout-minutes: 5 - name: Build Test Harness ${{ matrix.config }} run: | &nmake -f makefile.vc ${{ matrix.config }} tcltest if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } + timeout-minutes: 5 - name: Run Tests ${{ matrix.config }} run: | &nmake -f makefile.vc ${{ matrix.config }} test if ($lastexitcode -ne 0) { throw "nmake exit code: $lastexitcode" } + timeout-minutes: 30 gcc: runs-on: windows-2022 defaults: @@ -64,6 +68,7 @@ jobs: - "" - "CFLAGS=-DTCL_NO_DEPRECATED=1" - "--disable-shared" + - "--disable-zipfs" - "--enable-symbols" - "--enable-symbols=mem" - "--enable-symbols=all" @@ -74,8 +79,10 @@ jobs: with: msystem: MINGW64 install: git mingw-w64-x86_64-toolchain make + timeout-minutes: 10 - name: Checkout uses: actions/checkout@v4 + timeout-minutes: 5 - name: Prepare run: | touch tclStubInit.c tclOOStubInit.c tclOOScript.h @@ -86,12 +93,16 @@ jobs: ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1) env: CFGOPT: --enable-64bit ${{ matrix.config }} + timeout-minutes: 5 - name: Build run: make all + timeout-minutes: 5 - name: Build Test Harness run: make tcltest + timeout-minutes: 5 - name: Run Tests run: make test + timeout-minutes: 30 # If you add builds with Wine, be sure to define the environment variable # CI_USING_WINE when running them so that broken tests know not to run. -- cgit v0.12 From 386020eb7997d209433e66adb0c3d5fc066b7207 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 5 Jan 2024 09:46:36 +0000 Subject: Tcl_UtfNCmp -> Tcl_UtfNcmp --- generic/tclInt.decls | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 993cc5d..700311f 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -433,7 +433,7 @@ declare 167 { declare 168 { Tcl_Obj *TclGetStartupScriptPath(void) } -# variant of Tcl_UtfNCmp that takes n as bytes, not chars +# variant of Tcl_UtfNcmp that takes n as bytes, not chars declare 169 { int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n) } -- cgit v0.12 From d8531f86fd3639c8cbefb475589655775588e914 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 5 Jan 2024 13:49:07 +0000 Subject: Only run "loaddll" testcases in non-static builds --- tests/fileSystem.test | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/tests/fileSystem.test b/tests/fileSystem.test index 4c406a1..8eb0f49 100644 --- a/tests/fileSystem.test +++ b/tests/fileSystem.test @@ -31,7 +31,9 @@ catch { set ::ddelib [lindex [package ifneeded dde $::ddever] 1] set ::regver [package require registry] set ::reglib [lindex [package ifneeded registry $::regver] 1] - testConstraint loaddll 1 + if {[file extension $::reglib] eq ".dll"} { + testConstraint loaddll 1 + } } # Test for commands defined in Tcltest executable -- cgit v0.12 From f7b17661e96fff2a6fba6a0020e4da40063dfd9f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 5 Jan 2024 14:20:42 +0000 Subject: Make the SUFX for nmake-builds the same as for Makefile builds, if TCL_VERSION > 86 --- win/rules.vc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/rules.vc b/win/rules.vc index 7880d2a..337eec9 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -1093,7 +1093,7 @@ SUFX = $(SUFX:x=) !else TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=) EXT = lib -!if !$(MSVCRT) +!if $(MSVCRT) && $(TCL_VERSION) > 86 || !$(MSVCRT) && $(TCL_VERSION) < 87 TMP_DIRFULL = $(TMP_DIRFULL:X=) SUFX = $(SUFX:x=) !endif -- cgit v0.12 From feb51e40ae66abff0f247136358a3403b6dcdf79 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 5 Jan 2024 17:22:35 +0000 Subject: Resolve the INT_MAX limination in GetIndexFromObjList() --- generic/tclIndexObj.c | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 7decf1f..bd6795d 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -22,7 +22,7 @@ static int GetIndexFromObjList(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *tableObjPtr, - const char *msg, int flags, int *indexPtr); + const char *msg, int flags, Tcl_Size *indexPtr); static void UpdateStringOfIndex(Tcl_Obj *objPtr); static void DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr); static void FreeIndex(Tcl_Obj *objPtr); @@ -105,7 +105,7 @@ GetIndexFromObjList( const char *msg, /* Identifying word to use in error * messages. */ int flags, /* 0 or TCL_EXACT */ - int *indexPtr) /* Place to store resulting integer index. */ + Tcl_Size *indexPtr) /* Place to store resulting index. */ { Tcl_Size objc, t; @@ -123,9 +123,6 @@ GetIndexFromObjList( return result; } - /* Return type is int* so caller should not be passing larger table */ - assert(objc <= INT_MAX); - /* * Build a string table from the list. */ @@ -138,7 +135,7 @@ GetIndexFromObjList( */ Tcl_Free((void *)tablePtr); - *indexPtr = (int) t; + *indexPtr = t; return TCL_OK; } -- cgit v0.12 From 62c2093b16db05751b062134c2eefb9838ebac01 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 5 Jan 2024 18:49:26 +0000 Subject: silence compiler warning --- generic/tclIndexObj.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index bd6795d..e492ece 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -504,8 +504,8 @@ PrefixMatchObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int flags = 0, result, dummy, i; - Tcl_Size dummyLength, errorLength; + int flags = 0, result, i; + Tcl_Size dummy, dummyLength, errorLength; Tcl_Obj *errorPtr = NULL; const char *message = "option"; Tcl_Obj *tablePtr, *objPtr, *resultPtr; -- cgit v0.12 From 951009fc31122ad429569df967c7402a1ac69fc0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 5 Jan 2024 22:50:14 +0000 Subject: Handle README -> README.md change in tcltk-man2html.tcl --- generic/tcl.h | 2 +- macosx/Tcl.xcode/project.pbxproj | 2 +- macosx/Tcl.xcodeproj/project.pbxproj | 2 +- tools/tcltk-man2html.tcl | 6 +++--- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 01eafba..f4c89ba 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -41,7 +41,7 @@ extern "C" { * unix/configure.in (2 LOC Major, 2 LOC minor, 1 LOC patch) * win/configure.in (as above) * win/tcl.m4 (not patchlevel) - * README (sections 0 and 2, with and without separator) + * README.md (sections 0 and 2, with and without separator) * macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC * win/README (not patchlevel) (sections 0 and 2) * unix/tcl.spec (1 LOC patch) diff --git a/macosx/Tcl.xcode/project.pbxproj b/macosx/Tcl.xcode/project.pbxproj index aceb929..22d728d 100644 --- a/macosx/Tcl.xcode/project.pbxproj +++ b/macosx/Tcl.xcode/project.pbxproj @@ -963,7 +963,7 @@ F9183E690EFC81560030B814 /* pkgs */, F96D3DFA08F272A4004A47F5 /* ChangeLog */, F96D3DFB08F272A4004A47F5 /* changes */, - F96D434308F272B5004A47F5 /* README */, + F96D434308F272B5004A47F5 /* README.md */, F96D432B08F272B4004A47F5 /* license.terms */, ); name = "Tcl Sources"; diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj index da16424..212058f 100644 --- a/macosx/Tcl.xcodeproj/project.pbxproj +++ b/macosx/Tcl.xcodeproj/project.pbxproj @@ -963,7 +963,7 @@ F9183E690EFC81560030B814 /* pkgs */, F96D3DFA08F272A4004A47F5 /* ChangeLog */, F96D3DFB08F272A4004A47F5 /* changes */, - F96D434308F272B5004A47F5 /* README */, + F96D434308F272B5004A47F5 /* README.md */, F96D432B08F272B4004A47F5 /* license.terms */, ); name = "Tcl Sources"; diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index caececa..6a47528 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -442,12 +442,12 @@ proc make-man-pages {html args} { proc plus-base {var root glob name dir desc} { global tcltkdir if {$var} { - if {[file exists $tcltkdir/$root/README]} { - set f [open $tcltkdir/$root/README] + if {[file exists $tcltkdir/$root/README.md]} { + set f [open $tcltkdir/$root/README.md] fconfigure $f -encoding utf-8 set d [read $f] close $f - if {[regexp {This is the \w+ (\S+) source distribution} $d -> version]} { + if {[regexp {This is the \*\*\w+ (\S+)\*\* source distribution} $d -> version]} { append name ", version $version" } } -- cgit v0.12 From 44c2830503a47d05a56656f051231ce3977bbe0e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 6 Jan 2024 17:09:22 +0000 Subject: Correction in documentation embedded in rules.vc --- win/makefile.vc | 16 ++++++++-------- win/rules.vc | 9 +++++---- 2 files changed, 13 insertions(+), 12 deletions(-) diff --git a/win/makefile.vc b/win/makefile.vc index f1da0f9..ef67c66 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -17,11 +17,11 @@ # nmake [-nologo] -f makefile.vc [TARGET|MACRODEF [TARGET|MACRODEF] [...]] # # For MACRODEF, see TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) -# or examine Sections 6-8 in rules.vc. +# or examine Sections 7-9 in rules.vc. # -# Possible values of TARGET are: +# Possible values for TARGET are: # release -- Builds the core, the shell and the dlls. (default) -# dlls -- Just builds the windows extensions +# dlls -- Just builds the windows extensions. # shell -- Just builds the shell and the core. # core -- Only builds the core [tclXX.(dll|lib)]. # all -- Builds everything. @@ -47,9 +47,9 @@ # Visual Studio/Windows SDK for the appropriate target architecture. # # NOTE: For older (Visual C++ 6 or the 2003 SDK), to use the Platform -# SDK (not expressly needed), run setenv.bat after -# vcvars32.bat according to the instructions for it. This can also -# turn on the 64-bit compiler, if your SDK has it. +# SDK (not expressly needed), run setenv.bat after vcvars32.bat +# according to the instructions for it. This can also turn on the +# 64-bit compiler, if your SDK has it. # # Basic macros and options usable on the commandline (see rules.vc for more info): # OPTS=msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,time64bit,unchecked,none @@ -133,10 +133,10 @@ PROJECT = tcl # rules.vc file will set up "all" as the target. DEFAULT_BUILD_TARGET = release -# We want to use our own resource file, not the standard template one. +# We have a custom resource file RCFILE = tcl.rc -# The rules.vc file does most of the hard work in terms of defining +# The rules.vc file does much of the hard work in terms of defining # the build configuration, macros, output directories etc. !include "rules.vc" diff --git a/win/rules.vc b/win/rules.vc index 1b0693f..b15978f 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -79,10 +79,11 @@ NEED_TK_SOURCE = 0 # 3. Determine the compiler and linker versions # 4. Build the nmakehlp helper application # 5. Determine the supported compiler options and features -# 6. Parse the OPTS macro value for user-specified build configuration -# 7. Parse the STATS macro value for statistics instrumentation -# 8. Parse the CHECKS macro for additional compilation checks -# 9. Extract Tcl, and possibly Tk, version numbers from the headers +# 6. Extract Tcl, Tk, and possibly extensions, version numbers from the +# headers +# 7. Parse the OPTS macro value for user-specified build configuration +# 8. Parse the STATS macro value for statistics instrumentation +# 9. Parse the CHECKS macro for additional compilation checks # 10. Based on this selected configuration, construct the output # directory and file paths # 11. Construct the paths where the package is to be installed -- cgit v0.12 From 008fb711ca7ea3692c1d3bfdc786ee79d42e9020 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 7 Jan 2024 00:06:32 +0000 Subject: Upgrade to autoconf-2.72 --- unix/configure | 2675 ++++++++++++++++++++++++++++++++------------------------ win/configure | 1059 ++++++++++++---------- 2 files changed, 2123 insertions(+), 1611 deletions(-) diff --git a/unix/configure b/unix/configure index 88fc130..818fb46 100755 --- a/unix/configure +++ b/unix/configure @@ -1,9 +1,9 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.71 for tcl 8.7. +# Generated by GNU Autoconf 2.72 for tcl 8.7. # # -# Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation, +# Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation, # Inc. # # @@ -15,7 +15,6 @@ # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh -as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh @@ -24,12 +23,13 @@ then : # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST -else $as_nop - case `(set -o) 2>/dev/null` in #( +else case e in #( + e) case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; +esac ;; esac fi @@ -101,7 +101,7 @@ IFS=$as_save_IFS ;; esac -# We did not find ourselves, most probably we were run as `sh COMMAND' +# We did not find ourselves, most probably we were run as 'sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 @@ -131,15 +131,14 @@ case $- in # (((( esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. +# out after a failed 'exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi # We don't want this to propagate to other subprocesses. { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then - as_bourne_compatible="as_nop=: -if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 + as_bourne_compatible="if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: @@ -147,12 +146,13 @@ then : # is contrary to our usage. Disable this feature. alias -g '\${1+\"\$@\"}'='\"\$@\"' setopt NO_GLOB_SUBST -else \$as_nop - case \`(set -o) 2>/dev/null\` in #( +else case e in #( + e) case \`(set -o) 2>/dev/null\` in #( *posix*) : set -o posix ;; #( *) : ;; +esac ;; esac fi " @@ -170,8 +170,9 @@ as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } if ( set x; as_fn_ret_success y && test x = \"\$1\" ) then : -else \$as_nop - exitcode=1; echo positional parameters were not saved. +else case e in #( + e) exitcode=1; echo positional parameters were not saved. ;; +esac fi test x\$exitcode = x0 || exit 1 blah=\$(echo \$(echo blah)) @@ -185,14 +186,15 @@ test \$(( 1 + 1 )) = 2 || exit 1" if (eval "$as_required") 2>/dev/null then : as_have_required=yes -else $as_nop - as_have_required=no +else case e in #( + e) as_have_required=no ;; +esac fi if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null then : -else $as_nop - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +else case e in #( + e) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_found=false for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do @@ -225,12 +227,13 @@ IFS=$as_save_IFS if $as_found then : -else $as_nop - if { test -f "$SHELL" || test -f "$SHELL.exe"; } && +else case e in #( + e) if { test -f "$SHELL" || test -f "$SHELL.exe"; } && as_run=a "$SHELL" -c "$as_bourne_compatible""$as_required" 2>/dev/null then : CONFIG_SHELL=$SHELL as_have_required=yes -fi +fi ;; +esac fi @@ -252,7 +255,7 @@ case $- in # (((( esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. +# out after a failed 'exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi @@ -271,7 +274,8 @@ $0: message. Then install a modern shell, or manually run $0: the script under such a shell if you do have one." fi exit 1 -fi +fi ;; +esac fi fi SHELL=${CONFIG_SHELL-/bin/sh} @@ -310,14 +314,6 @@ as_fn_exit () as_fn_set_status $1 exit $1 } # as_fn_exit -# as_fn_nop -# --------- -# Do nothing but, unlike ":", preserve the value of $?. -as_fn_nop () -{ - return $? -} -as_nop=as_fn_nop # as_fn_mkdir_p # ------------- @@ -386,11 +382,12 @@ then : { eval $1+=\$2 }' -else $as_nop - as_fn_append () +else case e in #( + e) as_fn_append () { eval $1=\$$1\$2 - } + } ;; +esac fi # as_fn_append # as_fn_arith ARG... @@ -404,21 +401,14 @@ then : { as_val=$(( $* )) }' -else $as_nop - as_fn_arith () +else case e in #( + e) as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` - } + } ;; +esac fi # as_fn_arith -# as_fn_nop -# --------- -# Do nothing but, unlike ":", preserve the value of $?. -as_fn_nop () -{ - return $? -} -as_nop=as_fn_nop # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- @@ -492,6 +482,8 @@ as_cr_alnum=$as_cr_Letters$as_cr_digits /[$]LINENO/= ' <$as_myself | sed ' + t clear + :clear s/[$]LINENO.*/&-/ t lineno b @@ -540,7 +532,6 @@ esac as_echo='printf %s\n' as_echo_n='printf %s' - rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file @@ -552,9 +543,9 @@ if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. + # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable. + # In both cases, we have to default to 'cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then @@ -579,10 +570,12 @@ as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. -as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" +as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" +as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated # Sed expression to map a string onto a valid variable name. -as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" +as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g" +as_tr_sh="eval sed '$as_sed_sh'" # deprecated test -n "$DJDIR" || exec 7<&0 /dev/null && - as_fn_error $? "invalid feature name: \`$ac_useropt'" + as_fn_error $? "invalid feature name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -961,7 +952,7 @@ do ac_useropt=`expr "x$ac_option" : 'x-*enable-$[^=]*$'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid feature name: \`$ac_useropt'" + as_fn_error $? "invalid feature name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1174,7 +1165,7 @@ do ac_useropt=`expr "x$ac_option" : 'x-*with-$[^=]*$'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid package name: \`$ac_useropt'" + as_fn_error $? "invalid package name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1190,7 +1181,7 @@ do ac_useropt=`expr "x$ac_option" : 'x-*without-$.*$'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid package name: \`$ac_useropt'" + as_fn_error $? "invalid package name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1220,8 +1211,8 @@ do | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; - -*) as_fn_error $? "unrecognized option: \`$ac_option' -Try \`$0 --help' for more information" + -*) as_fn_error $? "unrecognized option: '$ac_option' +Try '$0 --help' for more information" ;; *=*) @@ -1229,7 +1220,7 @@ Try \`$0 --help' for more information" # Reject names that are not valid shell variable names. case $ac_envvar in #( '' | [0-9]* | *[!_$as_cr_alnum]* ) - as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + as_fn_error $? "invalid variable name: '$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;; @@ -1279,7 +1270,7 @@ do as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done -# There might be people who depend on the old broken behavior: `$host' +# There might be people who depend on the old broken behavior: '$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias @@ -1347,7 +1338,7 @@ if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" fi -ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_msg="sources are in $srcdir, but 'cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" pwd)` @@ -1375,7 +1366,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures tcl 8.7 to adapt to many kinds of systems. +'configure' configures tcl 8.7 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1389,11 +1380,11 @@ Configuration: --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit - -q, --quiet, --silent do not print \`checking ...' messages + -q, --quiet, --silent do not print 'checking ...' messages --cache-file=FILE cache test results in FILE [disabled] - -C, --config-cache alias for \`--cache-file=config.cache' + -C, --config-cache alias for '--cache-file=config.cache' -n, --no-create do not create output files - --srcdir=DIR find the sources in DIR [configure dir or \`..'] + --srcdir=DIR find the sources in DIR [configure dir or '..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX @@ -1401,10 +1392,10 @@ Installation directories: --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] -By default, \`make install' will install all the files in -\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify -an installation prefix other than \`$ac_default_prefix' using \`--prefix', -for instance \`--prefix=\$HOME'. +By default, 'make install' will install all the files in +'$ac_default_prefix/bin', '$ac_default_prefix/lib' etc. You can specify +an installation prefix other than '$ac_default_prefix' using '--prefix', +for instance '--prefix=\$HOME'. For better control, use the options below. @@ -1487,7 +1478,7 @@ Some influential environment variables: you have headers in a nonstandard directory CPP C preprocessor -Use these variables to override the choices made by `configure' or to help +Use these variables to override the choices made by 'configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to the package provider. @@ -1555,9 +1546,9 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF tcl configure 8.7 -generated by GNU Autoconf 2.71 +generated by GNU Autoconf 2.72 -Copyright (C) 2021 Free Software Foundation, Inc. +Copyright (C) 2023 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF @@ -1596,11 +1587,12 @@ printf "%s\n" "$ac_try_echo"; } >&5 } && test -s conftest.$ac_objext then : ac_retval=0 -else $as_nop - printf "%s\n" "$as_me: failed program was:" >&5 +else case e in #( + e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_retval=1 + ac_retval=1 ;; +esac fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval @@ -1619,8 +1611,8 @@ printf %s "checking for $2... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 #include <$2> @@ -1628,10 +1620,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "$3=yes" -else $as_nop - eval "$3=no" +else case e in #( + e) eval "$3=no" ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 @@ -1667,11 +1661,12 @@ printf "%s\n" "$ac_try_echo"; } >&5 } then : ac_retval=0 -else $as_nop - printf "%s\n" "$as_me: failed program was:" >&5 +else case e in #( + e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_retval=1 + ac_retval=1 ;; +esac fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval @@ -1709,11 +1704,12 @@ printf "%s\n" "$ac_try_echo"; } >&5 } then : ac_retval=0 -else $as_nop - printf "%s\n" "$as_me: failed program was:" >&5 +else case e in #( + e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_retval=1 + ac_retval=1 ;; +esac fi # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would @@ -1736,15 +1732,15 @@ printf %s "checking for $2... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Define $2 to an innocuous variant, in case declares $2. For example, HP-UX 11i declares gettimeofday. */ #define $2 innocuous_$2 /* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $2 (); below. */ + which can conflict with char $2 (void); below. */ #include #undef $2 @@ -1755,7 +1751,7 @@ else $as_nop #ifdef __cplusplus extern "C" #endif -char $2 (); +char $2 (void); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ @@ -1774,11 +1770,13 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : eval "$3=yes" -else $as_nop - eval "$3=no" +else case e in #( + e) eval "$3=no" ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ - conftest$ac_exeext conftest.$ac_ext + conftest$ac_exeext conftest.$ac_ext ;; +esac fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 @@ -1800,8 +1798,8 @@ printf %s "checking whether $as_decl_name is declared... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 -else $as_nop - as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'` +else case e in #( + e) as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'` eval ac_save_FLAGS=\$$6 as_fn_append $6 " $5" cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -1825,12 +1823,14 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "$3=yes" -else $as_nop - eval "$3=no" +else case e in #( + e) eval "$3=no" ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext eval $6=\$ac_save_FLAGS - + ;; +esac fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 @@ -1851,8 +1851,8 @@ printf %s "checking for $2... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 -else $as_nop - eval "$3=no" +else case e in #( + e) eval "$3=no" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 @@ -1882,12 +1882,14 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : -else $as_nop - eval "$3=yes" +else case e in #( + e) eval "$3=yes" ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 @@ -1926,12 +1928,13 @@ printf "%s\n" "$ac_try_echo"; } >&5 test $ac_status = 0; }; } then : ac_retval=0 -else $as_nop - printf "%s\n" "$as_me: program exited with status $ac_status" >&5 +else case e in #( + e) printf "%s\n" "$as_me: program exited with status $ac_status" >&5 printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_retval=$ac_status + ac_retval=$ac_status ;; +esac fi rm -rf conftest.dSYM conftest_ipa8_conftest.oo eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno @@ -1951,8 +1954,8 @@ printf %s "checking for $2.$3... " >&6; } if eval test \${$4+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $5 int @@ -1968,8 +1971,8 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "$4=yes" -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $5 int @@ -1985,12 +1988,15 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "$4=yes" -else $as_nop - eval "$4=no" +else case e in #( + e) eval "$4=no" ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi eval ac_res=\$$4 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 @@ -2023,7 +2029,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by tcl $as_me 8.7, which was -generated by GNU Autoconf 2.71. Invocation command line was +generated by GNU Autoconf 2.72. Invocation command line was $ $0$ac_configure_args_raw @@ -2269,10 +2275,10 @@ esac printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" \ - || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} + || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file -See \`config.log' for more details" "$LINENO" 5; } +See 'config.log' for more details" "$LINENO" 5; } fi done @@ -2308,9 +2314,7 @@ struct stat; /* Most of the following tests are stolen from RCS 5.7 src/conf.sh. */ struct buf { int x; }; struct buf * (*rcsopen) (struct buf *, struct stat *, int); -static char *e (p, i) - char **p; - int i; +static char *e (char **p, int i) { return p[i]; } @@ -2324,6 +2328,21 @@ static char *f (char * (*g) (char **, int), char **p, ...) return s; } +/* C89 style stringification. */ +#define noexpand_stringify(a) #a +const char *stringified = noexpand_stringify(arbitrary+token=sequence); + +/* C89 style token pasting. Exercises some of the corner cases that + e.g. old MSVC gets wrong, but not very hard. */ +#define noexpand_concat(a,b) a##b +#define expand_concat(a,b) noexpand_concat(a,b) +extern int vA; +extern int vbee; +#define aye A +#define bee B +int *pvA = &expand_concat(v,aye); +int *pvbee = &noexpand_concat(v,bee); + /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not \xHH hex character constants. These do not provoke an error unfortunately, instead are silently treated @@ -2351,16 +2370,19 @@ ok |= (argc == 0 || f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]); # Test code for whether the C compiler supports C99 (global declarations) ac_c_conftest_c99_globals=' -// Does the compiler advertise C99 conformance? +/* Does the compiler advertise C99 conformance? */ #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L # error "Compiler does not advertise C99 conformance" #endif +// See if C++-style comments work. + #include extern int puts (const char *); extern int printf (const char *, ...); extern int dprintf (int, const char *, ...); extern void *malloc (size_t); +extern void free (void *); // Check varargs macros. These examples are taken from C99 6.10.3.5. // dprintf is used instead of fprintf to avoid needing to declare @@ -2410,7 +2432,6 @@ typedef const char *ccp; static inline int test_restrict (ccp restrict text) { - // See if C++-style comments work. // Iterate through items via the restricted pointer. // Also check for declarations in for loops. for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i) @@ -2476,6 +2497,8 @@ ac_c_conftest_c99_main=' ia->datasize = 10; for (int i = 0; i < ia->datasize; ++i) ia->data[i] = i * 1.234; + // Work around memory leak warnings. + free (ia); // Check named initializers. struct named_init ni = { @@ -2497,7 +2520,7 @@ ac_c_conftest_c99_main=' # Test code for whether the C compiler supports C11 (global declarations) ac_c_conftest_c11_globals=' -// Does the compiler advertise C11 conformance? +/* Does the compiler advertise C11 conformance? */ #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L # error "Compiler does not advertise C11 conformance" #endif @@ -2621,12 +2644,12 @@ for ac_var in $ac_precious_vars; do eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 -printf "%s\n" "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&5 +printf "%s\n" "$as_me: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 -printf "%s\n" "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was not set in the previous run" >&5 +printf "%s\n" "$as_me: error: '$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) @@ -2635,18 +2658,18 @@ printf "%s\n" "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_old_val_w=`echo x $ac_old_val` ac_new_val_w=`echo x $ac_new_val` if test "$ac_old_val_w" != "$ac_new_val_w"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 -printf "%s\n" "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' has changed since the previous run:" >&5 +printf "%s\n" "$as_me: error: '$ac_var' has changed since the previous run:" >&2;} ac_cache_corrupted=: else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 -printf "%s\n" "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&5 +printf "%s\n" "$as_me: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&2;} eval $ac_var=\$ac_old_val fi - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 -printf "%s\n" "$as_me: former value: \`$ac_old_val'" >&2;} - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 -printf "%s\n" "$as_me: current value: \`$ac_new_val'" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: former value: '$ac_old_val'" >&5 +printf "%s\n" "$as_me: former value: '$ac_old_val'" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: current value: '$ac_new_val'" >&5 +printf "%s\n" "$as_me: current value: '$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. @@ -2662,11 +2685,11 @@ printf "%s\n" "$as_me: current value: \`$ac_new_val'" >&2;} fi done if $ac_cache_corrupted; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;} - as_fn_error $? "run \`${MAKE-make} distclean' and/or \`rm $cache_file' + as_fn_error $? "run '${MAKE-make} distclean' and/or 'rm $cache_file' and start over" "$LINENO" 5 fi ## -------------------- ## @@ -2740,8 +2763,9 @@ printf %s "checking whether to use symlinks for manpages... " >&6; } if test ${enable_man_symlinks+y} then : enableval=$enable_man_symlinks; test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks" -else $as_nop - enableval="no" +else case e in #( + e) enableval="no" ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5 @@ -2757,8 +2781,9 @@ then : no) ;; *) MAN_FLAGS="$MAN_FLAGS --compress $enableval";; esac -else $as_nop - enableval="no" +else case e in #( + e) enableval="no" ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5 @@ -2785,8 +2810,9 @@ then : no) ;; *) MAN_FLAGS="$MAN_FLAGS --suffix $enableval";; esac -else $as_nop - enableval="no" +else case e in #( + e) enableval="no" ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5 @@ -2827,8 +2853,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CC"; then +else case e in #( + e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2850,7 +2876,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then @@ -2872,8 +2899,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_CC"; then +else case e in #( + e) if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2895,7 +2922,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then @@ -2930,8 +2958,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CC"; then +else case e in #( + e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2953,7 +2981,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then @@ -2975,8 +3004,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CC"; then +else case e in #( + e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no @@ -3015,7 +3044,8 @@ if test $ac_prog_rejected = yes; then ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@" fi fi -fi +fi ;; +esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then @@ -3039,8 +3069,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CC"; then +else case e in #( + e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3062,7 +3092,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then @@ -3088,8 +3119,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_CC"; then +else case e in #( + e) if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3111,7 +3142,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then @@ -3149,8 +3181,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CC"; then +else case e in #( + e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3172,7 +3204,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then @@ -3194,8 +3227,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_CC"; then +else case e in #( + e) if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3217,7 +3250,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then @@ -3246,10 +3280,10 @@ fi fi -test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH -See \`config.log' for more details" "$LINENO" 5; } +See 'config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 @@ -3321,8 +3355,8 @@ printf "%s\n" "$ac_try_echo"; } >&5 printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : - # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. -# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' + # Autoconf-2.13 could set the ac_cv_exeext variable to 'no'. +# So ignore a value of 'no', otherwise this would lead to 'EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. @@ -3342,7 +3376,7 @@ do ac_cv_exeext=`expr "$ac_file" : '[^.]*$\..*$'` fi # We set ac_cv_exeext here because the later test for it is not - # safe: cross compilers may not add the suffix if given an `-o' + # safe: cross compilers may not add the suffix if given an '-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. @@ -3353,8 +3387,9 @@ do done test "$ac_cv_exeext" = no && ac_cv_exeext= -else $as_nop - ac_file='' +else case e in #( + e) ac_file='' ;; +esac fi if test -z "$ac_file" then : @@ -3363,13 +3398,14 @@ printf "%s\n" "no" >&6; } printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables -See \`config.log' for more details" "$LINENO" 5; } -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -printf "%s\n" "yes" >&6; } +See 'config.log' for more details" "$LINENO" 5; } +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 printf %s "checking for C compiler default output file name... " >&6; } @@ -3393,10 +3429,10 @@ printf "%s\n" "$ac_try_echo"; } >&5 printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : - # If both `conftest.exe' and `conftest' are `present' (well, observable) -# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will -# work properly (i.e., refer to `conftest.exe'), while it won't with -# `rm'. + # If both 'conftest.exe' and 'conftest' are 'present' (well, observable) +# catch 'conftest.exe'. For instance with Cygwin, 'ls conftest' will +# work properly (i.e., refer to 'conftest.exe'), while it won't with +# 'rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in @@ -3406,11 +3442,12 @@ for ac_file in conftest.exe conftest conftest.*; do * ) break;; esac done -else $as_nop - { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +else case e in #( + e) { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link -See \`config.log' for more details" "$LINENO" 5; } +See 'config.log' for more details" "$LINENO" 5; } ;; +esac fi rm -f conftest conftest$ac_cv_exeext { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 @@ -3426,6 +3463,8 @@ int main (void) { FILE *f = fopen ("conftest.out", "w"); + if (!f) + return 1; return ferror (f) || fclose (f) != 0; ; @@ -3465,26 +3504,27 @@ printf "%s\n" "$ac_try_echo"; } >&5 if test "$cross_compiling" = maybe; then cross_compiling=yes else - { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error 77 "cannot run C compiled programs. -If you meant to cross compile, use \`--host'. -See \`config.log' for more details" "$LINENO" 5; } +If you meant to cross compile, use '--host'. +See 'config.log' for more details" "$LINENO" 5; } fi fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 printf "%s\n" "$cross_compiling" >&6; } -rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +rm -f conftest.$ac_ext conftest$ac_cv_exeext \ + conftest.o conftest.obj conftest.out ac_clean_files=$ac_clean_files_save { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 printf %s "checking for suffix of object files... " >&6; } if test ${ac_cv_objext+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -3516,16 +3556,18 @@ then : break;; esac done -else $as_nop - printf "%s\n" "$as_me: failed program was:" >&5 +else case e in #( + e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile -See \`config.log' for more details" "$LINENO" 5; } +See 'config.log' for more details" "$LINENO" 5; } ;; +esac fi -rm -f conftest.$ac_cv_objext conftest.$ac_ext +rm -f conftest.$ac_cv_objext conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 printf "%s\n" "$ac_cv_objext" >&6; } @@ -3536,8 +3578,8 @@ printf %s "checking whether the compiler supports GNU C... " >&6; } if test ${ac_cv_c_compiler_gnu+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -3554,12 +3596,14 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_compiler_gnu=yes -else $as_nop - ac_compiler_gnu=no +else case e in #( + e) ac_compiler_gnu=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; } @@ -3577,8 +3621,8 @@ printf %s "checking whether $CC accepts -g... " >&6; } if test ${ac_cv_prog_cc_g+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_save_c_werror_flag=$ac_c_werror_flag +else case e in #( + e) ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" @@ -3596,8 +3640,8 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes -else $as_nop - CFLAGS="" +else case e in #( + e) CFLAGS="" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3612,8 +3656,8 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : -else $as_nop - ac_c_werror_flag=$ac_save_c_werror_flag +else case e in #( + e) ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3630,12 +3674,15 @@ if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - ac_c_werror_flag=$ac_save_c_werror_flag + ac_c_werror_flag=$ac_save_c_werror_flag ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 printf "%s\n" "$ac_cv_prog_cc_g" >&6; } @@ -3662,8 +3709,8 @@ printf %s "checking for $CC option to enable C11 features... " >&6; } if test ${ac_cv_prog_cc_c11+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_cv_prog_cc_c11=no +else case e in #( + e) ac_cv_prog_cc_c11=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3680,25 +3727,28 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c11" != "xno" && break done rm -f conftest.$ac_ext -CC=$ac_save_CC +CC=$ac_save_CC ;; +esac fi if test "x$ac_cv_prog_cc_c11" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } -else $as_nop - if test "x$ac_cv_prog_cc_c11" = x +else case e in #( + e) if test "x$ac_cv_prog_cc_c11" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } - CC="$CC $ac_cv_prog_cc_c11" + CC="$CC $ac_cv_prog_cc_c11" ;; +esac fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 - ac_prog_cc_stdc=c11 + ac_prog_cc_stdc=c11 ;; +esac fi fi if test x$ac_prog_cc_stdc = xno @@ -3708,8 +3758,8 @@ printf %s "checking for $CC option to enable C99 features... " >&6; } if test ${ac_cv_prog_cc_c99+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_cv_prog_cc_c99=no +else case e in #( + e) ac_cv_prog_cc_c99=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3726,25 +3776,28 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c99" != "xno" && break done rm -f conftest.$ac_ext -CC=$ac_save_CC +CC=$ac_save_CC ;; +esac fi if test "x$ac_cv_prog_cc_c99" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } -else $as_nop - if test "x$ac_cv_prog_cc_c99" = x +else case e in #( + e) if test "x$ac_cv_prog_cc_c99" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } - CC="$CC $ac_cv_prog_cc_c99" + CC="$CC $ac_cv_prog_cc_c99" ;; +esac fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 - ac_prog_cc_stdc=c99 + ac_prog_cc_stdc=c99 ;; +esac fi fi if test x$ac_prog_cc_stdc = xno @@ -3754,8 +3807,8 @@ printf %s "checking for $CC option to enable C89 features... " >&6; } if test ${ac_cv_prog_cc_c89+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_cv_prog_cc_c89=no +else case e in #( + e) ac_cv_prog_cc_c89=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3772,25 +3825,28 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext -CC=$ac_save_CC +CC=$ac_save_CC ;; +esac fi if test "x$ac_cv_prog_cc_c89" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } -else $as_nop - if test "x$ac_cv_prog_cc_c89" = x +else case e in #( + e) if test "x$ac_cv_prog_cc_c89" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } - CC="$CC $ac_cv_prog_cc_c89" + CC="$CC $ac_cv_prog_cc_c89" ;; +esac fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 - ac_prog_cc_stdc=c89 + ac_prog_cc_stdc=c89 ;; +esac fi fi @@ -3806,8 +3862,8 @@ printf %s "checking for inline... " >&6; } if test ${ac_cv_c_inline+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_cv_c_inline=no +else case e in #( + e) ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3825,7 +3881,8 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext test "$ac_cv_c_inline" != no && break done - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5 printf "%s\n" "$ac_cv_c_inline" >&6; } @@ -3900,8 +3957,8 @@ if test -z "$CPP"; then if test ${ac_cv_prog_CPP+y} then : printf %s "(cached) " >&6 -else $as_nop - # Double quotes because $CC needs to be expanded +else case e in #( + e) # Double quotes because $CC needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" cpp /lib/cpp do ac_preproc_ok=false @@ -3919,9 +3976,10 @@ _ACEOF if ac_fn_c_try_cpp "$LINENO" then : -else $as_nop - # Broken: fails on valid input. -continue +else case e in #( + e) # Broken: fails on valid input. +continue ;; +esac fi rm -f conftest.err conftest.i conftest.$ac_ext @@ -3935,15 +3993,16 @@ if ac_fn_c_try_cpp "$LINENO" then : # Broken: success on invalid input. continue -else $as_nop - # Passes both tests. +else case e in #( + e) # Passes both tests. ac_preproc_ok=: -break +break ;; +esac fi rm -f conftest.err conftest.i conftest.$ac_ext done -# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +# Because of 'break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok then : @@ -3952,7 +4011,8 @@ fi done ac_cv_prog_CPP=$CPP - + ;; +esac fi CPP=$ac_cv_prog_CPP else @@ -3975,9 +4035,10 @@ _ACEOF if ac_fn_c_try_cpp "$LINENO" then : -else $as_nop - # Broken: fails on valid input. -continue +else case e in #( + e) # Broken: fails on valid input. +continue ;; +esac fi rm -f conftest.err conftest.i conftest.$ac_ext @@ -3991,24 +4052,26 @@ if ac_fn_c_try_cpp "$LINENO" then : # Broken: success on invalid input. continue -else $as_nop - # Passes both tests. +else case e in #( + e) # Passes both tests. ac_preproc_ok=: -break +break ;; +esac fi rm -f conftest.err conftest.i conftest.$ac_ext done -# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +# Because of 'break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok then : -else $as_nop - { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +else case e in #( + e) { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details" "$LINENO" 5; } +See 'config.log' for more details" "$LINENO" 5; } ;; +esac fi ac_ext=c @@ -4018,14 +4081,14 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $ ac_compiler_gnu=$ac_cv_c_compiler_gnu -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 -printf %s "checking for grep that handles long lines and -e... " >&6; } -if test ${ac_cv_path_GREP+y} +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for egrep -e" >&5 +printf %s "checking for egrep -e... " >&6; } +if test ${ac_cv_path_EGREP_TRADITIONAL+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -z "$GREP"; then - ac_path_GREP_found=false +else case e in #( + e) if test -z "$EGREP_TRADITIONAL"; then + ac_path_EGREP_TRADITIONAL_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin @@ -4039,13 +4102,14 @@ do for ac_prog in grep ggrep do for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_GREP="$as_dir$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_GREP" || continue -# Check for GNU ac_path_GREP and select it if it is found. - # Check for GNU $ac_path_GREP -case `"$ac_path_GREP" --version 2>&1` in + ac_path_EGREP_TRADITIONAL="$as_dir$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP_TRADITIONAL" || continue +# Check for GNU ac_path_EGREP_TRADITIONAL and select it if it is found. + # Check for GNU $ac_path_EGREP_TRADITIONAL +case `"$ac_path_EGREP_TRADITIONAL" --version 2>&1` in #( *GNU*) - ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; + ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" ac_path_EGREP_TRADITIONAL_found=:;; +#( *) ac_count=0 printf %s 0123456789 >"conftest.in" @@ -4054,14 +4118,14 @@ case `"$ac_path_GREP" --version 2>&1` in cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" - printf "%s\n" 'GREP' >> "conftest.nl" - "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + printf "%s\n" 'EGREP_TRADITIONAL' >> "conftest.nl" + "$ac_path_EGREP_TRADITIONAL" -E 'EGR(EP|AC)_TRADITIONAL$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_GREP_max-0}; then + if test $ac_count -gt ${ac_path_EGREP_TRADITIONAL_max-0}; then # Best one so far, save it but keep looking for a better one - ac_cv_path_GREP="$ac_path_GREP" - ac_path_GREP_max=$ac_count + ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" + ac_path_EGREP_TRADITIONAL_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break @@ -4069,35 +4133,24 @@ case `"$ac_path_GREP" --version 2>&1` in rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac - $ac_path_GREP_found && break 3 + $ac_path_EGREP_TRADITIONAL_found && break 3 done done done IFS=$as_save_IFS - if test -z "$ac_cv_path_GREP"; then - as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + if test -z "$ac_cv_path_EGREP_TRADITIONAL"; then + : fi else - ac_cv_path_GREP=$GREP + ac_cv_path_EGREP_TRADITIONAL=$EGREP_TRADITIONAL fi -fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 -printf "%s\n" "$ac_cv_path_GREP" >&6; } - GREP="$ac_cv_path_GREP" - - -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 -printf %s "checking for egrep... " >&6; } -if test ${ac_cv_path_EGREP+y} + if test "$ac_cv_path_EGREP_TRADITIONAL" then : - printf %s "(cached) " >&6 -else $as_nop - if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 - then ac_cv_path_EGREP="$GREP -E" - else - if test -z "$EGREP"; then - ac_path_EGREP_found=false + ac_cv_path_EGREP_TRADITIONAL="$ac_cv_path_EGREP_TRADITIONAL -E" +else case e in #( + e) if test -z "$EGREP_TRADITIONAL"; then + ac_path_EGREP_TRADITIONAL_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin @@ -4111,13 +4164,14 @@ do for ac_prog in egrep do for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_EGREP="$as_dir$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_EGREP" || continue -# Check for GNU ac_path_EGREP and select it if it is found. - # Check for GNU $ac_path_EGREP -case `"$ac_path_EGREP" --version 2>&1` in + ac_path_EGREP_TRADITIONAL="$as_dir$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP_TRADITIONAL" || continue +# Check for GNU ac_path_EGREP_TRADITIONAL and select it if it is found. + # Check for GNU $ac_path_EGREP_TRADITIONAL +case `"$ac_path_EGREP_TRADITIONAL" --version 2>&1` in #( *GNU*) - ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; + ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" ac_path_EGREP_TRADITIONAL_found=:;; +#( *) ac_count=0 printf %s 0123456789 >"conftest.in" @@ -4126,14 +4180,14 @@ case `"$ac_path_EGREP" --version 2>&1` in cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" - printf "%s\n" 'EGREP' >> "conftest.nl" - "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + printf "%s\n" 'EGREP_TRADITIONAL' >> "conftest.nl" + "$ac_path_EGREP_TRADITIONAL" 'EGR(EP|AC)_TRADITIONAL$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_EGREP_max-0}; then + if test $ac_count -gt ${ac_path_EGREP_TRADITIONAL_max-0}; then # Best one so far, save it but keep looking for a better one - ac_cv_path_EGREP="$ac_path_EGREP" - ac_path_EGREP_max=$ac_count + ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" + ac_path_EGREP_TRADITIONAL_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break @@ -4141,32 +4195,34 @@ case `"$ac_path_EGREP" --version 2>&1` in rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac - $ac_path_EGREP_found && break 3 + $ac_path_EGREP_TRADITIONAL_found && break 3 done done done IFS=$as_save_IFS - if test -z "$ac_cv_path_EGREP"; then + if test -z "$ac_cv_path_EGREP_TRADITIONAL"; then as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 fi else - ac_cv_path_EGREP=$EGREP + ac_cv_path_EGREP_TRADITIONAL=$EGREP_TRADITIONAL fi - - fi + ;; +esac +fi ;; +esac fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 -printf "%s\n" "$ac_cv_path_EGREP" >&6; } - EGREP="$ac_cv_path_EGREP" - +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP_TRADITIONAL" >&5 +printf "%s\n" "$ac_cv_path_EGREP_TRADITIONAL" >&6; } + EGREP_TRADITIONAL=$ac_cv_path_EGREP_TRADITIONAL ac_fn_c_check_header_compile "$LINENO" "string.h" "ac_cv_header_string_h" "$ac_includes_default" if test "x$ac_cv_header_string_h" = xyes then : tcl_ok=1 -else $as_nop - tcl_ok=0 +else case e in #( + e) tcl_ok=0 ;; +esac fi cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -4175,11 +4231,12 @@ fi _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "strstr" >/dev/null 2>&1 + $EGREP_TRADITIONAL "strstr" >/dev/null 2>&1 then : -else $as_nop - tcl_ok=0 +else case e in #( + e) tcl_ok=0 ;; +esac fi rm -rf conftest* @@ -4189,11 +4246,12 @@ rm -rf conftest* _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "strerror" >/dev/null 2>&1 + $EGREP_TRADITIONAL "strerror" >/dev/null 2>&1 then : -else $as_nop - tcl_ok=0 +else case e in #( + e) tcl_ok=0 ;; +esac fi rm -rf conftest* @@ -4211,20 +4269,22 @@ printf "%s\n" "#define NO_STRING_H 1" >>confdefs.h if test "x$ac_cv_header_sys_wait_h" = xyes then : -else $as_nop - +else case e in #( + e) printf "%s\n" "#define NO_SYS_WAIT_H 1" >>confdefs.h - + ;; +esac fi ac_fn_c_check_header_compile "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default" if test "x$ac_cv_header_dlfcn_h" = xyes then : -else $as_nop - +else case e in #( + e) printf "%s\n" "#define NO_DLFCN_H 1" >>confdefs.h - + ;; +esac fi @@ -4255,8 +4315,8 @@ printf %s "checking if the compiler understands -pipe... " >&6; } if test ${tcl_cv_cc_pipe+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -4272,11 +4332,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_cc_pipe=yes -else $as_nop - tcl_cv_cc_pipe=no +else case e in #( + e) tcl_cv_cc_pipe=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - CFLAGS=$hold_cflags + CFLAGS=$hold_cflags ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_pipe" >&5 printf "%s\n" "$tcl_cv_cc_pipe" >&6; } @@ -4318,8 +4380,8 @@ printf %s "checking for $CC options needed to detect all undeclared functions... if test ${ac_cv_c_undeclared_builtin_options+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_save_CFLAGS=$CFLAGS +else case e in #( + e) ac_save_CFLAGS=$CFLAGS ac_cv_c_undeclared_builtin_options='cannot detect' for ac_arg in '' -fno-builtin; do CFLAGS="$ac_save_CFLAGS $ac_arg" @@ -4338,8 +4400,8 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : -else $as_nop - # This test program should compile successfully. +else case e in #( + e) # This test program should compile successfully. # No library function is consistently available on # freestanding implementations, so test against a dummy # declaration. Include always-available headers on the @@ -4367,26 +4429,29 @@ then : if test x"$ac_arg" = x then : ac_cv_c_undeclared_builtin_options='none needed' -else $as_nop - ac_cv_c_undeclared_builtin_options=$ac_arg +else case e in #( + e) ac_cv_c_undeclared_builtin_options=$ac_arg ;; +esac fi break fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext done CFLAGS=$ac_save_CFLAGS - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_undeclared_builtin_options" >&5 printf "%s\n" "$ac_cv_c_undeclared_builtin_options" >&6; } case $ac_cv_c_undeclared_builtin_options in #( 'cannot detect') : - { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot make $CC report undeclared builtins -See \`config.log' for more details" "$LINENO" 5; } ;; #( +See 'config.log' for more details" "$LINENO" 5; } ;; #( 'none needed') : ac_c_undeclared_builtin_options='' ;; #( *) : @@ -4403,8 +4468,9 @@ esac if test "x$ac_cv_func_sin" = xyes then : MATH_LIBS="" -else $as_nop - MATH_LIBS="-lm" +else case e in #( + e) MATH_LIBS="-lm" ;; +esac fi @@ -4418,8 +4484,8 @@ printf %s "checking for main in -linet... " >&6; } if test ${ac_cv_lib_inet_main+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-linet $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -4436,12 +4502,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_inet_main=yes -else $as_nop - ac_cv_lib_inet_main=no +else case e in #( + e) ac_cv_lib_inet_main=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_inet_main" >&5 printf "%s\n" "$ac_cv_lib_inet_main" >&6; } @@ -4483,8 +4551,9 @@ fi if test "x$ac_cv_func_connect" = xyes then : tcl_checkSocket=0 -else $as_nop - tcl_checkSocket=1 +else case e in #( + e) tcl_checkSocket=1 ;; +esac fi if test "$tcl_checkSocket" = 1; then @@ -4492,22 +4561,28 @@ fi if test "x$ac_cv_func_setsockopt" = xyes then : -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for setsockopt in -lsocket" >&5 +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for setsockopt in -lsocket" >&5 printf %s "checking for setsockopt in -lsocket... " >&6; } if test ${ac_cv_lib_socket_setsockopt+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-lsocket $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char setsockopt (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char setsockopt (void); int main (void) { @@ -4519,22 +4594,26 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_socket_setsockopt=yes -else $as_nop - ac_cv_lib_socket_setsockopt=no +else case e in #( + e) ac_cv_lib_socket_setsockopt=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_setsockopt" >&5 printf "%s\n" "$ac_cv_lib_socket_setsockopt" >&6; } if test "x$ac_cv_lib_socket_setsockopt" = xyes then : LIBS="$LIBS -lsocket" -else $as_nop - tcl_checkBoth=1 +else case e in #( + e) tcl_checkBoth=1 ;; +esac fi - + ;; +esac fi fi @@ -4545,8 +4624,9 @@ fi if test "x$ac_cv_func_accept" = xyes then : tcl_checkNsl=0 -else $as_nop - LIBS=$tk_oldLibs +else case e in #( + e) LIBS=$tk_oldLibs ;; +esac fi fi @@ -4554,22 +4634,28 @@ fi if test "x$ac_cv_func_gethostbyname" = xyes then : -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lnsl" >&5 +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lnsl" >&5 printf %s "checking for gethostbyname in -lnsl... " >&6; } if test ${ac_cv_lib_nsl_gethostbyname+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-lnsl $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char gethostbyname (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char gethostbyname (void); int main (void) { @@ -4581,12 +4667,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_nsl_gethostbyname=yes -else $as_nop - ac_cv_lib_nsl_gethostbyname=no +else case e in #( + e) ac_cv_lib_nsl_gethostbyname=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_nsl_gethostbyname" >&5 printf "%s\n" "$ac_cv_lib_nsl_gethostbyname" >&6; } @@ -4594,7 +4682,8 @@ if test "x$ac_cv_lib_nsl_gethostbyname" = xyes then : LIBS="$LIBS -lnsl" fi - + ;; +esac fi @@ -4609,16 +4698,22 @@ printf %s "checking for pthread_mutex_init in -lpthread... " >&6; } if test ${ac_cv_lib_pthread_pthread_mutex_init+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-lpthread $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char pthread_mutex_init (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_mutex_init (void); int main (void) { @@ -4630,20 +4725,23 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_pthread_pthread_mutex_init=yes -else $as_nop - ac_cv_lib_pthread_pthread_mutex_init=no +else case e in #( + e) ac_cv_lib_pthread_pthread_mutex_init=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5 printf "%s\n" "$ac_cv_lib_pthread_pthread_mutex_init" >&6; } if test "x$ac_cv_lib_pthread_pthread_mutex_init" = xyes then : tcl_ok=yes -else $as_nop - tcl_ok=no +else case e in #( + e) tcl_ok=no ;; +esac fi if test "$tcl_ok" = "no"; then @@ -4657,16 +4755,22 @@ printf %s "checking for __pthread_mutex_init in -lpthread... " >&6; } if test ${ac_cv_lib_pthread___pthread_mutex_init+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-lpthread $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char __pthread_mutex_init (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char __pthread_mutex_init (void); int main (void) { @@ -4678,20 +4782,23 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_pthread___pthread_mutex_init=yes -else $as_nop - ac_cv_lib_pthread___pthread_mutex_init=no +else case e in #( + e) ac_cv_lib_pthread___pthread_mutex_init=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5 printf "%s\n" "$ac_cv_lib_pthread___pthread_mutex_init" >&6; } if test "x$ac_cv_lib_pthread___pthread_mutex_init" = xyes then : tcl_ok=yes -else $as_nop - tcl_ok=no +else case e in #( + e) tcl_ok=no ;; +esac fi fi @@ -4705,16 +4812,22 @@ printf %s "checking for pthread_mutex_init in -lpthreads... " >&6; } if test ${ac_cv_lib_pthreads_pthread_mutex_init+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-lpthreads $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char pthread_mutex_init (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_mutex_init (void); int main (void) { @@ -4726,20 +4839,23 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_pthreads_pthread_mutex_init=yes -else $as_nop - ac_cv_lib_pthreads_pthread_mutex_init=no +else case e in #( + e) ac_cv_lib_pthreads_pthread_mutex_init=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5 printf "%s\n" "$ac_cv_lib_pthreads_pthread_mutex_init" >&6; } if test "x$ac_cv_lib_pthreads_pthread_mutex_init" = xyes then : _ok=yes -else $as_nop - tcl_ok=no +else case e in #( + e) tcl_ok=no ;; +esac fi if test "$tcl_ok" = "yes"; then @@ -4751,16 +4867,22 @@ printf %s "checking for pthread_mutex_init in -lc... " >&6; } if test ${ac_cv_lib_c_pthread_mutex_init+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-lc $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char pthread_mutex_init (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_mutex_init (void); int main (void) { @@ -4772,20 +4894,23 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_c_pthread_mutex_init=yes -else $as_nop - ac_cv_lib_c_pthread_mutex_init=no +else case e in #( + e) ac_cv_lib_c_pthread_mutex_init=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_pthread_mutex_init" >&5 printf "%s\n" "$ac_cv_lib_c_pthread_mutex_init" >&6; } if test "x$ac_cv_lib_c_pthread_mutex_init" = xyes then : tcl_ok=yes -else $as_nop - tcl_ok=no +else case e in #( + e) tcl_ok=no ;; +esac fi if test "$tcl_ok" = "no"; then @@ -4794,16 +4919,22 @@ printf %s "checking for pthread_mutex_init in -lc_r... " >&6; } if test ${ac_cv_lib_c_r_pthread_mutex_init+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-lc_r $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char pthread_mutex_init (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_mutex_init (void); int main (void) { @@ -4815,20 +4946,23 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_c_r_pthread_mutex_init=yes -else $as_nop - ac_cv_lib_c_r_pthread_mutex_init=no +else case e in #( + e) ac_cv_lib_c_r_pthread_mutex_init=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5 printf "%s\n" "$ac_cv_lib_c_r_pthread_mutex_init" >&6; } if test "x$ac_cv_lib_c_r_pthread_mutex_init" = xyes then : tcl_ok=yes -else $as_nop - tcl_ok=no +else case e in #( + e) tcl_ok=no ;; +esac fi if test "$tcl_ok" = "yes"; then @@ -4868,15 +5002,17 @@ fi if test "x$ac_cv_have_decl_PTHREAD_MUTEX_RECURSIVE" = xyes then : ac_have_decl=1 -else $as_nop - ac_have_decl=0 +else case e in #( + e) ac_have_decl=0 ;; +esac fi printf "%s\n" "#define HAVE_DECL_PTHREAD_MUTEX_RECURSIVE $ac_have_decl" >>confdefs.h if test $ac_have_decl = 1 then : tcl_ok=yes -else $as_nop - tcl_ok=no +else case e in #( + e) tcl_ok=no ;; +esac fi @@ -4891,8 +5027,9 @@ printf %s "checking how to build libraries... " >&6; } if test ${enable_shared+y} then : enableval=$enable_shared; tcl_ok=$enableval -else $as_nop - tcl_ok=yes +else case e in #( + e) tcl_ok=yes ;; +esac fi if test "$tcl_ok" = "yes" ; then @@ -4922,8 +5059,8 @@ printf %s "checking for tclsh... " >&6; } if test ${ac_cv_path_tclsh+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/tclsh[8-9]* 2> /dev/null` \ @@ -4936,7 +5073,8 @@ else $as_nop fi done done - + ;; +esac fi @@ -4970,13 +5108,15 @@ then : if test "x$ac_cv_type_gz_header" = xyes then : -else $as_nop - zlib_ok=no +else case e in #( + e) zlib_ok=no ;; +esac fi -else $as_nop - - zlib_ok=no +else case e in #( + e) + zlib_ok=no ;; +esac fi if test $zlib_ok = yes @@ -4987,15 +5127,21 @@ printf %s "checking for library containing deflateSetHeader... " >&6; } if test ${ac_cv_search_deflateSetHeader+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_func_search_save_LIBS=$LIBS +else case e in #( + e) ac_func_search_save_LIBS=$LIBS cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char deflateSetHeader (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char deflateSetHeader (void); int main (void) { @@ -5026,11 +5172,13 @@ done if test ${ac_cv_search_deflateSetHeader+y} then : -else $as_nop - ac_cv_search_deflateSetHeader=no +else case e in #( + e) ac_cv_search_deflateSetHeader=no ;; +esac fi rm conftest.$ac_ext -LIBS=$ac_func_search_save_LIBS +LIBS=$ac_func_search_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_deflateSetHeader" >&5 printf "%s\n" "$ac_cv_search_deflateSetHeader" >&6; } @@ -5039,10 +5187,11 @@ if test "$ac_res" != no then : test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" -else $as_nop - +else case e in #( + e) zlib_ok=no - + ;; +esac fi fi @@ -5082,13 +5231,15 @@ then : if test "x$ac_cv_type_mp_int" = xyes then : -else $as_nop - libtommath_ok=no +else case e in #( + e) libtommath_ok=no ;; +esac fi -else $as_nop - - libtommath_ok=no +else case e in #( + e) + libtommath_ok=no ;; +esac fi if test $libtommath_ok = yes @@ -5099,16 +5250,22 @@ printf %s "checking for mp_log_u32 in -ltommath... " >&6; } if test ${ac_cv_lib_tommath_mp_log_u32+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-ltommath $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char mp_log_u32 (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char mp_log_u32 (void); int main (void) { @@ -5120,21 +5277,24 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_tommath_mp_log_u32=yes -else $as_nop - ac_cv_lib_tommath_mp_log_u32=no +else case e in #( + e) ac_cv_lib_tommath_mp_log_u32=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tommath_mp_log_u32" >&5 printf "%s\n" "$ac_cv_lib_tommath_mp_log_u32" >&6; } if test "x$ac_cv_lib_tommath_mp_log_u32" = xyes then : MATH_LIBS="$MATH_LIBS -ltommath" -else $as_nop - - libtommath_ok=no +else case e in #( + e) + libtommath_ok=no ;; +esac fi fi @@ -5150,15 +5310,16 @@ then : printf "%s\n" "#define TCL_WITH_EXTERNAL_TOMMATH 1" >>confdefs.h -else $as_nop - +else case e in #( + e) TOMMATH_OBJS=\${TOMMATH_OBJS} TOMMATH_SRCS=\${TOMMATH_SRCS} TOMMATH_INCLUDE=-I\${TOMMATH_DIR} - + ;; +esac fi #-------------------------------------------------------------------- @@ -5175,8 +5336,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_RANLIB+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$RANLIB"; then +else case e in #( + e) if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -5198,7 +5359,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then @@ -5220,8 +5382,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_RANLIB+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_RANLIB"; then +else case e in #( + e) if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -5243,7 +5405,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then @@ -5279,8 +5442,9 @@ printf %s "checking if 64bit support is requested... " >&6; } if test ${enable_64bit+y} then : enableval=$enable_64bit; do64bit=$enableval -else $as_nop - do64bit=no +else case e in #( + e) do64bit=no ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5 @@ -5294,8 +5458,9 @@ printf %s "checking if 64bit Sparc VIS support is requested... " >&6; } if test ${enable_64bit_vis+y} then : enableval=$enable_64bit_vis; do64bitVIS=$enableval -else $as_nop - do64bitVIS=no +else case e in #( + e) do64bitVIS=no ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $do64bitVIS" >&5 @@ -5314,8 +5479,8 @@ printf %s "checking if compiler supports visibility \"hidden\"... " >&6; } if test ${tcl_cv_cc_visibility_hidden+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -5333,12 +5498,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_cc_visibility_hidden=yes -else $as_nop - tcl_cv_cc_visibility_hidden=no +else case e in #( + e) tcl_cv_cc_visibility_hidden=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - CFLAGS=$hold_cflags + CFLAGS=$hold_cflags ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_visibility_hidden" >&5 printf "%s\n" "$tcl_cv_cc_visibility_hidden" >&6; } @@ -5362,8 +5529,9 @@ printf %s "checking if rpath support is requested... " >&6; } if test ${enable_rpath+y} then : enableval=$enable_rpath; doRpath=$enableval -else $as_nop - doRpath=yes +else case e in #( + e) doRpath=yes ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $doRpath" >&5 @@ -5378,8 +5546,8 @@ printf %s "checking system version... " >&6; } if test ${tcl_cv_sys_version+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) if test "${TEA_PLATFORM}" = "windows" ; then tcl_cv_sys_version=windows else @@ -5397,7 +5565,8 @@ printf "%s\n" "$as_me: WARNING: can't find uname command" >&2;} fi fi fi - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5 printf "%s\n" "$tcl_cv_sys_version" >&6; } @@ -5412,16 +5581,22 @@ printf %s "checking for dlopen in -ldl... " >&6; } if test ${ac_cv_lib_dl_dlopen+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-ldl $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char dlopen (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (void); int main (void) { @@ -5433,20 +5608,23 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_dl_dlopen=yes -else $as_nop - ac_cv_lib_dl_dlopen=no +else case e in #( + e) ac_cv_lib_dl_dlopen=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 printf "%s\n" "$ac_cv_lib_dl_dlopen" >&6; } if test "x$ac_cv_lib_dl_dlopen" = xyes then : have_dl=yes -else $as_nop - have_dl=no +else case e in #( + e) have_dl=no ;; +esac fi @@ -5483,11 +5661,12 @@ then : esac -else $as_nop - +else case e in #( + e) CFLAGS_OPTIMIZE=-O CFLAGS_WARNING="" - + ;; +esac fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. @@ -5497,8 +5676,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_AR+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$AR"; then +else case e in #( + e) if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -5520,7 +5699,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi AR=$ac_cv_prog_AR if test -n "$AR"; then @@ -5542,8 +5722,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_AR+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_AR"; then +else case e in #( + e) if test -n "$ac_ct_AR"; then ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -5565,7 +5745,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_AR=$ac_cv_prog_ac_ct_AR if test -n "$ac_ct_AR"; then @@ -5640,15 +5821,16 @@ then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5 printf "%s\n" "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} -else $as_nop - +else case e in #( + e) do64bit_ok=yes CFLAGS="$CFLAGS -q64" LDFLAGS_ARCH="-q64" RANLIB="${RANLIB} -X64" AR="${AR} -X64" SHLIB_LD_FLAGS="-b64" - + ;; +esac fi fi @@ -5665,31 +5847,34 @@ then : CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' -else $as_nop - +else case e in #( + e) CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}' - + ;; +esac fi LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' -else $as_nop - +else case e in #( + e) if test "$GCC" = yes then : SHLIB_LD='${CC} -shared -Wl,-bexpall' -else $as_nop - +else case e in #( + e) SHLIB_LD="/bin/ld -bhalt:4 -bM:SRE -bexpall -H512 -T512 -bnoentry" LDFLAGS="$LDFLAGS -brtl" - + ;; +esac fi SHLIB_LD="${SHLIB_LD} ${SHLIB_LD_FLAGS}" DL_LIBS="-ldl" CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} - + ;; +esac fi ;; BeOS*) @@ -5709,16 +5894,22 @@ printf %s "checking for inet_ntoa in -lbind... " >&6; } if test ${ac_cv_lib_bind_inet_ntoa+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-lbind $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char inet_ntoa (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char inet_ntoa (void); int main (void) { @@ -5730,12 +5921,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_bind_inet_ntoa=yes -else $as_nop - ac_cv_lib_bind_inet_ntoa=no +else case e in #( + e) ac_cv_lib_bind_inet_ntoa=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bind_inet_ntoa" >&5 printf "%s\n" "$ac_cv_lib_bind_inet_ntoa" >&6; } @@ -5779,8 +5972,8 @@ printf %s "checking for Cygwin version of gcc... " >&6; } if test ${ac_cv_cygwin+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef __CYGWIN__ @@ -5798,11 +5991,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_cygwin=no -else $as_nop - ac_cv_cygwin=yes +else case e in #( + e) ac_cv_cygwin=yes ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cygwin" >&5 printf "%s\n" "$ac_cv_cygwin" >&6; } @@ -5842,16 +6037,22 @@ printf %s "checking for inet_ntoa in -lnetwork... " >&6; } if test ${ac_cv_lib_network_inet_ntoa+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-lnetwork $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char inet_ntoa (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char inet_ntoa (void); int main (void) { @@ -5863,12 +6064,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_network_inet_ntoa=yes -else $as_nop - ac_cv_lib_network_inet_ntoa=no +else case e in #( + e) ac_cv_lib_network_inet_ntoa=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_network_inet_ntoa" >&5 printf "%s\n" "$ac_cv_lib_network_inet_ntoa" >&6; } @@ -5893,26 +6096,33 @@ then : SHLIB_SUFFIX=".so" -else $as_nop - +else case e in #( + e) SHLIB_SUFFIX=".sl" - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5 printf %s "checking for shl_load in -ldld... " >&6; } if test ${ac_cv_lib_dld_shl_load+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char shl_load (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char shl_load (void); int main (void) { @@ -5924,20 +6134,23 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_dld_shl_load=yes -else $as_nop - ac_cv_lib_dld_shl_load=no +else case e in #( + e) ac_cv_lib_dld_shl_load=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 printf "%s\n" "$ac_cv_lib_dld_shl_load" >&6; } if test "x$ac_cv_lib_dld_shl_load" = xyes then : tcl_ok=yes -else $as_nop - tcl_ok=no +else case e in #( + e) tcl_ok=no ;; +esac fi if test "$tcl_ok" = yes @@ -5959,10 +6172,11 @@ then : SHLIB_LD='${CC} -shared' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} -else $as_nop - +else case e in #( + e) CFLAGS="$CFLAGS -z" - + ;; +esac fi # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc @@ -5993,12 +6207,13 @@ printf "%s\n" "$as_me: WARNING: 64bit mode not supported with GCC on $system" >& ;; esac -else $as_nop - +else case e in #( + e) do64bit_ok=yes CFLAGS="$CFLAGS +DD64" LDFLAGS_ARCH="+DD64" - + ;; +esac fi fi ;; @@ -6009,16 +6224,22 @@ printf %s "checking for shl_load in -ldld... " >&6; } if test ${ac_cv_lib_dld_shl_load+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-ldld $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char shl_load (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char shl_load (void); int main (void) { @@ -6030,20 +6251,23 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_dld_shl_load=yes -else $as_nop - ac_cv_lib_dld_shl_load=no +else case e in #( + e) ac_cv_lib_dld_shl_load=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 printf "%s\n" "$ac_cv_lib_dld_shl_load" >&6; } if test "x$ac_cv_lib_dld_shl_load" = xyes then : tcl_ok=yes -else $as_nop - tcl_ok=no +else case e in #( + e) tcl_ok=no ;; +esac fi if test "$tcl_ok" = yes @@ -6103,8 +6327,8 @@ then : CFLAGS="$CFLAGS -mabi=n32" LDFLAGS="$LDFLAGS -mabi=n32" -else $as_nop - +else case e in #( + e) case $system in IRIX-6.3) # Use to build 6.2 compatible binaries on 6.3. @@ -6115,7 +6339,8 @@ else $as_nop ;; esac LDFLAGS="$LDFLAGS -n32" - + ;; +esac fi ;; IRIX64-6.*) @@ -6148,13 +6373,14 @@ then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported by gcc" >&5 printf "%s\n" "$as_me: WARNING: 64bit mode not supported by gcc" >&2;} -else $as_nop - +else case e in #( + e) do64bit_ok=yes SHLIB_LD="ld -64 -shared -rdata_shared" CFLAGS="$CFLAGS -64" LDFLAGS_ARCH="-64" - + ;; +esac fi fi @@ -6205,8 +6431,8 @@ printf %s "checking if compiler accepts -m64 flag... " >&6; } if test ${tcl_cv_cc_m64+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) hold_cflags=$CFLAGS CFLAGS="$CFLAGS -m64" cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6223,12 +6449,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_cc_m64=yes -else $as_nop - tcl_cv_cc_m64=no +else case e in #( + e) tcl_cv_cc_m64=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - CFLAGS=$hold_cflags + CFLAGS=$hold_cflags ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_m64" >&5 printf "%s\n" "$tcl_cv_cc_m64" >&6; } @@ -6340,8 +6568,8 @@ printf %s "checking if compiler accepts -arch ppc64 flag... " >&6; } if test ${tcl_cv_cc_arch_ppc64+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5" cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6358,12 +6586,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_cc_arch_ppc64=yes -else $as_nop - tcl_cv_cc_arch_ppc64=no +else case e in #( + e) tcl_cv_cc_arch_ppc64=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - CFLAGS=$hold_cflags + CFLAGS=$hold_cflags ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_ppc64" >&5 printf "%s\n" "$tcl_cv_cc_arch_ppc64" >&6; } @@ -6380,8 +6610,8 @@ printf %s "checking if compiler accepts -arch x86_64 flag... " >&6; } if test ${tcl_cv_cc_arch_x86_64+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch x86_64" cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6398,12 +6628,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_cc_arch_x86_64=yes -else $as_nop - tcl_cv_cc_arch_x86_64=no +else case e in #( + e) tcl_cv_cc_arch_x86_64=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - CFLAGS=$hold_cflags + CFLAGS=$hold_cflags ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_x86_64" >&5 printf "%s\n" "$tcl_cv_cc_arch_x86_64" >&6; } @@ -6420,8 +6652,8 @@ printf %s "checking if compiler accepts -arch arm64 flag... " >&6; } if test ${tcl_cv_cc_arch_arm64+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) hold_cflags=$CFLAGS CFLAGS="$CFLAGS -arch arm64" cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6438,12 +6670,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_cc_arch_arm64=yes -else $as_nop - tcl_cv_cc_arch_arm64=no +else case e in #( + e) tcl_cv_cc_arch_arm64=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - CFLAGS=$hold_cflags + CFLAGS=$hold_cflags ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_arm64" >&5 printf "%s\n" "$tcl_cv_cc_arch_arm64" >&6; } @@ -6459,8 +6693,8 @@ fi;; printf "%s\n" "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};; esac -else $as_nop - +else case e in #( + e) # Check for combined 32-bit and 64-bit fat build if echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64|arm64) ' \ && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) ' @@ -6468,7 +6702,8 @@ then : fat_32_64=yes fi - + ;; +esac fi SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS}' { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if ld accepts -single_module flag" >&5 @@ -6476,8 +6711,8 @@ printf %s "checking if ld accepts -single_module flag... " >&6; } if test ${tcl_cv_ld_single_module+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module" cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6494,12 +6729,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_ld_single_module=yes -else $as_nop - tcl_cv_ld_single_module=no +else case e in #( + e) tcl_cv_ld_single_module=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - LDFLAGS=$hold_ldflags + LDFLAGS=$hold_ldflags ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_single_module" >&5 printf "%s\n" "$tcl_cv_ld_single_module" >&6; } @@ -6518,8 +6755,8 @@ printf %s "checking if ld accepts -search_paths_first flag... " >&6; } if test ${tcl_cv_ld_search_paths_first+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-search_paths_first" cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6536,12 +6773,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_ld_search_paths_first=yes -else $as_nop - tcl_cv_ld_search_paths_first=no +else case e in #( + e) tcl_cv_ld_search_paths_first=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - LDFLAGS=$hold_ldflags + LDFLAGS=$hold_ldflags ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_search_paths_first" >&5 printf "%s\n" "$tcl_cv_ld_search_paths_first" >&6; } @@ -6574,8 +6813,9 @@ printf %s "checking whether to use CoreFoundation... " >&6; } if test ${enable_corefoundation+y} then : enableval=$enable_corefoundation; tcl_corefoundation=$enableval -else $as_nop - tcl_corefoundation=yes +else case e in #( + e) tcl_corefoundation=yes ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_corefoundation" >&5 @@ -6588,8 +6828,8 @@ printf %s "checking for CoreFoundation.framework... " >&6; } if test ${tcl_cv_lib_corefoundation+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) hold_libs=$LIBS if test "$fat_32_64" = yes then : @@ -6617,8 +6857,9 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_lib_corefoundation=yes -else $as_nop - tcl_cv_lib_corefoundation=no +else case e in #( + e) tcl_cv_lib_corefoundation=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext @@ -6629,7 +6870,8 @@ then : eval $v'="$hold_'$v'"' done fi - LIBS=$hold_libs + LIBS=$hold_libs ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_corefoundation" >&5 printf "%s\n" "$tcl_cv_lib_corefoundation" >&6; } @@ -6641,8 +6883,9 @@ then : printf "%s\n" "#define HAVE_COREFOUNDATION 1" >>confdefs.h -else $as_nop - tcl_corefoundation=no +else case e in #( + e) tcl_corefoundation=no ;; +esac fi if test "$fat_32_64" = yes -a $tcl_corefoundation = yes then : @@ -6652,8 +6895,8 @@ printf %s "checking for 64-bit CoreFoundation... " >&6; } if test ${tcl_cv_lib_corefoundation_64+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) for v in CFLAGS CPPFLAGS LDFLAGS; do eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"' done @@ -6671,14 +6914,16 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_lib_corefoundation_64=yes -else $as_nop - tcl_cv_lib_corefoundation_64=no +else case e in #( + e) tcl_cv_lib_corefoundation_64=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext for v in CFLAGS CPPFLAGS LDFLAGS; do eval $v'="$hold_'$v'"' - done + done ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_corefoundation_64" >&5 printf "%s\n" "$tcl_cv_lib_corefoundation_64" >&6; } @@ -6711,10 +6956,11 @@ then : SHLIB_LD='${CC} -shared' -else $as_nop - +else case e in #( + e) SHLIB_LD='${CC} -non_shared' - + ;; +esac fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" @@ -6728,9 +6974,10 @@ fi if test "$GCC" = yes then : CFLAGS="$CFLAGS -mieee" -else $as_nop - - CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee" +else case e in #( + e) + CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee" ;; +esac fi # see pthread_intro(3) for pthread support on osf1, k.furukawa CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE" @@ -6741,11 +6988,12 @@ then : LIBS="$LIBS -lpthread -lmach -lexc" -else $as_nop - +else case e in #( + e) CFLAGS="$CFLAGS -pthread" LDFLAGS="$LDFLAGS -pthread" - + ;; +esac fi ;; QNX-6*) @@ -6770,11 +7018,12 @@ then : SHLIB_CFLAGS="-fPIC -melf" LDFLAGS="$LDFLAGS -melf -Wl,-Bexport" -else $as_nop - +else case e in #( + e) SHLIB_CFLAGS="-Kpic -belf" LDFLAGS="$LDFLAGS -belf -Wl,-Bexport" - + ;; +esac fi SHLIB_LD="ld -G" SHLIB_LD_LIBS="" @@ -6808,12 +7057,13 @@ then : CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} -else $as_nop - +else case e in #( + e) SHLIB_LD="/usr/ccs/bin/ld -G -z text" CC_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} - + ;; +esac fi ;; SunOS-5*) @@ -6846,17 +7096,18 @@ then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&5 printf "%s\n" "$as_me: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&2;} -else $as_nop - +else case e in #( + e) do64bit_ok=yes CFLAGS="$CFLAGS -m64 -mcpu=v9" LDFLAGS="$LDFLAGS -m64 -mcpu=v9" SHLIB_CFLAGS="-fPIC" - + ;; +esac fi -else $as_nop - +else case e in #( + e) do64bit_ok=yes if test "$do64bitVIS" = yes then : @@ -6864,19 +7115,21 @@ then : CFLAGS="$CFLAGS -xarch=v9a" LDFLAGS_ARCH="-xarch=v9a" -else $as_nop - +else case e in #( + e) CFLAGS="$CFLAGS -xarch=v9" LDFLAGS_ARCH="-xarch=v9" - + ;; +esac fi # Solaris 64 uses this as well #LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH_64" - + ;; +esac fi -else $as_nop - if test "$arch" = "amd64 i386" +else case e in #( + e) if test "$arch" = "amd64 i386" then : if test "$GCC" = yes @@ -6892,8 +7145,8 @@ then : printf "%s\n" "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;};; esac -else $as_nop - +else case e in #( + e) do64bit_ok=yes case $system in SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) @@ -6903,13 +7156,16 @@ else $as_nop CFLAGS="$CFLAGS -xarch=amd64" LDFLAGS="$LDFLAGS -xarch=amd64";; esac - + ;; +esac fi -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported for $arch" >&5 -printf "%s\n" "$as_me: WARNING: 64bit mode not supported for $arch" >&2;} -fi +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported for $arch" >&5 +printf "%s\n" "$as_me: WARNING: 64bit mode not supported for $arch" >&2;} ;; +esac +fi ;; +esac fi fi @@ -6921,8 +7177,8 @@ fi if test "$GCC" = yes then : use_sunmath=no -else $as_nop - +else case e in #( + e) arch=`isainfo` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to use -lsunmath for fp rounding control" >&5 printf %s "checking whether to use -lsunmath for fp rounding control... " >&6; } @@ -6940,14 +7196,16 @@ fi use_sunmath=yes -else $as_nop - +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } use_sunmath=no - + ;; +esac fi - + ;; +esac fi SHLIB_SUFFIX=".so" DL_OBJS="tclLoadDl.o" @@ -6972,24 +7230,26 @@ then : #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" -else $as_nop - if test "$arch" = "amd64 i386" +else case e in #( + e) if test "$arch" = "amd64 i386" then : SHLIB_LD="$SHLIB_LD -m64 -static-libgcc" -fi +fi ;; +esac fi fi -else $as_nop - +else case e in #( + e) if test "$use_sunmath" = yes then : textmode=textoff -else $as_nop - textmode=text +else case e in #( + e) textmode=text ;; +esac fi case $system in SunOS-5.[1-9][0-9]*|SunOS-5.[7-9]) @@ -6999,7 +7259,8 @@ fi esac CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' - + ;; +esac fi ;; UNIX_SV* | UnixWare-5*) @@ -7016,8 +7277,8 @@ printf %s "checking for ld accepts -Bexport flag... " >&6; } if test ${tcl_cv_ld_Bexport+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) hold_ldflags=$LDFLAGS LDFLAGS="$LDFLAGS -Wl,-Bexport" cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7034,12 +7295,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_ld_Bexport=yes -else $as_nop - tcl_cv_ld_Bexport=no +else case e in #( + e) tcl_cv_ld_Bexport=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - LDFLAGS=$hold_ldflags + LDFLAGS=$hold_ldflags ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_Bexport" >&5 printf "%s\n" "$tcl_cv_ld_Bexport" >&6; } @@ -7079,8 +7342,9 @@ fi if test ${enable_load+y} then : enableval=$enable_load; tcl_ok=$enableval -else $as_nop - tcl_ok=yes +else case e in #( + e) tcl_ok=yes ;; +esac fi if test "$tcl_ok" = no @@ -7091,8 +7355,8 @@ fi if test "x$DL_OBJS" != x then : BUILD_DLTEST="\$(DLTEST_TARGETS)" -else $as_nop - +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&5 printf "%s\n" "$as_me: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&2;} SHLIB_CFLAGS="" @@ -7104,7 +7368,8 @@ printf "%s\n" "$as_me: WARNING: Can't figure out how to do dynamic loading or sh CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" BUILD_DLTEST="" - + ;; +esac fi LDFLAGS="$LDFLAGS $LDFLAGS_ARCH" @@ -7162,14 +7427,15 @@ then : INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)"' DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)" -else $as_nop - +else case e in #( + e) INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' - + ;; +esac fi -else $as_nop - +else case e in #( + e) LIB_SUFFIX=${UNSHARED_LIB_SUFFIX} if test "$RANLIB" = "" @@ -7177,13 +7443,15 @@ then : MAKE_LIB='$(STLIB_LD) $@ ${OBJS}' -else $as_nop - +else case e in #( + e) MAKE_LIB='${STLIB_LD} $@ ${OBJS} ; ${RANLIB} $@' - + ;; +esac fi INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"' - + ;; +esac fi # Stub lib does not depend on shared/static configuration @@ -7192,10 +7460,11 @@ then : MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS}' -else $as_nop - +else case e in #( + e) MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS} ; ${RANLIB} $@' - + ;; +esac fi INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"' @@ -7218,8 +7487,8 @@ printf %s "checking for cast to union support... " >&6; } if test ${tcl_cv_cast_to_union+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -7236,11 +7505,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_cast_to_union=yes -else $as_nop - tcl_cv_cast_to_union=no +else case e in #( + e) tcl_cv_cast_to_union=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5 printf "%s\n" "$tcl_cv_cast_to_union" >&6; } @@ -7255,8 +7526,8 @@ printf %s "checking for working -fno-lto... " >&6; } if test ${ac_cv_nolto+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -7270,11 +7541,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_nolto=yes -else $as_nop - ac_cv_nolto=no +else case e in #( + e) ac_cv_nolto=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_nolto" >&5 printf "%s\n" "$ac_cv_nolto" >&6; } @@ -7289,8 +7562,8 @@ printf %s "checking if the compiler understands -finput-charset... " >&6; } if test ${tcl_cv_cc_input_charset+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -finput-charset=UTF-8" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -7306,11 +7579,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_cc_input_charset=yes -else $as_nop - tcl_cv_cc_input_charset=no +else case e in #( + e) tcl_cv_cc_input_charset=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - CFLAGS=$hold_cflags + CFLAGS=$hold_cflags ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_input_charset" >&5 printf "%s\n" "$tcl_cv_cc_input_charset" >&6; } @@ -7401,8 +7676,9 @@ printf %s "checking for build with symbols... " >&6; } if test ${enable_symbols+y} then : enableval=$enable_symbols; tcl_ok=$enableval -else $as_nop - tcl_ok=no +else case e in #( + e) tcl_ok=no ;; +esac fi # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. @@ -7470,8 +7746,8 @@ printf %s "checking for required early compiler flags... " >&6; } if test ${tcl_cv_flag__isoc99_source+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include int @@ -7485,8 +7761,8 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_flag__isoc99_source=no -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define _ISOC99_SOURCE 1 #include @@ -7501,12 +7777,15 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_flag__isoc99_source=yes -else $as_nop - tcl_cv_flag__isoc99_source=no +else case e in #( + e) tcl_cv_flag__isoc99_source=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi if test "x${tcl_cv_flag__isoc99_source}" = "xyes" ; then @@ -7520,8 +7799,8 @@ printf "%s\n" "#define _ISOC99_SOURCE 1" >>confdefs.h if test ${tcl_cv_flag__largefile64_source+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include int @@ -7535,8 +7814,8 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_flag__largefile64_source=no -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define _LARGEFILE64_SOURCE 1 #include @@ -7551,12 +7830,15 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_flag__largefile64_source=yes -else $as_nop - tcl_cv_flag__largefile64_source=no +else case e in #( + e) tcl_cv_flag__largefile64_source=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then @@ -7581,8 +7863,8 @@ printf %s "checking if 'long' and 'long long' have the same size (64-bit)?... " if test ${tcl_cv_type_64bit+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) tcl_cv_type_64bit=none # See if we could use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check @@ -7604,7 +7886,8 @@ if ac_fn_c_try_compile "$LINENO" then : tcl_cv_type_64bit="long long" fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi if test "${tcl_cv_type_64bit}" = none ; then @@ -7622,8 +7905,8 @@ printf %s "checking for struct dirent64... " >&6; } if test ${tcl_cv_struct_dirent64+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -7639,10 +7922,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_struct_dirent64=yes -else $as_nop - tcl_cv_struct_dirent64=no +else case e in #( + e) tcl_cv_struct_dirent64=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_dirent64" >&5 printf "%s\n" "$tcl_cv_struct_dirent64" >&6; } @@ -7657,8 +7942,8 @@ printf %s "checking for DIR64... " >&6; } if test ${tcl_cv_DIR64+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -7675,10 +7960,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_DIR64=yes -else $as_nop - tcl_cv_DIR64=no +else case e in #( + e) tcl_cv_DIR64=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_DIR64" >&5 printf "%s\n" "$tcl_cv_DIR64" >&6; } @@ -7693,8 +7980,8 @@ printf %s "checking for struct stat64... " >&6; } if test ${tcl_cv_struct_stat64+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -7710,10 +7997,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_struct_stat64=yes -else $as_nop - tcl_cv_struct_stat64=no +else case e in #( + e) tcl_cv_struct_stat64=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_stat64" >&5 printf "%s\n" "$tcl_cv_struct_stat64" >&6; } @@ -7741,8 +8030,8 @@ printf %s "checking for off64_t... " >&6; } if test ${tcl_cv_type_off64_t+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -7758,10 +8047,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_type_off64_t=yes -else $as_nop - tcl_cv_type_off64_t=no +else case e in #( + e) tcl_cv_type_off64_t=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi if test "x${tcl_cv_type_off64_t}" = "xyes" && \ @@ -7789,8 +8080,8 @@ printf %s "checking whether byte ordering is bigendian... " >&6; } if test ${ac_cv_c_bigendian+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_cv_c_bigendian=unknown +else case e in #( + e) ac_cv_c_bigendian=unknown # See if we're dealing with a universal compiler. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -7836,8 +8127,8 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext int main (void) { -#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \ - && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \ +#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \\ + && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \\ && LITTLE_ENDIAN) bogus endian macros #endif @@ -7868,8 +8159,9 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_c_bigendian=yes -else $as_nop - ac_cv_c_bigendian=no +else case e in #( + e) ac_cv_c_bigendian=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi @@ -7913,8 +8205,9 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_c_bigendian=yes -else $as_nop - ac_cv_c_bigendian=no +else case e in #( + e) ac_cv_c_bigendian=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi @@ -7941,22 +8234,23 @@ unsigned short int ascii_mm[] = int use_ebcdic (int i) { return ebcdic_mm[i] + ebcdic_ii[i]; } - extern int foo; - -int -main (void) -{ -return use_ascii (foo) == use_ebcdic (foo); - ; - return 0; -} + int + main (int argc, char **argv) + { + /* Intimidate the compiler so that it does not + optimize the arrays away. */ + char *p = argv[0]; + ascii_mm[1] = *p++; ebcdic_mm[1] = *p++; + ascii_ii[1] = *p++; ebcdic_ii[1] = *p++; + return use_ascii (argc) == use_ebcdic (*p); + } _ACEOF -if ac_fn_c_try_compile "$LINENO" +if ac_fn_c_try_link "$LINENO" then : - if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then + if grep BIGenDianSyS conftest$ac_exeext >/dev/null; then ac_cv_c_bigendian=yes fi - if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then + if grep LiTTleEnDian conftest$ac_exeext >/dev/null ; then if test "$ac_cv_c_bigendian" = unknown; then ac_cv_c_bigendian=no else @@ -7965,9 +8259,10 @@ then : fi fi fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam \ + conftest$ac_exeext conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_includes_default int @@ -7990,14 +8285,17 @@ _ACEOF if ac_fn_c_try_run "$LINENO" then : ac_cv_c_bigendian=no -else $as_nop - ac_cv_c_bigendian=yes +else case e in #( + e) ac_cv_c_bigendian=yes ;; +esac fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext + conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi - fi + fi ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5 printf "%s\n" "$ac_cv_c_bigendian" >&6; } @@ -8030,10 +8328,11 @@ if test "x$ac_cv_func_getcwd" = xyes then : printf "%s\n" "#define HAVE_GETCWD 1" >>confdefs.h -else $as_nop - +else case e in #( + e) printf "%s\n" "#define USEGETWD 1" >>confdefs.h - + ;; +esac fi done @@ -8045,96 +8344,105 @@ if test "x$ac_cv_func_mkstemp" = xyes then : printf "%s\n" "#define HAVE_MKSTEMP 1" >>confdefs.h -else $as_nop - case " $LIBOBJS " in +else case e in #( + e) case " $LIBOBJS " in *" mkstemp.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;; esac - + ;; +esac fi ac_fn_c_check_func "$LINENO" "waitpid" "ac_cv_func_waitpid" if test "x$ac_cv_func_waitpid" = xyes then : printf "%s\n" "#define HAVE_WAITPID 1" >>confdefs.h -else $as_nop - case " $LIBOBJS " in +else case e in #( + e) case " $LIBOBJS " in *" waitpid.$ac_objext "* ) ;; *) LIBOBJS="$LIBOBJS waitpid.$ac_objext" ;; esac - + ;; +esac fi ac_fn_c_check_func "$LINENO" "strerror" "ac_cv_func_strerror" if test "x$ac_cv_func_strerror" = xyes then : -else $as_nop - +else case e in #( + e) printf "%s\n" "#define NO_STRERROR 1" >>confdefs.h - + ;; +esac fi ac_fn_c_check_func "$LINENO" "getwd" "ac_cv_func_getwd" if test "x$ac_cv_func_getwd" = xyes then : -else $as_nop - +else case e in #( + e) printf "%s\n" "#define NO_GETWD 1" >>confdefs.h - + ;; +esac fi ac_fn_c_check_func "$LINENO" "wait3" "ac_cv_func_wait3" if test "x$ac_cv_func_wait3" = xyes then : -else $as_nop - +else case e in #( + e) printf "%s\n" "#define NO_WAIT3 1" >>confdefs.h - + ;; +esac fi ac_fn_c_check_func "$LINENO" "fork" "ac_cv_func_fork" if test "x$ac_cv_func_fork" = xyes then : -else $as_nop - +else case e in #( + e) printf "%s\n" "#define NO_FORK 1" >>confdefs.h - + ;; +esac fi ac_fn_c_check_func "$LINENO" "mknod" "ac_cv_func_mknod" if test "x$ac_cv_func_mknod" = xyes then : -else $as_nop - +else case e in #( + e) printf "%s\n" "#define NO_MKNOD 1" >>confdefs.h - + ;; +esac fi ac_fn_c_check_func "$LINENO" "tcdrain" "ac_cv_func_tcdrain" if test "x$ac_cv_func_tcdrain" = xyes then : -else $as_nop - +else case e in #( + e) printf "%s\n" "#define NO_TCDRAIN 1" >>confdefs.h - + ;; +esac fi ac_fn_c_check_func "$LINENO" "uname" "ac_cv_func_uname" if test "x$ac_cv_func_uname" = xyes then : -else $as_nop - +else case e in #( + e) printf "%s\n" "#define NO_UNAME 1" >>confdefs.h - + ;; +esac fi @@ -8148,10 +8456,11 @@ ac_fn_c_check_func "$LINENO" "realpath" "ac_cv_func_realpath" if test "x$ac_cv_func_realpath" = xyes then : -else $as_nop - +else case e in #( + e) printf "%s\n" "#define NO_REALPATH 1" >>confdefs.h - + ;; +esac fi @@ -8160,16 +8469,17 @@ fi for ac_func in getnameinfo getaddrinfo freeaddrinfo gai_strerror do : - as_ac_var=`printf "%s\n" "ac_cv_func_$ac_func" | $as_tr_sh` + as_ac_var=`printf "%s\n" "ac_cv_func_$ac_func" | sed "$as_sed_sh"` ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" if eval test \"x\$"$as_ac_var"\" = x"yes" then : cat >>confdefs.h <<_ACEOF -#define `printf "%s\n" "HAVE_$ac_func" | $as_tr_cpp` 1 +#define `printf "%s\n" "HAVE_$ac_func" | sed "$as_sed_cpp"` 1 _ACEOF -else $as_nop - NEED_FAKE_RFC2553=1 +else case e in #( + e) NEED_FAKE_RFC2553=1 ;; +esac fi done @@ -8186,8 +8496,9 @@ then : printf "%s\n" "#define HAVE_STRUCT_ADDRINFO 1" >>confdefs.h -else $as_nop - NEED_FAKE_RFC2553=1 +else case e in #( + e) NEED_FAKE_RFC2553=1 ;; +esac fi ac_fn_c_check_type "$LINENO" "struct in6_addr" "ac_cv_type_struct_in6_addr" " #include @@ -8202,8 +8513,9 @@ then : printf "%s\n" "#define HAVE_STRUCT_IN6_ADDR 1" >>confdefs.h -else $as_nop - NEED_FAKE_RFC2553=1 +else case e in #( + e) NEED_FAKE_RFC2553=1 ;; +esac fi ac_fn_c_check_type "$LINENO" "struct sockaddr_in6" "ac_cv_type_struct_sockaddr_in6" " #include @@ -8218,8 +8530,9 @@ then : printf "%s\n" "#define HAVE_STRUCT_SOCKADDR_IN6 1" >>confdefs.h -else $as_nop - NEED_FAKE_RFC2553=1 +else case e in #( + e) NEED_FAKE_RFC2553=1 ;; +esac fi ac_fn_c_check_type "$LINENO" "struct sockaddr_storage" "ac_cv_type_struct_sockaddr_storage" " #include @@ -8234,8 +8547,9 @@ then : printf "%s\n" "#define HAVE_STRUCT_SOCKADDR_STORAGE 1" >>confdefs.h -else $as_nop - NEED_FAKE_RFC2553=1 +else case e in #( + e) NEED_FAKE_RFC2553=1 ;; +esac fi if test "x$NEED_FAKE_RFC2553" = "x1"; then @@ -8270,8 +8584,8 @@ printf %s "checking for getpwuid_r with 5 args... " >&6; } if test ${tcl_cv_api_getpwuid_r_5+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -8296,10 +8610,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getpwuid_r_5=yes -else $as_nop - tcl_cv_api_getpwuid_r_5=no +else case e in #( + e) tcl_cv_api_getpwuid_r_5=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwuid_r_5" >&5 printf "%s\n" "$tcl_cv_api_getpwuid_r_5" >&6; } @@ -8314,8 +8630,8 @@ printf %s "checking for getpwuid_r with 4 args... " >&6; } if test ${tcl_cv_api_getpwuid_r_4+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -8340,10 +8656,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getpwuid_r_4=yes -else $as_nop - tcl_cv_api_getpwuid_r_4=no +else case e in #( + e) tcl_cv_api_getpwuid_r_4=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwuid_r_4" >&5 printf "%s\n" "$tcl_cv_api_getpwuid_r_4" >&6; } @@ -8371,8 +8689,8 @@ printf %s "checking for getpwnam_r with 5 args... " >&6; } if test ${tcl_cv_api_getpwnam_r_5+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -8397,10 +8715,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getpwnam_r_5=yes -else $as_nop - tcl_cv_api_getpwnam_r_5=no +else case e in #( + e) tcl_cv_api_getpwnam_r_5=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwnam_r_5" >&5 printf "%s\n" "$tcl_cv_api_getpwnam_r_5" >&6; } @@ -8415,8 +8735,8 @@ printf %s "checking for getpwnam_r with 4 args... " >&6; } if test ${tcl_cv_api_getpwnam_r_4+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -8441,10 +8761,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getpwnam_r_4=yes -else $as_nop - tcl_cv_api_getpwnam_r_4=no +else case e in #( + e) tcl_cv_api_getpwnam_r_4=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwnam_r_4" >&5 printf "%s\n" "$tcl_cv_api_getpwnam_r_4" >&6; } @@ -8472,8 +8794,8 @@ printf %s "checking for getgrgid_r with 5 args... " >&6; } if test ${tcl_cv_api_getgrgid_r_5+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -8498,10 +8820,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getgrgid_r_5=yes -else $as_nop - tcl_cv_api_getgrgid_r_5=no +else case e in #( + e) tcl_cv_api_getgrgid_r_5=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrgid_r_5" >&5 printf "%s\n" "$tcl_cv_api_getgrgid_r_5" >&6; } @@ -8516,8 +8840,8 @@ printf %s "checking for getgrgid_r with 4 args... " >&6; } if test ${tcl_cv_api_getgrgid_r_4+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -8542,10 +8866,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getgrgid_r_4=yes -else $as_nop - tcl_cv_api_getgrgid_r_4=no +else case e in #( + e) tcl_cv_api_getgrgid_r_4=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrgid_r_4" >&5 printf "%s\n" "$tcl_cv_api_getgrgid_r_4" >&6; } @@ -8573,8 +8899,8 @@ printf %s "checking for getgrnam_r with 5 args... " >&6; } if test ${tcl_cv_api_getgrnam_r_5+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -8599,10 +8925,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getgrnam_r_5=yes -else $as_nop - tcl_cv_api_getgrnam_r_5=no +else case e in #( + e) tcl_cv_api_getgrnam_r_5=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrnam_r_5" >&5 printf "%s\n" "$tcl_cv_api_getgrnam_r_5" >&6; } @@ -8617,8 +8945,8 @@ printf %s "checking for getgrnam_r with 4 args... " >&6; } if test ${tcl_cv_api_getgrnam_r_4+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -8643,10 +8971,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_getgrnam_r_4=yes -else $as_nop - tcl_cv_api_getgrnam_r_4=no +else case e in #( + e) tcl_cv_api_getgrnam_r_4=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrnam_r_4" >&5 printf "%s\n" "$tcl_cv_api_getgrnam_r_4" >&6; } @@ -8697,16 +9027,18 @@ else if test "x$ac_cv_have_decl_gethostbyname_r" = xyes then : ac_have_decl=1 -else $as_nop - ac_have_decl=0 +else case e in #( + e) ac_have_decl=0 ;; +esac fi printf "%s\n" "#define HAVE_DECL_GETHOSTBYNAME_R $ac_have_decl" >>confdefs.h if test $ac_have_decl = 1 then : tcl_cv_api_gethostbyname_r=yes -else $as_nop - tcl_cv_api_gethostbyname_r=no +else case e in #( + e) tcl_cv_api_gethostbyname_r=no ;; +esac fi @@ -8721,8 +9053,8 @@ printf %s "checking for gethostbyname_r with 6 args... " >&6; } if test ${tcl_cv_api_gethostbyname_r_6+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -8747,10 +9079,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_gethostbyname_r_6=yes -else $as_nop - tcl_cv_api_gethostbyname_r_6=no +else case e in #( + e) tcl_cv_api_gethostbyname_r_6=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyname_r_6" >&5 printf "%s\n" "$tcl_cv_api_gethostbyname_r_6" >&6; } @@ -8765,8 +9099,8 @@ printf %s "checking for gethostbyname_r with 5 args... " >&6; } if test ${tcl_cv_api_gethostbyname_r_5+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -8791,10 +9125,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_gethostbyname_r_5=yes -else $as_nop - tcl_cv_api_gethostbyname_r_5=no +else case e in #( + e) tcl_cv_api_gethostbyname_r_5=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyname_r_5" >&5 printf "%s\n" "$tcl_cv_api_gethostbyname_r_5" >&6; } @@ -8809,8 +9145,8 @@ printf %s "checking for gethostbyname_r with 3 args... " >&6; } if test ${tcl_cv_api_gethostbyname_r_3+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -8833,10 +9169,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_gethostbyname_r_3=yes -else $as_nop - tcl_cv_api_gethostbyname_r_3=no +else case e in #( + e) tcl_cv_api_gethostbyname_r_3=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyname_r_3" >&5 printf "%s\n" "$tcl_cv_api_gethostbyname_r_3" >&6; } @@ -8865,16 +9203,18 @@ fi if test "x$ac_cv_have_decl_gethostbyaddr_r" = xyes then : ac_have_decl=1 -else $as_nop - ac_have_decl=0 +else case e in #( + e) ac_have_decl=0 ;; +esac fi printf "%s\n" "#define HAVE_DECL_GETHOSTBYADDR_R $ac_have_decl" >>confdefs.h if test $ac_have_decl = 1 then : tcl_cv_api_gethostbyaddr_r=yes -else $as_nop - tcl_cv_api_gethostbyaddr_r=no +else case e in #( + e) tcl_cv_api_gethostbyaddr_r=no ;; +esac fi @@ -8889,8 +9229,8 @@ printf %s "checking for gethostbyaddr_r with 7 args... " >&6; } if test ${tcl_cv_api_gethostbyaddr_r_7+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -8918,10 +9258,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_gethostbyaddr_r_7=yes -else $as_nop - tcl_cv_api_gethostbyaddr_r_7=no +else case e in #( + e) tcl_cv_api_gethostbyaddr_r_7=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyaddr_r_7" >&5 printf "%s\n" "$tcl_cv_api_gethostbyaddr_r_7" >&6; } @@ -8936,8 +9278,8 @@ printf %s "checking for gethostbyaddr_r with 8 args... " >&6; } if test ${tcl_cv_api_gethostbyaddr_r_8+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -8965,10 +9307,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_api_gethostbyaddr_r_8=yes -else $as_nop - tcl_cv_api_gethostbyaddr_r_8=no +else case e in #( + e) tcl_cv_api_gethostbyaddr_r_8=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyaddr_r_8" >&5 printf "%s\n" "$tcl_cv_api_gethostbyaddr_r_8" >&6; } @@ -9037,8 +9381,8 @@ printf %s "checking for fd_set in sys/types... " >&6; } if test ${tcl_cv_type_fd_set+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -9053,10 +9397,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_type_fd_set=yes -else $as_nop - tcl_cv_type_fd_set=no +else case e in #( + e) tcl_cv_type_fd_set=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_type_fd_set" >&5 printf "%s\n" "$tcl_cv_type_fd_set" >&6; } @@ -9067,22 +9413,24 @@ printf %s "checking for fd_mask in sys/select... " >&6; } if test ${tcl_cv_grep_fd_mask+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "fd_mask" >/dev/null 2>&1 + $EGREP_TRADITIONAL "fd_mask" >/dev/null 2>&1 then : tcl_cv_grep_fd_mask=present -else $as_nop - tcl_cv_grep_fd_mask=missing +else case e in #( + e) tcl_cv_grep_fd_mask=missing ;; +esac fi rm -rf conftest* - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_grep_fd_mask" >&5 printf "%s\n" "$tcl_cv_grep_fd_mask" >&6; } @@ -9104,8 +9452,8 @@ printf %s "checking for pselect... " >&6; } if test ${tcl_cv_func_pselect+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -9120,10 +9468,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_func_pselect=yes -else $as_nop - tcl_cv_func_pselect=no +else case e in #( + e) tcl_cv_func_pselect=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_func_pselect" >&5 printf "%s\n" "$tcl_cv_func_pselect" >&6; } @@ -9177,12 +9527,12 @@ printf "%s\n" "kqueue(2)" >&6; } tcl_kqueue_headers=x for ac_header in sys/types.h sys/event.h sys/time.h do : - as_ac_Header=`printf "%s\n" "ac_cv_header_$ac_header" | $as_tr_sh` + as_ac_Header=`printf "%s\n" "ac_cv_header_$ac_header" | sed "$as_sed_sh"` ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" if eval test \"x\$"$as_ac_Header"\" = x"yes" then : cat >>confdefs.h <<_ACEOF -#define `printf "%s\n" "HAVE_$ac_header" | $as_tr_cpp` 1 +#define `printf "%s\n" "HAVE_$ac_header" | sed "$as_sed_cpp"` 1 _ACEOF tcl_kqueue_headers=${tcl_kqueue_headers}y fi @@ -9245,8 +9595,8 @@ printf %s "checking tm_tzadj in struct tm... " >&6; } if test ${tcl_cv_member_tm_tzadj+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -9261,10 +9611,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_member_tm_tzadj=yes -else $as_nop - tcl_cv_member_tm_tzadj=no +else case e in #( + e) tcl_cv_member_tm_tzadj=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_member_tm_tzadj" >&5 printf "%s\n" "$tcl_cv_member_tm_tzadj" >&6; } @@ -9279,8 +9631,8 @@ printf %s "checking tm_gmtoff in struct tm... " >&6; } if test ${tcl_cv_member_tm_gmtoff+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -9295,10 +9647,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_member_tm_gmtoff=yes -else $as_nop - tcl_cv_member_tm_gmtoff=no +else case e in #( + e) tcl_cv_member_tm_gmtoff=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_member_tm_gmtoff" >&5 printf "%s\n" "$tcl_cv_member_tm_gmtoff" >&6; } @@ -9317,8 +9671,8 @@ printf %s "checking long timezone variable... " >&6; } if test ${tcl_cv_timezone_long+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -9336,10 +9690,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_timezone_long=yes -else $as_nop - tcl_cv_timezone_long=no +else case e in #( + e) tcl_cv_timezone_long=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_timezone_long" >&5 printf "%s\n" "$tcl_cv_timezone_long" >&6; } @@ -9356,8 +9712,8 @@ printf %s "checking time_t timezone variable... " >&6; } if test ${tcl_cv_timezone_time+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -9375,10 +9731,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_timezone_time=yes -else $as_nop - tcl_cv_timezone_time=no +else case e in #( + e) tcl_cv_timezone_time=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_timezone_time" >&5 printf "%s\n" "$tcl_cv_timezone_time" >&6; } @@ -9436,10 +9794,11 @@ ac_fn_c_check_func "$LINENO" "fstatfs" "ac_cv_func_fstatfs" if test "x$ac_cv_func_fstatfs" = xyes then : -else $as_nop - +else case e in #( + e) printf "%s\n" "#define NO_FSTATFS 1" >>confdefs.h - + ;; +esac fi @@ -9453,14 +9812,15 @@ ac_fn_c_check_func "$LINENO" "memmove" "ac_cv_func_memmove" if test "x$ac_cv_func_memmove" = xyes then : -else $as_nop - +else case e in #( + e) printf "%s\n" "#define NO_MEMMOVE 1" >>confdefs.h printf "%s\n" "#define NO_STRING_H 1" >>confdefs.h - + ;; +esac fi @@ -9473,10 +9833,11 @@ ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default" if test "x$ac_cv_type_mode_t" = xyes then : -else $as_nop - +else case e in #( + e) printf "%s\n" "#define mode_t int" >>confdefs.h - + ;; +esac fi @@ -9485,8 +9846,8 @@ fi if test "x$ac_cv_type_pid_t" = xyes then : -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #if defined _WIN64 && !defined __CYGWIN__ @@ -9505,14 +9866,16 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_pid_type='int' -else $as_nop - ac_pid_type='__int64' +else case e in #( + e) ac_pid_type='__int64' ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext printf "%s\n" "#define pid_t $ac_pid_type" >>confdefs.h - + ;; +esac fi @@ -9520,42 +9883,33 @@ ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default" if test "x$ac_cv_type_size_t" = xyes then : -else $as_nop - +else case e in #( + e) printf "%s\n" "#define size_t unsigned int" >>confdefs.h - + ;; +esac fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for uid_t in sys/types.h" >&5 -printf %s "checking for uid_t in sys/types.h... " >&6; } -if test ${ac_cv_type_uid_t+y} -then : - printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "uid_t" >/dev/null 2>&1 +ac_fn_c_check_type "$LINENO" "uid_t" "ac_cv_type_uid_t" "$ac_includes_default" +if test "x$ac_cv_type_uid_t" = xyes then : - ac_cv_type_uid_t=yes -else $as_nop - ac_cv_type_uid_t=no -fi -rm -rf conftest* - -fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_uid_t" >&5 -printf "%s\n" "$ac_cv_type_uid_t" >&6; } -if test $ac_cv_type_uid_t = no; then +else case e in #( + e) printf "%s\n" "#define uid_t int" >>confdefs.h + ;; +esac +fi +ac_fn_c_check_type "$LINENO" "gid_t" "ac_cv_type_gid_t" "$ac_includes_default" +if test "x$ac_cv_type_gid_t" = xyes +then : +else case e in #( + e) printf "%s\n" "#define gid_t int" >>confdefs.h - + ;; +esac fi @@ -9564,8 +9918,8 @@ printf %s "checking for socklen_t... " >&6; } if test ${tcl_cv_type_socklen_t+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -9585,10 +9939,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_type_socklen_t=yes -else $as_nop - tcl_cv_type_socklen_t=no +else case e in #( + e) tcl_cv_type_socklen_t=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_type_socklen_t" >&5 printf "%s\n" "$tcl_cv_type_socklen_t" >&6; } @@ -9635,8 +9991,8 @@ printf %s "checking union wait... " >&6; } if test ${tcl_cv_union_wait+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -9656,11 +10012,13 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_union_wait=yes -else $as_nop - tcl_cv_union_wait=no +else case e in #( + e) tcl_cv_union_wait=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ - conftest$ac_exeext conftest.$ac_ext + conftest$ac_exeext conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_union_wait" >&5 printf "%s\n" "$tcl_cv_union_wait" >&6; } @@ -9680,8 +10038,9 @@ ac_fn_c_check_func "$LINENO" "strncasecmp" "ac_cv_func_strncasecmp" if test "x$ac_cv_func_strncasecmp" = xyes then : tcl_ok=1 -else $as_nop - tcl_ok=0 +else case e in #( + e) tcl_ok=0 ;; +esac fi if test "$tcl_ok" = 0; then @@ -9690,16 +10049,22 @@ printf %s "checking for strncasecmp in -lsocket... " >&6; } if test ${ac_cv_lib_socket_strncasecmp+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-lsocket $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char strncasecmp (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char strncasecmp (void); int main (void) { @@ -9711,20 +10076,23 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_socket_strncasecmp=yes -else $as_nop - ac_cv_lib_socket_strncasecmp=no +else case e in #( + e) ac_cv_lib_socket_strncasecmp=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_strncasecmp" >&5 printf "%s\n" "$ac_cv_lib_socket_strncasecmp" >&6; } if test "x$ac_cv_lib_socket_strncasecmp" = xyes then : tcl_ok=1 -else $as_nop - tcl_ok=0 +else case e in #( + e) tcl_ok=0 ;; +esac fi fi @@ -9734,16 +10102,22 @@ printf %s "checking for strncasecmp in -linet... " >&6; } if test ${ac_cv_lib_inet_strncasecmp+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_check_lib_save_LIBS=$LIBS +else case e in #( + e) ac_check_lib_save_LIBS=$LIBS LIBS="-linet $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -char strncasecmp (); + builtin and then its argument prototype would still apply. + The 'extern "C"' is for builds by C++ compilers; + although this is not generally supported in C code supporting it here + has little cost and some practical benefit (sr 110532). */ +#ifdef __cplusplus +extern "C" +#endif +char strncasecmp (void); int main (void) { @@ -9755,20 +10129,23 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_inet_strncasecmp=yes -else $as_nop - ac_cv_lib_inet_strncasecmp=no +else case e in #( + e) ac_cv_lib_inet_strncasecmp=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS +LIBS=$ac_check_lib_save_LIBS ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_inet_strncasecmp" >&5 printf "%s\n" "$ac_cv_lib_inet_strncasecmp" >&6; } if test "x$ac_cv_lib_inet_strncasecmp" = xyes then : tcl_ok=1 -else $as_nop - tcl_ok=0 +else case e in #( + e) tcl_ok=0 ;; +esac fi fi @@ -9795,12 +10172,13 @@ ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday" if test "x$ac_cv_func_gettimeofday" = xyes then : -else $as_nop - +else case e in #( + e) printf "%s\n" "#define NO_GETTOD 1" >>confdefs.h - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for gettimeofday declaration" >&5 @@ -9808,22 +10186,24 @@ printf %s "checking for gettimeofday declaration... " >&6; } if test ${tcl_cv_grep_gettimeofday+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "gettimeofday" >/dev/null 2>&1 + $EGREP_TRADITIONAL "gettimeofday" >/dev/null 2>&1 then : tcl_cv_grep_gettimeofday=present -else $as_nop - tcl_cv_grep_gettimeofday=missing +else case e in #( + e) tcl_cv_grep_gettimeofday=missing ;; +esac fi rm -rf conftest* - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_grep_gettimeofday" >&5 printf "%s\n" "$tcl_cv_grep_gettimeofday" >&6; } @@ -9844,8 +10224,8 @@ printf %s "checking whether char is unsigned... " >&6; } if test ${ac_cv_c_char_unsigned+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_includes_default int @@ -9862,10 +10242,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_c_char_unsigned=no -else $as_nop - ac_cv_c_char_unsigned=yes +else case e in #( + e) ac_cv_c_char_unsigned=yes ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_char_unsigned" >&5 printf "%s\n" "$ac_cv_c_char_unsigned" >&6; } @@ -9879,8 +10261,8 @@ printf %s "checking signed char declarations... " >&6; } if test ${tcl_cv_char_signed+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -9898,10 +10280,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_char_signed=yes -else $as_nop - tcl_cv_char_signed=no +else case e in #( + e) tcl_cv_char_signed=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_char_signed" >&5 printf "%s\n" "$tcl_cv_char_signed" >&6; } @@ -9920,13 +10304,13 @@ printf %s "checking for a putenv() that copies the buffer... " >&6; } if test ${tcl_cv_putenv_copy+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) if test "$cross_compiling" = yes then : tcl_cv_putenv_copy=no -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -9952,13 +10336,16 @@ _ACEOF if ac_fn_c_try_run "$LINENO" then : tcl_cv_putenv_copy=no -else $as_nop - tcl_cv_putenv_copy=yes +else case e in #( + e) tcl_cv_putenv_copy=yes ;; +esac fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext + conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_putenv_copy" >&5 printf "%s\n" "$tcl_cv_putenv_copy" >&6; } @@ -9977,8 +10364,9 @@ fi if test ${enable_langinfo+y} then : enableval=$enable_langinfo; langinfo_ok=$enableval -else $as_nop - langinfo_ok=yes +else case e in #( + e) langinfo_ok=yes ;; +esac fi @@ -9988,8 +10376,9 @@ fi if test "x$ac_cv_header_langinfo_h" = xyes then : langinfo_ok=yes -else $as_nop - langinfo_ok=no +else case e in #( + e) langinfo_ok=no ;; +esac fi fi @@ -9999,8 +10388,8 @@ printf %s "checking whether to use nl_langinfo... " >&6; } if test ${tcl_cv_langinfo_h+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -10015,10 +10404,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_langinfo_h=yes -else $as_nop - tcl_cv_langinfo_h=no +else case e in #( + e) tcl_cv_langinfo_h=no ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_langinfo_h" >&5 @@ -10122,8 +10513,8 @@ printf %s "checking if weak import is available... " >&6; } if test ${tcl_cv_cc_weak_import+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -10148,12 +10539,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_cc_weak_import=yes -else $as_nop - tcl_cv_cc_weak_import=no +else case e in #( + e) tcl_cv_cc_weak_import=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - CFLAGS=$hold_cflags + CFLAGS=$hold_cflags ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_weak_import" >&5 printf "%s\n" "$tcl_cv_cc_weak_import" >&6; } @@ -10167,8 +10560,8 @@ printf %s "checking if Darwin SUSv3 extensions are available... " >&6; } if test ${tcl_cv_cc_darwin_c_source+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -10194,11 +10587,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_cc_darwin_c_source=yes -else $as_nop - tcl_cv_cc_darwin_c_source=no +else case e in #( + e) tcl_cv_cc_darwin_c_source=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - CFLAGS=$hold_cflags + CFLAGS=$hold_cflags ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_darwin_c_source" >&5 printf "%s\n" "$tcl_cv_cc_darwin_c_source" >&6; } @@ -10225,8 +10620,8 @@ printf %s "checking for fts... " >&6; } if test ${tcl_cv_api_fts+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -10249,11 +10644,13 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_api_fts=yes -else $as_nop - tcl_cv_api_fts=no +else case e in #( + e) tcl_cv_api_fts=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ - conftest$ac_exeext conftest.$ac_ext + conftest$ac_exeext conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_fts" >&5 printf "%s\n" "$tcl_cv_api_fts" >&6; } @@ -10290,8 +10687,8 @@ printf %s "checking system version... " >&6; } if test ${tcl_cv_sys_version+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) if test "${TEA_PLATFORM}" = "windows" ; then tcl_cv_sys_version=windows else @@ -10309,7 +10706,8 @@ printf "%s\n" "$as_me: WARNING: can't find uname command" >&2;} fi fi fi - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5 printf "%s\n" "$tcl_cv_sys_version" >&6; } @@ -10340,8 +10738,9 @@ printf %s "checking whether to use dll unloading... " >&6; } if test ${enable_dll_unloading+y} then : enableval=$enable_dll_unloading; tcl_ok=$enableval -else $as_nop - tcl_ok=yes +else case e in #( + e) tcl_ok=yes ;; +esac fi if test $tcl_ok = yes; then @@ -10365,8 +10764,9 @@ printf %s "checking for timezone data... " >&6; } if test ${with_tzdata+y} then : withval=$with_tzdata; tcl_ok=$withval -else $as_nop - tcl_ok=auto +else case e in #( + e) tcl_ok=auto ;; +esac fi # @@ -10385,8 +10785,8 @@ printf "%s\n" "supplied by OS vendor" >&6; } if test ${tcl_cv_dir_zoneinfo+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) for dir in /usr/share/zoneinfo \ /usr/share/lib/zoneinfo \ /usr/lib/zoneinfo @@ -10396,7 +10796,8 @@ else $as_nop tcl_cv_dir_zoneinfo="$dir" break fi - done + done ;; +esac fi if test -n "$tcl_cv_dir_zoneinfo"; then @@ -10426,8 +10827,9 @@ fi if test ${enable_dtrace+y} then : enableval=$enable_dtrace; tcl_ok=$enableval -else $as_nop - tcl_ok=no +else case e in #( + e) tcl_ok=no ;; +esac fi if test $tcl_ok = yes; then @@ -10435,8 +10837,9 @@ if test $tcl_ok = yes; then if test "x$ac_cv_header_sys_sdt_h" = xyes then : tcl_ok=yes -else $as_nop - tcl_ok=no +else case e in #( + e) tcl_ok=no ;; +esac fi fi @@ -10448,8 +10851,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_path_DTRACE+y} then : printf %s "(cached) " >&6 -else $as_nop - case $DTRACE in +else case e in #( + e) case $DTRACE in [\\/]* | ?:[\\/]*) ac_cv_path_DTRACE="$DTRACE" # Let the user override the test with a path. ;; @@ -10475,6 +10878,7 @@ done IFS=$as_save_IFS ;; +esac ;; esac fi DTRACE=$ac_cv_path_DTRACE @@ -10524,8 +10928,8 @@ printf %s "checking whether the cpuid instruction is usable... " >&6; } if test ${tcl_cv_cpuid+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -10548,11 +10952,13 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_cpuid=yes -else $as_nop - tcl_cv_cpuid=no +else case e in #( + e) tcl_cv_cpuid=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ - conftest$ac_exeext conftest.$ac_ext + conftest$ac_exeext conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cpuid" >&5 printf "%s\n" "$tcl_cv_cpuid" >&6; } @@ -10595,8 +11001,9 @@ printf %s "checking how to package libraries... " >&6; } if test ${enable_framework+y} then : enableval=$enable_framework; enable_framework=$enableval -else $as_nop - enable_framework=no +else case e in #( + e) enable_framework=no ;; +esac fi if test $enable_framework = yes; then @@ -10700,8 +11107,9 @@ VERSION=${TCL_VERSION} if test ${enable_zipfs+y} then : enableval=$enable_zipfs; tcl_ok=$enableval -else $as_nop - tcl_ok=yes +else case e in #( + e) tcl_ok=yes ;; +esac fi if test "$tcl_ok" = "yes" -a "x$enable_framework" != "xyes"; then @@ -10718,8 +11126,8 @@ printf %s "checking for gcc... " >&6; } if test ${ac_cv_path_cc+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/gcc 2> /dev/null` \ @@ -10732,7 +11140,8 @@ else $as_nop fi done done - + ;; +esac fi fi @@ -10749,8 +11158,8 @@ printf %s "checking for build system executable suffix... " >&6; } if test ${bfd_cv_build_exeext+y} then : printf %s "(cached) " >&6 -else $as_nop - rm -f conftest* +else case e in #( + e) rm -f conftest* echo 'int main () { return 0; }' > conftest.c bfd_cv_build_exeext= ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 @@ -10761,7 +11170,8 @@ else $as_nop esac done rm -f conftest* - test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no + test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5 printf "%s\n" "$bfd_cv_build_exeext" >&6; } @@ -10784,8 +11194,8 @@ printf %s "checking for macher... " >&6; } if test ${ac_cv_path_macher+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/macher 2> /dev/null` \ @@ -10798,7 +11208,8 @@ else $as_nop fi done done - + ;; +esac fi if test -f "$ac_cv_path_macher" ; then @@ -10813,8 +11224,8 @@ printf %s "checking for zip... " >&6; } if test ${ac_cv_path_zip+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/zip 2> /dev/null` \ @@ -10827,7 +11238,8 @@ else $as_nop fi done done - + ;; +esac fi if test -f "$ac_cv_path_zip" ; then @@ -11018,8 +11430,8 @@ cat >confcache <<\_ACEOF # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # -# `ac_cv_env_foo' variables (set or unset) will be overridden when -# loading this file, other *unset* `ac_cv_foo' will be assigned the +# 'ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* 'ac_cv_foo' will be assigned the # following values. _ACEOF @@ -11049,14 +11461,14 @@ printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) - # `set' does not quote correctly, so add quotes: double-quote + # 'set' does not quote correctly, so add quotes: double-quote # substitution turns \\\\ into \\, and sed turns \\ into \. sed -n \ "s/'/'\\\\''/g; s/^\$[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\$=\$.*\$/\\1='\\2'/p" ;; #( *) - # `set' quotes correctly as required by POSIX, so do not add quotes. + # 'set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | @@ -11120,9 +11532,7 @@ s/^[ ]*#[ ]*define[ ][ ]*$[^ ][^ ]*$[ ]*$.*$/-D\1=\2/g t quote b any :quote -s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g -s/\[/\\&/g -s/\]/\\&/g +s/[][ `~#$^&*(){}\\|;'\''"<>?]/\\&/g s/\$/$$/g H :any @@ -11167,7 +11577,6 @@ cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh -as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh @@ -11176,12 +11585,13 @@ then : # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST -else $as_nop - case `(set -o) 2>/dev/null` in #( +else case e in #( + e) case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; +esac ;; esac fi @@ -11253,7 +11663,7 @@ IFS=$as_save_IFS ;; esac -# We did not find ourselves, most probably we were run as `sh COMMAND' +# We did not find ourselves, most probably we were run as 'sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 @@ -11282,7 +11692,6 @@ as_fn_error () } # as_fn_error - # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. @@ -11322,11 +11731,12 @@ then : { eval $1+=\$2 }' -else $as_nop - as_fn_append () +else case e in #( + e) as_fn_append () { eval $1=\$$1\$2 - } + } ;; +esac fi # as_fn_append # as_fn_arith ARG... @@ -11340,11 +11750,12 @@ then : { as_val=$(( $* )) }' -else $as_nop - as_fn_arith () +else case e in #( + e) as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` - } + } ;; +esac fi # as_fn_arith @@ -11427,9 +11838,9 @@ if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. + # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable. + # In both cases, we have to default to 'cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then @@ -11510,10 +11921,12 @@ as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. -as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" +as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" +as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated # Sed expression to map a string onto a valid variable name. -as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" +as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g" +as_tr_sh="eval sed '$as_sed_sh'" # deprecated exec 6>&1 @@ -11529,7 +11942,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # values after options handling. ac_log=" This file was extended by tcl $as_me 8.7, which was -generated by GNU Autoconf 2.71. Invocation command line was +generated by GNU Autoconf 2.72. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -11557,7 +11970,7 @@ _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\ -\`$as_me' instantiates files and other configuration actions +'$as_me' instantiates files and other configuration actions from templates according to the current configuration. Unless the files and actions are specified as TAGs, all are instantiated by default. @@ -11588,10 +12001,10 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ tcl config.status 8.7 -configured by $0, generated by GNU Autoconf 2.71, +configured by $0, generated by GNU Autoconf 2.72, with options \\"\$ac_cs_config\\" -Copyright (C) 2021 Free Software Foundation, Inc. +Copyright (C) 2023 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." @@ -11648,8 +12061,8 @@ do ac_cs_silent=: ;; # This is an error. - -*) as_fn_error $? "unrecognized option: \`$1' -Try \`$0 --help' for more information." ;; + -*) as_fn_error $? "unrecognized option: '$1' +Try '$0 --help' for more information." ;; *) as_fn_append ac_config_targets " $1" ac_need_defaults=false ;; @@ -11710,7 +12123,7 @@ do "tclConfig.sh") CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;; "tcl.pc") CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;; - *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + *) as_fn_error $? "invalid argument: '$ac_config_target'" "$LINENO" 5;; esac done @@ -11729,7 +12142,7 @@ fi # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: -# after its creation but before its name has been assigned to `$tmp'. +# after its creation but before its name has been assigned to '$tmp'. $debug || { tmp= ac_tmp= @@ -11753,7 +12166,7 @@ ac_tmp=$tmp # Set up the scripts for CONFIG_FILES section. # No need to generate them if there are no CONFIG_FILES. -# This happens for instance with `./config.status config.h'. +# This happens for instance with './config.status config.h'. if test -n "$CONFIG_FILES"; then @@ -11919,7 +12332,7 @@ do esac case $ac_mode$ac_tag in :[FHL]*:*);; - :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :L* | :C*:*) as_fn_error $? "invalid tag '$ac_tag'" "$LINENO" 5;; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac @@ -11941,19 +12354,19 @@ do -) ac_f="$ac_tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, - # because $ac_f cannot contain `:'. + # because $ac_f cannot contain ':'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || - as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + as_fn_error 1 "cannot find input file: '$ac_f'" "$LINENO" 5;; esac case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'" done - # Let's still pretend it is `configure' which instantiates (i.e., don't + # Let's still pretend it is 'configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input='Generated from '` @@ -12077,7 +12490,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 esac _ACEOF -# Neutralize VPATH when `$srcdir' = `.'. +# Neutralize VPATH when '$srcdir' = '.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 @@ -12106,9 +12519,9 @@ test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ "$ac_tmp/out"`; test -z "$ac_out"; } && - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable 'datarootdir' which seems to be undefined. Please make sure it is defined" >&5 -printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable 'datarootdir' which seems to be undefined. Please make sure it is defined" >&2;} rm -f "$ac_tmp/stdin" diff --git a/win/configure b/win/configure index f154f32..75a3c38 100755 --- a/win/configure +++ b/win/configure @@ -1,9 +1,9 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.71 for tcl 8.7. +# Generated by GNU Autoconf 2.72 for tcl 8.7. # # -# Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation, +# Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation, # Inc. # # @@ -15,7 +15,6 @@ # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh -as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh @@ -24,12 +23,13 @@ then : # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST -else $as_nop - case `(set -o) 2>/dev/null` in #( +else case e in #( + e) case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; +esac ;; esac fi @@ -101,7 +101,7 @@ IFS=$as_save_IFS ;; esac -# We did not find ourselves, most probably we were run as `sh COMMAND' +# We did not find ourselves, most probably we were run as 'sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 @@ -131,15 +131,14 @@ case $- in # (((( esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. +# out after a failed 'exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi # We don't want this to propagate to other subprocesses. { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then - as_bourne_compatible="as_nop=: -if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 + as_bourne_compatible="if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: @@ -147,12 +146,13 @@ then : # is contrary to our usage. Disable this feature. alias -g '\${1+\"\$@\"}'='\"\$@\"' setopt NO_GLOB_SUBST -else \$as_nop - case \`(set -o) 2>/dev/null\` in #( +else case e in #( + e) case \`(set -o) 2>/dev/null\` in #( *posix*) : set -o posix ;; #( *) : ;; +esac ;; esac fi " @@ -170,8 +170,9 @@ as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } if ( set x; as_fn_ret_success y && test x = \"\$1\" ) then : -else \$as_nop - exitcode=1; echo positional parameters were not saved. +else case e in #( + e) exitcode=1; echo positional parameters were not saved. ;; +esac fi test x\$exitcode = x0 || exit 1 blah=\$(echo \$(echo blah)) @@ -185,14 +186,15 @@ test \$(( 1 + 1 )) = 2 || exit 1" if (eval "$as_required") 2>/dev/null then : as_have_required=yes -else $as_nop - as_have_required=no +else case e in #( + e) as_have_required=no ;; +esac fi if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null then : -else $as_nop - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +else case e in #( + e) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_found=false for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do @@ -225,12 +227,13 @@ IFS=$as_save_IFS if $as_found then : -else $as_nop - if { test -f "$SHELL" || test -f "$SHELL.exe"; } && +else case e in #( + e) if { test -f "$SHELL" || test -f "$SHELL.exe"; } && as_run=a "$SHELL" -c "$as_bourne_compatible""$as_required" 2>/dev/null then : CONFIG_SHELL=$SHELL as_have_required=yes -fi +fi ;; +esac fi @@ -252,7 +255,7 @@ case $- in # (((( esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. +# out after a failed 'exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi @@ -271,7 +274,8 @@ $0: message. Then install a modern shell, or manually run $0: the script under such a shell if you do have one." fi exit 1 -fi +fi ;; +esac fi fi SHELL=${CONFIG_SHELL-/bin/sh} @@ -310,14 +314,6 @@ as_fn_exit () as_fn_set_status $1 exit $1 } # as_fn_exit -# as_fn_nop -# --------- -# Do nothing but, unlike ":", preserve the value of $?. -as_fn_nop () -{ - return $? -} -as_nop=as_fn_nop # as_fn_mkdir_p # ------------- @@ -386,11 +382,12 @@ then : { eval $1+=\$2 }' -else $as_nop - as_fn_append () +else case e in #( + e) as_fn_append () { eval $1=\$$1\$2 - } + } ;; +esac fi # as_fn_append # as_fn_arith ARG... @@ -404,21 +401,14 @@ then : { as_val=$(( $* )) }' -else $as_nop - as_fn_arith () +else case e in #( + e) as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` - } + } ;; +esac fi # as_fn_arith -# as_fn_nop -# --------- -# Do nothing but, unlike ":", preserve the value of $?. -as_fn_nop () -{ - return $? -} -as_nop=as_fn_nop # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- @@ -492,6 +482,8 @@ as_cr_alnum=$as_cr_Letters$as_cr_digits /[$]LINENO/= ' <$as_myself | sed ' + t clear + :clear s/[$]LINENO.*/&-/ t lineno b @@ -540,7 +532,6 @@ esac as_echo='printf %s\n' as_echo_n='printf %s' - rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file @@ -552,9 +543,9 @@ if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. + # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable. + # In both cases, we have to default to 'cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then @@ -579,10 +570,12 @@ as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. -as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" +as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" +as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated # Sed expression to map a string onto a valid variable name. -as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" +as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g" +as_tr_sh="eval sed '$as_sed_sh'" # deprecated test -n "$DJDIR" || exec 7<&0 /dev/null && - as_fn_error $? "invalid feature name: \`$ac_useropt'" + as_fn_error $? "invalid feature name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -957,7 +948,7 @@ do ac_useropt=`expr "x$ac_option" : 'x-*enable-$[^=]*$'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid feature name: \`$ac_useropt'" + as_fn_error $? "invalid feature name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1170,7 +1161,7 @@ do ac_useropt=`expr "x$ac_option" : 'x-*with-$[^=]*$'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid package name: \`$ac_useropt'" + as_fn_error $? "invalid package name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1186,7 +1177,7 @@ do ac_useropt=`expr "x$ac_option" : 'x-*without-$.*$'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid package name: \`$ac_useropt'" + as_fn_error $? "invalid package name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in @@ -1216,8 +1207,8 @@ do | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; - -*) as_fn_error $? "unrecognized option: \`$ac_option' -Try \`$0 --help' for more information" + -*) as_fn_error $? "unrecognized option: '$ac_option' +Try '$0 --help' for more information" ;; *=*) @@ -1225,7 +1216,7 @@ Try \`$0 --help' for more information" # Reject names that are not valid shell variable names. case $ac_envvar in #( '' | [0-9]* | *[!_$as_cr_alnum]* ) - as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + as_fn_error $? "invalid variable name: '$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;; @@ -1275,7 +1266,7 @@ do as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done -# There might be people who depend on the old broken behavior: `$host' +# There might be people who depend on the old broken behavior: '$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias @@ -1343,7 +1334,7 @@ if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" fi -ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_msg="sources are in $srcdir, but 'cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" pwd)` @@ -1371,7 +1362,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures tcl 8.7 to adapt to many kinds of systems. +'configure' configures tcl 8.7 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1385,11 +1376,11 @@ Configuration: --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit - -q, --quiet, --silent do not print \`checking ...' messages + -q, --quiet, --silent do not print 'checking ...' messages --cache-file=FILE cache test results in FILE [disabled] - -C, --config-cache alias for \`--cache-file=config.cache' + -C, --config-cache alias for '--cache-file=config.cache' -n, --no-create do not create output files - --srcdir=DIR find the sources in DIR [configure dir or \`..'] + --srcdir=DIR find the sources in DIR [configure dir or '..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX @@ -1397,10 +1388,10 @@ Installation directories: --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] -By default, \`make install' will install all the files in -\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify -an installation prefix other than \`$ac_default_prefix' using \`--prefix', -for instance \`--prefix=\$HOME'. +By default, 'make install' will install all the files in +'$ac_default_prefix/bin', '$ac_default_prefix/lib' etc. You can specify +an installation prefix other than '$ac_default_prefix' using '--prefix', +for instance '--prefix=\$HOME'. For better control, use the options below. @@ -1464,7 +1455,7 @@ Some influential environment variables: you have headers in a nonstandard directory CPP C preprocessor -Use these variables to override the choices made by `configure' or to help +Use these variables to override the choices made by 'configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to the package provider. @@ -1532,9 +1523,9 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF tcl configure 8.7 -generated by GNU Autoconf 2.71 +generated by GNU Autoconf 2.72 -Copyright (C) 2021 Free Software Foundation, Inc. +Copyright (C) 2023 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF @@ -1573,11 +1564,12 @@ printf "%s\n" "$ac_try_echo"; } >&5 } && test -s conftest.$ac_objext then : ac_retval=0 -else $as_nop - printf "%s\n" "$as_me: failed program was:" >&5 +else case e in #( + e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_retval=1 + ac_retval=1 ;; +esac fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval @@ -1596,8 +1588,8 @@ printf %s "checking for $2... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 #include <$2> @@ -1605,10 +1597,12 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "$3=yes" -else $as_nop - eval "$3=no" +else case e in #( + e) eval "$3=no" ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 @@ -1629,8 +1623,8 @@ printf %s "checking for $2... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 -else $as_nop - eval "$3=no" +else case e in #( + e) eval "$3=no" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 @@ -1660,12 +1654,14 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : -else $as_nop - eval "$3=yes" +else case e in #( + e) eval "$3=yes" ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 @@ -1701,11 +1697,12 @@ printf "%s\n" "$ac_try_echo"; } >&5 } then : ac_retval=0 -else $as_nop - printf "%s\n" "$as_me: failed program was:" >&5 +else case e in #( + e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_retval=1 + ac_retval=1 ;; +esac fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval @@ -1736,7 +1733,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by tcl $as_me 8.7, which was -generated by GNU Autoconf 2.71. Invocation command line was +generated by GNU Autoconf 2.72. Invocation command line was $ $0$ac_configure_args_raw @@ -1982,10 +1979,10 @@ esac printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" \ - || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} + || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file -See \`config.log' for more details" "$LINENO" 5; } +See 'config.log' for more details" "$LINENO" 5; } fi done @@ -2021,9 +2018,7 @@ struct stat; /* Most of the following tests are stolen from RCS 5.7 src/conf.sh. */ struct buf { int x; }; struct buf * (*rcsopen) (struct buf *, struct stat *, int); -static char *e (p, i) - char **p; - int i; +static char *e (char **p, int i) { return p[i]; } @@ -2037,6 +2032,21 @@ static char *f (char * (*g) (char **, int), char **p, ...) return s; } +/* C89 style stringification. */ +#define noexpand_stringify(a) #a +const char *stringified = noexpand_stringify(arbitrary+token=sequence); + +/* C89 style token pasting. Exercises some of the corner cases that + e.g. old MSVC gets wrong, but not very hard. */ +#define noexpand_concat(a,b) a##b +#define expand_concat(a,b) noexpand_concat(a,b) +extern int vA; +extern int vbee; +#define aye A +#define bee B +int *pvA = &expand_concat(v,aye); +int *pvbee = &noexpand_concat(v,bee); + /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not \xHH hex character constants. These do not provoke an error unfortunately, instead are silently treated @@ -2064,16 +2074,19 @@ ok |= (argc == 0 || f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]); # Test code for whether the C compiler supports C99 (global declarations) ac_c_conftest_c99_globals=' -// Does the compiler advertise C99 conformance? +/* Does the compiler advertise C99 conformance? */ #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L # error "Compiler does not advertise C99 conformance" #endif +// See if C++-style comments work. + #include extern int puts (const char *); extern int printf (const char *, ...); extern int dprintf (int, const char *, ...); extern void *malloc (size_t); +extern void free (void *); // Check varargs macros. These examples are taken from C99 6.10.3.5. // dprintf is used instead of fprintf to avoid needing to declare @@ -2123,7 +2136,6 @@ typedef const char *ccp; static inline int test_restrict (ccp restrict text) { - // See if C++-style comments work. // Iterate through items via the restricted pointer. // Also check for declarations in for loops. for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i) @@ -2189,6 +2201,8 @@ ac_c_conftest_c99_main=' ia->datasize = 10; for (int i = 0; i < ia->datasize; ++i) ia->data[i] = i * 1.234; + // Work around memory leak warnings. + free (ia); // Check named initializers. struct named_init ni = { @@ -2210,7 +2224,7 @@ ac_c_conftest_c99_main=' # Test code for whether the C compiler supports C11 (global declarations) ac_c_conftest_c11_globals=' -// Does the compiler advertise C11 conformance? +/* Does the compiler advertise C11 conformance? */ #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L # error "Compiler does not advertise C11 conformance" #endif @@ -2333,12 +2347,12 @@ for ac_var in $ac_precious_vars; do eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 -printf "%s\n" "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&5 +printf "%s\n" "$as_me: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 -printf "%s\n" "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was not set in the previous run" >&5 +printf "%s\n" "$as_me: error: '$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) @@ -2347,18 +2361,18 @@ printf "%s\n" "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_old_val_w=`echo x $ac_old_val` ac_new_val_w=`echo x $ac_new_val` if test "$ac_old_val_w" != "$ac_new_val_w"; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 -printf "%s\n" "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' has changed since the previous run:" >&5 +printf "%s\n" "$as_me: error: '$ac_var' has changed since the previous run:" >&2;} ac_cache_corrupted=: else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 -printf "%s\n" "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&5 +printf "%s\n" "$as_me: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&2;} eval $ac_var=\$ac_old_val fi - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 -printf "%s\n" "$as_me: former value: \`$ac_old_val'" >&2;} - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 -printf "%s\n" "$as_me: current value: \`$ac_new_val'" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: former value: '$ac_old_val'" >&5 +printf "%s\n" "$as_me: former value: '$ac_old_val'" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: current value: '$ac_new_val'" >&5 +printf "%s\n" "$as_me: current value: '$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. @@ -2374,11 +2388,11 @@ printf "%s\n" "$as_me: current value: \`$ac_new_val'" >&2;} fi done if $ac_cache_corrupted; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;} - as_fn_error $? "run \`${MAKE-make} distclean' and/or \`rm $cache_file' + as_fn_error $? "run '${MAKE-make} distclean' and/or 'rm $cache_file' and start over" "$LINENO" 5 fi ## -------------------- ## @@ -2468,8 +2482,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CC"; then +else case e in #( + e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2491,7 +2505,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then @@ -2513,8 +2528,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_CC"; then +else case e in #( + e) if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2536,7 +2551,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then @@ -2571,8 +2587,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CC"; then +else case e in #( + e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2594,7 +2610,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then @@ -2616,8 +2633,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CC"; then +else case e in #( + e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no @@ -2656,7 +2673,8 @@ if test $ac_prog_rejected = yes; then ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@" fi fi -fi +fi ;; +esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then @@ -2680,8 +2698,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CC"; then +else case e in #( + e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2703,7 +2721,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then @@ -2729,8 +2748,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_CC"; then +else case e in #( + e) if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2752,7 +2771,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then @@ -2790,8 +2810,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CC"; then +else case e in #( + e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2813,7 +2833,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then @@ -2835,8 +2856,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_CC"; then +else case e in #( + e) if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -2858,7 +2879,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then @@ -2887,10 +2909,10 @@ fi fi -test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH -See \`config.log' for more details" "$LINENO" 5; } +See 'config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 @@ -2962,8 +2984,8 @@ printf "%s\n" "$ac_try_echo"; } >&5 printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : - # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. -# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' + # Autoconf-2.13 could set the ac_cv_exeext variable to 'no'. +# So ignore a value of 'no', otherwise this would lead to 'EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. @@ -2983,7 +3005,7 @@ do ac_cv_exeext=`expr "$ac_file" : '[^.]*$\..*$'` fi # We set ac_cv_exeext here because the later test for it is not - # safe: cross compilers may not add the suffix if given an `-o' + # safe: cross compilers may not add the suffix if given an '-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. @@ -2994,8 +3016,9 @@ do done test "$ac_cv_exeext" = no && ac_cv_exeext= -else $as_nop - ac_file='' +else case e in #( + e) ac_file='' ;; +esac fi if test -z "$ac_file" then : @@ -3004,13 +3027,14 @@ printf "%s\n" "no" >&6; } printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables -See \`config.log' for more details" "$LINENO" 5; } -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -printf "%s\n" "yes" >&6; } +See 'config.log' for more details" "$LINENO" 5; } +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +printf "%s\n" "yes" >&6; } ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 printf %s "checking for C compiler default output file name... " >&6; } @@ -3034,10 +3058,10 @@ printf "%s\n" "$ac_try_echo"; } >&5 printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : - # If both `conftest.exe' and `conftest' are `present' (well, observable) -# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will -# work properly (i.e., refer to `conftest.exe'), while it won't with -# `rm'. + # If both 'conftest.exe' and 'conftest' are 'present' (well, observable) +# catch 'conftest.exe'. For instance with Cygwin, 'ls conftest' will +# work properly (i.e., refer to 'conftest.exe'), while it won't with +# 'rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in @@ -3047,11 +3071,12 @@ for ac_file in conftest.exe conftest conftest.*; do * ) break;; esac done -else $as_nop - { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +else case e in #( + e) { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link -See \`config.log' for more details" "$LINENO" 5; } +See 'config.log' for more details" "$LINENO" 5; } ;; +esac fi rm -f conftest conftest$ac_cv_exeext { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 @@ -3067,6 +3092,8 @@ int main (void) { FILE *f = fopen ("conftest.out", "w"); + if (!f) + return 1; return ferror (f) || fclose (f) != 0; ; @@ -3106,26 +3133,27 @@ printf "%s\n" "$ac_try_echo"; } >&5 if test "$cross_compiling" = maybe; then cross_compiling=yes else - { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} + { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error 77 "cannot run C compiled programs. -If you meant to cross compile, use \`--host'. -See \`config.log' for more details" "$LINENO" 5; } +If you meant to cross compile, use '--host'. +See 'config.log' for more details" "$LINENO" 5; } fi fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 printf "%s\n" "$cross_compiling" >&6; } -rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +rm -f conftest.$ac_ext conftest$ac_cv_exeext \ + conftest.o conftest.obj conftest.out ac_clean_files=$ac_clean_files_save { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 printf %s "checking for suffix of object files... " >&6; } if test ${ac_cv_objext+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -3157,16 +3185,18 @@ then : break;; esac done -else $as_nop - printf "%s\n" "$as_me: failed program was:" >&5 +else case e in #( + e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile -See \`config.log' for more details" "$LINENO" 5; } +See 'config.log' for more details" "$LINENO" 5; } ;; +esac fi -rm -f conftest.$ac_cv_objext conftest.$ac_ext +rm -f conftest.$ac_cv_objext conftest.$ac_ext ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 printf "%s\n" "$ac_cv_objext" >&6; } @@ -3177,8 +3207,8 @@ printf %s "checking whether the compiler supports GNU C... " >&6; } if test ${ac_cv_c_compiler_gnu+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -3195,12 +3225,14 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_compiler_gnu=yes -else $as_nop - ac_compiler_gnu=no +else case e in #( + e) ac_compiler_gnu=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; } @@ -3218,8 +3250,8 @@ printf %s "checking whether $CC accepts -g... " >&6; } if test ${ac_cv_prog_cc_g+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_save_c_werror_flag=$ac_c_werror_flag +else case e in #( + e) ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" @@ -3237,8 +3269,8 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes -else $as_nop - CFLAGS="" +else case e in #( + e) CFLAGS="" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3253,8 +3285,8 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : -else $as_nop - ac_c_werror_flag=$ac_save_c_werror_flag +else case e in #( + e) ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3271,12 +3303,15 @@ if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi -rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - ac_c_werror_flag=$ac_save_c_werror_flag + ac_c_werror_flag=$ac_save_c_werror_flag ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 printf "%s\n" "$ac_cv_prog_cc_g" >&6; } @@ -3303,8 +3338,8 @@ printf %s "checking for $CC option to enable C11 features... " >&6; } if test ${ac_cv_prog_cc_c11+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_cv_prog_cc_c11=no +else case e in #( + e) ac_cv_prog_cc_c11=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3321,25 +3356,28 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c11" != "xno" && break done rm -f conftest.$ac_ext -CC=$ac_save_CC +CC=$ac_save_CC ;; +esac fi if test "x$ac_cv_prog_cc_c11" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } -else $as_nop - if test "x$ac_cv_prog_cc_c11" = x +else case e in #( + e) if test "x$ac_cv_prog_cc_c11" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } - CC="$CC $ac_cv_prog_cc_c11" + CC="$CC $ac_cv_prog_cc_c11" ;; +esac fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 - ac_prog_cc_stdc=c11 + ac_prog_cc_stdc=c11 ;; +esac fi fi if test x$ac_prog_cc_stdc = xno @@ -3349,8 +3387,8 @@ printf %s "checking for $CC option to enable C99 features... " >&6; } if test ${ac_cv_prog_cc_c99+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_cv_prog_cc_c99=no +else case e in #( + e) ac_cv_prog_cc_c99=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3367,25 +3405,28 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c99" != "xno" && break done rm -f conftest.$ac_ext -CC=$ac_save_CC +CC=$ac_save_CC ;; +esac fi if test "x$ac_cv_prog_cc_c99" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } -else $as_nop - if test "x$ac_cv_prog_cc_c99" = x +else case e in #( + e) if test "x$ac_cv_prog_cc_c99" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } - CC="$CC $ac_cv_prog_cc_c99" + CC="$CC $ac_cv_prog_cc_c99" ;; +esac fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 - ac_prog_cc_stdc=c99 + ac_prog_cc_stdc=c99 ;; +esac fi fi if test x$ac_prog_cc_stdc = xno @@ -3395,8 +3436,8 @@ printf %s "checking for $CC option to enable C89 features... " >&6; } if test ${ac_cv_prog_cc_c89+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_cv_prog_cc_c89=no +else case e in #( + e) ac_cv_prog_cc_c89=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3413,25 +3454,28 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext -CC=$ac_save_CC +CC=$ac_save_CC ;; +esac fi if test "x$ac_cv_prog_cc_c89" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } -else $as_nop - if test "x$ac_cv_prog_cc_c89" = x +else case e in #( + e) if test "x$ac_cv_prog_cc_c89" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } -else $as_nop - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +else case e in #( + e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } - CC="$CC $ac_cv_prog_cc_c89" + CC="$CC $ac_cv_prog_cc_c89" ;; +esac fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 - ac_prog_cc_stdc=c89 + ac_prog_cc_stdc=c89 ;; +esac fi fi @@ -3447,8 +3491,8 @@ printf %s "checking for inline... " >&6; } if test ${ac_cv_c_inline+y} then : printf %s "(cached) " >&6 -else $as_nop - ac_cv_c_inline=no +else case e in #( + e) ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -3466,7 +3510,8 @@ fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext test "$ac_cv_c_inline" != no && break done - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5 printf "%s\n" "$ac_cv_c_inline" >&6; } @@ -3495,8 +3540,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_AR+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$AR"; then +else case e in #( + e) if test -n "$AR"; then ac_cv_prog_AR="$AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3518,7 +3563,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi AR=$ac_cv_prog_AR if test -n "$AR"; then @@ -3540,8 +3586,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_AR+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_AR"; then +else case e in #( + e) if test -n "$ac_ct_AR"; then ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3563,7 +3609,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_AR=$ac_cv_prog_ac_ct_AR if test -n "$ac_ct_AR"; then @@ -3597,8 +3644,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_RANLIB+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$RANLIB"; then +else case e in #( + e) if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3620,7 +3667,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then @@ -3642,8 +3690,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_RANLIB+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_RANLIB"; then +else case e in #( + e) if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3665,7 +3713,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then @@ -3699,8 +3748,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_RC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$RC"; then +else case e in #( + e) if test -n "$RC"; then ac_cv_prog_RC="$RC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3722,7 +3771,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi RC=$ac_cv_prog_RC if test -n "$RC"; then @@ -3744,8 +3794,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_RC+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$ac_ct_RC"; then +else case e in #( + e) if test -n "$ac_ct_RC"; then ac_cv_prog_ac_ct_RC="$ac_ct_RC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3767,7 +3817,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi ac_ct_RC=$ac_cv_prog_ac_ct_RC if test -n "$ac_ct_RC"; then @@ -3805,8 +3856,8 @@ ac_make=`printf "%s\n" "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` if eval test \${ac_cv_prog_make_${ac_make}_set+y} then : printf %s "(cached) " >&6 -else $as_nop - cat >conftest.make <<\_ACEOF +else case e in #( + e) cat >conftest.make <<\_ACEOF SHELL = /bin/sh all: @echo '@@@%%%=$(MAKE)=@@@%%%' @@ -3818,7 +3869,8 @@ case `${MAKE-make} -f conftest.make 2>/dev/null` in *) eval ac_cv_prog_make_${ac_make}_set=no;; esac -rm -f conftest.make +rm -f conftest.make ;; +esac fi if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 @@ -3872,8 +3924,9 @@ printf %s "checking how to build libraries... " >&6; } if test ${enable_shared+y} then : enableval=$enable_shared; tcl_ok=$enableval -else $as_nop - tcl_ok=yes +else case e in #( + e) tcl_ok=yes ;; +esac fi if test "$tcl_ok" = "yes" ; then @@ -3901,8 +3954,9 @@ printf %s "checking force of 64-bit time_t... " >&6; } if test ${enable_time64bit+y} then : enableval=$enable_time64bit; tcl_ok=$enableval -else $as_nop - tcl_ok=no +else case e in #( + e) tcl_ok=no ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: \"$tcl_ok\"" >&5 @@ -3956,8 +4010,9 @@ printf %s "checking if 64bit support is requested... " >&6; } if test ${enable_64bit+y} then : enableval=$enable_64bit; do64bit=$enableval -else $as_nop - do64bit=no +else case e in #( + e) do64bit=no ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5 @@ -3976,8 +4031,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CYGPATH+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$CYGPATH"; then +else case e in #( + e) if test -n "$CYGPATH"; then ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -4000,7 +4055,8 @@ done IFS=$as_save_IFS test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo" -fi +fi ;; +esac fi CYGPATH=$ac_cv_prog_CYGPATH if test -n "$CYGPATH"; then @@ -4019,8 +4075,8 @@ printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_WINE+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -n "$WINE"; then +else case e in #( + e) if test -n "$WINE"; then ac_cv_prog_WINE="$WINE" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -4042,7 +4098,8 @@ done done IFS=$as_save_IFS -fi +fi ;; +esac fi WINE=$ac_cv_prog_WINE if test -n "$WINE"; then @@ -4068,8 +4125,8 @@ printf %s "checking for cross-compile version of gcc... " >&6; } if test ${ac_cv_cross+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifndef _WIN32 @@ -4087,11 +4144,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_cross=no -else $as_nop - ac_cv_cross=yes +else case e in #( + e) ac_cv_cross=yes ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cross" >&5 printf "%s\n" "$ac_cv_cross" >&6; } @@ -4172,8 +4231,8 @@ printf %s "checking for mingw32 version of gcc... " >&6; } if test ${ac_cv_win32+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #ifdef _WIN32 @@ -4191,11 +4250,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_win32=no -else $as_nop - ac_cv_win32=yes +else case e in #( + e) ac_cv_win32=yes ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_win32" >&5 printf "%s\n" "$ac_cv_win32" >&6; } @@ -4212,8 +4273,8 @@ printf %s "checking for working -municode linker flag... " >&6; } if test ${ac_cv_municode+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) # ac_fn_c_try_link LINENO # ----------------------- # Try to link conftest.$ac_ext, and return whether this succeeded. @@ -4245,11 +4306,12 @@ printf "%s\n" "$ac_try_echo"; } >&5 } then : ac_retval=0 -else $as_nop - printf "%s\n" "$as_me: failed program was:" >&5 +else case e in #( + e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_retval=1 + ac_retval=1 ;; +esac fi # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would @@ -4277,12 +4339,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_municode=yes -else $as_nop - ac_cv_municode=no +else case e in #( + e) ac_cv_municode=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_municode" >&5 printf "%s\n" "$ac_cv_municode" >&6; } @@ -4298,8 +4362,8 @@ printf %s "checking for working -fno-lto... " >&6; } if test ${ac_cv_nolto+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -4313,11 +4377,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_nolto=yes -else $as_nop - ac_cv_nolto=no +else case e in #( + e) ac_cv_nolto=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_nolto" >&5 printf "%s\n" "$ac_cv_nolto" >&6; } @@ -4332,8 +4398,8 @@ printf %s "checking if the compiler understands -finput-charset... " >&6; } if test ${tcl_cv_cc_input_charset+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -finput-charset=UTF-8" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ @@ -4349,11 +4415,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_cc_input_charset=yes -else $as_nop - tcl_cv_cc_input_charset=no +else case e in #( + e) tcl_cv_cc_input_charset=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - CFLAGS=$hold_cflags + CFLAGS=$hold_cflags ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_input_charset" >&5 printf "%s\n" "$tcl_cv_cc_input_charset" >&6; } @@ -4368,8 +4436,8 @@ printf %s "checking for working --enable-auto-image-base... " >&6; } if test ${ac_cv_enable_auto_image_base+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -4383,11 +4451,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_enable_auto_image_base=yes -else $as_nop - ac_cv_enable_auto_image_base=no +else case e in #( + e) ac_cv_enable_auto_image_base=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_enable_auto_image_base" >&5 printf "%s\n" "$ac_cv_enable_auto_image_base" >&6; } @@ -4526,9 +4596,10 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_win_64bit=yes -else $as_nop - tcl_win_64bit=no - +else case e in #( + e) tcl_win_64bit=no + ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext if test "$tcl_win_64bit" = "yes" ; then @@ -4667,12 +4738,12 @@ printf %s "checking for SEH support in compiler... " >&6; } if test ${tcl_cv_seh+y} then : printf %s "(cached) " >&6 -else $as_nop - if test "$cross_compiling" = yes +else case e in #( + e) if test "$cross_compiling" = yes then : tcl_cv_seh=no -else $as_nop - +else case e in #( + e) # ac_fn_c_try_run LINENO # ---------------------- # Try to run conftest.$ac_ext, and return whether this succeeded. Assumes that @@ -4703,12 +4774,13 @@ printf "%s\n" "$ac_try_echo"; } >&5 test $ac_status = 0; }; } then : ac_retval=0 -else $as_nop - printf "%s\n" "$as_me: program exited with status $ac_status" >&5 +else case e in #( + e) printf "%s\n" "$as_me: program exited with status $ac_status" >&5 printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - ac_retval=$ac_status + ac_retval=$ac_status ;; +esac fi rm -rf conftest.dSYM conftest_ipa8_conftest.oo eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno @@ -4737,14 +4809,17 @@ _ACEOF if ac_fn_c_try_run "$LINENO" then : tcl_cv_seh=yes -else $as_nop - tcl_cv_seh=no +else case e in #( + e) tcl_cv_seh=no ;; +esac fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext + conftest.$ac_objext conftest.beam conftest.$ac_ext ;; +esac fi - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_seh" >&5 printf "%s\n" "$tcl_cv_seh" >&6; } @@ -4765,8 +4840,8 @@ printf %s "checking for EXCEPTION_DISPOSITION support in include files... " >&6; if test ${tcl_cv_eh_disposition+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ # define WIN32_LEAN_AND_MEAN @@ -4786,11 +4861,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_eh_disposition=yes -else $as_nop - tcl_cv_eh_disposition=no +else case e in #( + e) tcl_cv_eh_disposition=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_eh_disposition" >&5 printf "%s\n" "$tcl_cv_eh_disposition" >&6; } @@ -4818,8 +4895,8 @@ printf %s "checking for cast to union support... " >&6; } if test ${tcl_cv_cast_to_union+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int @@ -4836,11 +4913,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_cast_to_union=yes -else $as_nop - tcl_cv_cast_to_union=no +else case e in #( + e) tcl_cv_cast_to_union=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5 printf "%s\n" "$tcl_cv_cast_to_union" >&6; } @@ -4881,10 +4960,11 @@ then : enableval="$enable_shared" tcl_ok=$enableval -else $as_nop - +else case e in #( + e) tcl_ok=yes - + ;; +esac fi zlib_lib_name=zdll.lib tommath_lib_name=tommath.lib @@ -4917,17 +4997,18 @@ then : zlib_lib_name=libz.dll.a tommath_lib_name=libtommath.dll.a -else $as_nop - +else case e in #( + e) ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64-arm/zdll.lib TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64-arm/tommath.lib - + ;; +esac fi -else $as_nop - +else case e in #( + e) if test "$GCC" == "yes" then : @@ -4938,33 +5019,37 @@ then : zlib_lib_name=libz.dll.a tommath_lib_name=libtommath.dll.a -else $as_nop - +else case e in #( + e) ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/zdll.lib TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/tommath.lib - + ;; +esac fi - + ;; +esac fi -else $as_nop - +else case e in #( + e) ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win32/zdll.lib TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win32/tommath.lib - + ;; +esac fi -else $as_nop - +else case e in #( + e) ZLIB_OBJS=\${ZLIB_OBJS} TOMMATH_OBJS=\${TOMMATH_OBJS} - + ;; +esac fi printf "%s\n" "#define HAVE_ZLIB 1" >>confdefs.h @@ -5004,8 +5089,9 @@ fi if test ${enable_zipfs+y} then : enableval=$enable_zipfs; tcl_ok=$enableval -else $as_nop - tcl_ok=yes +else case e in #( + e) tcl_ok=yes ;; +esac fi if test "$tcl_ok" = "yes" ; then @@ -5022,8 +5108,8 @@ printf %s "checking for gcc... " >&6; } if test ${ac_cv_path_cc+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/gcc 2> /dev/null` \ @@ -5036,7 +5122,8 @@ else $as_nop fi done done - + ;; +esac fi fi @@ -5053,8 +5140,8 @@ printf %s "checking for build system executable suffix... " >&6; } if test ${bfd_cv_build_exeext+y} then : printf %s "(cached) " >&6 -else $as_nop - rm -f conftest* +else case e in #( + e) rm -f conftest* echo 'int main () { return 0; }' > conftest.c bfd_cv_build_exeext= ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 @@ -5065,7 +5152,8 @@ else $as_nop esac done rm -f conftest* - test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no + test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5 printf "%s\n" "$bfd_cv_build_exeext" >&6; } @@ -5083,8 +5171,8 @@ printf %s "checking for tclsh... " >&6; } if test ${ac_cv_path_tclsh+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/tclsh[8-9]*.exe 2> /dev/null` \ @@ -5097,7 +5185,8 @@ else $as_nop fi done done - + ;; +esac fi @@ -5124,8 +5213,8 @@ printf %s "checking for zip... " >&6; } if test ${ac_cv_path_zip+y} then : printf %s "(cached) " >&6 -else $as_nop - +else case e in #( + e) search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do for j in `ls -r $dir/zip 2> /dev/null` \ @@ -5138,7 +5227,8 @@ else $as_nop fi done done - + ;; +esac fi if test -f "$ac_cv_path_zip" ; then @@ -5212,8 +5302,8 @@ printf %s "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; } if test ${tcl_cv_findex_enums+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN @@ -5234,11 +5324,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_findex_enums=yes -else $as_nop - tcl_cv_findex_enums=no +else case e in #( + e) tcl_cv_findex_enums=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5 printf "%s\n" "$tcl_cv_findex_enums" >&6; } @@ -5255,8 +5347,8 @@ printf %s "checking for intrinsics support in compiler... " >&6; } if test ${tcl_cv_intrinsics+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN @@ -5277,12 +5369,14 @@ _ACEOF if ac_fn_c_try_link "$LINENO" then : tcl_cv_intrinsics=yes -else $as_nop - tcl_cv_intrinsics=no +else case e in #( + e) tcl_cv_intrinsics=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intrinsics" >&5 printf "%s\n" "$tcl_cv_intrinsics" >&6; } @@ -5299,8 +5393,8 @@ printf %s "checking for wspiapi.h... " >&6; } if test ${tcl_cv_wspiapi_h+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -5316,11 +5410,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_wspiapi_h=yes -else $as_nop - tcl_cv_wspiapi_h=no +else case e in #( + e) tcl_cv_wspiapi_h=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_wspiapi_h" >&5 printf "%s\n" "$tcl_cv_wspiapi_h" >&6; } @@ -5339,8 +5435,8 @@ printf %s "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; } if test ${tcl_cv_findex_enums+y} then : printf %s "(cached) " >&6 -else $as_nop - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +else case e in #( + e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #define WIN32_LEAN_AND_MEAN @@ -5361,11 +5457,13 @@ _ACEOF if ac_fn_c_try_compile "$LINENO" then : tcl_cv_findex_enums=yes -else $as_nop - tcl_cv_findex_enums=no +else case e in #( + e) tcl_cv_findex_enums=no ;; +esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext - + ;; +esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5 printf "%s\n" "$tcl_cv_findex_enums" >&6; } @@ -5388,8 +5486,9 @@ printf %s "checking for build with symbols... " >&6; } if test ${enable_symbols+y} then : enableval=$enable_symbols; tcl_ok=$enableval -else $as_nop - tcl_ok=no +else case e in #( + e) tcl_ok=no ;; +esac fi # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. @@ -5460,8 +5559,8 @@ if test -z "$CPP"; then if test ${ac_cv_prog_CPP+y} then : printf %s "(cached) " >&6 -else $as_nop - # Double quotes because $CC needs to be expanded +else case e in #( + e) # Double quotes because $CC needs to be expanded for CPP in "$CC -E" "$CC -E -traditional-cpp" cpp /lib/cpp do ac_preproc_ok=false @@ -5479,9 +5578,10 @@ _ACEOF if ac_fn_c_try_cpp "$LINENO" then : -else $as_nop - # Broken: fails on valid input. -continue +else case e in #( + e) # Broken: fails on valid input. +continue ;; +esac fi rm -f conftest.err conftest.i conftest.$ac_ext @@ -5495,15 +5595,16 @@ if ac_fn_c_try_cpp "$LINENO" then : # Broken: success on invalid input. continue -else $as_nop - # Passes both tests. +else case e in #( + e) # Passes both tests. ac_preproc_ok=: -break +break ;; +esac fi rm -f conftest.err conftest.i conftest.$ac_ext done -# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +# Because of 'break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok then : @@ -5512,7 +5613,8 @@ fi done ac_cv_prog_CPP=$CPP - + ;; +esac fi CPP=$ac_cv_prog_CPP else @@ -5535,9 +5637,10 @@ _ACEOF if ac_fn_c_try_cpp "$LINENO" then : -else $as_nop - # Broken: fails on valid input. -continue +else case e in #( + e) # Broken: fails on valid input. +continue ;; +esac fi rm -f conftest.err conftest.i conftest.$ac_ext @@ -5551,24 +5654,26 @@ if ac_fn_c_try_cpp "$LINENO" then : # Broken: success on invalid input. continue -else $as_nop - # Passes both tests. +else case e in #( + e) # Passes both tests. ac_preproc_ok=: -break +break ;; +esac fi rm -f conftest.err conftest.i conftest.$ac_ext done -# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +# Because of 'break', _AC_PREPROC_IFELSE's cleaning code was skipped. rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok then : -else $as_nop - { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;} +else case e in #( + e) { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 +printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details" "$LINENO" 5; } +See 'config.log' for more details" "$LINENO" 5; } ;; +esac fi ac_ext=c @@ -5578,14 +5683,14 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $ ac_compiler_gnu=$ac_cv_c_compiler_gnu -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 -printf %s "checking for grep that handles long lines and -e... " >&6; } -if test ${ac_cv_path_GREP+y} +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for egrep -e" >&5 +printf %s "checking for egrep -e... " >&6; } +if test ${ac_cv_path_EGREP_TRADITIONAL+y} then : printf %s "(cached) " >&6 -else $as_nop - if test -z "$GREP"; then - ac_path_GREP_found=false +else case e in #( + e) if test -z "$EGREP_TRADITIONAL"; then + ac_path_EGREP_TRADITIONAL_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin @@ -5599,13 +5704,14 @@ do for ac_prog in grep ggrep do for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_GREP="$as_dir$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_GREP" || continue -# Check for GNU ac_path_GREP and select it if it is found. - # Check for GNU $ac_path_GREP -case `"$ac_path_GREP" --version 2>&1` in + ac_path_EGREP_TRADITIONAL="$as_dir$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP_TRADITIONAL" || continue +# Check for GNU ac_path_EGREP_TRADITIONAL and select it if it is found. + # Check for GNU $ac_path_EGREP_TRADITIONAL +case `"$ac_path_EGREP_TRADITIONAL" --version 2>&1` in #( *GNU*) - ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; + ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" ac_path_EGREP_TRADITIONAL_found=:;; +#( *) ac_count=0 printf %s 0123456789 >"conftest.in" @@ -5614,14 +5720,14 @@ case `"$ac_path_GREP" --version 2>&1` in cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" - printf "%s\n" 'GREP' >> "conftest.nl" - "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + printf "%s\n" 'EGREP_TRADITIONAL' >> "conftest.nl" + "$ac_path_EGREP_TRADITIONAL" -E 'EGR(EP|AC)_TRADITIONAL$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_GREP_max-0}; then + if test $ac_count -gt ${ac_path_EGREP_TRADITIONAL_max-0}; then # Best one so far, save it but keep looking for a better one - ac_cv_path_GREP="$ac_path_GREP" - ac_path_GREP_max=$ac_count + ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" + ac_path_EGREP_TRADITIONAL_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break @@ -5629,35 +5735,24 @@ case `"$ac_path_GREP" --version 2>&1` in rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac - $ac_path_GREP_found && break 3 + $ac_path_EGREP_TRADITIONAL_found && break 3 done done done IFS=$as_save_IFS - if test -z "$ac_cv_path_GREP"; then - as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + if test -z "$ac_cv_path_EGREP_TRADITIONAL"; then + : fi else - ac_cv_path_GREP=$GREP -fi - + ac_cv_path_EGREP_TRADITIONAL=$EGREP_TRADITIONAL fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 -printf "%s\n" "$ac_cv_path_GREP" >&6; } - GREP="$ac_cv_path_GREP" - -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 -printf %s "checking for egrep... " >&6; } -if test ${ac_cv_path_EGREP+y} + if test "$ac_cv_path_EGREP_TRADITIONAL" then : - printf %s "(cached) " >&6 -else $as_nop - if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 - then ac_cv_path_EGREP="$GREP -E" - else - if test -z "$EGREP"; then - ac_path_EGREP_found=false + ac_cv_path_EGREP_TRADITIONAL="$ac_cv_path_EGREP_TRADITIONAL -E" +else case e in #( + e) if test -z "$EGREP_TRADITIONAL"; then + ac_path_EGREP_TRADITIONAL_found=false # Loop through the user's path and test for each of PROGNAME-LIST as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin @@ -5671,13 +5766,14 @@ do for ac_prog in egrep do for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_EGREP="$as_dir$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_EGREP" || continue -# Check for GNU ac_path_EGREP and select it if it is found. - # Check for GNU $ac_path_EGREP -case `"$ac_path_EGREP" --version 2>&1` in + ac_path_EGREP_TRADITIONAL="$as_dir$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP_TRADITIONAL" || continue +# Check for GNU ac_path_EGREP_TRADITIONAL and select it if it is found. + # Check for GNU $ac_path_EGREP_TRADITIONAL +case `"$ac_path_EGREP_TRADITIONAL" --version 2>&1` in #( *GNU*) - ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; + ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" ac_path_EGREP_TRADITIONAL_found=:;; +#( *) ac_count=0 printf %s 0123456789 >"conftest.in" @@ -5686,14 +5782,14 @@ case `"$ac_path_EGREP" --version 2>&1` in cat "conftest.in" "conftest.in" >"conftest.tmp" mv "conftest.tmp" "conftest.in" cp "conftest.in" "conftest.nl" - printf "%s\n" 'EGREP' >> "conftest.nl" - "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + printf "%s\n" 'EGREP_TRADITIONAL' >> "conftest.nl" + "$ac_path_EGREP_TRADITIONAL" 'EGR(EP|AC)_TRADITIONAL$' < "conftest.nl" >"conftest.out" 2>/dev/null || break diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_EGREP_max-0}; then + if test $ac_count -gt ${ac_path_EGREP_TRADITIONAL_max-0}; then # Best one so far, save it but keep looking for a better one - ac_cv_path_EGREP="$ac_path_EGREP" - ac_path_EGREP_max=$ac_count + ac_cv_path_EGREP_TRADITIONAL="$ac_path_EGREP_TRADITIONAL" + ac_path_EGREP_TRADITIONAL_max=$ac_count fi # 10*(2^10) chars as input seems more than enough test $ac_count -gt 10 && break @@ -5701,24 +5797,25 @@ case `"$ac_path_EGREP" --version 2>&1` in rm -f conftest.in conftest.tmp conftest.nl conftest.out;; esac - $ac_path_EGREP_found && break 3 + $ac_path_EGREP_TRADITIONAL_found && break 3 done done done IFS=$as_save_IFS - if test -z "$ac_cv_path_EGREP"; then + if test -z "$ac_cv_path_EGREP_TRADITIONAL"; then as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 fi else - ac_cv_path_EGREP=$EGREP + ac_cv_path_EGREP_TRADITIONAL=$EGREP_TRADITIONAL fi - - fi + ;; +esac +fi ;; +esac fi -{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 -printf "%s\n" "$ac_cv_path_EGREP" >&6; } - EGREP="$ac_cv_path_EGREP" - +{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP_TRADITIONAL" >&5 +printf "%s\n" "$ac_cv_path_EGREP_TRADITIONAL" >&6; } + EGREP_TRADITIONAL=$ac_cv_path_EGREP_TRADITIONAL { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to embed manifest" >&5 @@ -5727,8 +5824,9 @@ printf %s "checking whether to embed manifest... " >&6; } if test ${enable_embedded_manifest+y} then : enableval=$enable_embedded_manifest; embed_ok=$enableval -else $as_nop - embed_ok=yes +else case e in #( + e) embed_ok=yes ;; +esac fi @@ -5747,7 +5845,7 @@ print("manifest needed") _ACEOF if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "manifest needed" >/dev/null 2>&1 + $EGREP_TRADITIONAL "manifest needed" >/dev/null 2>&1 then : # Could do a CHECK_PROG for mt, but should always be with MSVC8+ @@ -5953,8 +6051,8 @@ cat >confcache <<\_ACEOF # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # -# `ac_cv_env_foo' variables (set or unset) will be overridden when -# loading this file, other *unset* `ac_cv_foo' will be assigned the +# 'ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* 'ac_cv_foo' will be assigned the # following values. _ACEOF @@ -5984,14 +6082,14 @@ printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) - # `set' does not quote correctly, so add quotes: double-quote + # 'set' does not quote correctly, so add quotes: double-quote # substitution turns \\\\ into \\, and sed turns \\ into \. sed -n \ "s/'/'\\\\''/g; s/^\$[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\$=\$.*\$/\\1='\\2'/p" ;; #( *) - # `set' quotes correctly as required by POSIX, so do not add quotes. + # 'set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | @@ -6055,9 +6153,7 @@ s/^[ ]*#[ ]*define[ ][ ]*$[^ ][^ ]*$[ ]*$.*$/-D\1=\2/g t quote b any :quote -s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g -s/\[/\\&/g -s/\]/\\&/g +s/[][ `~#$^&*(){}\\|;'\''"<>?]/\\&/g s/\$/$$/g H :any @@ -6117,7 +6213,6 @@ cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh -as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh @@ -6126,12 +6221,13 @@ then : # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST -else $as_nop - case `(set -o) 2>/dev/null` in #( +else case e in #( + e) case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; +esac ;; esac fi @@ -6203,7 +6299,7 @@ IFS=$as_save_IFS ;; esac -# We did not find ourselves, most probably we were run as `sh COMMAND' +# We did not find ourselves, most probably we were run as 'sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 @@ -6232,7 +6328,6 @@ as_fn_error () } # as_fn_error - # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. @@ -6272,11 +6367,12 @@ then : { eval $1+=\$2 }' -else $as_nop - as_fn_append () +else case e in #( + e) as_fn_append () { eval $1=\$$1\$2 - } + } ;; +esac fi # as_fn_append # as_fn_arith ARG... @@ -6290,11 +6386,12 @@ then : { as_val=$(( $* )) }' -else $as_nop - as_fn_arith () +else case e in #( + e) as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` - } + } ;; +esac fi # as_fn_arith @@ -6377,9 +6474,9 @@ if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. + # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable. + # In both cases, we have to default to 'cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then @@ -6460,10 +6557,12 @@ as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. -as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" +as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" +as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated # Sed expression to map a string onto a valid variable name. -as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" +as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g" +as_tr_sh="eval sed '$as_sed_sh'" # deprecated exec 6>&1 @@ -6479,7 +6578,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # values after options handling. ac_log=" This file was extended by tcl $as_me 8.7, which was -generated by GNU Autoconf 2.71. Invocation command line was +generated by GNU Autoconf 2.72. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -6506,7 +6605,7 @@ _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\ -\`$as_me' instantiates files and other configuration actions +'$as_me' instantiates files and other configuration actions from templates according to the current configuration. Unless the files and actions are specified as TAGs, all are instantiated by default. @@ -6534,10 +6633,10 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ tcl config.status 8.7 -configured by $0, generated by GNU Autoconf 2.71, +configured by $0, generated by GNU Autoconf 2.72, with options \\"\$ac_cs_config\\" -Copyright (C) 2021 Free Software Foundation, Inc. +Copyright (C) 2023 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." @@ -6594,8 +6693,8 @@ do ac_cs_silent=: ;; # This is an error. - -*) as_fn_error $? "unrecognized option: \`$1' -Try \`$0 --help' for more information." ;; + -*) as_fn_error $? "unrecognized option: '$1' +Try '$0 --help' for more information." ;; *) as_fn_append ac_config_targets " $1" ac_need_defaults=false ;; @@ -6647,7 +6746,7 @@ do "tclConfig.sh") CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;; "tclsh.exe.manifest") CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;; - *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + *) as_fn_error $? "invalid argument: '$ac_config_target'" "$LINENO" 5;; esac done @@ -6665,7 +6764,7 @@ fi # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: -# after its creation but before its name has been assigned to `$tmp'. +# after its creation but before its name has been assigned to '$tmp'. $debug || { tmp= ac_tmp= @@ -6689,7 +6788,7 @@ ac_tmp=$tmp # Set up the scripts for CONFIG_FILES section. # No need to generate them if there are no CONFIG_FILES. -# This happens for instance with `./config.status config.h'. +# This happens for instance with './config.status config.h'. if test -n "$CONFIG_FILES"; then @@ -6855,7 +6954,7 @@ do esac case $ac_mode$ac_tag in :[FHL]*:*);; - :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :L* | :C*:*) as_fn_error $? "invalid tag '$ac_tag'" "$LINENO" 5;; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac @@ -6877,19 +6976,19 @@ do -) ac_f="$ac_tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, - # because $ac_f cannot contain `:'. + # because $ac_f cannot contain ':'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || - as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + as_fn_error 1 "cannot find input file: '$ac_f'" "$LINENO" 5;; esac case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'" done - # Let's still pretend it is `configure' which instantiates (i.e., don't + # Let's still pretend it is 'configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input='Generated from '` @@ -7013,7 +7112,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 esac _ACEOF -# Neutralize VPATH when `$srcdir' = `.'. +# Neutralize VPATH when '$srcdir' = '.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 @@ -7042,9 +7141,9 @@ test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ "$ac_tmp/out"`; test -z "$ac_out"; } && - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable 'datarootdir' which seems to be undefined. Please make sure it is defined" >&5 -printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable 'datarootdir' which seems to be undefined. Please make sure it is defined" >&2;} rm -f "$ac_tmp/stdin" -- cgit v0.12 From 3c68325bf7466e9a841a48d7fb17cedc75fa172f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 7 Jan 2024 00:56:33 +0000 Subject: re-generate tclConfig.h.in as well --- unix/tclConfig.h.in | 88 ++++++++++++++++++++++++++--------------------------- 1 file changed, 44 insertions(+), 44 deletions(-) diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index 519c641..cc75c29 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -10,19 +10,19 @@ /* Define to 1 if you have the header file. */ #undef HAVE_AVAILABILITYMACROS_H -/* Define to 1 if the system has the type `blkcnt_t'. */ +/* Define to 1 if the system has the type 'blkcnt_t'. */ #undef HAVE_BLKCNT_T /* Defined when compiler supports casting to union type. */ #undef HAVE_CAST_TO_UNION -/* Define to 1 if you have the `cfmakeraw' function. */ +/* Define to 1 if you have the 'cfmakeraw' function. */ #undef HAVE_CFMAKERAW -/* Define to 1 if you have the `chflags' function. */ +/* Define to 1 if you have the 'chflags' function. */ #undef HAVE_CHFLAGS -/* Define to 1 if you have the `copyfile' function. */ +/* Define to 1 if you have the 'copyfile' function. */ #undef HAVE_COPYFILE /* Define to 1 if you have the header file. */ @@ -34,15 +34,15 @@ /* Is the cpuid instruction usable? */ #undef HAVE_CPUID -/* Define to 1 if you have the declaration of `gethostbyaddr_r', and to 0 if +/* Define to 1 if you have the declaration of 'gethostbyaddr_r', and to 0 if you don't. */ #undef HAVE_DECL_GETHOSTBYADDR_R -/* Define to 1 if you have the declaration of `gethostbyname_r', and to 0 if +/* Define to 1 if you have the declaration of 'gethostbyname_r', and to 0 if you don't. */ #undef HAVE_DECL_GETHOSTBYNAME_R -/* Define to 1 if you have the declaration of `PTHREAD_MUTEX_RECURSIVE', and +/* Define to 1 if you have the declaration of 'PTHREAD_MUTEX_RECURSIVE', and to 0 if you don't. */ #undef HAVE_DECL_PTHREAD_MUTEX_RECURSIVE @@ -52,22 +52,22 @@ /* Is eventfd(2) supported? */ #undef HAVE_EVENTFD -/* Define to 1 if you have the `freeaddrinfo' function. */ +/* Define to 1 if you have the 'freeaddrinfo' function. */ #undef HAVE_FREEADDRINFO /* Do we have fts functions? */ #undef HAVE_FTS -/* Define to 1 if you have the `gai_strerror' function. */ +/* Define to 1 if you have the 'gai_strerror' function. */ #undef HAVE_GAI_STRERROR -/* Define to 1 if you have the `getaddrinfo' function. */ +/* Define to 1 if you have the 'getaddrinfo' function. */ #undef HAVE_GETADDRINFO -/* Define to 1 if you have the `getattrlist' function. */ +/* Define to 1 if you have the 'getattrlist' function. */ #undef HAVE_GETATTRLIST -/* Define to 1 if you have the `getcwd' function. */ +/* Define to 1 if you have the 'getcwd' function. */ #undef HAVE_GETCWD /* Define to 1 if getgrgid_r is available. */ @@ -109,7 +109,7 @@ /* Define to 1 if gethostbyname_r takes 6 args. */ #undef HAVE_GETHOSTBYNAME_R_6 -/* Define to 1 if you have the `getnameinfo' function. */ +/* Define to 1 if you have the 'getnameinfo' function. */ #undef HAVE_GETNAMEINFO /* Define to 1 if getpwnam_r is available. */ @@ -130,13 +130,13 @@ /* Define to 1 if getpwuid_r takes 5 args. */ #undef HAVE_GETPWUID_R_5 -/* Define to 1 if you have the `gmtime_r' function. */ +/* Define to 1 if you have the 'gmtime_r' function. */ #undef HAVE_GMTIME_R /* Compiler support for module scope symbols */ #undef HAVE_HIDDEN -/* Define to 1 if the system has the type `intptr_t'. */ +/* Define to 1 if the system has the type 'intptr_t'. */ #undef HAVE_INTPTR_T /* Define to 1 if you have the header file. */ @@ -148,19 +148,19 @@ /* Define to 1 if you have the header file. */ #undef HAVE_LIBKERN_OSATOMIC_H -/* Define to 1 if you have the `localtime_r' function. */ +/* Define to 1 if you have the 'localtime_r' function. */ #undef HAVE_LOCALTIME_R -/* Define to 1 if you have the `lseek64' function. */ +/* Define to 1 if you have the 'lseek64' function. */ #undef HAVE_LSEEK64 -/* Define to 1 if you have the `mkstemp' function. */ +/* Define to 1 if you have the 'mkstemp' function. */ #undef HAVE_MKSTEMP -/* Define to 1 if you have the `mkstemps' function. */ +/* Define to 1 if you have the 'mkstemps' function. */ #undef HAVE_MKSTEMPS -/* Define to 1 if you have the `mktime' function. */ +/* Define to 1 if you have the 'mktime' function. */ #undef HAVE_MKTIME /* Do we have MT-safe gethostbyaddr() ? */ @@ -172,28 +172,28 @@ /* Do we have ? */ #undef HAVE_NET_ERRNO_H -/* Define to 1 if you have the `open64' function. */ +/* Define to 1 if you have the 'open64' function. */ #undef HAVE_OPEN64 -/* Define to 1 if you have the `OSSpinLockLock' function. */ +/* Define to 1 if you have the 'OSSpinLockLock' function. */ #undef HAVE_OSSPINLOCKLOCK -/* Define to 1 if you have the `posix_spawnattr_setflags' function. */ +/* Define to 1 if you have the 'posix_spawnattr_setflags' function. */ #undef HAVE_POSIX_SPAWNATTR_SETFLAGS -/* Define to 1 if you have the `posix_spawnp' function. */ +/* Define to 1 if you have the 'posix_spawnp' function. */ #undef HAVE_POSIX_SPAWNP -/* Define to 1 if you have the `posix_spawn_file_actions_adddup2' function. */ +/* Define to 1 if you have the 'posix_spawn_file_actions_adddup2' function. */ #undef HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDDUP2 /* Should we use pselect()? */ #undef HAVE_PSELECT -/* Define to 1 if you have the `pthread_atfork' function. */ +/* Define to 1 if you have the 'pthread_atfork' function. */ #undef HAVE_PTHREAD_ATFORK -/* Define to 1 if you have the `pthread_attr_setstacksize' function. */ +/* Define to 1 if you have the 'pthread_attr_setstacksize' function. */ #undef HAVE_PTHREAD_ATTR_SETSTACKSIZE /* Does putenv() copy strings or incorporate them by reference? */ @@ -220,31 +220,31 @@ /* Define to 1 if you have the header file. */ #undef HAVE_STRING_H -/* Define to 1 if the system has the type `struct addrinfo'. */ +/* Define to 1 if the system has the type 'struct addrinfo'. */ #undef HAVE_STRUCT_ADDRINFO /* Is 'struct dirent64' in ? */ #undef HAVE_STRUCT_DIRENT64 -/* Define to 1 if the system has the type `struct in6_addr'. */ +/* Define to 1 if the system has the type 'struct in6_addr'. */ #undef HAVE_STRUCT_IN6_ADDR -/* Define to 1 if the system has the type `struct sockaddr_in6'. */ +/* Define to 1 if the system has the type 'struct sockaddr_in6'. */ #undef HAVE_STRUCT_SOCKADDR_IN6 -/* Define to 1 if the system has the type `struct sockaddr_storage'. */ +/* Define to 1 if the system has the type 'struct sockaddr_storage'. */ #undef HAVE_STRUCT_SOCKADDR_STORAGE /* Is 'struct stat64' in ? */ #undef HAVE_STRUCT_STAT64 -/* Define to 1 if `st_blksize' is a member of `struct stat'. */ +/* Define to 1 if 'st_blksize' is a member of 'struct stat'. */ #undef HAVE_STRUCT_STAT_ST_BLKSIZE -/* Define to 1 if `st_blocks' is a member of `struct stat'. */ +/* Define to 1 if 'st_blocks' is a member of 'struct stat'. */ #undef HAVE_STRUCT_STAT_ST_BLOCKS -/* Define to 1 if `st_rdev' is a member of `struct stat'. */ +/* Define to 1 if 'st_rdev' is a member of 'struct stat'. */ #undef HAVE_STRUCT_STAT_ST_RDEV /* Define to 1 if you have the header file. */ @@ -295,16 +295,16 @@ /* Is off64_t in ? */ #undef HAVE_TYPE_OFF64_T -/* Define to 1 if the system has the type `uintptr_t'. */ +/* Define to 1 if the system has the type 'uintptr_t'. */ #undef HAVE_UINTPTR_T /* Define to 1 if you have the header file. */ #undef HAVE_UNISTD_H -/* Define to 1 if you have the `vfork' function. */ +/* Define to 1 if you have the 'vfork' function. */ #undef HAVE_VFORK -/* Define to 1 if you have the `waitpid' function. */ +/* Define to 1 if you have the 'waitpid' function. */ #undef HAVE_WAITPID /* Is weak import available? */ @@ -406,7 +406,7 @@ /* Is this a static build? */ #undef STATIC_BUILD -/* Define to 1 if all of the C90 standard headers exist (not just the ones +/* Define to 1 if all of the C89 standard headers exist (not just the ones required in a freestanding environment). This macro is provided for backward compatibility; new code need not use it. */ #undef STDC_HEADERS @@ -504,34 +504,34 @@ /* Do we want to use the XOPEN network library? */ #undef _XOPEN_SOURCE_EXTENDED -/* Define to 1 if type `char' is unsigned and your compiler does not +/* Define to 1 if type 'char' is unsigned and your compiler does not predefine this macro. */ #ifndef __CHAR_UNSIGNED__ # undef __CHAR_UNSIGNED__ #endif -/* Define to `int' if doesn't define. */ +/* Define as 'int' if doesn't define. */ #undef gid_t -/* Define to `__inline__' or `__inline' if that's what the C compiler +/* Define to '__inline__' or '__inline' if that's what the C compiler calls it, or to nothing if 'inline' is not supported under any name. */ #ifndef __cplusplus #undef inline #endif -/* Define to `int' if does not define. */ +/* Define to 'int' if does not define. */ #undef mode_t /* Define as a signed integer type capable of holding a process identifier. */ #undef pid_t -/* Define to `unsigned int' if does not define. */ +/* Define as 'unsigned int' if doesn't define. */ #undef size_t /* Define as int if socklen_t is not available */ #undef socklen_t -/* Define to `int' if doesn't define. */ +/* Define as 'int' if doesn't define. */ #undef uid_t -- cgit v0.12 From 984fcfb1e7e05be3fe0948914686ee517cc4bd8f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 7 Jan 2024 22:50:01 +0000 Subject: Remove Cygwin trick, which makes no sense any more --- generic/tclStubInit.c | 9 --------- 1 file changed, 9 deletions(-) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index fd2bfe6..aa830e0 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -357,15 +357,6 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ return result; } #define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj -static int utfNcmp(const char *s1, const char *s2, unsigned int n){ - return Tcl_UtfNcmp(s1, s2, (unsigned long)n); -} -#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcmp -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 /* TCL_WIDE_INT_IS_LONG */ #else /* __CYGWIN__ */ -- cgit v0.12 From 8f67aa69c15fe66d42a1b26c75653e9ca2fb49ad Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 8 Jan 2024 13:16:29 +0000 Subject: (cygwin-only): Add (void *) typecast, preventing coompiler warnings in some situations --- generic/tclStubInit.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 34bf824..036dba2 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -3,7 +3,7 @@ * * This file contains the initializers for the Tcl stub vectors. * - * Copyright (c) 1998-1999 by Scriptics Corporation. + * Copyright (c) 1998-1999 Scriptics Corporation. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -371,7 +371,7 @@ Tcl_WinTCharToUtf( * signature. Tcl 9 must find a better solution, but that cannot be done * without introducing a binary incompatibility. */ -#define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))(void *)dbNewLongObj) +#define Tcl_DbNewLongObj (Tcl_Obj*(*)(long,const char*,int))(void *)dbNewLongObj static Tcl_Obj *dbNewLongObj( int intValue, const char *file, @@ -408,7 +408,7 @@ static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){ } return result; } -#define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))exprInt +#define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))(void *)exprInt static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ long longValue; int result = Tcl_ExprLongObj(interp, expr, &longValue); @@ -424,7 +424,7 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ } return result; } -#define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj +#define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))(void *)exprIntObj static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n); } -- cgit v0.12 From 7541111e88a7eea5b6d77dcda2fec08e1ada6a03 Mon Sep 17 00:00:00 2001 From: oehhar Date: Mon, 8 Jan 2024 15:31:47 +0000 Subject: Documentation of "string is unicode": add warning "this option is under discussion and may be renamed or replaced by another solution withhin the TCL 9.0 series" --- doc/string.n | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/doc/string.n b/doc/string.n index 76f98c6..c610aeb 100644 --- a/doc/string.n +++ b/doc/string.n @@ -175,7 +175,11 @@ zero width no-break space (U+feff) (=BOM). 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 +Any Unicode character, except surrogates and noncharacters. +. +Warning: this option is under discussion and may be renamed or replaced +by another solution withhin the TCL 9.0 series. +. .IP \fBupper\fR 12 Any upper case alphabet character in the Unicode character set. .IP \fBwideinteger\fR 12 -- cgit v0.12 From 0edc405c6984dab01ceff5e8bc2b3400a18e24ac Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 9 Jan 2024 09:11:34 +0000 Subject: Use "info exists" to test for Tk presence --- library/tcltest/tcltest.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index d3e9ea4..3b89cf7 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -2583,7 +2583,7 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} { # loop is running, which is the real issue. # Actually, this doesn't belong here at all. A package # really has no business [exit]-ing an application. - if {![catch {package present Tk}] && ![testConstraint interactive]} { + if {![info exists ::tk_version] && ![testConstraint interactive]} { exit } } else { -- cgit v0.12 From a1c587cc1603b9460faa8dc920521143b12e8935 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 9 Jan 2024 10:32:52 +0000 Subject: Backport tcltest 2.5.6 from Tcl9.0b1 --- library/tcltest/pkgIndex.tcl | 2 +- library/tcltest/tcltest.tcl | 61 +++++++++++++++++++++++++++++++++++--------- unix/Makefile.in | 4 +-- win/Makefile.in | 4 +-- 4 files changed, 54 insertions(+), 17 deletions(-) diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index 18b05e5..9903e32 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.5-]} {return} -package ifneeded tcltest 2.5.5 [list source [file join $dir tcltest.tcl]] +package ifneeded tcltest 2.5.6 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 3b89cf7..d13e97f 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -22,13 +22,14 @@ namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. - variable Version 2.5.5 + variable Version 2.5.6 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] # yourself. You don't need tcltest to wrap it for you. variable version [package provide Tcl] variable patchLevel [info patchlevel] + variable fullutf [package vsatisfies $version 8.7-] ##### Export the public tcltest procs; several categories # @@ -400,7 +401,7 @@ namespace eval tcltest { default { set outputChannel [open $filename a] if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $outputChannel -encoding utf-8 + fconfigure $outputChannel -profile tcl8 -encoding utf-8 } set ChannelsWeOpened($outputChannel) 1 @@ -447,7 +448,7 @@ namespace eval tcltest { default { set errorChannel [open $filename a] if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $errorChannel -encoding utf-8 + fconfigure $errorChannel -profile tcl8 -encoding utf-8 } set ChannelsWeOpened($errorChannel) 1 @@ -792,7 +793,7 @@ namespace eval tcltest { if {$Option(-loadfile) eq {}} {return} set tmp [open $Option(-loadfile) r] if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $tmp -encoding utf-8 + fconfigure $tmp -profile tcl8 -encoding utf-8 } loadScript [read $tmp] close $tmp @@ -1134,6 +1135,38 @@ proc tcltest::SafeFetch {n1 n2 op} { } } +# tcltest::Asciify -- +# +# Transforms the passed string to contain only printable ascii characters. +# Useful for printing to terminals. Non-printables are mapped to +# \x, \u or \U sequences. +# +# Arguments: +# s - string to transform +# +# Results: +# The transformed strings +# +# Side effects: +# None. + +proc tcltest::Asciify {s} { + variable fullutf + set print "" + foreach c [split $s ""] { + if {[string is print $c] && (($c <= "\x7E") || ($c == "\n"))} { + append print $c + } elseif {$c < "\u0100"} { + append print \\x[format %02X [scan $c %c]] + } elseif {$fullutf && ($c >= "\U10000")} { + append print \\U[format %08X [scan $c %c]] + } else { + append print \\u[format %04X [scan $c %c]] + } + } + return $print +} + # tcltest::ConstraintInitializer -- # # Get or set a script that when evaluated in the tcltest namespace @@ -1340,7 +1373,7 @@ proc tcltest::DefineConstraintInitializers {} { set code 0 if {![catch {set f [open "|[list [interpreter]]" w]}]} { if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $f -encoding utf-8 + fconfigure $f -profile tcl8 -encoding utf-8 } if {![catch {puts $f exit}]} { if {![catch {close $f}]} { @@ -2190,7 +2223,7 @@ proc tcltest::test {name description args} { if {[file readable $testFile]} { set testFd [open $testFile r] if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $testFd -encoding utf-8 + fconfigure $testFd -profile tcl8 -encoding utf-8 } set testLine [expr {[lsearch -regexp \ [split [read $testFd] "\n"] \ @@ -2221,9 +2254,13 @@ proc tcltest::test {name description args} { if {$scriptCompare} { puts [outputChannel] "---- Error testing result: $scriptMatch" } else { - puts [outputChannel] "---- Result was:\n$actualAnswer" + if {[catch { + puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]" + } errMsg]} { + puts [outputChannel] "\n---- Result was:\n" + } puts [outputChannel] "---- Result should have been\ - ($match matching):\n$result" + ($match matching):\n[Asciify $result]" } } if {$errorCodeFailure} { @@ -2583,7 +2620,7 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} { # loop is running, which is the real issue. # Actually, this doesn't belong here at all. A package # really has no business [exit]-ing an application. - if {![info exists ::tk_version] && ![testConstraint interactive]} { + if {[info exists ::tk_version] && ![testConstraint interactive]} { exit } } else { @@ -2902,7 +2939,7 @@ proc tcltest::runAllTests { {shell ""} } { incr numTestFiles set pipeFd [open $cmd "r"] if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $pipeFd -encoding utf-8 + fconfigure $pipeFd -profile tcl8 -encoding utf-8 } while {[gets $pipeFd line] >= 0} { if {[regexp [join { @@ -3102,7 +3139,7 @@ proc tcltest::makeFile {contents name {directory ""}} { set fd [open $fullName w] fconfigure $fd -translation lf if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $fd -encoding utf-8 + fconfigure $fd -profile tcl8 -encoding utf-8 } if {[string index $contents end] eq "\n"} { puts -nonewline $fd $contents @@ -3253,7 +3290,7 @@ proc tcltest::viewFile {name {directory ""}} { set fullName [file join $directory $name] set f [open $fullName] if {[package vsatisfies [package provide Tcl] 8.7-]} { - fconfigure $f -encoding utf-8 + fconfigure $f -profile tcl8 -encoding utf-8 } set data [read -nonewline $f] close $f diff --git a/unix/Makefile.in b/unix/Makefile.in index 9267ef7..239b22b 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -964,9 +964,9 @@ install-libraries: libraries @echo "Installing package msgcat 1.6.1 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \ "$(MODULE_INSTALL_DIR)/8.5/msgcat-1.6.1.tm" - @echo "Installing package tcltest 2.5.5 as a Tcl Module" + @echo "Installing package tcltest 2.5.6 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \ - "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.5.tm" + "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.6.tm" @echo "Installing package platform 1.0.19 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \ "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm" diff --git a/win/Makefile.in b/win/Makefile.in index 7b0f209..ba543a9 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -747,8 +747,8 @@ install-libraries: libraries install-tzdata install-msgs done; @echo "Installing package msgcat 1.6.1 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.5/msgcat-1.6.1.tm"; - @echo "Installing package tcltest 2.5.5 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.5.tm"; + @echo "Installing package tcltest 2.5.6 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.6.tm"; @echo "Installing package platform 1.0.19 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm"; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; -- cgit v0.12 From 5dadb3ab3276921573c7b4b43b7ae0b95a68b3cc Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 9 Jan 2024 12:02:51 +0000 Subject: Optimize use of $fullutf variable --- library/tcltest/tcltest.tcl | 43 ++++++++++++++++++++++++++++--------------- 1 file changed, 28 insertions(+), 15 deletions(-) diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index d13e97f..55ad481 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -16,7 +16,6 @@ # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # All rights reserved. -package require Tcl 8.5- ;# -verbose line uses [info frame] namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, @@ -25,10 +24,12 @@ namespace eval tcltest { variable Version 2.5.6 # Compatibility support for dumb variables defined in tcltest 1 - # Do not use these. Call [package provide Tcl] and [info patchlevel] + # Do not use these. Call [package require] and [info patchlevel] # yourself. You don't need tcltest to wrap it for you. - variable version [package provide Tcl] + variable version [package require Tcl 8.5-] variable patchLevel [info patchlevel] + + # Detect if we can use code points >= \U10000 variable fullutf [package vsatisfies $version 8.7-] ##### Export the public tcltest procs; several categories @@ -42,7 +43,7 @@ namespace eval tcltest { outputChannel testConstraint # Export commands that are duplication (candidates for deprecation) - if {![package vsatisfies [package provide Tcl] 8.7-]} { + if {!$fullutf} { namespace export bytestring ;# dups [encoding convertfrom identity] } namespace export debug ;# [configure -debug] @@ -346,6 +347,7 @@ namespace eval tcltest { proc outputChannel { {filename ""} } { variable outputChannel variable ChannelsWeOpened + variable fullutf # This is very subtle and tricky, so let me try to explain. # (Hopefully this longer comment will be clear when I come @@ -400,7 +402,7 @@ namespace eval tcltest { } default { set outputChannel [open $filename a] - if {[package vsatisfies [package provide Tcl] 8.7-]} { + if {$fullutf} { fconfigure $outputChannel -profile tcl8 -encoding utf-8 } set ChannelsWeOpened($outputChannel) 1 @@ -428,6 +430,7 @@ namespace eval tcltest { proc errorChannel { {filename ""} } { variable errorChannel variable ChannelsWeOpened + variable fullutf # This is subtle and tricky. See the comment above in # [outputChannel] for a detailed explanation. @@ -447,7 +450,7 @@ namespace eval tcltest { } default { set errorChannel [open $filename a] - if {[package vsatisfies [package provide Tcl] 8.7-]} { + if {$fullutf} { fconfigure $errorChannel -profile tcl8 -encoding utf-8 } set ChannelsWeOpened($errorChannel) 1 @@ -790,9 +793,11 @@ namespace eval tcltest { } proc ReadLoadScript {args} { variable Option + variable fullutf + if {$Option(-loadfile) eq {}} {return} set tmp [open $Option(-loadfile) r] - if {[package vsatisfies [package provide Tcl] 8.7-]} { + if {$fullutf} { fconfigure $tmp -profile tcl8 -encoding utf-8 } loadScript [read $tmp] @@ -1151,14 +1156,13 @@ proc tcltest::SafeFetch {n1 n2 op} { # None. proc tcltest::Asciify {s} { - variable fullutf set print "" foreach c [split $s ""] { if {[string is print $c] && (($c <= "\x7E") || ($c == "\n"))} { append print $c } elseif {$c < "\u0100"} { append print \\x[format %02X [scan $c %c]] - } elseif {$fullutf && ($c >= "\U10000")} { + } elseif {$c > "\uFFFF"} { append print \\U[format %08X [scan $c %c]] } else { append print \\u[format %04X [scan $c %c]] @@ -1370,9 +1374,11 @@ proc tcltest::DefineConstraintInitializers {} { } ConstraintInitializer stdio { + variable fullutf + set code 0 if {![catch {set f [open "|[list [interpreter]]" w]}]} { - if {[package vsatisfies [package provide Tcl] 8.7-]} { + if {$fullutf} { fconfigure $f -profile tcl8 -encoding utf-8 } if {![catch {puts $f exit}]} { @@ -1917,6 +1923,8 @@ proc tcltest::test {name description args} { global tcl_platform variable testLevel variable coreModTime + variable fullutf + DebugPuts 3 "test $name $args" DebugDo 1 { variable TestNames @@ -2222,7 +2230,7 @@ proc tcltest::test {name description args} { set testFile [file normalize [uplevel 1 {info script}]] if {[file readable $testFile]} { set testFd [open $testFile r] - if {[package vsatisfies [package provide Tcl] 8.7-]} { + if {$fullutf} { fconfigure $testFd -profile tcl8 -encoding utf-8 } set testLine [expr {[lsearch -regexp \ @@ -2853,6 +2861,7 @@ proc tcltest::runAllTests { {shell ""} } { variable numTests variable failFiles variable DefaultValue + variable fullutf FillFilesExisted if {[llength [info level 0]] == 1} { @@ -2938,7 +2947,7 @@ proc tcltest::runAllTests { {shell ""} } { if {[catch { incr numTestFiles set pipeFd [open $cmd "r"] - if {[package vsatisfies [package provide Tcl] 8.7-]} { + if {$fullutf} { fconfigure $pipeFd -profile tcl8 -encoding utf-8 } while {[gets $pipeFd line] >= 0} { @@ -3125,6 +3134,8 @@ proc tcltest::normalizeMsg {msg} { proc tcltest::makeFile {contents name {directory ""}} { variable filesMade + variable fullutf + FillFilesExisted if {[llength [info level 0]] == 3} { @@ -3138,7 +3149,7 @@ proc tcltest::makeFile {contents name {directory ""}} { set fd [open $fullName w] fconfigure $fd -translation lf - if {[package vsatisfies [package provide Tcl] 8.7-]} { + if {$fullutf} { fconfigure $fd -profile tcl8 -encoding utf-8 } if {[string index $contents end] eq "\n"} { @@ -3283,13 +3294,15 @@ proc tcltest::removeDirectory {name {directory ""}} { # None. proc tcltest::viewFile {name {directory ""}} { + variable fullutf + FillFilesExisted if {[llength [info level 0]] == 2} { set directory [temporaryDirectory] } set fullName [file join $directory $name] set f [open $fullName] - if {[package vsatisfies [package provide Tcl] 8.7-]} { + if {$fullutf} { fconfigure $f -profile tcl8 -encoding utf-8 } set data [read -nonewline $f] @@ -3325,7 +3338,7 @@ proc tcltest::viewFile {name {directory ""}} { # Side effects: # None -if {![package vsatisfies [package provide Tcl] 8.7-]} { +if {!$::tcltest::fullutf} { proc tcltest::bytestring {string} { return [encoding convertfrom identity $string] } -- cgit v0.12 From 5bbfefe89f6daa8cc27ecf068f1447b1f426c215 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 10 Jan 2024 15:12:39 +0000 Subject: Fix [4e38c347a4]: Changed contract for Tcl_UtfN(case)cmp in Tcl 8.7 --- generic/tcl.decls | 11 ++++++-- generic/tclDecls.h | 39 ++++++++++++++++----------- generic/tclStubInit.c | 8 +++--- generic/tclUtf.c | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 109 insertions(+), 22 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 0d13dc3..8e047d0 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -1363,10 +1363,10 @@ declare 368 { int Tcl_Stat(const char *path, struct stat *bufPtr) } declare 369 { - int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n) + int TclUtfNcmp(const char *s1, const char *s2, size_t n) } declare 370 { - int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n) + int TclUtfNcasecmp(const char *s1, const char *s2, size_t n) } declare 371 { int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase) @@ -2628,6 +2628,13 @@ declare 685 { Tcl_Obj *Tcl_DStringToObj(Tcl_DString *dsPtr) } +declare 686 { + int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n) +} +declare 687 { + int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n) +} + # ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- # declare 688 { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 13d82a0..afa29a1 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -972,9 +972,9 @@ EXTERN int Tcl_Access(const char *path, int mode); /* 368 */ EXTERN int Tcl_Stat(const char *path, struct stat *bufPtr); /* 369 */ -EXTERN int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n); +EXTERN int TclUtfNcmp(const char *s1, const char *s2, size_t n); /* 370 */ -EXTERN int Tcl_UtfNcasecmp(const char *s1, const char *s2, +EXTERN int TclUtfNcasecmp(const char *s1, const char *s2, size_t n); /* 371 */ EXTERN int Tcl_StringCaseMatch(const char *str, @@ -1862,8 +1862,11 @@ EXTERN int Tcl_GetWideUIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 685 */ EXTERN Tcl_Obj * Tcl_DStringToObj(Tcl_DString *dsPtr); -/* Slot 686 is reserved */ -/* Slot 687 is reserved */ +/* 686 */ +EXTERN int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n); +/* 687 */ +EXTERN int Tcl_UtfNcasecmp(const char *s1, const char *s2, + size_t n); /* 688 */ EXTERN void TclUnusedStubEntry(void); @@ -2246,8 +2249,8 @@ typedef struct TclStubs { int (*tcl_Chdir) (const char *dirName); /* 366 */ int (*tcl_Access) (const char *path, int mode); /* 367 */ int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */ - int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 369 */ - int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 370 */ + int (*tclUtfNcmp) (const char *s1, const char *s2, size_t n); /* 369 */ + int (*tclUtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 370 */ int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */ int (*tcl_UniCharIsControl) (int ch); /* 372 */ int (*tcl_UniCharIsGraph) (int ch); /* 373 */ @@ -2563,8 +2566,8 @@ typedef struct TclStubs { Tcl_Size (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */ Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */ - void (*reserved686)(void); - void (*reserved687)(void); + int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 686 */ + int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 687 */ void (*tclUnusedStubEntry) (void); /* 688 */ } TclStubs; @@ -3266,10 +3269,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_Access) /* 367 */ #define Tcl_Stat \ (tclStubsPtr->tcl_Stat) /* 368 */ -#define Tcl_UtfNcmp \ - (tclStubsPtr->tcl_UtfNcmp) /* 369 */ -#define Tcl_UtfNcasecmp \ - (tclStubsPtr->tcl_UtfNcasecmp) /* 370 */ +#define TclUtfNcmp \ + (tclStubsPtr->tclUtfNcmp) /* 369 */ +#define TclUtfNcasecmp \ + (tclStubsPtr->tclUtfNcasecmp) /* 370 */ #define Tcl_StringCaseMatch \ (tclStubsPtr->tcl_StringCaseMatch) /* 371 */ #define Tcl_UniCharIsControl \ @@ -3890,8 +3893,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetWideUIntFromObj) /* 684 */ #define Tcl_DStringToObj \ (tclStubsPtr->tcl_DStringToObj) /* 685 */ -/* Slot 686 is reserved */ -/* Slot 687 is reserved */ +#define Tcl_UtfNcmp \ + (tclStubsPtr->tcl_UtfNcmp) /* 686 */ +#define Tcl_UtfNcasecmp \ + (tclStubsPtr->tcl_UtfNcasecmp) /* 687 */ #define TclUnusedStubEntry \ (tclStubsPtr->tclUnusedStubEntry) /* 688 */ @@ -4089,7 +4094,6 @@ extern const TclStubs *tclStubsPtr; # define Tcl_UniCharToUtf(c, p) \ ((Tcl_UniCharToUtf)((c)|TCL_COMBINE, (p))) # endif -#if !defined(BUILD_tcl) # undef Tcl_NumUtfChars # define Tcl_NumUtfChars TclNumUtfChars # undef Tcl_GetCharLength @@ -4100,7 +4104,10 @@ extern const TclStubs *tclStubsPtr; # define Tcl_GetRange TclGetRange # undef Tcl_GetUniChar # define Tcl_GetUniChar TclGetUniChar -#endif +# undef Tcl_UtfNcmp +# define Tcl_UtfNcmp TclUtfNcmp +# undef Tcl_UtfNcasecmp +# define Tcl_UtfNcasecmp TclUtfNcasecmp #endif #if defined(USE_TCL_STUBS) # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index a987fe8..34e8c27 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1164,8 +1164,8 @@ const TclStubs tclStubs = { Tcl_Chdir, /* 366 */ Tcl_Access, /* 367 */ Tcl_Stat, /* 368 */ - Tcl_UtfNcmp, /* 369 */ - Tcl_UtfNcasecmp, /* 370 */ + TclUtfNcmp, /* 369 */ + TclUtfNcasecmp, /* 370 */ Tcl_StringCaseMatch, /* 371 */ Tcl_UniCharIsControl, /* 372 */ Tcl_UniCharIsGraph, /* 373 */ @@ -1481,8 +1481,8 @@ const TclStubs tclStubs = { Tcl_GetEncodingNulLength, /* 683 */ Tcl_GetWideUIntFromObj, /* 684 */ Tcl_DStringToObj, /* 685 */ - 0, /* 686 */ - 0, /* 687 */ + Tcl_UtfNcmp, /* 686 */ + Tcl_UtfNcasecmp, /* 687 */ TclUnusedStubEntry, /* 688 */ }; diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 8a802a2..707bf0d 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -1537,6 +1537,44 @@ TclpUtfNcmp2( */ int +TclUtfNcmp( + const char *cs, /* UTF string to compare to ct. */ + const char *ct, /* UTF string cs is compared to. */ + size_t numChars) /* Number of UTF-16 chars to compare. */ +{ + unsigned short ch1 = 0, ch2 = 0; + + /* + * Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the + * pair of bytes 0xC0,0x80) is larger than byte representation of \u0001 + * (the byte 0x01.) + */ + + while (numChars-- > 0) { + /* + * n must be interpreted as chars, not bytes. This should be called + * only when both strings are of at least n UTF-16 chars long (no need for \0 + * check) + */ + + cs += Tcl_UtfToChar16(cs, &ch1); + ct += Tcl_UtfToChar16(ct, &ch2); + if (ch1 != ch2) { + /* Surrogates always report higher than non-surrogates */ + if (((ch1 & 0xFC00) == 0xD800)) { + if ((ch2 & 0xFC00) != 0xD800) { + return ch1; + } + } else if ((ch2 & 0xFC00) == 0xD800) { + return -ch2; + } + return (ch1 - ch2); + } + } + return 0; +} + +int Tcl_UtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ @@ -1585,6 +1623,41 @@ Tcl_UtfNcmp( */ int +TclUtfNcasecmp( + const char *cs, /* UTF string to compare to ct. */ + const char *ct, /* UTF string cs is compared to. */ + size_t numChars) /* Number of UTF-16 chars to compare. */ +{ + unsigned short ch1 = 0, ch2 = 0; + + while (numChars-- > 0) { + /* + * n must be interpreted as UTF-16 chars, not bytes. + * This should be called only when both strings are of + * at least n UTF-16 chars long (no need for \0 check) + */ + cs += Tcl_UtfToChar16(cs, &ch1); + ct += Tcl_UtfToChar16(ct, &ch2); + if (ch1 != ch2) { + /* Surrogates always report higher than non-surrogates */ + if (((ch1 & 0xFC00) == 0xD800)) { + if ((ch2 & 0xFC00) != 0xD800) { + return ch1; + } + } else if ((ch2 & 0xFC00) == 0xD800) { + return -ch2; + } + ch1 = Tcl_UniCharToLower(ch1); + ch2 = Tcl_UniCharToLower(ch2); + if (ch1 != ch2) { + return (ch1 - ch2); + } + } + } + return 0; +} + +int Tcl_UtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ -- cgit v0.12 From 2e333610b4dd033f842d3b3e9a3e59aee2bfb3f5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 10 Jan 2024 21:01:29 +0000 Subject: Fix [4e38c347a4] Changed contract for Tcl_UtfN(case)cmp in Tcl 8.7 --- generic/tcl.decls | 7 ++++ generic/tclDecls.h | 21 ++++++++---- generic/tclStubInit.c | 4 +-- generic/tclUtf.c | 93 +++++++++++++++++++++++++++++++++++++++++++++------ 4 files changed, 106 insertions(+), 19 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index 0097eea..ec135a5 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2502,6 +2502,13 @@ declare 685 { Tcl_Obj *Tcl_DStringToObj(Tcl_DString *dsPtr) } +declare 686 { + int TclUtfNcmp(const char *s1, const char *s2, size_t n) +} +declare 687 { + int TclUtfNcasecmp(const char *s1, const char *s2, size_t n) +} + # ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- # declare 688 { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 5768233..447bd9a 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -2009,8 +2009,11 @@ EXTERN int Tcl_GetWideUIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 685 */ EXTERN Tcl_Obj * Tcl_DStringToObj(Tcl_DString *dsPtr); -/* Slot 686 is reserved */ -/* Slot 687 is reserved */ +/* 686 */ +EXTERN int TclUtfNcmp(const char *s1, const char *s2, size_t n); +/* 687 */ +EXTERN int TclUtfNcasecmp(const char *s1, const char *s2, + size_t n); /* 688 */ EXTERN void TclUnusedStubEntry(void); @@ -2734,8 +2737,8 @@ typedef struct TclStubs { Tcl_Size (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */ Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */ - void (*reserved686)(void); - void (*reserved687)(void); + int (*tclUtfNcmp) (const char *s1, const char *s2, size_t n); /* 686 */ + int (*tclUtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 687 */ void (*tclUnusedStubEntry) (void); /* 688 */ } TclStubs; @@ -4124,8 +4127,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetWideUIntFromObj) /* 684 */ #define Tcl_DStringToObj \ (tclStubsPtr->tcl_DStringToObj) /* 685 */ -/* Slot 686 is reserved */ -/* Slot 687 is reserved */ +#define TclUtfNcmp \ + (tclStubsPtr->tclUtfNcmp) /* 686 */ +#define TclUtfNcasecmp \ + (tclStubsPtr->tclUtfNcasecmp) /* 687 */ #define TclUnusedStubEntry \ (tclStubsPtr->tclUnusedStubEntry) /* 688 */ @@ -4392,6 +4397,10 @@ extern const TclStubs *tclStubsPtr; # define Tcl_GetRange TclGetRange # undef Tcl_GetUniChar # define Tcl_GetUniChar TclGetUniChar +# undef Tcl_UtfNcmp +# define Tcl_UtfNcmp TclUtfNcmp +# undef Tcl_UtfNcasecmp +# define Tcl_UtfNcasecmp TclUtfNcasecmp #endif #if defined(USE_TCL_STUBS) # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index e45efc8..dfcc1fb 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1970,8 +1970,8 @@ const TclStubs tclStubs = { Tcl_GetEncodingNulLength, /* 683 */ Tcl_GetWideUIntFromObj, /* 684 */ Tcl_DStringToObj, /* 685 */ - 0, /* 686 */ - 0, /* 687 */ + TclUtfNcmp, /* 686 */ + TclUtfNcasecmp, /* 687 */ TclUnusedStubEntry, /* 688 */ }; diff --git a/generic/tclUtf.c b/generic/tclUtf.c index a502f69..d495402 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -1229,7 +1229,7 @@ TclUtfAtIndex( const char *src, /* The UTF-8 string. */ Tcl_Size index) /* The position of the desired character. */ { - Tcl_UniChar ch = 0; + Tcl_UniChar ch = 0; while (index-- > 0) { src += TclUtfToUniChar(src, &ch); @@ -1552,7 +1552,45 @@ int Tcl_UtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - unsigned long numChars) /* Number of UTF chars to compare. */ + unsigned long numChars) /* Number of UTF-16 chars to compare. */ +{ + unsigned short ch1 = 0, ch2 = 0; + + /* + * Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the + * pair of bytes 0xC0,0x80) is larger than byte representation of \u0001 + * (the byte 0x01.) + */ + + while (numChars-- > 0) { + /* + * n must be interpreted as chars, not bytes. This should be called + * only when both strings are of at least n UTF-16 chars long (no need for \0 + * check) + */ + + cs += Tcl_UtfToChar16(cs, &ch1); + ct += Tcl_UtfToChar16(ct, &ch2); + if (ch1 != ch2) { + /* Surrogates always report higher than non-surrogates */ + if (((ch1 & 0xFC00) == 0xD800)) { + if ((ch2 & 0xFC00) != 0xD800) { + return ch1; + } + } else if ((ch2 & 0xFC00) == 0xD800) { + return -ch2; + } + return (ch1 - ch2); + } + } + return 0; +} + +int +TclUtfNcmp( + const char *cs, /* UTF string to compare to ct. */ + const char *ct, /* UTF string cs is compared to. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; @@ -1632,7 +1670,42 @@ int Tcl_UtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - unsigned long numChars) /* Number of UTF chars to compare. */ + unsigned long numChars) /* Number of UTF-16 chars to compare. */ +{ + unsigned short ch1 = 0, ch2 = 0; + + while (numChars-- > 0) { + /* + * n must be interpreted as UTF-16 chars, not bytes. + * This should be called only when both strings are of + * at least n UTF-16 chars long (no need for \0 check) + */ + cs += Tcl_UtfToChar16(cs, &ch1); + ct += Tcl_UtfToChar16(ct, &ch2); + if (ch1 != ch2) { + /* Surrogates always report higher than non-surrogates */ + if (((ch1 & 0xFC00) == 0xD800)) { + if ((ch2 & 0xFC00) != 0xD800) { + return ch1; + } + } else if ((ch2 & 0xFC00) == 0xD800) { + return -ch2; + } + ch1 = Tcl_UniCharToLower(ch1); + ch2 = Tcl_UniCharToLower(ch2); + if (ch1 != ch2) { + return (ch1 - ch2); + } + } + } + return 0; +} + +int +TclUtfNcasecmp( + const char *cs, /* UTF string to compare to ct. */ + const char *ct, /* UTF string cs is compared to. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1 = 0, ch2 = 0; @@ -2057,8 +2130,8 @@ TclUniCharNcasecmp( { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { - int lcs = Tcl_UniCharToLower(*ucs); - int lct = Tcl_UniCharToLower(*uct); + Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs); + Tcl_UniChar lct = Tcl_UniCharToLower(*uct); if (lcs != lct) { return (lcs - lct); @@ -2078,8 +2151,8 @@ TclUniCharNcasememcmp( const Tcl_UniChar *uct = (const Tcl_UniChar *)uctPtr; for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { - int lcs = Tcl_UniCharToLower(*ucs); - int lct = Tcl_UniCharToLower(*uct); + Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs); + Tcl_UniChar lct = Tcl_UniCharToLower(*uct); if (lcs != lct) { return (lcs - lct); @@ -2115,7 +2188,6 @@ Tcl_UniCharNcasecmp( return 0; } #endif - /* *---------------------------------------------------------------------- @@ -2486,7 +2558,7 @@ TclUniCharCaseMatch( * characters. */ int nocase) /* 0 for case sensitive, 1 for insensitive */ { - int ch1 = 0, p; + Tcl_UniChar ch1 = 0, p; while (1) { p = *uniPattern; @@ -2574,7 +2646,7 @@ TclUniCharCaseMatch( */ if (p == '[') { - int startChar, endChar; + Tcl_UniChar startChar, endChar; uniPattern++; ch1 = (nocase ? Tcl_UniCharToLower(*uniStr) : *uniStr); @@ -2814,7 +2886,6 @@ Tcl_UniCharCaseMatch( } #endif - /* *---------------------------------------------------------------------- * -- cgit v0.12 From 40568d95206049adc373e1dd3d2af534e045e0c0 Mon Sep 17 00:00:00 2001 From: oehhar Date: Thu, 11 Jan 2024 09:33:35 +0000 Subject: Ticket [fd27add6]: doc change of Tcl_PkgRequire & friends: version string specification refers to "package require". --- doc/PkgRequire.3 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/doc/PkgRequire.3 b/doc/PkgRequire.3 index 71f3acf..a85d43f 100644 --- a/doc/PkgRequire.3 +++ b/doc/PkgRequire.3 @@ -40,8 +40,7 @@ Interpreter where package is needed or available. .AP "const char" *name in Name of package. .AP "const char" *version in -A version string consisting of one or more decimal numbers -separated by dots. +A version specification string as described for \fBpackage require\fR. .AP int exact in Non-zero means that only the particular version specified by \fIversion\fR is acceptable. -- cgit v0.12 From 92335a5b9cd2a06dffb89ea3e9b2a68901f5d57f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 12 Jan 2024 11:31:15 +0000 Subject: Update the pkga.c/pkgua.c examples, making sure there's no misunderstanding that Tcl_UtfNcmp() expects Tcl_UniChar lengths, not byte lengts --- unix/dltest/pkga.c | 2 ++ unix/dltest/pkgua.c | 2 ++ 2 files changed, 4 insertions(+) diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c index c5292ee..7ab5823 100644 --- a/unix/dltest/pkga.c +++ b/unix/dltest/pkga.c @@ -50,6 +50,8 @@ Pkga_EqObjCmd( str1 = Tcl_GetStringFromObj(objv[1], &len1); str2 = Tcl_GetStringFromObj(objv[2], &len2); + len1 = Tcl_NumUtfChars(str1, len1); + len2 = Tcl_NumUtfChars(str2, len2); if (len1 == len2) { result = (Tcl_UtfNcmp(str1, str2, (size_t)len1) == 0); } else { diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index 03e8aab..89fa4fe 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -138,6 +138,8 @@ PkguaEqObjCmd( str1 = Tcl_GetStringFromObj(objv[1], &len1); str2 = Tcl_GetStringFromObj(objv[2], &len2); + len1 = Tcl_NumUtfChars(str1, len1); + len2 = Tcl_NumUtfChars(str2, len2); if (len1 == len2) { result = (Tcl_UtfNcmp(str1, str2, (size_t)len1) == 0); } else { -- cgit v0.12 From 3827fdbdddb5dfcdf30e19a360e1c97a79b41e7d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 13 Jan 2024 22:24:05 +0000 Subject: Fix wrongly places braces (noted by AKU, thannks!). Also '==' -> 'eq' in expression --- library/tcltest/tcltest.tcl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 55ad481..4c8d8f2 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -1144,7 +1144,7 @@ proc tcltest::SafeFetch {n1 n2 op} { # # Transforms the passed string to contain only printable ascii characters. # Useful for printing to terminals. Non-printables are mapped to -# \x, \u or \U sequences. +# \x, \u or \U sequences, except \n. # # Arguments: # s - string to transform @@ -1158,7 +1158,7 @@ proc tcltest::SafeFetch {n1 n2 op} { proc tcltest::Asciify {s} { set print "" foreach c [split $s ""] { - if {[string is print $c] && (($c <= "\x7E") || ($c == "\n"))} { + if {(($c < "\x7F") && [string is print $c]) || ($c eq "\n")} { append print $c } elseif {$c < "\u0100"} { append print \\x[format %02X [scan $c %c]] -- cgit v0.12 From 9cdc14d4f0772cc73d3712b6944048ac0b2a2659 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 15 Jan 2024 10:46:33 +0000 Subject: Bug [d63061a1ac]: "PRIVATE != CONTROL in Unicode". Leave out "Co" (private-use characters) from "string is control". --- generic/regc_locale.c | 6 ++---- generic/tclUtf.c | 5 +---- 2 files changed, 3 insertions(+), 8 deletions(-) diff --git a/generic/regc_locale.c b/generic/regc_locale.c index adeb0bd..2f0e210 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -299,11 +299,9 @@ 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}, - {0xF0000, 0xFFFFD}, {0x100000, 0x10FFFD} + ,{0x13430, 0x1343F}, {0x1BCA0, 0x1BCA3}, {0x1D173, 0x1D17A}, {0xE0020, 0xE007F} #endif }; diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 8d5d8f9..be185b0 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -26,7 +26,7 @@ #define ALPHA_BITS ((1 << UPPERCASE_LETTER) | (1 << LOWERCASE_LETTER) \ | (1 << TITLECASE_LETTER) | (1 << MODIFIER_LETTER) | (1<= 0xE0020) && (ch <= 0xE007F))) { return 1; } - if ((ch >= 0xF0000) && ((ch & 0xFFFF) <= 0xFFFD)) { - return 1; - } return 0; } return ((CONTROL_BITS >> GetCategory(ch)) & 1); -- cgit v0.12 From 70cd9b24ad02580678df10f151af7e7fbc4e8769 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 15 Jan 2024 19:22:02 +0000 Subject: Fix non-existing function names in test titles --- ChangeLog.1999 | 2 +- tests/utf.test | 22 +++++++++++----------- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/ChangeLog.1999 b/ChangeLog.1999 index e736dee..c2de0f2 100644 --- a/ChangeLog.1999 +++ b/ChangeLog.1999 @@ -2596,7 +2596,7 @@ * tclUtf.c: added Unicode character table support - * tclInt.h: added TclUniCharIsWordChar + * tclInt.h: added Tcl_UniCharIsWordChar * tclCmdMZ.c (Tcl_StringObjCmd): added "totitle" subcommand, changed "wordend" and "wordstart" to properly handle Unicode word characters diff --git a/tests/utf.test b/tests/utf.test index c9abb08..f7a4535 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -1343,7 +1343,7 @@ test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} { expr {($first == $second) ? "agree" : "disagree"} } agree -test utf-21.1 {TclUniCharIsAlnum} { +test utf-21.1 {Tcl_UniCharIsAlnum} { # this returns 1 with Unicode 7 compliance string is alnum \u1040\u021F\u0220 } 1 @@ -1355,7 +1355,7 @@ test utf-21.3 {unicode print char in regc_locale.c} { # this returns 1 with Unicode 7 compliance regexp {^[[:print:]]+$} \uFBC1 } 1 -test utf-21.4 {TclUniCharIsGraph} { +test utf-21.4 {Tcl_UniCharIsGraph} { # [Bug 3464428] string is graph \u0120 } 1 @@ -1363,7 +1363,7 @@ test utf-21.5 {unicode graph char in regc_locale.c} { # [Bug 3464428] regexp {^[[:graph:]]+$} \u0120 } 1 -test utf-21.6 {TclUniCharIsGraph} { +test utf-21.6 {Tcl_UniCharIsGraph} { # [Bug 3464428] string is graph \xA0 } 0 @@ -1371,7 +1371,7 @@ test utf-21.7 {unicode graph char in regc_locale.c} { # [Bug 3464428] regexp {[[:graph:]]} \x20\xA0\u2028\u2029 } 0 -test utf-21.8 {TclUniCharIsPrint} { +test utf-21.8 {Tcl_UniCharIsPrint} { # [Bug 3464428] string is print \x09 } 0 @@ -1383,7 +1383,7 @@ test utf-21.10 {unicode print char in regc_locale.c} { # [Bug 3464428] regexp {[[:print:]]} \x09 } 0 -test utf-21.11 {TclUniCharIsControl} { +test utf-21.11 {Tcl_UniCharIsControl} { # [Bug 3464428] string is control \x00\x1F\xAD\u0605\u061C\u180E\u2066\uFEFF } 1 @@ -1392,14 +1392,14 @@ test utf-21.12 {unicode control char in regc_locale.c} { regexp {^[[:cntrl:]]*$} \x00\x1F\xAD\u0605\u061C\u180E\u2066\uFEFF } 1 -test utf-22.1 {TclUniCharIsWordChar} { +test utf-22.1 {Tcl_UniCharIsWordChar} { string wordend "xyz123_bar fg" 0 } 10 -test utf-22.2 {TclUniCharIsWordChar} { +test utf-22.2 {Tcl_UniCharIsWordChar} { string wordend "x\u5080z123_bar\u203C fg" 0 } 10 -test utf-23.1 {TclUniCharIsAlpha} { +test utf-23.1 {Tcl_UniCharIsAlpha} { # this returns 1 with Unicode 7 compliance string is alpha \u021F\u0220\u037F\u052F } 1 @@ -1408,7 +1408,7 @@ test utf-23.2 {unicode alpha char in regc_locale.c} { regexp {^[[:alpha:]]+$} \u021F\u0220\u037F\u052F } 1 -test utf-24.1 {TclUniCharIsDigit} { +test utf-24.1 {Tcl_UniCharIsDigit} { # this returns 1 with Unicode 7 compliance string is digit \u1040\uABF0 } 1 @@ -1417,7 +1417,7 @@ test utf-24.2 {unicode digit char in regc_locale.c} { list [regexp {^[[:digit:]]+$} \u1040\uABF0] [regexp {^\d+$} \u1040\uABF0] } {1 1} -test utf-24.3 {TclUniCharIsSpace} { +test utf-24.3 {Tcl_UniCharIsSpace} { # this returns 1 with Unicode 7 compliance string is space \u1680\u180E\u202F } 1 @@ -1425,7 +1425,7 @@ test utf-24.4 {unicode space char in regc_locale.c} { # this returns 1 with Unicode 7 compliance list [regexp {^[[:space:]]+$} \u1680\u180E\u202F] [regexp {^\s+$} \u1680\u180E\u202F] } {1 1} -test utf-24.5 {TclUniCharIsSpace} tip413 { +test utf-24.5 {Tcl_UniCharIsSpace} tip413 { # this returns 1 with Unicode 7/TIP 413 compliance string is space \x85\u1680\u180E\u200B\u202F\u2060 } 1 -- cgit v0.12 From 374ccca513cc5aa17aa70e5aad998b393e5c15ae Mon Sep 17 00:00:00 2001 From: griffin Date: Tue, 16 Jan 2024 01:05:52 +0000 Subject: Bump to 8.6.14 for release --- README.md | 2 +- generic/tcl.h | 2 +- library/init.tcl | 2 +- unix/configure | 2 +- unix/configure.in | 2 +- win/configure | 2 +- win/configure.in | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index 1c5cd4b..a96ebf3 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # README: Tcl -This is the **Tcl 8.6.13** source distribution. +This is the **Tcl 8.6.14** 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 f4c89ba..8806489 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -59,7 +59,7 @@ extern "C" { #define TCL_RELEASE_SERIAL 13 #define TCL_VERSION "8.6" -#define TCL_PATCH_LEVEL "8.6.13" +#define TCL_PATCH_LEVEL "8.6.14" /* *---------------------------------------------------------------------------- diff --git a/library/init.tcl b/library/init.tcl index 9412e00..3cf117f 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -16,7 +16,7 @@ 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.6.13 +package require -exact Tcl 8.6.14 # 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 fcbd279..87dc84d 100755 --- a/unix/configure +++ b/unix/configure @@ -1335,7 +1335,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".13" +TCL_PATCH_LEVEL=".14" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} diff --git a/unix/configure.in b/unix/configure.in index 39eba16..4f62510 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -26,7 +26,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".13" +TCL_PATCH_LEVEL=".14" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} diff --git a/win/configure b/win/configure index d755c39..1382854 100755 --- a/win/configure +++ b/win/configure @@ -1325,7 +1325,7 @@ SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".13" +TCL_PATCH_LEVEL=".14" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 diff --git a/win/configure.in b/win/configure.in index 7096be0..737f046 100644 --- a/win/configure.in +++ b/win/configure.in @@ -15,7 +15,7 @@ SHELL=/bin/sh TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".13" +TCL_PATCH_LEVEL=".14" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 -- cgit v0.12 From dce50124e72392480b6b72193d7b014a6e09e9dd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 17 Jan 2024 16:31:23 +0000 Subject: TCL_RELEASE_SERIAL (in tcl.h) and unix/tcl.spec should be updated too --- generic/tcl.h | 2 +- unix/tcl.spec | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 8806489..28d094f 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -56,7 +56,7 @@ extern "C" { #endif #define TCL_MINOR_VERSION 6 #define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TCL_RELEASE_SERIAL 13 +#define TCL_RELEASE_SERIAL 14 #define TCL_VERSION "8.6" #define TCL_PATCH_LEVEL "8.6.14" diff --git a/unix/tcl.spec b/unix/tcl.spec index f4177a4..de61d38 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.6.13 +Version: 8.6.14 Release: 2 License: BSD Group: Development/Languages -- cgit v0.12 From a6f4856b19e41aa6a37ed20825c088c7f981a877 Mon Sep 17 00:00:00 2001 From: apnadkarni Date: Fri, 19 Jan 2024 11:27:25 +0000 Subject: Bug [e5ca49bcfa] - zipfs glob --- generic/tclZipfs.c | 64 +++++++++++++++++++++++++++++++++++++----------------- tests/zipfs.test | 8 +++++++ 2 files changed, 52 insertions(+), 20 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index c2c0a01..3608751 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -5506,7 +5506,7 @@ AppendWithPrefix( * Results: * The return value is a standard Tcl result indicating whether an error * occurred in globbing. Errors are left in interp, good results are - * lappend'ed to resultPtr (which must be a valid object). + * lappend'ed to result (which must be a valid object). * * Side effects: * None. @@ -5516,26 +5516,45 @@ AppendWithPrefix( static int ZipFSMatchInDirectoryProc( - TCL_UNUSED(Tcl_Interp *), + Tcl_Interp *interp, Tcl_Obj *result, /* Where to append matched items to. */ Tcl_Obj *pathPtr, /* Where we are looking. */ const char *pattern, /* What names we are looking for. */ Tcl_GlobTypeData *types) /* What types we are looking for. */ { Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); - int scnt, l, dirOnly = -1, mounts = 0; + int scnt, l; Tcl_Size prefixLen, len, strip = 0; char *pat, *prefix, *path; Tcl_DString dsPref, *prefixBuf = NULL; int foundInHash, notDuplicate; ZipEntry *z; + int wanted; /* TCL_GLOB_TYPE* */ if (!normPathPtr) { return -1; } if (types) { - dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR; - mounts = (types->type == TCL_GLOB_TYPE_MOUNT); + wanted = types->type; + if ((wanted & TCL_GLOB_TYPE_MOUNT) && (wanted != TCL_GLOB_TYPE_MOUNT)) { + if (interp) { + Tcl_SetResult(interp, + "Internal error: TCL_GLOB_TYPE_MOUNT should not " + "be set in conjunction with other glob types.", + TCL_STATIC); + } + return TCL_ERROR; + } + if ((wanted & (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE | + TCL_GLOB_TYPE_MOUNT)) == 0) { + /* Not looking for files,dirs,mounts. zipfs cannot have others */ + return TCL_OK; + } + wanted &= + (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE | TCL_GLOB_TYPE_MOUNT); + } + else { + wanted = TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE; } /* @@ -5572,11 +5591,14 @@ ZipFSMatchInDirectoryProc( * Are we globbing the mount points? */ - if (mounts) { + if (wanted & TCL_GLOB_TYPE_MOUNT) { ZipFSMatchMountPoints(result, normPathPtr, pattern, prefixBuf); goto end; } + /* Should not reach here unless at least one of DIR or FILE is set */ + assert(wanted & (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE)); + /* Does the path exist in the hash table? */ z = ZipFSLookup(path); if (z) { @@ -5587,8 +5609,9 @@ ZipFSMatchInDirectoryProc( if (!pattern || (pattern[0] == '\0')) { /* TODO - can't seem to get to this code from script for tests. */ /* Follow logic of what tclUnixFile.c does */ - if ((dirOnly < 0) || (!dirOnly && !z->isDirectory) || - (dirOnly && z->isDirectory)) { + if ((wanted == (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE)) || + (wanted == TCL_GLOB_TYPE_DIR && z->isDirectory) || + (wanted == TCL_GLOB_TYPE_FILE && !z->isDirectory)) { Tcl_ListObjAppendElement(NULL, result, pathPtr); } goto end; @@ -5597,7 +5620,7 @@ ZipFSMatchInDirectoryProc( /* Not in the hash table but could be an intermediate dir in a mount */ if (!pattern || (pattern[0] == '\0')) { /* TODO - can't seem to get to this code from script for tests. */ - if (dirOnly && ContainsMountPoint(path, len)) { + if ((wanted & TCL_GLOB_TYPE_DIR) && ContainsMountPoint(path, len)) { Tcl_ListObjAppendElement(NULL, result, pathPtr); } goto end; @@ -5636,20 +5659,21 @@ ZipFSMatchInDirectoryProc( hPtr = Tcl_NextHashEntry(&search)) { z = (ZipEntry *)Tcl_GetHashValue(hPtr); - if ((dirOnly >= 0) && ((dirOnly && !z->isDirectory) || - (!dirOnly && z->isDirectory))) { - continue; - } - 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); - assert(notDuplicate); - AppendWithPrefix(result, prefixBuf, z->name + strip, -1); + if ((wanted == (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE)) || + (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); + assert(notDuplicate); + AppendWithPrefix(result, prefixBuf, z->name + strip, -1); + } } } } - if (dirOnly) { + if (wanted & TCL_GLOB_TYPE_DIR) { /* * Also check paths that are ancestors of a mount. e.g. glob * //zipfs:/a/? with mount at //zipfs:/a/b/c. Also have to be diff --git a/tests/zipfs.test b/tests/zipfs.test index d77369b..be4ba19 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -1447,6 +1447,13 @@ namespace eval test_ns_zipfs { testzipfsglob basic-dir-tails $basicMounts [list -tails -dir $defMountPt *] [list test testdir] testzipfsglob basic-type-d $basicMounts [list -type d $defMountPt/*] [zipfspathsmt $defMountPt testdir] testzipfsglob basic-type-f $basicMounts [list -type f $defMountPt/*] [zipfspathsmt $defMountPt test] + testzipfsglob basic-type-d-f $basicMounts [list -type {d f} $defMountPt/*] [zipfspathsmt $defMountPt test testdir] + testzipfsglob basic-type-l $basicMounts [list -type l $defMountPt/*] {} + foreach type {b c l p s} { + testzipfsglob basic-type-$type $basicMounts [list -type $type $defMountPt/*] {} + 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] + } testzipfsglob basic-path $basicMounts [list -path $defMountPt/t *d*] [zipfspathsmt $defMountPt testdir] testzipfsglob basic-enoent $basicMounts [list $defMountPt/x*] {} testzipfsglob basic-enoent-ok $basicMounts [list -nocomplain $defMountPt/x*] {} @@ -1464,6 +1471,7 @@ namespace eval test_ns_zipfs { testzipfsglob root-type-d-1 $rootMounts [list -type d [zipfs root]*] [zipfspaths $::zipLibTop testdir] -constraints zipfslib testzipfsglob root-type-d-2 $rootMounts [list -type d [zipfs root]*] [zipfspaths testdir] -constraints !zipfslib testzipfsglob root-type-f $rootMounts [list -type f [zipfs root]*] [zipfspaths test] + testzipfsglob root-type-d-f $rootMounts [list -type {d f} [zipfs root]*] [zipfspaths test testdir] -constraints !zipfslib testzipfsglob root-path $rootMounts [list -path [zipfs root]t *d*] [zipfspaths testdir] testzipfsglob root-enoent $rootMounts [list [zipfs root]x*] {} testzipfsglob root-enoent-ok $rootMounts [list -nocomplain [zipfs root]x*] {} -- cgit v0.12 From 2d01ae0798e0b3934dfd17c2b18dfaec1b761305 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 19 Jan 2024 14:34:33 +0000 Subject: (cherry-pick): Bug [e5ca49bcfa] - zipfs glob --- generic/tclZipfs.c | 64 +++++++++++++++++++++++++++++++++++++----------------- tests/zipfs.test | 10 ++++++++- 2 files changed, 53 insertions(+), 21 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 5df300a..cbfa48b 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -5524,7 +5524,7 @@ AppendWithPrefix( * Results: * The return value is a standard Tcl result indicating whether an error * occurred in globbing. Errors are left in interp, good results are - * lappend'ed to resultPtr (which must be a valid object). + * lappend'ed to result (which must be a valid object). * * Side effects: * None. @@ -5534,26 +5534,45 @@ AppendWithPrefix( static int ZipFSMatchInDirectoryProc( - TCL_UNUSED(Tcl_Interp *), + Tcl_Interp *interp, Tcl_Obj *result, /* Where to append matched items to. */ Tcl_Obj *pathPtr, /* Where we are looking. */ const char *pattern, /* What names we are looking for. */ Tcl_GlobTypeData *types) /* What types we are looking for. */ { Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); - int scnt, l, dirOnly = -1, mounts = 0; + int scnt, l; Tcl_Size prefixLen, len, strip = 0; char *pat, *prefix, *path; Tcl_DString dsPref, *prefixBuf = NULL; int foundInHash, notDuplicate; ZipEntry *z; + int wanted; /* TCL_GLOB_TYPE* */ if (!normPathPtr) { return -1; } if (types) { - dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR; - mounts = (types->type == TCL_GLOB_TYPE_MOUNT); + wanted = types->type; + if ((wanted & TCL_GLOB_TYPE_MOUNT) && (wanted != TCL_GLOB_TYPE_MOUNT)) { + if (interp) { + Tcl_SetResult(interp, + "Internal error: TCL_GLOB_TYPE_MOUNT should not " + "be set in conjunction with other glob types.", + TCL_STATIC); + } + return TCL_ERROR; + } + if ((wanted & (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE | + TCL_GLOB_TYPE_MOUNT)) == 0) { + /* Not looking for files,dirs,mounts. zipfs cannot have others */ + return TCL_OK; + } + wanted &= + (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE | TCL_GLOB_TYPE_MOUNT); + } + else { + wanted = TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE; } /* @@ -5590,11 +5609,14 @@ ZipFSMatchInDirectoryProc( * Are we globbing the mount points? */ - if (mounts) { + if (wanted & TCL_GLOB_TYPE_MOUNT) { ZipFSMatchMountPoints(result, normPathPtr, pattern, prefixBuf); goto end; } + /* Should not reach here unless at least one of DIR or FILE is set */ + assert(wanted & (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE)); + /* Does the path exist in the hash table? */ z = ZipFSLookup(path); if (z) { @@ -5605,8 +5627,9 @@ ZipFSMatchInDirectoryProc( if (!pattern || (pattern[0] == '\0')) { /* TODO - can't seem to get to this code from script for tests. */ /* Follow logic of what tclUnixFile.c does */ - if ((dirOnly < 0) || (!dirOnly && !z->isDirectory) || - (dirOnly && z->isDirectory)) { + if ((wanted == (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE)) || + (wanted == TCL_GLOB_TYPE_DIR && z->isDirectory) || + (wanted == TCL_GLOB_TYPE_FILE && !z->isDirectory)) { Tcl_ListObjAppendElement(NULL, result, pathPtr); } goto end; @@ -5615,7 +5638,7 @@ ZipFSMatchInDirectoryProc( /* Not in the hash table but could be an intermediate dir in a mount */ if (!pattern || (pattern[0] == '\0')) { /* TODO - can't seem to get to this code from script for tests. */ - if (dirOnly && ContainsMountPoint(path, len)) { + if ((wanted & TCL_GLOB_TYPE_DIR) && ContainsMountPoint(path, len)) { Tcl_ListObjAppendElement(NULL, result, pathPtr); } goto end; @@ -5654,20 +5677,21 @@ ZipFSMatchInDirectoryProc( hPtr = Tcl_NextHashEntry(&search)) { z = (ZipEntry *)Tcl_GetHashValue(hPtr); - if ((dirOnly >= 0) && ((dirOnly && !z->isDirectory) || - (!dirOnly && z->isDirectory))) { - continue; - } - 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); - assert(notDuplicate); - AppendWithPrefix(result, prefixBuf, z->name + strip, -1); + if ((wanted == (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_FILE)) || + (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); + assert(notDuplicate); + AppendWithPrefix(result, prefixBuf, z->name + strip, -1); + } } } } - if (dirOnly) { + if (wanted & TCL_GLOB_TYPE_DIR) { /* * Also check paths that are ancestors of a mount. e.g. glob * //zipfs:/a/? with mount at //zipfs:/a/b/c. Also have to be diff --git a/tests/zipfs.test b/tests/zipfs.test index d8817f8..8cf10c8 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -1447,7 +1447,14 @@ namespace eval test_ns_zipfs { testzipfsglob basic-dir-tails $basicMounts [list -tails -dir $defMountPt *] [list test testdir] testzipfsglob basic-type-d $basicMounts [list -type d $defMountPt/*] [zipfspathsmt $defMountPt testdir] testzipfsglob basic-type-f $basicMounts [list -type f $defMountPt/*] [zipfspathsmt $defMountPt test] - testzipfsglob basic-path $basicMounts [list -path $defMountPt/t *d*] [zipfspathsmt $defMountPt testdir] + testzipfsglob basic-type-d-f $basicMounts [list -type {d f} $defMountPt/*] [zipfspathsmt $defMountPt test testdir] + testzipfsglob basic-type-l $basicMounts [list -type l $defMountPt/*] {} + foreach type {b c l p s} { + testzipfsglob basic-type-$type $basicMounts [list -type $type $defMountPt/*] {} + 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] + } + testzipfsglob basic-path $basicMounts [list -path $defMountPt/t *d*] [zipfspathsmt $defMountPt testdir] testzipfsglob basic-enoent $basicMounts [list $defMountPt/x*] "no files matched glob pattern \"$defMountPt/x*\"" -returnCodes error testzipfsglob basic-enoent-ok $basicMounts [list -nocomplain $defMountPt/x*] {} @@ -1464,6 +1471,7 @@ namespace eval test_ns_zipfs { testzipfsglob root-type-d-1 $rootMounts [list -type d [zipfs root]*] [zipfspaths $::zipLibTop testdir] -constraints zipfslib testzipfsglob root-type-d-2 $rootMounts [list -type d [zipfs root]*] [zipfspaths testdir] -constraints !zipfslib testzipfsglob root-type-f $rootMounts [list -type f [zipfs root]*] [zipfspaths test] + testzipfsglob root-type-d-f $rootMounts [list -type {d f} [zipfs root]*] [zipfspaths test testdir] -constraints !zipfslib testzipfsglob root-path $rootMounts [list -path [zipfs root]t *d*] [zipfspaths testdir] testzipfsglob root-enoent $rootMounts [list [zipfs root]x*] {no files matched glob pattern "//zipfs:/x*"} -returnCodes error testzipfsglob root-enoent-ok $rootMounts [list -nocomplain [zipfs root]x*] {} -- cgit v0.12 From 7671f188fc0e0907f2c3c1ca61c94c18d4c159e5 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 19 Jan 2024 14:59:53 +0000 Subject: Fix compiler warning --- generic/tclZipfs.c | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index cbfa48b..6f014eb 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -5556,10 +5556,9 @@ ZipFSMatchInDirectoryProc( wanted = types->type; if ((wanted & TCL_GLOB_TYPE_MOUNT) && (wanted != TCL_GLOB_TYPE_MOUNT)) { if (interp) { - Tcl_SetResult(interp, + ZIPFS_ERROR(interp, "Internal error: TCL_GLOB_TYPE_MOUNT should not " - "be set in conjunction with other glob types.", - TCL_STATIC); + "be set in conjunction with other glob types."); } return TCL_ERROR; } -- cgit v0.12 From 64444fbc7292e0bd16780baa8567e90e41f8904b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 20 Jan 2024 11:23:54 +0000 Subject: Fix failing zipfs testcases --- tests/zipfs.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/zipfs.test b/tests/zipfs.test index 8cf10c8..69c682e 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -1448,9 +1448,9 @@ namespace eval test_ns_zipfs { testzipfsglob basic-type-d $basicMounts [list -type d $defMountPt/*] [zipfspathsmt $defMountPt testdir] testzipfsglob basic-type-f $basicMounts [list -type f $defMountPt/*] [zipfspathsmt $defMountPt test] testzipfsglob basic-type-d-f $basicMounts [list -type {d f} $defMountPt/*] [zipfspathsmt $defMountPt test testdir] - testzipfsglob basic-type-l $basicMounts [list -type l $defMountPt/*] {} + 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/*] {} + testzipfsglob basic-type-$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 145a2574d993bba4942edc57ebfbf4d1ec9314af Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 21 Jan 2024 16:26:40 +0000 Subject: Optimize Tcl_UniCharIsControl(). Don't worry about range >= U+F0000, that's for TCL_UTF_MAX>3, which is unsupported for 8.6. --- generic/regc_locale.c | 3 +-- generic/tclUtf.c | 8 +------- 2 files changed, 2 insertions(+), 9 deletions(-) diff --git a/generic/regc_locale.c b/generic/regc_locale.c index 449cff6..c0ae530 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -302,8 +302,7 @@ static const crange controlRangeTable[] = { {0x202A, 0x202E}, {0x2060, 0x2064}, {0x2066, 0x206F}, {0xE000, 0xF8FF}, {0xFFF9, 0xFFFB} #if CHRBITS > 16 - ,{0x13430, 0x1343F}, {0x1BCA0, 0x1BCA3}, {0x1D173, 0x1D17A}, {0xE0020, 0xE007F}, - {0xF0000, 0xFFFFD}, {0x100000, 0x10FFFD} + ,{0x13430, 0x1343F}, {0x1BCA0, 0x1BCA3}, {0x1D173, 0x1D17A}, {0xE0020, 0xE007F} #endif }; diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 196c5fb..736da66 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -1805,13 +1805,7 @@ Tcl_UniCharIsControl( if (UNICODE_OUT_OF_RANGE(ch)) { /* Clear away extension bits, if any */ ch &= 0x1FFFFF; - if ((ch == 0xE0001) || ((ch >= 0xE0020) && (ch <= 0xE007F))) { - return 1; - } - if ((ch >= 0xF0000) && ((ch & 0xFFFF) <= 0xFFFD)) { - return 1; - } - return 0; + return ((ch == 0xE0001) || ((unsigned)(ch - 0xE0020) <= 0x5F)); } #endif return ((CONTROL_BITS >> GetCategory(ch)) & 1); -- cgit v0.12 From 820c8a824a4d79dc69b83bbb329b24e8ca42b845 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 21 Jan 2024 17:48:32 +0000 Subject: Clean up of docs --- doc/after.n | 5 ++ doc/apply.n | 6 +- doc/array.n | 25 +++++++ doc/binary.n | 4 ++ doc/callback.n | 4 +- doc/chan.n | 200 +++++++++++++++++++++++++++++---------------------- doc/class.n | 3 + doc/classvariable.n | 2 +- doc/clock.n | 131 ++++++++++++++++++++++++++------- doc/concat.n | 16 +++-- doc/configurable.n | 13 +++- doc/cookiejar.n | 26 ++++--- doc/coroutine.n | 4 +- doc/dde.n | 12 ++++ doc/define.n | 34 ++++++++- doc/dict.n | 24 +++++++ doc/encoding.n | 43 ++++++----- doc/exec.n | 2 +- doc/fconfigure.n | 18 ++--- doc/fcopy.n | 2 +- doc/file.n | 48 +++++++++++-- doc/glob.n | 6 +- doc/history.n | 20 +++++- doc/http.n | 186 +++++++++++++++++++++++++++-------------------- doc/idna.n | 22 +++--- doc/info.n | 70 ++++++++++++++++-- doc/interp.n | 90 +++++++++++++++-------- doc/library.n | 26 +++++++ doc/link.n | 2 +- doc/lseq.n | 2 +- doc/mathfunc.n | 109 ++++++++++++++++++---------- doc/mathop.n | 71 ++++++++++++------ doc/memory.n | 20 ++++-- doc/msgcat.n | 58 +++++++++------ doc/namespace.n | 40 ++++++++--- doc/object.n | 6 ++ doc/open.n | 22 +++--- doc/package.n | 17 ++++- doc/platform.n | 3 + doc/platform_shell.n | 6 ++ doc/prefix.n | 11 +-- doc/process.n | 4 ++ doc/refchan.n | 33 ++++++--- doc/regexp.n | 2 +- doc/registry.n | 9 ++- doc/regsub.n | 2 +- doc/return.n | 2 +- doc/safe.n | 75 +++++++++++++------ doc/self.n | 9 +++ doc/string.n | 31 ++++++-- doc/switch.n | 4 +- doc/tcltest.n | 55 +++++++++++--- doc/tclvars.n | 16 +++++ doc/tm.n | 5 ++ doc/trace.n | 7 +- doc/transchan.n | 8 +++ doc/vwait.n | 10 +-- doc/zipfs.n | 51 ++++++++----- doc/zlib.n | 23 +++++- 59 files changed, 1266 insertions(+), 489 deletions(-) diff --git a/doc/after.n b/doc/after.n index 1a814e0..5d64cb6 100644 --- a/doc/after.n +++ b/doc/after.n @@ -29,6 +29,7 @@ after \- Execute a command after a time delay This command is used to delay execution of the program or to execute a command in background sometime in the future. It has several forms, depending on the first argument to the command: +.\" METHOD: .TP \fBafter \fIms\fR . @@ -37,6 +38,7 @@ A negative number is treated as 0. The command sleeps for \fIms\fR milliseconds and then returns. While the command is sleeping the application does not respond to events. +.\" METHOD: .TP \fBafter \fIms \fR?\fIscript script script ...\fR? . @@ -56,6 +58,7 @@ to cancel the delayed command using \fBafter cancel\fR. A \fIms\fR value of 0 (or negative) queues the event immediately with priority over other event types (if not installed withn an event proc, which will wait for next round of events). +.\" METHOD: cancel .TP \fBafter cancel \fIid\fR . @@ -74,6 +77,7 @@ separators (just as in the \fBconcat\fR command). If there is a pending command that matches the string, it is canceled and will never be executed; if no such command is currently pending then the \fBafter cancel\fR command has no effect. +.\" METHOD: idle .TP \fBafter idle \fIscript \fR?\fIscript script ...\fR? . @@ -87,6 +91,7 @@ to cancel the delayed command using \fBafter cancel\fR. If an error occurs while executing the script then the background error will be reported by the command registered with \fBinterp bgerror\fR. +.\" METHOD: info .TP \fBafter info \fR?\fIid\fR? . diff --git a/doc/apply.n b/doc/apply.n index aeb2227..154ddff 100644 --- a/doc/apply.n +++ b/doc/apply.n @@ -44,18 +44,18 @@ interpreted relative to the global namespace even if its name does not start with .QW :: . .PP -The semantics of \fBapply\fR can also be described by: +The semantics of \fBapply\fR can also be described by approximately this: .PP .CS proc apply {fun args} { set len [llength $fun] if {($len < 2) || ($len > 3)} { - error "can't interpret \e"$fun\e" as anonymous function" + error "can't interpret \e"$fun\e" as anonymous function" } lassign $fun argList body ns set name ::$ns::[getGloballyUniqueName] set body0 { - rename [lindex [info level 0] 0] {} + rename [lindex [info level 0] 0] {} } proc $name $argList ${body0}$body set code [catch {uplevel 1 $name $args} res opt] diff --git a/doc/array.n b/doc/array.n index 268597d..6c63366 100644 --- a/doc/array.n +++ b/doc/array.n @@ -23,8 +23,10 @@ Unless otherwise specified for individual commands below, The \fIoption\fR argument determines what action is carried out by the command. The legal \fIoptions\fR (which may be abbreviated) are: +.\" METHOD: anymore .TP \fBarray anymore \fIarrayName searchId\fR +. Returns 1 if there are any more elements left to be processed in an array search, 0 if all elements have already been returned. @@ -35,6 +37,7 @@ This option is particularly useful if an array has an element with an empty name, since the return value from \fBarray nextelement\fR will not indicate whether the search has been completed. +.\" METHOD: default .TP \fBarray default \fIsubcommand arrayName args...\fR .VS TIP508 @@ -82,19 +85,25 @@ value. Raises an error if \fIarrayName\fR is an existing variable that is not an array. .VE TIP508 .RE +.\" METHOD: donesearch .TP \fBarray donesearch \fIarrayName searchId\fR +. This command terminates an array search and destroys all the state associated with that search. \fISearchId\fR indicates which search on \fIarrayName\fR to destroy, and must have been the return value from a previous invocation of \fBarray startsearch\fR. Returns an empty string. +.\" METHOD: exists .TP \fBarray exists \fIarrayName\fR +. Returns 1 if \fIarrayName\fR is an array variable, 0 if there is no variable by that name or if it is a scalar variable. +.\" METHOD: for .TP \fBarray for {\fIkeyVariable valueVariable\fB} \fIarrayName body\fP +. The first argument is a two element list of variable names for the key and value of each entry in the array. The second argument is the array name to iterate over. The third argument is the body to execute @@ -102,8 +111,10 @@ for each key and value returned. The ordering of the returned keys is undefined. If an array element is deleted or a new array element is inserted during the \fIarray for\fP process, the command will terminate with an error. +.\" METHOD: get .TP \fBarray get \fIarrayName\fR ?\fIpattern\fR? +. Returns a list containing pairs of elements. The first element in each pair is the name of an element in \fIarrayName\fR and the second element of each pair is the value of the @@ -118,8 +129,10 @@ the array contains no elements, then an empty list is returned. If traces on the array modify the list of elements, the elements returned are those that exist both before and after the call to \fBarray get\fR. +.\" METHOD: names .TP \fBarray names \fIarrayName\fR ?\fImode\fR? ?\fIpattern\fR? +. Returns a list containing the names of all of the elements in the array that match \fIpattern\fR. \fIMode\fR may be one of \fB\-exact\fR, \fB\-glob\fR, or \fB\-regexp\fR. If specified, \fImode\fR @@ -132,8 +145,10 @@ If \fIpattern\fR is omitted then the command returns all of the element names in the array. If there are no (matching) elements in the array, or if \fIarrayName\fR is not the name of an array variable, then an empty string is returned. +.\" METHOD: nextelement .TP \fBarray nextelement \fIarrayName searchId\fR +. Returns the name of the next element in \fIarrayName\fR, or an empty string if all elements of \fIarrayName\fR have already been returned in this search. The \fIsearchId\fR @@ -143,8 +158,10 @@ Warning: if elements are added to or deleted from the array, then all searches are automatically terminated just as if \fBarray donesearch\fR had been invoked; this will cause \fBarray nextelement\fR operations to fail for those searches. +.\" METHOD: set .TP \fBarray set \fIarrayName list\fR +. Sets the values of one or more elements in \fIarrayName\fR. \fIlist\fR must have a form like that returned by \fBarray get\fR, consisting of an even number of elements. @@ -154,13 +171,17 @@ is used as a new value for that array element. If the variable \fIarrayName\fR does not already exist and \fIlist\fR is empty, \fIarrayName\fR is created with an empty array value. +.\" METHOD: size .TP \fBarray size \fIarrayName\fR +. Returns a decimal string giving the number of elements in the array. If \fIarrayName\fR is not the name of an array then 0 is returned. +.\" METHOD: startsearch .TP \fBarray startsearch \fIarrayName\fR +. This command initializes an element-by-element search through the array given by \fIarrayName\fR, such that invocations of the \fBarray nextelement\fR command will return the names of the @@ -175,14 +196,18 @@ It is currently more efficient and easier to use either the \fBarray get\fR or \fBarray names\fR, together with \fBforeach\fR, to iterate over all but very large arrays. See the examples below for how to do this. +.\" METHOD: statistics .TP \fBarray statistics \fIarrayName\fR +. Returns statistics about the distribution of data within the hashtable that represents the array. This information includes the number of entries in the table, the number of buckets, and the utilization of the buckets. +.\" METHOD: unset .TP \fBarray unset \fIarrayName\fR ?\fIpattern\fR? +. Unsets all of the elements in the array that match \fIpattern\fR (using the matching rules of \fBstring match\fR). If \fIarrayName\fR is not the name of an array variable or there are no matching elements in the array, no diff --git a/doc/binary.n b/doc/binary.n index 864b0f9..8793b2f 100644 --- a/doc/binary.n +++ b/doc/binary.n @@ -40,6 +40,8 @@ done by other Tcl commands (respectively \fBstring range\fR, binary string in Tcl is merely one where all the characters it contains are in the range \eu0000\-\eu00FF. .SH "BINARY ENCODE AND DECODE" +.\" METHOD: decode +.\" METHOD: encode .PP When encoding binary data as a readable string, the starting binary data is passed to the \fBbinary encode\fR command, together with the name of the @@ -134,6 +136,7 @@ Note that neither the encoder nor the decoder handle the header and footer of the uuencode format. .RE .SH "BINARY FORMAT" +.\" METHOD: format .PP The \fBbinary format\fR command generates a binary string whose layout is specified by the \fIformatString\fR and whose contents come from @@ -607,6 +610,7 @@ will return .CE .RE .SH "BINARY SCAN" +.\" METHOD: scan .PP The \fBbinary scan\fR command parses fields from a binary string, returning the number of conversions performed. \fIString\fR gives the diff --git a/doc/callback.n b/doc/callback.n index 3ab81ac..c96b23b 100644 --- a/doc/callback.n +++ b/doc/callback.n @@ -14,8 +14,8 @@ callback, mymethod \- generate callbacks to methods .nf package require tcl::oo -\fBcallback\fR \fImethodName\fR ?\fIarg ...\fR? -\fBmymethod\fR \fImethodName\fR ?\fIarg ...\fR? +\fBcallback\fI methodName\fR ?\fIarg ...\fR? +\fBmymethod\fI methodName\fR ?\fIarg ...\fR? .fi .BE .SH DESCRIPTION diff --git a/doc/chan.n b/doc/chan.n index 6f30379..2964eff 100644 --- a/doc/chan.n +++ b/doc/chan.n @@ -21,6 +21,7 @@ otherwise manipulating channels, e.g. those created by \fBopen\fR and which correspond respectively to the standard input, output, and error streams of the process. Any unique abbreviation for \fIoperation\fR is acceptable. Available operations are: +.\" METHOD: blocked .TP \fBchan blocked \fIchannelName\fR . @@ -28,6 +29,7 @@ Returns 1 when the channel is in non-blocking mode and the last input operation on the channel failed because it would have otherwise caused the process to block, and 0 otherwise. Each Tcl channel is in blocking mode unless configured otherwise. +.\" METHOD: close .TP \fBchan close \fIchannelName\fR ?\fIdirection\fR? . @@ -84,6 +86,7 @@ switch them back to blocking or (b) use the environment variable .QW \fB0\fR restores the previous behavior. .RE +.\" METHOD: configure .TP \fBchan configure \fIchannelName\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?... . @@ -103,7 +106,7 @@ channel may provide additional options. Those options are described in the relevant documentation. For example, additional options are documented for \fBsocket\fR, and also for serial devices at \fBopen\fR. .TP -\fB\-blocking\fR \fIboolean\fR +\fB\-blocking\fI boolean\fR . If \fB\-blocking\fR is set to \fBtrue\fR, which is the default, reading from or writing to the channel may cause the process to block indefinitely. Otherwise, @@ -113,7 +116,7 @@ generally requires that the event loop is entered, e.g. by calling \fBTcl_DoOneEvent\fR or \fBvwait\fR or by using Tk, to give Tcl a chance to process events on the channel. .TP -\fB\-buffering\fR \fInewValue\fR +\fB\-buffering\fI newValue\fR . If \fInewValue\fR is \fBfull\fR, which is the default, output is buffered until the internal buffer is full or until \fBchan flush\fR is called. If @@ -123,7 +126,7 @@ every output operation. For \fBstdin\fR, \fBstdout\fR, and channels that connect to terminal-like devices, the default value is \fBline\fR. For \fBstderr\fR the default value is \fBnone\fR. .TP -\fB\-buffersize\fR \fInewSize\fR +\fB\-buffersize\fI newSize\fR . \fInewSize\fR, an integer no greater than one million, is the size in bytes of any input or output buffers subsequently allocated for this channel. @@ -145,7 +148,7 @@ which returns the platform- and locale-dependent system encoding used to interface with the operating system, .RE .TP -\fB\-eofchar\fR \fIchar\fR +\fB\-eofchar\fI char\fR . \fIchar\fR signals the end of the data when it is encountered in the input. If \fIchar\fR is the empty string, there is no special character that marks @@ -155,7 +158,7 @@ The default value is the empty string. The acceptable range is \ex01 - \ex7F. A value outside this range results in an error. .VS "TCL8.7 TIP656" .TP -\fB\-profile\fR \fIprofile\fR +\fB\-profile\fI profile\fR . Specifies the encoding profile to be used on the channel. The encoding transforms in use for the channel's input and output will then be subject to the @@ -164,7 +167,7 @@ rules of that profile. Any failures will result in a channel error. See profiles. .VE "TCL8.7 TIP656" .TP -\fB\-translation\fR \fItranslation\fR +\fB\-translation\fI translation\fR .TP \fB\-translation\fR \fB{\fIinTranslation outTranslation\fB}\fR . @@ -232,6 +235,7 @@ translations occur during either input or output. This translation is typically used on UNIX platforms, .RE .RE +.\" METHOD: copy .TP \fBchan copy \fIinputChan outputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR? . @@ -265,90 +269,15 @@ closed all data already queued is written to \fIoutputChan\fR. There should be no event handler established for \fIinputChan\fR because it may become readable during a background copy. An attempt to read or write from within an event handler results result in the error, "channel busy". Any -wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) results +wrong-sided I/O attempted (by a \fBchan event\fR handler or otherwise) results in a .QW "channel busy" error. .PP .PP .IP \fBEXAMPLES\fR -.PP -The first example transfers the contents of one channel exactly to -another. Note that when copying one file to another, it is better to -use \fBfile copy\fR which also copies file metadata (e.g. the file -access permissions) where possible. -.PP -.CS -fconfigure $in -translation binary -fconfigure $out -translation binary -\fBfcopy\fR $in $out -.CE -.PP -This second example shows how the callback gets -passed the number of bytes transferred. -It also uses vwait to put the application into the event loop. -Of course, this simplified example could be done without the command -callback. -.PP -.CS -proc Cleanup {in out bytes {error {}}} { - global total - set total $bytes - close $in - close $out - if {[string length $error] != 0} { - # error occurred during the copy - } -} -set in [open $file1] -set out [socket $server $port] -\fBfcopy\fR $in $out -command [list Cleanup $in $out] -vwait total -.CE -.PP -The third example copies in chunks and tests for end of file -in the command callback. -.PP -.CS -proc CopyMore {in out chunk bytes {error {}}} { - global total done - incr total $bytes - if {([string length $error] != 0) || [eof $in]} { - set done $total - close $in - close $out - } else { - \fBfcopy\fR $in $out -size $chunk \e - -command [list CopyMore $in $out $chunk] - } -} -set in [open $file1] -set out [socket $server $port] -set chunk 1024 -set total 0 -\fBfcopy\fR $in $out -size $chunk \e - -command [list CopyMore $in $out $chunk] -vwait done -.CE -.PP -The fourth example starts an asynchronous, bidirectional fcopy between -two sockets. Those could also be pipes from two [open "|hal 9000" r+] -(though their conversation would remain secret to the script, since -all four fileevent slots are busy). -.PP -.CS -set flows 2 -proc Done {dir args} { - global flows done - puts "$dir is over." - incr flows -1 - if {$flows<=0} {set done 1} -} -\fBfcopy\fR $sok1 $sok2 -command [list Done UP] -\fBfcopy\fR $sok2 $sok1 -command [list Done DOWN] -vwait done -.CE .RE +.\" METHOD: create .TP \fBchan create \fImode cmdPrefix\fR . @@ -388,11 +317,13 @@ is currently in or shared with. \fBchan create\fR is \fBsafe\fR and is accessible to safe interpreters. The handler is always called in the safe interpreter it was created in. .RE +.\" METHOD: eof .TP \fBchan eof \fIchannelName\fR . Returns 1 if the last read on the channel failed because the end of the data was already reached, and 0 otherwise. +.\" METHOD: event .TP \fBchan event \fIchannelName event\fR ?\fIscript\fR? . @@ -407,7 +338,6 @@ deleted when the channel is closed. If \fIscript\fR is omitted, either the existing script or the empty string is returned. The event loop must be entered, e.g. via \fBvwait\fR or \fBupdate\fR, or by using Tk, for handlers to be evaluated. - .RS .PP \fIscript\fR is evaluated at the global level in the interpreter it was @@ -415,7 +345,6 @@ established in. Any resulting error is handled in the background, i.e. via \fBinterp bgerror\fR. In order to prevent an endless loop due to a buggy handler, the handler is deleted if \fIscript\fR returns an error so that it is not evaluated again. - .PP Without an event handler, \fBchan gets\fR or \fBchan read\fR on a channel in blocking mode may block until data becomes available, become during which the @@ -450,12 +379,14 @@ thread can not do any other processing or service any other events. A channel in non-blocking mode allows a thread to carry on with other work and get back to the channel at the right time. .RE +.\" METHOD: flush .TP \fBchan flush \fIchannelName\fR . For a channel in blocking mode, flushes all buffered output to the destination, and then returns. For a channel in non-blocking mode, returns immediately while all buffered output is flushed in the background as soon as possible. +.\" METHOD: gets .TP \fBchan gets \fIchannelName\fR ?\fIvarName\fR? . @@ -477,11 +408,13 @@ indicate that the empty string means that the end of the data has been reached, and \fBchan blocked\fR may indicate that that the empty string means there isn't currently enough data do return the next line. .RE +.\" METHOD: names .TP \fBchan names\fR ?\fIpattern\fR? . Returns a list of all channel names, or if \fIpattern\fR is given, only those names that match according to the rules of \fBstring match\fR. +.\" METHOD: pending .TP \fBchan pending \fImode channelName\fR . @@ -495,8 +428,10 @@ event callback to impose limits on input line length to avoid a potential denial-of-service attack where an extremely long line exceeds the available memory to buffer it. Returns -1 if the channel was not opened for the mode in question. +.\" METHOD: pipe .TP \fBchan pipe\fR +. Creates a pipe, i.e. a readable channel and a writable channel, and returns the names of the readable channel and the writable channel. Data written to the writable channel can be read from the readable channel. Because the pipe is a @@ -526,12 +461,15 @@ issue, either put the channels into non-blocking mode and use event handlers, or place the read channel and the write channel in separate interpreters in separate threads. .RE +.\" METHOD: pop .TP \fBchan pop \fIchannelName\fR +. Removes the topmost transformation handler from the channel if there is one, and closes the channel otherwise. The result is normally the empty string, but may be an error in some situations, e.g. when closing the underlying resource results in an error. +.\" METHOD: postevent .TP \fBchan postevent \fIchannelName eventSpec\fR . @@ -557,13 +495,16 @@ It is an error to post an event that the channel has no interest in. See reflected channel would have been created, and will be evaluated in that interpreter as well. .RE +.\" METHOD: push .TP \fBchan push \fIchannelName cmdPrefix\fR +. Adds a new transformation handler on top of the channel and returns a handle for the transformation. \fIcmdPrefix\fR is the first words of a command that provides the interface documented for \fBtranschan\fR, and transforms data on the channel, It is an error if handler does not support the mode(s) the channel is in. +.\" METHOD: puts .TP \fBchan puts\fR ?\fB\-nonewline\fR? ?\fIchannelName\fR? \fIstring\fR . @@ -593,6 +534,7 @@ non-blocking mode should normally be handled using \fBchan event\fR, where the application only invokes \fBchan puts\fR after being recently notified through a file event handler that the channel is ready for more output data. .RE +.\" METHOD: read .TP \fBchan read \fIchannelName\fR ?\fInumChars\fR? .TP @@ -623,6 +565,7 @@ possible to get a \fBreadable\fR event for each individual character. In blocking mode, \fBchan read\fR blocks forever when reading to the end of the data if there is no \fBchan configure -eofchar\fR configured for the channel. .RE +.\" METHOD: seek .TP \fBchan seek \fIchannelName offset\fR ?\fIorigin\fR? . @@ -653,12 +596,14 @@ empty string or an error if the channel does not support seeking. read\fR, both \fBchan seek\fR and \fBchan tell\fR operate in terms of bytes, not characters, .RE +.\" METHOD: tell .TP \fBchan tell \fIchannelName\fR . Returns the offset in bytes of the current position in the underlying data, or -1 if the channel does not suport seeking. The value can be passed to \fBchan seek\fR to set current position to that offset. +.\" METHOD: truncate .TP \fBchan truncate \fIchannelName\fR ?\fIlength\fR? . @@ -666,6 +611,7 @@ Flushes the channel and truncates the data in the channel to \fIlength\fR bytes, or to the current position in bytes if \fIlength\fR is omitted. . .SH EXAMPLES +.SS "SIMPLE CHANNEL OPERATION EXAMPLES" .PP In the following example a file is opened using the encoding CP1252, which is common on Windows, searches for a string, rewrites that part, and truncates the @@ -736,6 +682,90 @@ proc echoLine {chan clientName} { socket -server connect 12345 vwait forever .CE +.SS "CHANNEL COPY EXAMPLES" +.PP +The first example transfers the contents of one channel exactly to +another. Note that when copying one file to another, it is better to +use \fBfile copy\fR which also copies file metadata (e.g. the file +access permissions) where possible. +.PP +.CS +\fBchan configure\fR $in -translation binary +\fBchan configure\fR $out -translation binary +\fBchan copy\fR $in $out +.CE +.PP +This second example shows how the callback gets +passed the number of bytes transferred. +It also uses vwait to put the application into the event loop. +Of course, this simplified example could be done without the command +callback. +.PP +.CS +proc Cleanup {in out bytes {error {}}} { + global total + set total $bytes + \fBchan close\fR $in + \fBchan close\fR $out + if {$error ne ""} { + # error occurred during the copy + } +} + +set in [open $file1] +set out [socket $server $port] +\fBchan copy\fR $in $out -command [list Cleanup $in $out] +vwait total +.CE +.PP +The third example copies in chunks and tests for end of file +in the command callback. +.PP +.CS +proc CopyMore {in out chunk bytes {error {}}} { + global total done + incr total $bytes + if {($error ne "") || [\fBchan eof\fR $in]} { + set done $total + \fBchan close\fR $in + \fBchan close\fR $out + } else { + \fBchan copy\fR $in $out -size $chunk \e + -command [list CopyMore $in $out $chunk] + } +} + +set in [open $file1] +set out [socket $server $port] +set chunk 1024 +set total 0 +\fBchan copy\fR $in $out -size $chunk \e + -command [list CopyMore $in $out $chunk] +vwait done +.CE +.PP +The fourth example starts an asynchronous, bidirectional copy between +two sockets. Those could also be pipes from two bidirectional pipelines +(e.g., \fI[open "|hal 9000" r+]\fR); the conversation will remain +essentially secret to the script, since all four \fBchan event\fR slots +are busy, though any transforms that are \fBchan push\fRed on the +channels will be able to observe the passing traffic. +.PP +.CS +proc Done {dir args} { + global flows done + \fBchan puts\fR "$dir is over." + incr flows -1 + if {$flows <= 0} { + set done 1 + } +} + +set flows 2 +\fBchan copy\fR $sok1 $sok2 -command [list Done UP] +\fBchan copy\fR $sok2 $sok1 -command [list Done DOWN] +vwait done +.CE .SH "SEE ALSO" close(n), eof(n), fblocked(n), fconfigure(n), fcopy(n), file(n), fileevent(n), flush(n), gets(n), open(n), puts(n), read(n), seek(n), diff --git a/doc/class.n b/doc/class.n index c48f52d..1f4c774 100644 --- a/doc/class.n +++ b/doc/class.n @@ -48,6 +48,7 @@ The \fBoo::class\fR class does not define an explicit destructor. However, when a class is destroyed, all its subclasses and instances are also destroyed, along with all objects that it has been mixed into. .SS "EXPORTED METHODS" +.\" METHOD: create .TP \fIcls \fBcreate \fIname \fR?\fIarg ...\fR? . @@ -58,6 +59,7 @@ a successful result) returning the fully qualified name of the created object (the result of the constructor is ignored). If the constructor fails (i.e. returns a non-OK result) then the object is destroyed and the error message is the result of this method call. +.\" METHOD: new .TP \fIcls \fBnew \fR?\fIarg ...\fR? . @@ -75,6 +77,7 @@ classes should not be created using this method. .SS "NON-EXPORTED METHODS" .PP The \fBoo::class\fR class supports the following non-exported methods: +.\" METHOD: createWithNamespace .TP \fIcls \fBcreateWithNamespace\fI name nsName\fR ?\fIarg ...\fR? . diff --git a/doc/classvariable.n b/doc/classvariable.n index 70d9f13..15b8783 100644 --- a/doc/classvariable.n +++ b/doc/classvariable.n @@ -15,7 +15,7 @@ classvariable \- create link from local variable to variable in class .nf package require tcl::oo -\fBclassvariable\fR \fIvariableName\fR ?\fI...\fR? +\fBclassvariable\fI variableName\fR ?\fI...\fR? .fi .BE .SH DESCRIPTION diff --git a/doc/clock.n b/doc/clock.n index 5157ed1..5d86ed2 100644 --- a/doc/clock.n +++ b/doc/clock.n @@ -10,17 +10,17 @@ clock \- Obtain and manipulate dates and times .SH "SYNOPSIS" package require \fBTcl 8.5-\fR .sp -\fBclock add\fR \fItimeVal\fR ?\fIcount unit...\fR? ?\fI\-option value\fR? +\fBclock add\fI timeVal\fR ?\fIcount unit...\fR? ?\fI\-option value\fR? .sp \fBclock clicks\fR ?\fI\-option\fR? .sp -\fBclock format\fR \fItimeVal\fR ?\fI\-option value\fR...? +\fBclock format\fI timeVal\fR ?\fI\-option value\fR...? .sp \fBclock microseconds\fR .sp \fBclock milliseconds\fR .sp -\fBclock scan\fR \fIinputString\fR ?\fI\-option value\fR...? +\fBclock scan\fI inputString\fR ?\fI\-option value\fR...? .sp \fBclock seconds\fR .sp @@ -30,16 +30,21 @@ package require \fBTcl 8.5-\fR The \fBclock\fR command performs several operations that obtain and manipulate values that represent times. The command supports several subcommands that determine what action is carried out by the command. +.\" METHOD: add .TP -\fBclock add\fR \fItimeVal\fR ?\fIcount unit...\fR? ?\fI\-option value\fR? +\fBclock add\fI timeVal\fR ?\fIcount unit...\fR? ?\fI\-option value\fR? +. Adds a (possibly negative) offset to a time that is expressed as an integer number of seconds. See \fBCLOCK ARITHMETIC\fR for a full description. +.\" METHOD: clicks .TP \fBclock clicks\fR ?\fI\-option\fR? +. If no \fI\-option\fR argument is supplied, returns a high-resolution time value as a system-dependent integer value. The unit of the value is system-dependent but should be the highest resolution clock available -on the system such as a CPU cycle counter. See \fBHIGH RESOLUTION TIMERS\fR for a full description. +on the system such as a CPU cycle counter. +See \fBHIGH RESOLUTION TIMERS\fR for a full description. .RS .PP If the \fI\-option\fR argument is \fB\-milliseconds\fR, then the command @@ -52,32 +57,45 @@ is synonymous with \fBclock microseconds\fR (see below). This usage is obsolete, and \fBclock microseconds\fR is to be considered the preferred way of obtaining a count of microseconds. .RE +.\" METHOD: format .TP -\fBclock format\fR \fItimeVal\fR ?\fI\-option value\fR...? +\fBclock format\fI timeVal\fR ?\fI\-option value\fR...? +. Formats a time that is expressed as an integer number of seconds into a format intended for consumption by users or external programs. See \fBFORMATTING TIMES\fR for a full description. +.\" METHOD: microseconds .TP \fBclock microseconds\fR -Returns the current time as an integer number of microseconds. See \fBHIGH RESOLUTION TIMERS\fR for a full description. +. +Returns the current time as an integer number of microseconds. +See \fBHIGH RESOLUTION TIMERS\fR for a full description. +.\" METHOD: milliseconds .TP \fBclock milliseconds\fR -Returns the current time as an integer number of milliseconds. See \fBHIGH RESOLUTION TIMERS\fR for a full description. +. +Returns the current time as an integer number of milliseconds. +See \fBHIGH RESOLUTION TIMERS\fR for a full description. +.\" METHOD: scan .TP -\fBclock scan\fR \fIinputString\fR ?\fI\-option value\fR...? +\fBclock scan\fI inputString\fR ?\fI\-option value\fR...? +. Scans a time that is expressed as a character string and produces an integer number of seconds. See \fBSCANNING TIMES\fR for a full description. +.\" METHOD: seconds .TP \fBclock seconds\fR Returns the current time as an integer number of seconds. .SS "PARAMETERS" .TP \fIcount\fR +. An integer representing a count of some unit of time. See \fBCLOCK ARITHMETIC\fR for the details. .TP \fItimeVal\fR +. An integer value passed to the \fBclock\fR command that represents an absolute time as a number of seconds from the \fIepoch time\fR of 1 January 1970, 00:00 UTC. Note that the count of seconds does not @@ -88,6 +106,7 @@ back in sync with UTC; its data model does not represent minutes that have 59 or 61 seconds. .TP \fIunit\fR +. One of the words, \fBseconds\fR, \fBminutes\fR, \fBhours\fR, \fBdays\fR, \fBweekdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR. Used in conjunction with \fIcount\fR to identify an interval of time, @@ -95,11 +114,13 @@ for example, \fI3 seconds\fR or \fI1 year\fR. .SS "OPTIONS" .TP \fB\-base\fR time +. Specifies that any relative times present in a \fBclock scan\fR command are to be given relative to \fItime\fR. \fItime\fR must be expressed as a count of nominal seconds from the epoch time of 1 January 1970, 00:00 UTC. .TP \fB\-format\fR format +. Specifies the desired output format for \fBclock format\fR or the expected input format for \fBclock scan\fR. The \fIformat\fR string consists of any number of characters other than the per-cent sign @@ -121,15 +142,17 @@ is requested; see \fBFREE FORM SCAN\fR for a description of what happens. .RE .TP \fB\-gmt\fR boolean +. If \fIboolean\fR is true, specifies that a time specified to \fBclock add\fR, \fBclock format\fR or \fBclock scan\fR should be processed in UTC. If \fIboolean\fR is false, the processing defaults to the local time zone. This usage is obsolete; the correct current usage is to specify the UTC time zone with -.QW "\fB\-timezone\fR \fI:UTC\fR" +.QW "\fB\-timezone\fI :UTC\fR" or any of the equivalent ways to specify it. .TP \fB\-locale\fR localeName +. Specifies that locale-dependent scanning and formatting (and date arithmetic for dates preceding the adoption of the Gregorian calendar) is to be done in the locale identified by \fIlocaleName\fR. The locale name may be any of @@ -145,6 +168,7 @@ The effect of locale on clock arithmetic is discussed under .RE .TP \fB\-timezone\fR zoneName +. Specifies that clock arithmetic, formatting, and scanning are to be done according to the rules for the time zone specified by \fIzoneName\fR. The permissible values, and their interpretation, are discussed under @@ -310,9 +334,9 @@ and their interpretation, are described under \fBFORMAT GROUPS\fR. If a \fB\-timezone\fR option is present, the following argument is a string that specifies the time zone in which the date and time are to be formatted. As an alternative to -.QW "\fB\-timezone\fR \fI:UTC\fR" , +.QW "\fB\-timezone\fI :UTC\fR" , the obsolete usage -.QW "\fB\-gmt\fR \fItrue\fR" +.QW "\fB\-gmt\fI true\fR" may be used. See \fBTIME ZONES\fR for the permissible variants for the time zone. .PP @@ -321,14 +345,14 @@ a string that specifies the locale in which the time is to be formatted, in the same format that is used for the \fBmsgcat\fR package. Note that the default, if \fB\-locale\fR is not specified, is the root locale \fB{}\fR rather than the current locale. The current locale may -be obtained by using \fB\-locale\fR \fBcurrent\fR. +be obtained by using \fB\-locale current\fR. In addition, some platforms support a \fBsystem\fR locale that reflects the user's current choices. For instance, on Windows, the format that the user has selected from dates and times in the Control Panel can be obtained by using the \fBsystem\fR locale. On platforms that do not define a user selection of date and time formats -separate from \fBLC_TIME\fR, \fB\-locale\fR \fBsystem\fR is -synonymous with \fB\-locale\fR \fBcurrent\fR. +separate from \fBLC_TIME\fR, \fB\-locale system\fR is +synonymous with \fB\-locale current\fR. .SH "SCANNING TIMES" .PP The \fBclock scan\fR command accepts times that are formatted as @@ -346,8 +370,8 @@ and their interpretation, are described under \fBFORMAT GROUPS\fR. .PP If a \fB\-timezone\fR option is present, the following argument is a string that specifies the time zone in which the date and time -are to be interpreted. As an alternative to \fB\-timezone\fR \fI:UTC\fR, -the obsolete usage \fB\-gmt\fR \fItrue\fR may be used. See +are to be interpreted. As an alternative to \fB\-timezone\fI :UTC\fR, +the obsolete usage \fB\-gmt\fI true\fR may be used. See \fBTIME ZONES\fR for the permissible variants for the time zone. .PP If a \fB\-locale\fR option is present, the following argument is @@ -355,14 +379,14 @@ a string that specifies the locale in which the time is to be interpreted, in the same format that is used for the \fBmsgcat\fR package. Note that the default, if \fB\-locale\fR is not specified, is the root locale \fB{}\fR rather than the current locale. The current locale may -be obtained by using \fB\-locale\fR \fBcurrent\fR. +be obtained by using \fB\-locale current\fR. In addition, some platforms support a \fBsystem\fR locale that reflects the user's current choices. For instance, on Windows, the format that the user has selected from dates and times in the Control Panel can be obtained by using the \fBsystem\fR locale. On platforms that do not define a user selection of date and time formats -separate from \fBLC_TIME\fR, \fB\-locale\fR \fBsystem\fR is -synonymous with \fB\-locale\fR \fBcurrent\fR. +separate from \fBLC_TIME\fR, \fB\-locale system\fR is +synonymous with \fB\-locale current\fR. .PP If a \fB\-base\fR option is present, the following argument is a time (expressed in seconds from the epoch time) that is used as @@ -471,67 +495,79 @@ The following format groups are recognized by the \fBclock scan\fR and \fBclock format\fR commands. .TP \fB%a\fR -On output, produces an abbreviation (\fIe.g.,\fR \fBMon\fR) for the day +. +On output, produces an abbreviation (\fIe.g., \fBMon\fR) for the day of the week in the given locale. On input, matches the name of the day of the week in the given locale (in either abbreviated or full form, or any unique prefix of either form). .TP \fB%A\fR -On output, produces the full name (\fIe.g.,\fR \fBMonday\fR) of the day +. +On output, produces the full name (\fIe.g., \fBMonday\fR) of the day of the week in the given locale. On input, matches the name of the day of the week in the given locale (in either abbreviated or full form, or any unique prefix of either form). .TP \fB%b\fR -On output, produces an abbreviation (\fIe.g.,\fR \fBJan\fR) for the name +. +On output, produces an abbreviation (\fIe.g., \fBJan\fR) for the name of the month in the given locale. On input, matches the name of the month in the given locale (in either abbreviated or full form, or any unique prefix of either form). .TP \fB%B\fR -On output, produces the full name (\fIe.g.,\fR \fBJanuary\fR) +. +On output, produces the full name (\fIe.g., \fBJanuary\fR) of the month in the given locale. On input, matches the name of the month in the given locale (in either abbreviated or full form, or any unique prefix of either form). .TP \fB%c\fR +. On output, produces a localized representation of date and time of day; the localized representation is expected to use the Gregorian calendar. On input, matches whatever \fB%c\fR produces. .TP \fB%C\fR +. On output, produces the number of the century in Indo-Arabic numerals. On input, matches one or two digits, possibly with leading whitespace, that are expected to be the number of the century. .TP \fB%d\fR +. On output, produces the number of the day of the month, as two decimal digits. On input, matches one or two digits, possibly with leading whitespace, that are expected to be the number of the day of the month. .TP \fB%D\fR +. This format group is synonymous with \fB%m/%d/%Y\fR. It should be used only in exchanging data within the \fBen_US\fR locale, since other locales typically do not use this order for the fields of the date. .TP \fB%e\fR +. On output, produces the number of the day of the month, as one or two decimal digits (with a leading blank for one-digit dates). On input, matches one or two digits, possibly with leading whitespace, that are expected to be the number of the day of the month. .TP \fB%Ec\fR +. On output, produces a locale-dependent representation of the date and time of day in the locale's alternative calendar. On input, matches whatever \fB%Ec\fR produces. The locale's alternative calendar need not be the Gregorian calendar. .TP \fB%EC\fR +. On output, produces a locale-dependent name of an era in the locale's alternative calendar. On input, matches the name of the era or any unique prefix. .TP \fB%EE\fR +. On output, produces the string \fBB.C.E.\fR or \fBC.E.\fR, or a string of the same meaning in the locale, to indicate whether \fB%Y\fR refers to years before or after Year 1 of the Common Era. On input, accepts @@ -541,54 +577,65 @@ whether \fB%Y\fR refers to years before or after Year 1 of the Common Era. .TP \fB%Ex\fR +. On output, produces a locale-dependent representation of the date in the locale's alternative calendar. On input, matches whatever \fB%Ex\fR produces. The locale's alternative calendar need not be the Gregorian calendar. .TP \fB%EX\fR +. On output, produces a locale-dependent representation of the time of day in the locale's alternative numerals. On input, matches whatever \fB%EX\fR produces. .TP \fB%Ey\fR +. On output, produces a locale-dependent number of the year of the era in the locale's alternative calendar and numerals. On input, matches such a number. .TP \fB%EY\fR +. On output, produces a representation of the year in the locale's alternative calendar and numerals. On input, matches what \fB%EY\fR produces. Often synonymous with \fB%EC%Ey\fR. .TP \fB%g\fR +. On output, produces a two-digit year number suitable for use with the week-based ISO8601 calendar; that is, the year number corresponds to the week number produced by \fB%V\fR. On input, accepts such a two-digit year number, possibly with leading whitespace. .TP \fB%G\fR +. On output, produces a four-digit year number suitable for use with the week-based ISO8601 calendar; that is, the year number corresponds to the week number produced by \fB%V\fR. On input, accepts such a four-digit year number, possibly with leading whitespace. .TP \fB%h\fR +. This format group is synonymous with \fB%b\fR. .TP \fB%H\fR +. On output, produces a two-digit number giving the hour of the day (00-23) on a 24-hour clock. On input, accepts such a number. .TP \fB%I\fR +. On output, produces a two-digit number giving the hour of the day (12-11) on a 12-hour clock. On input, accepts such a number. .TP \fB%j\fR +. 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 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 @@ -597,30 +644,36 @@ Julian calendar. The epoch time of 1 January 1970 corresponds to Julian Day Number 2440588. .TP \fB%k\fR +. On output, produces a one- or two-digit number giving the hour of the day (0-23) on a 24-hour clock. On input, accepts such a number. .TP \fB%l\fR +. On output, produces a one- or two-digit number giving the hour of the day (12-11) on a 12-hour clock. On input, accepts such a number. .TP \fB%m\fR +. On output, produces the number of the month (01-12) with exactly two digits. On input, accepts two digits and interprets them as the number of the month. .TP \fB%M\fR +. On output, produces the number of the minute of the hour (00-59) with exactly two digits. On input, accepts two digits and interprets them as the number of the minute of the hour. .TP \fB%N\fR +. On output, produces the number of the month (1-12) with one or two digits, and a leading blank for one-digit dates. On input, accepts one or two digits, possibly with leading whitespace, and interprets them as the number of the month. .TP \fB%Od\fR, \fB%Oe\fR, \fB%OH\fR, \fB%OI\fR, \fB%Ok\fR, \fB%Ol\fR, \fB%Om\fR, \fB%OM\fR, \fB%OS\fR, \fB%Ou\fR, \fB%Ow\fR, \fB%Oy\fR +. All of these format groups are synonymous with their counterparts without the .QW \fBO\fR , @@ -628,6 +681,7 @@ except that the string is produced and parsed in the locale-dependent alternative numerals. .TP \fB%p\fR +. On output, produces an indicator for the part of the day, \fBAM\fR or \fBPM\fR, appropriate to the given locale. If the script of the given locale supports multiple letterforms, lowercase is preferred. @@ -635,6 +689,7 @@ On input, matches the representation \fBAM\fR or \fBPM\fR in the given locale, in either case. .TP \fB%P\fR +. On output, produces an indicator for the part of the day, \fBam\fR or \fBpm\fR, appropriate to the given locale. If the script of the given locale supports multiple letterforms, uppercase is preferred. @@ -642,18 +697,23 @@ On input, matches the representation \fBAM\fR or \fBPM\fR in the given locale, in either case. .TP \fB%Q\fR +. This format group is reserved for internal use within the Tcl library. +.\" It's the STARDATE! We're so Enterprise-ready... .TP \fB%r\fR +. On output, produces a locale-dependent time of day representation on a 12-hour clock. On input, accepts whatever \fB%r\fR produces. .TP \fB%R\fR +. On output, the time in 24-hour notation (%H:%M). For a version including the seconds, see \fB%T\fR below. On input, accepts whatever \fB%R\fR produces. .TP \fB%s\fR +. On output, simply formats the \fItimeVal\fR argument as a decimal integer and inserts it into the output string. On input, accepts a decimal integer and uses is as the time value without any further @@ -661,23 +721,28 @@ processing. Since \fB%s\fR uniquely determines a point in time, it overrides all other input formats. .TP \fB%S\fR +. On output, produces a two-digit number of the second of the minute (00-59). On input, accepts two digits and uses them as the second of the minute. .TP \fB%t\fR +. On output, produces a TAB character. On input, matches a TAB character. .TP \fB%T\fR +. Synonymous with \fB%H:%M:%S\fR. .TP \fB%u\fR +. On output, produces the number of the day of the week (\fB1\fR\(->Monday, \fB7\fR\(->Sunday). On input, accepts a single digit and interprets it as the day of the week. Sunday may be either \fB0\fR or \fB7\fR. .TP \fB%U\fR +. On output, produces the ordinal number of the week of the year (00-53). The first Sunday of the year is the first day of week 01. On input accepts two digits which are otherwise ignored. This format @@ -686,6 +751,7 @@ of the week of the year was once common in US banking but is now largely obsolete. See \fB%V\fR for the ISO8601 week number. .TP \fB%V\fR +. On output, produces the number of the ISO8601 week as a two digit number (01-53). Week 01 is the week containing January 4; or the first week of the year containing at least 4 days; or the week containing @@ -694,6 +760,7 @@ equivalent). Each week begins on a Monday. On input, accepts the ISO8601 week number. .TP \fB%w\fR +. On output, produces the ordinal number of the day of the week (Sunday==0; Saturday==6). On input, accepts a single digit and interprets it as the day of the week; Sunday may be represented as @@ -701,6 +768,7 @@ either 0 or 7. Note that \fB%w\fR is not the ISO8601 weekday number, which is produced and accepted by \fB%u\fR. .TP \fB%W\fR +. On output, produces a week number (00-53) within the year; week 01 begins on the first Monday of the year. On input, accepts two digits, which are otherwise ignored. This format group is never used in @@ -708,16 +776,19 @@ determining an input date. It is not the ISO8601 week number; that week is produced and accepted by \fB%V\fR. .TP \fB%x\fR +. On output, produces the date in a locale-dependent representation. On input, accepts whatever \fB%x\fR produces and is used to determine calendar date. .TP \fB%X\fR +. On output, produces the time of day in a locale-dependent representation. On input, accepts whatever \fB%X\fR produces and is used to determine time of day. .TP \fB%y\fR +. On output, produces the two-digit year of the century. On input, accepts two digits, and is used to determine calendar date. The date is presumed to lie between 1938 and 2037 inclusive. Note @@ -725,18 +796,21 @@ that \fB%y\fR does not yield a year appropriate for use with the ISO8601 week number \fB%V\fR; programs should use \fB%g\fR for that purpose. .TP \fB%Y\fR +. On output, produces the four-digit calendar year. On input, accepts four digits and may be used to determine calendar date. Note that \fB%Y\fR does not yield a year appropriate for use with the ISO8601 week number \fB%V\fR; programs should use \fB%G\fR for that purpose. .TP \fB%z\fR +. 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. .TP \fB%Z\fR +. On output, produces the current time zone's name, possibly translated to the given locale. On input, accepts a time zone specifier (see \fBTIME ZONES\fR below) that will be used to determine the @@ -747,6 +821,7 @@ Brazilian Standard Time. It is recommended that date/time strings for use by computers use numeric time zones instead. .TP \fB%%\fR +. On output, produces a literal .QW \fB%\fR character. On input, matches a literal @@ -754,6 +829,7 @@ character. On input, matches a literal character. .TP \fB%+\fR +. Synonymous with .QW "\fB%a %b %e %H:%M:%S %Z %Y\fR" . .SH "TIME ZONES" @@ -766,7 +842,7 @@ A time zone specified inside a string being parsed and matched by a \fB%z\fR or \fB%Z\fR format group. .IP [2] A time zone specified with the \fB\-timezone\fR option to the \fBclock\fR -command (or, equivalently, by \fB\-gmt\fR \fB1\fR). +command (or, equivalently, by \fB\-gmt 1\fR). .IP [3] A time zone specified in an environment variable \fBTCL_TZ\fR. .IP [4] @@ -852,8 +928,9 @@ specification. .SH "FREE FORM SCAN" .PP If the \fBclock scan\fR command is invoked without a \fB\-format\fR -option, then it requests a \fIfree-form scan.\fR \fI -This form of scan is deprecated.\fR The reason for the deprecation +option, then it requests a \fIfree-form scan\fR. +\fIThis form of scan is deprecated.\fR +The reason for the deprecation is that there are too many ambiguities. (Does the string .QW 2000 represent a year, a time of day, or a quantity?) No set of rules diff --git a/doc/concat.n b/doc/concat.n index d10f092..c83d2c4 100644 --- a/doc/concat.n +++ b/doc/concat.n @@ -28,7 +28,7 @@ Although \fBconcat\fR will concatenate lists, flattening them in the process (so giving the following interactive session): .PP .CS -\fI%\fR \fBconcat\fR a b {c d e} {f {g h}} +\fI% \fBconcat\fR a b {c d e} {f {g h}} \fIa b c d e f {g h}\fR .CE .PP @@ -36,7 +36,7 @@ it will also concatenate things that are not lists, as can be seen from this session: .PP .CS -\fI%\fR \fBconcat\fR " a b {c " d " e} f" +\fI% \fBconcat\fR " a b {c " d " e} f" \fIa b {c d e} f\fR .CE .PP @@ -44,14 +44,22 @@ Note also that the concatenation does not remove spaces from the middle of values, as can be seen here: .PP .CS -\fI%\fR \fBconcat\fR "a b c" { d e f } +\fI% \fBconcat\fR "a b c" { d e f } \fIa b c d e f\fR .CE .PP (i.e., there are three spaces between each of the \fBa\fR, the \fBb\fR and the \fBc\fR). +.PP +For \fItrue\fR list concatenation, the \fBlist\fR command should be used with +expansion of each input list: +.PP +.CS +\fI% \fRlist {*}"a b c" {*}{ d e f } +\fIa b c d e f\fR +.CE .SH "SEE ALSO" -append(n), eval(n), join(n) +append(n), eval(n), join(n), list(n) .SH KEYWORDS concatenate, join, list '\" Local Variables: diff --git a/doc/configurable.n b/doc/configurable.n index 0102f8c..07335bd 100644 --- a/doc/configurable.n +++ b/doc/configurable.n @@ -25,8 +25,8 @@ package require TclOO \fB}\fR \fIobjectName \fBconfigure\fR -\fIobjectName \fBconfigure\fR \fI\-prop\fR -\fIobjectName \fBconfigure\fR \fI\-prop value\fR ?\fI\-prop value\fR... +\fIobjectName \fBconfigure\fI \-prop\fR +\fIobjectName \fBconfigure\fI \-prop value\fR ?\fI\-prop value\fR... .fi .SH "CLASS HIERARCHY" .nf @@ -54,6 +54,7 @@ definition command available in definition scripts for the class and instances \fBoo::objdefine\fR) and making a \fBconfigure\fR method available within the instances. .SS "CONFIGURE METHOD" +.\" METHOD: configure .PP The behavior of the \fBconfigure\fR method is modelled after the \fBfconfigure\fR/\fBchan configure\fR command. @@ -74,6 +75,7 @@ method fails, the preceding pairs (if any) will continue to have been applied, and the succeeding pairs (if any) will be not applied. On success, the result of the \fBconfigure\fR method in this mode operation will be an empty string. .SS "PROPERTY DEFINITIONS" +.\" COMMAND: property .PP When a class has been manufactured by the \fBoo::configurable\fR metaclass (or one of its subclasses), it gains an extra definition, \fBproperty\fR. The @@ -143,11 +145,13 @@ The configurable class system is comprised of several pieces. The definition namespaces during object creation that provide the other bits and pieces of machinery. The key pieces of the implementation are enumerated here so that they can be used by other code: +.\" COMMAND: configurable .TP \fBoo::configuresupport::configurable\fR . This is a class that provides the implementation of the \fBconfigure\fR method (described above in \fBCONFIGURE METHOD\fR). +.\" NAMESPACE: configurableclass .TP \fBoo::configuresupport::configurableclass\fR . @@ -156,6 +160,7 @@ This is a namespace that contains the definition dialect that provides the class constructors under normal circumstances), as described above in \fBPROPERTY DEFINITIONS\fR. It \fBnamespace export\fRs its \fBproperty\fR command so that it may be used easily in user definition dialects. +.\" NAMESPACE: configurableobject .TP \fBoo::configuresupport::configurableobject\fR . @@ -173,24 +178,28 @@ slots mean other than that they have unique names, no important order, can be inherited and discovered on classes and instances. .PP These slots, and their intended semantics, are: +.\" METHOD: readableproperties .TP \fBoo::configuresupport::readableproperties\fR . The set of properties of a class (not including those from its superclasses) that may be read from when configuring an instance of the class. This slot can also be read with the \fBinfo class properties\fR command. +.\" METHOD: writableproperties .TP \fBoo::configuresupport::writableproperties\fR . The set of properties of a class (not including those from its superclasses) that may be written to when configuring an instance of the class. This slot can also be read with the \fBinfo class properties\fR command. +.\" METHOD: objreadableproperties .TP \fBoo::configuresupport::objreadableproperties\fR . The set of properties of an object instance (not including those from its classes) that may be read from when configuring the object. This slot can also be read with the \fBinfo object properties\fR command. +.\" METHOD: objwritableproperties .TP \fBoo::configuresupport::objwritableproperties\fR . diff --git a/doc/cookiejar.n b/doc/cookiejar.n index 1391e01..224d488 100644 --- a/doc/cookiejar.n +++ b/doc/cookiejar.n @@ -15,13 +15,13 @@ cookiejar \- Implementation of the Tcl http package cookie jar protocol \fBpackage require\fR \fBcookiejar\fR ?\fB0.1\fR? \fB::http::cookiejar configure\fR ?\fIoptionName\fR? ?\fIoptionValue\fR? -\fB::http::cookiejar create\fR \fIname\fR ?\fIfilename\fR? +\fB::http::cookiejar create\fI name\fR ?\fIfilename\fR? \fB::http::cookiejar new\fR ?\fIfilename\fR? \fIcookiejar\fR \fBdestroy\fR \fIcookiejar\fR \fBforceLoadDomainData\fR -\fIcookiejar\fR \fBgetCookies\fR \fIprotocol host path\fR -\fIcookiejar\fR \fBstoreCookie\fR \fIoptions\fR +\fIcookiejar\fR \fBgetCookies\fI protocol host path\fR +\fIcookiejar\fR \fBstoreCookie\fI options\fR \fIcookiejar\fR \fBlookup\fR ?\fIhost\fR? ?\fIkey\fR? .fi .SH DESCRIPTION @@ -33,6 +33,7 @@ create a cookie jar that manages a particular HTTP session. .PP The database management policy can be controlled at the package level by the \fBconfigure\fR method on the \fB::http::cookiejar\fR class object: +.\" METHOD: configure .TP \fB::http::cookiejar configure\fR ?\fIoptionName\fR? ?\fIoptionValue\fR? . @@ -97,6 +98,7 @@ the database. .PP Cookie jar instances may be made with any of the standard TclOO instance creation methods (\fBcreate\fR or \fBnew\fR). +.\" METHOD: new .TP \fB::http::cookiejar new\fR ?\fIfilename\fR? . @@ -108,27 +110,31 @@ memory, which effectively forces all cookies within it to be session cookies. .SS "INSTANCE METHODS" .PP The following methods are supported on the instances: +.\" METHOD: destroy .TP -\fIcookiejar\fR \fBdestroy\fR +\fIcookiejar \fBdestroy\fR . This is the standard TclOO destruction method. It does \fInot\fR delete the SQLite database if it is written to disk. Callers are responsible for ensuring that the cookie jar is not in use by the http package at the time of destruction. +.\" METHOD: forceLoadDomainData .TP -\fIcookiejar\fR \fBforceLoadDomainData\fR +\fIcookiejar \fBforceLoadDomainData\fR . This method causes the cookie jar to immediately load (and cache) the domain list data. The domain list will be loaded from the \fB\-domainlist\fR configured a the package level if that is enabled, and otherwise will be obtained from the \fB\-domainfile\fR configured at the package level. +.\" METHOD: getCookies .TP -\fIcookiejar\fR \fBgetCookies\fR \fIprotocol host path\fR +\fIcookiejar \fBgetCookies\fI protocol host path\fR . This method obtains the cookies for a particular HTTP request. \fIThis implements the http cookie jar protocol.\fR +.\" METHOD: policyAllow .TP -\fIcookiejar\fR \fBpolicyAllow\fR \fIoperation domain path\fR +\fIcookiejar \fBpolicyAllow\fI operation domain path\fR . This method is called by the \fBstoreCookie\fR method to get a decision on whether to allow \fIoperation\fR to be performed for the \fIdomain\fR and @@ -154,14 +160,16 @@ defined lifetime). The default implementation of this method just returns true, but subclasses of this class may impose their own rules. .RE +.\" METHOD: storeCookie .TP -\fIcookiejar\fR \fBstoreCookie\fR \fIoptions\fR +\fIcookiejar \fBstoreCookie\fI options\fR . This method stores a single cookie from a particular HTTP response. Cookies that fail security checks are ignored. \fIThis implements the http cookie jar protocol.\fR +.\" METHOD: lookup .TP -\fIcookiejar\fR \fBlookup\fR ?\fIhost\fR? ?\fIkey\fR? +\fIcookiejar \fBlookup\fR ?\fIhost\fR? ?\fIkey\fR? . This method looks a cookie by exact host (or domain) matching. If neither \fIhost\fR nor \fIkey\fR are supplied, the list of hosts for which a cookie is diff --git a/doc/coroutine.n b/doc/coroutine.n index 8110628..25ab6ad 100644 --- a/doc/coroutine.n +++ b/doc/coroutine.n @@ -14,7 +14,7 @@ coroutine, yield, yieldto, coroinject, coroprobe \- Create and produce values fr .nf \fBcoroutine \fIname command\fR ?\fIarg...\fR? \fByield\fR ?\fIvalue\fR? -\fByieldto\fR \fIcommand\fR ?\fIarg...\fR? +\fByieldto\fI command\fR ?\fIarg...\fR? \fIname\fR ?\fIvalue...\fR? .sp .VS "8.7, TIP383" @@ -198,7 +198,7 @@ proc juggler {name target {value ""}} { while {$value ne ""} { puts "$name : $value" set value [string range $value 0 end-1] - lassign [\fByieldto\fR \fI$target\fR $value] value + lassign [\fByieldto\fI $target\fR $value] value } } \fBcoroutine\fR j1 juggler Larry [ diff --git a/doc/dde.n b/doc/dde.n index 8316af9..ab6ed80 100644 --- a/doc/dde.n +++ b/doc/dde.n @@ -44,6 +44,7 @@ has the service name \fBExcel\fR. .PP The following commands are a subset of the full Dynamic Data Exchange set of commands. +.\" METHOD: servername .TP \fBdde servername \fR?\fB\-force\fR? ?\fB\-handler \fIproc\fR? ?\fB\-\|\-\fR? ?\fItopic\fR? . @@ -68,6 +69,7 @@ safe interpreter then a \fB\-handler\fR procedure must be defined. The procedure is called with all the arguments provided by the remote call. .RE +.\" METHOD: execute .TP \fBdde execute\fR ?\fB\-async\fR? ?\fB\-binary\fR? \fIservice topic data\fR . @@ -80,11 +82,15 @@ script is run in the application. The \fB\-async\fR option requests asynchronous invocation. The command returns an error message if the script did not run, unless the \fB\-async\fR flag was used, in which case the command returns immediately with no error. +.RS +.PP Without the \fB\-binary\fR option all data will be sent in unicode. For dde clients which don't implement the CF_UNICODE clipboard format, this will automatically be translated to the system encoding. You can use the \fB\-binary\fR option in combination with the result of \fBencoding convertto\fR to send data in any other encoding. +.RE +.\" METHOD: poke .TP \fBdde poke\fR ?\fB\-binary\fR? \fIservice topic item data\fR . @@ -95,11 +101,15 @@ specific but can be a command to the server or the name of a file to work on. The \fIitem\fR is also application specific and is often not used, but it must always be non-null. The \fIdata\fR field is given to the remote application. +.RS +.PP Without the \fB\-binary\fR option all data will be sent in unicode. For dde clients which don't implement the CF_UNICODE clipboard format, this will automatically be translated to the system encoding. You can use the \fB\-binary\fR option in combination with the result of \fBencoding convertto\fR to send data in any other encoding. +.RE +.\" METHOD: request .TP \fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR . @@ -111,6 +121,7 @@ application-specific. The command returns the value of \fIitem\fR as defined in the application. Normally this is interpreted to be a string with terminating null. If \fB\-binary\fR is specified, the result is returned as a byte array. +.\" METHOD: services .TP \fBdde services \fIservice topic\fR . @@ -123,6 +134,7 @@ returned. If \fIservice\fR is non-empty and \fItopic\fR is, all topics for a given service are returned. If both are non-empty, if that service-topic pair currently exists, it is returned; otherwise, an empty string is returned. +.\" METHOD: eval .TP \fBdde eval\fR ?\fB\-async\fR? \fItopic cmd \fR?\fIarg arg ...\fR? . diff --git a/doc/define.n b/doc/define.n index c5e93ac..cb1864c43 100644 --- a/doc/define.n +++ b/doc/define.n @@ -42,6 +42,7 @@ and define a class in one step. .PP The following commands are supported in the \fIdefScript\fR for \fBoo::define\fR, each of which may also be used in the \fIsubcommand\fR form: +.\" METHOD: classmethod .TP \fBclassmethod\fI name\fR ?\fIargList bodyScrip\fR? .VS TIP478 @@ -63,6 +64,7 @@ In a private definition context, the methods as invoked on classes are private. .RE .VE TIP478 +.\" METHOD: constructor .TP \fBconstructor\fI argList bodyScript\fR . @@ -79,6 +81,7 @@ string, the constructor will be deleted. Classes do not need to have a constructor defined. If none is specified, the superclass's constructor will be used instead. .RE +.\" METHOD: destructor .TP \fBdestructor\fI bodyScript\fR . @@ -95,6 +98,7 @@ Note that errors during the evaluation of a destructor \fIare not returned\fR to the code that causes the destruction of an object. Instead, they are passed to the currently-defined \fBbgerror\fR handler. .RE +.\" METHOD: export .TP \fBexport\fI name \fR?\fIname ...\fR? . @@ -103,6 +107,7 @@ This arranges for each of the named methods, \fIname\fR, to be exported class being defined. Note that the methods themselves may be actually defined by a superclass; subclass exports override superclass visibility, and may in turn be overridden by instances. +.\" METHOD: forward .TP \fBforward\fI name cmdName \fR?\fIarg ...\fR? . @@ -122,6 +127,8 @@ If in a private definition context (see the \fBprivate\fR definition command, below), this command creates private forwarded methods. .VE TIP500 .RE +.\" METHOD: initialise +.\" METHOD: initialize .TP \fBinitialise\fI script\fR .TP @@ -131,6 +138,7 @@ This evaluates \fIscript\fR in a context which supports local variables and where the current namespace is the instance namespace of the class object itself. This is useful for setting up, e.g., class-scoped variables. .VE TIP478 +.\" METHOD: method .TP \fBmethod\fI name \fR?\fIoption\fR? \fIargList bodyScript\fR . @@ -155,6 +163,7 @@ below) or if the \fB\-private\fR flag is given for \fIoption\fR, this command creates private procedure-like methods. .VE TIP500 .RE +.\" METHOD: private .TP \fBprivate \fIcmd arg...\fR .TP @@ -174,6 +183,7 @@ commands have no difference in behavior when used in a private definition context. .RE .VE TIP500 +.\" METHOD: self .TP \fBself\fI subcommand arg ...\fR .TP @@ -201,6 +211,7 @@ below), the definitions on the class object will also be made in a private definition context. .VE TIP500 .RE +.\" METHOD: superclass .TP \fBsuperclass\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR? . @@ -212,6 +223,7 @@ being non-classes or vice-versa, that an empty parent class is equivalent to \fBoo::object\fR, and that the parent classes of \fBoo::object\fR and \fBoo::class\fR may not be modified. By default, this slot works by replacement. +.\" METHOD: unexport .TP \fBunexport\fI name \fR?\fIname ...\fR? . @@ -221,6 +233,7 @@ but instead just through the \fBmy\fR command visible in each object's context) by the class being defined. Note that the methods themselves may be actually defined by a superclass; subclass unexports override superclass visibility, and may be overridden by instance unexports. +.\" METHOD: variable .TP \fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR? . @@ -252,6 +265,7 @@ extremely unlikely. .PP The following definitions are also supported, but are not required in simple programs: +.\" METHOD: definitionnamespace .TP \fBdefinitionnamespace\fR ?\fIkind\fR? \fInamespaceName\fR .VS TIP524 @@ -278,6 +292,7 @@ locked to \fB::oo::define\fR. A consequence of this is that effective use of this feature for classes requires the definition of a metaclass. .RE .VE TIP524 +.\" METHOD: deletemethod .TP \fBdeletemethod\fI name\fR ?\fIname ...\fR? . @@ -286,6 +301,7 @@ must have previously existed in that class. Does not affect the superclasses of the class, nor does it affect the subclasses or instances of the class (except when they have a call chain through the class being modified) or the class object itself. +.\" METHOD: filter .TP \fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR? . @@ -296,6 +312,7 @@ results are. Each \fImethodName\fR names a single filtering method (which may be exposed or not exposed); it is not an error for a non-existent method to be named since they may be defined by subclasses. By default, this slot works by appending. +.\" METHOD: mixin .TP \fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR? . @@ -304,6 +321,7 @@ sets or updates the list of additional classes that are to be mixed into all the instances of the class being defined. Each \fIclassName\fR argument names a single class that is to be mixed in. By default, this slot works by replacement. +.\" METHOD: renamemethod .TP \fBrenamemethod\fI fromName toName\fR . @@ -320,6 +338,7 @@ be afterwards. The following commands are supported in the \fIdefScript\fR for \fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR form: +.\" METHOD: export .TP \fBexport\fI name \fR?\fIname ...\fR? . @@ -327,6 +346,7 @@ This arranges for each of the named methods, \fIname\fR, to be exported (i.e. usable outside the object through the object's command) by the object being defined. Note that the methods themselves may be actually defined by a class or superclass; object exports override class visibility. +.\" METHOD: forward .TP \fBforward\fI name cmdName \fR?\fIarg ...\fR? . @@ -343,6 +363,7 @@ If in a private definition context (see the \fBprivate\fR definition command, below), this command creates private forwarded methods. .VE TIP500 .RE +.\" METHOD: method .TP \fBmethod\fI name \fR?\fIoption\fR? \fIargList bodyScript\fR . @@ -366,6 +387,7 @@ below) or if the \fB\-private\fR flag is given for \fIoption\fR, this command creates private procedure-like methods. .VE TIP500 .RE +.\" METHOD: mixin .TP \fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR? . @@ -374,6 +396,7 @@ sets or updates a per-object list of additional classes that are to be mixed into the object. Each argument, \fIclassName\fR, names a single class that is to be mixed in. By default, this slot works by replacement. +.\" METHOD: private .TP \fBprivate \fIcmd arg...\fR .TP @@ -391,6 +414,7 @@ just a private definition context. All other definition commands have no difference in behavior when used in a private definition context. .RE .VE TIP500 +.\" METHOD: unexport .TP \fBunexport\fI name \fR?\fIname ...\fR? . @@ -399,6 +423,7 @@ This arranges for each of the named methods, \fIname\fR, to be not exported just through the \fBmy\fR command visible in the object's context) by the object being defined. Note that the methods themselves may be actually defined by a class; instance unexports override class visibility. +.\" METHOD: variable .TP \fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR? . @@ -428,12 +453,14 @@ superclass methods extremely unlikely. .PP The following definitions are also supported, but are not required in simple programs: +.\" METHOD: class .TP \fBclass\fI className\fR . This allows the class of an object to be changed after creation. Note that the class's constructors are not called when this is done, and so the object may well be in an inconsistent state unless additional configuration work is done. +.\" METHOD: deletemethod .TP \fBdeletemethod\fI name\fR ?\fIname ...\fR . @@ -442,6 +469,7 @@ must have previously existed in that object (e.g., because it was created through \fBoo::objdefine method\fR). Does not affect the classes that the object is an instance of, or remove the exposure of those class-provided methods in the instance of that class. +.\" METHOD: filter .TP \fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR? . @@ -453,6 +481,7 @@ not exposed); it is not an error for a non-existent method to be named. Note that the actual list of filters also depends on the filters set upon any classes that the object is an instance of. By default, this slot works by appending. +.\" METHOD: renamemethod .TP \fBrenamemethod\fI fromName toName\fR . @@ -527,6 +556,7 @@ which is forwarded to the default operation of the slot (thus, for the class slot, this is forwarded to .QW "\fBmy \-append\fR" ), and these methods which provide the implementation interface: +.\" METHOD: Get .TP \fIslot\fR \fBGet\fR . @@ -542,8 +572,9 @@ The elements of the list should be fully resolved, if that is a meaningful concept to the slot. .VE TIP516 .RE +.\" METHOD: Resolve .TP -\fIslot\fR \fBResolve\fR \fIslotElement\fR +\fIslot\fR \fBResolve\fI slotElement\fR .VS TIP516 Returns \fIslotElement\fR with a resolution operation applied to it, but does not modify the slot. For slots of simple strings, this is an operation that @@ -560,6 +591,7 @@ Implementations \fIshould not\fR enforce uniqueness and ordering constraints in this method; that is the responsibility of the \fBSet\fR method. .RE .VE TIP516 +.\" METHOD: Set .TP \fIslot\fR \fBSet \fIelementList\fR . diff --git a/doc/dict.n b/doc/dict.n index 5f5a087..9fcb05f 100644 --- a/doc/dict.n +++ b/doc/dict.n @@ -19,6 +19,7 @@ Performs one of several operations on dictionary values or variables containing dictionary values (see the \fBDICTIONARY VALUES\fR section below for a description), depending on \fIoption\fR. The legal \fIoption\fRs (which may be abbreviated) are: +.\" METHOD: append .TP \fBdict append \fIdictionaryVariable key \fR?\fIstring ...\fR? . @@ -32,12 +33,14 @@ If \fIdictionaryVariable\fR indicates an element that does not exist of an array that has a default value set, the default value and will be used as the value of the dictionary prior to the appending operation. .VE TIP508 +.\" METHOD: create .TP \fBdict create \fR?\fIkey value ...\fR? . Return a new dictionary that contains each of the key/value mappings listed as arguments (keys and values alternating, with each key being followed by its associated value.) +.\" METHOD: exists .TP \fBdict exists \fIdictionaryValue key \fR?\fIkey ...\fR? . @@ -45,6 +48,7 @@ This returns a boolean value indicating whether the given key (or path of keys through a set of nested dictionaries) exists in the given dictionary value. This returns a true value exactly when \fBdict get\fR on that path will succeed. +.\" METHOD: filter .TP \fBdict filter \fIdictionaryValue filterType arg \fR?\fIarg ...\fR? . @@ -54,6 +58,7 @@ type (which may be abbreviated.) Supported filter types are: .RS .TP \fBdict filter \fIdictionaryValue \fBkey\fR ?\fIglobPattern ...\fR? +. The key rule only matches those key/value pairs whose keys match any of the given patterns (in the style of \fBstring match\fR.) .TP @@ -72,9 +77,11 @@ result. The key/value pairs are tested in the order in which the keys were inserted into the dictionary. .TP \fBdict filter \fIdictionaryValue \fBvalue \fR?\fIglobPattern ...\fR? +. The value rule only matches those key/value pairs whose values match any of the given patterns (in the style of \fBstring match\fR.) .RE +.\" METHOD: for .TP \fBdict for {\fIkeyVariable valueVariable\fB} \fIdictionaryValue body\fR . @@ -90,6 +97,7 @@ terminate successfully immediately. If any evaluation of the body generates a \fBTCL_CONTINUE\fR result, this shall be treated exactly like a normal \fBTCL_OK\fR result. The order of iteration is the order in which the keys were inserted into the dictionary. +.\" METHOD: get .TP \fBdict get \fIdictionaryValue \fR?\fIkey ...\fR? . @@ -115,6 +123,8 @@ the value for that key. It is an error to attempt to retrieve a value for a key that is not present in the dictionary. .RE +.\" METHOD: getdef +.\" METHOD: getwithdefault .TP \fBdict getdef \fIdictionaryValue \fR?\fIkey ...\fR? \fIkey default\fR .TP @@ -131,6 +141,7 @@ Note that there must always be at least one \fIkey\fR provided, and that \fBdict getdef\fR and \fBdict getwithdefault\fR are aliases for each other. .RE .VE "8.7, TIP342" +.\" METHOD: incr .TP \fBdict incr \fIdictionaryVariable key \fR?\fIincrement\fR? . @@ -146,6 +157,7 @@ If \fIdictionaryVariable\fR indicates an element that does not exist of an array that has a default value set, the default value and will be used as the value of the dictionary prior to the incrementing operation. .VE TIP508 +.\" METHOD: info .TP \fBdict info \fIdictionaryValue\fR . @@ -154,6 +166,7 @@ given dictionary though the format of this data is dependent on the implementation of the dictionary. For dictionaries that are implemented by hash tables, it is expected that this will return the string produced by \fBTcl_HashStats\fR, similar to \fBarray statistics\fR. +.\" METHOD: keys .TP \fBdict keys \fIdictionaryValue \fR?\fIglobPattern\fR? . @@ -161,6 +174,7 @@ Return a list of all keys in the given dictionary value. If a pattern is supplied, only those keys that match it (according to the rules of \fBstring match\fR) will be returned. The returned keys will be in the order that they were inserted into the dictionary. +.\" METHOD: lappend .TP \fBdict lappend \fIdictionaryVariable key \fR?\fIvalue ...\fR? . @@ -176,6 +190,7 @@ If \fIdictionaryVariable\fR indicates an element that does not exist of an array that has a default value set, the default value and will be used as the value of the dictionary prior to the list-appending operation. .VE TIP508 +.\" METHOD: map .TP \fBdict map \fR{\fIkeyVariable valueVariable\fR} \fIdictionaryValue body\fR . @@ -201,6 +216,7 @@ of iteration is the natural order of the dictionary (typically the order in which the keys were added to the dictionary; the order is the same as that used in \fBdict for\fR). .RE +.\" METHOD: merge .TP \fBdict merge \fR?\fIdictionaryValue ...\fR? . @@ -209,6 +225,7 @@ Return a dictionary that contains the contents of each of the contain a mapping for the same key, the resulting dictionary maps that key to the value according to the last dictionary on the command line containing a mapping for that key. +.\" METHOD: remove .TP \fBdict remove \fIdictionaryValue \fR?\fIkey ...\fR? . @@ -217,6 +234,7 @@ first argument except without mappings for each of the keys listed. It is legal for there to be no keys to remove, and it also legal for any of the keys to be removed to not be present in the input dictionary in the first place. +.\" METHOD: replace .TP \fBdict replace \fIdictionaryValue \fR?\fIkey value ...\fR? . @@ -225,6 +243,7 @@ first argument except with some values different or some extra key/value pairs added. It is legal for this command to be called with no key/value pairs, but illegal for this command to be called with a key but no value. +.\" METHOD: set .TP \fBdict set \fIdictionaryVariable key \fR?\fIkey ...\fR? \fIvalue\fR . @@ -238,10 +257,12 @@ If \fIdictionaryVariable\fR indicates an element that does not exist of an array that has a default value set, the default value and will be used as the value of the dictionary prior to the value insert/update operation. .VE TIP508 +.\" METHOD: size .TP \fBdict size \fIdictionaryValue\fR . Return the number of key/value mappings in the given dictionary value. +.\" METHOD: unset .TP \fBdict unset \fIdictionaryVariable key \fR?\fIkey ...\fR? . @@ -258,6 +279,7 @@ If \fIdictionaryVariable\fR indicates an element that does not exist of an array that has a default value set, the default value and will be used as the value of the dictionary prior to the value remove operation. .VE TIP508 +.\" METHOD: update .TP \fBdict update \fIdictionaryVariable key varName \fR?\fIkey varName ...\fR? \fIbody\fR . @@ -289,6 +311,7 @@ Note that the mapping of values to variables does not use traces; changes to the \fIdictionaryVariable\fR's contents only happen when \fIbody\fR terminates. .RE +.\" METHOD: values .TP \fBdict values \fIdictionaryValue \fR?\fIglobPattern\fR? . @@ -297,6 +320,7 @@ pattern is supplied, only those values that match it (according to the rules of \fBstring match\fR) will be returned. The returned values will be in the order of that the keys associated with those values were inserted into the dictionary. +.\" METHOD: with .TP \fBdict with \fIdictionaryVariable \fR?\fIkey ...\fR? \fIbody\fR . diff --git a/doc/encoding.n b/doc/encoding.n index 255e070..b88dbc4 100644 --- a/doc/encoding.n +++ b/doc/encoding.n @@ -44,14 +44,14 @@ expr {$text eq $decoded}; #-> 1 .SH DESCRIPTION .PP Performs one of the following encoding \fIoperations\fR: +.\" METHOD: convertfrom .TP \fBencoding convertfrom\fR ?\fIencoding\fR? \fIdata\fR .TP -\fBencoding convertfrom\fR ?\fB-profile \fIprofile\fR? ?\fB-failindex var\fR? \fIencoding\fR \fIdata\fR +\fBencoding convertfrom\fR ?\fB-profile \fIprofile\fR? ?\fB-failindex var\fR? \fIencoding data\fR . Decodes \fIdata\fR encoded in \fIencoding\fR. If \fIencoding\fR is not specified the current system encoding is used. - .VS "TCL8.7 TIP607, TIP656" \fB-profile\fR determines how invalid data for the encoding are handled. See the \fBPROFILES\fR section below for details. Returns an error if decoding @@ -61,17 +61,18 @@ the character that could not be converted. If no errors are encountered the entire result of the conversion is returned and the value \fB-1\fR is stored in \fBvar\fR. .VE "TCL8.7 TIP607, TIP656" +.\" METHOD: convertto .TP \fBencoding convertto\fR ?\fIencoding\fR? \fIdata\fR .TP -\fBencoding convertto\fR ?\fB-profile \fIprofile\fR? ?\fB-failindex var\fR? \fIencoding\fR \fIdata\fR +\fBencoding convertto\fR ?\fB-profile \fIprofile\fR? ?\fB-failindex var\fR? \fIencoding data\fR . Converts \fIstring\fR to \fIencoding\fR. If \fIencoding\fR is not given, the current system encoding is used. - .VS "TCL8.7 TIP607, TIP656" See \fBencoding convertfrom\fR for the meaning of \fB-profile\fR and \fB-failindex\fR. .VE "TCL8.7 TIP607, TIP656" +.\" METHOD: dirs .TP \fBencoding dirs\fR ?\fIdirectoryList\fR? . @@ -80,6 +81,7 @@ directories given by \fIdirectoryList\fR. If \fIdirectoryList\fR is not given, returns the current list of directories that make up the search path. It is not an error for an item in \fIdirectoryList\fR to not refer to a readable, searchable directory. +.\" METHOD: names .TP \fBencoding names\fR . @@ -95,6 +97,7 @@ are guaranteed to be present in the list. Returns a list of names of available encoding profiles. See \fBPROFILES\fR below. .VE "TCL8.7 TIP656" +.\" METHOD: system .TP \fBencoding system\fR ?\fIencoding\fR? . @@ -109,15 +112,16 @@ Each \fIprofile\fR is a distinct strategy for dealing with invalid data for an encoding. .PP The following profiles are currently implemented. -.VS "TCL8.7 TIP656" +.VE "TCL8.7 TIP656" .TP \fBstrict\fR -. +.VS "TCL8.7 TIP656" The default profile. The operation fails when invalid data for the encoding are encountered. +.VE "TCL8.7 TIP656" .TP \fBtcl8\fR -. +.VS "TCL8.7 TIP656" Provides for behaviour identical to that of Tcl 8.6: When decoding, for encodings \fBother than utf-8\fR, each invalid byte is interpreted as the Unicode value given by that one byte. For example, the byte 0x80, which @@ -128,18 +132,23 @@ not is treated as the Unicode value given by that one byte. For example, byte 0x80 is defined by CP1252 and is therefore mapped to its Unicode equivalent U+20AC while byte 0x81 which is not defined by CP1252 is mapped to U+0081. As an additional special case, the sequence 0xC0 0x80 is mapped to U+0000. - +.RS +.PP When encoding, each character that cannot be represented in the encoding is replaced by an encoding-dependent character, usually the question mark \fB?\fR. +.RE +.VE "TCL8.7 TIP656" .TP \fBreplace\fR -. +.VS "TCL8.7 TIP 656" When decoding, invalid bytes are replaced by U+FFFD, the Unicode REPLACEMENT CHARACTER. - +.RS +.PP When encoding, Unicode values that cannot be represented in the target encoding are transformed to an encoding-specific fallback character, U+FFFD REPLACEMENT CHARACTER for UTF targets, and generally `?` for other encodings. +.RE .VE "TCL8.7 TIP656" .SH EXAMPLES .PP @@ -170,18 +179,18 @@ The letter \fBA\fR is Unicode character U+0041 and the byte "\ex80" is invalid in ASCII encoding. .PP .CS -% codepoints [encoding convertfrom -profile tcl8 ascii A\ex80] +% codepoints [\fBencoding convertfrom\fR -profile tcl8 ascii A\ex80] U+000041 U+000080 -% codepoints [encoding convertfrom -profile replace ascii A\ex80] +% codepoints [\fBencoding convertfrom\fR -profile replace ascii A\ex80] U+000041 U+00FFFD -% codepoints [encoding convertfrom -profile strict ascii A\ex80] +% codepoints [\fBencoding convertfrom\fR -profile strict ascii A\ex80] unexpected byte sequence starting at index 1: '\ex80' .CE .PP Example 3: Get partial data and the error location: .PP .CS -% codepoints [encoding convertfrom -failindex idx ascii AB\ex80] +% codepoints [\fBencoding convertfrom\fR -failindex idx ascii AB\ex80] U+000041 U+000042 % set idx 2 @@ -190,11 +199,11 @@ U+000041 U+000042 Example 4: Encode a character that is not representable in ISO8859-1: .PP .CS -% encoding convertto iso8859-1 A\eu0141 +% \fBencoding convertto\fR iso8859-1 A\eu0141 A? -% encoding convertto -profile strict iso8859-1 A\eu0141 +% \fBencoding convertto\fR -profile strict iso8859-1 A\eu0141 unexpected character at index 1: 'U+000141' -% encoding convertto -failindex idx iso8859-1 A\eu0141 +% \fBencoding convertto\fR -failindex idx iso8859-1 A\eu0141 A % set idx 1 diff --git a/doc/exec.n b/doc/exec.n index 7831c85..612bd4e 100644 --- a/doc/exec.n +++ b/doc/exec.n @@ -52,7 +52,7 @@ described below then it is used by \fBexec\fR to control the flow of input and output among the subprocess(es). Such arguments will not be passed to the subprocess(es). In forms such as -.QW "\fB<\fR \fIfileName\fR" , +.QW "\fB<\fI fileName\fR" , \fIfileName\fR may either be in a separate argument from .QW \fB<\fR or in the same argument with no intervening space (i.e. diff --git a/doc/fconfigure.n b/doc/fconfigure.n index c2847cd..e265fc4 100644 --- a/doc/fconfigure.n +++ b/doc/fconfigure.n @@ -13,8 +13,8 @@ fconfigure \- Set and get options on a channel .SH SYNOPSIS .nf \fBfconfigure \fIchannelId\fR -\fBfconfigure \fIchannelId\fR \fIname\fR -\fBfconfigure \fIchannelId\fR \fIname value \fR?\fIname value ...\fR? +\fBfconfigure \fIchannelId name\fR +\fBfconfigure \fIchannelId name value \fR?\fIname value ...\fR? .fi .BE .SH DESCRIPTION @@ -42,7 +42,7 @@ that that specific type of channel supports. For example, see the manual entry for the \fBsocket\fR command for additional options for sockets, and the \fBopen\fR command for additional options for serial devices. .TP -\fB\-blocking\fR \fIboolean\fR +\fB\-blocking\fI boolean\fR The \fB\-blocking\fR option determines whether I/O operations on the channel can cause the process to block indefinitely. The value of the option must be a proper boolean value. @@ -55,7 +55,7 @@ For nonblocking mode to work correctly, the application must be using the Tcl event loop (e.g. by calling \fBTcl_DoOneEvent\fR or invoking the \fBvwait\fR command). .TP -\fB\-buffering\fR \fInewValue\fR +\fB\-buffering\fI newValue\fR . If \fInewValue\fR is \fBfull\fR then the I/O system will buffer output until its internal buffer is full or until the \fBflush\fR command is @@ -68,14 +68,14 @@ connect to terminal-like devices; for these channels the initial setting is \fBline\fR. Additionally, \fBstdin\fR and \fBstdout\fR are initially set to \fBline\fR, and \fBstderr\fR is set to \fBnone\fR. .TP -\fB\-buffersize\fR \fInewSize\fR +\fB\-buffersize\fI newSize\fR . \fINewvalue\fR must be an integer; its value is used to set the size of buffers, in bytes, subsequently allocated for this channel to store input or output. \fINewvalue\fR must be between one and one million, allowing buffers of one to one million bytes in size. .TP -\fB\-encoding\fR \fIname\fR +\fB\-encoding\fI name\fR . This option is used to specify the encoding of the channel, so that the data can be converted to and from Unicode for use in Tcl. For instance, in @@ -101,7 +101,7 @@ locale-dependent system encoding used for interfacing with the operating system, as returned by \fBencoding system\fR. .RE .TP -\fB\-eofchar\fR \fIchar\fR +\fB\-eofchar\fI char\fR . This option supports DOS file systems that use Control-z (\ex1A) as an end of file marker. If \fIchar\fR is not an empty string, then this @@ -114,7 +114,7 @@ attempting to set \fB\-eofchar\fR to a value outside of this range will generate an error. .VS "TCL8.7 TIP656" .TP -\fB\-profile\fR \fIprofile\fR +\fB\-profile\fI profile\fR . Specifies the encoding profile to be used on the channel. The encoding transforms in use for the channel's input and output will then be subject to the @@ -123,7 +123,7 @@ rules of that profile. Any failures will result in a channel error. See profiles. .VE "TCL8.7 TIP656" .TP -\fB\-translation\fR \fImode\fR +\fB\-translation\fI mode\fR .TP \fB\-translation\fR \fB{\fIinMode outMode\fB}\fR . diff --git a/doc/fcopy.n b/doc/fcopy.n index 9f7c218..800a392 100644 --- a/doc/fcopy.n +++ b/doc/fcopy.n @@ -12,7 +12,7 @@ .SH NAME fcopy \- Copy data from one channel to another .SH SYNOPSIS -\fBfcopy \fIinputChan\fR \fIoutputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR? +\fBfcopy \fIinputChan outputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR? .BE .SH DESCRIPTION diff --git a/doc/file.n b/doc/file.n index 30bfb1f..f35f40e 100644 --- a/doc/file.n +++ b/doc/file.n @@ -12,7 +12,7 @@ .SH NAME file \- Manipulate file names and attributes .SH SYNOPSIS -\fBfile \fIoption\fR \fIname\fR ?\fIarg arg ...\fR? +\fBfile \fIoption name\fR ?\fIarg arg ...\fR? .BE .SH DESCRIPTION .PP @@ -20,6 +20,7 @@ This command provides several operations on a file's name or attributes. The \fIname\fR argument is the name of a file in most cases. The \fIoption\fR argument indicates what to do with the file name. Any unique abbreviation for \fIoption\fR is acceptable. The valid options are: +.\" METHOD: atime .TP \fBfile atime \fIname\fR ?\fItime\fR? . @@ -31,6 +32,7 @@ does not exist or its access time cannot be queried or set then an error is generated. On Windows, FAT file systems do not support access time. On \fBzipfs\fR file systems, access time is mapped to the modification time. +.\" METHOD: attributes .TP \fBfile attributes \fIname\fR .TP @@ -95,6 +97,7 @@ This is \fB0\fR for directories. Other attributes may be present in the returned list. These should be ignored. .RE +.\" METHOD: channels .TP \fBfile channels\fR ?\fIpattern\fR? . @@ -102,8 +105,9 @@ If \fIpattern\fR is not specified, returns a list of names of all registered open channels in this interpreter. If \fIpattern\fR is specified, only those names matching \fIpattern\fR are returned. Matching is determined using the same rules as for \fBstring match\fR. +.\" METHOD: copy .TP -\fBfile copy \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR \fItarget\fR +\fBfile copy \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource target\fR .TP \fBfile copy \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR ?\fIsource\fR ...? \fItargetDir\fR . @@ -124,6 +128,7 @@ or overwrite a file with a directory will all result in errors even if specified, halting at the first error, if any. A \fB\-\|\-\fR marks the end of switches; the argument following the \fB\-\|\-\fR will be treated as a \fIsource\fR even if it starts with a \fB\-\fR. +.\" METHOD: delete .TP \fBfile delete \fR?\fB\-force\fR? ?\fB\-\|\-\fR? ?\fIpathname\fR ... ? . @@ -143,8 +148,10 @@ the first error, if any. A \fB\-\|\-\fR marks the end of switches; the argument following the \fB\-\|\-\fR will be treated as a \fIpathname\fR even if it starts with a \fB\-\fR. +.\" METHOD: dirname .TP \fBfile dirname \fIname\fR +. Returns a name comprised of all of the path components in \fIname\fR excluding the last element. If \fIname\fR is a relative file name and only contains one path element, then returns @@ -159,6 +166,7 @@ returned. For example, .PP returns \fBc:/\fR. .RE +.\" METHOD: executable .TP \fBfile executable \fIname\fR . @@ -166,17 +174,20 @@ Returns \fB1\fR if file \fIname\fR is executable by the current user, \fB0\fR otherwise. On Windows, which does not have an executable attribute, the command treats all directories and any files with extensions \fBexe\fR, \fBcom\fR, \fBcmd\fR or \fBbat\fR as executable. +.\" METHOD: exists .TP \fBfile exists \fIname\fR . Returns \fB1\fR if file \fIname\fR exists and the current user has search privileges for the directories leading to it, \fB0\fR otherwise. +.\" METHOD: extension .TP \fBfile extension \fIname\fR . Returns all of the characters in \fIname\fR after and including the last dot in the last element of \fIname\fR. If there is no dot in the last element of \fIname\fR then returns the empty string. +.\" METHOD: home .TP \fBfile home ?\fIusername\fR? .VS "8.7, TIP 602" @@ -195,14 +206,17 @@ raised if the \fIusername\fR does not correspond to a user account on the system. .RE .VE "8.7, TIP 602" +.\" METHOD: isdirectory .TP \fBfile isdirectory \fIname\fR . Returns \fB1\fR if file \fIname\fR is a directory, \fB0\fR otherwise. +.\" METHOD: isfile .TP \fBfile isfile \fIname\fR . Returns \fB1\fR if file \fIname\fR is a regular file, \fB0\fR otherwise. +.\" METHOD: join .TP \fBfile join \fIname\fR ?\fIname ...\fR? . @@ -223,6 +237,7 @@ Note that any of the names can contain separators, and that the result is always canonical for the current platform: \fB/\fR for Unix and Windows. .RE +.\" METHOD: link .TP \fBfile link\fR ?\fI\-linktype\fR? \fIlinkName\fR ?\fItarget\fR? . @@ -263,8 +278,9 @@ error message will be returned. Most Unix platforms support both symbolic and hard links (the latter for files only). Windows supports symbolic directory links and hard file links on NTFS drives. .RE +.\" METHOD: lstat .TP -\fBfile lstat \fIname ?varName?\fR +\fBfile lstat \fIname\fR ?\fIvarName\fR? . Same as \fBstat\fR option (see below) except uses the \fIlstat\fR kernel call instead of \fIstat\fR. This means that if \fIname\fR @@ -272,6 +288,7 @@ refers to a symbolic link the information returned is for the link rather than the file it refers to. On systems that do not support symbolic links this option behaves exactly the same as the \fBstat\fR option. +.\" METHOD: mkdir .TP \fBfile mkdir\fR ?\fIdir\fR ...? . @@ -281,6 +298,7 @@ well as \fIdir\fR itself. If an existing directory is specified, then no action is taken and no error is returned. Trying to overwrite an existing file with a directory will result in an error. Arguments are processed in the order specified, halting at the first error, if any. +.\" METHOD: mtime .TP \fBfile mtime \fIname\fR ?\fItime\fR? . @@ -291,12 +309,14 @@ standard POSIX fashion as seconds from a fixed starting time (often January 1, 1970). If the file does not exist or its modified time cannot be queried or set then an error is generated. On \fBzipfs\fR file systems, modification time cannot be explicitly set. +.\" METHOD: nativename .TP \fBfile nativename \fIname\fR . Returns the platform-specific name of the file. This is useful if the filename is needed to pass to a platform-specific call, such as to a subprocess via \fBexec\fR under Windows (see \fBEXAMPLES\fR below). +.\" METHOD: normalize .TP \fBfile normalize \fIname\fR . @@ -318,11 +338,13 @@ last link in the path is necessary, because Tcl or the user may wish to operate on the actual symbolic link itself (for example \fBfile delete\fR, \fBfile rename\fR, \fBfile copy\fR are defined to operate on symbolic links, not on the things that they point to). +.\" METHOD: owned .TP \fBfile owned \fIname\fR . Returns \fB1\fR if file \fIname\fR is owned by the current user, \fB0\fR otherwise. +.\" METHOD: pathtype .TP \fBfile pathtype \fIname\fR . @@ -333,11 +355,13 @@ working directory, then the path type will be \fBrelative\fR. If \fIname\fR refers to a file relative to the current working directory on a specified volume, or to a specific file on the current working volume, then the path type is \fBvolumerelative\fR. +.\" METHOD: readable .TP \fBfile readable \fIname\fR . Returns \fB1\fR if file \fIname\fR is readable by the current user, \fB0\fR otherwise. +.\" METHOD: readlink .TP \fBfile readlink \fIname\fR . @@ -345,8 +369,9 @@ Returns the value of the symbolic link given by \fIname\fR (i.e. the name of the file it points to). If \fIname\fR is not a symbolic link or its value cannot be read, then an error is returned. On systems that do not support symbolic links this option is undefined. +.\" METHOD: rename .TP -\fBfile rename \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR \fItarget\fR +\fBfile rename \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource target\fR .TP \fBfile rename \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR ?\fIsource\fR ...? \fItargetDir\fR . @@ -364,6 +389,7 @@ result in errors. Arguments are processed in the order specified, halting at the first error, if any. A \fB\-\|\-\fR marks the end of switches; the argument following the \fB\-\|\-\fR will be treated as a \fIsource\fR even if it starts with a \fB\-\fR. +.\" METHOD: rootname .TP \fBfile rootname \fIname\fR . @@ -372,6 +398,7 @@ last .QW . character in the last component of name. If the last component of \fIname\fR does not contain a dot, then returns \fIname\fR. +.\" METHOD: separator .TP \fBfile separator\fR ?\fIname\fR? . @@ -380,12 +407,14 @@ path segments for native files on this platform. If a path is given, the filesystem responsible for that path is asked to return its separator character. If no file system accepts \fIname\fR, an error is generated. +.\" METHOD: size .TP \fBfile size \fIname\fR . Returns a decimal string giving the size of file \fIname\fR in bytes. If the file does not exist or its size cannot be queried then an error is generated. +.\" METHOD: split .TP \fBfile split \fIname\fR . @@ -393,8 +422,9 @@ Returns a list whose elements are the path components in \fIname\fR. The first element of the list will have the same path type as \fIname\fR. All other elements will be relative. Path separators will be discarded unless they are needed to ensure that an element is unambiguously relative. +.\" METHOD: stat .TP -\fBfile stat \fIname ?varName?\fR +\fBfile stat \fIname\fR ?\fIvarName\fR? . Invokes the \fBstat\fR kernel call on \fIname\fR, and returns a dictionary with the information returned from the kernel call. If @@ -408,6 +438,7 @@ field from the \fBstat\fR return structure; see the manual entry for \fBstat\fR for details on the meanings of the values. The \fBtype\fR element gives the type of the file in the same form returned by the command \fBfile type\fR. +.\" METHOD: system .TP \fBfile system \fIname\fR . @@ -429,6 +460,7 @@ to represent a file on a remote ftp site mounted as a virtual filesystem through an extension called .QW vfs . If the file does not belong to any filesystem, an error is generated. +.\" METHOD: tail .TP \fBfile tail \fIname\fR . @@ -437,6 +469,7 @@ Returns all of the characters in the last filesystem component of If \fIname\fR contains no separators then returns \fIname\fR. So, \fBfile tail a/b\fR, \fBfile tail a/b/\fR and \fBfile tail b\fR all return \fBb\fR. +.\" METHOD: tempdir .TP \fBfile tempdir\fR ?\fItemplate\fR? .VS "8.7, TIP 431" @@ -467,6 +500,7 @@ between platforms: .CE .RE .VE "8.7, TIP 431" +.\" METHOD: tempfile .TP \fBfile tempfile\fR ?\fInameVar\fR? ?\fItemplate\fR? '\" TIP #210 @@ -484,6 +518,7 @@ Note that temporary files are \fIonly\fR ever created on the native filesystem. As such, they can be relied upon to be used with operating-system native APIs and external programs that require a filename. .RE +.\" METHOD: tildeexpand .TP \fBfile tildeexpand \fIname\fR .VS "8.7, TIP 602" @@ -500,12 +535,14 @@ retrieve the user's home directory for substitution. An error is raised if the If the file name does not begin with a tilde, it is returned unmodified. .RE .VE "8.7, TIP 602" +.\" METHOD: type .TP \fBfile type \fIname\fR . Returns a string giving the type of file \fIname\fR, which will be one of \fBfile\fR, \fBdirectory\fR, \fBcharacterSpecial\fR, \fBblockSpecial\fR, \fBfifo\fR, \fBlink\fR, or \fBsocket\fR. +.\" METHOD: volumes .TP \fBfile volumes\fR . @@ -519,6 +556,7 @@ On Windows, it will return a list of the available local drives .QW "a:/ c:/" ). If any virtual filesystem has mounted additional volumes, they will be in the returned list. +.\" METHOD: writable .TP \fBfile writable \fIname\fR . diff --git a/doc/glob.n b/doc/glob.n index b19e47f..840d1b7 100644 --- a/doc/glob.n +++ b/doc/glob.n @@ -29,7 +29,7 @@ If the initial arguments to \fBglob\fR start with \fB\-\fR then they are treated as switches. The following switches are currently supported: .TP -\fB\-directory\fR \fIdirectory\fR +\fB\-directory\fI directory\fR . Search for files which match the given patterns starting in the given \fIdirectory\fR. This allows searching of directories whose name @@ -49,7 +49,7 @@ separators. Allows an empty list to be returned without error; This is the default behavior in Tcl 9.0, so this switch has no effect any more. .TP -\fB\-path\fR \fIpathPrefix\fR +\fB\-path\fI pathPrefix\fR . Search for files with the given \fIpathPrefix\fR where the rest of the name matches the given patterns. This allows searching for files with names @@ -75,7 +75,7 @@ path segment, so .QW "\fBglob \-tails \-path [file rootname /home/fred/foo.tex] .*\fR" will return paths like \fBfoo.aux foo.bib foo.tex\fR etc. .TP -\fB\-types\fR \fItypeList\fR +\fB\-types\fI typeList\fR . Only list files or directories which match \fItypeList\fR, where the items in the list have two forms. The first form is like the \-type option of diff --git a/doc/history.n b/doc/history.n index 05d936e..30a5eeb 100644 --- a/doc/history.n +++ b/doc/history.n @@ -39,14 +39,18 @@ The \fBhistory\fR command can take any of the following forms: \fBhistory\fR Same as \fBhistory info\fR, described below. +.\" METHOD: add .TP \fBhistory add\fI command \fR?\fBexec\fR? +. Adds the \fIcommand\fR argument to the history list as a new event. If \fBexec\fR is specified (or abbreviated) then the command is also executed and its result is returned. If \fBexec\fR is not specified then an empty string is returned as result. +.\" METHOD: change .TP \fBhistory change\fI newValue\fR ?\fIevent\fR? +. Replaces the value recorded for an event with \fInewValue\fR. \fIEvent\fR specifies the event to replace, and defaults to the \fIcurrent\fR event (not event \fB\-1\fR). This command @@ -54,32 +58,44 @@ is intended for use in commands that implement new forms of history substitution and wish to replace the current event (which invokes the substitution) with the command created through substitution. The return value is an empty string. +.\" METHOD: clear .TP \fBhistory clear\fR +. Erase the history list. The current keep limit is retained. The history event numbers are reset. +.\" METHOD: event .TP \fBhistory event\fR ?\fIevent\fR? +. Returns the value of the event given by \fIevent\fR. \fIEvent\fR defaults to \fB\-1\fR. +.\" METHOD: info .TP \fBhistory info \fR?\fIcount\fR? +. Returns a formatted string (intended for humans to read) giving the event number and contents for each of the events in the history list except the current event. If \fIcount\fR is specified then only the most recent \fIcount\fR events are returned. +.\" METHOD: keep .TP \fBhistory keep \fR?\fIcount\fR? +. This command may be used to change the size of the history list to \fIcount\fR events. Initially, 20 events are retained in the history list. If \fIcount\fR is not specified, the current keep limit is returned. +.\" METHOD: nextid .TP \fBhistory nextid\fR +. Returns the number of the next event to be recorded in the history list. It is useful for things like printing the event number in command-line prompts. +.\" METHOD: redo .TP \fBhistory redo \fR?\fIevent\fR? +. Re-executes the command indicated by \fIevent\fR and returns its result. \fIEvent\fR defaults to \fB\-1\fR. This command results in history revision: see below for details. @@ -93,8 +109,8 @@ history operations \fBsubstitute\fR and \fBwords\fR have been removed. The history option \fBredo\fR results in much simpler .QW "history revision" . When this option is invoked then the most recent event -is modified to eliminate the history command and replace it with -the result of the history command. +is modified to eliminate the \fBhistory\fR command and replace it with +the result of the \fBhistory\fR command. If you want to redo an event without modifying history, then use the \fBevent\fR operation to retrieve some event, and the \fBadd\fR operation to add it to history and execute it. diff --git a/doc/http.n b/doc/http.n index 9231945..4105592 100644 --- a/doc/http.n +++ b/doc/http.n @@ -20,11 +20,11 @@ http \- Client-side implementation of the HTTP/1.1 protocol .sp \fB::http::geturl \fIurl\fR ?\fI\-option value\fR ...? .sp -\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...? +\fB::http::formatQuery\fI key value\fR ?\fIkey value\fR ...? .sp -\fB::http::quoteString\fR \fIvalue\fR +\fB::http::quoteString\fI value\fR .sp -\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR? +\fB::http::reset\fI token\fR ?\fIwhy\fR? .sp \fB::http::wait \fItoken\fR .sp @@ -38,25 +38,25 @@ http \- Client-side implementation of the HTTP/1.1 protocol .sp \fB::http::cleanup \fItoken\fR .sp -\fB::http::requestLine\fR \fItoken\fR +\fB::http::requestLine\fI token\fR .sp -\fB::http::requestHeaders\fR \fItoken\fR ?\fIheaderName\fR? +\fB::http::requestHeaders\fI token\fR ?\fIheaderName\fR? .sp -\fB::http::requestHeaderValue\fR \fItoken\fR \fIheaderName\fR +\fB::http::requestHeaderValue\fI token headerName\fR .sp -\fB::http::responseLine\fR \fItoken\fR +\fB::http::responseLine\fI token\fR .sp -\fB::http::responseCode\fR \fItoken\fR +\fB::http::responseCode\fI token\fR .sp -\fB::http::reasonPhrase\fR \fIcode\fR +\fB::http::reasonPhrase\fI code\fR .sp -\fB::http::responseHeaders\fR \fItoken\fR ?\fIheaderName\fR? +\fB::http::responseHeaders\fI token\fR ?\fIheaderName\fR? .sp -\fB::http::responseHeaderValue\fR \fItoken\fR \fIheaderName\fR +\fB::http::responseHeaderValue\fI token headerName\fR .sp -\fB::http::responseInfo\fR \fItoken\fR +\fB::http::responseInfo\fI token\fR .sp -\fB::http::responseBody\fR \fItoken\fR +\fB::http::responseBody\fI token\fR .sp \fB::http::register \fIproto port command\fR ?\fIsocketCmdVarName\fR? ?\fIuseSockThread\fR? ?\fIendToEndProxy\fR? .sp @@ -70,7 +70,7 @@ http \- Client-side implementation of the HTTP/1.1 protocol .sp \fB::http::meta \fItoken\fR ?\fIheaderName\fR? .sp -\fB::http::metaValue\fR \fItoken\fR \fIheaderName\fR +\fB::http::metaValue\fI token headerName\fR .sp \fB::http::ncode \fItoken\fR .SH "EXPORTED COMMANDS" @@ -130,6 +130,7 @@ The response itself is returned by command \fB::http::responseBody\fR, unless it has been redirected to a file by the \fI\-channel\fR option of \fB::http::geturl\fR. .SH COMMANDS +.\" METHOD: config .TP \fB::http::config\fR ?\fIoptions\fR? . @@ -142,7 +143,7 @@ that setting is returned. Otherwise, the options should be a set of flags and values that define the configuration: .RS .TP -\fB\-accept\fR \fImimetypes\fR +\fB\-accept\fI mimetypes\fR . The Accept header of the request. The default is */*, which means that all types of documents are accepted. Otherwise you can supply a @@ -150,7 +151,7 @@ comma-separated list of mime type patterns that you are willing to receive. For example, .QW "image/gif, image/jpeg, text/*" . .TP -\fB\-cookiejar\fR \fIcommand\fR +\fB\-cookiejar\fI command\fR .VS TIP406 The cookie store for the package to use to manage HTTP cookies. \fIcommand\fR is a command prefix list; if the empty list (the @@ -159,20 +160,20 @@ from responses. The command indicated by \fIcommand\fR, if supplied, must obey the \fBCOOKIE JAR PROTOCOL\fR described below. .VE TIP406 .TP -\fB\-pipeline\fR \fIboolean\fR +\fB\-pipeline\fI boolean\fR . Specifies whether HTTP/1.1 transactions on a persistent socket will be pipelined. See the \fBPERSISTENT SOCKETS\fR section for details. The default is 1. .TP -\fB\-postfresh\fR \fIboolean\fR +\fB\-postfresh\fI boolean\fR . Specifies whether requests that use the \fBPOST\fR method will always use a fresh socket, overriding the \fB\-keepalive\fR option of command \fBhttp::geturl\fR. See the \fBPERSISTENT SOCKETS\fR section for details. The default is 0. .TP -\fB\-proxyauth\fR \fIstring\fR +\fB\-proxyauth\fI string\fR . If non-empty, the string is supplied to the proxy server as the value of the request header Proxy-Authorization. This option can be used for HTTP Basic @@ -182,7 +183,7 @@ useful. In that case the caller must expect a 407 response from the proxy, compute the authentication value to be supplied, and use the \fB\-headers\fR option to supply it as the value of the Proxy-Authorization header. .TP -\fB\-proxyfilter\fR \fIcommand\fR +\fB\-proxyfilter\fI command\fR . The command is a callback that is made during \fB::http::geturl\fR @@ -209,13 +210,13 @@ not call the \fBbgerror\fR handler. See the \fBERRORS\fR section for details. .RE .TP -\fB\-proxyhost\fR \fIhostname\fR +\fB\-proxyhost\fI hostname\fR . The host name or IP address of the proxy server, if any. If this value is the empty string, the URL host is contacted directly. See \fB\-proxyfilter\fR for how the value is used. .TP -\fB\-proxynot\fR \fIlist\fR +\fB\-proxynot\fI list\fR . A Tcl list of domain names and IP addresses that should be accessed directly, not through the proxy server. The target hostname is compared with each list @@ -224,12 +225,12 @@ to use the wildcard "*" at the start of a domain name (e.g. *.example.com) or at the end of an IP address (e.g. 192.168.0.*). See \fB\-proxyfilter\fR for how the value is used. .TP -\fB\-proxyport\fR \fInumber\fR +\fB\-proxyport\fI number\fR . The port number of the proxy server. See \fB\-proxyfilter\fR for how the value is used. .TP -\fB\-repost\fR \fIboolean\fR +\fB\-repost\fI boolean\fR . Specifies what to do if a POST request over a persistent connection fails because the server has half-closed the connection. If boolean \fBtrue\fR, the @@ -241,7 +242,7 @@ retrying the POST. The value \fBtrue\fR should be used only under certain conditions. See the \fBPERSISTENT SOCKETS\fR section for details. The default is 0. .TP -\fB\-threadlevel\fR \fIlevel\fR +\fB\-threadlevel\fI level\fR . Specifies whether and how to use the \fBThread\fR package. Possible values of \fIlevel\fR are 0, 1 or 2. @@ -259,13 +260,13 @@ available only to the main interpreter in each thread. See section \fBTHREADS\fR for more information. .RE .TP -\fB\-urlencoding\fR \fIencoding\fR +\fB\-urlencoding\fI encoding\fR . The \fIencoding\fR used for creating the x-url-encoded URLs with \fB::http::formatQuery\fR and \fB::http::quoteString\fR. The default is \fButf-8\fR, as specified by RFC 2718. .TP -\fB\-useragent\fR \fIstring\fR +\fB\-useragent\fI string\fR . The value of the User-Agent header in the HTTP request. In an unsafe interpreter, the default value depends upon the operating system, and @@ -275,7 +276,7 @@ A safe interpreter cannot determine its operating system, and so the default in a safe interpreter is to use a Windows 10 value with the current version numbers of \fBhttp\fR and \fBTcl\fR. .TP -\fB\-zip\fR \fIboolean\fR +\fB\-zip\fI boolean\fR . If the value is boolean \fBtrue\fR, then by default requests will send a header .QW "\fBAccept-Encoding: gzip,deflate\fR" . @@ -285,8 +286,9 @@ In either case the default can be overridden for an individual request by supplying a custom \fBAccept-Encoding\fR header in the \fB\-headers\fR option of \fBhttp::geturl\fR. The default value is 1. .RE +.\" METHOD: geturl .TP -\fB::http::geturl\fR \fIurl\fR ?\fIoptions\fR? +\fB::http::geturl\fI url\fR ?\fIoptions\fR? . The \fB::http::geturl\fR command is the main procedure in the package. The \fB\-query\fR or \fB\-querychannel\fR option causes a POST operation and @@ -301,25 +303,25 @@ that is invoked when the HTTP transaction completes. \fB::http::geturl\fR takes several options: .RS .TP -\fB\-binary\fR \fIboolean\fR +\fB\-binary\fI boolean\fR . Specifies whether to force interpreting the URL data as binary. Normally this is auto-detected (anything not beginning with a \fBtext\fR content type or whose content encoding is \fBgzip\fR or \fBdeflate\fR is considered binary data). .TP -\fB\-blocksize\fR \fIsize\fR +\fB\-blocksize\fI size\fR . The block size used when reading the URL. At most \fIsize\fR bytes are read at once. After each block, a call to the \fB\-progress\fR callback is made (if that option is specified). .TP -\fB\-channel\fR \fIname\fR +\fB\-channel\fI name\fR . Copy the URL contents to channel \fIname\fR instead of saving it in a Tcl variable for retrieval by \fB::http::responseBody\fR. .TP -\fB\-command\fR \fIcallback\fR +\fB\-command\fI callback\fR . The presence of this option causes \fB::http::geturl\fR to return immediately. After the HTTP transaction completes, the value of \fIcallback\fR is expanded, @@ -345,7 +347,7 @@ not call the \fBbgerror\fR handler. See the \fBERRORS\fR section for details. .RE .TP -\fB\-guesstype\fR \fIboolean\fR +\fB\-guesstype\fI boolean\fR . Attempt to guess the \fBContent-Type\fR and character set when a misconfigured server provides no information. The default value is \fIfalse\fR (do @@ -359,7 +361,7 @@ state(binary) is changed to 0, and the character set is changed to the one specified by the "encoding" tag of the XML line, or to utf-8 if no encoding is specified. Not used if a \fI\-channel\fR is specified. .TP -\fB\-handler\fR \fIcallback\fR +\fB\-handler\fI callback\fR . If this option is absent, \fBhttp::geturl\fR processes incoming data itself, either appending it to the state(body) variable or writing it to the -channel. @@ -406,7 +408,7 @@ not call the \fBbgerror\fR handler. See the \fBERRORS\fR section for details. .RE .TP -\fB\-headers\fR \fIkeyvaluelist\fR +\fB\-headers\fI keyvaluelist\fR . This option is used to add headers not already specified by \fB::http::config\fR to the HTTP request. The @@ -423,12 +425,12 @@ Pragma: no-cache .CE .RE .TP -\fB\-keepalive\fR \fIboolean\fR +\fB\-keepalive\fI boolean\fR . If boolean \fBtrue\fR, attempt to keep the connection open for servicing multiple requests. Default is 0. .TP -\fB\-method\fR \fItype\fR +\fB\-method\fI type\fR . Force the HTTP request method to \fItype\fR. \fB::http::geturl\fR will auto-select GET, POST or HEAD based on other options, but this option overrides @@ -437,7 +439,7 @@ that selection and enables choices like PUT and DELETE for WebDAV support. .PP It is the caller's responsibility to ensure that the headers and request body (if any) conform to the requirements of the request method. For example, if -using \fB\-method\fR \fIPOST\fR to send a POST with an empty request body, the +using \fB\-method\fI POST\fR to send a POST with an empty request body, the caller must also supply the option .PP .CS @@ -445,12 +447,12 @@ caller must also supply the option .CE .RE .TP -\fB\-myaddr\fR \fIaddress\fR +\fB\-myaddr\fI address\fR . Pass an specific local address to the underlying \fBsocket\fR call in case multiple interfaces are available. .TP -\fB\-progress\fR \fIcallback\fR +\fB\-progress\fI callback\fR . If the \fB\-progress\fR option is present, then the \fIcallback\fR is made after each transfer of data from the URL. @@ -476,13 +478,13 @@ proc httpProgress {token total current} { .CE .RE .TP -\fB\-protocol\fR \fIversion\fR +\fB\-protocol\fI version\fR . Select the HTTP protocol version to use. This should be 1.0 or 1.1 (the default). Should only be necessary for servers that do not understand or otherwise complain about HTTP/1.1. .TP -\fB\-query\fR \fIquery\fR +\fB\-query\fI query\fR . This flag (if the value is non-empty) causes \fB::http::geturl\fR to do a POST request that passes the string @@ -500,7 +502,7 @@ used in a POST submitted from an html form). The \fB::http::formatQuery\fR procedure can be used to do the formatting. .RE .TP -\fB\-queryblocksize\fR \fIsize\fR +\fB\-queryblocksize\fI size\fR . The block size used when posting query data to the URL. At most @@ -509,7 +511,7 @@ bytes are written at once. After each block, a call to the \fB\-queryprogress\fR callback is made (if that option is specified). .TP -\fB\-querychannel\fR \fIchannelID\fR +\fB\-querychannel\fI channelID\fR . This flag causes \fB::http::geturl\fR to do a POST request that passes the data contained in \fIchannelID\fR to the server. The data contained in @@ -520,7 +522,7 @@ options, \fB::http::geturl\fR attempts to determine the size of the post data in order to create that header. If it is unable to determine the size, it returns an error. .TP -\fB\-queryprogress\fR \fIcallback\fR +\fB\-queryprogress\fI callback\fR . If the \fB\-queryprogress\fR option is present, then the \fIcallback\fR is made after each transfer of data to the URL @@ -528,13 +530,13 @@ in a POST request (i.e. a call to \fB::http::geturl\fR with option \fB\-query\fR or \fB\-querychannel\fR) and acts exactly like the \fB\-progress\fR option (the callback format is the same). .TP -\fB\-strict\fR \fIboolean\fR +\fB\-strict\fI boolean\fR . If true then the command will test that the URL complies with RFC 3986, i.e. that it has no characters that should be "x-url-encoded" (e.g. a space should be encoded to "%20"). Default value is 1. .TP -\fB\-timeout\fR \fImilliseconds\fR +\fB\-timeout\fI milliseconds\fR . If \fImilliseconds\fR is non-zero, then \fB::http::geturl\fR sets up a timeout to occur after the specified number of milliseconds. @@ -544,13 +546,13 @@ The return value of \fB::http::status\fR (and the value of the \fIstatus\fR key in the dictionary returned by \fB::http::responseInfo\fR) is \fBtimeout\fR after a timeout has occurred. .TP -\fB\-type\fR \fImime-type\fR +\fB\-type\fI mime-type\fR . Use \fImime-type\fR as the \fBContent-Type\fR value, instead of the default value (\fBapplication/x-www-form-urlencoded\fR) during a POST operation. .TP -\fB\-validate\fR \fIboolean\fR +\fB\-validate\fI boolean\fR . If \fIboolean\fR is non-zero, then \fB::http::geturl\fR does an HTTP HEAD request. This server returns the same status line and response headers as it @@ -559,27 +561,31 @@ would for a HTTP GET request, but omits the response entity transaction using command \fB::http::responseHeaders\fR or, for selected information, \fB::http::responseInfo\fR. .RE +.\" METHOD: formatQuery .TP -\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...? +\fB::http::formatQuery\fI key value\fR ?\fIkey value\fR ...? . This procedure does x-url-encoding of query data. It takes an even number of arguments that are the keys and values of the query. It encodes the keys and values, and generates one string that has the proper & and = separators. The result is suitable for the \fB\-query\fR value passed to \fB::http::geturl\fR. +.\" METHOD: quoteString .TP -\fB::http::quoteString\fR \fIvalue\fR +\fB::http::quoteString\fI value\fR . This procedure does x-url-encoding of string. It takes a single argument and encodes it. +.\" METHOD: reset .TP -\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR? +\fB::http::reset\fI token\fR ?\fIwhy\fR? . This command resets the HTTP transaction identified by \fItoken\fR, if any. This sets the \fBstate(status)\fR value to \fIwhy\fR, which defaults to \fBreset\fR, and then calls the registered \fB\-command\fR callback. +.\" METHOD: wait .TP -\fB::http::wait\fR \fItoken\fR +\fB::http::wait\fI token\fR . This command blocks and waits for the transaction to complete. This only works in trusted code because it @@ -588,8 +594,9 @@ uses \fBvwait\fR. Also, it is not useful for the case where because in this case the \fB::http::geturl\fR call does not return until the HTTP transaction is complete, and thus there is nothing to wait for. +.\" METHOD: status .TP -\fB::http::status\fR \fItoken\fR +\fB::http::status\fI token\fR . This command returns a description of the status of the HTTP transaction. The return value is the empty string until the HTTP transaction is @@ -601,19 +608,22 @@ section \fBERRORS\fR (below). The name "status" is not related to the terms "status line" and "status code" that are defined for a HTTP response. .RE +.\" METHOD: size .TP -\fB::http::size\fR \fItoken\fR +\fB::http::size\fI token\fR . This command returns the number of bytes received so far from the URL in the \fB::http::geturl\fR call. +.\" METHOD: error .TP -\fB::http::error\fR \fItoken\fR +\fB::http::error\fI token\fR . This command returns the error information if the HTTP transaction failed, or the empty string if there was no error. The information is a Tcl list of the error message, stack trace, and error code. +.\" METHOD: postError .TP -\fB::http::postError\fR \fItoken\fR +\fB::http::postError\fI token\fR . A POST request is a call to \fB::http::geturl\fR with either the \fB\-query\fR or \fB\-querychannel\fR option. @@ -623,8 +633,9 @@ string if there was no error. The information is a Tcl list of the error message, stack trace, and error code. When this type of error occurs, the \fB::http::geturl\fR command continues the transaction and attempts to receive a response from the server. +.\" METHOD: cleanup .TP -\fB::http::cleanup\fR \fItoken\fR +\fB::http::cleanup\fI token\fR . This procedure cleans up the state associated with the connection identified by \fItoken\fR. After this call, the procedures @@ -634,8 +645,9 @@ this function after you are done with a given HTTP request. Not doing so will result in memory not being freed, and if your app calls \fB::http::geturl\fR enough times, the memory leak could cause a performance hit...or worse. +.\" METHOD: requestLine .TP -\fB::http::requestLine\fR \fItoken\fR +\fB::http::requestLine\fI token\fR . This command returns the "request line" sent to the server. The "request line" is the first line of a HTTP client request, and has three @@ -647,8 +659,9 @@ GET / HTTP/1.1 GET /introduction.html?subject=plumbing HTTP/1.1 POST /forms/order.html HTTP/1.1 .RE +.\" METHOD: requestHeaders .TP -\fB::http::requestHeaders\fR \fItoken\fR ?\fIheaderName\fR? +\fB::http::requestHeaders\fI token\fR ?\fIheaderName\fR? . This command returns the HTTP request header names and values, in the order that they were sent to the server, as a Tcl list of the form @@ -659,8 +672,9 @@ are returned. If two arguments are supplied, the second provides the value of a header name. Only headers with the requested name (converted to lower case) are returned. If no such headers are found, an empty list is returned. +.\" METHOD: requestHeaderValue .TP -\fB::http::requestHeaderValue\fR \fItoken\fR \fIheaderName\fR +\fB::http::requestHeaderValue\fI token headerName\fR . This command returns the value of the HTTP request header named \fIheaderName\fR. Header names are case-insensitive and are converted to @@ -668,8 +682,9 @@ lower case. If no such header exists, the return value is the empty string. If there are multiple headers named \fIheaderName\fR, the result is obtained by joining the individual values with the string ", " (comma and space), preserving their order. +.\" METHOD: responseLine .TP -\fB::http::responseLine\fR \fItoken\fR +\fB::http::responseLine\fI token\fR . This command returns the first line of the server response: the HTTP "status line". The "status line" has three @@ -695,15 +710,17 @@ and can be changed without affecting the HTTP protocol. The recommended values (RFC 7231 and IANA assignments) for each code are provided by the command \fB::http::reasonPhrase\fR. .RE +.\" METHOD: responseCode .TP -\fB::http::responseCode\fR \fItoken\fR +\fB::http::responseCode\fI token\fR . This command returns the "status code" (200, 404, etc.) of the server "status line". If a three-digit code cannot be found, the full status line is returned. See command \fB::http::responseLine\fR for more information on the "status line". +.\" METHOD: reasonPhrase .TP -\fB::http::reasonPhrase\fR \fIcode\fR +\fB::http::reasonPhrase\fI code\fR . This command returns the IANA recommended "reason phrase" for a particular "status code" returned by a HTTP server. The argument \fIcode\fR is a valid @@ -724,8 +741,9 @@ the "reason phrase" stored in key \fIreasonPhrase\fR). A registry of valid status codes is maintained at https://www.iana.org/assignments/http-status-codes/http-status-codes.xhtml .RE +.\" METHOD: responseHeaders .TP -\fB::http::responseHeaders\fR \fItoken\fR ?\fIheaderName\fR? +\fB::http::responseHeaders\fI token\fR ?\fIheaderName\fR? . The response from a HTTP server includes metadata headers that describe the response body and the transaction itself. @@ -739,8 +757,9 @@ supplied, it provides the value of a header name. Only headers with the requested name (converted to lower case) are returned. If no such headers are found, an empty list is returned. See section \fBMETADATA\fR for more information. +.\" METHOD: responseHeaderValue .TP -\fB::http::responseHeaderValue\fR \fItoken\fR \fIheaderName\fR +\fB::http::responseHeaderValue\fI token headerName\fR . This command returns the value of the HTTP response header named \fIheaderName\fR. Header names are case-insensitive and are converted to @@ -751,9 +770,10 @@ preserving their order. Multiple headers with the same name may be processed in this manner, except \fBSet-Cookie\fR which does not conform to the comma-separated-list syntax and cannot be combined into a single value. Each \fBSet-Cookie\fR header must be treated individually, e.g. by processing -the return value of \fB::http::responseHeaders\fR \fItoken\fR \fBSet-Cookie\fR. +the return value of \fB::http::responseHeaders\fI token\fR \fBSet-Cookie\fR. +.\" METHOD: responseInfo .TP -\fB::http::responseInfo\fR \fItoken\fR +\fB::http::responseInfo\fI token\fR . This command returns a \fBdict\fR of selected response metadata that are essential for identifying a successful transaction and making use of the @@ -775,8 +795,9 @@ text resource as a binary, or vice versa. After a POST transaction, check the value of \fIpostError\fR to verify that the request body was uploaded without error. .RE +.\" METHOD: responseBody .TP -\fB::http::responseBody\fR \fItoken\fR +\fB::http::responseBody\fI token\fR . This command returns the entity sent by the HTTP server (unless \fI-channel\fR was used, in which case the entity was delivered to the @@ -788,8 +809,9 @@ Other terms for "resource", "response body after decoding", "payload", "message body after decoding", "content(s)", and "file". .RE +.\" METHOD: register .TP -\fB::http::register\fR \fIproto port command\fR ?\fIsocketCmdVarName\fR? ?\fIuseSockThread\fR? ?\fIendToEndProxy\fR? +\fB::http::register\fI proto port command\fR ?\fIsocketCmdVarName\fR? ?\fIuseSockThread\fR? ?\fIendToEndProxy\fR? . This procedure allows one to provide custom HTTP transport types such as HTTPS, by registering a prefix, the default port, and the @@ -809,7 +831,7 @@ arguments \fIuseSockThread\fR, \fIendToEndProxy\fR, which take boolean values with default value \fIfalse\fR. .PP Iff argument \fIuseSockThread\fR is supplied and is boolean \fItrue\fR, -then iff permitted by the value [\fBhttp::config\fR \fI-threadlevel\fR] +then iff permitted by the value [\fBhttp::config\fI \-threadlevel\fR] and by the availability of package \fBThread\fR, sockets created for the transport will be opened in a different thread so that a slow DNS lookup will not cause the script to block. @@ -834,8 +856,9 @@ set token [::http::geturl https://my.secure.site/] .CE .RE .RE +.\" METHOD: registerError .TP -\fB::http::registerError\fR \fIsock\fR ?\fImessage\fR? +\fB::http::registerError\fI sock\fR ?\fImessage\fR? . This procedure allows a registered protocol handler to deliver an error message for use by \fBhttp\fR. Calling this command does not raise an @@ -845,27 +868,32 @@ propagate to \fBhttp\fR. The command allows \fBhttp\fR to provide a precise error message rather than a general one. The command returns the value provided by the last call with argument \fImessage\fR, or the empty string if no such call has been made. +.\" METHOD: unregister .TP -\fB::http::unregister\fR \fIproto\fR +\fB::http::unregister\fI proto\fR . This procedure unregisters a protocol handler that was previously registered via \fB::http::register\fR, returning a six-item list of the values that were previously supplied to \fB::http::register\fR if there was such a handler, and an error if there was no such handler. +.\" METHOD: code .TP -\fB::http::code\fR \fItoken\fR +\fB::http::code\fI token\fR . An alternative name for the command \fB::http::responseLine\fR +.\" METHOD: data .TP -\fB::http::data\fR \fItoken\fR +\fB::http::data\fI token\fR . An alternative name for the command \fB::http::responseBody\fR. +.\" METHOD: meta .TP -\fB::http::meta\fR \fItoken\fR ?\fIheaderName\fR? +\fB::http::meta\fI token\fR ?\fIheaderName\fR? . An alternative name for the command \fB::http::responseHeaders\fR +.\" METHOD: ncode .TP -\fB::http::ncode\fR \fItoken\fR +\fB::http::ncode\fI token\fR . An alternative name for the command \fB::http::responseCode\fR .SH ERRORS @@ -1493,6 +1521,7 @@ values of \fIcookieJar\fR will correspond to sessions; it is up to the caller of \fB::http::config\fR to decide what session applies and to manage the deletion of said sessions when they are no longer desired (which should be when they not configured as the current cookie jar). +.\" METHOD: getCookies .TP \fIcookieJar \fBgetCookies \fIprotocol host requestPath\fR . @@ -1509,6 +1538,7 @@ request (typically the one with the most specific \fIhost\fR/domain match and most specific \fIrequestPath\fR/path match), but there may be many cookies with different names in any request. .RE +.\" METHOD: storeCookie .TP \fIcookieJar \fBstoreCookie \fIcookieDictionary\fR . diff --git a/doc/idna.n b/doc/idna.n index 744bf67..7f4ab6a 100644 --- a/doc/idna.n +++ b/doc/idna.n @@ -14,38 +14,41 @@ tcl::idna \- Support for normalization of Internationalized Domain Names .nf package require tcl::idna 1.0 -\fBtcl::idna decode\fR \fIhostname\fR -\fBtcl::idna encode\fR \fIhostname\fR -\fBtcl::idna puny decode\fR \fIstring\fR ?\fIcase\fR? -\fBtcl::idna puny encode\fR \fIstring\fR ?\fIcase\fR? +\fBtcl::idna decode\fI hostname\fR +\fBtcl::idna encode\fI hostname\fR +\fBtcl::idna puny decode\fI string\fR ?\fIcase\fR? +\fBtcl::idna puny encode\fI string\fR ?\fIcase\fR? \fBtcl::idna version\fR .fi .SH DESCRIPTION This package provides an implementation of the punycode scheme used in Internationalised Domain Names, and some access commands. (See RFC 3492 for a description of punycode.) +.\" METHOD: decode .TP -\fBtcl::idna decode\fR \fIhostname\fR +\fBtcl::idna decode\fI hostname\fR . This command takes the name of a host that potentially contains punycode-encoded character sequences, \fIhostname\fR, and returns the hostname as might be displayed to the user. Note that there are often UNICODE characters that have extremely similar glyphs, so care should be taken with displaying hostnames to users. +.\" METHOD: encode .TP -\fBtcl::idna encode\fR \fIhostname\fR +\fBtcl::idna encode\fI hostname\fR . This command takes the name of a host as might be displayed to the user, \fIhostname\fR, and returns the version of the hostname with characters not permitted in basic hostnames encoded with punycode. +.\" METHOD: puny .TP -\fBtcl::idna puny\fR \fIsubcommand ...\fR +\fBtcl::idna puny\fI subcommand ...\fR . This command provides direct access to the basic punycode encoder and decoder. It supports two \fIsubcommand\fRs: .RS .TP -\fBtcl::idna puny decode\fR \fIstring\fR ?\fIcase\fR? +\fBtcl::idna puny decode\fI string\fR ?\fIcase\fR? . This command decodes the punycode-encoded string, \fIstring\fR, and returns the result. If \fIcase\fR is provided, it is a boolean to make the case be @@ -53,7 +56,7 @@ folded to upper case (if \fIcase\fR is true) or lower case (if \fIcase\fR is false) during the decoding process; if omitted, no case transformation is applied. .TP -\fBtcl::idna puny encode\fR \fIstring\fR ?\fIcase\fR? +\fBtcl::idna puny encode\fI string\fR ?\fIcase\fR? . This command encodes the string, \fIstring\fR, and returns the punycode-encoded version of the string. If \fIcase\fR is provided, it is a @@ -61,6 +64,7 @@ boolean to make the case be folded to upper case (if \fIcase\fR is true) or lower case (if \fIcase\fR is false) during the encoding process; if omitted, no case transformation is applied. .RE +.\" METHOD: version .TP \fBtcl::idna version\fR . diff --git a/doc/info.n b/doc/info.n index 24ed3b8..a7896a9 100644 --- a/doc/info.n +++ b/doc/info.n @@ -20,23 +20,28 @@ info \- Information about the state of the Tcl interpreter .SH DESCRIPTION .PP Available commands: +.\" METHOD: args .TP \fBinfo args \fIprocname\fR . Returns the names of the parameters to the procedure named \fIprocname\fR. +.\" METHOD: body .TP \fBinfo body \fIprocname\fR . Returns the body of the procedure named \fIprocname\fR. +.\" METHOD: class .TP \fBinfo class\fI subcommand class\fR ?\fIarg ...\fR . Returns information about the class named \fIclass\fR. See \fBCLASS INTROSPECTION\fR below. +.\" METHOD: cmdcount .TP \fBinfo cmdcount\fR . Returns the total number of commands evaluated in this interpreter. +.\" METHOD: cmdtype .TP \fBinfo cmdtype \fIcommandName\fR .VS TIP426 @@ -70,6 +75,7 @@ that represents an instance of \fBoo::object\fR or one of its subclasses. \fIcommandName\fR was created by \fBzlib stream\fR. .RE .VE TIP426 +.\" METHOD: commands .TP \fBinfo commands \fR?\fIpattern\fR? . @@ -78,18 +84,21 @@ Returns the names of all commands visible in the current namespace. If \fBstring match\fR. Only the last component of \fIpattern\fR is a pattern. Other components identify a namespace. See \fBNAMESPACE RESOLUTION\fR in the \fBnamespace\fR(n) documentation. +.\" METHOD: complete .TP \fBinfo complete \fIcommand\fR . Returns 1 if \fIcommand\fR is a complete command, and \fB0\fR otherwise. Typically used in line-oriented input environments to allow users to type in commands that span multiple lines. +.\" METHOD: constant .TP \fBinfo constant \fIvarName\fR .VS "TIP 677" Returns 1 if \fIvarName\fR is a constant variable (see \fBconst\fR) and 0 otherwise. .VE "TIP 677" +.\" METHOD: consts .TP \fBinfo consts\fR ?\fIpattern\fR? .VS "TIP 677" @@ -97,18 +106,21 @@ Returns the list of constant variables (see \fBconst\fR) in the current scope, or the list of constant variables matching \fIpattern\fR (if that is provided) in a manner similar to \fBinfo vars\fR. .VE "TIP 677" +.\" METHOD: coroutine .TP \fBinfo coroutine\fR . Returns the name of the current \fBcoroutine\fR, or the empty string if there is no current coroutine or the current coroutine has been deleted. +.\" METHOD: default .TP \fBinfo default \fIprocname parameter varname\fR . If the parameter \fIparameter\fR for the procedure named \fIprocname\fR has a default value, stores that value in \fIvarname\fR and returns \fB1\fR. Otherwise, returns \fB0\fR. +.\" METHOD: errorstack .TP \fBinfo errorstack \fR?\fIinterp\fR? . @@ -136,11 +148,13 @@ options dictionary returned by 3-argument \fBcatch\fR; \fBinfo errorstack\fR is a convenient way of retrieving it for uncaught errors at top-level in an interactive \fBinterpreter\fR. .RE +.\" METHOD: exists .TP \fBinfo exists \fIvarName\fR . Returns \fB1\fR if a variable named \fIvarName\fR is visible and has been defined, and \fB0\fR otherwise. +.\" METHOD: frame .TP \fBinfo frame\fR ?\fIdepth\fR? . @@ -242,6 +256,7 @@ is given a literal list argument the system tracks the line number within the list words as well, and otherwise all line numbers are counted relative to the start of each word (smallest scope) .RE +.\" METHOD: functions .TP \fBinfo functions \fR?\fIpattern\fR? . @@ -249,6 +264,7 @@ If \fIpattern\fR is not given, returns a list of all the math functions currently defined. If \fIpattern\fR is given, returns only those names that match \fIpattern\fR according to \fBstring match\fR. +.\" METHOD: globals .TP \fBinfo globals \fR?\fIpattern\fR? . @@ -258,16 +274,20 @@ Global variables are variables in the global namespace. If \fIpattern\fR is given, only those names matching \fIpattern\fR are returned. Matching is determined using the same rules as for \fBstring match\fR. +.\" METHOD: hostname .TP \fBinfo hostname\fR . Returns the name of the current host. - +.RS +.PP This name is not guaranteed to be the fully-qualified domain name of the host. Where machines have several different names, as is common on systems with both TCP/IP (DNS) and NetBIOS-based networking installed, it is the name that is suitable for TCP/IP networking that is returned. +.RE +.\" METHOD: level .TP \fBinfo level\fR ?\fIlevel\fR? . @@ -277,11 +297,13 @@ Otherwise returns the complete command active at the given level. If is \fInumber\fR levels up from the current level. A complete command is the words in the command, with all subsitutions performed, meaning that it is a list. See \fBuplevel\fR for more information on levels. +.\" METHOD: library .TP \fBinfo library\fR . Returns the value of \fBtcl_library\fR, which is the name of the library directory in which the scripts distributed with Tcl scripts are stored. +.\" METHOD: loaded .TP \fBinfo loaded \fR?\fIinterp\fR? ?\fIpackage\fR? . @@ -290,6 +312,7 @@ Returns the name of each file loaded in \fIinterp\fR va \fBload\fR as part of is the name of the loaded file and the name of the package for which the file was loaded. For a statically-loaded package the name of the file is the empty string. For \fIinterp\fR, the empty string is the current interpreter. +.\" METHOD: locals .TP \fBinfo locals \fR?\fIpattern\fR? . @@ -297,22 +320,25 @@ If \fIpattern\fR is given, returns the name of each local variable matching \fIpattern\fR according to \fBstring match\fR. Otherwise, returns the name of each local variable. A variables defined with the \fBglobal\fR, \fBupvar\fR or \fBvariable\fR is not local. - +.\" METHOD: nameofexecutable .TP \fBinfo nameofexecutable\fR . Returns the absolute pathname of the program for the current interpreter. If such a file can not be identified an empty string is returned. +.\" METHOD: object .TP \fBinfo object\fI subcommand object\fR ?\fIarg ...\fR . Returns information about the object named \fIobject\fR. \fIsubcommand\fR is described \fBOBJECT INTROSPECTION\fR below. +.\" METHOD: patchlevel .TP \fBinfo patchlevel\fR . Returns the value of the global variable \fBtcl_patchLevel\fR, in which the exact version of the Tcl library initially stored. +.\" METHOD: procs .TP \fBinfo procs \fR?\fIpattern\fR? . @@ -321,6 +347,7 @@ only those names that match according to \fBstring match\fR. Only the final component in \fIpattern\fR is actually considered a pattern. Any qualifying components simply select a namespace. See \fBNAMESPACE RESOLUTION\fR in the \fBnamespace\fR(n) documentation. +.\" METHOD: script .TP \fBinfo script\fR ?\fIfilename\fR? . @@ -329,17 +356,20 @@ empty string if no pathname can be determined. If \fIfilename\fR is given, sets the return value of any future calls to \fBinfo script\fR for the duration of the innermost active script. This is useful in virtual file system applications. +.\" METHOD: sharedlibextension .TP \fBinfo sharedlibextension\fR . Returns the extension used on this platform for names of shared libraries, e.g. \fB.so\fR under Solaris. Returns the empty string if shared libraries are not supported on this platform. +.\" METHOD: tclversion .TP \fBinfo tclversion\fR . Returns the value of the global variable \fBtcl_version\fR, in which the major and minor version of the Tcl library are stored. +.\" METHOD: vars .TP \fBinfo vars\fR ?\fIpattern\fR? . @@ -349,11 +379,15 @@ If \fIpattern\fR is not given, returns the names of all visible variables. If Other components identify a namespace. See \fBNAMESPACE RESOLUTION\fR in the \fBnamespace\fR(n) documentation. When \fIpattern\fR is a qualified name, results are fully qualified. - -A variable that has declared but not yet defined is included in the results. +.RS +.PP +A variable that has been declared but not yet given a value will be included in +the results. +.RE .SS "CLASS INTROSPECTION" .PP The following \fIsubcommand\fR values are supported by \fBinfo class\fR: +.\" METHOD: call .TP \fBinfo class call\fI class method\fR . @@ -384,6 +418,7 @@ and the call chains that this command files do not actually contain private methods. .VE TIP500 .RE +.\" METHOD: constructor .TP \fBinfo class constructor\fI class\fR . @@ -393,6 +428,7 @@ element is the list of arguments to the constructor in a form suitable for passing to another call to \fBproc\fR or a method definition, and the second element is the body of the constructor. If no constructor is present, this returns the empty list. +.\" METHOD: definition .TP \fBinfo class definition\fI class method\fR . @@ -401,6 +437,7 @@ This subcommand returns a description of the definition of the method named list; the first element is the list of arguments to the method in a form suitable for passing to another call to \fBproc\fR or a method definition, and the second element is the body of the method. +.\" METHOD: definitionnamespace .TP \fBinfo class definitionnamespace\fI class\fR ?\fIkind\fR? .VS TIP524 @@ -419,26 +456,31 @@ this command returns the empty string. In those circumstances, the namespace to use using the class inheritance hierarchy. .RE .VE TIP524 +.\" METHOD: destructor .TP \fBinfo class destructor\fI class\fR . This subcommand returns the body of the destructor of class \fIclass\fR. If no destructor is present, this returns the empty string. +.\" METHOD: filters .TP \fBinfo class filters\fI class\fR . This subcommand returns the list of filter methods set on the class. +.\" METHOD: forward .TP \fBinfo class forward\fI class method\fR . This subcommand returns the argument list for the method forwarding called \fImethod\fR that is set on the class called \fIclass\fR. +.\" METHOD: instances .TP \fBinfo class instances\fI class\fR ?\fIpattern\fR? . This subcommand returns a list of instances of class \fIclass\fR. If the optional \fIpattern\fR argument is present, it constrains the list of returned instances to those that match it according to the rules of \fBstring match\fR. +.\" METHOD: methods .TP \fBinfo class methods\fI class\fR ?\fIoptions...\fR? . @@ -489,6 +531,7 @@ methods) are to be returned. .RE .VE TIP500 .RE +.\" METHOD: methodtype .TP \fBinfo class methodtype\fI class method\fR . @@ -497,11 +540,13 @@ the method named \fImethod\fR of class \fIclass\fR. When the result is \fBmethod\fR, further information can be discovered with \fBinfo class definition\fR, and when the result is \fBforward\fR, further information can be discovered with \fBinfo class forward\fR. +.\" METHOD: mixins .TP \fBinfo class mixins\fI class\fR . This subcommand returns a list of all classes that have been mixed into the class named \fIclass\fR. +.\" METHOD: properties .TP \fBinfo class properties\fI class\fR ?\fIoptions...\fR .VS "TIP 558" @@ -525,6 +570,7 @@ This option asks for the writable properties to be returned. Only readable or writable properties are returned, not both. .RE .VE "TIP 558" +.\" METHOD: subclasses .TP \fBinfo class subclasses\fI class\fR ?\fIpattern\fR? . @@ -532,11 +578,13 @@ This subcommand returns a list of direct subclasses of class \fIclass\fR. If the optional \fIpattern\fR argument is present, it constrains the list of returned classes to those that match it according to the rules of \fBstring match\fR. +.\" METHOD: superclasses .TP \fBinfo class superclasses\fI class\fR . This subcommand returns a list of direct superclasses of class \fIclass\fR in inheritance precedence order. +.\" METHOD: variables .TP \fBinfo class variables\fI class\fR ?\fB\-private\fR? . @@ -550,6 +598,7 @@ declared instead. .SS "OBJECT INTROSPECTION" .PP The following \fIsubcommand\fR values are supported by \fBinfo object\fR: +.\" METHOD: call .TP \fBinfo object call\fI object method\fR . @@ -579,12 +628,14 @@ and the call chains that this command files do not actually contain private methods. .VE TIP500 .RE +.\" METHOD: class .TP \fBinfo object class\fI object\fR ?\fIclassName\fR? . If \fIclassName\fR is not given, this subcommand returns class of the \fIobject\fR object. If \fIclassName\fR is present, this subcommand returns a boolean value indicating whether the \fIobject\fR is of that class. +.\" METHOD: creationid .TP \fBinfo object creationid\fI object\fR .VS TIP500 @@ -597,6 +648,7 @@ cannot be controlled at object creation time or altered afterwards. identifiers associated with the object, especially for private variables. .RE .VE TIP500 +.\" METHOD: definition .TP \fBinfo object definition\fI object method\fR . @@ -605,15 +657,18 @@ This subcommand returns a description of the definition of the method named element list; the first element is the list of arguments to the method in a form suitable for passing to another call to \fBproc\fR or a method definition, and the second element is the body of the method. +.\" METHOD: filters .TP \fBinfo object filters\fI object\fR . This subcommand returns the list of filter methods set on the object. +.\" METHOD: forward .TP \fBinfo object forward\fI object method\fR . This subcommand returns the argument list for the method forwarding called \fImethod\fR that is set on the object called \fIobject\fR. +.\" METHOD: isa .TP \fBinfo object isa\fI category object\fR ?\fIarg\fR? . @@ -646,6 +701,7 @@ This returns whether \fIclass\fR is the type of \fIobject\fR (i.e. whether \fIobject\fR is an instance of \fIclass\fR or one of its subclasses, whether direct or indirect). .RE +.\" METHOD: methods .TP \fBinfo object methods\fI object\fR ?\fIoption...\fR? . @@ -696,6 +752,7 @@ instance methods) are to be returned. .RE .VE TIP500 .RE +.\" METHOD: methodtype .TP \fBinfo object methodtype\fI object method\fR . @@ -704,16 +761,19 @@ the method named \fImethod\fR of object \fIobject\fR. When the result is \fBmethod\fR, further information can be discovered with \fBinfo object definition\fR, and when the result is \fBforward\fR, further information can be discovered with \fBinfo object forward\fR. +.\" METHOD: mixins .TP \fBinfo object mixins\fI object\fR . This subcommand returns a list of all classes that have been mixed into the object named \fIobject\fR. +.\" METHOD: namespace .TP \fBinfo object namespace\fI object\fR . This subcommand returns the name of the internal namespace of the object named \fIobject\fR. +.\" METHOD: properties .TP \fBinfo object properties\fI object\fR ?\fIoptions...\fR .VS "TIP 558" @@ -738,6 +798,7 @@ This option asks for the writable properties to be returned. Only readable or writable properties are returned, not both. .RE .VE "TIP 558" +.\" METHOD: variables .TP \fBinfo object variables\fI object\fRR ?\fB\-private\fR? . @@ -748,6 +809,7 @@ object's methods). If the \fB\-private\fR option is given, this lists the private variables declared instead. .VE TIP500 +.\" METHOD: vars .TP \fBinfo object vars\fI object\fR ?\fIpattern\fR? . diff --git a/doc/interp.n b/doc/interp.n index 7037c65..7cff9c2 100644 --- a/doc/interp.n +++ b/doc/interp.n @@ -87,8 +87,9 @@ The \fBinterp\fR command is used to create, delete, and manipulate child interpreters, and to share or transfer channels between interpreters. It can have any of several forms, depending on the \fIsubcommand\fR argument: +.\" METHOD: alias .TP -\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcToken\fR +\fBinterp alias\fI srcPath srcToken\fR . Returns a Tcl list whose elements are the \fItargetCmd\fR and \fIarg\fRs associated with the alias represented by \fIsrcToken\fR @@ -96,7 +97,7 @@ Returns a Tcl list whose elements are the \fItargetCmd\fR and created; it is possible that the name of the source command in the child is different from \fIsrcToken\fR). .TP -\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcToken\fR \fB{}\fR +\fBinterp alias\fI srcPath srcToken\fR \fB{}\fR . Deletes the alias for \fIsrcToken\fR in the child interpreter identified by \fIsrcPath\fR. @@ -104,7 +105,7 @@ Deletes the alias for \fIsrcToken\fR in the child interpreter identified by was created; if the source command has been renamed, the renamed command will be deleted. .TP -\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcCmd\fR \fItargetPath\fR \fItargetCmd \fR?\fIarg arg ...\fR? +\fBinterp alias\fI srcPath srcCmd targetPath targetCmd \fR?\fIarg arg ...\fR? . This command creates an alias between one child and another (see the \fBalias\fR child command below for creating aliases between a child @@ -135,14 +136,16 @@ more details. The command returns a token that uniquely identifies the command created \fIsrcCmd\fR, even if the command is renamed afterwards. The token may but does not have to be equal to \fIsrcCmd\fR. +.\" METHOD: aliases .TP -\fBinterp\fR \fBaliases \fR?\fIpath\fR? +\fBinterp aliases \fR?\fIpath\fR? . This command returns a Tcl list of the tokens of all the source commands for aliases defined in the interpreter identified by \fIpath\fR. The tokens correspond to the values returned when the aliases were created (which may not be the same as the current names of the commands). +.\" METHOD: bgerror .TP \fBinterp bgerror \fIpath\fR ?\fIcmdPrefix\fR? . @@ -152,8 +155,10 @@ absent, the current background exception handler is returned, and if it is present, it is a list of words (of minimum length one) that describes what to set the interpreter's background exception handler to. See the \fBBACKGROUND EXCEPTION HANDLING\fR section for more details. +.\" METHOD: cancel .TP -\fBinterp\fR \fBcancel \fR?\fB\-unwind\fR? ?\fB\-\|\-\fR? ?\fIpath\fR? ?\fIresult\fR? +\fBinterp cancel \fR?\fB\-unwind\fR? ?\fB\-\|\-\fR? ?\fIpath\fR? ?\fIresult\fR? +. Cancels the script being evaluated in the interpreter identified by \fIpath\fR. Without the \fB\-unwind\fR switch the evaluation stack for the interpreter is unwound until an enclosing catch command is found or @@ -166,8 +171,16 @@ switches; it may be needed if \fIpath\fR is an unusual value such as \fB\-safe\fR. If \fIresult\fR is present, it will be used as the error message string; otherwise, a default error message string will be used. +.\" METHOD: children +.TP +\fBinterp children\fR ?\fIpath\fR? +. +Returns a Tcl list of the names of all the child interpreters associated +with the interpreter identified by \fIpath\fR. If \fIpath\fR is omitted, +the invoking interpreter is used. +.\" METHOD: create .TP -\fBinterp\fR \fBcreate \fR?\fB\-safe\fR? ?\fB\-\|\-\fR? ?\fIpath\fR? +\fBinterp create \fR?\fB\-safe\fR? ?\fB\-\|\-\fR? ?\fIpath\fR? . Creates a child interpreter identified by \fIpath\fR and a new command, called a \fIchild command\fR. The name of the child command is the last @@ -191,8 +204,9 @@ the children for its parent; an error occurs if a child interpreter by the given name already exists in this parent. The initial recursion limit of the child interpreter is set to the current recursion limit of its parent interpreter. +.\" METHOD: debug .TP -\fBinterp\fR \fBdebug \fIpath\fR ?\fB\-frame\fR ?\fIbool\fR?? +\fBinterp debug \fIpath\fR ?\fB\-frame\fR ?\fIbool\fR?? . Controls whether frame-level stack information is captured in the child interpreter identified by \fIpath\fR. If no arguments are @@ -233,16 +247,18 @@ Note that once it is on, this flag cannot be switched back off: such attempts are silently ignored. This is needed to maintain the consistency of the underlying interpreter's state. .RE +.\" METHOD: delete .TP -\fBinterp\fR \fBdelete \fR?\fIpath ...\fR? +\fBinterp delete \fR?\fIpath ...\fR? . Deletes zero or more interpreters given by the optional \fIpath\fR arguments, and for each interpreter, it also deletes its children. The command also deletes the child command for each interpreter deleted. For each \fIpath\fR argument, if no interpreter by that name exists, the command raises an error. +.\" METHOD: eval .TP -\fBinterp\fR \fBeval\fR \fIpath arg \fR?\fIarg ...\fR? +\fBinterp eval\fI path arg \fR?\fIarg ...\fR? . This command concatenates all of the \fIarg\fR arguments in the same fashion as the \fBconcat\fR command, then evaluates the resulting string as @@ -255,14 +271,16 @@ Note that the script will be executed in the current context stack frame of the interpreter) of aliases in a child interpreter can execute scripts in the child that find out information about the child's current state and stack frame. +.\" METHOD: exists .TP \fBinterp exists \fIpath\fR . Returns \fB1\fR if a child interpreter by the specified \fIpath\fR exists in this parent, \fB0\fR otherwise. If \fIpath\fR is omitted, the invoking interpreter is used. +.\" METHOD: expose .TP -\fBinterp expose \fIpath\fR \fIhiddenName\fR ?\fIexposedCmdName\fR? +\fBinterp expose \fIpath hiddenName\fR ?\fIexposedCmdName\fR? . Makes the hidden command \fIhiddenName\fR exposed, eventually bringing it back under a new \fIexposedCmdName\fR name (this name is currently @@ -272,8 +290,9 @@ denoted by \fIpath\fR. If an exposed command with the targeted name already exists, this command fails. Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below. +.\" METHOD: hide .TP -\fBinterp\fR \fBhide\fR \fIpath\fR \fIexposedCmdName\fR ?\fIhiddenCmdName\fR? +\fBinterp hide\fI path exposedCmdName\fR ?\fIhiddenCmdName\fR? . Makes the exposed command \fIexposedCmdName\fR hidden, renaming it to the hidden command \fIhiddenCmdName\fR, or keeping the same name if @@ -288,13 +307,15 @@ namespace even if the current namespace is not the global one. This prevents children from fooling a parent interpreter into hiding the wrong command, by making the current namespace be different from the global one. Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below. +.\" METHOD: hidden .TP -\fBinterp\fR \fBhidden\fR \fIpath\fR +\fBinterp hidden\fI path\fR . Returns a list of the names of all hidden commands in the interpreter identified by \fIpath\fR. +.\" METHOD: invokehidden .TP -\fBinterp\fR \fBinvokehidden\fR \fIpath\fR ?\fI\-option ...\fR? \fIhiddenCmdName\fR ?\fIarg ...\fR? +\fBinterp invokehidden\fI path\fR ?\fI\-option ...\fR? \fIhiddenCmdName\fR ?\fIarg ...\fR? . Invokes the hidden command \fIhiddenCmdName\fR with the arguments supplied in the interpreter denoted by \fIpath\fR. No substitutions or evaluation @@ -315,13 +336,15 @@ If both the \fB\-namespace\fR and \fB\-global\fR flags are present, the Note that the hidden command will be executed (by default) in the current context stack frame of the \fIpath\fR interpreter. Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below. +.\" METHOD: issafe .TP \fBinterp issafe\fR ?\fIpath\fR? . Returns \fB1\fR if the interpreter identified by the specified \fIpath\fR is safe, \fB0\fR otherwise. +.\" METHOD: limit .TP -\fBinterp\fR \fBlimit\fR \fIpath\fR \fIlimitType\fR ?\fI\-option\fR? ?\fIvalue\fR \fI...\fR? +\fBinterp limit\fI path limitType\fR ?\fI\-option\fR? ?\fIvalue ...\fR? . Sets up, manipulates and queries the configuration of the resource limit \fIlimitType\fR for the interpreter denoted by \fIpath\fR. If @@ -330,16 +353,18 @@ limit. If \fI\-option\fR is the sole argument, return the value of that option. Otherwise, a list of \fI\-option\fR/\fIvalue\fR argument pairs must supplied. See \fBRESOURCE LIMITS\fR below for a more detailed explanation of what limits and options are supported. +.\" METHOD: marktrusted .TP -\fBinterp marktrusted\fR \fIpath\fR +\fBinterp marktrusted\fI path\fR . Marks the interpreter identified by \fIpath\fR as trusted. Does not expose the hidden commands. This command can only be invoked from a trusted interpreter. The command has no effect if the interpreter identified by \fIpath\fR is already trusted. +.\" METHOD: recursionlimit .TP -\fBinterp\fR \fBrecursionlimit\fR \fIpath\fR ?\fInewlimit\fR? +\fBinterp recursionlimit\fI path\fR ?\fInewlimit\fR? . Returns the maximum allowable nesting depth for the interpreter specified by \fIpath\fR. If \fInewlimit\fR is specified, @@ -358,8 +383,9 @@ may get stack overflows before reaching the limit set by the command. If this happens, see if there is a mechanism in your system for increasing the maximum size of the C stack. .RE +.\" METHOD: share .TP -\fBinterp\fR \fBshare\fR \fIsrcPath channelId destPath\fR +\fBinterp share\fI srcPath channelId destPath\fR . Causes the IO channel identified by \fIchannelId\fR to become shared between the interpreter identified by \fIsrcPath\fR and the interpreter @@ -368,14 +394,9 @@ on the IO channel. Both interpreters must close it to close the underlying IO channel; IO channels accessible in an interpreter are automatically closed when an interpreter is destroyed. +.\" METHOD: target .TP -\fBinterp\fR \fBchildren\fR ?\fIpath\fR? -. -Returns a Tcl list of the names of all the child interpreters associated -with the interpreter identified by \fIpath\fR. If \fIpath\fR is omitted, -the invoking interpreter is used. -.TP -\fBinterp\fR \fBtarget\fR \fIpath alias\fR +\fBinterp target\fI path alias\fR . Returns a Tcl list describing the target interpreter for an alias. The alias is specified with an interpreter path and source command name, just @@ -385,8 +406,9 @@ If the target interpreter for the alias is the invoking interpreter then an empty list is returned. If the target interpreter for the alias is not the invoking interpreter or one of its descendants then an error is generated. The target command does not have to be defined at the time of this invocation. +.\" METHOD: transfer .TP -\fBinterp\fR \fBtransfer\fR \fIsrcPath channelId destPath\fR +\fBinterp transfer\fI srcPath channelId destPath\fR . Causes the IO channel identified by \fIchannelId\fR to become available in the interpreter identified by \fIdestPath\fR and unavailable in the @@ -406,6 +428,7 @@ general form: \fIChild\fR is the name of the interpreter, and \fIcommand\fR and the \fIarg\fRs determine the exact behavior of the command. The valid forms of this command are: +.\" METHOD: aliases .TP \fIchild \fBaliases\fR . @@ -413,6 +436,7 @@ Returns a Tcl list whose elements are the tokens of all the aliases in \fIchild\fR. The tokens correspond to the values returned when the aliases were created (which may not be the same as the current names of the commands). +.\" METHOD: alias .TP \fIchild \fBalias \fIsrcToken\fR . @@ -440,6 +464,7 @@ See \fBALIAS INVOCATION\fR below for details. The command returns a token that uniquely identifies the command created \fIsrcCmd\fR, even if the command is renamed afterwards. The token may but does not have to be equal to \fIsrcCmd\fR. +.\" METHOD: bgerror .TP \fIchild \fBbgerror\fR ?\fIcmdPrefix\fR? . @@ -449,6 +474,7 @@ absent, the current background exception handler is returned, and if it is present, it is a list of words (of minimum length one) that describes what to set the interpreter's background exception handler to. See the \fBBACKGROUND EXCEPTION HANDLING\fR section for more details. +.\" METHOD: eval .TP \fIchild \fBeval \fIarg \fR?\fIarg ..\fR? . @@ -463,6 +489,7 @@ of \fIchild\fR; this is so that the implementations (in a parent interpreter) of aliases in a child interpreter can execute scripts in the child that find out information about the child's current state and stack frame. +.\" METHOD: expose .TP \fIchild \fBexpose \fIhiddenName \fR?\fIexposedCmdName\fR? . @@ -473,6 +500,7 @@ in \fIchild\fR. If an exposed command with the targeted name already exists, this command fails. For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below. +.\" METHOD: hide .TP \fIchild \fBhide \fIexposedCmdName\fR ?\fIhiddenCmdName\fR? . @@ -488,10 +516,12 @@ namespace even if the current namespace is not the global one. This prevents children from fooling a parent interpreter into hiding the wrong command, by making the current namespace be different from the global one. For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below. +.\" METHOD: hidden .TP \fIchild \fBhidden\fR . Returns a list of the names of all hidden commands in \fIchild\fR. +.\" METHOD: invokehidden .TP \fIchild \fBinvokehidden\fR ?\fI\-option ...\fR? \fIhiddenName \fR?\fIarg ..\fR? . @@ -514,12 +544,14 @@ Note that the hidden command will be executed (by default) in the current context stack frame of \fIchild\fR. For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below. +.\" METHOD: issafe .TP \fIchild \fBissafe\fR . -Returns \fB1\fR if the child interpreter is safe, \fB0\fR otherwise. +Returns \fB1\fR if the child interpreter is safe, \fB0\fR otherwise. +.\" METHOD: limit .TP -\fIchild \fBlimit\fR \fIlimitType\fR ?\fI\-option\fR? ?\fIvalue\fR \fI...\fR? +\fIchild \fBlimit\fI limitType\fR ?\fI\-option\fR? ?\fIvalue ...\fR? . Sets up, manipulates and queries the configuration of the resource limit \fIlimitType\fR for the child interpreter. If no \fI\-option\fR @@ -528,6 +560,7 @@ is specified, return the current configuration of the limit. If Otherwise, a list of \fI\-option\fR/\fIvalue\fR argument pairs must supplied. See \fBRESOURCE LIMITS\fR below for a more detailed explanation of what limits and options are supported. +.\" METHOD: marktrusted .TP \fIchild \fBmarktrusted\fR . @@ -535,8 +568,9 @@ Marks the child interpreter as trusted. Can only be invoked by a trusted interpreter. This command does not expose any hidden commands in the child interpreter. The command has no effect if the child is already trusted. +.\" METHOD: recursionlimit .TP -\fIchild\fR \fBrecursionlimit\fR ?\fInewlimit\fR? +\fIchild \fBrecursionlimit\fR ?\fInewlimit\fR? . Returns the maximum allowable nesting depth for the \fIchild\fR interpreter. If \fInewlimit\fR is specified, the recursion limit in \fIchild\fR will be diff --git a/doc/library.n b/doc/library.n index 0342cbe..d55218d 100644 --- a/doc/library.n +++ b/doc/library.n @@ -61,6 +61,7 @@ the auto-load mechanism defined below. .SH "COMMAND PROCEDURES" .PP The following procedures are provided in the Tcl library: +.\" COMMAND: auto_execok .TP \fBauto_execok \fIcmd\fR . @@ -97,6 +98,7 @@ you would do: set mayFrob [expr {[llength [\fBauto_execok\fR frobnicate]] > 0}] .CE .RE +.\" COMMAND: auto_import .TP \fBauto_import \fIpattern\fR . @@ -111,6 +113,7 @@ matching rules of \fBnamespace import\fR. .PP It is not normally necessary to call this command directly. .RE +.\" COMMAND: auto_load .TP \fBauto_load \fIcmd\fR . @@ -142,6 +145,7 @@ reload the index database from disk. It is not normally necessary to call this command directly; the default \fBunknown\fR handler will do so. .RE +.\" COMMAND: auto_mkindex .TP \fBauto_mkindex \fIdir pattern pattern ...\fR . @@ -184,6 +188,7 @@ code, such as global initialization code or procedure names with special characters like \fB$\fR, \fB*\fR, \fB[\fR or \fB]\fR, you are safer using \fBauto_mkindex_old\fR. .RE +.\" COMMAND: auto_reset .TP \fBauto_reset\fR . @@ -192,6 +197,7 @@ Destroys all the information cached by \fBauto_execok\fR and time it is needed. \fBAuto_reset\fR also deletes any procedures listed in the auto-load index, so that fresh copies of them will be loaded the next time that they are used. +.\" COMMAND: auto_qualify .TP \fBauto_qualify \fIcommand namespace\fR . @@ -212,6 +218,7 @@ if it were a command in the global namespace. for producing auto-loading indexes such as \fIpkgIndex.tcl\fR, and for performing the actual auto-loading of functions at runtime. .RE +.\" COMMAND: auto_findLibrary .TP \fBtcl_findLibrary \fIbasename version patch initScript enVarName varName\fR . @@ -235,6 +242,7 @@ relative to the executable file in the standard installation bin or bin/\fIarch\fR directory; relative to the executable file in the current build tree; relative to the executable file in a parallel build tree. +.\" COMMAND: parray .TP \fBparray \fIarrayName\fR ?\fIpattern\fR? . @@ -256,6 +264,7 @@ For example, to print the contents of the \fBtcl_platform\fR array, do: .SS "WORD BOUNDARY HELPERS" .PP These procedures are mainly used internally by Tk. +.\" COMMAND: tcl_endOfWord .TP \fBtcl_endOfWord \fIstr start\fR . @@ -267,6 +276,7 @@ are no more end-of-word locations after the starting point. See the description of \fBtcl_wordchars\fR and \fBtcl_nonwordchars\fR below for more details on how Tcl determines which characters are word characters. +.\" COMMAND: tcl_startOfNextWord .TP \fBtcl_startOfNextWord \fIstr start\fR . @@ -288,6 +298,7 @@ for {set idx 0} {$idx >= 0} { } .CE .RE +.\" COMMAND: tcl_startOfPreviousWord .TP \fBtcl_startOfPreviousWord \fIstr start\fR . @@ -295,6 +306,7 @@ Returns the index of the first start-of-word location that occurs before a starting index \fIstart\fR in the string \fIstr\fR. Returns \-1 if there are no more start-of-word locations before the starting point. +.\" COMMAND: tcl_wordBreakAfter .TP \fBtcl_wordBreakAfter \fIstr start\fR . @@ -303,6 +315,7 @@ Returns the index of the first word boundary after the starting index boundaries after the starting point in the given string. The index returned refers to the second character of the pair that comprises a boundary. +.\" COMMAND: tcl_wordBreakBefore .TP \fBtcl_wordBreakBefore \fIstr start\fR . @@ -311,6 +324,8 @@ Returns the index of the first word boundary before the starting index boundaries before the starting point in the given string. The index returned refers to the second character of the pair that comprises a boundary. +.SS "FILE ACCESS HELPERS" +.\" COMMAND: foreachLine .TP \fBforeachLine \fIvarName filename body\fR .VS "Tcl 8.7, TIP 670" @@ -325,6 +340,7 @@ The overall result of \fBforeachLine\fR is the empty string (assuming no errors from I/O or from evaluating the body of the loop); the file will be closed prior to the procedure returning. .VE "Tcl 8.7, TIP 670" +.\" COMMAND: readFile .TP \fBreadFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR? .VS "Tcl 8.7, TIP 670" @@ -335,6 +351,7 @@ The second argument says how to read in the file, either as \fBtext\fR will include any trailing newline. The file will be closed prior to the procedure returning. .VE "Tcl 8.7, TIP 670" +.\" COMMAND: writeFile .TP \fBwriteFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR? \fIcontents\fR .VS "Tcl 8.7, TIP 670" @@ -352,6 +369,7 @@ The following global variables are defined or used by the procedures in the Tcl library. They fall into two broad classes, handling unknown commands and packages, and determining what are words. .SS "AUTOLOADING AND PACKAGE MANAGEMENT VARIABLES" +.\" VARIABLE: auto_execs .TP \fBauto_execs\fR . @@ -361,6 +379,7 @@ particular commands exist as executable files. .PP Not normally usefully accessed directly by user code. .RE +.\" VARIABLE: auto_index .TP \fBauto_index\fR . @@ -370,16 +389,19 @@ disk. .PP Not normally usefully accessed directly by user code. .RE +.\" VARIABLE: auto_noexec .TP \fBauto_noexec\fR . If set to any value, then \fBunknown\fR will not attempt to auto-exec any commands. +.\" VARIABLE: auto_noload .TP \fBauto_noload\fR . If set to any value, then \fBunknown\fR will not attempt to auto-load any commands. +.\" VARIABLE: auto_path .TP \fBauto_path\fR . @@ -405,6 +427,7 @@ lappend \fBauto_path\fR [file dirname [info script]]/lib Note that if the script uses \fBcd\fR, it is advisable to ensure that entries on the \fBauto_path\fR are \fBfile normalize\fRd. .RE +.\" VARIABLE: env(TCL_LIBRARY) .TP \fBenv(TCL_LIBRARY)\fR . @@ -419,6 +442,7 @@ Use of this environment variable is not recommended outside of testing. Tcl installations should already know where to find their own script files, as the value is baked in during the build or installation. .RE +.\" VARIABLE: env(TCLLIBPATH) .TP \fBenv(TCLLIBPATH)\fR . @@ -441,6 +465,7 @@ as their own threads or subprocesses). These variables are only used in the \fBtcl_endOfWord\fR, \fBtcl_startOfNextWord\fR, \fBtcl_startOfPreviousWord\fR, \fBtcl_wordBreakAfter\fR, and \fBtcl_wordBreakBefore\fR commands. +.\" VARIABLE: tcl_nonwordchars .TP \fBtcl_nonwordchars\fR . @@ -449,6 +474,7 @@ like \fBtcl_endOfWord\fR to identify whether a character is part of a word or not. If the pattern matches a character, the character is considered to be a non-word character. The default value is .QW "\\W" . +.\" VARIABLE: tcl_wordchars .TP \fBtcl_wordchars\fR . diff --git a/doc/link.n b/doc/link.n index a11c261..4561b57 100644 --- a/doc/link.n +++ b/doc/link.n @@ -15,7 +15,7 @@ link \- create link from command to method of object .nf package require tcl::oo -\fBlink\fR \fImethodName\fR ?\fI...\fR? +\fBlink\fI methodName\fR ?\fI...\fR? \fBlink\fR \fB{\fIcommandName methodName\fB}\fR ?\fI...\fR? .fi .BE diff --git a/doc/lseq.n b/doc/lseq.n index 8b6bd2e..fded359 100644 --- a/doc/lseq.n +++ b/doc/lseq.n @@ -13,7 +13,7 @@ lseq \- Build a numeric sequence returned as a list .SH SYNOPSIS \fBlseq \fIstart \fR?(\fB..\fR|\fBto\fR)? \fIend\fR ??\fBby\fR? \fIstep\fR? -\fBlseq \fIstart \fBcount\fR \fIcount\fR ??\fBby\fR? \fIstep\fR? +\fBlseq \fIstart \fBcount\fI count\fR ??\fBby\fR? \fIstep\fR? \fBlseq \fIcount\fR ?\fBby \fIstep\fR? .BE diff --git a/doc/mathfunc.n b/doc/mathfunc.n index 805cf82..00fef17 100644 --- a/doc/mathfunc.n +++ b/doc/mathfunc.n @@ -15,83 +15,83 @@ mathfunc \- Mathematical functions for Tcl expressions .SH SYNOPSIS package require \fBTcl 8.5-\fR .sp -\fB::tcl::mathfunc::abs\fR \fIarg\fR +\fB::tcl::mathfunc::abs\fI arg\fR .br -\fB::tcl::mathfunc::acos\fR \fIarg\fR +\fB::tcl::mathfunc::acos\fI arg\fR .br -\fB::tcl::mathfunc::asin\fR \fIarg\fR +\fB::tcl::mathfunc::asin\fI arg\fR .br -\fB::tcl::mathfunc::atan\fR \fIarg\fR +\fB::tcl::mathfunc::atan\fI arg\fR .br -\fB::tcl::mathfunc::atan2\fR \fIy\fR \fIx\fR +\fB::tcl::mathfunc::atan2\fI y x\fR .br -\fB::tcl::mathfunc::bool\fR \fIarg\fR +\fB::tcl::mathfunc::bool\fI arg\fR .br -\fB::tcl::mathfunc::ceil\fR \fIarg\fR +\fB::tcl::mathfunc::ceil\fI arg\fR .br -\fB::tcl::mathfunc::cos\fR \fIarg\fR +\fB::tcl::mathfunc::cos\fI arg\fR .br -\fB::tcl::mathfunc::cosh\fR \fIarg\fR +\fB::tcl::mathfunc::cosh\fI arg\fR .br -\fB::tcl::mathfunc::double\fR \fIarg\fR +\fB::tcl::mathfunc::double\fI arg\fR .br -\fB::tcl::mathfunc::entier\fR \fIarg\fR +\fB::tcl::mathfunc::entier\fI arg\fR .br -\fB::tcl::mathfunc::exp\fR \fIarg\fR +\fB::tcl::mathfunc::exp\fI arg\fR .br -\fB::tcl::mathfunc::floor\fR \fIarg\fR +\fB::tcl::mathfunc::floor\fI arg\fR .br -\fB::tcl::mathfunc::fmod\fR \fIx\fR \fIy\fR +\fB::tcl::mathfunc::fmod\fI x y\fR .br -\fB::tcl::mathfunc::hypot\fR \fIx\fR \fIy\fR +\fB::tcl::mathfunc::hypot\fI x y\fR .br -\fB::tcl::mathfunc::int\fR \fIarg\fR +\fB::tcl::mathfunc::int\fI arg\fR .br .VS "8.7, TIP 521" -\fB::tcl::mathfunc::isfinite\fR \fIarg\fR +\fB::tcl::mathfunc::isfinite\fI arg\fR .br -\fB::tcl::mathfunc::isinf\fR \fIarg\fR +\fB::tcl::mathfunc::isinf\fI arg\fR .br -\fB::tcl::mathfunc::isnan\fR \fIarg\fR +\fB::tcl::mathfunc::isnan\fI arg\fR .br -\fB::tcl::mathfunc::isnormal\fR \fIarg\fR +\fB::tcl::mathfunc::isnormal\fI arg\fR .VE "8.7, TIP 521" .br -\fB::tcl::mathfunc::isqrt\fR \fIarg\fR +\fB::tcl::mathfunc::isqrt\fI arg\fR .br .VS "8.7, TIP 521" -\fB::tcl::mathfunc::issubnormal\fR \fIarg\fR +\fB::tcl::mathfunc::issubnormal\fI arg\fR .br -\fB::tcl::mathfunc::isunordered\fR \fIx y\fR +\fB::tcl::mathfunc::isunordered\fI x y\fR .VE "8.7, TIP 521" .br -\fB::tcl::mathfunc::log\fR \fIarg\fR +\fB::tcl::mathfunc::log\fI arg\fR .br -\fB::tcl::mathfunc::log10\fR \fIarg\fR +\fB::tcl::mathfunc::log10\fI arg\fR .br -\fB::tcl::mathfunc::max\fR \fIarg\fR ?\fIarg\fR ...? +\fB::tcl::mathfunc::max\fI arg\fR ?\fIarg\fR ...? .br -\fB::tcl::mathfunc::min\fR \fIarg\fR ?\fIarg\fR ...? +\fB::tcl::mathfunc::min\fI arg\fR ?\fIarg\fR ...? .br -\fB::tcl::mathfunc::pow\fR \fIx\fR \fIy\fR +\fB::tcl::mathfunc::pow\fI x y\fR .br \fB::tcl::mathfunc::rand\fR .br -\fB::tcl::mathfunc::round\fR \fIarg\fR +\fB::tcl::mathfunc::round\fI arg\fR .br -\fB::tcl::mathfunc::sin\fR \fIarg\fR +\fB::tcl::mathfunc::sin\fI arg\fR .br -\fB::tcl::mathfunc::sinh\fR \fIarg\fR +\fB::tcl::mathfunc::sinh\fI arg\fR .br -\fB::tcl::mathfunc::sqrt\fR \fIarg\fR +\fB::tcl::mathfunc::sqrt\fI arg\fR .br -\fB::tcl::mathfunc::srand\fR \fIarg\fR +\fB::tcl::mathfunc::srand\fI arg\fR .br -\fB::tcl::mathfunc::tan\fR \fIarg\fR +\fB::tcl::mathfunc::tan\fI arg\fR .br -\fB::tcl::mathfunc::tanh\fR \fIarg\fR +\fB::tcl::mathfunc::tanh\fI arg\fR .br -\fB::tcl::mathfunc::wide\fR \fIarg\fR +\fB::tcl::mathfunc::wide\fI arg\fR .sp .BE .SH "DESCRIPTION" @@ -126,26 +126,31 @@ define additional functions by using \fBproc\fR (or any other method, such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define new commands in the \fBtcl::mathfunc\fR namespace. .SS "DETAILED DEFINITIONS" +.\" COMMAND: abs .TP \fBabs \fIarg\fR . Returns the absolute value of \fIarg\fR. \fIArg\fR may be either integer or floating-point, and the result is returned in the same form. +.\" COMMAND: acos .TP \fBacos \fIarg\fR . Returns the arc cosine of \fIarg\fR, in the range [\fI0\fR,\fIpi\fR] radians. \fIArg\fR should be in the range [\fI\-1\fR,\fI1\fR]. +.\" COMMAND: asin .TP \fBasin \fIarg\fR . Returns the arc sine of \fIarg\fR, in the range [\fI\-pi/2\fR,\fIpi/2\fR] radians. \fIArg\fR should be in the range [\fI\-1\fR,\fI1\fR]. +.\" COMMAND: atan .TP \fBatan \fIarg\fR . Returns the arc tangent of \fIarg\fR, in the range [\fI\-pi/2\fR,\fIpi/2\fR] radians. +.\" COMMAND: atan2 .TP \fBatan2 \fIy x\fR . @@ -153,6 +158,7 @@ Returns the arc tangent of \fIy\fR/\fIx\fR, in the range [\fI\-pi\fR,\fIpi\fR] radians. \fIx\fR and \fIy\fR cannot both be 0. If \fIx\fR is greater than \fI0\fR, this is equivalent to .QW "\fBatan \fR[\fBexpr\fR {\fIy\fB/\fIx\fR}]" . +.\" COMMAND: bool .TP \fBbool \fIarg\fR . @@ -161,21 +167,25 @@ Accepts any numeric value, or any string acceptable to boolean value \fB0\fR or \fB1\fR. Non-zero numbers are true. Other numbers are false. Non-numeric strings produce boolean value in agreement with \fBstring is true\fR and \fBstring is false\fR. +.\" COMMAND: ceil .TP \fBceil \fIarg\fR . Returns the smallest integral floating-point value (i.e. with a zero fractional part) not less than \fIarg\fR. The argument may be any numeric value. +.\" COMMAND: cos .TP \fBcos \fIarg\fR . Returns the cosine of \fIarg\fR, measured in radians. +.\" COMMAND: cosh .TP \fBcosh \fIarg\fR . Returns the hyperbolic cosine of \fIarg\fR. If the result would cause an overflow, an error is returned. +.\" COMMAND: double .TP \fBdouble \fIarg\fR . @@ -184,6 +194,7 @@ If \fIarg\fR is a floating-point value, returns \fIarg\fR, otherwise converts \fIarg\fR to floating-point and returns the converted value. May return \fBInf\fR or \fB\-Inf\fR when the argument is a numeric value that exceeds the floating-point range. +.\" COMMAND: entier .TP \fBentier \fIarg\fR . @@ -191,22 +202,26 @@ The argument may be any numeric value. The integer part of \fIarg\fR is determined and returned. The integer range returned by this function is unlimited, unlike \fBint\fR and \fBwide\fR which truncate their range to fit in particular storage widths. +.\" COMMAND: exp .TP \fBexp \fIarg\fR . Returns the exponential of \fIarg\fR, defined as \fIe\fR**\fIarg\fR. If the result would cause an overflow, an error is returned. +.\" COMMAND: floor .TP \fBfloor \fIarg\fR . Returns the largest integral floating-point value (i.e. with a zero fractional part) not greater than \fIarg\fR. The argument may be any numeric value. +.\" COMMAND: fmod .TP \fBfmod \fIx y\fR . Returns the floating-point remainder of the division of \fIx\fR by \fIy\fR. If \fIy\fR is 0, an error is returned. +.\" COMMAND: hypot .TP \fBhypot \fIx y\fR . @@ -215,6 +230,7 @@ approximately .QW "\fBsqrt\fR [\fBexpr\fR {\fIx\fB*\fIx\fB+\fIy\fB*\fIy\fR}]" except for being more numerically stable when the two arguments have substantially different magnitudes. +.\" COMMAND: int .TP \fBint \fIarg\fR . @@ -223,6 +239,7 @@ is determined, and then the low order bits of that integer value up to the machine word size are returned as an integer value. For reference, the number of bytes in the machine word are stored in the \fBwordSize\fR element of the \fBtcl_platform\fR array. +.\" COMMAND: isfinite .TP \fBisfinite \fIarg\fR .VS "8.7, TIP 521" @@ -230,6 +247,7 @@ Returns 1 if the floating-point number \fIarg\fR is finite. That is, if it is zero, subnormal, or normal. Returns 0 if the number is infinite or NaN. Throws an error if \fIarg\fR cannot be promoted to a floating-point value. .VE "8.7, TIP 521" +.\" COMMAND: isinf .TP \fBisinf \fIarg\fR .VS "8.7, TIP 521" @@ -237,6 +255,7 @@ Returns 1 if the floating-point number \fIarg\fR is infinite. Returns 0 if the number is finite or NaN. Throws an error if \fIarg\fR cannot be promoted to a floating-point value. .VE "8.7, TIP 521" +.\" COMMAND: isnan .TP \fBisnan \fIarg\fR .VS "8.7, TIP 521" @@ -244,6 +263,7 @@ Returns 1 if the floating-point number \fIarg\fR is Not-a-Number. Returns 0 if the number is finite or infinite. Throws an error if \fIarg\fR cannot be promoted to a floating-point value. .VE "8.7, TIP 521" +.\" COMMAND: isnormal .TP \fBisnormal \fIarg\fR .VS "8.7, TIP 521" @@ -251,6 +271,7 @@ Returns 1 if the floating-point number \fIarg\fR is normal. Returns 0 if the number is zero, subnormal, infinite or NaN. Throws an error if \fIarg\fR cannot be promoted to a floating-point value. .VE "8.7, TIP 521" +.\" COMMAND: isqrt .TP \fBisqrt \fIarg\fR . @@ -258,6 +279,7 @@ Computes the integer part of the square root of \fIarg\fR. \fIArg\fR must be a positive value, either an integer or a floating point number. Unlike \fBsqrt\fR, which is limited to the precision of a floating point number, \fIisqrt\fR will return a result of arbitrary precision. +.\" COMMAND: issubnormal .TP \fBissubnormal \fIarg\fR .VS "8.7, TIP 521" @@ -266,6 +288,7 @@ result of gradual underflow. Returns 0 if the number is zero, normal, infinite or NaN. Throws an error if \fIarg\fR cannot be promoted to a floating-point value. .VE "8.7, TIP 521" +.\" COMMAND: isunordered .TP \fBisunordered \fIx y\fR .VS "8.7, TIP 521" @@ -275,31 +298,37 @@ are both chosen from among the set of zero, subnormal, normal and infinite values. Throws an error if either \fIx\fR or \fIy\fR cannot be promoted to a floating-point value. .VE "8.7, TIP 521" +.\" COMMAND: log .TP \fBlog \fIarg\fR . Returns the natural logarithm of \fIarg\fR. \fIArg\fR must be a positive value. +.\" COMMAND: log10 .TP \fBlog10 \fIarg\fR . Returns the base 10 logarithm of \fIarg\fR. \fIArg\fR must be a positive value. +.\" COMMAND: max .TP \fBmax \fIarg\fB \fI...\fR . Accepts one or more numeric arguments. Returns the one argument with the greatest value. +.\" COMMAND: min .TP \fBmin \fIarg\fB \fI...\fR . Accepts one or more numeric arguments. Returns the one argument with the least value. +.\" COMMAND: pow .TP \fBpow \fIx y\fR . Computes the value of \fIx\fR raised to the power \fIy\fR. If \fIx\fR is negative, \fIy\fR must be an integer value. +.\" COMMAND: rand .TP \fBrand\fR . @@ -310,20 +339,24 @@ determines all future results from subsequent calls to \fBrand\fR, so \fBrand\fR should not be used to generate a sequence of secrets, such as one-time passwords. The seed of the generator is initialized from the internal clock of the machine or may be set with the \fBsrand\fR function. +.\" COMMAND: round .TP \fBround \fIarg\fR . If \fIarg\fR is an integer value, returns \fIarg\fR, otherwise converts \fIarg\fR to integer by rounding and returns the converted value. +.\" COMMAND: sin .TP \fBsin \fIarg\fR . Returns the sine of \fIarg\fR, measured in radians. +.\" COMMAND: sinh .TP \fBsinh \fIarg\fR . Returns the hyperbolic sine of \fIarg\fR. If the result would cause an overflow, an error is returned. +.\" COMMAND: sqrt .TP \fBsqrt \fIarg\fR . @@ -331,20 +364,24 @@ The argument may be any non-negative numeric value. Returns a floating-point value that is the square root of \fIarg\fR. May return \fBInf\fR when the argument is a numeric value that exceeds the square of the maximum value of the floating-point range. +.\" COMMAND: srand .TP \fBsrand \fIarg\fR . The \fIarg\fR, which must be an integer, is used to reset the seed for the random number generator of \fBrand\fR. Returns the first random number (see \fBrand\fR) from that seed. Each interpreter has its own seed. +.\" COMMAND: tan .TP \fBtan \fIarg\fR . Returns the tangent of \fIarg\fR, measured in radians. +.\" COMMAND: tanh .TP \fBtanh \fIarg\fR . Returns the hyperbolic tangent of \fIarg\fR. +.\" COMMAND: wide .TP \fBwide \fIarg\fR . diff --git a/doc/mathop.n b/doc/mathop.n index 3a13456..f8a0dc4 100644 --- a/doc/mathop.n +++ b/doc/mathop.n @@ -13,19 +13,19 @@ mathop \- Mathematical operators as Tcl commands .SH SYNOPSIS package require \fBTcl 8.5-\fR .sp -\fB::tcl::mathop::!\fR \fInumber\fR +\fB::tcl::mathop::!\fI number\fR .br -\fB::tcl::mathop::~\fR \fInumber\fR +\fB::tcl::mathop::~\fI number\fR .br \fB::tcl::mathop::+\fR ?\fInumber\fR ...? .br -\fB::tcl::mathop::\-\fR \fInumber\fR ?\fInumber\fR ...? +\fB::tcl::mathop::\-\fI number\fR ?\fInumber\fR ...? .br \fB::tcl::mathop::*\fR ?\fInumber\fR ...? .br -\fB::tcl::mathop::/\fR \fInumber\fR ?\fInumber\fR ...? +\fB::tcl::mathop::/\fI number\fR ?\fInumber\fR ...? .br -\fB::tcl::mathop::%\fR \fInumber number\fR +\fB::tcl::mathop::%\fI number number\fR .br \fB::tcl::mathop::**\fR ?\fInumber\fR ...? .br @@ -35,13 +35,13 @@ package require \fBTcl 8.5-\fR .br \fB::tcl::mathop::^\fR ?\fInumber\fR ...? .br -\fB::tcl::mathop::<<\fR \fInumber number\fR +\fB::tcl::mathop::<<\fI number number\fR .br -\fB::tcl::mathop::>>\fR \fInumber number\fR +\fB::tcl::mathop::>>\fI number number\fR .br \fB::tcl::mathop::==\fR ?\fIarg\fR ...? .br -\fB::tcl::mathop::!=\fR \fIarg arg\fR +\fB::tcl::mathop::!=\fI arg arg\fR .br \fB::tcl::mathop::<\fR ?\fIarg\fR ...? .br @@ -53,7 +53,7 @@ package require \fBTcl 8.5-\fR .br \fB::tcl::mathop::eq\fR ?\fIarg\fR ...? .br -\fB::tcl::mathop::ne\fR \fIarg arg\fR +\fB::tcl::mathop::ne\fI arg arg\fR .br .VS "8.7, TIP461" \fB::tcl::mathop::lt\fR ?\fIarg\fR ...? @@ -65,9 +65,9 @@ package require \fBTcl 8.5-\fR \fB::tcl::mathop::ge\fR ?\fIarg\fR ...? .VE "8.7, TIP461" .br -\fB::tcl::mathop::in\fR \fIarg list\fR +\fB::tcl::mathop::in\fI arg list\fR .br -\fB::tcl::mathop::ni\fR \fIarg list\fR +\fB::tcl::mathop::ni\fI arg list\fR .sp .BE .SH DESCRIPTION @@ -92,34 +92,39 @@ The following operator commands are supported: .SS "MATHEMATICAL OPERATORS" .PP The behaviors of the mathematical operator commands are as follows: +.\" COMMAND: ! .TP -\fB!\fR \fIboolean\fR +\fB!\fI boolean\fR . Returns the boolean negation of \fIboolean\fR, where \fIboolean\fR may be any numeric value or any other form of boolean value (i.e. it returns truth if the argument is falsity or zero, and falsity if the argument is truth or non-zero). +.\" COMMAND: + .TP \fB+\fR ?\fInumber\fR ...? . Returns the sum of arbitrarily many arguments. Each \fInumber\fR argument may be any numeric value. If no arguments are given, the result will be zero (the summation identity). +.\" COMMAND: - .TP -\fB\-\fR \fInumber\fR ?\fInumber\fR ...? +\fB\-\fI number\fR ?\fInumber\fR ...? . If only a single \fInumber\fR argument is given, returns the negation of that numeric value. Otherwise returns the number that results when all subsequent numeric values are subtracted from the first one. All \fInumber\fR arguments must be numeric values. At least one argument must be given. +.\" COMMAND: * .TP \fB*\fR ?\fInumber\fR ...? . Returns the product of arbitrarily many arguments. Each \fInumber\fR may be any numeric value. If no arguments are given, the result will be one (the multiplicative identity). +.\" COMMAND: / .TP -\fB/\fR \fInumber\fR ?\fInumber\fR ...? +\fB/\fI number\fR ?\fInumber\fR ...? . If only a single \fInumber\fR argument is given, returns the reciprocal of that numeric value (i.e. the value obtained by dividing 1.0 by that value). @@ -134,8 +139,9 @@ results will be as if the functions \fIfloor\fR and \fIint\fR are applied to them, in that order). If all values in the operation are integers, the result will be an integer. .RE +.\" COMMAND: % .TP -\fB%\fR \fInumber number\fR +\fB%\fI number number\fR . Returns the integral modulus (i.e., remainder) of the first argument with respect to the second. @@ -152,6 +158,7 @@ clarity): \fB==\fR [\fB*\fR [\fB/\fI x y\fR] \fIy\fR] [\fB\-\fI x\fR [\fB%\fI x y\fR]] .CE .RE +.\" COMMAND: ** .TP \fB**\fR ?\fInumber\fR ...? . @@ -171,6 +178,7 @@ arguments are integral values. .PP The behaviors of the comparison operator commands (most of which operate preferentially on numeric arguments) are as follows: +.\" COMMAND: == .TP \fB==\fR ?\fIarg\fR ...? . @@ -178,23 +186,27 @@ Returns whether each argument is equal to the arguments on each side of it in the sense of the \fBexpr\fR == operator (\fIi.e.\fR, numeric comparison if possible, exact string comparison otherwise). If fewer than two arguments are given, this operation always returns a true value. +.\" COMMAND: eq .TP \fBeq\fR ?\fIarg\fR ...? . Returns whether each argument is equal to the arguments on each side of it using exact string comparison. If fewer than two arguments are given, this operation always returns a true value. +.\" COMMAND: != .TP -\fB!=\fR \fIarg arg\fR +\fB!=\fI arg arg\fR . Returns whether the two arguments are not equal to each other, in the sense of the \fBexpr\fR != operator (\fIi.e.\fR, numeric comparison if possible, exact string comparison otherwise). +.\" COMMAND: ne .TP -\fBne\fR \fIarg arg\fR +\fBne\fI arg arg\fR . Returns whether the two arguments are not equal to each other using exact string comparison. +.\" COMMAND: < .TP \fB<\fR ?\fIarg\fR ...? . @@ -205,6 +217,7 @@ otherwise performed using UNICODE string comparison. If fewer than two arguments are present, this operation always returns a true value. When the arguments are numeric but should be compared as strings, the \fBlt\fR operator or the \fBstring compare\fR command should be used instead. +.\" COMMAND: <= .TP \fB<=\fR ?\fIarg\fR ...? . @@ -215,6 +228,7 @@ otherwise performed using UNICODE string comparison. If fewer than two arguments are present, this operation always returns a true value. When the arguments are numeric but should be compared as strings, the \fBle\fR operator or the \fBstring compare\fR command should be used instead. +.\" COMMAND: > .TP \fB>\fR ?\fIarg\fR ...? . @@ -225,6 +239,7 @@ otherwise performed using UNICODE string comparison. If fewer than two arguments are present, this operation always returns a true value. When the arguments are numeric but should be compared as strings, the \fBgt\fR operator or the \fBstring compare\fR command should be used instead. +.\" COMMAND: >= .TP \fB>=\fR ?\fIarg\fR ...? . @@ -235,6 +250,7 @@ otherwise performed using UNICODE string comparison. If fewer than two arguments are present, this operation always returns a true value. When the arguments are numeric but should be compared as strings, the \fBge\fR operator or the \fBstring compare\fR command should be used instead. +.\" COMMAND: lt .TP \fBlt\fR ?\fIarg\fR ...? .VS "8.7, TIP461" @@ -243,6 +259,7 @@ after the first having to be strictly more than the one preceding it. Comparisons are performed using UNICODE string comparison. If fewer than two arguments are present, this operation always returns a true value. .VE "8.7, TIP461" +.\" COMMAND: le .TP \fBle\fR ?\fIarg\fR ...? .VS "8.7, TIP461" @@ -251,6 +268,7 @@ after the first having to be equal to or strictly more than the one preceding it Comparisons are performed using UNICODE string comparison. If fewer than two arguments are present, this operation always returns a true value. .VE "8.7, TIP461" +.\" COMMAND: gt .TP \fBgt\fR ?\fIarg\fR ...? .VS "8.7, TIP461" @@ -259,6 +277,7 @@ after the first having to be strictly less than the one preceding it. Comparisons are performed using UNICODE string comparison. If fewer than two arguments are present, this operation always returns a true value. .VE "8.7, TIP461" +.\" COMMAND: ge .TP \fBge\fR ?\fIarg\fR ...? .VS "8.7, TIP461" @@ -271,38 +290,44 @@ arguments are present, this operation always returns a true value. .PP The behaviors of the bit-wise operator commands (all of which only operate on integral arguments) are as follows: +.\" COMMAND: ~ .TP -\fB~\fR \fInumber\fR +\fB~\fI number\fR . Returns the bit-wise negation of \fInumber\fR. \fINumber\fR may be an integer of any size. Note that the result of this operation will always have the opposite sign to the input \fInumber\fR. +.\" COMMAND: & .TP \fB&\fR ?\fInumber\fR ...? . Returns the bit-wise AND of each of the arbitrarily many arguments. Each \fInumber\fR must have an integral value. If no arguments are given, the result will be minus one. +.\" COMMAND: | .TP \fB|\fR ?\fInumber\fR ...? . Returns the bit-wise OR of each of the arbitrarily many arguments. Each \fInumber\fR must have an integral value. If no arguments are given, the result will be zero. +.\" COMMAND: ^ .TP \fB^\fR ?\fInumber\fR ...? . Returns the bit-wise XOR of each of the arbitrarily many arguments. Each \fInumber\fR must have an integral value. If no arguments are given, the result will be zero. +.\" COMMAND: << .TP -\fB<<\fR \fInumber number\fR +\fB<<\fI number number\fR . Returns the result of bit-wise shifting the first argument left by the number of bits specified in the second argument. Each \fInumber\fR must have an integral value. +.\" COMMAND: >> .TP -\fB>>\fR \fInumber number\fR +\fB>>\fI number number\fR . Returns the result of bit-wise shifting the first argument right by the number of bits specified in the second argument. Each \fInumber\fR @@ -310,13 +335,15 @@ must have an integral value. .SS "LIST OPERATORS" .PP The behaviors of the list-oriented operator commands are as follows: +.\" COMMAND: in .TP -\fBin\fR \fIarg list\fR +\fBin\fI arg list\fR . Returns whether the value \fIarg\fR is present in the list \fIlist\fR (according to exact string comparison of elements). +.\" COMMAND: ni .TP -\fBni\fR \fIarg list\fR +\fBni\fI arg list\fR . Returns whether the value \fIarg\fR is not present in the list \fIlist\fR (according to exact string comparison of elements). diff --git a/doc/memory.n b/doc/memory.n index 7a69221..8fe6a9b 100644 --- a/doc/memory.n +++ b/doc/memory.n @@ -18,18 +18,21 @@ debugging capabilities. The memory command has several suboptions, which are described below. It is only available when Tcl has been compiled with memory debugging enabled (when \fBTCL_MEM_DEBUG\fR is defined at compile time), and after \fBTcl_InitMemory\fR has been called. +.\" METHOD: active .TP -\fBmemory active\fR \fIfile\fR +\fBmemory active\fI file\fR . Write a list of all currently allocated memory to the specified \fIfile\fR. +.\" METHOD: break_on_malloc .TP -\fBmemory break_on_malloc\fR \fIcount\fR +\fBmemory break_on_malloc\fI count\fR . After the \fIcount\fR allocations have been performed, \fBTcl_Alloc\fR outputs a message to this effect and that it is now attempting to enter the C debugger. Tcl will then issue a \fISIGINT\fR signal against itself. If you are running Tcl under a C debugger, it should then enter the debugger command mode. +.\" METHOD: info .TP \fBmemory info\fR . @@ -38,26 +41,30 @@ Tcl began, the current packets allocated (the current number of calls to \fBTcl_Alloc\fR not met by a corresponding call to \fBTcl_Free\fR), the current bytes allocated, and the maximum number of packets and bytes allocated. +.\" METHOD: init .TP \fBmemory init \fR[\fBon\fR|\fBoff\fR] . Turn on or off the preinitialization of all allocated memory with bogus bytes. Useful for detecting the use of uninitialized values. +.\" METHOD: objs .TP \fBmemory objs \fIfile\fR . Causes a list of all allocated Tcl_Obj values to be written to the specified \fIfile\fR immediately, together with where they were allocated. Useful for checking for leaks of values. +.\" METHOD: onexit .TP -\fBmemory onexit\fR \fIfile\fR +\fBmemory onexit\fI file\fR . Causes a list of all allocated memory to be written to the specified \fIfile\fR during the finalization of Tcl's memory subsystem. Useful for checking that memory is properly cleaned up during process exit. +.\" METHOD: tag .TP -\fBmemory tag\fR \fIstring\fR +\fBmemory tag\fI string\fR . Each packet of memory allocated by \fBTcl_Alloc\fR can have associated with it a string-valued tag. In the lists of allocated memory generated @@ -65,6 +72,7 @@ by \fBmemory active\fR and \fBmemory onexit\fR, the tag for each packet is printed along with other information about the packet. The \fBmemory tag\fR command sets the tag value for subsequent calls to \fBTcl_Alloc\fR to be \fIstring\fR. +.\" METHOD: trace .TP \fBmemory trace \fR[\fBon\fR|\fBoff\fR] . @@ -81,8 +89,9 @@ Tcl_Alloc 40e478 98 tclProc.c 1406 .PP Calls to \fBTcl_Free\fR are traced in the same manner. .RE +.\" METHOD: trace_on_at_malloc .TP -\fBmemory trace_on_at_malloc\fR \fIcount\fR +\fBmemory trace_on_at_malloc\fI count\fR . Enable memory tracing after \fIcount\fR \fBTcl_Alloc\fRs have been performed. For example, if you enter \fBmemory trace_on_at_malloc 100\fR, @@ -93,6 +102,7 @@ can reduce the slowdown caused by tracing (and the amount of trace information produced), if you can identify a number of allocations that occur before the problem sets in. The current number of memory allocations that have occurred since Tcl started is printed on a guard zone failure. +.\" METHOD: validate .TP \fBmemory validate \fR[\fBon\fR|\fBoff\fR] . diff --git a/doc/msgcat.n b/doc/msgcat.n index c39dc87..58b5b0d 100644 --- a/doc/msgcat.n +++ b/doc/msgcat.n @@ -52,7 +52,7 @@ msgcat \- Tcl message catalog .VS "TIP 412" \fB::msgcat::mcpackagelocale subcommand\fR ?\fIlocale\fR? .sp -\fB::msgcat::mcpackageconfig subcommand\fR \fIoption\fR ?\fIvalue\fR? +\fB::msgcat::mcpackageconfig subcommand\fI option\fR ?\fIvalue\fR? .sp \fB::msgcat::mcforgetpackage\fR .VE "TIP 412" @@ -87,6 +87,7 @@ Object oriented programming is supported by the use of a package namespace. .VE tip490 .PP .SH COMMANDS +.\" COMMAND: mc .TP \fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR? . @@ -110,17 +111,18 @@ use the result. If an application is written for a single language in this fashion, then it is easy to add support for additional languages later simply by defining new message catalog entries. .RE -.VS "TIP 490" +.\" COMMAND: mcc .TP -\fB::msgcat::mcn \fInamespace\fR \fIsrc-string\fR ?\fIarg arg ...\fR? -. +\fB::msgcat::mcn \fInamespace src-string\fR ?\fIarg arg ...\fR? +.VS "TIP 490" Like \fB::msgcat::mc\fR, but with the message namespace specified as first argument. .PP .RS \fBmcn\fR may be used for cases where the package namespace is not the namespace of the caller. An example is shown within the description of the command \fB::msgcat::mcpackagenamespaceget\fR below. .RE -.PP +.VE +.\" COMMAND: mcmax .TP \fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR? . @@ -128,10 +130,10 @@ Given several source strings, \fB::msgcat::mcmax\fR returns the length of the longest translated string. This is useful when designing localized GUIs, which may require that all buttons, for example, be a fixed width (which will be the width of the widest button). -.VS "TIP 412" +.\" COMMAND: mcexists .TP -\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? ?\fB-namespace\fR \fInamespace\fR? \fIsrc-string\fR -. +\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? ?\fB-namespace\fI namespace\fR? \fIsrc-string\fR +.VS "TIP 412" Return true, if there is a translation for the given \fIsrc-string\fR. .PP .RS @@ -146,10 +148,10 @@ The namespace of the caller is used if not explicitly specified. .RE .PP .VE "TIP 490" -.VS "TIP 490" +.\" COMMAND: mcpackagenamespaceget .TP \fB::msgcat::mcpackagenamespaceget\fR -. +.VS "TIP 490" Return the package namespace of the caller. This command handles all cases described in section \fBOBJECT ORIENTED PROGRAMMING\fR. .PP @@ -172,6 +174,7 @@ proc ::tooltip::show {widget messagenamespace message} { .RE .PP .VE "TIP 490" +.\" COMMAND: mclocale .TP \fB::msgcat::mclocale \fR?\fInewLocale\fR? . @@ -182,7 +185,7 @@ is set to \fInewLocale\fR. If the new locale is set to \fInewLocale\fR, the corresponding preferences are calculated and set. For example, if the current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR returns \fB{en_us_funky en_us en {}}\fR. .PP -The same result may be acheved by \fB::msgcat::mcpreferences\fR {*}[\fB::msgcat::mcutil getpreferences\fR \fInewLocale\fR]. +The same result may be acheved by \fB::msgcat::mcpreferences\fR {*}[\fB::msgcat::mcutil getpreferences\fI newLocale\fR]. .PP The current locale is always the first element of the list returned by \fBmcpreferences\fR. .PP @@ -197,6 +200,7 @@ If the locale is set, the preference list of locales is evaluated. Locales in this list are loaded now, if not jet loaded. .VE "TIP 412" .RE +.\" COMMAND: mcpreferences .TP \fB::msgcat::mcpreferences\fR ?\fIlocale preference\fR? ... . @@ -217,10 +221,10 @@ As an example, the user may prefer French or English text. This may be configure .CE .RE .PP -.VS "TIP 499" +.\" COMMAND: mcloadedlocales .TP \fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR? -. +.VS "TIP 499" This group of commands manage the list of loaded locales for packages not setting a package locale. .PP .RS @@ -228,9 +232,10 @@ The subcommand \fBloaded\fR returns the list of currently loaded locales. .PP The subcommand \fBclear\fR removes all locales and their data, which are not in the current preference list. .RE +.VE +.\" COMMAND: mcload .TP \fB::msgcat::mcload \fIdirname\fR -. .VS "TIP 412" Searches the specified directory for files that match the language specifications returned by \fB::msgcat::mcloadedlocales loaded\fR @@ -245,9 +250,12 @@ evaluation. The number of message files which matched the specification and were loaded is returned. .RS .PP -In addition, the given folder is stored in the \fBmsgcat\fR package configuration option \fImcfolder\fR to eventually load message catalog files required by a locale change. +In addition, the given folder is stored in the \fBmsgcat\fR package +configuration option \fImcfolder\fR to eventually load message catalog +files required by a locale change. .VE "TIP 412" .RE +.\" COMMAND: mcset .TP \fB::msgcat::mcset \fIlocale src-string \fR?\fItranslate-string\fR? . @@ -255,6 +263,7 @@ Sets the translation for \fIsrc-string\fR to \fItranslate-string\fR in the specified \fIlocale\fR and the current namespace. If \fItranslate-string\fR is not specified, \fIsrc-string\fR is used for both. The function returns \fItranslate-string\fR. +.\" COMMAND: mcmset .TP \fB::msgcat::mcmset \fIlocale src-trans-list\fR . @@ -266,15 +275,19 @@ the form {\fIsrc-string translate-string\fR ?\fIsrc-string translate-string ...\fR?} \fB::msgcat::mcmset\fR can be significantly faster than multiple invocations of \fB::msgcat::mcset\fR. The function returns the number of translations set. +.\" COMMAND: mcflset .TP \fB::msgcat::mcflset \fIsrc-string \fR?\fItranslate-string\fR? +. Sets the translation for \fIsrc-string\fR to \fItranslate-string\fR in the current namespace for the locale implied by the name of the message catalog being loaded via \fB::msgcat::mcload\fR. If \fItranslate-string\fR is not specified, \fIsrc-string\fR is used for both. The function returns \fItranslate-string\fR. +.\" COMMAND: mcflmset .TP \fB::msgcat::mcflmset \fIsrc-trans-list\fR +. Sets the translation for multiple source strings in \fIsrc-trans-list\fR in the current namespace for the locale implied by the name of the message catalog being loaded via \fB::msgcat::mcload\fR. \fIsrc-trans-list\fR must @@ -282,6 +295,7 @@ have an even number of elements and is in the form {\fIsrc-string translate-string\fR ?\fIsrc-string translate-string ...\fR?} \fB::msgcat::mcflmset\fR can be significantly faster than multiple invocations of \fB::msgcat::mcflset\fR. The function returns the number of translations set. +.\" COMMAND: mcunknown .TP \fB::msgcat::mcunknown \fIlocale src-string\fR ?\fIarg arg ...\fR? . @@ -300,15 +314,17 @@ to \fB::msgcat::mc\fR. .PP Note that this routine is only called if the concerned package did not set a package locale unknown command name. .RE +.\" COMMAND: mcforgetpackage .TP \fB::msgcat::mcforgetpackage\fR . The calling package clears all its state within the \fBmsgcat\fR package including all settings and translations. .VE "TIP 412" .PP +.\" COMMAND: mcutil .VS "TIP 499" .TP -\fB::msgcat::mcutil getpreferences\fR \fIlocale\fR +\fB::msgcat::mcutil getpreferences\fI locale\fR . Return the preferences list of the given locale as described in section \fBLOCALE SPECIFICATION\fR. An example is the composition of a preference list for the bilingual region "Biel/Bienne" as a concatenation of swiss german and swiss french: @@ -582,7 +598,7 @@ Unset the package private locale and use the globale locale. Load and remove locales to adjust the list of loaded locales for the package to the global loaded locales list. .TP -\fB::msgcat::mcpackagelocale present\fR \fIlocale\fR +\fB::msgcat::mcpackagelocale present\fI locale\fR . Returns true, if the given locale is loaded for the package. .TP @@ -596,22 +612,22 @@ Each package using msgcat has a set of options within \fBmsgcat\fR. The package options are described in the next sectionPackage options. Each package option may be set or unset individually using the following ensemble: .TP -\fB::msgcat::mcpackageconfig get\fR \fIoption\fR +\fB::msgcat::mcpackageconfig get\fI option\fR . Return the current value of the given \fIoption\fR. This call returns an error if the option is not set for the package. .TP -\fB::msgcat::mcpackageconfig isset\fR \fIoption\fR +\fB::msgcat::mcpackageconfig isset\fI option\fR . Returns 1, if the given \fIoption\fR is set for the package, 0 otherwise. .TP -\fB::msgcat::mcpackageconfig set\fR \fIoption\fR \fIvalue\fR +\fB::msgcat::mcpackageconfig set\fI option value\fR . Set the given \fIoption\fR to the given \fIvalue\fR. This may invoke additional actions in dependency of the \fIoption\fR. The return value is 0 or the number of loaded packages for the option \fBmcfolder\fR. .TP -\fB::msgcat::mcpackageconfig unset\fR \fIoption\fR +\fB::msgcat::mcpackageconfig unset\fI option\fR . Unsets the given \fIoption\fR for the package. No action is taken if the \fIoption\fR is not set for the package. diff --git a/doc/namespace.n b/doc/namespace.n index 4be0a3a..5e90d13 100644 --- a/doc/namespace.n +++ b/doc/namespace.n @@ -24,6 +24,7 @@ See the section \fBWHAT IS A NAMESPACE?\fR below for a brief overview of namespaces. The legal values of \fIsubcommand\fR are listed below. Note that you can abbreviate the \fIsubcommand\fRs. +.\" METHOD: children .TP \fBnamespace children \fR?\fInamespace\fR? ?\fIpattern\fR? . @@ -40,6 +41,7 @@ a pattern that starts with double colon (\fB::\fR) is used directly, otherwise the namespace \fInamespace\fR (or the fully-qualified name of the current namespace) is prepended onto the pattern. +.\" METHOD: code .TP \fBnamespace code \fIscript\fR . @@ -68,6 +70,7 @@ A scoped command captures a command together with its namespace context in a way that allows it to be executed properly later. See the section \fBSCOPED SCRIPTS\fR for some examples of how this is used to create callback scripts. +.\" METHOD: current .TP \fBnamespace current\fR . @@ -77,6 +80,7 @@ The actual name of the global namespace is (i.e., an empty string), but this command returns \fB::\fR for the global namespace as a convenience to programmers. +.\" METHOD: delete .TP \fBnamespace delete \fR?\fInamespace namespace ...\fR? . @@ -89,14 +93,16 @@ however, the namespace is marked to prevent other code from looking it up by name. If a namespace does not exist, this command returns an error. If no namespace names are given, this command does nothing. +.\" METHOD: ensemble .TP -\fBnamespace ensemble\fR \fIsubcommand\fR ?\fIarg ...\fR? +\fBnamespace ensemble \fIsubcommand\fR ?\fIarg ...\fR? . Creates and manipulates a command that is formed out of an ensemble of subcommands. See the section \fBENSEMBLES\fR below for further details. +.\" METHOD: eval .TP -\fBnamespace eval\fR \fInamespace arg\fR ?\fIarg ...\fR? +\fBnamespace eval \fInamespace arg\fR ?\fIarg ...\fR? . Activates a namespace called \fInamespace\fR and evaluates some code in that context. @@ -111,11 +117,13 @@ If \fInamespace\fR has leading namespace qualifiers and any leading namespaces do not exist, they are automatically created. .RE +.\" METHOD: exists .TP -\fBnamespace exists\fR \fInamespace\fR +\fBnamespace exists \fInamespace\fR . Returns \fB1\fR if \fInamespace\fR is a valid namespace in the current context, returns \fB0\fR otherwise. +.\" METHOD: export .TP \fBnamespace export \fR?\fB\-clear\fR? ?\fIpattern pattern ...\fR? . @@ -137,6 +145,7 @@ the namespace's export pattern list is reset to empty before any \fIpattern\fR arguments are appended. If no \fIpattern\fRs are given and the \fB\-clear\fR flag is not given, this command returns the namespace's current export list. +.\" METHOD: forget .TP \fBnamespace forget \fR?\fIpattern pattern ...\fR? . @@ -162,8 +171,9 @@ It then checks whether any of those commands were previously imported by the current namespace. If so, this command deletes the corresponding imported commands. In effect, this undoes the action of a \fBnamespace import\fR command. +.\" METHOD: import .TP -\fBnamespace import \fR?\fB\-force\fR? ?\fIpattern\fR \fIpattern ...\fR? +\fBnamespace import \fR?\fB\-force\fR? ?\fIpattern pattern ...\fR? . Imports commands into a namespace, or queries the set of imported commands in a namespace. When no arguments are present, @@ -205,8 +215,9 @@ at the time when the \fBnamespace import\fR command is executed. If another command is defined and exported in this namespace later on, it will not be imported. .RE +.\" METHOD: inscope .TP -\fBnamespace inscope\fR \fInamespace\fR \fIscript\fR ?\fIarg ...\fR? +\fBnamespace inscope \fInamespace script\fR ?\fIarg ...\fR? . Executes a script in the context of the specified \fInamespace\fR. This command is not expected to be used directly by programmers; @@ -232,6 +243,7 @@ is equivalent to thus additional arguments will not undergo a second round of substitution, as is the case with \fBnamespace eval\fR. .RE +.\" METHOD: origin .TP \fBnamespace origin \fIcommand\fR . @@ -247,6 +259,7 @@ this command returns the fully-qualified name of the original command in the first namespace, \fIa\fR. If \fIcommand\fR does not refer to an imported command, the command's own fully-qualified name is returned. +.\" METHOD: parent .TP \fBnamespace parent\fR ?\fInamespace\fR? . @@ -254,6 +267,7 @@ Returns the fully-qualified name of the parent namespace for namespace \fInamespace\fR. If \fInamespace\fR is not specified, the fully-qualified name of the current namespace's parent is returned. +.\" METHOD: path .TP \fBnamespace path\fR ?\fInamespaceList\fR? . @@ -263,8 +277,9 @@ current namespace's command resolution path is set to those namespaces and returns the empty list. The default command resolution path is always empty. See the section \fBNAME RESOLUTION\fR below for an explanation of the rules regarding name resolution. +.\" METHOD: qualifiers .TP -\fBnamespace qualifiers\fR \fIstring\fR +\fBnamespace qualifiers\fI string\fR . Returns any leading namespace qualifiers for \fIstring\fR. Qualifiers are namespace names separated by double colons (\fB::\fR). @@ -275,8 +290,9 @@ This command is the complement of the \fBnamespace tail\fR command. Note that it does not check whether the namespace names are, in fact, the names of currently defined namespaces. +.\" METHOD: tail .TP -\fBnamespace tail\fR \fIstring\fR +\fBnamespace tail\fI string\fR . Returns the simple name at the end of a qualified string. Qualifiers are namespace names separated by double colons (\fB::\fR). @@ -286,8 +302,9 @@ and for \fB::\fR it returns an empty string. This command is the complement of the \fBnamespace qualifiers\fR command. It does not check whether the namespace names are, in fact, the names of currently defined namespaces. +.\" METHOD: upvar .TP -\fBnamespace upvar\fR \fInamespace\fR ?\fIotherVar myVar \fR...? +\fBnamespace upvar\fI namespace\fR ?\fIotherVar myVar \fR...? . This command arranges for zero or more local variables in the current procedure to refer to variables in \fInamespace\fR. The namespace name is @@ -297,6 +314,7 @@ The command \fBupvar 0 ${ns}::a b\fR, with the sole exception of the resolution rules used for qualified namespace or variable names. \fBnamespace upvar\fR returns an empty string. +.\" METHOD: unknown .TP \fBnamespace unknown\fR ?\fIscript\fR? . @@ -310,6 +328,7 @@ the handler is invoked, the full invocation line will be appended to the script and the result evaluated in the context of the namespace. The default handler for all namespaces is \fB::unknown\fR. If no argument is given, it returns the handler for the current namespace. +.\" METHOD: which .TP \fBnamespace which\fR ?\fB\-command\fR? ?\fB\-variable\fR? \fIname\fR . @@ -730,6 +749,7 @@ namespace is deleted. The link between an ensemble command and its namespace is maintained however the ensemble is renamed. .PP Three subcommands of the \fBnamespace ensemble\fR command are defined: +.\" METHOD: create .TP \fBnamespace ensemble create\fR ?\fIoption value ...\fR? . @@ -741,6 +761,7 @@ command. If not overridden with the \fB\-command\fR option, this command creates an ensemble with exactly the same name as the linked namespace. See the section \fBENSEMBLE OPTIONS\fR below for a full list of options supported and their effects. +.\" METHOD: configure .TP \fBnamespace ensemble configure \fIcommand\fR ?\fIoption\fR? ?\fIvalue ...\fR? . @@ -748,8 +769,9 @@ Retrieves the value of an option associated with the ensemble command named \fIcommand\fR, or updates some options associated with that ensemble command. See the section \fBENSEMBLE OPTIONS\fR below for a full list of options supported and their effects. +.\" METHOD: exists .TP -\fBnamespace ensemble exists\fR \fIcommand\fR +\fBnamespace ensemble exists\fI command\fR . Returns a boolean value that describes whether the command \fIcommand\fR exists and is an ensemble command. This command only diff --git a/doc/object.n b/doc/object.n index 98679d1..2bed231 100644 --- a/doc/object.n +++ b/doc/object.n @@ -48,6 +48,7 @@ The \fBoo::object\fR class does not define an explicit constructor. The \fBoo::object\fR class does not define an explicit destructor. .SS "EXPORTED METHODS" The \fBoo::object\fR class supports the following exported methods: +.\" METHOD: destroy .TP \fIobj \fBdestroy\fR . @@ -58,12 +59,14 @@ always the empty string. .SS "NON-EXPORTED METHODS" .PP The \fBoo::object\fR class supports the following non-exported methods: +.\" METHOD: eval .TP \fIobj \fBeval\fR ?\fIarg ...\fR? . This method concatenates the arguments, \fIarg\fR, as if with \fBconcat\fR, and then evaluates the resulting script in the namespace that is uniquely associated with \fIobj\fR, returning the result of the evaluation. +.\" METHOD: unknown .TP \fIobj \fBunknown ?\fImethodName\fR? ?\fIarg ...\fR? . @@ -78,6 +81,7 @@ The default implementation (i.e., the one defined by the \fBoo::object\fR class) generates a suitable error, detailing what methods the object supports given whether the object was invoked by its public name or through the \fBmy\fR command. +.\" METHOD: variable .TP \fIobj \fBvariable \fR?\fIvarName ...\fR? . @@ -86,11 +90,13 @@ the object \fIobj\fR's unique namespace into the caller's context. Thus, if it is invoked from inside a procedure then the namespace variable in the object is linked to the local variable in the procedure. Each \fIvarName\fR argument must not have any namespace separators in it. The result is the empty string. +.\" METHOD: varname .TP \fIobj \fBvarname \fIvarName\fR . This method returns the globally qualified name of the variable \fIvarName\fR in the unique namespace for the object \fIobj\fR. +.\" METHOD: .TP \fIobj \fB \fIsourceObjectName\fR .VS diff --git a/doc/open.n b/doc/open.n index 68e8494..f955e39 100644 --- a/doc/open.n +++ b/doc/open.n @@ -192,7 +192,7 @@ The \fBchan configure\fR and \fBfconfigure\fR commands can be used to query and set additional configuration options specific to serial ports (where supported): .TP -\fB\-mode\fR \fIbaud\fB,\fIparity\fB,\fIdata\fB,\fIstop\fR +\fB\-mode\fI baud\fB,\fIparity\fB,\fIdata\fB,\fIstop\fR . This option is a set of 4 comma-separated values: the baud rate, parity, number of data bits, and number of stop bits for this serial port. The @@ -209,7 +209,7 @@ or data bits and should be an integer from 5 to 8, while \fIstop\fR is the number of stop bits and should be the integer 1 or 2. .TP -\fB\-handshake\fR \fItype\fR +\fB\-handshake\fI type\fR . (Windows and Unix). This option is used to setup automatic handshake control. Note that not all handshake types maybe supported by your operating @@ -233,7 +233,7 @@ The \fB\-handshake\fR option cannot be queried. It returns a list of two integers representing the current number of bytes in the input and output queue respectively. .TP -\fB\-timeout\fR \fImsec\fR +\fB\-timeout\fI msec\fR . (Windows and Unix). This option is used to set the timeout for blocking read operations. It specifies the maximum interval between the @@ -243,7 +243,7 @@ The \fB\-timeout\fR option does not affect write operations or nonblocking reads. This option cannot be queried. .TP -\fB\-ttycontrol\fR \fI{signal boolean signal boolean ...}\fR +\fB\-ttycontrol\fI {signal boolean signal boolean ...}\fR . (Windows and Unix). This option is used to setup the handshake output lines (see below) permanently or to send a BREAK over the serial line. @@ -265,14 +265,14 @@ The result is a list of signal,value pairs with a fixed order, e.g. \fB{CTS 1 DSR 0 RING 1 DCD 0}\fR. The \fIsignal\fR names are returned upper case. .TP -\fB\-xchar\fR \fI{xonChar xoffChar}\fR +\fB\-xchar\fI {xonChar xoffChar}\fR . (Windows and Unix). This option is used to query or change the software handshake characters. Normally the operating system default should be DC1 (0x11) and DC3 (0x13) representing the ASCII standard XON and XOFF characters. .TP -\fB\-closemode\fR \fIcloseMode\fR +\fB\-closemode\fI closeMode\fR .VS "8.7, TIP 160" (Windows and Unix). This option is used to query or change the close mode of the serial channel, which defines how pending output in operating system @@ -298,7 +298,7 @@ been consumed. This may slow down \fBclose\fR noticeably. .RE .VE "8.7, TIP 160" .TP -\fB\-inputmode\fR \fIinputMode\fR +\fB\-inputmode\fI inputMode\fR .VS "8.7, TIP 160" (Unix only; Windows has the equivalent option on console channels). This option is used to query or change the input mode of the serial channel under @@ -341,7 +341,7 @@ option is query only. It retrieves a two-element list with the the current width and height of the terminal. .VE "8.7, TIP 160" .TP -\fB\-pollinterval\fR \fImsec\fR +\fB\-pollinterval\fI msec\fR . (Windows only). This option is used to set the maximum time between polling for fileevents. @@ -350,9 +350,9 @@ interpreter (the smallest value always wins). Use this option only if you want to poll the serial port more or less often than 10 msec (the default). .TP -\fB\-sysbuffer\fR \fIinSize\fR +\fB\-sysbuffer\fI inSize\fR .TP -\fB\-sysbuffer\fR \fI{inSize outSize}\fR +\fB\-sysbuffer\fI {inSize outSize}\fR . (Windows only). This option is used to change the size of Windows system buffers for a serial channel. Especially at higher communication @@ -511,7 +511,7 @@ applications on the various platforms On Windows only, console channels (usually \fBstdin\fR or \fBstdout\fR) support the following options: .TP -\fB\-inputmode\fR \fIinputMode\fR +\fB\-inputmode\fI inputMode\fR . This option is used to query or change the input mode of the console channel, which controls how interactive input from users is handled. The following diff --git a/doc/package.n b/doc/package.n index 5687480..dc21093 100644 --- a/doc/package.n +++ b/doc/package.n @@ -12,7 +12,7 @@ package \- Facilities for package loading and version control .SH SYNOPSIS .nf -\fBpackage files\fR \fIpackage\fR +\fBpackage files\fI package\fR \fBpackage forget\fR ?\fIpackage package ...\fR? \fBpackage ifneeded \fIpackage version\fR ?\fIscript\fR? \fBpackage names\fR @@ -43,19 +43,22 @@ primarily by system scripts that maintain the package database. .PP The behavior of the \fBpackage\fR command is determined by its first argument. The following forms are permitted: +.\" METHOD: files .TP -\fBpackage files\fR \fIpackage\fR +\fBpackage files \fIpackage\fR . Lists all files forming part of \fIpackage\fR. Auto-loaded files are not included in this list, only files which were directly sourced during package initialization. The list order corresponds with the order in which the files were sourced. +.\" METHOD: forget .TP \fBpackage forget\fR ?\fIpackage package ...\fR? . Removes all information about each specified package from this interpreter, including information provided by both \fBpackage ifneeded\fR and \fBpackage provide\fR. +.\" METHOD: ifneeded .TP \fBpackage ifneeded \fIpackage version\fR ?\fIscript\fR? . @@ -78,6 +81,7 @@ If the \fIscript\fR argument is omitted, the current script for version \fIversion\fR of package \fIpackage\fR is returned, or an empty string if no \fBpackage ifneeded\fR command has been invoked for this \fIpackage\fR and \fIversion\fR. +.\" METHOD: names .TP \fBpackage names\fR . @@ -86,11 +90,13 @@ interpreter for which a version has been provided (via \fBpackage provide\fR) or for which a \fBpackage ifneeded\fR script is available. The order of elements in the list is arbitrary. +.\" METHOD: present .TP \fBpackage present\fR ?\fB\-exact\fR? \fIpackage\fR ?\fIrequirement...\fR? . This command is equivalent to \fBpackage require\fR except that it does not try and load the package if it is not already loaded. +.\" METHOD: provide .TP \fBpackage provide \fIpackage \fR?\fIversion\fR? . @@ -104,6 +110,7 @@ If the \fIversion\fR argument is omitted, then the command returns the version number that is currently provided, or an empty string if no \fBpackage provide\fR command has been invoked for \fIpackage\fR in this interpreter. +.\" METHOD: require .TP \fBpackage require \fR\fIpackage \fR?\fIrequirement...\fR? . @@ -156,6 +163,7 @@ package, then the command returns an error. This form of the command is used when only the given \fIversion\fR of \fIpackage\fR is acceptable to the caller. This command is equivalent to \fBpackage require \fIpackage version\fR-\fIversion\fR. +.\" METHOD: unknown .TP \fBpackage unknown \fR?\fIcommand\fR? . @@ -178,18 +186,21 @@ argument, then the current \fBpackage unknown\fR script is returned, or an empty string if there is none. If \fIcommand\fR is specified as an empty string, then the current \fBpackage unknown\fR script is removed, if there is one. +.\" METHOD: vcompare .TP \fBpackage vcompare \fIversion1 version2\fR . Compares the two version numbers given by \fIversion1\fR and \fIversion2\fR. Returns -1 if \fIversion1\fR is an earlier version than \fIversion2\fR, 0 if they are equal, and 1 if \fIversion1\fR is later than \fIversion2\fR. +.\" METHOD: versions .TP \fBpackage versions \fIpackage\fR . Returns a list of all the version numbers of \fIpackage\fR for which information has been provided by \fBpackage ifneeded\fR commands. +.\" METHOD: vsatisfies .TP \fBpackage vsatisfies \fIversion requirement...\fR . @@ -260,8 +271,10 @@ requirement if, and only if it is greater than or equal to the .QW a0 . There is no constraint to a maximum. .RE +.\" METHOD: prefer .TP \fBpackage prefer \fR?\fBlatest\fR|\fBstable\fR? +. With no arguments, the commands returns either .QW latest or diff --git a/doc/platform.n b/doc/platform.n index 7cb685d..8ac07d2 100644 --- a/doc/platform.n +++ b/doc/platform.n @@ -43,6 +43,7 @@ establishes a standard naming convention for architectures running Tcl and makes it more convenient for developers to identify the current architecture a Tcl program is running on. .SH COMMANDS +.\" METHOD: identify .TP \fBplatform::identify\fR . @@ -52,6 +53,7 @@ core is running on. The returned identifier has the general format details like kernel version, libc version, etc., and this information may contain dashes as well. The \fICPU\fR part will not contain dashes, making the preceding dash the last dash in the result. +.\" METHOD: generic .TP \fBplatform::generic\fR . @@ -59,6 +61,7 @@ This command returns a simplified identifier describing the platform the Tcl core is running on. In contrast to \fBplatform::identify\fR it leaves out details like kernel version, libc version, etc. The returned identifier has the general format \fIOS\fR-\fICPU\fR. +.\" METHOD: patterns .TP \fBplatform::patterns \fIidentifier\fR . diff --git a/doc/platform_shell.n b/doc/platform_shell.n index a9e14d0..54a1edb 100644 --- a/doc/platform_shell.n +++ b/doc/platform_shell.n @@ -41,16 +41,22 @@ the architecture of the shell which will actually run the installed packages, versus the architecture of the shell running the repository software. .SH COMMANDS +.\" METHOD: identify .TP \fBplatform::shell::identify \fIshell\fR +. This command does the same identification as \fBplatform::identify\fR, for the specified Tcl shell, in contrast to the running shell. +.\" METHOD: generic .TP \fBplatform::shell::generic \fIshell\fR +. This command does the same identification as \fBplatform::generic\fR, for the specified Tcl shell, in contrast to the running shell. +.\" METHOD: platform .TP \fBplatform::shell::platform \fIshell\fR +. This command returns the contents of \fBtcl_platform(platform)\fR for the specified Tcl shell. .SH KEYWORDS diff --git a/doc/prefix.n b/doc/prefix.n index d327a78..abd337a 100644 --- a/doc/prefix.n +++ b/doc/prefix.n @@ -12,8 +12,8 @@ tcl::prefix \- facilities for prefix matching .SH SYNOPSIS .nf -\fB::tcl::prefix all\fR \fItable string\fR -\fB::tcl::prefix longest\fR \fItable string\fR +\fB::tcl::prefix all\fI table string\fR +\fB::tcl::prefix longest\fI table string\fR \fB::tcl::prefix match\fR ?\fIoption ...\fR? \fItable string\fR .fi .BE @@ -21,16 +21,19 @@ tcl::prefix \- facilities for prefix matching .PP This document describes commands looking up a prefix in a list of strings. The following commands are supported: +.\" METHOD: all .TP -\fB::tcl::prefix all\fR \fItable string\fR +\fB::tcl::prefix all\fI table string\fR . Returns a list of all elements in \fItable\fR that begin with the prefix \fIstring\fR. +.\" METHOD: longest .TP -\fB::tcl::prefix longest\fR \fItable string\fR +\fB::tcl::prefix longest\fI table string\fR . Returns the longest common prefix of all elements in \fItable\fR that begin with the prefix \fIstring\fR. +.\" METHOD: match .TP \fB::tcl::prefix match\fR ?\fIoptions\fR? \fItable string\fR . diff --git a/doc/process.n b/doc/process.n index 165e413..f69811e 100644 --- a/doc/process.n +++ b/doc/process.n @@ -18,6 +18,7 @@ tcl::process \- Subprocess management This command provides a way to manage subprocesses created by the \fBopen\fR and \fBexec\fR commands, as identified by the process identifiers (PIDs) of those subprocesses. The legal \fIoptions\fR (which may be abbreviated) are: +.\" METHOD: autopurge .TP \fB::tcl::process autopurge\fR ?\fIflag\fR? . @@ -28,12 +29,14 @@ status as a boolean value. When autopurge is active, executed or a pipe channel created by \fBopen\fR is closed. When autopurge is inactive, \fB::tcl::process\fR purge must be called explicitly. By default autopurge is active. +.\" METHOD: list .TP \fB::tcl::process list\fR . Returns the list of subprocess PIDs. This includes all currently executing subprocesses and all terminated subprocesses that have not yet had their corresponding process table entries purged. +.\" METHOD: purge .TP \fB::tcl::process purge\fR ?\fIpids\fR? . @@ -41,6 +44,7 @@ Cleans up all data associated with terminated subprocesses. If \fIpids\fR is specified as a list of PIDs then the command only cleanup data for the matching subprocesses if they exist, and raises an error otherwise. If a process listed is still active, this command does nothing to that process. +.\" METHOD: status .TP \fB::tcl::process status\fR ?\fIswitches\fR? ?\fIpids\fR? . diff --git a/doc/refchan.n b/doc/refchan.n index 94823c5..2b79da2 100644 --- a/doc/refchan.n +++ b/doc/refchan.n @@ -14,16 +14,16 @@ refchan \- command handler API of reflected channels .nf \fBchan create \fImode cmdPrefix\fR -\fIcmdPrefix \fBblocking\fR \fIchannelId mode\fR -\fIcmdPrefix \fBcget\fR \fIchannelId option\fR -\fIcmdPrefix \fBcgetall\fR \fIchannelId\fR -\fIcmdPrefix \fBconfigure\fR \fIchannelId option value\fR -\fIcmdPrefix \fBfinalize\fR \fIchannelId\fR -\fIcmdPrefix \fBinitialize\fR \fIchannelId mode\fR -\fIcmdPrefix \fBread\fR \fIchannelId count\fR -\fIcmdPrefix \fBseek\fR \fIchannelId offset base\fR -\fIcmdPrefix \fBwatch\fR \fIchannelId eventspec\fR -\fIcmdPrefix \fBwrite\fR \fIchannelId data\fR +\fIcmdPrefix \fBblocking\fI channelId mode\fR +\fIcmdPrefix \fBcget\fI channelId option\fR +\fIcmdPrefix \fBcgetall\fI channelId\fR +\fIcmdPrefix \fBconfigure\fI channelId option value\fR +\fIcmdPrefix \fBfinalize\fI channelId\fR +\fIcmdPrefix \fBinitialize\fI channelId mode\fR +\fIcmdPrefix \fBread\fI channelId count\fR +\fIcmdPrefix \fBseek\fI channelId offset base\fR +\fIcmdPrefix \fBwatch\fI channelId eventspec\fR +\fIcmdPrefix \fBwrite\fI channelId data\fR .fi .BE .SH DESCRIPTION @@ -42,6 +42,7 @@ Of all the possible subcommands, the handler \fImust\fR support \fBinitialize\fR, \fBfinalize\fR, and \fBwatch\fR. Support for the other subcommands is optional. .SS "MANDATORY SUBCOMMANDS" +.\" METHOD: initialize .TP \fIcmdPrefix \fBinitialize \fIchannelId mode\fR . @@ -72,6 +73,7 @@ will usually contain at least one element. The subcommand must throw an error if the chosen mode is not supported by the \fIcmdPrefix\fR. .RE +.\" METHOD: finalize .TP \fIcmdPrefix \fBfinalize \fIchannelId\fR . @@ -94,6 +96,7 @@ treated as (and converted to) an error. This subcommand is not invoked if the creation of the channel was aborted during \fBinitialize\fR (See above). .RE +.\" METHOD: watch .TP \fIcmdPrefix \fBwatch \fIchannelId eventspec\fR . @@ -114,6 +117,7 @@ event which was not listed in the last call to \fBwatch\fR will cause \fBchan postevent\fR to throw an error. .RE .SS "OPTIONAL SUBCOMMANDS" +.\" METHOD: read .TP \fIcmdPrefix \fBread \fIchannelId count\fR . @@ -170,6 +174,7 @@ invocation (usually \fBgets\fR, or \fBread\fR) will appear to have thrown this error. Any exception beyond \fBerror\fR, (e.g.,\ \fBbreak\fR, etc.) is treated as and converted to an error. .RE +.\" METHOD: write .TP \fIcmdPrefix \fBwrite \fIchannelId data\fR . @@ -227,6 +232,7 @@ invocation (usually \fBputs\fR) will appear to have thrown this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR, etc.) is treated as and converted to an error. .RE +.\" METHOD: seek .TP \fIcmdPrefix \fBseek \fIchannelId offset base\fR . @@ -269,6 +275,7 @@ The offset/base combination of 0/\fBcurrent\fR signals a \fBchan tell\fR request, i.e.,\ seek nothing relative to the current location, making the new location identical to the current one, which is then returned. .RE +.\" METHOD: configure .TP \fIcmdPrefix \fBconfigure \fIchannelId option value\fR . @@ -288,6 +295,7 @@ If the subcommand throws an error the command which performed the beyond \fBerror\fR (e.g.,\ \fBbreak\fR, etc.) is treated as and converted to an error. .RE +.\" METHOD: cget .TP \fIcmdPrefix \fBcget \fIchannelId option\fR . @@ -303,6 +311,7 @@ If the subcommand throws an error, the command which performed the will appear to have thrown this error. Any exception beyond \fIerror\fR (e.g.,\ \fBbreak\fR, etc.) is treated as and converted to an error. .RE +.\" METHOD: cgetall .TP \fIcmdPrefix \fBcgetall \fIchannelId\fR . @@ -319,6 +328,7 @@ If the subcommand throws an error the command which performed the will appear to have thrown this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR, etc.) is treated as and converted to an error. .RE +.\" METHOD: blocking .TP \fIcmdPrefix \fBblocking \fIchannelId mode\fR . @@ -335,8 +345,9 @@ invocation (usually \fBfconfigure\fR or \fBchan configure\fR) will appear to have thrown this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR, etc.) is treated as and converted to an error. .RE +.\" METHOD: truncate .TP -\fIcmdPrefix \fBtruncate\fR \fIchannelId length\fR +\fIcmdPrefix \fBtruncate\fI channelId length\fR . This \fIoptional\fR subcommand handles changing the length of the underlying data stream for the channel \fIchannelId\fR. Its length diff --git a/doc/regexp.n b/doc/regexp.n index 6f303a4..f39f389 100644 --- a/doc/regexp.n +++ b/doc/regexp.n @@ -130,7 +130,7 @@ regular expression. Examples are: .CE .RE .TP 15 -\fB\-start\fR \fIindex\fR +\fB\-start\fI index\fR . Specifies a character index offset into the string to start matching the regular expression at. diff --git a/doc/registry.n b/doc/registry.n index 66b2dd9..a58dd87 100644 --- a/doc/registry.n +++ b/doc/registry.n @@ -15,7 +15,7 @@ registry \- Manipulate the Windows registry .sp \fBpackage require registry 1.3\fR .sp -\fBregistry \fR?\fI\-mode\fR? \fIoption\fR \fIkeyName\fR ?\fIarg arg ...\fR? +\fBregistry \fR?\fI\-mode\fR? \fIoption keyName\fR ?\fIarg arg ...\fR? .BE .SH DESCRIPTION .PP @@ -53,6 +53,7 @@ of the requested operation. \fIOption\fR indicates what to do with the registry key name. Any unique abbreviation for \fIoption\fR is acceptable. The valid options are: +.\" METHOD: broadcast .TP \fBregistry broadcast \fIkeyName\fR ?\fB\-timeout \fImilliseconds\fR? . @@ -79,6 +80,7 @@ set curPath [\fBregistry get\fR $regPath "Path"] \fBregistry broadcast\fR "Environment" .CE .RE +.\" METHOD: delete .TP \fBregistry delete \fIkeyName\fR ?\fIvalueName\fR? . @@ -88,6 +90,7 @@ optional \fIvalueName\fR is omitted, the specified key and any subkeys or values beneath it in the registry hierarchy will be deleted. If the key could not be deleted then an error is generated. If the key did not exist, the command has no effect. +.\" METHOD: get .TP \fBregistry get \fIkeyName valueName\fR . @@ -95,6 +98,7 @@ Returns the data associated with the value \fIvalueName\fR under the key \fIkeyName\fR. If either the key or the value does not exist, then an error is generated. For more details on the format of the returned data, see \fBSUPPORTED TYPES\fR, below. +.\" METHOD: keys .TP \fBregistry keys \fIkeyName\fR ?\fIpattern\fR? . @@ -103,6 +107,7 @@ subkeys of \fIkeyName\fR. If \fIpattern\fR is specified, only those names matching \fIpattern\fR are returned. Matching is determined using the same rules as for \fBstring match\fR. If the specified \fIkeyName\fR does not exist, then an error is generated. +.\" METHOD: set .TP \fBregistry set \fIkeyName\fR ?\fIvalueName data \fR?\fItype\fR?? . @@ -113,12 +118,14 @@ contents of \fIvalueName\fR are set to \fIdata\fR with the type indicated by \fItype\fR. If \fItype\fR is not specified, the type \fBsz\fR is assumed. For more details on the data and type arguments, see \fBSUPPORTED TYPES\fR below. +.\" METHOD: type .TP \fBregistry type \fIkeyName valueName\fR . Returns the type of the value \fIvalueName\fR in the key \fIkeyName\fR. For more information on the possible types, see \fBSUPPORTED TYPES\fR, below. +.\" METHOD: values .TP \fBregistry values \fIkeyName\fR ?\fIpattern\fR? . diff --git a/doc/regsub.n b/doc/regsub.n index 29c118a..439ad49 100644 --- a/doc/regsub.n +++ b/doc/regsub.n @@ -147,7 +147,7 @@ Upper-case characters in \fIstring\fR will be converted to lower-case before matching against \fIexp\fR; however, substitutions specified by \fIsubSpec\fR use the original unconverted form of \fIstring\fR. .TP -\fB\-start\fR \fIindex\fR +\fB\-start\fI index\fR . Specifies a character index offset into the string to start matching the regular expression at. diff --git a/doc/return.n b/doc/return.n index e3d7c06..58b1b75 100644 --- a/doc/return.n +++ b/doc/return.n @@ -54,7 +54,7 @@ of the procedure is 0 (\fBTCL_OK\fR). . Error return: the return code of the procedure is 1 (\fBTCL_ERROR\fR). The procedure command behaves in its calling context as if it -were the command \fBerror\fR \fIresult\fR. See below for additional +were the command \fBerror\fI result\fR. See below for additional options. .TP 13 \fBreturn\fR (or \fB2\fR) diff --git a/doc/safe.n b/doc/safe.n index 6e0d948..a3a945e 100644 --- a/doc/safe.n +++ b/doc/safe.n @@ -13,26 +13,26 @@ safe \- Creating and manipulating safe interpreters .SH SYNOPSIS \fB::safe::interpCreate\fR ?\fIchild\fR? ?\fIoptions...\fR? .sp -\fB::safe::interpInit\fR \fIchild\fR ?\fIoptions...\fR? +\fB::safe::interpInit\fI child\fR ?\fIoptions...\fR? .sp -\fB::safe::interpConfigure\fR \fIchild\fR ?\fIoptions...\fR? +\fB::safe::interpConfigure\fI child\fR ?\fIoptions...\fR? .sp -\fB::safe::interpDelete\fR \fIchild\fR +\fB::safe::interpDelete\fI child\fR .sp -\fB::safe::interpAddToAccessPath\fR \fIchild\fR \fIdirectory\fR +\fB::safe::interpAddToAccessPath\fI child directory\fR .sp -\fB::safe::interpFindInAccessPath\fR \fIchild\fR \fIdirectory\fR +\fB::safe::interpFindInAccessPath\fI child directory\fR .sp \fB::safe::setSyncMode\fR ?\fInewValue\fR? .sp \fB::safe::setLogCmd\fR ?\fIcmd arg...\fR? .SS OPTIONS .PP -?\fB\-accessPath\fR \fIpathList\fR? -?\fB\-autoPath\fR \fIpathList\fR? -?\fB\-statics\fR \fIboolean\fR? ?\fB\-noStatics\fR? -?\fB\-nested\fR \fIboolean\fR? ?\fB\-nestedLoadOk\fR? -?\fB\-deleteHook\fR \fIscript\fR? +?\fB\-accessPath\fI pathList\fR? +?\fB\-autoPath\fI pathList\fR? +?\fB\-statics\fI boolean\fR? ?\fB\-noStatics\fR? +?\fB\-nested\fI boolean\fR? ?\fB\-nestedLoadOk\fR? +?\fB\-deleteHook\fI script\fR? .BE .SH DESCRIPTION Safe Tcl is a mechanism for executing untrusted Tcl scripts @@ -66,8 +66,10 @@ All commands provided in the parent interpreter by Safe Tcl reside in the \fBsafe\fR namespace. .SH COMMANDS The following commands are provided in the parent interpreter: +.\" COMMAND: interpCreate .TP \fB::safe::interpCreate\fR ?\fIchild\fR? ?\fIoptions...\fR? +. Creates a safe interpreter, installs the aliases described in the section \fBALIASES\fR and initializes the auto-loading and package mechanism as specified by the supplied \fIoptions\fR. @@ -75,21 +77,27 @@ See the \fBOPTIONS\fR section below for a description of the optional arguments. If the \fIchild\fR argument is omitted, a name will be generated. \fB::safe::interpCreate\fR always returns the interpreter name. -.sp +.RS +.PP The interpreter name \fIchild\fR may include namespace separators, but may not have leading or trailing namespace separators, or excess colon characters in namespace separators. The interpreter name is qualified relative to the global namespace ::, not the namespace in which the \fB::safe::interpCreate\fR command is evaluated. +.RE +.\" COMMAND: interpInit .TP -\fB::safe::interpInit\fR \fIchild\fR ?\fIoptions...\fR? +\fB::safe::interpInit\fI child\fR ?\fIoptions...\fR? +. This command is similar to \fBinterpCreate\fR except it that does not create the safe interpreter. \fIchild\fR must have been created by some other means, like \fBinterp create\fR \fB\-safe\fR. The interpreter name \fIchild\fR may include namespace separators, subject to the same restrictions as for \fBinterpCreate\fR. +.\" COMMAND: interpConfigure .TP -\fB::safe::interpConfigure\fR \fIchild\fR ?\fIoptions...\fR? +\fB::safe::interpConfigure\fI child\fR ?\fIoptions...\fR? +. If no \fIoptions\fR are given, returns the settings for all options for the named safe interpreter as a list of options and their current values for that \fIchild\fR. @@ -115,15 +123,18 @@ set dh [safe::interpConfigure $i0 \-del] safe::interpConfigure $i0 \-delete {foo bar} \-statics 0 .CE .RE +.\" COMMAND: interpDelete .TP -\fB::safe::interpDelete\fR \fIchild\fR +\fB::safe::interpDelete\fI child\fR Deletes the safe interpreter and cleans up the corresponding parent interpreter data structures. If a \fIdeleteHook\fR script was specified for this interpreter it is evaluated before the interpreter is deleted, with the name of the interpreter as an additional argument. +.\" COMMAND: interpFindInAccessPath .TP -\fB::safe::interpFindInAccessPath\fR \fIchild\fR \fIdirectory\fR +\fB::safe::interpFindInAccessPath\fI child directory\fR +. This command finds and returns the token for the real directory \fIdirectory\fR in the safe interpreter's current virtual access path. It generates an error if the directory is not found. @@ -135,8 +146,10 @@ $child eval [list set tk_library \e [::safe::interpFindInAccessPath $name $tk_library]] .CE .RE +.\" COMMAND: interpAddToAccessPath .TP -\fB::safe::interpAddToAccessPath\fR \fIchild\fR \fIdirectory\fR +\fB::safe::interpAddToAccessPath\fI child directory\fR +. This command adds \fIdirectory\fR to the virtual path maintained for the safe interpreter in the parent, and returns the token that can be used in the safe interpreter to obtain access to files in that directory. @@ -150,8 +163,10 @@ $child eval [list set tk_library \e [::safe::interpAddToAccessPath $name $tk_library]] .CE .RE +.\" COMMAND: setSyncMode .TP \fB::safe::setSyncMode\fR ?\fInewValue\fR? +. This command is used to get or set the "Sync Mode" of the Safe Base. When an argument is supplied, the command returns an error if the argument is not a boolean value, or if any Safe Base interpreters exist. Typically @@ -159,8 +174,10 @@ the value will be set as part of initialization - boolean true for "Sync Mode" on (the default), false for "Sync Mode" off. With "Sync Mode" on, the Safe Base keeps each child interpreter's ::auto_path synchronized with its access path. See the section \fBSYNC MODE\fR below for details. +.\" COMMAND: setLogCmd .TP \fB::safe::setLogCmd\fR ?\fIcmd arg...\fR? +. This command installs a script that will be called when interesting life cycle events occur for a safe interpreter. When called with no arguments, it returns the currently installed script. @@ -202,7 +219,8 @@ Any option name can be abbreviated to its minimal non-ambiguous name. Option names are not case sensitive. .TP -\fB\-accessPath\fR \fIdirectoryList\fR +\fB\-accessPath\fI directoryList\fR +. This option sets the list of directories from which the safe interpreter can \fBsource\fR and \fBload\fR files. If this option is not specified, or if it is given as the @@ -211,25 +229,29 @@ parent for auto-loading. See the section \fBSECURITY\fR below for more detail about virtual paths, tokens and access control. .TP -\fB\-autoPath\fR \fIdirectoryList\fR +\fB\-autoPath\fI directoryList\fR +. This option sets the list of directories in the safe interpreter's ::auto_path. The option is undefined if the Safe Base has "Sync Mode" on - in that case the safe interpreter's ::auto_path is managed by the Safe Base and is a tokenized form of its access path. See the section \fBSYNC MODE\fR below for details. .TP -\fB\-statics\fR \fIboolean\fR +\fB\-statics\fI boolean\fR +. This option specifies if the safe interpreter will be allowed to load statically linked packages (like \fBload {} Tk\fR). The default value is \fBtrue\fR : safe interpreters are allowed to load statically linked packages. .TP \fB\-noStatics\fR +. This option is a convenience shortcut for \fB\-statics false\fR and thus specifies that the safe interpreter will not be allowed to load statically linked packages. .TP -\fB\-nested\fR \fIboolean\fR +\fB\-nested\fI boolean\fR +. This option specifies if the safe interpreter will be allowed to load packages into its own sub-interpreters. The default value is \fBfalse\fR : @@ -237,11 +259,13 @@ safe interpreters are not allowed to load packages into their own sub-interpreters. .TP \fB\-nestedLoadOk\fR +. This option is a convenience shortcut for \fB\-nested true\fR and thus specifies the safe interpreter will be allowed to load packages into its own sub-interpreters. .TP -\fB\-deleteHook\fR \fIscript\fR +\fB\-deleteHook\fI script\fR +. When this option is given a non-empty \fIscript\fR, it will be evaluated in the parent with the name of the safe interpreter as an additional argument @@ -252,7 +276,8 @@ The default value (\fB{}\fR) is not to have any deletion call back. .SH ALIASES The following aliases are provided in a safe interpreter: .TP -\fBsource\fR \fIfileName\fR +\fBsource\fI fileName\fR +. The requested file, a Tcl source file, is sourced into the safe interpreter if it is found. The \fBsource\fR alias can only source files from directories in @@ -263,7 +288,8 @@ which the file to be sourced can be found. See the section on \fBSECURITY\fR for more discussion of restrictions on valid filenames. .TP -\fBload\fR \fIfileName\fR +\fBload\fI fileName\fR +. The requested file, a shared object file, is dynamically loaded into the safe interpreter if it is found. The filename must contain a token name mentioned in the virtual path for @@ -272,6 +298,7 @@ Additionally, the shared object file must contain a safe entry point; see the manual page for the \fBload\fR command for more details. .TP \fBfile\fR ?\fIsubCmd args...\fR? +. The \fBfile\fR alias provides access to a safe subset of the subcommands of the \fBfile\fR command; it allows only \fBdirname\fR, \fBjoin\fR, \fBextension\fR, \fBroot\fR, \fBtail\fR, \fBpathname\fR and \fBsplit\fR @@ -279,12 +306,14 @@ subcommands. For more details on what these subcommands do see the manual page for the \fBfile\fR command. .TP \fBencoding\fR ?\fIsubCmd args...\fR? +. The \fBencoding\fR alias provides access to a safe subset of the subcommands of the \fBencoding\fR command; it disallows setting of the system encoding, but allows all other subcommands including \fBsystem\fR to check the current encoding. .TP \fBexit\fR +. The calling interpreter is deleted and its computation is stopped, but the Tcl process in which this interpreter exists is not terminated. .SH SECURITY diff --git a/doc/self.n b/doc/self.n index 14f68c7..e12eb29 100644 --- a/doc/self.n +++ b/doc/self.n @@ -24,6 +24,7 @@ used to allow the method to discover information about how it was called. It takes an argument, \fIsubcommand\fR, that tells it what sort of information is actually desired; if omitted the result will be the same as if \fBself object\fR was invoked. The supported subcommands are: +.\" METHOD: call .TP \fBself call\fR . @@ -40,6 +41,7 @@ being a \fBmethod\fR), and the second element is an index into the first element's list that indicates which actual implementation is currently executing (the first implementation to execute is always at index 0). +.\" METHOD: caller .TP \fBself caller\fR . @@ -50,6 +52,7 @@ second element is the name of the object on which the containing method was invoked, and the third element is the name of the method (with the strings \fB\fR and \fB\fR indicating constructors and destructors respectively). +.\" METHOD: class .TP \fBself class\fR . @@ -66,6 +69,7 @@ construct: info object class [\fBself object\fR] .CE .RE +.\" METHOD: filter .TP \fBself filter\fR . @@ -75,17 +79,20 @@ that declared the filter (note that this may be different from the object or class that provided the implementation of the filter), the second element is either \fBobject\fR or \fBclass\fR depending on whether the declaring entity was an object or class, and the third element is the name of the filter. +.\" METHOD: method .TP \fBself method\fR . This returns the name of the current method (with the strings \fB\fR and \fB\fR indicating constructors and destructors respectively). +.\" METHOD: namespace .TP \fBself namespace\fR . This returns the name of the unique namespace of the object that the method was invoked upon. +.\" METHOD: next .TP \fBself next\fR . @@ -98,10 +105,12 @@ of the method (with the strings \fB\fR and \fB\fR indicating constructors and destructors respectively). If invoked from a method that is at the end of a call chain, this subcommand returns the empty string. +.\" METHOD: object .TP \fBself object\fR . This returns the name of the object that the method was invoked upon. +.\" METHOD: target .TP \fBself target\fR . diff --git a/doc/string.n b/doc/string.n index c610aeb..6e87deb 100644 --- a/doc/string.n +++ b/doc/string.n @@ -18,6 +18,7 @@ string \- Manipulate strings .PP Performs one of several string operations, depending on \fIoption\fR. The legal \fIoption\fRs (which may be abbreviated) are: +.\" METHOD: cat .TP \fBstring cat\fR ?\fIstring1\fR? ?\fIstring2...\fR? . @@ -32,6 +33,7 @@ of a concatenation without resorting to \fBreturn\fR \fB\-level 0\fR, and is more efficient than building a list of arguments and using \fBjoin\fR with an empty join string. .RE +.\" METHOD: compare .TP \fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR . @@ -42,6 +44,7 @@ than \fIstring2\fR. If \fB\-length\fR is specified, then only the first \fIlength\fR characters are used in the comparison. If \fB\-length\fR is negative, it is ignored. If \fB\-nocase\fR is specified, then the strings are compared in a case-insensitive manner. +.\" METHOD: equal .TP \fBstring equal\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR . @@ -51,6 +54,7 @@ identical, or 0 when not. If \fB\-length\fR is specified, then only the first \fIlength\fR characters are used in the comparison. If \fB\-length\fR is negative, it is ignored. If \fB\-nocase\fR is specified, then the strings are compared in a case-insensitive manner. +.\" METHOD: first .TP \fBstring first \fIneedleString haystackString\fR ?\fIstartIndex\fR? . @@ -75,6 +79,7 @@ will return \fB10\fR, but .PP will return \fB\-1\fR. .RE +.\" METHOD: index .TP \fBstring index \fIstring charIndex\fR . @@ -87,6 +92,7 @@ string. \fIcharIndex\fR may be specified as described in the If \fIcharIndex\fR is less than 0 or greater than or equal to the length of the string then this command returns an empty string. .RE +.\" METHOD: insert .TP \fBstring insert \fIstring index insertString\fR .VS "TIP 504" @@ -105,6 +111,7 @@ or after the end of \fIstring\fR (e.g., \fIindex\fR is \fBend\fR), \fIinsertString\fR is appended to \fIstring\fR. .RE .VE "TIP 504" +.\" METHOD: is .TP \fBstring is \fIclass\fR ?\fB\-strict\fR? ?\fB\-failindex \fIvarname\fR? \fIstring\fR . @@ -196,6 +203,7 @@ In the case of \fBboolean\fR, \fBtrue\fR and \fBfalse\fR, if the function will return 0, then the \fIvarname\fR will always be set to 0, due to the varied nature of a valid boolean value. .RE +.\" METHOD: last .TP \fBstring last \fIneedleString haystackString\fR ?\fIlastIndex\fR? . @@ -220,6 +228,7 @@ will return \fB10\fR, but .PP will return \fB1\fR. .RE +.\" METHOD: length .TP \fBstring length \fIstring\fR . @@ -228,6 +237,7 @@ Returns a decimal string giving the number of characters in number of bytes used to store the string. If the value is a byte array value (such as those returned from reading a binary encoded channel), then this will return the actual byte length of the value. +.\" METHOD: map .TP \fBstring map\fR ?\fB\-nocase\fR? \fImapping string\fR . @@ -259,8 +269,9 @@ reordered like this, .PP it will return the string \fB02c322c222c\fR. .RE +.\" METHOD: match .TP -\fBstring match\fR ?\fB\-nocase\fR? \fIpattern\fR \fIstring\fR +\fBstring match\fR ?\fB\-nocase\fR? \fIpattern string\fR . See if \fIpattern\fR matches \fIstring\fR; return 1 if it does, 0 if it does not. If \fB\-nocase\fR is specified, then the pattern attempts @@ -293,6 +304,7 @@ Matches the single character \fIx\fR. This provides a way of avoiding the special interpretation of the characters \fB*?[]\e\fR in \fIpattern\fR. .RE +.\" METHOD: range .TP \fBstring range \fIstring first last\fR . @@ -307,12 +319,14 @@ it is treated as if it were zero, and if \fIlast\fR is greater than or equal to the length of the string then it is treated as if it were \fBend\fR. If \fIfirst\fR is greater than \fIlast\fR then an empty string is returned. +.\" METHOD: repeat .TP \fBstring repeat \fIstring count\fR . Returns a string consisting of \fIstring\fR concatenated with itself \fIcount\fR times. If \fIcount\fR is 0, the empty string will be returned. +.\" METHOD: replace .TP \fBstring replace \fIstring first last\fR ?\fInewstring\fR? . @@ -329,11 +343,13 @@ then it is treated as if it were \fBend\fR. The initial string is returned untouched, if \fIfirst\fR is greater than \fIlast\fR, or if \fIfirst\fR is equal to or greater than the length of the initial string, or \fIlast\fR is less than 0. +.\" METHOD: reverse .TP \fBstring reverse \fIstring\fR . Returns a string that is the same length as \fIstring\fR but with its characters in the reverse order. +.\" METHOD: tolower .TP \fBstring tolower \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR? . @@ -343,6 +359,7 @@ specified, it refers to the first char index in the string to start modifying. If \fIlast\fR is specified, it refers to the char index in the string to stop at (inclusive). \fIfirst\fR and \fIlast\fR may be specified using the forms described in \fBSTRING INDICES\fR. +.\" METHOD: totitle .TP \fBstring totitle \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR? . @@ -354,6 +371,7 @@ refers to the first char index in the string to start modifying. If \fIlast\fR is specified, it refers to the char index in the string to stop at (inclusive). \fIfirst\fR and \fIlast\fR may be specified using the forms described in \fBSTRING INDICES\fR. +.\" METHOD: toupper .TP \fBstring toupper \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR? . @@ -363,6 +381,7 @@ specified, it refers to the first char index in the string to start modifying. If \fIlast\fR is specified, it refers to the char index in the string to stop at (inclusive). \fIfirst\fR and \fIlast\fR may be specified using the forms described in \fBSTRING INDICES\fR. +.\" METHOD: trim .TP \fBstring trim \fIstring\fR ?\fIchars\fR? . @@ -370,6 +389,7 @@ Returns a value equal to \fIstring\fR except that any leading or trailing characters present in the string given by \fIchars\fR are removed. If \fIchars\fR is not specified then white space is removed (any character for which \fBstring is space\fR returns 1, and "\e0"). +.\" METHOD: trimleft .TP \fBstring trimleft \fIstring\fR ?\fIchars\fR? . @@ -377,6 +397,7 @@ Returns a value equal to \fIstring\fR except that any leading characters present in the string given by \fIchars\fR are removed. If \fIchars\fR is not specified then white space is removed (any character for which \fBstring is space\fR returns 1, and "\e0"). +.\" METHOD: trimright .TP \fBstring trimright \fIstring\fR ?\fIchars\fR? . @@ -389,12 +410,7 @@ for which \fBstring is space\fR returns 1, and "\e0"). These subcommands are currently supported, but are likely to go away in a future release as their functionality is either virtually never used or highly misleading. -.RS -.PP -.CS -\fBstring length\fR [encoding convertto utf-8 $theString] -.CE -.RE +.\" METHOD: wordend .TP \fBstring wordend \fIstring charIndex\fR . @@ -404,6 +420,7 @@ may be specified using the forms in \fBSTRING INDICES\fR. A word is considered to be any contiguous range of alphanumeric (Unicode letters or decimal digits) or underscore (Unicode connector punctuation) characters, or any single character other than these. +.\" METHOD: wordstart .TP \fBstring wordstart \fIstring charIndex\fR . diff --git a/doc/switch.n b/doc/switch.n index 70eeb09..d35c650 100644 --- a/doc/switch.n +++ b/doc/switch.n @@ -56,7 +56,7 @@ expression matching . Causes comparisons to be handled in a case-insensitive manner. .TP 10 -\fB\-matchvar\fR \fIvarName\fR +\fB\-matchvar\fI varName\fR . This option (only legal when \fB\-regexp\fR is also specified) specifies the name of a variable into which the list of matches @@ -69,7 +69,7 @@ on. When a \fBdefault\fR branch is taken, the variable will have the empty list written to it. This option may be specified at the same time as the \fB\-indexvar\fR option. .TP 10 -\fB\-indexvar\fR \fIvarName\fR +\fB\-indexvar\fI varName\fR . This option (only legal when \fB\-regexp\fR is also specified) specifies the name of a variable into which the list of indices diff --git a/doc/tcltest.n b/doc/tcltest.n index 965ed64..c29b05e 100644 --- a/doc/tcltest.n +++ b/doc/tcltest.n @@ -89,8 +89,9 @@ See \fBCREATING TEST SUITES WITH TCLTEST\fR below for an extended example of how to use the commands of \fBtcltest\fR to produce test suites for your Tcl-enabled code. .SH COMMANDS +.\" COMMAND: test .TP -\fBtest\fR \fIname description\fR ?\fI\-option value ...\fR? +\fBtest\fI name description\fR ?\fI\-option value ...\fR? . Defines and possibly runs a test with the name \fIname\fR and description \fIdescription\fR. The name and description of a test @@ -104,17 +105,18 @@ See \fBTESTS\fR below for a complete description of the valid options and how they define a test. The \fBtest\fR command returns an empty string. .TP -\fBtest\fR \fIname description\fR ?\fIconstraints\fR? \fIbody result\fR +\fBtest\fI name description\fR ?\fIconstraints\fR? \fIbody result\fR . This form of \fBtest\fR is provided to support test suites written for version 1 of the \fBtcltest\fR package, and also a simpler interface for a common usage. It is the same as -.QW "\fBtest\fR \fIname description\fB \-constraints \fIconstraints\fB \-body \fIbody\fB \-result \fIresult\fR" . +.QW "\fBtest\fI name description\fB \-constraints \fIconstraints\fB \-body \fIbody\fB \-result \fIresult\fR" . All other options to \fBtest\fR take their default values. When \fIconstraints\fR is omitted, this form of \fBtest\fR can be distinguished from the first because all \fIoption\fRs begin with .QW \- . +.\" COMMAND: loadTestedCommands .TP \fBloadTestedCommands\fR . @@ -124,8 +126,9 @@ Returns the result of that script evaluation, including any error raised by the script. Use this command and the related configuration options to provide the commands to be tested to the interpreter running the test suite. +.\" COMMAND: makeFile .TP -\fBmakeFile\fR \fIcontents name\fR ?\fIdirectory\fR? +\fBmakeFile\fI contents name\fR ?\fIdirectory\fR? . Creates a file named \fIname\fR relative to directory \fIdirectory\fR and write \fIcontents\fR @@ -140,16 +143,18 @@ of \fBcleanupTests\fR, unless it is removed by \fIdirectory\fR is the directory \fBconfigure \-tmpdir\fR. Returns the full path of the file created. Use this command to create any text file required by a test with contents as needed. +.\" COMMAND: removeFile .TP -\fBremoveFile\fR \fIname\fR ?\fIdirectory\fR? +\fBremoveFile\fI name\fR ?\fIdirectory\fR? . Forces the file referenced by \fIname\fR to be removed. This file name should be relative to \fIdirectory\fR. The default value of \fIdirectory\fR is the directory \fBconfigure \-tmpdir\fR. Returns an empty string. Use this command to delete files created by \fBmakeFile\fR. +.\" COMMAND: makeDirectory .TP -\fBmakeDirectory\fR \fIname\fR ?\fIdirectory\fR? +\fBmakeDirectory\fI name\fR ?\fIdirectory\fR? . Creates a directory named \fIname\fR relative to directory \fIdirectory\fR. The directory will be removed by the next evaluation of \fBcleanupTests\fR, @@ -158,8 +163,9 @@ The default value of \fIdirectory\fR is the directory \fBconfigure \-tmpdir\fR. Returns the full path of the directory created. Use this command to create any directories that are required to exist by a test. +.\" COMMAND: removeDirectory .TP -\fBremoveDirectory\fR \fIname\fR ?\fIdirectory\fR? +\fBremoveDirectory\fI name\fR ?\fIdirectory\fR? . Forces the directory referenced by \fIname\fR to be removed. This directory should be relative to \fIdirectory\fR. @@ -167,8 +173,9 @@ The default value of \fIdirectory\fR is the directory \fBconfigure \-tmpdir\fR. Returns an empty string. Use this command to delete any directories created by \fBmakeDirectory\fR. +.\" COMMAND: viewFile .TP -\fBviewFile\fR \fIfile\fR ?\fIdirectory\fR? +\fBviewFile\fI file\fR ?\fIdirectory\fR? . Returns the contents of \fIfile\fR, except for any final newline, just as \fBread \-nonewline\fR would return. @@ -180,6 +187,7 @@ by a test into the result of that test for matching against an expected result. The contents of the file are read using the system encoding, so its usefulness is limited to text files. +.\" COMMAND: cleanupTests .TP \fBcleanupTests\fR . @@ -200,6 +208,7 @@ to \fBoutputChannel\fR. This command also restores the original shell environment, as described by the global \fBenv\fR array. Returns an empty string. .RE +.\" COMMAND: runAllTests .TP \fBrunAllTests\fR . @@ -209,6 +218,7 @@ the configurable options of \fBtcltest\fR. See \fBRUNNING ALL TESTS\fR below for a complete description of the many variations possible with \fBrunAllTests\fR. .SS "CONFIGURATION COMMANDS" +.\" COMMAND: configure .TP \fBconfigure\fR . @@ -238,6 +248,7 @@ then its value is taken as a list of arguments to pass to \fBconfigure\fR. This allows the default values of the configuration options to be set by the environment. .RE +.\" COMMAND: customMatch .TP \fBcustomMatch \fImode script\fR . @@ -252,11 +263,13 @@ is evaluated in the global namespace. The completed script is expected to return a boolean value indicating whether or not the results match. The built-in matching modes of \fBtest\fR are \fBexact\fR, \fBglob\fR, and \fBregexp\fR. +.\" COMMAND: testConstraint .TP \fBtestConstraint \fIconstraint\fR ?\fIboolean\fR? . Sets or returns the boolean value associated with the named \fIconstraint\fR. See \fBTEST CONSTRAINTS\fR below for more information. +.\" COMMAND: interpreter .TP \fBinterpreter\fR ?\fIexecutableName\fR? . @@ -265,6 +278,7 @@ Sets or returns the name of the executable to be \fBexec\fRed by \fBconfigure \-singleproc\fR is false. The default value for \fBinterpreter\fR is the name of the currently running program as returned by \fBinfo nameofexecutable\fR. +.\" COMMAND: outputChannel .TP \fBoutputChannel\fR ?\fIchannelID\fR? . @@ -272,6 +286,7 @@ Sets or returns the output channel ID. This defaults to \fBstdout\fR. Any test that prints test related output should send that output to \fBoutputChannel\fR rather than letting that output default to \fBstdout\fR. +.\" COMMAND: errorChannel .TP \fBerrorChannel\fR ?\fIchannelID\fR? . @@ -280,6 +295,7 @@ Any test that prints error messages should send that output to \fBerrorChannel\fR rather than printing directly to \fBstderr\fR. .SS "SHORTCUT CONFIGURATION COMMANDS" +.\" COMMAND: debug .TP \fBdebug\fR ?\fIlevel\fR? . @@ -290,76 +306,91 @@ Same as . Same as .QW "\fBconfigure \-errfile\fR ?\fIfilename\fR?" . +.\" COMMAND: limitConstraints .TP \fBlimitConstraints\fR ?\fIboolean\fR? . Same as .QW "\fBconfigure \-limitconstraints\fR ?\fIboolean\fR?" . +.\" COMMAND: loadFile .TP \fBloadFile\fR ?\fIfilename\fR? . Same as .QW "\fBconfigure \-loadfile\fR ?\fIfilename\fR?" . +.\" COMMAND: loadScript .TP \fBloadScript\fR ?\fIscript\fR? . Same as .QW "\fBconfigure \-load\fR ?\fIscript\fR?" . +.\" COMMAND: match .TP \fBmatch\fR ?\fIpatternList\fR? . Same as .QW "\fBconfigure \-match\fR ?\fIpatternList\fR?" . +.\" COMMAND: matchDirectories .TP \fBmatchDirectories\fR ?\fIpatternList\fR? . Same as .QW "\fBconfigure \-relateddir\fR ?\fIpatternList\fR?" . +.\" COMMAND: matchFiles .TP \fBmatchFiles\fR ?\fIpatternList\fR? . Same as .QW "\fBconfigure \-file\fR ?\fIpatternList\fR?" . +.\" COMMAND: outputFile .TP \fBoutputFile\fR ?\fIfilename\fR? . Same as .QW "\fBconfigure \-outfile\fR ?\fIfilename\fR?" . +.\" COMMAND: preserveCore .TP \fBpreserveCore\fR ?\fIlevel\fR? . Same as .QW "\fBconfigure \-preservecore\fR ?\fIlevel\fR?" . +.\" COMMAND: singleProcess .TP \fBsingleProcess\fR ?\fIboolean\fR? . Same as .QW "\fBconfigure \-singleproc\fR ?\fIboolean\fR?" . +.\" COMMAND: skip .TP \fBskip\fR ?\fIpatternList\fR? . Same as .QW "\fBconfigure \-skip\fR ?\fIpatternList\fR?" . +.\" COMMAND: skipDirectories .TP \fBskipDirectories\fR ?\fIpatternList\fR? . Same as .QW "\fBconfigure \-asidefromdir\fR ?\fIpatternList\fR?" . +.\" COMMAND: skipFiles .TP \fBskipFiles\fR ?\fIpatternList\fR? . Same as .QW "\fBconfigure \-notfile\fR ?\fIpatternList\fR?" . +.\" COMMAND: temporaryDirectory .TP \fBtemporaryDirectory\fR ?\fIdirectory\fR? . Same as .QW "\fBconfigure \-tmpdir\fR ?\fIdirectory\fR?" . +.\" COMMAND: testsDirectory .TP \fBtestsDirectory\fR ?\fIdirectory\fR? . Same as .QW "\fBconfigure \-testdir\fR ?\fIdirectory\fR?" . +.\" COMMAND: verbose .TP \fBverbose\fR ?\fIlevel\fR? . @@ -372,7 +403,7 @@ alternatives provided by \fBtcltest\fR or \fBTcl\fR itself. They are retained to support existing test suites, but should be avoided in new code. .TP -\fBtest\fR \fIname description optionList\fR +\fBtest\fI name description optionList\fR . This form of \fBtest\fR was provided to enable passing many options spanning several lines to \fBtest\fR as a single @@ -396,6 +427,7 @@ If you insist on using this form, examine the source code of \fBtcltest\fR if you want to know the substitution details, or just enclose the third through last argument to \fBtest\fR in braces and hope for the best. +.\" COMMAND: workingDirectory .TP \fBworkingDirectory\fR ?\fIdirectoryName\fR? . @@ -403,6 +435,7 @@ Sets or returns the current working directory when the test suite is running. The default value for workingDirectory is the directory in which the test suite was launched. The Tcl commands \fBcd\fR and \fBpwd\fR are sufficient replacements. +.\" COMMAND: normalizeMsg .TP \fBnormalizeMsg \fImsg\fR . @@ -414,6 +447,7 @@ is rather imprecise. Tcl offers plenty of string processing commands to modify strings as you wish, and \fBcustomMatch\fR allows flexible matching of actual and expected results. +.\" COMMAND: normalizePath .TP \fBnormalizePath \fIpathVar\fR . @@ -421,6 +455,7 @@ Resolves symlinks in a path, thus creating a path without internal redirection. It is assumed that \fIpathVar\fR is absolute. \fIpathVar\fR is modified in place. The Tcl command \fBfile normalize\fR is a sufficient replacement. +.\" COMMAND: bytestring .TP \fBbytestring \fIstring\fR . @@ -445,7 +480,7 @@ also influence how \fBtest\fR operates. The valid options for \fBtest\fR are summarized: .PP .CS -\fBtest\fR \fIname\fR \fIdescription\fR +\fBtest\fI name description\fR ?\fB\-constraints \fIkeywordList|expression\fR? ?\fB\-setup \fIsetupScript\fR? ?\fB\-body \fItestScript\fR? diff --git a/doc/tclvars.n b/doc/tclvars.n index 49e86a5..a08f525 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -17,6 +17,7 @@ argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_li The following global variables are created and managed automatically by the Tcl library. Except where noted below, these variables should normally be treated as read-only by application-specific code and by users. +.\" VARIABLE: auto_path .TP \fBauto_path\fR . @@ -40,6 +41,7 @@ Additional variables relating to package management exist. More details are listed in the \fBVARIABLES\fR section of the \fBlibrary\fR manual page. .RE +.\" VARIABLE: env .TP \fBenv\fR . @@ -121,6 +123,7 @@ If existing, it has the same effect as running \fBinterp debug\fR \fB{} -frame 1\fR as the very first command of each new Tcl interpreter. .RE +.\" VARIABLE: errorCode .TP \fBerrorCode\fR . @@ -217,6 +220,7 @@ If none of these methods for setting the error code has been used, the Tcl interpreter will reset the variable to \fBNONE\fR after the next error. .RE +.\" VARIABLE: errorInfo .TP \fBerrorInfo\fR . @@ -227,6 +231,7 @@ identifying the Tcl commands and procedures that were being executed when the most recent error occurred. Its contents take the form of a stack trace showing the various nested Tcl commands that had been invoked at the time of the error. +.\" VARIABLE: tcl_library .TP \fBtcl_library\fR . @@ -249,6 +254,7 @@ If \fBTCL_LIBRARY\fR is not set or doesn't refer to an appropriate directory, then Tcl checks several other directories based on a compiled-in default location, the location of the binary containing the application, and the current working directory. +.\" VARIABLE: tcl_patchLevel .TP \fBtcl_patchLevel\fR . @@ -258,6 +264,7 @@ hold a string giving the current patch level for Tcl, such as \fB8.5b3\fR for the third beta release of Tcl 8.5. The value of this variable is returned by the \fBinfo patchlevel\fR command. +.\" VARIABLE: tcl_pkgPath .TP \fBtcl_pkgPath\fR . @@ -277,6 +284,7 @@ value is added to \fBauto_path\fR at startup; changes to \fBtcl_pkgPath\fR are not reflected in \fBauto_path\fR. If you want Tcl to search additional directories for packages you should add the names of those directories to \fBauto_path\fR, not \fBtcl_pkgPath\fR. +.\" VARIABLE: tcl_platform .TP \fBtcl_platform\fR . @@ -357,6 +365,7 @@ and the value from the GetUserName() system call on Windows. This gives the size of the native-machine word in bytes (strictly, it is same as the result of evaluating \fIsizeof(long)\fR in C.) .RE +.\" VARIABLE: tcl_traceCompile .TP \fBtcl_traceCompile\fR . @@ -375,6 +384,7 @@ tracking down suspected problems with the Tcl compiler. This variable and functionality only exist if \fBTCL_COMPILE_DEBUG\fR was defined during Tcl's compilation. .RE +.\" VARIABLE: tcl_traceExec .TP \fBtcl_traceExec\fR . @@ -401,6 +411,7 @@ and interpreter. This variable and functionality only exist if \fBTCL_COMPILE_DEBUG\fR was defined during Tcl's compilation. .RE +.\" VARIABLE: tcl_wordchars .TP \fBtcl_wordchars\fR . @@ -423,6 +434,7 @@ selecting a word by double-clicking in text in Tk. It is platform dependent. On Windows, it defaults to \fB\es\fR, meaning any Unicode space character. Otherwise it defaults to \fB\eW\fR, which is anything but a Unicode word character (number, letter, or underscore). +.\" VARIABLE: tcl_version .TP \fBtcl_version\fR . @@ -438,20 +450,24 @@ command. The following variables are only guaranteed to exist in \fBtclsh\fR and \fBwish\fR executables; the Tcl library does not define them itself but many Tcl environments do. +.\" VARIABLE: argc .TP 6 \fBargc\fR . The number of arguments to \fBtclsh\fR or \fBwish\fR. +.\" VARIABLE: argv .TP 6 \fBargv\fR . Tcl list of arguments to \fBtclsh\fR or \fBwish\fR. +.\" VARIABLE: argv0 .TP 6 \fBargv0\fR . The script that \fBtclsh\fR or \fBwish\fR started executing (if it was specified) or otherwise the name by which \fBtclsh\fR or \fBwish\fR was invoked. +.\" VARIABLE: tcl_interactive .TP 6 \fBtcl_interactive\fR . diff --git a/doc/tm.n b/doc/tm.n index 27ce673..9b869b6 100644 --- a/doc/tm.n +++ b/doc/tm.n @@ -23,6 +23,8 @@ tm \- Facilities for locating and loading of Tcl Modules This document describes the facilities for locating and loading Tcl Modules (see \fBMODULE DEFINITION\fR for the definition of a Tcl Module). The following commands are supported: +.\" COMMAND: path +.\" METHOD: add .TP \fB::tcl::tm::path add \fR?\fIpath\fR...? . @@ -45,16 +47,19 @@ list. As they are added to the front of the list they are searched in reverse order of addition. In other words, the paths added last are looked at first. .RE +.\" METHOD: remove .TP \fB::tcl::tm::path remove \fR?\fIpath\fR...? . Removes the paths from the list of module paths. The command silently ignores all paths which are not on the list. +.\" METHOD: list .TP \fB::tcl::tm::path list\fR . Returns a list containing all registered module paths, in the order that they are searched for modules. +.\" COMMAND: roots .TP \fB::tcl::tm::roots \fR?\fIpath\fR...? . diff --git a/doc/trace.n b/doc/trace.n index 72b415b..a60b36c 100644 --- a/doc/trace.n +++ b/doc/trace.n @@ -19,13 +19,14 @@ trace \- Monitor variable accesses, command usages and command executions .PP This command causes Tcl commands to be executed whenever certain operations are invoked. The legal \fIoption\fRs (which may be abbreviated) are: +.\" METHOD: add .TP \fBtrace add \fItype name ops\fR ?\fIargs\fR? . Where \fItype\fR is \fBcommand\fR, \fBexecution\fR, or \fBvariable\fR. .RS .TP -\fBtrace add command\fR \fIname ops commandPrefix\fR +\fBtrace add command\fI name ops commandPrefix\fR . Arrange for \fIcommandPrefix\fR to be executed (with additional arguments) whenever command \fIname\fR is modified in one of the ways given by the list @@ -76,7 +77,7 @@ Both \fIoldName\fR and \fInewName\fR are fully qualified with any namespace(s) in which they appear. .RE .TP -\fBtrace add execution\fR \fIname ops commandPrefix\fR +\fBtrace add execution\fI name ops commandPrefix\fR . Arrange for \fIcommandPrefix\fR to be executed (with additional arguments) whenever command \fIname\fR is executed, with traces occurring at the points @@ -302,6 +303,7 @@ but will not remove traces on the overall array. This command returns an empty string. .RE .RE +.\" METHOD: remove .TP \fBtrace remove \fItype name opList commandPrefix\fR Where \fItype\fR is either \fBcommand\fR, \fBexecution\fR or \fBvariable\fR. @@ -327,6 +329,7 @@ command given by \fIopList\fR and \fIcommandPrefix\fR, then the trace is removed, so that \fIcommandPrefix\fR will never again be invoked. Returns an empty string. .RE +.\" METHOD: info .TP \fBtrace info \fItype name\fR Where \fItype\fR is either \fBcommand\fR, \fBexecution\fR or \fBvariable\fR. diff --git a/doc/transchan.n b/doc/transchan.n index b9a0f21..a424981 100644 --- a/doc/transchan.n +++ b/doc/transchan.n @@ -44,6 +44,7 @@ create the transformation. .SS "GENERIC SUBCOMMANDS" .PP The following subcommands are relevant to all types of channel. +.\" METHOD: clear .TP \fIcmdPrefix \fBclear \fIhandle\fR . @@ -51,6 +52,7 @@ This optional subcommand is called to signify to the transformation that any data stored in internal buffers (either incoming or outgoing) must be cleared. It is called when a \fBchan seek\fR is performed on the channel being transformed. +.\" METHOD: finalize .TP \fIcmdPrefix \fBfinalize \fIhandle\fR . @@ -59,6 +61,7 @@ never again, and it exists to allow for cleaning up any Tcl-level data structures associated with the transformation. \fIWarning!\fR Any errors thrown by this subcommand will be ignored. It is not guaranteed to be called if the interpreter is deleted. +.\" METHOD: initialize .TP \fIcmdPrefix \fBinitialize \fIhandle mode\fR . @@ -86,6 +89,7 @@ as error thrown by \fBchan push\fR. These subcommands are used for handling transformations applied to readable channels; though strictly \fBread \fRis optional, it must be supported if any of the others is or the channel will be made non-readable. +.\" METHOD: drain .TP \fIcmdPrefix \fBdrain \fIhandle\fR . @@ -100,6 +104,7 @@ In other words, when this method is called the transformation cannot defer the actual transformation operation anymore and has to transform all data waiting in its internal read buffers and return the result of that action. .RE +.\" METHOD: limit? .TP \fIcmdPrefix \fBlimit? \fIhandle\fR . @@ -108,6 +113,7 @@ how far ahead it should read. If present, it should return an integer number greater than zero which indicates how many bytes ahead should be read, or an integer less than zero to indicate that the I/O engine may read as far ahead as it likes. +.\" METHOD: read .TP \fIcmdPrefix \fBread \fIhandle buffer\fR . @@ -131,6 +137,7 @@ defer the actual transformation until it has more data. These subcommands are used for handling transformations applied to writable channels; though strictly \fBwrite\fR is optional, it must be supported if any of the others is or the channel will be made non-writable. +.\" METHOD: flush .TP \fIcmdPrefix \fBflush \fIhandle\fR . @@ -145,6 +152,7 @@ In other words, when this subcommand is called the transformation cannot defer the actual transformation operation anymore and has to transform all data waiting in its internal write buffers and return the result of that action. .RE +.\" METHOD: write .TP \fIcmdPrefix \fBwrite \fIhandle buffer\fR . diff --git a/doc/vwait.n b/doc/vwait.n index e595a74..951dbaa 100644 --- a/doc/vwait.n +++ b/doc/vwait.n @@ -11,7 +11,7 @@ .SH NAME vwait \- Process events until a variable is written .SH SYNOPSIS -\fBvwait\fR \fIvarName\fR +\fBvwait\fI varName\fR .sp \fBvwait\fR ?\fIoptions\fR? ?\fIvarName ...\fR? .BE @@ -61,21 +61,21 @@ Timer handlers are not serviced during the wait operation. . Events of the windowing system are not handled during the wait operation. .TP -\fB\-readable\fR \fIchannel\fR +\fB\-readable\fI channel\fR . \fIChannel\fR must name a Tcl channel open for reading. If \fIchannel\fR is or becomes readable the wait operation completes. .TP -\fB\-timeout\fR \fImilliseconds\fR +\fB\-timeout\fI milliseconds\fR . The wait operation is constrained to \fImilliseconds\fR. .TP -\fB\-variable\fR \fIvarName\fR +\fB\-variable\fI varName\fR . \fIVarName\fR must be the name of a global variable. Writing or unsetting this variable completes the wait operation. .TP -\fB\-writable\fR \fIchannel\fR +\fB\-writable\fI channel\fR . \fIChannel\fR must name a Tcl channel open for writing. If \fIchannel\fR is or becomes writable the wait operation completes. diff --git a/doc/zipfs.n b/doc/zipfs.n index 0a05078..b7bcab1 100644 --- a/doc/zipfs.n +++ b/doc/zipfs.n @@ -17,18 +17,18 @@ zipfs \- Mount and work with ZIP files within Tcl \fBpackage require tcl::zipfs \fR?\fB1.0\fR? .sp \fBzipfs canonical\fR ?\fImntpnt\fR? \fIfilename\fR ?\fIZIPFS\fR? -\fBzipfs exists\fR \fIfilename\fR -\fBzipfs find\fR \fIdirectoryName\fR -\fBzipfs info\fR \fIfilename\fR +\fBzipfs exists\fI filename\fR +\fBzipfs find\fI directoryName\fR +\fBzipfs info\fI filename\fR \fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR? -\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR? -\fBzipfs lmkzip\fR \fIoutfile inlist\fR ?\fIpassword\fR? -\fBzipfs mkimg\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\fR? -\fBzipfs mkkey\fR \fIpassword\fR -\fBzipfs mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? +\fBzipfs lmkimg\fI outfile inlist\fR ?\fIpassword infile\fR? +\fBzipfs lmkzip\fI outfile inlist\fR ?\fIpassword\fR? +\fBzipfs mkimg\fI outfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\fR? +\fBzipfs mkkey\fI password\fR +\fBzipfs mkzip\fI outfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? \fBzipfs mount\fR ?\fIzipfile\fR? ?\fImountpoint\fR? ?\fIpassword\fR? \fBzipfs root\fR -\fBzipfs unmount\fR \fImountpoint\fR +\fBzipfs unmount\fI mountpoint\fR .fi '\" The following subcommand is *UNDOCUMENTED* '\" \fBzipfs mount_data\fR ?\fIdata\fR ?\fImountpoint\fR?? @@ -49,6 +49,7 @@ cannot be created. Further, modifications to files are limited to the mounted archive in memory and are not persisted to disk. .PP Paths in mounted archives are case-sensitive on all platforms. +.\" METHOD: canonical .TP \fBzipfs canonical\fR ?\fImountpoint\fR? \fIfilename\fR ?\fIinZipfs\fR? . @@ -57,19 +58,22 @@ mapped into a zipfs mount as its result. If specified, \fImountpoint\fR says within which mount the mapping will be done; if omitted, the main root of the zipfs system is used. The \fIinZipfs\fR argument is a an optional boolean which controls whether to fully canonicalise the name; it defaults to true. +.\" METHOD: exists .TP -\fBzipfs exists\fR \fIfilename\fR +\fBzipfs exists\fI filename\fR . Return 1 if the given filename exists in the mounted zipfs and 0 if it does not. +.\" METHOD: find .TP -\fBzipfs find\fR \fIdirectoryName\fR +\fBzipfs find\fI directoryName\fR . Returns the list of paths under directory \fIdirectoryName\fR which need not be within a zipfs mounted archive. The paths are prefixed with \fIdirectoryName\fR. This command is also used by the \fBzipfs mkzip\fR and \fBzipfs mkimg\fR commands. +.\" METHOD: info .TP -\fBzipfs info\fR \fIfile\fR +\fBzipfs info\fI file\fR . Return information about the given \fIfile\fR in the mounted zipfs. The information consists of: @@ -87,6 +91,7 @@ As a special case, querying the mount point gives the start of the zip data as t in (4), which can be used to truncate the zip information from an executable. Querying an ancestor of a mount point will raise an error. .RE +.\" METHOD: list .TP \fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR? . @@ -101,12 +106,13 @@ ordinary characters in the matching. Thus forward slashes should be used as path separators in the pattern. The returned paths only include those actually in the archive and does not include intermediate directories in mount paths. +.\" METHOD: mount .TP \fBzipfs mount\fR .TP -\fBzipfs mount\fR \fImountpoint\fR +\fBzipfs mount\fI mountpoint\fR .TP -\fBzipfs mount\fR \fIzipfile\fR \fImountpoint\fR ?\fIpassword\fR? +\fBzipfs mount\fI zipfile mountpoint\fR ?\fIpassword\fR? .RS .PP The \fBzipfs mount\fR command mounts ZIP archives as Tcl virtual file systems @@ -137,6 +143,7 @@ uses direct access to the OS rather than through Tcl's filesystem API, it will not see the current directory as being inside the mount and will not be able to access the files inside the mount). .RE +.\" METHOD: root .TP \fBzipfs root\fR . @@ -145,6 +152,7 @@ for the current platform. This value is .QW \fB//zipfs:/\fR on most platforms. +.\" METHOD: unmount .TP \fBzipfs unmount \fImountpoint\fR . @@ -154,8 +162,9 @@ there are any files within the mounted archive are open. .SS "ZIP CREATION COMMANDS" This package also provides several commands to aid the creation of ZIP archives as Tcl applications. +.\" METHOD: mkzip .TP -\fBzipfs mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? +\fBzipfs mkzip\fI outfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? . Creates a ZIP archive file named \fIoutfile\fR from the contents of the input directory \fIindir\fR (contained regular files only) with optional ZIP @@ -168,8 +177,9 @@ the whole source directory name or the name of its parent directory. \fBCaution:\fR the choice of the \fIindir\fR parameter (less the optional stripped prefix) determines the later root name of the archive's content. .RE +.\" METHOD: mkimg .TP -\fBzipfs mkimg\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\fR? +\fBzipfs mkimg\fI outfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\fR? . Creates an image (potentially a new executable file) similar to \fBzipfs mkzip\fR; see that command for a description of most parameters to this @@ -196,20 +206,23 @@ that script has been executed. \fBCaution:\fR highly experimental, not usable on Android, only partially tested on Linux and Windows. .RE +.\" METHOD: mkkey .TP -\fBzipfs mkkey\fR \fIpassword\fR +\fBzipfs mkkey\fI password\fR . Given the clear text \fIpassword\fR argument, an obfuscated string version is returned with the same format used in the \fBzipfs mkimg\fR command. +.\" METHOD: lmkimg .TP -\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR? +\fBzipfs lmkimg\fI outfile inlist\fR ?\fIpassword infile\fR? . This command is like \fBzipfs mkimg\fR, but instead of an input directory, \fIinlist\fR must be a Tcl list where the odd elements are the names of files to be copied into the archive in the image, and the even elements are their respective names within that archive. +.\" METHOD: lmkzip .TP -\fBzipfs lmkzip\fR \fIoutfile inlist\fR ?\fIpassword\fR? +\fBzipfs lmkzip\fI outfile inlist\fR ?\fIpassword\fR? . This command is like \fBzipfs mkzip\fR, but instead of an input directory, \fIinlist\fR must be a Tcl list where the odd elements are the names of files diff --git a/doc/zlib.n b/doc/zlib.n index 3714fc1..8bf6f2b 100644 --- a/doc/zlib.n +++ b/doc/zlib.n @@ -21,24 +21,28 @@ The \fBzlib\fR command provides access to the compression and check-summing facilities of the Zlib library by Jean-loup Gailly and Mark Adler. It has the following subcommands. .SS "COMPRESSION SUBCOMMANDS" +.\" METHOD: compress .TP \fBzlib compress\fI string\fR ?\fIlevel\fR? . Returns the zlib-format compressed binary data of the binary string in \fIstring\fR. If present, \fIlevel\fR gives the compression level to use (from 0, which is uncompressed, to 9, maximally compressed). +.\" METHOD: decompress .TP \fBzlib decompress\fI string\fR ?\fIbufferSize\fR? . Returns the uncompressed version of the raw compressed binary data in \fIstring\fR. If present, \fIbufferSize\fR is a hint as to what size of buffer is to be used to receive the data. +.\" METHOD: deflate .TP \fBzlib deflate\fI string\fR ?\fIlevel\fR? . Returns the raw compressed binary data of the binary string in \fIstring\fR. If present, \fIlevel\fR gives the compression level to use (from 0, which is uncompressed, to 9, maximally compressed). +.\" METHOD: gunzip .TP \fBzlib gunzip\fI string\fR ?\fB\-headerVar \fIvarName\fR? . @@ -80,6 +84,7 @@ named by the \fBfilename\fR field was modified. Suitable for use with . The type of the uncompressed data (\fBbinary\fR or \fBtext\fR) if known. .RE +.\" METHOD: gzip .TP \fBzlib gzip\fI string\fR ?\fB\-level \fIlevel\fR? ?\fB\-header \fIdict\fR? . @@ -118,6 +123,7 @@ will be in the same as is returned by \fBclock seconds\fR or \fBfile mtime\fR. . The type of the data being compressed, being \fBbinary\fR or \fBtext\fR. .RE +.\" METHOD: inflate .TP \fBzlib inflate\fI string\fR ?\fIbufferSize\fR? . @@ -125,6 +131,7 @@ Returns the uncompressed version of the raw compressed binary data in \fIstring\fR. If present, \fIbufferSize\fR is a hint as to what size of buffer is to be used to receive the data. .SS "CHANNEL SUBCOMMAND" +.\" METHOD: push .TP \fBzlib push\fI mode channel\fR ?\fIoptions ...\fR? . @@ -250,6 +257,7 @@ maximum number of bytes ahead to read from the underlying data source. See above for more information. .RE .SS "STREAMING SUBCOMMAND" +.\" METHOD: stream .TP \fBzlib stream\fI mode\fR ?\fIoptions\fR? . @@ -311,11 +319,13 @@ is correct. .VE .RE .SS "CHECKSUMMING SUBCOMMANDS" +.\" METHOD: adler32 .TP \fBzlib adler32\fI string\fR ?\fIinitValue\fR? . Compute a checksum of binary string \fIstring\fR using the Adler-32 algorithm. If given, \fIinitValue\fR is used to initialize the checksum engine. +.\" METHOD: crc32 .TP \fBzlib crc32\fI string\fR ?\fIinitValue\fR? . @@ -330,6 +340,7 @@ the transformed data. .PP The full set of subcommands supported by a streaming instance command, \fIstream\fR, is as follows: +.\" METHOD: add .TP \fIstream \fBadd\fR ?\fIoption...\fR? \fIdata\fR . @@ -337,47 +348,56 @@ A short-cut for .QW "\fIstream \fBput \fR?\fIoption...\fR? \fIdata\fR" followed by .QW "\fIstream \fBget\fR" . +.\" METHOD: checksum .TP \fIstream \fBchecksum\fR . Returns the checksum of the uncompressed data seen so far by this stream. +.\" METHOD: close .TP \fIstream \fBclose\fR . Deletes this stream and frees up all resources associated with it. +.\" METHOD: eof .TP \fIstream \fBeof\fR . Returns a boolean indicating whether the end of the stream (as determined by the compressed data itself) has been reached. Not all formats support detection of the end of the stream. +.\" METHOD: finalize .TP \fIstream \fBfinalize\fR . A short-cut for .QW "\fIstream \fBput \-finalize {}\fR" . +.\" METHOD: flush .TP \fIstream \fBflush\fR . A short-cut for .QW "\fIstream \fBput \-flush {}\fR" . +.\" METHOD: fullflush .TP \fIstream \fBfullflush\fR . A short-cut for .QW "\fIstream \fBput \-fullflush {}\fR" . +.\" METHOD: get .TP \fIstream \fBget \fR?\fIcount\fR? . Return up to \fIcount\fR bytes from \fIstream\fR's internal buffers with the transformation applied. If \fIcount\fR is omitted, the entire contents of the buffers are returned. -. +.\" METHOD: header +.TP \fIstream \fBheader\fR . Return the gzip header description dictionary extracted from the stream. Only supported for streams created with their \fImode\fR parameter set to \fBgunzip\fR. +.\" METHOD: put .TP \fIstream \fBput\fR ?\fIoption...\fR? \fIdata\fR . @@ -429,6 +449,7 @@ This option is mutually exclusive with the \fB\-finalize\fR and \fB\-flush\fR options. .RE .RE +.\" METHOD: reset .TP \fIstream \fBreset\fR . -- cgit v0.12 From 13036b6c78df40187cf45f66c6c934248f065aad Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 21 Jan 2024 23:03:52 +0000 Subject: More small bits of doc polishing --- doc/Access.3 | 1 + doc/AddErrInfo.3 | 7 ++-- doc/Alloc.3 | 3 +- doc/AllowExc.3 | 1 + doc/AppInit.3 | 1 + doc/AssocData.3 | 1 + doc/Async.3 | 3 +- doc/BackgdErr.3 | 1 + doc/BoolObj.3 | 1 + doc/ByteArrObj.3 | 2 +- doc/CallDel.3 | 1 + doc/Cancel.3 | 1 + doc/ChnlStack.3 | 3 +- doc/Class.3 | 1 + doc/CmdCmplt.3 | 1 + doc/Concat.3 | 1 + doc/CrtAlias.3 | 1 + doc/CrtChannel.3 | 5 +-- doc/CrtChnlHdlr.3 | 5 +-- doc/CrtCloseHdlr.3 | 4 +-- doc/CrtCommand.3 | 1 + doc/CrtFileHdlr.3 | 1 + doc/CrtInterp.3 | 1 + doc/CrtObjCmd.3 | 3 +- doc/CrtTimerHdlr.3 | 1 + doc/CrtTrace.3 | 1 + doc/DString.3 | 1 + doc/DetachPids.3 | 1 + doc/DictObj.3 | 3 +- doc/DoOneEvent.3 | 1 + doc/DoWhenIdle.3 | 1 + doc/DoubleObj.3 | 1 + doc/DumpActiveMemory.3 | 4 +-- doc/Encoding.3 | 3 +- doc/Ensemble.3 | 1 + doc/Environment.3 | 1 + doc/Eval.3 | 3 +- doc/Exit.3 | 1 + doc/ExprLong.3 | 1 + doc/ExprLongObj.3 | 1 + doc/FileSystem.3 | 2 +- doc/FindExec.3 | 1 + doc/GetCwd.3 | 1 + doc/GetHostName.3 | 1 + doc/GetIndex.3 | 1 + doc/GetInt.3 | 1 + doc/GetOpnFl.3 | 2 +- doc/GetStdChan.3 | 2 +- doc/GetTime.3 | 1 + doc/GetVersion.3 | 1 + doc/Hash.3 | 1 + doc/Init.3 | 1 + doc/InitStubs.3 | 1 + doc/InitSubSyst.3 | 4 ++- doc/IntObj.3 | 1 + doc/Limit.3 | 9 +----- doc/LinkVar.3 | 1 + doc/ListObj.3 | 1 + doc/Load.3 | 1 + doc/Method.3 | 1 + doc/NRE.3 | 1 - doc/Namespace.3 | 1 + doc/Notifier.3 | 13 +------- doc/Number.3 | 1 + doc/Object.3 | 3 +- doc/ObjectType.3 | 1 + doc/OpenFileChnl.3 | 3 +- doc/OpenTcp.3 | 2 +- doc/Panic.3 | 4 +-- doc/ParseArgs.3 | 1 + doc/ParseCmd.3 | 1 + doc/PkgRequire.3 | 1 + doc/Preserve.3 | 1 + doc/PrintDbl.3 | 1 + doc/RecEvalObj.3 | 1 + doc/RecordEval.3 | 1 + doc/RegConfig.3 | 3 +- doc/RegExp.3 | 2 -- doc/SaveInterpState.3 | 1 + doc/SetChanErr.3 | 6 +--- doc/SetErrno.3 | 3 +- doc/SetRecLmt.3 | 1 + doc/SetResult.3 | 3 +- doc/SetVar.3 | 1 + doc/Signal.3 | 2 +- doc/Sleep.3 | 1 + doc/SourceRCFile.3 | 2 +- doc/SplitList.3 | 1 + doc/SplitPath.3 | 1 + doc/StaticLibrary.3 | 1 + doc/StrMatch.3 | 1 + doc/StringObj.3 | 12 ++----- doc/SubstObj.3 | 1 + doc/Tcl.n | 1 - doc/Tcl_Main.3 | 1 + doc/Thread.3 | 9 ++---- doc/ToUpper.3 | 1 + doc/TraceCmd.3 | 8 ++--- doc/TraceVar.3 | 13 ++++---- doc/Translate.3 | 1 + doc/UniCharIsAlpha.3 | 1 + doc/UpVar.3 | 5 +-- doc/Utf.3 | 1 + doc/WrongNumArgs.3 | 1 + doc/after.n | 7 ++-- doc/chan.n | 4 ++- doc/clock.n | 11 ++----- doc/coroutine.n | 3 +- doc/dde.n | 11 ++----- doc/define.n | 1 - doc/error.n | 1 - doc/eval.n | 14 +++++++- doc/exit.n | 1 - doc/expr.n | 1 - doc/fblocked.n | 1 - doc/fcopy.n | 1 - doc/fileevent.n | 1 - doc/for.n | 1 - doc/foreach.n | 3 -- doc/format.n | 1 - doc/gets.n | 3 -- doc/http.n | 32 ++---------------- doc/idna.n | 1 + doc/if.n | 1 - doc/ledit.n | 4 ++- doc/library.n | 1 + doc/lpop.n | 8 +++-- doc/lseq.n | 29 +++++++++-------- doc/mathfunc.n | 41 ++--------------------- doc/mathop.n | 31 ++---------------- doc/msgcat.n | 21 ++---------- doc/open.n | 5 ++- doc/packagens.n | 2 -- doc/pid.n | 2 -- doc/platform.n | 2 +- doc/platform_shell.n | 2 +- doc/puts.n | 1 - doc/registry.n | 5 +-- doc/return.n | 4 +-- doc/safe.n | 88 ++++++++++++++++++++++++-------------------------- doc/socket.n | 4 +-- doc/tclsh.1 | 11 +++++++ doc/timerate.n | 17 +++++----- doc/upvar.n | 1 - doc/zipfs.3 | 2 +- doc/zipfs.n | 2 +- 146 files changed, 261 insertions(+), 350 deletions(-) diff --git a/doc/Access.3 b/doc/Access.3 index 5a29ec2..5a32e08 100644 --- a/doc/Access.3 +++ b/doc/Access.3 @@ -18,6 +18,7 @@ int .sp int \fBTcl_Stat\fR(\fIpath\fR, \fIstatPtr\fR) +.fi .SH ARGUMENTS .AS "struct stat" *statPtr out .AP "const char" *path in diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3 index d3289aa..21b75cb 100644 --- a/doc/AddErrInfo.3 +++ b/doc/AddErrInfo.3 @@ -13,7 +13,7 @@ Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErr .SH SYNOPSIS .nf \fB#include \fR -.sp + Tcl_Obj * \fBTcl_GetReturnOptions\fR(\fIinterp, code\fR) .sp @@ -28,8 +28,9 @@ int .sp \fBTcl_SetObjErrorCode\fR(\fIinterp, errorObjPtr\fR) .sp -\fBTcl_SetErrorCode\fR(\fIinterp, element, element, ... \fB(char *)NULL\fR) +\fBTcl_SetErrorCode\fR(\fIinterp, element, element, ... \fBNULL\fR) .sp +int \fBTcl_GetErrorLine\fR(\fIinterp\fR) .sp \fBTcl_SetErrorLine\fR(\fIinterp, lineNum\fR) @@ -37,8 +38,8 @@ int const char * \fBTcl_PosixError\fR(\fIinterp\fR) .sp -void \fBTcl_LogCommandInfo\fR(\fIinterp, script, command, commandLength\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp commandLength .AP Tcl_Interp *interp in diff --git a/doc/Alloc.3 b/doc/Alloc.3 index d1db8d4..bed6d83 100644 --- a/doc/Alloc.3 +++ b/doc/Alloc.3 @@ -16,7 +16,6 @@ Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, Tcl_GetM char * \fBTcl_Alloc\fR(\fIsize\fR) .sp -void \fBTcl_Free\fR(\fIptr\fR) .sp void * @@ -28,8 +27,8 @@ void * void * \fBTcl_AttemptRealloc\fR(\fIptr, size\fR) .sp -void \fBTcl_GetMemoryInfo\fR(\fIdsPtr\fR) +.fi .SH ARGUMENTS .AS char *size .AP "size_t" size in diff --git a/doc/AllowExc.3 b/doc/AllowExc.3 index 29e31be..a5e9aa2 100644 --- a/doc/AllowExc.3 +++ b/doc/AllowExc.3 @@ -15,6 +15,7 @@ Tcl_AllowExceptions \- allow all exceptions in next script evaluation \fB#include \fR .sp \fBTcl_AllowExceptions\fR(\fIinterp\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *interp .AP Tcl_Interp *interp in diff --git a/doc/AppInit.3 b/doc/AppInit.3 index 44b2d6b..e61d188 100644 --- a/doc/AppInit.3 +++ b/doc/AppInit.3 @@ -16,6 +16,7 @@ Tcl_AppInit \- perform application-specific initialization .sp int \fBTcl_AppInit\fR(\fIinterp\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *interp .AP Tcl_Interp *interp in diff --git a/doc/AssocData.3 b/doc/AssocData.3 index e95c26b..c1ca24c 100644 --- a/doc/AssocData.3 +++ b/doc/AssocData.3 @@ -19,6 +19,7 @@ void * \fBTcl_SetAssocData\fR(\fIinterp, key, delProc, clientData\fR) .sp \fBTcl_DeleteAssocData\fR(\fIinterp, key\fR) +.fi .SH ARGUMENTS .AS Tcl_InterpDeleteProc **delProcPtr .AP Tcl_Interp *interp in diff --git a/doc/Async.3 b/doc/Async.3 index a8d7da0..45ae587 100644 --- a/doc/Async.3 +++ b/doc/Async.3 @@ -17,7 +17,6 @@ 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 @@ -26,11 +25,11 @@ int int \fBTcl_AsyncInvoke\fR(\fIinterp, code\fR) .sp -void \fBTcl_AsyncDelete\fR(\fIasync\fR) .sp int \fBTcl_AsyncReady\fR() +.fi .SH ARGUMENTS .AS Tcl_AsyncHandler clientData .AP Tcl_AsyncProc *proc in diff --git a/doc/BackgdErr.3 b/doc/BackgdErr.3 index adbe33c..4340e4d 100644 --- a/doc/BackgdErr.3 +++ b/doc/BackgdErr.3 @@ -17,6 +17,7 @@ Tcl_BackgroundException, Tcl_BackgroundError \- report Tcl exception that occurr \fBTcl_BackgroundException\fR(\fIinterp, code\fR) .sp \fBTcl_BackgroundError\fR(\fIinterp\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *interp .AP Tcl_Interp *interp in diff --git a/doc/BoolObj.3 b/doc/BoolObj.3 index 71580af..de2a66b 100644 --- a/doc/BoolObj.3 +++ b/doc/BoolObj.3 @@ -24,6 +24,7 @@ int .sp int \fBTcl_GetBoolFromObj\fR(\fIinterp, objPtr, flags. charPtr\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp intValue in/out .AP int intValue in diff --git a/doc/ByteArrObj.3 b/doc/ByteArrObj.3 index 3dd626a..174bbc0 100644 --- a/doc/ByteArrObj.3 +++ b/doc/ByteArrObj.3 @@ -16,7 +16,6 @@ Tcl_NewByteArrayObj, Tcl_SetByteArrayObj, Tcl_GetBytesFromObj, Tcl_GetByteArrayF Tcl_Obj * \fBTcl_NewByteArrayObj\fR(\fIbytes, numBytes\fR) .sp -void \fBTcl_SetByteArrayObj\fR(\fIobjPtr, bytes, numBytes\fR) .sp .VS TIP568 @@ -29,6 +28,7 @@ unsigned char * .sp unsigned char * \fBTcl_SetByteArrayLength\fR(\fIobjPtr, numBytes\fR) +.fi .SH ARGUMENTS .AS "const unsigned char" *numBytesPtr in/out .AP "const unsigned char" *bytes in diff --git a/doc/CallDel.3 b/doc/CallDel.3 index 00763b6..7d65154 100644 --- a/doc/CallDel.3 +++ b/doc/CallDel.3 @@ -17,6 +17,7 @@ Tcl_CallWhenDeleted, Tcl_DontCallWhenDeleted \- Arrange for callback when interp \fBTcl_CallWhenDeleted\fR(\fIinterp\fR, \fIproc\fR, \fIclientData\fR) .sp \fBTcl_DontCallWhenDeleted\fR(\fIinterp\fR, \fIproc\fR, \fIclientData\fR) +.fi .SH ARGUMENTS .AS Tcl_InterpDeleteProc clientData .AP Tcl_Interp *interp in diff --git a/doc/Cancel.3 b/doc/Cancel.3 index a8121cb..72dd939 100644 --- a/doc/Cancel.3 +++ b/doc/Cancel.3 @@ -17,6 +17,7 @@ int .sp int \fBTcl_Canceled\fR(\fIinterp, flags\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *interp .AP Tcl_Interp *interp in diff --git a/doc/ChnlStack.3 b/doc/ChnlStack.3 index 9233a88..ba7bc48 100644 --- a/doc/ChnlStack.3 +++ b/doc/ChnlStack.3 @@ -11,7 +11,6 @@ Tcl_StackChannel, Tcl_UnstackChannel, Tcl_GetStackedChannel, Tcl_GetTopChannel \- manipulate stacked I/O channels .SH SYNOPSIS .nf -.nf \fB#include \fR .sp Tcl_Channel @@ -25,7 +24,7 @@ Tcl_Channel .sp Tcl_Channel \fBTcl_GetTopChannel\fR(\fIchannel\fR) -.sp +.fi .SH ARGUMENTS .AS Tcl_ChannelType clientData .AP Tcl_Interp *interp in diff --git a/doc/Class.3 b/doc/Class.3 index 888347f..ed549c0 100644 --- a/doc/Class.3 +++ b/doc/Class.3 @@ -63,6 +63,7 @@ Tcl_Class Tcl_Obj * \fBTcl_GetObjectClassName\fR(\fIinterp\fR, \fIobject\fR) .VE "TIP 605" +.fi .SH ARGUMENTS .AS void *metadata in/out .AP Tcl_Interp *interp in/out diff --git a/doc/CmdCmplt.3 b/doc/CmdCmplt.3 index bb7532c..2c18efe 100644 --- a/doc/CmdCmplt.3 +++ b/doc/CmdCmplt.3 @@ -16,6 +16,7 @@ Tcl_CommandComplete \- Check for unmatched braces in a Tcl command .sp int \fBTcl_CommandComplete\fR(\fIcmd\fR) +.fi .SH ARGUMENTS .AS "const char" *cmd .AP "const char" *cmd in diff --git a/doc/Concat.3 b/doc/Concat.3 index af30cd1..5357dae 100644 --- a/doc/Concat.3 +++ b/doc/Concat.3 @@ -16,6 +16,7 @@ Tcl_Concat \- concatenate a collection of strings .sp const char * \fBTcl_Concat\fR(\fIargc, argv\fR) +.fi .SH ARGUMENTS .AS "const char *const" argv[] .AP Tcl_Size argc in diff --git a/doc/CrtAlias.3 b/doc/CrtAlias.3 index eec8ed6..fba6253 100644 --- a/doc/CrtAlias.3 +++ b/doc/CrtAlias.3 @@ -49,6 +49,7 @@ int .sp int \fBTcl_HideCommand\fR(\fIinterp, cmdName, hiddenCmdName\fR) +.fi .SH ARGUMENTS .AS "const char *const" **targetInterpPtr out .AP Tcl_Interp *interp in diff --git a/doc/CrtChannel.3 b/doc/CrtChannel.3 index 6a62c0f..cbeb9da 100644 --- a/doc/CrtChannel.3 +++ b/doc/CrtChannel.3 @@ -59,13 +59,10 @@ int int \fBTcl_IsChannelExisting\fR(\fIchannelName\fR) .sp -void \fBTcl_CutChannel\fR(\fIchannel\fR) .sp -void \fBTcl_SpliceChannel\fR(\fIchannel\fR) .sp -void \fBTcl_ClearChannelHandlers\fR(\fIchannel\fR) .sp int @@ -115,7 +112,7 @@ Tcl_DriverFlushProc * .sp Tcl_DriverHandlerProc * \fBTcl_ChannelHandlerProc\fR(\fItypePtr\fR) -.sp +.fi .SH ARGUMENTS .AS "const Tcl_ChannelType" *channelName .AP "const Tcl_ChannelType" *typePtr in diff --git a/doc/CrtChnlHdlr.3 b/doc/CrtChnlHdlr.3 index ee8b411..5b0e724 100644 --- a/doc/CrtChnlHdlr.3 +++ b/doc/CrtChnlHdlr.3 @@ -12,15 +12,12 @@ Tcl_CreateChannelHandler, Tcl_DeleteChannelHandler \- call a procedure when a channel becomes readable or writable .SH SYNOPSIS .nf -.nf \fB#include \fR .sp -void \fBTcl_CreateChannelHandler\fR(\fIchannel, mask, proc, clientData\fR) .sp -void \fBTcl_DeleteChannelHandler\fR(\fIchannel, proc, clientData\fR) -.sp +.fi .SH ARGUMENTS .AS Tcl_ChannelProc clientData .AP Tcl_Channel channel in diff --git a/doc/CrtCloseHdlr.3 b/doc/CrtCloseHdlr.3 index 1046ea3..cd59e8a 100644 --- a/doc/CrtCloseHdlr.3 +++ b/doc/CrtCloseHdlr.3 @@ -14,12 +14,10 @@ Tcl_CreateCloseHandler, Tcl_DeleteCloseHandler \- arrange for callbacks when cha .nf \fB#include \fR .sp -void \fBTcl_CreateCloseHandler\fR(\fIchannel, proc, clientData\fR) .sp -void \fBTcl_DeleteCloseHandler\fR(\fIchannel, proc, clientData\fR) -.sp +.fi .SH ARGUMENTS .AS Tcl_CloseProc clientData .AP Tcl_Channel channel in diff --git a/doc/CrtCommand.3 b/doc/CrtCommand.3 index 50baa6f..f88e4f0 100644 --- a/doc/CrtCommand.3 +++ b/doc/CrtCommand.3 @@ -16,6 +16,7 @@ Tcl_CreateCommand \- implement new commands in C .sp Tcl_Command \fBTcl_CreateCommand\fR(\fIinterp, cmdName, proc, clientData, deleteProc\fR) +.fi .SH ARGUMENTS .AS Tcl_CmdDeleteProc *deleteProc .AP Tcl_Interp *interp in diff --git a/doc/CrtFileHdlr.3 b/doc/CrtFileHdlr.3 index 0dfb429..65a6794 100644 --- a/doc/CrtFileHdlr.3 +++ b/doc/CrtFileHdlr.3 @@ -17,6 +17,7 @@ Tcl_CreateFileHandler, Tcl_DeleteFileHandler \- associate procedure callbacks wi \fBTcl_CreateFileHandler\fR(\fIfd, mask, proc, clientData\fR) .sp \fBTcl_DeleteFileHandler\fR(\fIfd\fR) +.fi .SH ARGUMENTS .AS Tcl_FileProc clientData .AP int fd in diff --git a/doc/CrtInterp.3 b/doc/CrtInterp.3 index aacb868..159fb12 100644 --- a/doc/CrtInterp.3 +++ b/doc/CrtInterp.3 @@ -24,6 +24,7 @@ int .sp int \fBTcl_InterpActive\fR(\fIinterp\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *interp .AP Tcl_Interp *interp in diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3 index 4bdde44..57eaf8e 100644 --- a/doc/CrtObjCmd.3 +++ b/doc/CrtObjCmd.3 @@ -40,12 +40,11 @@ int const char * \fBTcl_GetCommandName\fR(\fIinterp, token\fR) .sp -void \fBTcl_GetCommandFullName\fR(\fIinterp, token, objPtr\fR) .sp Tcl_Command \fBTcl_GetCommandFromObj\fR(\fIinterp, objPtr\fR) -.sp +.fi .SH ARGUMENTS .AS Tcl_CmdDeleteProc *deleteProc in/out .AP Tcl_Interp *interp in diff --git a/doc/CrtTimerHdlr.3 b/doc/CrtTimerHdlr.3 index 1190417..eeeea77 100644 --- a/doc/CrtTimerHdlr.3 +++ b/doc/CrtTimerHdlr.3 @@ -18,6 +18,7 @@ Tcl_TimerToken \fBTcl_CreateTimerHandler\fR(\fImilliseconds, proc, clientData\fR) .sp \fBTcl_DeleteTimerHandler\fR(\fItoken\fR) +.fi .SH ARGUMENTS .AS Tcl_TimerToken milliseconds .AP int milliseconds in diff --git a/doc/CrtTrace.3 b/doc/CrtTrace.3 index 9f74cbf..8e4b92f 100644 --- a/doc/CrtTrace.3 +++ b/doc/CrtTrace.3 @@ -25,6 +25,7 @@ Tcl_Trace \fBTcl_CreateObjTrace2\fR(\fIinterp, level, flags, objProc2, clientData, deleteProc\fR) .sp \fBTcl_DeleteTrace\fR(\fIinterp, trace\fR) +.fi .SH ARGUMENTS .AS Tcl_CmdObjTraceDeleteProc *deleteProc .AP Tcl_Interp *interp in diff --git a/doc/DString.3 b/doc/DString.3 index 3d6f746..7265898 100644 --- a/doc/DString.3 +++ b/doc/DString.3 @@ -42,6 +42,7 @@ char * .sp Tcl_Obj * \fBTcl_DStringToObj\fR(\fIdsPtr\fR) +.fi .sp .SH ARGUMENTS .AS Tcl_DString newLength in/out diff --git a/doc/DetachPids.3 b/doc/DetachPids.3 index bff345a..4d87529 100644 --- a/doc/DetachPids.3 +++ b/doc/DetachPids.3 @@ -20,6 +20,7 @@ Tcl_DetachPids, Tcl_ReapDetachedProcs, Tcl_WaitPid \- manage child processes in .sp Tcl_Pid \fBTcl_WaitPid\fR(\fIpid, statusPtr, options\fR) +.fi .SH ARGUMENTS .AS Tcl_Pid *statusPtr out .AP Tcl_Size numPids in diff --git a/doc/DictObj.3 b/doc/DictObj.3 index 4a25d84..ec36d6a 100644 --- a/doc/DictObj.3 +++ b/doc/DictObj.3 @@ -33,10 +33,8 @@ int \fBTcl_DictObjFirst\fR(\fIinterp, dictPtr, searchPtr, keyPtrPtr, valuePtrPtr, donePtr\fR) .sp -void \fBTcl_DictObjNext\fR(\fIsearchPtr, keyPtrPtr, valuePtrPtr, donePtr\fR) .sp -void \fBTcl_DictObjDone\fR(\fIsearchPtr\fR) .sp int @@ -44,6 +42,7 @@ int .sp int \fBTcl_DictObjRemoveKeyList\fR(\fIinterp, dictPtr, keyc, keyv\fR) +.fi .SH ARGUMENTS .AS Tcl_DictSearch "**valuePtrPtr" in/out .AP Tcl_Interp *interp in diff --git a/doc/DoOneEvent.3 b/doc/DoOneEvent.3 index d48afd0..e515328 100644 --- a/doc/DoOneEvent.3 +++ b/doc/DoOneEvent.3 @@ -16,6 +16,7 @@ Tcl_DoOneEvent \- wait for events and invoke event handlers .sp int \fBTcl_DoOneEvent\fR(\fIflags\fR) +.fi .SH ARGUMENTS .AS int flags .AP int flags in diff --git a/doc/DoWhenIdle.3 b/doc/DoWhenIdle.3 index 1a252cc..aed3a4a 100644 --- a/doc/DoWhenIdle.3 +++ b/doc/DoWhenIdle.3 @@ -17,6 +17,7 @@ Tcl_DoWhenIdle, Tcl_CancelIdleCall \- invoke a procedure when there are no pendi \fBTcl_DoWhenIdle\fR(\fIproc, clientData\fR) .sp \fBTcl_CancelIdleCall\fR(\fIproc, clientData\fR) +.fi .SH ARGUMENTS .AS Tcl_IdleProc clientData .AP Tcl_IdleProc *proc in diff --git a/doc/DoubleObj.3 b/doc/DoubleObj.3 index c70f5d1..c4db52c 100644 --- a/doc/DoubleObj.3 +++ b/doc/DoubleObj.3 @@ -20,6 +20,7 @@ Tcl_Obj * .sp int \fBTcl_GetDoubleFromObj\fR(\fIinterp, objPtr, doublePtr\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp doubleValue in/out .AP double doubleValue in diff --git a/doc/DumpActiveMemory.3 b/doc/DumpActiveMemory.3 index 0e162bb..7c8dd7e 100644 --- a/doc/DumpActiveMemory.3 +++ b/doc/DumpActiveMemory.3 @@ -15,12 +15,10 @@ Tcl_DumpActiveMemory, Tcl_InitMemory, Tcl_ValidateAllMemory \- Validated memory int \fBTcl_DumpActiveMemory\fR(\fIfileName\fR) .sp -void \fBTcl_InitMemory\fR(\fIinterp\fR) .sp -void \fBTcl_ValidateAllMemory\fR(\fIfileName, line\fR) - +.fi .SH ARGUMENTS .AS Tcl_Interp *fileName .AP Tcl_Interp *interp in diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 68903b2..2759ec7 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -16,7 +16,6 @@ Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDStr Tcl_Encoding \fBTcl_GetEncoding\fR(\fIinterp, name\fR) .sp -void \fBTcl_FreeEncoding\fR(\fIencoding\fR) .sp int @@ -54,7 +53,6 @@ int const char * \fBTcl_GetEncodingNameFromEnvironment\fR(\fIbufPtr\fR) .sp -void \fBTcl_GetEncodingNames\fR(\fIinterp\fR) .sp Tcl_Encoding @@ -65,6 +63,7 @@ Tcl_Obj * .sp int \fBTcl_SetEncodingSearchPath\fR(\fIsearchPath\fR) +.fi .SH ARGUMENTS .AS "const Tcl_EncodingType" *dstWrotePtr in/out .AP Tcl_Interp *interp in diff --git a/doc/Ensemble.3 b/doc/Ensemble.3 index 71a53ac..0dfaa01 100644 --- a/doc/Ensemble.3 +++ b/doc/Ensemble.3 @@ -56,6 +56,7 @@ int .sp int \fBTcl_GetEnsembleNamespace\fR(\fIinterp, token, namespacePtrPtr\fR) +.fi .SH ARGUMENTS .AS Tcl_Namespace **namespacePtrPtr in/out .AP Tcl_Interp *interp in/out diff --git a/doc/Environment.3 b/doc/Environment.3 index 7a5e396..da1d4f4 100644 --- a/doc/Environment.3 +++ b/doc/Environment.3 @@ -15,6 +15,7 @@ Tcl_PutEnv \- procedures to manipulate the environment .sp int \fBTcl_PutEnv\fR(\fIassignment\fR) +.fi .SH ARGUMENTS .AS "const char" *assignment .AP "const char" *assignment in diff --git a/doc/Eval.3 b/doc/Eval.3 index f9e58d1..fb0a420 100644 --- a/doc/Eval.3 +++ b/doc/Eval.3 @@ -37,7 +37,8 @@ int \fBTcl_GlobalEvalObj\fR(\fIinterp, objPtr\fR) .sp int -\fBTcl_VarEval\fR(\fIinterp, part, part, ... \fB(char *)NULL\fR) +\fBTcl_VarEval\fR(\fIinterp, part, part, ... \fBNULL\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp **termPtr .AP Tcl_Interp *interp in diff --git a/doc/Exit.3 b/doc/Exit.3 index 874ea90..a1d0694 100644 --- a/doc/Exit.3 +++ b/doc/Exit.3 @@ -31,6 +31,7 @@ Tcl_Exit, Tcl_Finalize, Tcl_CreateExitHandler, Tcl_DeleteExitHandler, Tcl_ExitTh .sp Tcl_ExitProc * \fBTcl_SetExitProc\fR(\fIproc\fR) +.fi .SH ARGUMENTS .AS Tcl_ExitProc clientData .AP int status in diff --git a/doc/ExprLong.3 b/doc/ExprLong.3 index 0d369ce..8d5e06d 100644 --- a/doc/ExprLong.3 +++ b/doc/ExprLong.3 @@ -25,6 +25,7 @@ int .sp int \fBTcl_ExprString\fR(\fIinterp, expr\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *booleanPtr out .AP Tcl_Interp *interp in diff --git a/doc/ExprLongObj.3 b/doc/ExprLongObj.3 index 59413e1..09f83dd 100644 --- a/doc/ExprLongObj.3 +++ b/doc/ExprLongObj.3 @@ -24,6 +24,7 @@ int .sp int \fBTcl_ExprObj\fR(\fIinterp, objPtr, resultPtrPtr\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp **resultPtrPtr out .AP Tcl_Interp *interp in diff --git a/doc/FileSystem.3 b/doc/FileSystem.3 index 2076c96..255606c 100644 --- a/doc/FileSystem.3 +++ b/doc/FileSystem.3 @@ -23,7 +23,6 @@ int void * \fBTcl_FSData\fR(\fIfsPtr\fR) .sp -void \fBTcl_FSMountsChanged\fR(\fIfsPtr\fR) .sp const Tcl_Filesystem * @@ -182,6 +181,7 @@ unsigned long long .sp int \fBTcl_GetUserIdFromStat\fR(\fIstatPtr\fR) +.fi .SH ARGUMENTS .AS Tcl_GlobTypeData **srcPathPtr out .AP "const Tcl_Filesystem" *fsPtr in diff --git a/doc/FindExec.3 b/doc/FindExec.3 index eed296c..756d8cb 100644 --- a/doc/FindExec.3 +++ b/doc/FindExec.3 @@ -18,6 +18,7 @@ const char * .sp const char * \fBTcl_GetNameOfExecutable\fR() +.fi .SH ARGUMENTS .AS char *argv0 .AP char *argv0 in diff --git a/doc/GetCwd.3 b/doc/GetCwd.3 index b19f587..26bc691 100644 --- a/doc/GetCwd.3 +++ b/doc/GetCwd.3 @@ -18,6 +18,7 @@ char * .sp int \fBTcl_Chdir\fR(\fIdirName\fR) +.fi .SH ARGUMENTS .AS Tcl_DString *bufferPtr in/out .AP Tcl_Interp *interp in diff --git a/doc/GetHostName.3 b/doc/GetHostName.3 index 8e43f8e..cdef270 100644 --- a/doc/GetHostName.3 +++ b/doc/GetHostName.3 @@ -13,6 +13,7 @@ Tcl_GetHostName \- get the name of the local host .sp const char * \fBTcl_GetHostName\fR() +.fi .BE .SH DESCRIPTION diff --git a/doc/GetIndex.3 b/doc/GetIndex.3 index 176b0b2..4dcee45 100644 --- a/doc/GetIndex.3 +++ b/doc/GetIndex.3 @@ -20,6 +20,7 @@ indexPtr\fR) int \fBTcl_GetIndexFromObjStruct\fR(\fIinterp, objPtr, structTablePtr, offset, msg, flags, indexPtr\fR) +.fi .SH ARGUMENTS .AS "const char" *structTablePtr in/out .AP Tcl_Interp *interp in diff --git a/doc/GetInt.3 b/doc/GetInt.3 index 1e8cd61..a0c1d1b 100644 --- a/doc/GetInt.3 +++ b/doc/GetInt.3 @@ -25,6 +25,7 @@ int .sp int \fBTcl_GetBool\fR(\fIinterp, src, flags, charPtr\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *doublePtr out .AP Tcl_Interp *interp in diff --git a/doc/GetOpnFl.3 b/doc/GetOpnFl.3 index 5ac5391..f3a3143 100644 --- a/doc/GetOpnFl.3 +++ b/doc/GetOpnFl.3 @@ -15,7 +15,7 @@ Tcl_GetOpenFile \- Return a FILE* for a channel registered in the given interpre .sp int \fBTcl_GetOpenFile\fR(\fIinterp, chanID, write, checkUsage, filePtr\fR) -.sp +.fi .SH ARGUMENTS .AS Tcl_Interp checkUsage out .AP Tcl_Interp *interp in diff --git a/doc/GetStdChan.3 b/doc/GetStdChan.3 index 3472fee..91217e4 100644 --- a/doc/GetStdChan.3 +++ b/doc/GetStdChan.3 @@ -18,7 +18,7 @@ Tcl_Channel \fBTcl_GetStdChannel\fR(\fItype\fR) .sp \fBTcl_SetStdChannel\fR(\fIchannel, type\fR) -.sp +.fi .SH ARGUMENTS .AS Tcl_Channel channel .AP int type in diff --git a/doc/GetTime.3 b/doc/GetTime.3 index c2e6116..9f898e4 100644 --- a/doc/GetTime.3 +++ b/doc/GetTime.3 @@ -18,6 +18,7 @@ Tcl_GetTime, Tcl_SetTimeProc, Tcl_QueryTimeProc \- get date and time \fBTcl_SetTimeProc\fR(\fIgetProc, scaleProc, clientData\fR) .sp \fBTcl_QueryTimeProc\fR(\fIgetProcPtr, scaleProcPtr, clientDataPtr\fR) +.fi .SH ARGUMENTS .AS Tcl_GetTimeProc *getProc in .AP Tcl_Time *timePtr out diff --git a/doc/GetVersion.3 b/doc/GetVersion.3 index b973044..5a85a2a 100644 --- a/doc/GetVersion.3 +++ b/doc/GetVersion.3 @@ -14,6 +14,7 @@ Tcl_GetVersion \- get the version of the library at runtime \fB#include \fR .sp \fBTcl_GetVersion\fR(\fImajor, minor, patchLevel, type\fR) +.fi .SH ARGUMENTS .AP int *major out Major version number of the Tcl library. diff --git a/doc/Hash.3 b/doc/Hash.3 index 6481f64..dced52f 100644 --- a/doc/Hash.3 +++ b/doc/Hash.3 @@ -46,6 +46,7 @@ Tcl_HashEntry * .sp char * \fBTcl_HashStats\fR(\fItablePtr\fR) +.fi .SH ARGUMENTS .AS "const Tcl_HashKeyType" *searchPtr out .AP Tcl_HashTable *tablePtr in diff --git a/doc/Init.3 b/doc/Init.3 index e109c82..575a39d 100644 --- a/doc/Init.3 +++ b/doc/Init.3 @@ -16,6 +16,7 @@ int .sp const char * \fBTcl_SetPreInitScript\fR(\fIscriptPtr\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *interp .AP Tcl_Interp *interp in diff --git a/doc/InitStubs.3 b/doc/InitStubs.3 index 6f0a570..80a21de 100644 --- a/doc/InitStubs.3 +++ b/doc/InitStubs.3 @@ -15,6 +15,7 @@ Tcl_InitStubs \- initialize the Tcl stubs mechanism .sp const char * \fBTcl_InitStubs\fR(\fIinterp, version, exact\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *interp .AP Tcl_Interp *interp in diff --git a/doc/InitSubSyst.3 b/doc/InitSubSyst.3 index b7962c6..4647567 100644 --- a/doc/InitSubSyst.3 +++ b/doc/InitSubSyst.3 @@ -14,7 +14,9 @@ Tcl_InitSubsystems \- initialize the Tcl library. \fB#include \fR .sp const char * -\fBTcl_InitSubsystems\fR(\fIvoid\fR) +\fBTcl_InitSubsystems\fR() +.fi +.BE .SH DESCRIPTION .PP The \fBTcl_InitSubsystems\fR procedure initializes the Tcl diff --git a/doc/IntObj.3 b/doc/IntObj.3 index f3683c2..4cd13e6 100644 --- a/doc/IntObj.3 +++ b/doc/IntObj.3 @@ -62,6 +62,7 @@ int .sp int \fBTcl_InitBignumFromDouble\fR(\fIinterp, doubleValue, bigValue\fR) +.fi .SH ARGUMENTS .AS Tcl_WideInt doubleValue in/out .AP Tcl_Size endValue in diff --git a/doc/Limit.3 b/doc/Limit.3 index 60817e9..5eb3ac8 100644 --- a/doc/Limit.3 +++ b/doc/Limit.3 @@ -28,35 +28,28 @@ int int \fBTcl_LimitTypeEnabled\fR(\fIinterp, type\fR) .sp -void \fBTcl_LimitTypeSet\fR(\fIinterp, type\fR) .sp -void \fBTcl_LimitTypeReset\fR(\fIinterp, type\fR) .sp int \fBTcl_LimitGetCommands\fR(\fIinterp\fR) .sp -void \fBTcl_LimitSetCommands\fR(\fIinterp, commandLimit\fR) .sp -void \fBTcl_LimitGetTime\fR(\fIinterp, timeLimitPtr\fR) .sp -void \fBTcl_LimitSetTime\fR(\fIinterp, timeLimitPtr\fR) .sp int \fBTcl_LimitGetGranularity\fR(\fIinterp, type\fR) .sp -void \fBTcl_LimitSetGranularity\fR(\fIinterp, type, granularity\fR) .sp -void \fBTcl_LimitAddHandler\fR(\fIinterp, type, handlerProc, clientData, deleteProc\fR) .sp -void \fBTcl_LimitRemoveHandler\fR(\fIinterp, type, handlerProc, clientData\fR) +.fi .SH ARGUMENTS .AS Tcl_LimitHandlerDeleteProc commandLimit in/out .AP Tcl_Interp *interp in diff --git a/doc/LinkVar.3 b/doc/LinkVar.3 index 42211c5..ffedb9d 100644 --- a/doc/LinkVar.3 +++ b/doc/LinkVar.3 @@ -25,6 +25,7 @@ int \fBTcl_UnlinkVar\fR(\fIinterp, varName\fR) .sp \fBTcl_UpdateLinkedVar\fR(\fIinterp, varName\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp varName in .AP Tcl_Interp *interp in diff --git a/doc/ListObj.3 b/doc/ListObj.3 index 74cbe9a..deae5a5 100644 --- a/doc/ListObj.3 +++ b/doc/ListObj.3 @@ -35,6 +35,7 @@ int .sp int \fBTcl_ListObjReplace\fR(\fIinterp, listPtr, first, count, objc, objv\fR) +.fi .SH ARGUMENTS .AS "Tcl_Obj *const" *elemListPtr in/out .AP Tcl_Interp *interp in diff --git a/doc/Load.3 b/doc/Load.3 index 4533510..01af42b 100644 --- a/doc/Load.3 +++ b/doc/Load.3 @@ -19,6 +19,7 @@ int .sp void * \fBTcl_FindSymbol\fR(\fIinterp, loadHandle, symbol\fR) +.fi .SH ARGUMENTS .AS Tcl_LoadHandle loadHandle in .AP Tcl_Interp *interp in diff --git a/doc/Method.3 b/doc/Method.3 index 377fc5a..ed2211b 100644 --- a/doc/Method.3 +++ b/doc/Method.3 @@ -60,6 +60,7 @@ Tcl_Object .sp Tcl_Size \fBTcl_ObjectContextSkippedArgs\fR(\fIcontext\fR) +.fi .SH ARGUMENTS .AS void *clientData in .AP Tcl_Interp *interp in/out diff --git a/doc/NRE.3 b/doc/NRE.3 index 62184f9..bf757c3 100644 --- a/doc/NRE.3 +++ b/doc/NRE.3 @@ -40,7 +40,6 @@ int int \fBTcl_NRExprObj\fR(\fIinterp, objPtr, resultPtr\fR) .sp -void \fBTcl_NRAddCallback\fR(\fIinterp, postProcPtr, data0, data1, data2, data3\fR) .fi .SH ARGUMENTS diff --git a/doc/Namespace.3 b/doc/Namespace.3 index d5f7764..399bd7d 100644 --- a/doc/Namespace.3 +++ b/doc/Namespace.3 @@ -50,6 +50,7 @@ Tcl_Obj * .sp int \fBTcl_SetNamespaceUnknownHandler\fR(\fIinterp, nsPtr, handlerPtr\fR) +.fi .SH ARGUMENTS .AS Tcl_NamespaceDeleteProc allowOverwrite in/out .AP Tcl_Interp *interp in/out diff --git a/doc/Notifier.3 b/doc/Notifier.3 index 483fb2c..8041dd8 100644 --- a/doc/Notifier.3 +++ b/doc/Notifier.3 @@ -14,43 +14,33 @@ Tcl_CreateEventSource, Tcl_DeleteEventSource, Tcl_SetMaxBlockTime, Tcl_QueueEven .nf \fB#include \fR .sp -void \fBTcl_CreateEventSource\fR(\fIsetupProc, checkProc, clientData\fR) .sp -void \fBTcl_DeleteEventSource\fR(\fIsetupProc, checkProc, clientData\fR) .sp -void \fBTcl_SetMaxBlockTime\fR(\fItimePtr\fR) .sp -void \fBTcl_QueueEvent\fR(\fIevPtr, position\fR) .sp -void \fBTcl_ThreadQueueEvent\fR(\fIthreadId, evPtr, position\fR) .sp -void \fBTcl_ThreadAlert\fR(\fIthreadId\fR) .sp Tcl_ThreadId \fBTcl_GetCurrentThread\fR() .sp -void \fBTcl_DeleteEvents\fR(\fIdeleteProc, clientData\fR) .sp void * \fBTcl_InitNotifier\fR() .sp -void \fBTcl_FinalizeNotifier\fR(\fIclientData\fR) .sp int \fBTcl_WaitForEvent\fR(\fItimePtr\fR) .sp -void \fBTcl_AlertNotifier\fR(\fIclientData\fR) .sp -void \fBTcl_SetTimer\fR(\fItimePtr\fR) .sp int @@ -65,11 +55,10 @@ int int \fBTcl_SetServiceMode\fR(\fImode\fR) .sp -void \fBTcl_ServiceModeHook\fR(\fImode\fR) .sp -void \fBTcl_SetNotifier\fR(\fInotifierProcPtr\fR) +.fi .SH ARGUMENTS .AS Tcl_EventDeleteProc *notifierProcPtr .AP Tcl_EventSetupProc *setupProc in diff --git a/doc/Number.3 b/doc/Number.3 index 1bf018a..99efab7 100644 --- a/doc/Number.3 +++ b/doc/Number.3 @@ -20,6 +20,7 @@ int .sp int \fBTcl_GetNumberFromObj\fR(\fIinterp, objPtr, clientDataPtr, typePtr\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp clientDataPtr out .AP Tcl_Interp *interp out diff --git a/doc/Object.3 b/doc/Object.3 index 7c90f79..d14124f 100644 --- a/doc/Object.3 +++ b/doc/Object.3 @@ -28,7 +28,8 @@ Tcl_Obj * int \fBTcl_IsShared\fR(\fIobjPtr\fR) .sp -\fBTcl_InvalidateStringRep\fR(\fIobjPtr\fR) +\fBTcl_InvalidateStringRep\fR(\fIobjPtr\fR)3 +.fi .SH ARGUMENTS .AS Tcl_Obj *objPtr .AP Tcl_Obj *objPtr in diff --git a/doc/ObjectType.3 b/doc/ObjectType.3 index 3739c33..3b4782d 100644 --- a/doc/ObjectType.3 +++ b/doc/ObjectType.3 @@ -23,6 +23,7 @@ int .sp int \fBTcl_ConvertToType\fR(\fIinterp, objPtr, typePtr\fR) +.fi .SH ARGUMENTS .AS "const char" *typeName .AP "const Tcl_ObjType" *typePtr in diff --git a/doc/OpenFileChnl.3 b/doc/OpenFileChnl.3 index 3260198..db25ce2 100644 --- a/doc/OpenFileChnl.3 +++ b/doc/OpenFileChnl.3 @@ -32,7 +32,6 @@ int int \fBTcl_GetChannelNamesEx\fR(\fIinterp, pattern\fR) .sp -void \fBTcl_RegisterChannel\fR(\fIinterp, channel\fR) .sp int @@ -106,7 +105,7 @@ int .sp int \fBTcl_SetChannelOption\fR(\fIinterp, channel, optionName, newValue\fR) -.sp +.fi .SH ARGUMENTS .AS Tcl_DString *channelName in/out .AP Tcl_Interp *interp in diff --git a/doc/OpenTcp.3 b/doc/OpenTcp.3 index 602f081..3e62363 100644 --- a/doc/OpenTcp.3 +++ b/doc/OpenTcp.3 @@ -25,7 +25,7 @@ Tcl_Channel .sp Tcl_Channel \fBTcl_OpenTcpServerEx\fR(\fIinterp, service, myaddr, flags, backlog, proc, clientData\fR) -.sp +.fi .SH ARGUMENTS .AS Tcl_TcpAcceptProc clientData .AP Tcl_Interp *interp in diff --git a/doc/Panic.3 b/doc/Panic.3 index 2f5d19c..25e38c2 100644 --- a/doc/Panic.3 +++ b/doc/Panic.3 @@ -12,15 +12,13 @@ Tcl_Panic, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error and abort .nf \fB#include \fR .sp -void \fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR) .sp const char * \fBTcl_SetPanicProc\fR(\fIpanicProc\fR) .sp -void \fBTcl_ConsolePanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR) -.sp +.fi .SH ARGUMENTS .AS Tcl_PanicProc *panicProc .AP "const char*" format in diff --git a/doc/ParseArgs.3 b/doc/ParseArgs.3 index 4fdf0b0..7c7b08e 100644 --- a/doc/ParseArgs.3 +++ b/doc/ParseArgs.3 @@ -15,6 +15,7 @@ Tcl_ParseArgsObjv \- parse arguments according to a tabular description .sp int \fBTcl_ParseArgsObjv\fR(\fIinterp, argTable, objcPtr, objv, remObjv\fR) +.fi .SH ARGUMENTS .AS "const Tcl_ArgvInfo" ***remObjv in/out .AP Tcl_Interp *interp out diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index 0919299..0e2c3b4 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -35,6 +35,7 @@ const char * .sp int \fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *usedParsePtr out .AP Tcl_Interp *interp out diff --git a/doc/PkgRequire.3 b/doc/PkgRequire.3 index 3bfc684..c19065b 100644 --- a/doc/PkgRequire.3 +++ b/doc/PkgRequire.3 @@ -33,6 +33,7 @@ int .sp int \fBTcl_PkgProvideEx\fR(\fIinterp, name, version, clientData\fR) +.fi .SH ARGUMENTS .AS void *clientDataPtr out .AP Tcl_Interp *interp in diff --git a/doc/Preserve.3 b/doc/Preserve.3 index eb50a5f..e01cf80 100644 --- a/doc/Preserve.3 +++ b/doc/Preserve.3 @@ -19,6 +19,7 @@ Tcl_Preserve, Tcl_Release, Tcl_EventuallyFree \- avoid freeing storage while it \fBTcl_Release\fR(\fIclientData\fR) .sp \fBTcl_EventuallyFree\fR(\fIclientData, freeProc\fR) +.fi .SH ARGUMENTS .AS Tcl_FreeProc clientData .AP void *clientData in diff --git a/doc/PrintDbl.3 b/doc/PrintDbl.3 index 42b258c..79398ab 100644 --- a/doc/PrintDbl.3 +++ b/doc/PrintDbl.3 @@ -15,6 +15,7 @@ Tcl_PrintDouble \- Convert floating value to string \fB#include \fR .sp \fBTcl_PrintDouble\fR(\fIinterp, value, dst\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *interp out .AP Tcl_Interp *interp in diff --git a/doc/RecEvalObj.3 b/doc/RecEvalObj.3 index 0835904..7bfee95 100644 --- a/doc/RecEvalObj.3 +++ b/doc/RecEvalObj.3 @@ -15,6 +15,7 @@ Tcl_RecordAndEvalObj \- save command on history list before evaluating .sp int \fBTcl_RecordAndEvalObj\fR(\fIinterp, cmdPtr, flags\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *interp .AP Tcl_Interp *interp in diff --git a/doc/RecordEval.3 b/doc/RecordEval.3 index 36ef6b9..a5887f0 100644 --- a/doc/RecordEval.3 +++ b/doc/RecordEval.3 @@ -16,6 +16,7 @@ Tcl_RecordAndEval \- save command on history list before evaluating .sp int \fBTcl_RecordAndEval\fR(\fIinterp, cmd, flags\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *interp .AP Tcl_Interp *interp in diff --git a/doc/RegConfig.3 b/doc/RegConfig.3 index ef46ba5..09ae116 100644 --- a/doc/RegConfig.3 +++ b/doc/RegConfig.3 @@ -14,9 +14,8 @@ Tcl_RegisterConfig \- procedures to register embedded configuration information .nf \fB#include \fR .sp -void \fBTcl_RegisterConfig\fR(\fIinterp, pkgName, configuration, valEncoding\fR) -.sp +.fi .SH ARGUMENTS .AS Tcl_Interp *configuration .AP Tcl_Interp *interp in diff --git a/doc/RegExp.3 b/doc/RegExp.3 index f173b02..35b14a2 100644 --- a/doc/RegExp.3 +++ b/doc/RegExp.3 @@ -27,7 +27,6 @@ Tcl_RegExp int \fBTcl_RegExpExec\fR(\fIinterp\fR, \fIregexp\fR, \fItext\fR, \fIstart\fR) .sp -void \fBTcl_RegExpRange\fR(\fIregexp\fR, \fIindex\fR, \fIstartPtr\fR, \fIendPtr\fR) .sp Tcl_RegExp @@ -36,7 +35,6 @@ Tcl_RegExp int \fBTcl_RegExpExecObj\fR(\fIinterp\fR, \fIregexp\fR, \fItextObj\fR, \fIoffset\fR, \fInmatches\fR, \fIeflags\fR) .sp -void \fBTcl_RegExpGetInfo\fR(\fIregexp\fR, \fIinfoPtr\fR) .fi .SH ARGUMENTS diff --git a/doc/SaveInterpState.3 b/doc/SaveInterpState.3 index da70c4d..96fecdb 100644 --- a/doc/SaveInterpState.3 +++ b/doc/SaveInterpState.3 @@ -23,6 +23,7 @@ int \fBTcl_RestoreInterpState\fR(\fIinterp, state\fR) .sp \fBTcl_DiscardInterpState\fR(\fIstate\fR) +.fi .SH ARGUMENTS .AS Tcl_InterpState savedPtr .AP Tcl_Interp *interp in diff --git a/doc/SetChanErr.3 b/doc/SetChanErr.3 index 72157c6..e7593b7 100644 --- a/doc/SetChanErr.3 +++ b/doc/SetChanErr.3 @@ -14,18 +14,14 @@ Tcl_SetChannelError, Tcl_SetChannelErrorInterp, Tcl_GetChannelError, Tcl_GetChan .nf \fB#include \fR .sp -void \fBTcl_SetChannelError\fR(\fIchan, msg\fR) .sp -void \fBTcl_SetChannelErrorInterp\fR(\fIinterp, msg\fR) .sp -void \fBTcl_GetChannelError\fR(\fIchan, msgPtr\fR) .sp -void \fBTcl_GetChannelErrorInterp\fR(\fIinterp, msgPtr\fR) -.sp +.fi .SH ARGUMENTS .AS Tcl_Channel chan .AP Tcl_Channel chan in diff --git a/doc/SetErrno.3 b/doc/SetErrno.3 index c202e2e..abed74e 100644 --- a/doc/SetErrno.3 +++ b/doc/SetErrno.3 @@ -13,7 +13,6 @@ Tcl_SetErrno, Tcl_GetErrno, Tcl_ErrnoId, Tcl_ErrnoMsg \- manipulate errno to sto .nf \fB#include \fR .sp -void \fBTcl_SetErrno\fR(\fIerrorCode\fR) .sp int @@ -24,7 +23,7 @@ const char * .sp const char * \fBTcl_ErrnoMsg\fR(\fIerrorCode\fR) -.sp +.fi .SH ARGUMENTS .AS int errorCode .AP int errorCode in diff --git a/doc/SetRecLmt.3 b/doc/SetRecLmt.3 index 171d29d..b2d1705 100644 --- a/doc/SetRecLmt.3 +++ b/doc/SetRecLmt.3 @@ -16,6 +16,7 @@ Tcl_SetRecursionLimit \- set maximum allowable nesting depth in interpreter .sp Tcl_Size \fBTcl_SetRecursionLimit\fR(\fIinterp, depth\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *interp .AP Tcl_Interp *interp in diff --git a/doc/SetResult.3 b/doc/SetResult.3 index 41a87b3..4d0c9df 100644 --- a/doc/SetResult.3 +++ b/doc/SetResult.3 @@ -24,13 +24,14 @@ Tcl_Obj * const char * \fBTcl_GetStringResult\fR(\fIinterp\fR) .sp -\fBTcl_AppendResult\fR(\fIinterp, result, result, ... , \fB(char *)NULL\fR) +\fBTcl_AppendResult\fR(\fIinterp, result, result, ... , \fBNULL\fR) .sp \fBTcl_ResetResult\fR(\fIinterp\fR) .sp \fBTcl_TransferResult\fR(\fIsourceInterp, code, targetInterp\fR) .sp \fBTcl_AppendElement\fR(\fIinterp, element\fR) +.fi .SH ARGUMENTS .AS Tcl_FreeProc sourceInterp out .AP Tcl_Interp *interp out diff --git a/doc/SetVar.3 b/doc/SetVar.3 index 9d8e0b7..ad4773e 100644 --- a/doc/SetVar.3 +++ b/doc/SetVar.3 @@ -43,6 +43,7 @@ int .sp int \fBTcl_UnsetVar2\fR(\fIinterp, name1, name2, flags\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *newValuePtr .AP Tcl_Interp *interp in diff --git a/doc/Signal.3 b/doc/Signal.3 index 0a280f9..a0d7417 100644 --- a/doc/Signal.3 +++ b/doc/Signal.3 @@ -18,7 +18,7 @@ const char * .sp const char * \fBTcl_SignalMsg\fR(\fIsig\fR) -.sp +.fi .SH ARGUMENTS .AS int sig .AP int sig in diff --git a/doc/Sleep.3 b/doc/Sleep.3 index 656d72a..082adb2 100644 --- a/doc/Sleep.3 +++ b/doc/Sleep.3 @@ -15,6 +15,7 @@ Tcl_Sleep \- delay execution for a given number of milliseconds \fB#include \fR .sp \fBTcl_Sleep\fR(\fIms\fR) +.fi .SH ARGUMENTS .AS int ms .AP int ms in diff --git a/doc/SourceRCFile.3 b/doc/SourceRCFile.3 index bf8c527..3175cd1 100644 --- a/doc/SourceRCFile.3 +++ b/doc/SourceRCFile.3 @@ -11,8 +11,8 @@ Tcl_SourceRCFile \- source the Tcl rc file .nf \fB#include \fR .sp -void \fBTcl_SourceRCFile\fR(\fIinterp\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp *interp .AP Tcl_Interp *interp in diff --git a/doc/SplitList.3 b/doc/SplitList.3 index 0036333..d036ace 100644 --- a/doc/SplitList.3 +++ b/doc/SplitList.3 @@ -31,6 +31,7 @@ Tcl_Size .sp Tcl_Size \fBTcl_ConvertCountedElement\fR(\fIsrc, length, dst, flags\fR) +.fi .SH ARGUMENTS .AS "const char *const" ***argvPtr out .AP Tcl_Interp *interp out diff --git a/doc/SplitPath.3 b/doc/SplitPath.3 index 663b336..452baff 100644 --- a/doc/SplitPath.3 +++ b/doc/SplitPath.3 @@ -20,6 +20,7 @@ char * .sp Tcl_PathType \fBTcl_GetPathType\fR(\fIpath\fR) +.fi .SH ARGUMENTS .AS "const char *const" ***argvPtr in/out .AP "const char" *path in diff --git a/doc/StaticLibrary.3 b/doc/StaticLibrary.3 index c5bd364..9cad43d 100644 --- a/doc/StaticLibrary.3 +++ b/doc/StaticLibrary.3 @@ -16,6 +16,7 @@ Tcl_StaticLibrary, Tcl_StaticPackage \- make a statically linked library availab \fBTcl_StaticLibrary\fR(\fIinterp, prefix, initProc, safeInitProc\fR) .sp \fBTcl_StaticPackage\fR(\fIinterp, prefix, initProc, safeInitProc\fR) +.fi .SH ARGUMENTS .AS Tcl_LibraryInitProc *safeInitProc .AP Tcl_Interp *interp in diff --git a/doc/StrMatch.3 b/doc/StrMatch.3 index d664067..89b4ae0 100644 --- a/doc/StrMatch.3 +++ b/doc/StrMatch.3 @@ -19,6 +19,7 @@ int .sp int \fBTcl_StringCaseMatch\fR(\fIstr\fR, \fIpattern\fR, \fIflags\fR) +.fi .SH ARGUMENTS .AS "const char" *pattern .AP "const char" *str in diff --git a/doc/StringObj.3 b/doc/StringObj.3 index 5a67055..826f80e 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -19,10 +19,8 @@ Tcl_Obj * Tcl_Obj * \fBTcl_NewUnicodeObj\fR(\fIunicode, numChars\fR) .sp -void \fBTcl_SetStringObj\fR(\fIobjPtr, bytes, length\fR) .sp -void \fBTcl_SetUnicodeObj\fR(\fIobjPtr, unicode, numChars\fR) .sp char * @@ -46,19 +44,14 @@ Tcl_Size Tcl_Obj * \fBTcl_GetRange\fR(\fIobjPtr, first, last\fR) .sp -void \fBTcl_AppendToObj\fR(\fIobjPtr, bytes, length\fR) .sp -void \fBTcl_AppendUnicodeToObj\fR(\fIobjPtr, unicode, numChars\fR) .sp -void \fBTcl_AppendObjToObj\fR(\fIobjPtr, appendObjPtr\fR) .sp -void -\fBTcl_AppendStringsToObj\fR(\fIobjPtr, string, string, ... \fB(char *)NULL\fR) +\fBTcl_AppendStringsToObj\fR(\fIobjPtr, string, string, ... \fBNULL\fR) .sp -void \fBTcl_AppendLimitedToObj\fR(\fIobjPtr, bytes, length, limit, ellipsis\fR) .sp Tcl_Obj * @@ -70,10 +63,8 @@ int Tcl_Obj * \fBTcl_ObjPrintf\fR(\fIformat, ...\fR) .sp -void \fBTcl_AppendPrintfToObj\fR(\fIobjPtr, format, ...\fR) .sp -void \fBTcl_SetObjLength\fR(\fIobjPtr, newLength\fR) .sp int @@ -81,6 +72,7 @@ int .sp Tcl_Obj * \fBTcl_ConcatObj\fR(\fIobjc, objv\fR) +.fi .SH ARGUMENTS .AS "const Tcl_UniChar" *appendObjPtr in/out .AP "const char" *bytes in diff --git a/doc/SubstObj.3 b/doc/SubstObj.3 index f10e01d..2867df8 100644 --- a/doc/SubstObj.3 +++ b/doc/SubstObj.3 @@ -15,6 +15,7 @@ Tcl_SubstObj \- perform substitutions on Tcl values .sp Tcl_Obj * \fBTcl_SubstObj\fR(\fIinterp, objPtr, flags\fR) +.fi .SH ARGUMENTS .AS Tcl_Interp **termPtr .AP Tcl_Interp *interp in diff --git a/doc/Tcl.n b/doc/Tcl.n index 99af4df..0bceca6 100644 --- a/doc/Tcl.n +++ b/doc/Tcl.n @@ -108,7 +108,6 @@ variable within an array variable, and may be empty. \fB$\fIname\fR . \fIname\fR may not be empty. - .TP 15 \fB$\fIname\fB(\fIindex\fB)\fR . diff --git a/doc/Tcl_Main.3 b/doc/Tcl_Main.3 index 8277262..6410450 100644 --- a/doc/Tcl_Main.3 +++ b/doc/Tcl_Main.3 @@ -27,6 +27,7 @@ Tcl_Obj * \fBTcl_GetStartupScript\fR(\fIencodingPtr\fR) .sp \fBTcl_SetMainLoop\fR(\fImainLoopProc\fR) +.fi .SH ARGUMENTS .AS Tcl_MainLoopProc *mainLoopProc .AP Tcl_Size argc in diff --git a/doc/Thread.3 b/doc/Thread.3 index c59a8dd..cb63570 100644 --- a/doc/Thread.3 +++ b/doc/Thread.3 @@ -14,25 +14,19 @@ Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_ConditionFinalize, Tcl_GetThreadData .nf \fB#include \fR .sp -void \fBTcl_ConditionNotify\fR(\fIcondPtr\fR) .sp -void \fBTcl_ConditionWait\fR(\fIcondPtr, mutexPtr, timePtr\fR) .sp -void \fBTcl_ConditionFinalize\fR(\fIcondPtr\fR) .sp -Void * +void * \fBTcl_GetThreadData\fR(\fIkeyPtr, size\fR) .sp -void \fBTcl_MutexLock\fR(\fImutexPtr\fR) .sp -void \fBTcl_MutexUnlock\fR(\fImutexPtr\fR) .sp -void \fBTcl_MutexFinalize\fR(\fImutexPtr\fR) .sp int @@ -40,6 +34,7 @@ int .sp int \fBTcl_JoinThread\fR(\fIid, result\fR) +.fi .SH ARGUMENTS .AS Tcl_CreateThreadProc proc out .AP Tcl_Condition *condPtr in diff --git a/doc/ToUpper.3 b/doc/ToUpper.3 index 089e120..580a5b3 100644 --- a/doc/ToUpper.3 +++ b/doc/ToUpper.3 @@ -30,6 +30,7 @@ Tcl_Size .sp Tcl_Size \fBTcl_UtfToTitle\fR(\fIstr\fR) +.fi .SH ARGUMENTS .AS char *str in/out .AP int ch in diff --git a/doc/TraceCmd.3 b/doc/TraceCmd.3 index 8ae946e..d5de5a9 100644 --- a/doc/TraceCmd.3 +++ b/doc/TraceCmd.3 @@ -14,13 +14,13 @@ Tcl_CommandTraceInfo, Tcl_TraceCommand, Tcl_UntraceCommand \- monitor renames an \fB#include \fR .sp void * -\fBTcl_CommandTraceInfo(\fIinterp, cmdName, flags, proc, prevClientData\fB)\fR +\fBTcl_CommandTraceInfo\fR(\fIinterp, cmdName, flags, proc, prevClientData\fR) .sp int -\fBTcl_TraceCommand(\fIinterp, cmdName, flags, proc, clientData\fB)\fR +\fBTcl_TraceCommand\fR(\fIinterp, cmdName, flags, proc, clientData\fR) .sp -void -\fBTcl_UntraceCommand(\fIinterp, cmdName, flags, proc, clientData\fB)\fR +\fBTcl_UntraceCommand\fR(\fIinterp, cmdName, flags, proc, clientData\fR) +.fi .SH ARGUMENTS .AS Tcl_CommandTraceProc prevClientData .AP Tcl_Interp *interp in diff --git a/doc/TraceVar.3 b/doc/TraceVar.3 index 90c90b9..2c572d3 100644 --- a/doc/TraceVar.3 +++ b/doc/TraceVar.3 @@ -15,20 +15,21 @@ Tcl_TraceVar, Tcl_TraceVar2, Tcl_UntraceVar, Tcl_UntraceVar2, Tcl_VarTraceInfo, \fB#include \fR .sp int -\fBTcl_TraceVar(\fIinterp, varName, flags, proc, clientData\fB)\fR +\fBTcl_TraceVar\fR(\fIinterp, varName, flags, proc, clientData\fR) .sp int -\fBTcl_TraceVar2(\fIinterp, name1, name2, flags, proc, clientData\fB)\fR +\fBTcl_TraceVar2\fR(\fIinterp, name1, name2, flags, proc, clientData\fR) .sp -\fBTcl_UntraceVar(\fIinterp, varName, flags, proc, clientData\fB)\fR +\fBTcl_UntraceVar\fR(\fIinterp, varName, flags, proc, clientData\fR) .sp -\fBTcl_UntraceVar2(\fIinterp, name1, name2, flags, proc, clientData\fB)\fR +\fBTcl_UntraceVar2\fR(\fIinterp, name1, name2, flags, proc, clientData\fR) .sp void * -\fBTcl_VarTraceInfo(\fIinterp, varName, flags, proc, prevClientData\fB)\fR +\fBTcl_VarTraceInfo\fR(\fIinterp, varName, flags, proc, prevClientData\fR) .sp void * -\fBTcl_VarTraceInfo2(\fIinterp, name1, name2, flags, proc, prevClientData\fB)\fR +\fBTcl_VarTraceInfo2\fR(\fIinterp, name1, name2, flags, proc, prevClientData\fR) +.fi .SH ARGUMENTS .AS void *prevClientData .AP Tcl_Interp *interp in diff --git a/doc/Translate.3 b/doc/Translate.3 index e7668eb..0b6db29 100644 --- a/doc/Translate.3 +++ b/doc/Translate.3 @@ -16,6 +16,7 @@ Tcl_TranslateFileName \- convert file name to native form .sp char * \fBTcl_TranslateFileName\fR(\fIinterp\fR, \fIname\fR, \fIbufferPtr\fR) +.fi .SH ARGUMENTS .AS Tcl_DString *bufferPtr in/out .AP Tcl_Interp *interp in diff --git a/doc/UniCharIsAlpha.3 b/doc/UniCharIsAlpha.3 index a07af9a..1f70f6d 100644 --- a/doc/UniCharIsAlpha.3 +++ b/doc/UniCharIsAlpha.3 @@ -48,6 +48,7 @@ int .sp int \fBTcl_UniCharIsWordChar\fR(\fIch\fR) +.fi .SH ARGUMENTS .AS int ch .AP int ch in diff --git a/doc/UpVar.3 b/doc/UpVar.3 index 9e17ed5..d755b34 100644 --- a/doc/UpVar.3 +++ b/doc/UpVar.3 @@ -15,10 +15,11 @@ Tcl_UpVar, Tcl_UpVar2 \- link one variable to another \fB#include \fR .sp int -\fBTcl_UpVar(\fIinterp, frameName, sourceName, destName, flags\fB)\fR +\fBTcl_UpVar\fR(\fIinterp, frameName, sourceName, destName, flags\fR) .sp int -\fBTcl_UpVar2(\fIinterp, frameName, name1, name2, destName, flags\fB)\fR +\fBTcl_UpVar2\fR(\fIinterp, frameName, name1, name2, destName, flags\fR) +.fi .SH ARGUMENTS .AS "const char" *sourceName .AP Tcl_Interp *interp in diff --git a/doc/Utf.3 b/doc/Utf.3 index 6dd083f..fc7311e 100644 --- a/doc/Utf.3 +++ b/doc/Utf.3 @@ -95,6 +95,7 @@ const char * .sp Tcl_Size \fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR) +.fi .SH ARGUMENTS .AS "const Tcl_UniChar" *uniPattern in/out .AP char *buf out diff --git a/doc/WrongNumArgs.3 b/doc/WrongNumArgs.3 index 0d00c0b..fbd0f59 100644 --- a/doc/WrongNumArgs.3 +++ b/doc/WrongNumArgs.3 @@ -14,6 +14,7 @@ Tcl_WrongNumArgs \- generate standard error message for wrong number of argument \fB#include \fR .sp \fBTcl_WrongNumArgs\fR(\fIinterp, objc, objv, message\fR) +.fi .SH ARGUMENTS .AS "Tcl_Obj *const" *message .AP Tcl_Interp interp in diff --git a/doc/after.n b/doc/after.n index 5d64cb6..b43f2cb 100644 --- a/doc/after.n +++ b/doc/after.n @@ -12,17 +12,14 @@ .SH NAME after \- Execute a command after a time delay .SH SYNOPSIS +.nf \fBafter \fIms\fR -.sp \fBafter \fIms \fR?\fIscript script script ...\fR? -.sp \fBafter cancel \fIid\fR -.sp \fBafter cancel \fIscript script script ...\fR -.sp \fBafter idle \fR?\fIscript script script ...\fR? -.sp \fBafter info \fR?\fIid\fR? +.fi .BE .SH DESCRIPTION .PP diff --git a/doc/chan.n b/doc/chan.n index 2964eff..5436cc8 100644 --- a/doc/chan.n +++ b/doc/chan.n @@ -153,9 +153,11 @@ interface with the operating system, \fIchar\fR signals the end of the data when it is encountered in the input. If \fIchar\fR is the empty string, there is no special character that marks the end of the data. - +.RS +.PP The default value is the empty string. The acceptable range is \ex01 - \ex7F. A value outside this range results in an error. +.RE .VS "TCL8.7 TIP656" .TP \fB\-profile\fI profile\fR diff --git a/doc/clock.n b/doc/clock.n index 5d86ed2..e7f1b11 100644 --- a/doc/clock.n +++ b/doc/clock.n @@ -8,22 +8,17 @@ .SH NAME clock \- Obtain and manipulate dates and times .SH "SYNOPSIS" +.nf package require \fBTcl 8.5-\fR -.sp + \fBclock add\fI timeVal\fR ?\fIcount unit...\fR? ?\fI\-option value\fR? -.sp \fBclock clicks\fR ?\fI\-option\fR? -.sp \fBclock format\fI timeVal\fR ?\fI\-option value\fR...? -.sp \fBclock microseconds\fR -.sp \fBclock milliseconds\fR -.sp \fBclock scan\fI inputString\fR ?\fI\-option value\fR...? -.sp \fBclock seconds\fR -.sp +.fi .BE .SH "DESCRIPTION" .PP diff --git a/doc/coroutine.n b/doc/coroutine.n index 25ab6ad..cb4d3dd 100644 --- a/doc/coroutine.n +++ b/doc/coroutine.n @@ -13,10 +13,11 @@ coroutine, yield, yieldto, coroinject, coroprobe \- Create and produce values fr .SH SYNOPSIS .nf \fBcoroutine \fIname command\fR ?\fIarg...\fR? + \fByield\fR ?\fIvalue\fR? \fByieldto\fI command\fR ?\fIarg...\fR? \fIname\fR ?\fIvalue...\fR? -.sp + .VS "8.7, TIP383" \fBcoroinject \fIcoroName command\fR ?\fIarg...\fR? \fBcoroprobe \fIcoroName command\fR ?\fIarg...\fR? diff --git a/doc/dde.n b/doc/dde.n index ab6ed80..86bf92c 100644 --- a/doc/dde.n +++ b/doc/dde.n @@ -12,22 +12,17 @@ .SH NAME dde \- Execute a Dynamic Data Exchange command .SH SYNOPSIS -.sp +.nf \fBpackage require dde 1.4\fR -.sp + \fBdde servername\fR ?\fB\-force\fR? ?\fB\-handler \fIproc\fR? ?\fB\-\|\-\fR? ?\fItopic\fR? -.sp \fBdde execute\fR ?\fB\-async\fR? ?\fB\-binary\fR? \fIservice topic data\fR -.sp \fBdde poke\fR ?\fB\-binary\fR? \fIservice topic item data\fR -.sp \fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR -.sp \fBdde services \fIservice topic\fR -.sp \fBdde eval\fR ?\fB\-async\fR? \fItopic cmd \fR?\fIarg arg ...\fR? +.fi .BE - .SH DESCRIPTION .PP This command allows an application to send Dynamic Data Exchange (DDE) diff --git a/doc/define.n b/doc/define.n index cb1864c43..1344b32 100644 --- a/doc/define.n +++ b/doc/define.n @@ -20,7 +20,6 @@ package require tcl::oo \fBoo::objdefine\fI object subcommand arg\fR ?\fIarg ...\fR? .fi .BE - .SH DESCRIPTION The \fBoo::define\fR command is used to control the configuration of classes, and the \fBoo::objdefine\fR command is used to control the configuration of diff --git a/doc/error.n b/doc/error.n index c05f8b9..9ff4298 100644 --- a/doc/error.n +++ b/doc/error.n @@ -14,7 +14,6 @@ error \- Generate an error .SH SYNOPSIS \fBerror \fImessage\fR ?\fIinfo\fR? ?\fIcode\fR? .BE - .SH DESCRIPTION .PP Returns a \fBTCL_ERROR\fR code, which causes command interpretation to be diff --git a/doc/eval.n b/doc/eval.n index 9fc2ae4..9710a55 100644 --- a/doc/eval.n +++ b/doc/eval.n @@ -23,7 +23,13 @@ fashion as the \fBconcat\fR command, passes the concatenated string to the Tcl interpreter recursively, and returns the result of that evaluation (or any error generated by it). Note that the \fBlist\fR command quotes sequences of words in such a -way that they are not further expanded by the \fBeval\fR command. +way that they are not further expanded by the \fBeval\fR command; +for \fIany\fR values, $a, $b, and $c, these two lines are effectively +equivalent: +.PP +.CS +\fBeval\fR [list $a $b $c] +$a $b $c .SH EXAMPLES .PP Often, it is useful to store a fragment of a script in a variable and @@ -74,6 +80,12 @@ However, the last line would now normally be written without .CS set var [linsert $var 0 {*}$args] .CE +.PP +or indeed like this: +.PP +.CS +set var [list {*}$args {*}$var] +.CE .SH "SEE ALSO" catch(n), concat(n), error(n), errorCode(n), errorInfo(n), interp(n), list(n), namespace(n), subst(n), uplevel(n) diff --git a/doc/exit.n b/doc/exit.n index 36676b1..5744ffe 100644 --- a/doc/exit.n +++ b/doc/exit.n @@ -14,7 +14,6 @@ exit \- End the application .SH SYNOPSIS \fBexit \fR?\fIreturnCode\fR? .BE - .SH DESCRIPTION .PP Terminate the process, returning \fIreturnCode\fR to the diff --git a/doc/expr.n b/doc/expr.n index 3b8f1a8..340495c 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -88,7 +88,6 @@ end of a numeric value. Here are some examples: \fBexpr\fR 3_141_592_653_589e-1_2 \fI3.141592653589\fR .CE .RE - .TP A \fBboolean value\fR . diff --git a/doc/fblocked.n b/doc/fblocked.n index 0a28dcf..44dfcd5 100644 --- a/doc/fblocked.n +++ b/doc/fblocked.n @@ -12,7 +12,6 @@ fblocked \- Test whether the last input operation exhausted all available input .SH SYNOPSIS \fBfblocked \fIchannelId\fR .BE - .SH DESCRIPTION .PP The \fBfblocked\fR command returns 1 if the most recent input operation diff --git a/doc/fcopy.n b/doc/fcopy.n index 800a392..2eafdd7 100644 --- a/doc/fcopy.n +++ b/doc/fcopy.n @@ -14,7 +14,6 @@ fcopy \- Copy data from one channel to another .SH SYNOPSIS \fBfcopy \fIinputChan outputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR? .BE - .SH DESCRIPTION .PP The \fBfcopy\fR command copies data from one I/O channel, \fIinchan\fR to another I/O channel, \fIoutchan\fR. diff --git a/doc/fileevent.n b/doc/fileevent.n index bbba997..c302b39 100644 --- a/doc/fileevent.n +++ b/doc/fileevent.n @@ -17,7 +17,6 @@ fileevent \- Execute a script when a channel becomes readable or writable .sp \fBfileevent \fIchannelId \fBwritable \fR?\fIscript\fR? .BE - .SH DESCRIPTION .PP This command is used to create \fIfile event handlers\fR. A file event diff --git a/doc/for.n b/doc/for.n index 9a3235f..759b66e 100644 --- a/doc/for.n +++ b/doc/for.n @@ -14,7 +14,6 @@ for \- 'For' loop .SH SYNOPSIS \fBfor \fIstart test next body\fR .BE - .SH DESCRIPTION .PP \fBFor\fR is a looping command, similar in structure to the C diff --git a/doc/foreach.n b/doc/foreach.n index 43f961a..1f9f88e 100644 --- a/doc/foreach.n +++ b/doc/foreach.n @@ -16,7 +16,6 @@ foreach \- Iterate over all elements in one or more lists .br \fBforeach \fIvarlist1 list1\fR ?\fIvarlist2 list2 ...\fR? \fIbody\fR .BE - .SH DESCRIPTION .PP The \fBforeach\fR command implements a loop where the loop @@ -96,10 +95,8 @@ set x {} # The value of x is "a d e b f g c {} {}" # There are 3 iterations of the loop. .CE - .SH "SEE ALSO" for(n), while(n), break(n), continue(n) - .SH KEYWORDS foreach, iteration, list, loop '\" Local Variables: diff --git a/doc/format.n b/doc/format.n index eb64491..1e70995 100644 --- a/doc/format.n +++ b/doc/format.n @@ -14,7 +14,6 @@ format \- Format a string in the style of sprintf .SH SYNOPSIS \fBformat \fIformatString \fR?\fIarg arg ...\fR? .BE - .SH INTRODUCTION .PP This command generates a formatted string in a fashion similar to the diff --git a/doc/gets.n b/doc/gets.n index 29355a4..33d8cf6 100644 --- a/doc/gets.n +++ b/doc/gets.n @@ -14,7 +14,6 @@ gets \- Read a line from a channel .SH SYNOPSIS \fBgets \fIchannelId\fR ?\fIvarName\fR? .BE - .SH DESCRIPTION .PP This command reads the next line from \fIchannelId\fR, returns everything @@ -96,10 +95,8 @@ while {[\fBgets\fR $chan line] >= 0} { } close $chan .CE - .SH "SEE ALSO" file(n), eof(n), fblocked(n), Tcl_StandardChannels(3) - .SH KEYWORDS blocking, channel, end of file, end of line, line, non-blocking, read '\" Local Variables: diff --git a/doc/http.n b/doc/http.n index 4105592..f35e917 100644 --- a/doc/http.n +++ b/doc/http.n @@ -13,66 +13,40 @@ .SH NAME http \- Client-side implementation of the HTTP/1.1 protocol .SH SYNOPSIS +.nf \fBpackage require http\fR ?\fB2.10\fR? .\" See Also -useragent option documentation in body! -.sp + \fB::http::config\fR ?\fI\-option value\fR ...? -.sp \fB::http::geturl \fIurl\fR ?\fI\-option value\fR ...? -.sp \fB::http::formatQuery\fI key value\fR ?\fIkey value\fR ...? -.sp \fB::http::quoteString\fI value\fR -.sp \fB::http::reset\fI token\fR ?\fIwhy\fR? -.sp \fB::http::wait \fItoken\fR -.sp \fB::http::status \fItoken\fR -.sp \fB::http::size \fItoken\fR -.sp \fB::http::error \fItoken\fR -.sp \fB::http::postError \fItoken\fR -.sp \fB::http::cleanup \fItoken\fR -.sp \fB::http::requestLine\fI token\fR -.sp \fB::http::requestHeaders\fI token\fR ?\fIheaderName\fR? -.sp \fB::http::requestHeaderValue\fI token headerName\fR -.sp \fB::http::responseLine\fI token\fR -.sp \fB::http::responseCode\fI token\fR -.sp \fB::http::reasonPhrase\fI code\fR -.sp \fB::http::responseHeaders\fI token\fR ?\fIheaderName\fR? -.sp \fB::http::responseHeaderValue\fI token headerName\fR -.sp \fB::http::responseInfo\fI token\fR -.sp \fB::http::responseBody\fI token\fR -.sp \fB::http::register \fIproto port command\fR ?\fIsocketCmdVarName\fR? ?\fIuseSockThread\fR? ?\fIendToEndProxy\fR? -.sp \fB::http::registerError \fIsock\fR ?\fImessage\fR? -.sp \fB::http::unregister \fIproto\fR -.sp \fB::http::code \fItoken\fR -.sp \fB::http::data \fItoken\fR -.sp \fB::http::meta \fItoken\fR ?\fIheaderName\fR? -.sp \fB::http::metaValue\fI token headerName\fR -.sp \fB::http::ncode \fItoken\fR +.fi .SH "EXPORTED COMMANDS" .PP Namespace \fBhttp\fR exports the commands \fBconfig\fR, \fBformatQuery\fR, diff --git a/doc/idna.n b/doc/idna.n index 7f4ab6a..5f31558 100644 --- a/doc/idna.n +++ b/doc/idna.n @@ -20,6 +20,7 @@ package require tcl::idna 1.0 \fBtcl::idna puny encode\fI string\fR ?\fIcase\fR? \fBtcl::idna version\fR .fi +.BE .SH DESCRIPTION This package provides an implementation of the punycode scheme used in Internationalised Domain Names, and some access commands. (See RFC 3492 for a diff --git a/doc/if.n b/doc/if.n index ff2518d..8ba1f8e 100644 --- a/doc/if.n +++ b/doc/if.n @@ -14,7 +14,6 @@ if \- Execute scripts conditionally .SH SYNOPSIS \fBif \fIexpr1 \fR?\fBthen\fR? \fIbody1 \fBelseif \fIexpr2 \fR?\fBthen\fR? \fIbody2\fR \fBelseif\fR ... ?\fBelse\fR? ?\fIbodyN\fR? .BE - .SH DESCRIPTION .PP The \fIif\fR command evaluates \fIexpr1\fR as an expression (in the diff --git a/doc/ledit.n b/doc/ledit.n index 48bc608..b956cc1 100644 --- a/doc/ledit.n +++ b/doc/ledit.n @@ -26,6 +26,8 @@ the same as index values for the command \fBstring index\fR, supporting simple index arithmetic and indices relative to the end of the list. The index \fB0\fR refers to the first element of the list, and \fBend\fR refers to the last element of the list. +(Unlike with \fBlpop\fR, \fBlset\fR, and \fBlindex\fR, indices into sublists +are not supported.) .PP If either \fIfirst\fR or \fIlast\fR is less than zero, it is considered to refer to the position before the first element of the list. This allows @@ -42,7 +44,7 @@ with no elements being deleted. The \fIvalue\fR arguments specify zero or more new elements to be added to the list in place of those that were deleted. Each \fIvalue\fR argument will become a separate element of -the list. If no \fIvalue\fR arguments are specified, then the elements +the list. If no \fIvalue\fR arguments are specified, the elements between \fIfirst\fR and \fIlast\fR are simply deleted. .SH EXAMPLES .PP diff --git a/doc/library.n b/doc/library.n index d55218d..bb3db05 100644 --- a/doc/library.n +++ b/doc/library.n @@ -30,6 +30,7 @@ auto_execok, auto_import, auto_load, auto_mkindex, auto_qualify, auto_reset, tcl \fBreadFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR? \fBwriteFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR? \fIcontents\fR .VE "Tcl 8.7, TIP 670" +.fi .BE .SH INTRODUCTION .PP diff --git a/doc/lpop.n b/doc/lpop.n index 2a464eb..454ff2a 100644 --- a/doc/lpop.n +++ b/doc/lpop.n @@ -18,14 +18,15 @@ lpop \- Get and remove an element in a list The \fBlpop\fR command accepts a parameter, \fIvarName\fR, which it interprets as the name of a variable containing a Tcl list. It also accepts one or more \fIindices\fR into -the list. If no indices are presented, it defaults to "end". +the list. If no indices are presented, it defaults to "\fBend\fR". .PP When presented with a single index, the \fBlpop\fR command addresses the \fIindex\fR'th element in it, removes if from the list and returns the element. .PP If \fIindex\fR is negative or greater or equal than the number -of elements in \fI$varName\fR, then an error occurs. +of elements in the list in the variable called \fIvarName\fR, an +error occurs. .PP The interpretation of each simple \fIindex\fR value is the same as for the command \fBstring index\fR, supporting simple index @@ -34,7 +35,8 @@ arithmetic and indices relative to the end of the list. If additional \fIindex\fR arguments are supplied, then each argument is used in turn to address an element within a sublist designated by the previous indexing operation, -allowing the script to remove elements in sublists. +allowing the script to remove elements in sublists, similar to +\fBlindex\fR and \fBlset\fR. The command, .PP .CS diff --git a/doc/lseq.n b/doc/lseq.n index fded359..9e46f38 100644 --- a/doc/lseq.n +++ b/doc/lseq.n @@ -11,11 +11,11 @@ .SH NAME lseq \- Build a numeric sequence returned as a list .SH SYNOPSIS +.nf \fBlseq \fIstart \fR?(\fB..\fR|\fBto\fR)? \fIend\fR ??\fBby\fR? \fIstep\fR? - \fBlseq \fIstart \fBcount\fI count\fR ??\fBby\fR? \fIstep\fR? - \fBlseq \fIcount\fR ?\fBby \fIstep\fR? +.fi .BE .SH DESCRIPTION .PP @@ -24,16 +24,17 @@ parameters \fIstart\fR, \fIend\fR, and \fIstep\fR. The \fIoperation\fR argument "\fB..\fR" or "\fBto\fR" defines the range. The "\fBcount\fR" option is used to define a count of the number of elements in the list. A short form use of the command, with a single count value, will create a range from 0 to -count-1. - +\fIcount\fR-1. +.PP The \fBlseq\fR command can produce both increasing and decreasing sequences. When both \fIstart\fR and \fIend\fR are provided without a \fIstep\fR value, then if \fIstart\fR <= \fIend\fR, the sequence will be increasing and if \fIstart\fR > \fIend\fR it will be decreasing. If a \fIstep\fR vale is included, it's sign should agree with the direction of the -sequence (descending -> negative and ascending -> positive), otherwise an +sequence (descending \(-> negative and ascending \(-> positive), otherwise an empty list is returned. For example: - +.RS +.PP .CS \" % \fBlseq\fR 1 to 5 ;# increasing \fI\(-> 1 2 3 4 5 @@ -46,7 +47,8 @@ empty list is returned. For example: % \fBlseq\fR 1 to 5 by 0 ;# all step sizes of 0 produce an empty list .\" .CE - +.RE +.PP The numeric arguments, \fIstart\fR, \fIend\fR, \fIstep\fR, and \fIcount\fR, may also be a valid expression. The expression will be evaluated and the numeric result will be used. An expression that does not evaluate to a number @@ -54,20 +56,19 @@ will produce an invalid argument error. .PP \fIStart\fR defines the initial value and \fIend\fR defines the limit, not necessarily the last value. \fBlseq\fR produces a list with \fIcount\fR -elements, and if \fIcount\fR is not supplied, it is computed as - -.CS \" - \fIcount\fR = int( (\fIend\fR - \fIstart\fR + \fIstep\fR) / \fIstep\fR ) -.\" +elements, and if \fIcount\fR is not supplied, it is computed as: +.RS +.PP +.CS +\fIcount\fR = int( (\fIend\fR - \fIstart\fR + \fIstep\fR) / \fIstep\fR ) .CE - +.RE .PP The numeric arguments, \fIstart\fR, \fIend\fR, \fIstep\fR, and \fIcount\fR, can also be a valid expression. the \fBlseq\fR command will evaluate the expression (as if with \fBexpr\fR) and use the numeric result, or return an error as with any invalid argument value; a non-numeric expression result will result in an error. - .SH EXAMPLES .CS .\" diff --git a/doc/mathfunc.n b/doc/mathfunc.n index 00fef17..c84dbf7 100644 --- a/doc/mathfunc.n +++ b/doc/mathfunc.n @@ -13,86 +13,51 @@ .SH NAME mathfunc \- Mathematical functions for Tcl expressions .SH SYNOPSIS +.nf package require \fBTcl 8.5-\fR -.sp + \fB::tcl::mathfunc::abs\fI arg\fR -.br \fB::tcl::mathfunc::acos\fI arg\fR -.br \fB::tcl::mathfunc::asin\fI arg\fR -.br \fB::tcl::mathfunc::atan\fI arg\fR -.br \fB::tcl::mathfunc::atan2\fI y x\fR -.br \fB::tcl::mathfunc::bool\fI arg\fR -.br \fB::tcl::mathfunc::ceil\fI arg\fR -.br \fB::tcl::mathfunc::cos\fI arg\fR -.br \fB::tcl::mathfunc::cosh\fI arg\fR -.br \fB::tcl::mathfunc::double\fI arg\fR -.br \fB::tcl::mathfunc::entier\fI arg\fR -.br \fB::tcl::mathfunc::exp\fI arg\fR -.br \fB::tcl::mathfunc::floor\fI arg\fR -.br \fB::tcl::mathfunc::fmod\fI x y\fR -.br \fB::tcl::mathfunc::hypot\fI x y\fR -.br \fB::tcl::mathfunc::int\fI arg\fR -.br .VS "8.7, TIP 521" \fB::tcl::mathfunc::isfinite\fI arg\fR -.br \fB::tcl::mathfunc::isinf\fI arg\fR -.br \fB::tcl::mathfunc::isnan\fI arg\fR -.br \fB::tcl::mathfunc::isnormal\fI arg\fR .VE "8.7, TIP 521" -.br \fB::tcl::mathfunc::isqrt\fI arg\fR -.br .VS "8.7, TIP 521" \fB::tcl::mathfunc::issubnormal\fI arg\fR -.br \fB::tcl::mathfunc::isunordered\fI x y\fR .VE "8.7, TIP 521" -.br \fB::tcl::mathfunc::log\fI arg\fR -.br \fB::tcl::mathfunc::log10\fI arg\fR -.br \fB::tcl::mathfunc::max\fI arg\fR ?\fIarg\fR ...? -.br \fB::tcl::mathfunc::min\fI arg\fR ?\fIarg\fR ...? -.br \fB::tcl::mathfunc::pow\fI x y\fR -.br \fB::tcl::mathfunc::rand\fR -.br \fB::tcl::mathfunc::round\fI arg\fR -.br \fB::tcl::mathfunc::sin\fI arg\fR -.br \fB::tcl::mathfunc::sinh\fI arg\fR -.br \fB::tcl::mathfunc::sqrt\fI arg\fR -.br \fB::tcl::mathfunc::srand\fI arg\fR -.br \fB::tcl::mathfunc::tan\fI arg\fR -.br \fB::tcl::mathfunc::tanh\fI arg\fR -.br \fB::tcl::mathfunc::wide\fI arg\fR -.sp +.fi .BE .SH "DESCRIPTION" .PP diff --git a/doc/mathop.n b/doc/mathop.n index f8a0dc4..95a5d0e 100644 --- a/doc/mathop.n +++ b/doc/mathop.n @@ -11,64 +11,39 @@ .SH NAME mathop \- Mathematical operators as Tcl commands .SH SYNOPSIS +.nf package require \fBTcl 8.5-\fR -.sp + \fB::tcl::mathop::!\fI number\fR -.br \fB::tcl::mathop::~\fI number\fR -.br \fB::tcl::mathop::+\fR ?\fInumber\fR ...? -.br \fB::tcl::mathop::\-\fI number\fR ?\fInumber\fR ...? -.br \fB::tcl::mathop::*\fR ?\fInumber\fR ...? -.br \fB::tcl::mathop::/\fI number\fR ?\fInumber\fR ...? -.br \fB::tcl::mathop::%\fI number number\fR -.br \fB::tcl::mathop::**\fR ?\fInumber\fR ...? -.br \fB::tcl::mathop::&\fR ?\fInumber\fR ...? -.br \fB::tcl::mathop::|\fR ?\fInumber\fR ...? -.br \fB::tcl::mathop::^\fR ?\fInumber\fR ...? -.br \fB::tcl::mathop::<<\fI number number\fR -.br \fB::tcl::mathop::>>\fI number number\fR -.br \fB::tcl::mathop::==\fR ?\fIarg\fR ...? -.br \fB::tcl::mathop::!=\fI arg arg\fR -.br \fB::tcl::mathop::<\fR ?\fIarg\fR ...? -.br \fB::tcl::mathop::<=\fR ?\fIarg\fR ...? -.br \fB::tcl::mathop::>=\fR ?\fIarg\fR ...? -.br \fB::tcl::mathop::>\fR ?\fIarg\fR ...? -.br \fB::tcl::mathop::eq\fR ?\fIarg\fR ...? -.br \fB::tcl::mathop::ne\fI arg arg\fR -.br .VS "8.7, TIP461" \fB::tcl::mathop::lt\fR ?\fIarg\fR ...? -.br \fB::tcl::mathop::le\fR ?\fIarg\fR ...? -.br \fB::tcl::mathop::gt\fR ?\fIarg\fR ...? -.br \fB::tcl::mathop::ge\fR ?\fIarg\fR ...? .VE "8.7, TIP461" -.br \fB::tcl::mathop::in\fI arg list\fR -.br \fB::tcl::mathop::ni\fI arg list\fR -.sp +.fi .BE .SH DESCRIPTION .PP diff --git a/doc/msgcat.n b/doc/msgcat.n index 58b5b0d..43ea95d 100644 --- a/doc/msgcat.n +++ b/doc/msgcat.n @@ -11,55 +11,40 @@ .SH NAME msgcat \- Tcl message catalog .SH SYNOPSIS +.nf \fBpackage require tcl 8.7\fR -.sp \fBpackage require msgcat 1.7\fR -.sp + \fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR? -.sp \fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR? -.sp .VS "TIP 412" \fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? \fIsrc-string\fR .VE "TIP 412" -.sp .VS "TIP 490" \fB::msgcat::mcpackagenamespaceget\fR .VE "TIP 490" -.sp \fB::msgcat::mclocale \fR?\fInewLocale\fR? -.sp .VS "TIP 499" \fB::msgcat::mcpreferences\fR ?\fIlocale preference\fR? ... .VE "TIP 499" -.sp .VS "TIP 412" \fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR? .VE "TIP 412" -.sp \fB::msgcat::mcload \fIdirname\fR -.sp \fB::msgcat::mcset \fIlocale src-string \fR?\fItranslate-string\fR? -.sp \fB::msgcat::mcmset \fIlocale src-trans-list\fR -.sp \fB::msgcat::mcflset \fIsrc-string \fR?\fItranslate-string\fR? -.sp \fB::msgcat::mcflmset \fIsrc-trans-list\fR -.sp \fB::msgcat::mcunknown \fIlocale src-string\fR ?\fIarg arg ...\fR? -.sp .VS "TIP 412" \fB::msgcat::mcpackagelocale subcommand\fR ?\fIlocale\fR? -.sp \fB::msgcat::mcpackageconfig subcommand\fI option\fR ?\fIvalue\fR? -.sp \fB::msgcat::mcforgetpackage\fR .VE "TIP 412" -.sp .VS "TIP 499" \fB::msgcat::mcutil subcommand\fR ?\fIlocale\fR? .VS "TIP 499" +.fi .BE .SH DESCRIPTION .PP diff --git a/doc/open.n b/doc/open.n index f955e39..1c63f8f 100644 --- a/doc/open.n +++ b/doc/open.n @@ -12,12 +12,11 @@ .SH NAME open \- Open a file-based or command pipeline channel .SH SYNOPSIS -.sp +.nf \fBopen \fIfileName\fR -.br \fBopen \fIfileName access\fR -.br \fBopen \fIfileName access permissions\fR +.fi .BE .SH DESCRIPTION .PP diff --git a/doc/packagens.n b/doc/packagens.n index d55151f..ebb7372 100644 --- a/doc/packagens.n +++ b/doc/packagens.n @@ -11,14 +11,12 @@ pkg::create \- Construct an appropriate 'package ifneeded' command for a given p .SH SYNOPSIS \fB::pkg::create\fR \fB\-name \fIpackageName \fB\-version \fIpackageVersion\fR ?\fB\-load \fIfilespec\fR? ... ?\fB\-source \fIfilespec\fR? ... .BE - .SH DESCRIPTION .PP \fB::pkg::create\fR is a utility procedure that is part of the standard Tcl library. It is used to create an appropriate \fBpackage ifneeded\fR command for a given package specification. It can be used to construct a \fBpkgIndex.tcl\fR file for use with the \fBpackage\fR mechanism. - .SH OPTIONS The parameters supported are: .TP diff --git a/doc/pid.n b/doc/pid.n index fa0af56..02d1cbe 100644 --- a/doc/pid.n +++ b/doc/pid.n @@ -14,7 +14,6 @@ pid \- Retrieve process identifiers .SH SYNOPSIS \fBpid \fR?\fIfileId\fR? .BE - .SH DESCRIPTION .PP If the \fIfileId\fR argument is given then it should normally @@ -40,7 +39,6 @@ puts [string repeat - 70] puts [read $pipeline] close $pipeline .CE - .SH "SEE ALSO" exec(n), open(n) .SH KEYWORDS diff --git a/doc/platform.n b/doc/platform.n index 8ac07d2..18754b6 100644 --- a/doc/platform.n +++ b/doc/platform.n @@ -13,7 +13,7 @@ platform \- System identification support code and utilities .SH SYNOPSIS .nf \fBpackage require platform\fR ?\fB1.0.10\fR? -.sp + \fBplatform::generic\fR \fBplatform::identify\fR \fBplatform::patterns \fIidentifier\fR diff --git a/doc/platform_shell.n b/doc/platform_shell.n index 54a1edb..7103e6a 100644 --- a/doc/platform_shell.n +++ b/doc/platform_shell.n @@ -13,7 +13,7 @@ platform::shell \- System identification support code and utilities .SH SYNOPSIS .nf \fBpackage require platform::shell\fR ?\fB1.1.4\fR? -.sp + \fBplatform::shell::generic \fIshell\fR \fBplatform::shell::identify \fIshell\fR \fBplatform::shell::platform \fIshell\fR diff --git a/doc/puts.n b/doc/puts.n index 0943f87..5ce56b7 100644 --- a/doc/puts.n +++ b/doc/puts.n @@ -67,7 +67,6 @@ via a file event that the channel is ready for more output data). Encoding errors may exist, if the encoding profile \fBstrict\fR is used. \fBputs\fR writes out data until an encoding error occurs and fails with POSIX error code \fBEILSEQ\fR. - .SH EXAMPLES .PP Write a short message to the console (or wherever \fBstdout\fR is diff --git a/doc/registry.n b/doc/registry.n index a58dd87..58215ff 100644 --- a/doc/registry.n +++ b/doc/registry.n @@ -12,10 +12,11 @@ .SH NAME registry \- Manipulate the Windows registry .SH SYNOPSIS -.sp +.nf \fBpackage require registry 1.3\fR -.sp + \fBregistry \fR?\fI\-mode\fR? \fIoption keyName\fR ?\fIarg arg ...\fR? +.fi .BE .SH DESCRIPTION .PP diff --git a/doc/return.n b/doc/return.n index 58b1b75..a7eb197 100644 --- a/doc/return.n +++ b/doc/return.n @@ -13,11 +13,11 @@ .SH NAME return \- Return from a procedure, or set return code of a script .SH SYNOPSIS +.nf \fBreturn \fR?\fIresult\fR? -.sp \fBreturn \fR?\fB\-code \fIcode\fR? ?\fIresult\fR? -.sp \fBreturn \fR?\fIoption value \fR...? ?\fIresult\fR? +.fi .BE .SH DESCRIPTION .PP diff --git a/doc/safe.n b/doc/safe.n index a3a945e..44375e5 100644 --- a/doc/safe.n +++ b/doc/safe.n @@ -11,28 +11,26 @@ .SH NAME safe \- Creating and manipulating safe interpreters .SH SYNOPSIS +.nf \fB::safe::interpCreate\fR ?\fIchild\fR? ?\fIoptions...\fR? -.sp \fB::safe::interpInit\fI child\fR ?\fIoptions...\fR? -.sp \fB::safe::interpConfigure\fI child\fR ?\fIoptions...\fR? -.sp \fB::safe::interpDelete\fI child\fR -.sp \fB::safe::interpAddToAccessPath\fI child directory\fR -.sp \fB::safe::interpFindInAccessPath\fI child directory\fR -.sp \fB::safe::setSyncMode\fR ?\fInewValue\fR? -.sp \fB::safe::setLogCmd\fR ?\fIcmd arg...\fR? +.fi .SS OPTIONS -.PP +.nf ?\fB\-accessPath\fI pathList\fR? ?\fB\-autoPath\fI pathList\fR? -?\fB\-statics\fI boolean\fR? ?\fB\-noStatics\fR? -?\fB\-nested\fI boolean\fR? ?\fB\-nestedLoadOk\fR? +?\fB\-statics\fI boolean\fR? +?\fB\-noStatics\fR? +?\fB\-nested\fI boolean\fR? +?\fB\-nestedLoadOk\fR? ?\fB\-deleteHook\fI script\fR? +.fi .BE .SH DESCRIPTION Safe Tcl is a mechanism for executing untrusted Tcl scripts @@ -484,17 +482,17 @@ safe interpreter's ::auto_path will be set to {} (by (by \fB::safe::interpConfigure\fR). If the same command specifies a new value for \fB\-autoPath\fR, it will be applied after the \fB\-accessPath\fR argument has been processed. - +.PP Examples of use with "Sync Mode" off: any of these commands will set the ::auto_path to a tokenized form of its value in the parent interpreter: .RS .PP .CS - safe::interpCreate foo - safe::interpCreate foo -accessPath {} - safe::interpInit bar - safe::interpInit bar -accessPath {} - safe::interpConfigure foo -accessPath {} +safe::interpCreate foo +safe::interpCreate foo -accessPath {} +safe::interpInit bar +safe::interpInit bar -accessPath {} +safe::interpConfigure foo -accessPath {} .CE .RE .PP @@ -504,35 +502,35 @@ own value is also specified: .RS .PP .CS - safe::interpCreate foo -accessPath { - /usr/local/TclHome/lib/tcl8.6 - /usr/local/TclHome/lib/tcl8.6/http1.0 - /usr/local/TclHome/lib/tcl8.6/opt0.4 - /usr/local/TclHome/lib/tcl8.6/msgs - /usr/local/TclHome/lib/tcl8.6/encoding - /usr/local/TclHome/lib - } +safe::interpCreate foo -accessPath { + /usr/local/TclHome/lib/tcl8.6 + /usr/local/TclHome/lib/tcl8.6/http1.0 + /usr/local/TclHome/lib/tcl8.6/opt0.4 + /usr/local/TclHome/lib/tcl8.6/msgs + /usr/local/TclHome/lib/tcl8.6/encoding + /usr/local/TclHome/lib +} - # The child's ::auto_path must be given a suitable value: +# The child's ::auto_path must be given a suitable value: - safe::interpConfigure foo -autoPath { - /usr/local/TclHome/lib/tcl8.6 - /usr/local/TclHome/lib - } +safe::interpConfigure foo -autoPath { + /usr/local/TclHome/lib/tcl8.6 + /usr/local/TclHome/lib +} - # The two commands can be combined: +# The two commands can be combined: - safe::interpCreate foo -accessPath { - /usr/local/TclHome/lib/tcl8.6 - /usr/local/TclHome/lib/tcl8.6/http1.0 - /usr/local/TclHome/lib/tcl8.6/opt0.4 - /usr/local/TclHome/lib/tcl8.6/msgs - /usr/local/TclHome/lib/tcl8.6/encoding - /usr/local/TclHome/lib - } -autoPath { - /usr/local/TclHome/lib/tcl8.6 - /usr/local/TclHome/lib - } +safe::interpCreate foo -accessPath { + /usr/local/TclHome/lib/tcl8.6 + /usr/local/TclHome/lib/tcl8.6/http1.0 + /usr/local/TclHome/lib/tcl8.6/opt0.4 + /usr/local/TclHome/lib/tcl8.6/msgs + /usr/local/TclHome/lib/tcl8.6/encoding + /usr/local/TclHome/lib +} -autoPath { + /usr/local/TclHome/lib/tcl8.6 + /usr/local/TclHome/lib +} .CE .RE .PP @@ -542,11 +540,11 @@ Example of use with "Sync Mode" off: the command .RS .PP .CS - safe::interpAddToAccessPath foo /usr/local/TclHome/lib/extras/Img1.4.11 +safe::interpAddToAccessPath foo /usr/local/TclHome/lib/extras/Img1.4.11 - lassign [safe::interpConfigure foo -autoPath] DUM childAutoPath - lappend childAutoPath /usr/local/TclHome/lib/extras/Img1.4.11 - safe::interpConfigure foo -autoPath $childAutoPath +lassign [safe::interpConfigure foo -autoPath] DUM childAutoPath +lappend childAutoPath /usr/local/TclHome/lib/extras/Img1.4.11 +safe::interpConfigure foo -autoPath $childAutoPath .CE .RE .SH "SEE ALSO" diff --git a/doc/socket.n b/doc/socket.n index b7b3228..8cc5029 100644 --- a/doc/socket.n +++ b/doc/socket.n @@ -12,10 +12,10 @@ .SH NAME socket \- Open a TCP network connection .SH SYNOPSIS -.sp +.nf \fBsocket \fR?\fIoptions\fR? \fIhost port\fR -.sp \fBsocket\fR \fB\-server \fIcommand\fR ?\fIoptions\fR? \fIport\fR +.fi .BE .SH DESCRIPTION .PP diff --git a/doc/tclsh.1 b/doc/tclsh.1 index 3a78737..28ad14c 100644 --- a/doc/tclsh.1 +++ b/doc/tclsh.1 @@ -96,6 +96,17 @@ its version number as part of the name. This has the advantage of allowing multiple versions of Tcl to exist on the same system at once, but also the disadvantage of making it harder to write scripts that start up uniformly across different versions of Tcl. +.PP +Alternatively, you can use /usr/bin/env to locate tclsh on the path, +like this: +.PP +.CS +\fB#!/usr/bin/env tclsh\fR +.CE +.PP +That has the advantages of being succinct and simple, but the +disadvantage of not being flexible in the face of varying names for +the binary. .SH "VARIABLES" .PP \fBTclsh\fR sets the following global Tcl variables in addition to those diff --git a/doc/timerate.n b/doc/timerate.n index 5d49c86..f5f960c 100644 --- a/doc/timerate.n +++ b/doc/timerate.n @@ -11,11 +11,11 @@ .SH NAME timerate \- Calibrated performance measurements of script execution time .SH SYNOPSIS +.nf \fBtimerate \fIscript\fR ?\fItime\fR? ?\fImax-count\fR? -.sp -\fBtimerate \fR?\fB\-direct\fR? ?\fB\-overhead\fI double\fR? \fIscript\fR ?\fItime\fR? ?\fImax-count\fR? -.sp +\fBtimerate \fR?\fB\-direct\fR? ?\fB\-overhead\fI estimate\fR? \fIscript\fR ?\fItime\fR? ?\fImax-count\fR? \fBtimerate \fR?\fB\-calibrate\fR? ?\fB\-direct\fR? \fIscript\fR ?\fItime\fR? ?\fImax-count\fR? +.fi .BE .SH DESCRIPTION .PP @@ -32,12 +32,12 @@ application performance. The first and second form will evaluate \fIscript\fR until the interval \fItime\fR given in milliseconds elapses, or for 1000 milliseconds (1 second) if \fItime\fR is not specified. -.sp +.PP The parameter \fImax-count\fR could additionally impose a further restriction by the maximal number of iterations to evaluate the script. If \fImax-count\fR is specified, the evaluation will stop either this count of iterations is reached or the time is exceeded. -.sp +.PP It will then return a canonical Tcl-list of the form: .PP .CS @@ -66,12 +66,13 @@ for future invocations of the \fBtimerate\fR command. If the \fItime\fR parameter is not specified, the calibrate procedure runs for up to 10 seconds. .RS .PP -Note that calibration is not thread safe in the current implementation. +Note that the calibration process is not thread safe in the current implementation. .RE .TP -\fB\-overhead \fIdouble\fR +\fB\-overhead \fIestimate\fR . -The \fB\-overhead\fR parameter supplies an estimate (in microseconds) of the +The \fB\-overhead\fR parameter supplies an estimate (in microseconds, which may +be a floating point number) of the measurement overhead of each iteration of the tested script. This quantity will be subtracted from the measured time prior to reporting results. This can be useful for removing the cost of interpreter state reset commands from the diff --git a/doc/upvar.n b/doc/upvar.n index 55632d1..6543be8 100644 --- a/doc/upvar.n +++ b/doc/upvar.n @@ -14,7 +14,6 @@ upvar \- Create link to variable in a different stack frame .SH SYNOPSIS \fBupvar \fR?\fIlevel\fR? \fIotherVar myVar \fR?\fIotherVar myVar \fR...? .BE - .SH DESCRIPTION .PP This command arranges for one or more local variables in the current diff --git a/doc/zipfs.3 b/doc/zipfs.3 index 0418acd..18b9ea5 100644 --- a/doc/zipfs.3 +++ b/doc/zipfs.3 @@ -14,7 +14,7 @@ TclZipfs_AppHook, TclZipfs_Mount, TclZipfs_MountBuffer, TclZipfs_Unmount \- hand .SH SYNOPSIS .nf const char * -\fBTclZipfs_AppHook(\fIargcPtr, argvPtr\fR) +\fBTclZipfs_AppHook\fR(\fIargcPtr, argvPtr\fR) .sp int \fBTclZipfs_Mount\fR(\fIinterp, zipname, mountpoint, password\fR) diff --git a/doc/zipfs.n b/doc/zipfs.n index b7bcab1..520c11b 100644 --- a/doc/zipfs.n +++ b/doc/zipfs.n @@ -15,7 +15,7 @@ zipfs \- Mount and work with ZIP files within Tcl .SH SYNOPSIS .nf \fBpackage require tcl::zipfs \fR?\fB1.0\fR? -.sp + \fBzipfs canonical\fR ?\fImntpnt\fR? \fIfilename\fR ?\fIZIPFS\fR? \fBzipfs exists\fI filename\fR \fBzipfs find\fI directoryName\fR -- cgit v0.12 From 785abcfc3ad99e86993befbced53fe3c3059d1b3 Mon Sep 17 00:00:00 2001 From: oehhar Date: Mon, 22 Jan 2024 14:26:21 +0000 Subject: Doc of Tcl_AppendToObj: Document NULL data argument behaviour and buffer growth optimization. --- doc/StringObj.3 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/doc/StringObj.3 b/doc/StringObj.3 index e569e62..0568d5a 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -221,12 +221,16 @@ to bytes) in the string value. \fBTcl_AppendToObj\fR appends the data given by \fIbytes\fR and \fIlength\fR to the string representation of the value specified by \fIobjPtr\fR. If the value has an invalid string representation, -then an attempt is made to convert \fIbytes\fR is to the Unicode +then an attempt is made to convert \fIbytes\fR to the Unicode format. If the conversion is successful, then the converted form of \fIbytes\fR is appended to the value's Unicode representation. Otherwise, the value's Unicode representation is invalidated and converted to the UTF format, and \fIbytes\fR is appended to the value's new string representation. +\fIlength\fR bytes are allocated and not filled, if \fIbytes\fR is a +null pointer. +Eventually buffer growth is optimized by large allocations to optimize +multiple calls. .PP \fBTcl_AppendUnicodeToObj\fR appends the Unicode string given by \fIunicode\fR and \fInumChars\fR to the value specified by -- cgit v0.12 From 3c748667c71e566793f3a86b6e988d000952cd9b Mon Sep 17 00:00:00 2001 From: oehhar Date: Mon, 22 Jan 2024 15:07:33 +0000 Subject: [db4f2843cd],[da16d15574]: revert Tcl_ReadChars fix, due to performance impact. --- generic/tclIO.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 0153646..0f79f1e 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -6112,7 +6112,7 @@ ReadChars( int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR; (void) TclGetStringFromObj(objPtr, &numBytes); - Tcl_SetObjLength(objPtr, numBytes + dstLimit); + Tcl_AppendToObj(objPtr, NULL, dstLimit); if (toRead == srcLen) { unsigned int size; -- cgit v0.12 From 36303748ad11c49eb94ff612665c57407b021098 Mon Sep 17 00:00:00 2001 From: oehhar Date: Tue, 23 Jan 2024 08:35:57 +0000 Subject: Doc of Tcl_AppendToObj: Remove documentation of NULL data argument as this is an internal feature --- doc/StringObj.3 | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/doc/StringObj.3 b/doc/StringObj.3 index 0568d5a..aea8d62 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -227,9 +227,7 @@ format. If the conversion is successful, then the converted form of Otherwise, the value's Unicode representation is invalidated and converted to the UTF format, and \fIbytes\fR is appended to the value's new string representation. -\fIlength\fR bytes are allocated and not filled, if \fIbytes\fR is a -null pointer. -Eventually buffer growth is optimized by large allocations to optimize +Eventually buffer growth is done by large allocations to optimize multiple calls. .PP \fBTcl_AppendUnicodeToObj\fR appends the Unicode string given by -- cgit v0.12 From fb959134d9212901e350e0c651f4f463d6fb2cf9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 24 Jan 2024 20:46:04 +0000 Subject: Backport doc/eval.n from 9.0, and fix missing .CE --- doc/eval.n | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/doc/eval.n b/doc/eval.n index 9fc2ae4..448a459 100644 --- a/doc/eval.n +++ b/doc/eval.n @@ -23,7 +23,14 @@ fashion as the \fBconcat\fR command, passes the concatenated string to the Tcl interpreter recursively, and returns the result of that evaluation (or any error generated by it). Note that the \fBlist\fR command quotes sequences of words in such a -way that they are not further expanded by the \fBeval\fR command. +way that they are not further expanded by the \fBeval\fR command; +for \fIany\fR values, $a, $b, and $c, these two lines are effectively +equivalent: +.PP +.CS +\fBeval\fR [list $a $b $c] +$a $b $c +.CE .SH EXAMPLES .PP Often, it is useful to store a fragment of a script in a variable and @@ -74,6 +81,12 @@ However, the last line would now normally be written without .CS set var [linsert $var 0 {*}$args] .CE +.PP +or indeed like this: +.PP +.CS +set var [list {*}$args {*}$var] +.CE .SH "SEE ALSO" catch(n), concat(n), error(n), errorCode(n), errorInfo(n), interp(n), list(n), namespace(n), subst(n), uplevel(n) -- cgit v0.12 From 9eca2e18dc0ac838ea8b00f5e2294606c2c89419 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 25 Jan 2024 17:42:32 +0000 Subject: Add script I've used to find spelling errors in docs --- tools/findDocWords.tcl | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) create mode 100644 tools/findDocWords.tcl diff --git a/tools/findDocWords.tcl b/tools/findDocWords.tcl new file mode 100644 index 0000000..2b585d5 --- /dev/null +++ b/tools/findDocWords.tcl @@ -0,0 +1,38 @@ +lassign $argv dir dictionary + +set f [open $dictionary] +while {[gets $f line] > 0} { + dict set realWord [string tolower $line] yes +} +close $f +puts "loaded [dict size $realWord] words from dictionary" + +set files [glob -directory $dir {*.[13n]}] +set found {} + +proc identifyWords {fragment filename} { + global realWord found + foreach frag [split [string map {\\fB "" \\fR "" \\fI "" \\fP "" \\0 _} $fragment] _] { + if {[string is entier $frag]} continue + set frag [string trim $frag "\\0123456789"] + if {$frag eq ""} continue + foreach word [regexp -all -inline {^[a-z]+|[A-Z][a-z]*} $frag] { + set word [string tolower $word] + if {![dict exists $realWord $word]} { + dict lappend found $word $filename + } + } + } +} + +foreach fn $files { + set f [open $fn] + foreach word [regexp -all -inline {[\\\w]+} [read $f]] { + identifyWords $word $fn + } + close $f +} +set len [tcl::mathfunc::max {*}[lmap word [dict keys $found] {string length $word}]] +foreach word [lsort [dict keys $found]] { + puts [format "%-${len}s: %s" $word [lindex [dict get $found $word] 0]] +} -- cgit v0.12 From 271b2f228b1f51f0b9b7d202941cb64e1927be9d Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 25 Jan 2024 17:45:17 +0000 Subject: Another round of small fixes, especially spelling errors... --- doc/AddErrInfo.3 | 9 +- doc/Alloc.3 | 2 +- doc/ByteArrObj.3 | 4 +- doc/CallDel.3 | 3 +- doc/CrtChannel.3 | 3 +- doc/CrtCommand.3 | 6 +- doc/CrtObjCmd.3 | 3 +- doc/DoOneEvent.3 | 18 +-- doc/DoWhenIdle.3 | 2 +- doc/DoubleObj.3 | 3 +- doc/Encoding.3 | 23 +-- doc/Ensemble.3 | 1 + doc/Exit.3 | 15 +- doc/FileSystem.3 | 20 +-- doc/GetCwd.3 | 2 +- doc/GetIndex.3 | 2 +- doc/GetTime.3 | 4 +- doc/Hash.3 | 2 +- doc/Init.3 | 7 +- doc/NRE.3 | 2 +- doc/Notifier.3 | 9 +- doc/Object.3 | 9 +- doc/ObjectType.3 | 49 ++---- doc/OpenFileChnl.3 | 2 +- doc/OpenTcp.3 | 2 +- doc/ParseArgs.3 | 48 ++---- doc/ParseCmd.3 | 46 ++---- doc/RegConfig.3 | 9 +- doc/RegExp.3 | 22 ++- doc/SetVar.3 | 5 + doc/StdChannels.3 | 15 +- doc/StringObj.3 | 3 +- doc/Tcl.n | 9 ++ doc/TclZlib.3 | 28 +--- doc/TraceCmd.3 | 2 + doc/TraceVar.3 | 8 + doc/UniCharIsAlpha.3 | 22 ++- doc/WrongNumArgs.3 | 2 +- doc/after.n | 2 +- doc/binary.n | 9 +- doc/cd.n | 1 + doc/chan.n | 51 +++--- doc/classvariable.n | 4 +- doc/clock.n | 212 +++++++------------------ doc/configurable.n | 3 + doc/cookiejar.n | 28 ++-- doc/define.n | 11 +- doc/dict.n | 2 + doc/encoding.n | 30 ++-- doc/eval.n | 1 + doc/exec.n | 3 + doc/expr.n | 37 ++--- doc/fconfigure.n | 36 ++--- doc/fcopy.n | 30 ++-- doc/file.n | 52 +++++-- doc/filename.n | 14 ++ doc/for.n | 2 +- doc/format.n | 61 +++----- doc/fpclassify.n | 20 +-- doc/glob.n | 27 ++-- doc/history.n | 4 +- doc/http.n | 427 +++++++++++++++++++-------------------------------- doc/info.n | 83 +++++----- doc/interp.n | 37 ++++- doc/load.n | 2 +- doc/lrange.n | 3 +- doc/lrepeat.n | 4 +- doc/lsearch.n | 20 +++ doc/lsort.n | 20 ++- doc/msgcat.n | 208 +++++++++++++++++-------- doc/my.n | 6 +- doc/namespace.n | 21 ++- doc/next.n | 8 +- doc/open.n | 178 ++++++++------------- doc/package.n | 20 +-- doc/packagens.n | 8 + doc/pkgMkIndex.n | 10 ++ doc/platform.n | 6 +- doc/platform_shell.n | 6 +- doc/prefix.n | 15 +- doc/proc.n | 8 +- doc/process.n | 10 +- doc/re_syntax.n | 146 ++++++------------ doc/read.n | 9 +- doc/refchan.n | 12 +- doc/regexp.n | 19 ++- doc/registry.n | 36 ++--- doc/regsub.n | 20 ++- doc/return.n | 9 +- doc/safe.n | 32 ++-- doc/scan.n | 55 ++----- doc/seek.n | 12 +- doc/set.n | 3 +- doc/singleton.n | 4 +- doc/socket.n | 25 ++- doc/source.n | 3 +- doc/string.n | 15 +- doc/subst.n | 3 +- doc/switch.n | 17 +- doc/tclsh.1 | 6 + doc/tcltest.n | 140 ++++++++--------- doc/tclvars.n | 49 ++---- doc/timerate.n | 31 ++-- doc/trace.n | 16 ++ doc/transchan.n | 8 +- doc/unload.n | 13 +- doc/uplevel.n | 3 +- doc/vwait.n | 17 +- doc/while.n | 2 +- doc/zipfs.3 | 2 +- doc/zipfs.n | 20 +-- doc/zlib.n | 89 ++++------- 112 files changed, 1400 insertions(+), 1577 deletions(-) diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3 index 21b75cb..05b20b8 100644 --- a/doc/AddErrInfo.3 +++ b/doc/AddErrInfo.3 @@ -71,11 +71,14 @@ Last \fIelement\fR argument must be NULL. .AP int lineNum The line number of a script where an error occurred. .AP "const char" *script in -Pointer to first character in script containing command (must be <= command) +Pointer to first character in script containing command +(must be <= \fIcommand\fR). .AP "const char" *command in -Pointer to first character in command that generated the error +Pointer to first character in the command that generated the error; must +point within the string given by \fIscript\fR. .AP Tcl_Size commandLength in -Number of bytes in command; a negative value means use all bytes up to first null byte +Number of bytes in command; a negative value means use all bytes up to the +first null byte. .BE .SH DESCRIPTION .PP diff --git a/doc/Alloc.3 b/doc/Alloc.3 index bed6d83..493eebc 100644 --- a/doc/Alloc.3 +++ b/doc/Alloc.3 @@ -72,7 +72,7 @@ When a module or Tcl itself is compiled with \fBTCL_MEM_DEBUG\fR defined, the procedures \fBTcl_Alloc\fR, \fBTcl_Free\fR, \fBTcl_Realloc\fR, \fBTcl_AttemptAlloc\fR, and \fBTcl_AttempRealloc\fR are implemented as macros, redefined to be special debugging versions of these procedures. - +.PP \fBTcl_GetMemoryInfo\fR appends a list-of-lists of memory stats to the provided DString. This function cannot be used in stub-enabled extensions, and it is only available if Tcl is compiled with the threaded memory allocator diff --git a/doc/ByteArrObj.3 b/doc/ByteArrObj.3 index 174bbc0..ae1a79c 100644 --- a/doc/ByteArrObj.3 +++ b/doc/ByteArrObj.3 @@ -63,7 +63,7 @@ a finite byte sequence. A byte is an 8-bit quantity with no inherent meaning. When the 8 bits are interpreted as an integer value, the range of possible values is (0-255). The C type best suited to store a byte is the \fBunsigned char\fR. -An \fBunsigned char\fR array of size \fIN\fR stores an aribtrary binary +An \fBunsigned char\fR array of size \fIN\fR stores an arbitrary binary value of size \fIN\fR bytes. We call this representation a byte-array. Here we document the routines that allow us to operate on Tcl values as byte-arrays. @@ -126,7 +126,7 @@ way \fBTcl_GetByteArrayFromObj\fR functioned in Tcl 8. \fBTcl_GetBytesFromObj\fR is the more capable interface and should usually be favored for use over \fBTcl_GetByteArrayFromObj\fR. .PP -On success, both \fBTcl_GetByteFromObj\fR and \fBTcl_GetByteArrayFromObj\fR +On success, both \fBTcl_GetBytesFromObj\fR and \fBTcl_GetByteArrayFromObj\fR return a pointer into the internal representation of a \fBTcl_Obj\fR. That pointer must not be freed by the caller, and should not be retained for use beyond the known time the internal representation of the value diff --git a/doc/CallDel.3 b/doc/CallDel.3 index 7d65154..418998e 100644 --- a/doc/CallDel.3 +++ b/doc/CallDel.3 @@ -61,7 +61,8 @@ If there is no deletion callback that matches \fIinterp\fR, .PP Note that if the callback is being used to delete a resource that \fImust\fR be released on exit, \fBTcl_CreateExitHandler\fR should be used to ensure that -a callback is received even if the application terminates without deleting the interpreter. +a callback is received even if the application terminates without deleting the +interpreter. .SH "SEE ALSO" Tcl_CreateExitHandler(3), Tcl_CreateThreadExitHandler(3) .SH KEYWORDS diff --git a/doc/CrtChannel.3 b/doc/CrtChannel.3 index cbeb9da..3c622f2 100644 --- a/doc/CrtChannel.3 +++ b/doc/CrtChannel.3 @@ -316,7 +316,7 @@ details about the old structure. The \fBTcl_ChannelType\fR structure contains the following fields: .PP .CS -typedef struct Tcl_ChannelType { +typedef struct { const char *\fItypeName\fR; Tcl_ChannelTypeVersion \fIversion\fR; void *\fIcloseProc\fR; /* Not used any more*/ @@ -373,7 +373,6 @@ This value can be retrieved with \fBTcl_ChannelName\fR, which returns a pointer to the string. .SS VERSION .PP - The \fIversion\fR field should be set to the version of the structure that you require. \fBTCL_CHANNEL_VERSION_5\fR is the minimum supported. .PP diff --git a/doc/CrtCommand.3 b/doc/CrtCommand.3 index f88e4f0..d15a920 100644 --- a/doc/CrtCommand.3 +++ b/doc/CrtCommand.3 @@ -26,7 +26,7 @@ Name of command. .AP Tcl_CmdProc *proc in Implementation of new command: \fIproc\fR will be called whenever \fIcmdName\fR is invoked as a command. -.AP voie *clientData in +.AP void *clientData in Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR. .AP Tcl_CmdDeleteProc *deleteProc in Procedure to call before \fIcmdName\fR is deleted from the interpreter; @@ -93,11 +93,11 @@ the command name) and \fIargv\fR giving the values of the arguments as strings. The \fIargv\fR array will contain \fIargc\fR+1 values; the first \fIargc\fR values point to the argument strings, and the last value is NULL. +.PP Note that the argument strings should not be modified as they may point to constant strings or may be shared with other parts of the interpreter. -.PP -Note that the argument strings are encoded in normalized UTF-8 since +Note also that the argument strings are encoded in normalized UTF-8 since version 8.1 of Tcl. .PP \fIProc\fR must return an integer code that is expected to be one of diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3 index 57eaf8e..522f903 100644 --- a/doc/CrtObjCmd.3 +++ b/doc/CrtObjCmd.3 @@ -294,8 +294,7 @@ Note that \fBTcl_SetCommandInfo\fR and \fBTcl_SetCommandInfoFromToken\fR both allow the clientData for a command's deletion procedure to be given a different value than the clientData for its command procedure. -.PP -Note that neither \fBTcl_SetCommandInfo\fR nor +Note also that neither \fBTcl_SetCommandInfo\fR nor \fBTcl_SetCommandInfoFromToken\fR will change a command's namespace. Use \fBTcl_Eval\fR to call the \fBrename\fR command to do that. .PP diff --git a/doc/DoOneEvent.3 b/doc/DoOneEvent.3 index e515328..b14f2e1 100644 --- a/doc/DoOneEvent.3 +++ b/doc/DoOneEvent.3 @@ -54,24 +54,18 @@ If the \fIflags\fR argument to \fBTcl_DoOneEvent\fR is non-zero, it restricts the kinds of events that will be processed by \fBTcl_DoOneEvent\fR. \fIFlags\fR may be an OR-ed combination of any of the following bits: -.TP 27 -\fBTCL_WINDOW_EVENTS\fR \- +.IP \fBTCL_WINDOW_EVENTS\fR Process window system events. -.TP 27 -\fBTCL_FILE_EVENTS\fR \- +.IP \fBTCL_FILE_EVENTS\fR Process file events. -.TP 27 -\fBTCL_TIMER_EVENTS\fR \- +.IP \fBTCL_TIMER_EVENTS\fR Process timer events. -.TP 27 -\fBTCL_IDLE_EVENTS\fR \- +.IP \fBTCL_IDLE_EVENTS\fR Process idle callbacks. -.TP 27 -\fBTCL_ALL_EVENTS\fR \- +.IP \fBTCL_ALL_EVENTS\fR Process all kinds of events: equivalent to OR-ing together all of the above flags or specifying none of them. -.TP 27 -\fBTCL_DONT_WAIT\fR \- +.IP \fBTCL_DONT_WAIT\fR Do not sleep: process only events that are ready at the time of the call. .LP diff --git a/doc/DoWhenIdle.3 b/doc/DoWhenIdle.3 index aed3a4a..f342820 100644 --- a/doc/DoWhenIdle.3 +++ b/doc/DoWhenIdle.3 @@ -22,7 +22,7 @@ Tcl_DoWhenIdle, Tcl_CancelIdleCall \- invoke a procedure when there are no pendi .AS Tcl_IdleProc clientData .AP Tcl_IdleProc *proc in Procedure to invoke. -.AP coid *clientData in +.AP void *clientData in Arbitrary one-word value to pass to \fIproc\fR. .BE .SH DESCRIPTION diff --git a/doc/DoubleObj.3 b/doc/DoubleObj.3 index c4db52c..4696cc3 100644 --- a/doc/DoubleObj.3 +++ b/doc/DoubleObj.3 @@ -74,4 +74,5 @@ is holding a reference to the object, it will be deleted. .SH "SEE ALSO" Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult .SH KEYWORDS -double, double value, double type, internal representation, value, value type, string representation +double, double value, double type, internal representation, value, value type, +string representation diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 2759ec7..9e5ae06 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -219,12 +219,12 @@ be used to specify the profile to be used for the transform. The ignored as the function assumes the entire source string to be decoded is passed into the function. On success, the function returns \fBTCL_OK\fR with the converted string stored in \fB*dstPtr\fR. For errors \fIother than conversion -errors\fR, such as invalid flags, the function returns \fBTCL_ERROR\fR with an error -message in \fBinterp\fR if it is not NULL. +errors\fR, such as invalid flags, the function returns \fBTCL_ERROR\fR with an +error message in \fBinterp\fR if it is not NULL. For conversion errors, \fBTcl_ExternalToUtfDStringEx\fR returns one of the \fBTCL_CONVERT_*\fR errors listed below for \fBTcl_ExternalToUtf\fR. -When one of these conversion errors is returned, an error message is -stored in \fBinterp\fR only if \fBerrorIdxPtr\fR is NULL. Otherwise, no error message +When one of these conversion errors is returned, an error message is stored +in \fBinterp\fR only if \fBerrorIdxPtr\fR is NULL. Otherwise, no error message is stored as the function expects the caller is interested the decoded data up to that point and not treating this as an immediate error condition. The index of the error location is stored in \fB*errorIdxPtr\fR. @@ -253,8 +253,8 @@ the unconverted bytes that remained in \fIsrc\fR plus some further bytes from the source stream to properly convert the formerly split-up multibyte sequence. .IP \fBTCL_CONVERT_SYNTAX\fR 29 -The source buffer contained an invalid byte or character sequence. This may occur -if the input stream has been damaged or if the input encoding method was +The source buffer contained an invalid byte or character sequence. This may +occur if the input stream has been damaged or if the input encoding method was misidentified. .IP \fBTCL_CONVERT_UNKNOWN\fR 29 The source buffer contained a character that could not be represented in @@ -271,11 +271,12 @@ encoding, a default fallback character will be used. The return value is a pointer to the value stored in the DString. .PP \fBTcl_UtfToExternalDStringEx\fR is an enhanced version of -\fBTcl_UtfToExternalDString\fR that transforms UTF-8 encoded source data to a specified -\fIencoding\fR. Except for the direction of the transform, the parameters and -return values are identical to those of \fBTcl_ExternalToUtfDStringEx\fR. See +\fBTcl_UtfToExternalDString\fR that transforms UTF-8 encoded source data to a +specified \fIencoding\fR. Except for the direction of the transform, the +parameters and return values are identical to those of +\fBTcl_ExternalToUtfDStringEx\fR. See that function above for details about the same. - +.PP Irrespective of the return code from the function, the caller must free resources associated with \fB*dstPtr\fR when the function returns. .PP @@ -339,7 +340,7 @@ about the name of the encoding and the procedures that will be called to convert between this encoding and UTF-8. It is defined as follows: .PP .CS -typedef struct Tcl_EncodingType { +typedef struct { const char *\fIencodingName\fR; Tcl_EncodingConvertProc *\fItoUtfProc\fR; Tcl_EncodingConvertProc *\fIfromUtfProc\fR; diff --git a/doc/Ensemble.3 b/doc/Ensemble.3 index 0dfaa01..0c2ea9d 100644 --- a/doc/Ensemble.3 +++ b/doc/Ensemble.3 @@ -162,6 +162,7 @@ All command names in prefixes set via \fBTcl_SetEnsembleMappingDict\fR must be fully qualified. .TP \fBformal pre-subcommand parameter list\fR (read-write) +. A list of formal parameter names (the names only being used when generating error messages) that come at invocation of the ensemble between the name of the ensemble and the subcommand argument. NULL (the default) is equivalent to diff --git a/doc/Exit.3 b/doc/Exit.3 index a1d0694..d791f60 100644 --- a/doc/Exit.3 +++ b/doc/Exit.3 @@ -36,8 +36,8 @@ Tcl_ExitProc * .AS Tcl_ExitProc clientData .AP int status in Provides information about why the application or thread exited. -Exact meaning may -be platform-specific. 0 usually means a normal exit, any nonzero value +Exact meaning may be platform-specific. +0 usually means a normal exit, any nonzero value usually means that an error occurred. .AP Tcl_ExitProc *proc in Procedure to invoke before exiting application, or (for @@ -54,14 +54,14 @@ execution of a \fBTcl\fR application. Exit handlers are invoked to cleanup the application's state before ending the execution of \fBTcl\fR code. .PP Invoke \fBTcl_Exit\fR to end a \fBTcl\fR application and to exit from this -process. This procedure is invoked by the \fBexit\fR command, and can be +process. This procedure is invoked by the \fBexit\fR Tcl command, and can be invoked anyplace else to terminate the application. -No-one should ever invoke the \fBexit\fR system procedure directly; always +No-one should ever invoke the \fBexit()\fR system call directly; always invoke \fBTcl_Exit\fR instead, so that it can invoke exit handlers. -Note that if other code invokes \fBexit\fR system procedure directly, or +Note that if other code invokes \fBexit()\fR system call directly, or otherwise causes the application to terminate without calling \fBTcl_Exit\fR, the exit handlers will not be run. -\fBTcl_Exit\fR internally invokes the \fBexit\fR system call, thus it never +\fBTcl_Exit\fR internally invokes the \fBexit()\fR system call, thus it never returns control to its caller. If an application exit handler has been installed (see \fBTcl_SetExitProc\fR), that handler is invoked with an argument @@ -140,4 +140,5 @@ cast to a void *value. .SH "SEE ALSO" exit(n) .SH KEYWORDS -abort, callback, cleanup, dynamic loading, end application, exit, unloading, thread +abort, callback, cleanup, dynamic loading, end application, exit, unloading, +thread diff --git a/doc/FileSystem.3 b/doc/FileSystem.3 index 255606c..b6c6d1e 100644 --- a/doc/FileSystem.3 +++ b/doc/FileSystem.3 @@ -377,7 +377,8 @@ variable to the POSIX error code (which signifies a .QW "cross-domain link" ). .PP -\fBTcl_FSCopyDirectory\fR attempts to copy the directory given by \fIsrcPathPtr\fR to the +\fBTcl_FSCopyDirectory\fR attempts to copy the directory given by +\fIsrcPathPtr\fR to the path name given by \fIdestPathPtr\fR. If the two paths given lie in the same filesystem (according to \fBTcl_FSGetFileSystemForPath\fR) then that filesystem's @@ -487,8 +488,9 @@ is a Tcl_Obj specifying the contents of the symbolic link given by \fIlinkNamePtr\fR, or NULL if the link could not be read. The result is owned by the caller, which should call \fBTcl_DecrRefCount\fR when the result is no longer needed. If the \fItoPtr\fR is not NULL, Tcl should create a link -of one of the types passed in in the \fIlinkAction\fR flag. This flag is -an OR'ed combination of \fBTCL_CREATE_SYMBOLIC_LINK\fR and \fBTCL_CREATE_HARD_LINK\fR. +of one of the types passed in in the \fIlinkAction\fR flag. +This flag is an OR'ed combination of \fBTCL_CREATE_SYMBOLIC_LINK\fR +and \fBTCL_CREATE_HARD_LINK\fR. Where a choice exists (i.e.\ more than one flag is passed in), the Tcl convention is to prefer symbolic links. When a link is successfully created, the return value should be \fItoPtr\fR (which is therefore @@ -841,7 +843,7 @@ longer be correct. The \fBTcl_Filesystem\fR structure contains the following fields: .PP .CS -typedef struct Tcl_Filesystem { +typedef struct { const char *\fItypeName\fR; Tcl_Size \fIstructureLength\fR; Tcl_FSVersion \fIversion\fR; @@ -1254,7 +1256,7 @@ The \fBTcl_GlobTypeData\fR structure passed in the \fItypes\fR parameter contains the following fields: .PP .CS -typedef struct Tcl_GlobTypeData { +typedef struct { /* Corresponds to bcdpfls as in 'find -t' */ int \fItype\fR; /* Corresponds to file permissions */ @@ -1382,10 +1384,10 @@ typedef int \fBTcl_FSFileAttrsGetProc\fR( .PP Returns a standard Tcl return code. The attribute value retrieved, which corresponds to the \fIindex\fR'th element in the list returned by -the \fBTcl_FSFileAttrStringsProc\fR, is a Tcl_Obj placed in \fIobjPtrRef\fR (if -\fBTCL_OK\fR was returned) and is likely to have a reference count of zero. Either -way we must either store it somewhere (e.g.\ the Tcl result), or -Incr/Decr its reference count to ensure it is properly freed. +the \fBTcl_FSFileAttrStringsProc\fR, is a Tcl_Obj placed in \fIobjPtrRef\fR +(if \fBTCL_OK\fR was returned) and is likely to have a reference count of +zero. Either way we must either store it somewhere (e.g.\ the Tcl result), +or Incr/Decr its reference count to ensure it is properly freed. .SS FILEATTRSSETPROC .PP Function to process a \fBTcl_FSFileAttrsSet\fR call, used by \fBfile diff --git a/doc/GetCwd.3 b/doc/GetCwd.3 index 26bc691..b901098 100644 --- a/doc/GetCwd.3 +++ b/doc/GetCwd.3 @@ -47,7 +47,7 @@ The format of the path is UTF\-8. .PP \fBTcl_Chdir\fR changes the applications current working directory to the value specified in \fIdirName\fR. The format of the passed in string -must be UTF\-8. The function returns -1 on error or 0 on success. +must be UTF\-8. The function returns \-1 on error or 0 on success. .SH KEYWORDS pwd diff --git a/doc/GetIndex.3 b/doc/GetIndex.3 index 4dcee45..deb77fe 100644 --- a/doc/GetIndex.3 +++ b/doc/GetIndex.3 @@ -90,7 +90,7 @@ the table and the index of the matching entry. If \fBTcl_GetIndexFromObj\fR is invoked again with the same \fIobjPtr\fR and \fItablePtr\fR arguments (e.g. during a reinvocation of a Tcl command), it returns the matching index immediately without having to redo the lookup -operation. Note: \fBTcl_GetIndexFromObj\fR assumes that the entries +operation. Note that \fBTcl_GetIndexFromObj\fR assumes that the entries in \fItablePtr\fR are static: they must not change between invocations. This caching mechanism can be disallowed by specifying the \fBTCL_INDEX_TEMP_TABLE\fR flag. diff --git a/doc/GetTime.3 b/doc/GetTime.3 index 9f898e4..ff302e5 100644 --- a/doc/GetTime.3 +++ b/doc/GetTime.3 @@ -44,7 +44,7 @@ The \fBTcl_GetTime\fR function retrieves the current time as a structure has the following definition: .PP .CS -typedef struct Tcl_Time { +typedef struct { long long \fIsec\fR; long \fIusec\fR; } \fBTcl_Time\fR; @@ -53,7 +53,7 @@ typedef struct Tcl_Time { On return, the \fIsec\fR member of the structure is filled in with the number of seconds that have elapsed since the \fIepoch:\fR the epoch is the point in time of 00:00 UTC, 1 January 1970. This number does -\fInot\fR count leap seconds \- an interval of one day advances it by +\fInot\fR count leap seconds; an interval of one day advances it by 86400 seconds regardless of whether a leap second has been inserted. .PP The \fIusec\fR member of the structure is filled in with the number of diff --git a/doc/Hash.3 b/doc/Hash.3 index dced52f..e4567a5 100644 --- a/doc/Hash.3 +++ b/doc/Hash.3 @@ -242,7 +242,7 @@ calling \fBTcl_InitCustomHashTable\fR. The \fBTcl_HashKeyType\fR structure is defined as follows: .PP .CS -typedef struct Tcl_HashKeyType { +typedef struct { int \fIversion\fR; int \fIflags\fR; Tcl_HashKeyProc *\fIhashKeyProc\fR; diff --git a/doc/Init.3 b/doc/Init.3 index 575a39d..03e0c97 100644 --- a/doc/Init.3 +++ b/doc/Init.3 @@ -39,13 +39,12 @@ A value of \fINULL\fR may be passed to not register any script. The pre-initialization script is executed by \fBTcl_Init\fR before accessing the file system. The purpose is to typically prepare a custom file system (like an embedded zip-file) to be activated before the search. - +.PP When used in stub-enabled embedders, the stubs table must be first initialized -using one of \fBTcl_InitSubsystems\fR, \fBTcl_SetPanicProc\fR, \fBTcl_FindExecutable\fR +using one of \fBTcl_InitSubsystems\fR, \fBTcl_SetPanicProc\fR, +\fBTcl_FindExecutable\fR or \fBTclZipfs_AppHook\fR before \fBTcl_SetPreInitScript\fR may be called. - .SH "SEE ALSO" Tcl_AppInit, Tcl_Main - .SH KEYWORDS application, initialization, interpreter diff --git a/doc/NRE.3 b/doc/NRE.3 index bf757c3..2bf2698 100644 --- a/doc/NRE.3 +++ b/doc/NRE.3 @@ -157,7 +157,7 @@ the routine. .SH EXAMPLE .PP The following command uses \fBTcl_EvalObjEx\fR, which consumes space on the C -stack, to evalute a script: +stack, to evaluate a script: .PP .CS int diff --git a/doc/Notifier.3 b/doc/Notifier.3 index 8041dd8..6aab2e2 100644 --- a/doc/Notifier.3 +++ b/doc/Notifier.3 @@ -255,7 +255,7 @@ a structure that describes a time interval in seconds and microseconds: .PP .CS -typedef struct Tcl_Time { +typedef struct { long long \fIsec\fR; long \fIusec\fR; } \fBTcl_Time\fR; @@ -317,7 +317,7 @@ structure is used when communicating between the event source and the rest of the notifier. A \fBTcl_Event\fR has the following definition: .PP .CS -typedef struct { +typedef struct Tcl_Event { Tcl_EventProc *\fIproc\fR; struct Tcl_Event *\fInextPtr\fR; } \fBTcl_Event\fR; @@ -533,7 +533,7 @@ passing a pointer to a \fBTcl_NotifierProcs\fR data structure. The structure has the following layout: .PP .CS -typedef struct Tcl_NotifierProcs { +typedef struct { Tcl_SetTimerProc *\fIsetTimerProc\fR; Tcl_WaitForEventProc *\fIwaitForEventProc\fR; Tcl_CreateFileHandlerProc *\fIcreateFileHandlerProc\fR; @@ -616,4 +616,5 @@ mode. Tcl_CreateFileHandler(3), Tcl_DeleteFileHandler(3), Tcl_Sleep(3), Tcl_DoOneEvent(3), Thread(3) .SH KEYWORDS -event, notifier, event queue, event sources, file events, timer, idle, service mode, threads +event, notifier, event queue, event sources, file events, timer, idle, +service mode, threads diff --git a/doc/Object.3 b/doc/Object.3 index d14124f..0f52a51 100644 --- a/doc/Object.3 +++ b/doc/Object.3 @@ -113,7 +113,7 @@ Each Tcl value is represented by a \fBTcl_Obj\fR structure which is defined as follows. .PP .CS -typedef struct Tcl_Obj { +typedef struct { Tcl_Size \fIrefCount\fR; char *\fIbytes\fR; Tcl_Size \fIlength\fR; @@ -294,10 +294,11 @@ that the target list or dictionary be well-formed, but that is often easy to arrange when the value is being initially constructed.) The macro \fBTcl_IncrRefCount\fR increments the reference count when a new reference to the value is created. -The macro \fBTcl_DecrRefCount\fR decrements the count when a reference is no longer needed. -If the value's reference count drops to zero, frees +The macro \fBTcl_DecrRefCount\fR decrements the count when a reference +is no longer needed. If the value's reference count drops to zero, frees its storage. -The macro \fBTcl_BounceRefCount\fR will check if the value has no references (i.e. in a "new" state) and free the value. +The macro \fBTcl_BounceRefCount\fR will check if the value has no +references (i.e. in a "new" state) and free the value. A value shared by different code or data structures has \fIrefCount\fR greater than 1. Incrementing a value's reference count ensures that it will not be freed too early or have its value change diff --git a/doc/ObjectType.3 b/doc/ObjectType.3 index 3b4782d..62104a8 100644 --- a/doc/ObjectType.3 +++ b/doc/ObjectType.3 @@ -103,7 +103,7 @@ extensions to look up their Tcl_ObjType by name with the defined as follows: .PP .CS -typedef struct Tcl_ObjType { +typedef struct { const char *\fIname\fR; Tcl_FreeInternalRepProc *\fIfreeIntRepProc\fR; Tcl_DupInternalRepProc *\fIdupIntRepProc\fR; @@ -216,7 +216,6 @@ The \fIdupIntRepProc\fR member contains the address of a function called to copy an internal representation from one value to another. .PP .CS - typedef void \fBTcl_DupInternalRepProc\fR( Tcl_Obj *\fIsrcPtr\fR, Tcl_Obj *\fIdupPtr\fR); @@ -240,7 +239,6 @@ The \fIfreeIntRepProc\fR member contains the address of a function that is called when a value is freed. .PP .CS - typedef void \fBTcl_FreeInternalRepProc\fR( Tcl_Obj *\fIobjPtr\fR); .CE @@ -269,7 +267,7 @@ before the outermost current \fBTcl_DecrRefCount\fR returns. .SS "THE VERSION FIELD" .PP The \fIversion\fR member provides for future extensibility of the -structure and should be set to \fBTCL_OBJTYPE_V0\fR for compatability +structure and should be set to \fBTCL_OBJTYPE_V0\fR for compatibility of ObjType definitions prior to version 9.0. Specifics about versions will be described further in the sections below. .SH "ABSTRACT LIST TYPES" @@ -302,11 +300,9 @@ C API. The function returns the number of elements in the list. It is used in every List operation and is required for all Abstract List implementations. .CS - typedef Tcl_Size (Tcl_ObjTypeLengthProc) (Tcl_Obj *listPtr); .CE - .PP .SS "THE INDEXPROC FIELD" .PP @@ -314,9 +310,7 @@ The \fBIndexProc\fR function correlates with with the \fBTcl_ListObjIndex\fR C API. The function returns a Tcl_Obj value for the element at the specified index. .CS - -typedef int -(Tcl_ObjTypeIndexProc) ( +typedef int (\fBTcl_ObjTypeIndexProc\fR) ( Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index, @@ -326,11 +320,9 @@ typedef int .PP The \fBSliceProc\fR correlates with the \fBlrange\fR command, returning a new List or Abstract List for the portion of the original -list specifed. +list specified. .CS - -typedef int -(Tcl_ObjTypeSliceProc) ( +typedef int (\fBTcl_ObjTypeSliceProc\fR) ( Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size fromIdx, @@ -343,9 +335,7 @@ The \fBReverseProc\fR correlates with the \fBlreverse\fR command, returning a List or Abstract List that has the same elements as the input Abstract List, with the elements in the reverse order. .CS - -typedef int -(Tcl_ObjTypeReverseProc) ( +typedef int (\fBTcl_ObjTypeReverseProc\fR) ( Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj **newObjPtr); @@ -353,12 +343,10 @@ typedef int .SS "THE GETELEMENTS FIELD" .PP The \fBGetElements\fR function returns a count and a pointer to an -array of Tcl_Obj values for the entire Abstract List. This is a -correlary to the \fBTcl_ListObjGetElements\fR C API call. +array of Tcl_Obj values for the entire Abstract List. This +correlates to the \fBTcl_ListObjGetElements\fR C API call. .CS - -typedef int -(Tcl_ObjTypeGetElements) ( +typedef int (\fBTcl_ObjTypeGetElements\fR) ( Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size *objcptr, @@ -370,9 +358,7 @@ The \fBSetElement\fR function replaces the element within the specified list at the give index. This function correlates to the \fBlset\fR command. .CS - -typedef Tcl_Obj* -Tcl_ObjTypeSetElement) ( +typedef Tcl_Obj *(\fBTcl_ObjTypeSetElement\fR) ( Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size indexCount, @@ -381,13 +367,11 @@ Tcl_ObjTypeSetElement) ( .CE .SS "REPLACEPROC FIELD" .PP -The \fBReplaceProc\fR returns a new list after modfying the list +The \fBReplaceProc\fR returns a new list after modifying the list replacing the elements to be deleted, and adding the elements to be inserted. This function correlates to the \fBTcl_ListObjReplace\fR C API. .CS - -typedef int -(Tcl_ObjTypeReplaceProc) ( +typedef int (\fBTcl_ObjTypeReplaceProc\fR) ( Tcl_Interp *interp, Tcl_Obj *listObj, Tcl_Size first, @@ -395,7 +379,7 @@ typedef int Tcl_Size numToInsert, Tcl_Obj *const insertObjs[]); .CE -.SS "THE INOPERATORPROC FIELD" +.SS "THE INOPERPROC FIELD" .PP The \fBInOperProc\fR function determines whether the value is present in the given list, according to equivalent string comparison of elements. The @@ -403,9 +387,7 @@ given list, according to equivalent string comparison of elements. The (false) if it is not present. This function implements the "in" and "ni" math operators for an abstract list. .CS - -typedef int -(Tcl_ObjTypeInOperatorProc) ( +typedef int (\fBTcl_ObjTypeInOperatorProc\fR) ( Tcl_Interp *interp, Tcl_Obj *valueObj, Tcl_Obj *listObj, @@ -431,4 +413,5 @@ then those subsidiary values may have their reference counts modified. .SH "SEE ALSO" Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_BounceRefCount(3) .SH KEYWORDS -internal representation, value, value type, string representation, type conversion +internal representation, value, value type, string representation, +type conversion diff --git a/doc/OpenFileChnl.3 b/doc/OpenFileChnl.3 index db25ce2..59364e0 100644 --- a/doc/OpenFileChnl.3 +++ b/doc/OpenFileChnl.3 @@ -390,7 +390,7 @@ If the channel is being closed synchronously and an error occurs during closing of the channel and \fIinterp\fR is not NULL, an error message is left in the interpreter's result. .PP -Note: it is not safe to call \fBTcl_Close\fR on a channel that has been +Note that it is not safe to call \fBTcl_Close\fR on a channel that has been registered using \fBTcl_RegisterChannel\fR; see the documentation for \fBTcl_RegisterChannel\fR, above, for details. If the channel has ever been given as the \fBchan\fR argument in a call to diff --git a/doc/OpenTcp.3 b/doc/OpenTcp.3 index 3e62363..709a8fc 100644 --- a/doc/OpenTcp.3 +++ b/doc/OpenTcp.3 @@ -51,7 +51,7 @@ If nonzero, the client socket is connected asynchronously to the server. Length of OS listen backlog queue. Use -1 for default value. .AP "unsigned int" flags in ORed combination of \fBTCL_TCPSERVER_*\fR flags that specify additional -informations about the socket being created. +information about the socket being created. .AP void *sock in Platform-specific handle for client TCP socket. .AP Tcl_TcpAcceptProc *proc in diff --git a/doc/ParseArgs.3 b/doc/ParseArgs.3 index 7c7b08e..edc0bc0 100644 --- a/doc/ParseArgs.3 +++ b/doc/ParseArgs.3 @@ -63,20 +63,14 @@ The collection of arguments to be parsed is described by the \fIargTable\fR parameter. This points to a table of descriptor structures that is terminated by an entry with the \fItype\fR field set to TCL_ARGV_END. As convenience, the following prototypical entries are provided: -.TP -\fBTCL_ARGV_AUTO_HELP\fR -. +.IP \fBTCL_ARGV_AUTO_HELP\fR Enables the argument processor to provide help when passed the argument .QW \fB\-help\fR . -.TP -\fBTCL_ARGV_AUTO_REST\fR -. +.IP \fBTCL_ARGV_AUTO_REST\fR Instructs the argument processor that arguments after .QW \fB\-\-\fR are to be unprocessed. -.TP -\fBTCL_ARGV_TABLE_END\fR -. +.IP \fBTCL_ARGV_TABLE_END\fR Marks the end of the table of argument descriptors. .SS "ARGUMENT DESCRIPTOR ENTRIES" .PP @@ -105,27 +99,19 @@ users when they request it. As noted above, the \fItype\fR field is used to describe the interpretation of the argument's value. The following values are acceptable values for \fItype\fR: -.TP -\fBTCL_ARGV_CONSTANT\fR -. +.IP \fBTCL_ARGV_CONSTANT\fR The argument does not take any following value argument. If this argument is present, the (integer) value of the \fIsrcPtr\fR field is copied to the variable pointed to by the \fIdstPtr\fR field. The \fIclientData\fR field is ignored. -.TP -\fBTCL_ARGV_END\fR -. +.IP \fBTCL_ARGV_END\fR This value marks the end of all option descriptors in the table. All other fields are ignored. -.TP -\fBTCL_ARGV_FLOAT\fR -. +.IP \fBTCL_ARGV_FLOAT\fR This argument takes a following floating point value argument. The value (once parsed by \fBTcl_GetDoubleFromObj\fR) will be stored as a double-precision value in the variable pointed to by the \fIdstPtr\fR field. The \fIsrcPtr\fR and \fIclientData\fR fields are ignored. -.TP -\fBTCL_ARGV_FUNC\fR -. +.IP \fBTCL_ARGV_FUNC\fR This argument optionally takes a following value argument; it is up to the handler callback function passed in \fIsrcPtr\fR to decide. That function will have the following signature: @@ -144,9 +130,7 @@ argument. The \fIclientData\fR is the value from the table entry, the there are no following arguments at all, and the \fIdstPtr\fR argument to the \fBTcl_ArgvFuncProc\fR is the location to write the parsed value to. .RE -.TP -\fBTCL_ARGV_GENFUNC\fR -. +.IP \fBTCL_ARGV_GENFUNC\fR This argument takes zero or more following arguments; the handler callback function passed in \fIsrcPtr\fR returns how many (or a negative number to signal an error, in which case it should also set the interpreter result). The @@ -168,28 +152,20 @@ 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. .RE -.TP -\fBTCL_ARGV_HELP\fR -. +.IP \fBTCL_ARGV_HELP\fR This special argument does not take any following value argument, but instead causes \fBTcl_ParseArgsObjv\fR to generate an error message describing the arguments supported. All other fields except the \fIhelpStr\fR field are ignored. -.TP -\fBTCL_ARGV_INT\fR -. +.IP \fBTCL_ARGV_INT\fR This argument takes a following integer value argument. The value (once parsed by \fBTcl_GetIntFromObj\fR) will be stored as an int in the variable pointed to by the \fIdstPtr\fR field. The \fIsrcPtr\fR field is ignored. -.TP -\fBTCL_ARGV_REST\fR -. +.IP \fBTCL_ARGV_REST\fR This special argument does not take any following value argument, but instead marks all following arguments to be left unprocessed. The \fIsrcPtr\fR, \fIdstPtr\fR and \fIclientData\fR fields are ignored. -.TP -\fBTCL_ARGV_STRING\fR -. +.IP \fBTCL_ARGV_STRING\fR This argument takes a following string value argument. A pointer to the string will be stored at \fIdstPtr\fR; the string inside will have a lifetime linked to the lifetime of the string representation of the argument value that it diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index 0e2c3b4..cdce96c 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -195,7 +195,7 @@ result; it can be retrieved using \fBTcl_GetObjResult\fR. return parse information in two data structures, Tcl_Parse and Tcl_Token: .PP .CS -typedef struct Tcl_Parse { +typedef struct { const char *\fIcommentStart\fR; Tcl_Size \fIcommentSize\fR; const char *\fIcommandStart\fR; @@ -206,7 +206,7 @@ typedef struct Tcl_Parse { ... } \fBTcl_Parse\fR; -typedef struct Tcl_Token { +typedef struct { int \fItype\fR; const char *\fIstart\fR; Tcl_Size \fIsize\fR; @@ -220,8 +220,7 @@ These fields are not used by the other parsing procedures. .PP \fBTcl_ParseCommand\fR fills in a Tcl_Parse structure with information that describes one Tcl command and any comments that -precede the command. -If there are comments, +precede the command. If there are comments, the \fIcommentStart\fR field points to the \fB#\fR character that begins the first comment and \fIcommentSize\fR indicates the number of bytes in all of the comments preceding the command, including the newline @@ -251,9 +250,7 @@ such as \fBTCL_TOKEN_WORD\fR and \fBTCL_TOKEN_VARIABLE\fR, consist of several component tokens, which immediately follow the parent token; the \fInumComponents\fR field describes how many of these there are. The \fItype\fR field has one of the following values: -.TP 20 -\fBTCL_TOKEN_WORD\fR -. +.IP \fBTCL_TOKEN_WORD\fR This token ordinarily describes one word of a command but it may also describe a quoted or braced string in an expression. The token describes a component of the script that is @@ -266,42 +263,30 @@ space, semicolon, close bracket, close quote, or close brace that terminates the component. The \fInumComponents\fR field counts the total number of sub-tokens that make up the word, including sub-tokens of \fBTCL_TOKEN_VARIABLE\fR and \fBTCL_TOKEN_BS\fR tokens. -.TP -\fBTCL_TOKEN_SIMPLE_WORD\fR -. +.IP \fBTCL_TOKEN_SIMPLE_WORD\fR This token has the same meaning as \fBTCL_TOKEN_WORD\fR, except that the word is guaranteed to consist of a single \fBTCL_TOKEN_TEXT\fR sub-token. The \fInumComponents\fR field is always 1. -.TP -\fBTCL_TOKEN_EXPAND_WORD\fR -. +.IP \fBTCL_TOKEN_EXPAND_WORD\fR This token has the same meaning as \fBTCL_TOKEN_WORD\fR, except that the command parser notes this word began with the expansion prefix \fB{*}\fR, indicating that after substitution, the list value of this word should be expanded to form multiple arguments in command evaluation. This token type can only be created by Tcl_ParseCommand. -.TP -\fBTCL_TOKEN_TEXT\fR -. +.IP \fBTCL_TOKEN_TEXT\fR The token describes a range of literal text that is part of a word. The \fInumComponents\fR field is always 0. -.TP -\fBTCL_TOKEN_BS\fR -. +.IP \fBTCL_TOKEN_BS\fR The token describes a backslash sequence such as \fB\en\fR or \fB\e0xA3\fR. The \fInumComponents\fR field is always 0. -.TP -\fBTCL_TOKEN_COMMAND\fR -. +.IP \fBTCL_TOKEN_COMMAND\fR The token describes a command whose result must be substituted into the word. The token includes the square brackets that surround the command. The \fInumComponents\fR field is always 0 (the nested command is not parsed; call \fBTcl_ParseCommand\fR recursively if you want to see its tokens). -.TP -\fBTCL_TOKEN_VARIABLE\fR -. +.IP \fBTCL_TOKEN_VARIABLE\fR The token describes a variable substitution, including the \fB$\fR, variable name, and array index (if there is one) up through the close parenthesis that terminates the index. This token is followed @@ -315,9 +300,7 @@ token giving the array name and the remaining sub-tokens are \fBTCL_TOKEN_VARIABLE\fR tokens that must be concatenated to produce the array index. The \fInumComponents\fR field includes nested sub-tokens that are part of \fBTCL_TOKEN_VARIABLE\fR tokens in the array index. -.TP -\fBTCL_TOKEN_SUB_EXPR\fR -. +.IP \fBTCL_TOKEN_SUB_EXPR\fR The token describes one subexpression of an expression (or an entire expression). A subexpression may consist of a value @@ -342,9 +325,7 @@ one of the token types \fBTCL_TOKEN_WORD\fR, \fBTCL_TOKEN_TEXT\fR, The \fInumComponents\fR field counts the total number of sub-tokens that make up the subexpression; this includes the sub-tokens for any nested \fBTCL_TOKEN_SUB_EXPR\fR tokens. -.TP -\fBTCL_TOKEN_OPERATOR\fR -. +.IP \fBTCL_TOKEN_OPERATOR\fR The token describes one operator of an expression such as \fB&&\fR or \fBhypot\fR. A \fBTCL_TOKEN_OPERATOR\fR token is always preceded by a @@ -451,4 +432,5 @@ There are additional fields in the Tcl_Parse structure after the \fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR; they should not be referenced by code outside of these procedures. .SH KEYWORDS -backslash substitution, braces, command, expression, parse, token, variable substitution +backslash substitution, braces, command, expression, parse, token, +variable substitution diff --git a/doc/RegConfig.3 b/doc/RegConfig.3 index 09ae116..f2bd2e3 100644 --- a/doc/RegConfig.3 +++ b/doc/RegConfig.3 @@ -86,20 +86,23 @@ their associated values can be retrieved through calls to The command \fBpkgconfig\fR will provide two subcommands, \fBlist\fR and \fBget\fR: .RS +.\" METHOD: list .TP ::\fIpkgName\fR::\fBpkgconfig\fR list +. Returns a list containing the names of all defined keys. +.\" METHOD: get .TP ::\fIpkgName\fR::\fBpkgconfig\fR get \fIkey\fR -Returns the configuration value associated with the specified -\fIkey\fR. +. +Returns the configuration value associated with the specified \fIkey\fR. .RE .SH TCL_CONFIG .PP The \fBTcl_Config\fR structure contains the following fields: .PP .CS -typedef struct Tcl_Config { +typedef struct { const char *\fIkey\fR; const char *\fIvalue\fR; } \fBTcl_Config\fR; diff --git a/doc/RegExp.3 b/doc/RegExp.3 index 35b14a2..114bbbb 100644 --- a/doc/RegExp.3 +++ b/doc/RegExp.3 @@ -122,7 +122,7 @@ used in subsequent calls to \fBTcl_RegExpExec\fR or \fBTcl_RegExpRange\fR. If an error occurs while compiling the regular expression then \fBTcl_RegExpCompile\fR returns NULL and leaves an error message in the interpreter result. -Note: the return value from \fBTcl_RegExpCompile\fR is only valid +Note that the return value from \fBTcl_RegExpCompile\fR is only valid up to the next call to \fBTcl_RegExpCompile\fR; it is not safe to retain these values for long periods of time. .PP @@ -188,6 +188,7 @@ zero or more of the following flags that control the compilation of .RS 2 .TP \fBTCL_REG_ADVANCED\fR +. Compile advanced regular expressions .PQ ARE s . This mode corresponds to @@ -195,6 +196,7 @@ the normal regular expression syntax accepted by the Tcl \fBregexp\fR and \fBregsub\fR commands. .TP \fBTCL_REG_EXTENDED\fR +. Compile extended regular expressions .PQ ERE s . This mode corresponds @@ -202,6 +204,7 @@ to the regular expression syntax recognized by Tcl 8.0 and earlier versions. .TP \fBTCL_REG_BASIC\fR +. Compile basic regular expressions .PQ BRE s . This mode corresponds @@ -210,18 +213,22 @@ like \fBsed\fR and \fBgrep\fR. This is the default if no flags are specified. .TP \fBTCL_REG_EXPANDED\fR +. Compile the regular expression (basic, extended, or advanced) using an expanded syntax that allows comments and whitespace. This mode causes non-backslashed non-bracket-expression white space and #-to-end-of-line comments to be ignored. .TP \fBTCL_REG_QUOTE\fR +. Compile a literal string, with all characters treated as ordinary characters. .TP \fBTCL_REG_NOCASE\fR +. Compile for matching that ignores upper/lower case distinctions. .TP \fBTCL_REG_NEWLINE\fR +. Compile for newline-sensitive matching. By default, newline is a completely ordinary character with no special meaning in either regular expressions or strings. With this flag, @@ -239,6 +246,7 @@ an empty string before any newline in addition to its normal function. \fBREG_NLANCH\fR. .TP \fBTCL_REG_NLSTOP\fR +. Compile for partial newline-sensitive matching, with the behavior of .QW [^ @@ -255,6 +263,7 @@ bracket expressions and never match newline. .TP \fBTCL_REG_NLANCH\fR +. Compile for inverse partial newline-sensitive matching, with the behavior of .QW ^ @@ -275,12 +284,14 @@ matches an empty string before any newline in addition to its normal function. .TP \fBTCL_REG_NOSUB\fR +. Compile for matching that reports only success or failure, not what was matched. This reduces compile overhead and may improve performance. Subsequent calls to \fBTcl_RegExpGetInfo\fR or \fBTcl_RegExpRange\fR will not report any match information. .TP \fBTCL_REG_CANMATCH\fR +. Compile for matching that reports the potential to complete a partial match given more text (see below). .RE @@ -310,6 +321,7 @@ zero or more of the following flags: .RS 2 .TP \fBTCL_REG_NOTBOL\fR +. The starting character will not be treated as the beginning of a line or the beginning of the string, so .QW ^ @@ -319,6 +331,7 @@ Note that this flag has no effect on how matches. .TP \fBTCL_REG_NOTEOL\fR +. The last character in the string will not be treated as the end of a line or the end of the string, so .QW $ @@ -334,7 +347,7 @@ performed with a given regular expression \fIregexp\fR. The defined as follows: .PP .CS -typedef struct Tcl_RegExpInfo { +typedef struct { Tcl_Size \fInsubs\fR; Tcl_RegExpIndices *\fImatches\fR; Tcl_Size \fIextendStart\fR; @@ -352,7 +365,7 @@ appear in the pattern. Each element is a structure that is defined as follows: .PP .CS -typedef struct Tcl_RegExpIndices { +typedef struct { Tcl_Size \fIstart\fR; Tcl_Size \fIend\fR; } \fBTcl_RegExpIndices\fR; @@ -394,4 +407,5 @@ additional reference being taken. .SH "SEE ALSO" re_syntax(n) .SH KEYWORDS -match, pattern, regular expression, string, subexpression, Tcl_RegExpIndices, Tcl_RegExpInfo +match, pattern, regular expression, string, subexpression, +Tcl_RegExpIndices, Tcl_RegExpInfo diff --git a/doc/SetVar.3 b/doc/SetVar.3 index ad4773e..c34e55f 100644 --- a/doc/SetVar.3 +++ b/doc/SetVar.3 @@ -169,6 +169,7 @@ options to the procedures. It consists of an OR-ed combination of the following bits. .TP \fBTCL_GLOBAL_ONLY\fR +. Under normal circumstances the procedures look up variables as follows. If a procedure call is active in \fIinterp\fR, the variable is looked up at the current level of procedure call. @@ -181,12 +182,14 @@ If both \fBTCL_GLOBAL_ONLY\fR and \fBTCL_NAMESPACE_ONLY\fR are given, \fBTCL_GLOBAL_ONLY\fR is ignored. .TP \fBTCL_NAMESPACE_ONLY\fR +. If this bit is set in \fIflags\fR then the variable is looked up only in the current namespace; if a procedure is active its variables are ignored, and the global namespace is also ignored unless it is the current namespace. .TP \fBTCL_LEAVE_ERR_MSG\fR +. If an error is returned and this bit is set in \fIflags\fR, then an error message will be left in the interpreter's result, where it can be retrieved with \fBTcl_GetObjResult\fR @@ -195,12 +198,14 @@ If this flag bit is not set then no error message is left and the interpreter's result will not be modified. .TP \fBTCL_APPEND_VALUE\fR +. If this bit is set then \fInewValuePtr\fR or \fInewValue\fR is appended to the current value instead of replacing it. If the variable is currently undefined, then the bit is ignored. This bit is only used by the \fBTcl_Set*\fR procedures. .TP \fBTCL_LIST_ELEMENT\fR +. If this bit is set, then \fInewValue\fR is converted to a valid Tcl list element before setting (or appending to) the variable. A separator space is appended before the new list element unless diff --git a/doc/StdChannels.3 b/doc/StdChannels.3 index d3ecff2..e22e326 100644 --- a/doc/StdChannels.3 +++ b/doc/StdChannels.3 @@ -45,8 +45,7 @@ standard channels. (A channel is not if it could not be successfully opened; for example, in a Tcl application run as a Windows NT service.) -.TP -1) +.IP 1) A single standard channel is initialized when it is explicitly specified in a call to \fBTcl_SetStdChannel\fR. The states of the other standard channels are unaffected. @@ -55,17 +54,14 @@ other standard channels are unaffected. Missing platform-specific standard channels do not matter here. This approach is not available at the script level. .RE -.TP -2) +.IP 2) All uninitialized standard channels are initialized to platform-specific default values: .RS -.TP -(a) +.IP (a) when open channels are listed with \fBTcl_GetChannelNames\fR (or the \fBfile channels\fR script command), or -.TP -(b) +.IP (b) when information about any standard channel is requested with a call to \fBTcl_GetStdChannel\fR, or with a call to \fBTcl_GetChannel\fR which specifies one of the standard names (\fBstdin\fR, \fBstdout\fR @@ -76,8 +72,7 @@ standard channels are considered as initialized and then immediately closed. This means that the first three Tcl channels then opened by the application are designated as the Tcl standard channels. .RE -.TP -3) +.IP 3) All uninitialized standard channels are initialized to platform-specific default values when a user-requested channel is registered with \fBTcl_RegisterChannel\fR. diff --git a/doc/StringObj.3 b/doc/StringObj.3 index cb81559..817ed34 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -116,7 +116,8 @@ of a value's string representation. May be (Tcl_Size *)NULL when not used. If it points to a variable which type is not \fBTcl_Size\fR, a compiler warning will be generated. If your extensions is compiled with -DTCL_8_API, this function will -panic for strings with more than INT_MAX bytes/characters, otherwise expect it to crash. +panic for strings with more than INT_MAX bytes/characters, otherwise +expect it to crash. .AP "const char" *string in Null-terminated string value to append to \fIobjPtr\fR. .AP Tcl_Size limit in diff --git a/doc/Tcl.n b/doc/Tcl.n index 0bceca6..fbe77bc 100644 --- a/doc/Tcl.n +++ b/doc/Tcl.n @@ -114,6 +114,7 @@ variable within an array variable, and may be empty. \fIname\fR may be empty. Substitutions are performed on \fIindex\fR. .TP 15 \fB${\fIname\fB}\fR +. \fIname\fR may be empty. .TP 15 \fB${\fIname(index)\fB}\fR @@ -135,24 +136,31 @@ are replaced as described: .RS .TP 7 \e\fBa\fR +. Audible alert (bell) (U+7). .TP 7 \e\fBb\fR +. Backspace (U+8). .TP 7 \e\fBf\fR +. Form feed (U+C). .TP 7 \e\fBn\fR +. Newline (U+A). .TP 7 \e\fBr\fR +. Carriage-return (U+D). .TP 7 \e\fBt\fR +. Tab (U+9). .TP 7 \e\fBv\fR +. Vertical tab (U+B). .TP 7 \e\fB\fIwhiteSpace\fR @@ -164,6 +172,7 @@ within braced words, and if the resulting space may subsequently be treated as a word delimiter. .TP 7 \e\e +. Backslash .PQ \e "" . .TP 7 diff --git a/doc/TclZlib.3 b/doc/TclZlib.3 index efbe07b..d14ba48 100644 --- a/doc/TclZlib.3 +++ b/doc/TclZlib.3 @@ -219,47 +219,33 @@ an unshared dictionary value). .PP The following fields in the dictionary value are understood. All other fields are ignored. No field is required when creating a gzip-format stream. -.TP -\fBcomment\fR -. +.IP \fBcomment\fR This holds the comment field of the header, if present. If absent, no comment was supplied (on decompression) or will be created (on compression). -.TP -\fBcrc\fR -. +.IP \fBcrc\fR A boolean value describing whether a CRC of the header is computed. Note that the \fBgzip\fR program does \fInot\fR use or allow a CRC on the header. -.TP -\fBfilename\fR -. +.IP \fBfilename\fR The name of the file that held the uncompressed data. This should not contain any directory separators, and should be sanitized before use on decompression with \fBfile tail\fR. -.TP -\fBos\fR -. +.IP \fBos\fR The operating system type code field from the header (if not the .QW unknown value). See RFC 1952 for the meaning of these codes. On compression, if this is absent then the field will be set to the .QW unknown value. -.TP -\fBsize\fR -. +.IP \fBsize\fR The size of the uncompressed data. This is ignored on compression; the size of the data compressed depends on how much data is supplied to the compression engine. -.TP -\fBtime\fR -. +.IP \fBtime\fR The time field from the header if non-zero, expected to be the time that the file named by the \fBfilename\fR field was modified. Suitable for use with \fBclock format\fR. On creation, the right value to use is that from \fBclock seconds\fR or \fBfile mtime\fR. -.TP -\fBtype\fR -. +.IP \fBtype\fR The type of the uncompressed data (either \fBbinary\fR or \fBtext\fR) if known. .SH "REFERENCE COUNT MANAGEMENT" diff --git a/doc/TraceCmd.3 b/doc/TraceCmd.3 index d5de5a9..c1f2cbb 100644 --- a/doc/TraceCmd.3 +++ b/doc/TraceCmd.3 @@ -54,9 +54,11 @@ trace procedure is to be invoked. It consists of an OR'ed combination of any of the following values: .TP \fBTCL_TRACE_RENAME\fR +. Invoke \fIproc\fR whenever the command is renamed. .TP \fBTCL_TRACE_DELETE\fR +. Invoke \fIproc\fR when the command is deleted. .PP Whenever one of the specified operations occurs to the command, diff --git a/doc/TraceVar.3 b/doc/TraceVar.3 index 2c572d3..3fb3ab6 100644 --- a/doc/TraceVar.3 +++ b/doc/TraceVar.3 @@ -77,22 +77,27 @@ for setting up the trace. It consists of an OR-ed combination of any of the following values: .TP \fBTCL_GLOBAL_ONLY\fR +. Normally, the variable will be looked up at the current level of procedure call; if this bit is set then the variable will be looked up at global level, ignoring any active procedures. .TP \fBTCL_NAMESPACE_ONLY\fR +. Normally, the variable will be looked up at the current level of procedure call; if this bit is set then the variable will be looked up in the current namespace, ignoring any active procedures. .TP \fBTCL_TRACE_READS\fR +. Invoke \fIproc\fR whenever an attempt is made to read the variable. .TP \fBTCL_TRACE_WRITES\fR +. Invoke \fIproc\fR whenever an attempt is made to modify the variable. .TP \fBTCL_TRACE_UNSETS\fR +. Invoke \fIproc\fR whenever the variable is unset. A variable may be unset either explicitly by an \fBunset\fR command, or implicitly when a procedure returns (its local variables are @@ -100,18 +105,21 @@ automatically unset) or when the interpreter or namespace is deleted (all variables are automatically unset). .TP \fBTCL_TRACE_ARRAY\fR +. Invoke \fIproc\fR whenever the array command is invoked. This gives the trace procedure a chance to update the array before array names or array get is called. Note that this is called before an array set, but that will trigger write traces. .TP \fBTCL_TRACE_RESULT_DYNAMIC\fR +. The result of invoking the \fIproc\fR is a dynamically allocated string that will be released by the Tcl library via a call to \fBTcl_Free\fR. Must not be specified at the same time as \fBTCL_TRACE_RESULT_OBJECT\fR. .TP \fBTCL_TRACE_RESULT_OBJECT\fR +. The result of invoking the \fIproc\fR is a Tcl_Obj* (cast to a char*) with a reference count of at least one. The ownership of that reference will be transferred to the Tcl core for release (when the diff --git a/doc/UniCharIsAlpha.3 b/doc/UniCharIsAlpha.3 index 1f70f6d..4ae4612 100644 --- a/doc/UniCharIsAlpha.3 +++ b/doc/UniCharIsAlpha.3 @@ -65,28 +65,34 @@ with the various routines. .SH "CHARACTER CLASSES" .PP -\fBTcl_UniCharIsAlnum\fR tests if the character is an alphanumeric Unicode character. +\fBTcl_UniCharIsAlnum\fR tests if the character is an alphanumeric Unicode +character. .PP -\fBTcl_UniCharIsAlpha\fR tests if the character is an alphabetic Unicode character. +\fBTcl_UniCharIsAlpha\fR tests if the character is an alphabetic Unicode +character. .PP \fBTcl_UniCharIsControl\fR tests if the character is a Unicode control character. .PP \fBTcl_UniCharIsDigit\fR tests if the character is a numeric Unicode character. .PP -\fBTcl_UniCharIsGraph\fR tests if the character is any Unicode print character except space. +\fBTcl_UniCharIsGraph\fR tests if the character is any Unicode print character +except space. .PP \fBTcl_UniCharIsLower\fR tests if the character is a lowercase Unicode character. .PP \fBTcl_UniCharIsPrint\fR tests if the character is a Unicode print character. .PP -\fBTcl_UniCharIsPunct\fR tests if the character is a Unicode punctuation character. +\fBTcl_UniCharIsPunct\fR tests if the character is a Unicode punctuation +character. .PP -\fBTcl_UniCharIsSpace\fR tests if the character is a whitespace Unicode character. +\fBTcl_UniCharIsSpace\fR tests if the character is a whitespace Unicode +character. .PP -\fBTcl_UniCharIsUpper\fR tests if the character is an uppercase Unicode 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. +\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/doc/WrongNumArgs.3 b/doc/WrongNumArgs.3 index fbd0f59..864d315 100644 --- a/doc/WrongNumArgs.3 +++ b/doc/WrongNumArgs.3 @@ -64,7 +64,7 @@ a subcommand. The command into an \fIindexObject\fR. If an error occurs in the parsing of the subcommand we would like to use the full subcommand name rather than the abbreviation. If the \fBTcl_WrongNumArgs\fR command finds any -\fIindexObjects\fR in the \fIobjv\fR array it will use the full subcommand +\fIindexObject\fRs in the \fIobjv\fR array, it will use the full subcommand name in the error message instead of the abbreviated name that was originally passed in. Using the above example, let us assume that \fIbar\fR is actually an abbreviation for \fIbarfly\fR and the value diff --git a/doc/after.n b/doc/after.n index b43f2cb..a619935 100644 --- a/doc/after.n +++ b/doc/after.n @@ -53,7 +53,7 @@ registered with \fBinterp bgerror\fR. The \fBafter\fR command returns an identifier that can be used to cancel the delayed command using \fBafter cancel\fR. A \fIms\fR value of 0 (or negative) queues the event immediately with -priority over other event types (if not installed withn an event proc, +priority over other event types (if not installed with an event proc, which will wait for next round of events). .\" METHOD: cancel .TP diff --git a/doc/binary.n b/doc/binary.n index 8793b2f..911e170 100644 --- a/doc/binary.n +++ b/doc/binary.n @@ -59,11 +59,13 @@ information. .RS .PP During encoding, the following options are supported: +.\" OPTION: -maxlen .TP \fB\-maxlen \fIlength\fR . Indicates that the output should be split into lines of no more than \fIlength\fR characters. By default, lines are not split. +.\" OPTION: -wrapchar .TP \fB\-wrapchar \fIcharacter\fR . @@ -73,6 +75,7 @@ newline character, .QW \en . .PP During decoding, the following options are supported: +.\" OPTION: -strict .TP \fB\-strict\fR . @@ -91,6 +94,7 @@ When decoding, upper and lower characters are accepted. .PP No options are supported during encoding. During decoding, the following options are supported: +.\" OPTION: -strict .TP \fB\-strict\fR . @@ -107,12 +111,14 @@ largely superseded by the \fBbase64\fR binary encoding. .PP During encoding, the following options are supported (though changing them may produce files that other implementations of decoders cannot process): +.\" OPTION: -maxlen .TP \fB\-maxlen \fIlength\fR . Indicates the maximum number of characters to produce for each encoded line. The valid range is 5 to 85. Line lengths outside that range cannot be accommodated by the encoding format. The default value is 61. +.\" OPTION: -wrapchar .TP \fB\-wrapchar \fIcharacter\fR . @@ -124,6 +130,7 @@ they would generate encoded text that could not be decoded. The default value is a single newline. .PP During decoding, the following options are supported: +.\" OPTION: -strict .TP \fB\-strict\fR . @@ -1101,7 +1108,7 @@ base64 and prints them: set f [open $filename rb] set data [read $f] close $f -puts [\fBbinary encode\fR base64 \-maxlen 64 $data] +puts [\fBbinary encode\fR base64 -maxlen 64 $data] .CE .SH "SEE ALSO" encoding(n), format(n), scan(n), string(n), tcl_platform(n) diff --git a/doc/cd.n b/doc/cd.n index c6d8527..b750807 100644 --- a/doc/cd.n +++ b/doc/cd.n @@ -20,6 +20,7 @@ Change the current working directory to \fIdirName\fR, or to the home directory (as specified in the HOME environment variable) if \fIdirName\fR is not given. Returns an empty string. +.PP Note that the current working directory is a per-process resource; the \fBcd\fR command changes the working directory for all interpreters and all threads. diff --git a/doc/chan.n b/doc/chan.n index 5436cc8..b03d6e4 100644 --- a/doc/chan.n +++ b/doc/chan.n @@ -105,6 +105,7 @@ The options described below are supported for all channels. Each type of channel may provide additional options. Those options are described in the relevant documentation. For example, additional options are documented for \fBsocket\fR, and also for serial devices at \fBopen\fR. +.\" OPTION: -blocking .TP \fB\-blocking\fI boolean\fR . @@ -115,6 +116,7 @@ flush\fR, and \fBchan close\fR take care not to block. Non-blocking mode in generally requires that the event loop is entered, e.g. by calling \fBTcl_DoOneEvent\fR or \fBvwait\fR or by using Tk, to give Tcl a chance to process events on the channel. +.\" OPTION: -buffering .TP \fB\-buffering\fI newValue\fR . @@ -125,11 +127,13 @@ character is written. If \fInewValue\fR is \fBnone\fR, output is flushed after every output operation. For \fBstdin\fR, \fBstdout\fR, and channels that connect to terminal-like devices, the default value is \fBline\fR. For \fBstderr\fR the default value is \fBnone\fR. +.\" OPTION: -buffersize .TP \fB\-buffersize\fI newSize\fR . \fInewSize\fR, an integer no greater than one million, is the size in bytes of any input or output buffers subsequently allocated for this channel. +.\" OPTION: -encoding .TP \fB\-encoding\fR ?\fIname\fR? . @@ -147,6 +151,7 @@ The encoding of a new channel is the value of \fBencoding system\fR, which returns the platform- and locale-dependent system encoding used to interface with the operating system, .RE +.\" OPTION: -eofchar .TP \fB\-eofchar\fI char\fR . @@ -159,6 +164,7 @@ The default value is the empty string. The acceptable range is \ex01 - \ex7F. A value outside this range results in an error. .RE .VS "TCL8.7 TIP656" +.\" OPTION: -profile .TP \fB\-profile\fI profile\fR . @@ -168,6 +174,7 @@ rules of that profile. Any failures will result in a channel error. See \fBPROFILES\fR in the \fBencoding(n)\fR documentation for details about encoding profiles. .VE "TCL8.7 TIP656" +.\" OPTION: -translation .TP \fB\-translation\fI translation\fR .TP @@ -181,9 +188,9 @@ carriage-return-linefeed sequence is normally used in network connections. Therefore, on input, e.g. with \fBchan gets\fR and \fBchan read\fR, each external end-of-line character is translated into a line feed. On output, e.g. with \fBchan puts\fR, each line feed is translated to the external -end-of-line character. The default translation, \fBauto\fR, handles all the common -cases, and \fB\-translation\fR provides explicit control over the end-of-line -character. +end-of-line character. The default translation, \fBauto\fR, handles all the +common cases, and \fB\-translation\fR provides explicit control over the +end-of-line character. .RS .PP Returns the input translation for a read-only channel, the output translation @@ -192,18 +199,14 @@ translation for a read-write channel. When two translations are given, they are the input and output translation, respectively. When only one translation is given for a read-write channel, it is the translation for both input and output. The following values are currently supported: -.TP -\fBauto\fR -. +.IP \fBauto\fR The default. For input each occurrence of a line feed (\fBlf\fR), carriage return (\fBcr\fR), or carriage return followed by a line feed (\fBcrlf\fR) is translated into a line feed. For output, each line feed is translated into a platform-specific representation: For all Unix variants it is \fBlf\fR, and for all Windows variants it is \fBcrlf\fR, except that for sockets on all platforms it is \fBcrlf\fR for both input and output. -.TP -\fBbinary\fR -. +.IP \fBbinary\fR Like \fBlf\fR, no end-of-line translation is performed, but in addition, sets \fB\-eofchar\fR to the empty string to disable it, and sets \fB\-encoding\fR to \fBiso8859-1\fR. With this one setting, a channel is fully configured @@ -214,24 +217,18 @@ makes it possible to work seamlessly with binary data as long as each character in the data remains in the range of 0 to 255 so that there is no distinction between binary data and text. For example, A JPEG image can be read from a such a channel, manipulated, and then written back to such a channel. -.TP -\fBcr\fR -. +.IP \fBcr\fR The end of a line is represented in the external data by a single carriage return character. For input, each carriage return is translated to a line feed, and for output each line feed character is translated to a carriage return. -.TP -\fBcrlf\fR -. +.IP \fBcrlf\fR The end of a line is represented in the external data by a carriage return character followed by a line feed. For input, each carriage-return-linefeed sequence is translated to a line feed. For output, each line feed is translated to a carriage-return-linefeed sequence. This translation is typically used for network connections, and also on Windows systems. -.TP -\fBlf\fR -. +.IP \fBlf\fR The end of a line in the external data is represented by a line feed so no translations occur during either input or output. This translation is typically used on UNIX platforms, @@ -275,9 +272,6 @@ wrong-sided I/O attempted (by a \fBchan event\fR handler or otherwise) results in a .QW "channel busy" error. -.PP -.PP -.IP \fBEXAMPLES\fR .RE .\" METHOD: create .TP @@ -576,18 +570,11 @@ bytes relative to \fIorigin\fR. A negative offset moves the current position backwards from the origin. \fIorigin\fR is one of the following: .RS -.PP -.TP 10 -\fBstart\fR -. +.IP \fBstart\fR The origin is the start of the data. This is the default. -.TP 10 -\fBcurrent\fR -. +.IP \fBcurrent\fR The origin is the current position. -.TP 10 -\fBend\fR -. +.IP \fBend\fR The origin is the end of the data. .PP \fBChan seek\fR flushes all buffered output even if the channel is in @@ -603,7 +590,7 @@ not characters, \fBchan tell \fIchannelName\fR . Returns the offset in bytes of the current position in the underlying data, or --1 if the channel does not suport seeking. The value can be passed to \fBchan +-1 if the channel does not support seeking. The value can be passed to \fBchan seek\fR to set current position to that offset. .\" METHOD: truncate .TP diff --git a/doc/classvariable.n b/doc/classvariable.n index 15b8783..198f09e 100644 --- a/doc/classvariable.n +++ b/doc/classvariable.n @@ -26,8 +26,8 @@ elements. The originating scope for the variables is the namespace of the class that the method was defined by. In other words, the referenced variables are shared between all instances of that class. .PP -Note: This command is equivalent to the command \fBtypevariable\fR provided by -the snit package in tcllib for approximately the same purpose. If used in a +Note that this command is equivalent to the command \fBtypevariable\fR provided +by the snit package in tcllib for approximately the same purpose. If used in a method defined directly on a class instance (e.g., through the \fBoo::objdefine\fR \fBmethod\fR definition) this is very much like just using: diff --git a/doc/clock.n b/doc/clock.n index e7f1b11..871a942 100644 --- a/doc/clock.n +++ b/doc/clock.n @@ -81,6 +81,7 @@ See \fBSCANNING TIMES\fR for a full description. .\" METHOD: seconds .TP \fBclock seconds\fR +. Returns the current time as an integer number of seconds. .SS "PARAMETERS" .TP @@ -107,12 +108,14 @@ One of the words, \fBseconds\fR, \fBminutes\fR, \fBhours\fR, Used in conjunction with \fIcount\fR to identify an interval of time, for example, \fI3 seconds\fR or \fI1 year\fR. .SS "OPTIONS" +.\" OPTION: -base .TP \fB\-base\fR time . Specifies that any relative times present in a \fBclock scan\fR command are to be given relative to \fItime\fR. \fItime\fR must be expressed as a count of nominal seconds from the epoch time of 1 January 1970, 00:00 UTC. +.\" OPTION: -format .TP \fB\-format\fR format . @@ -135,6 +138,7 @@ On \fBclock scan\fR, the lack of a \fB\-format\fR option indicates that a .QW "free format scan" is requested; see \fBFREE FORM SCAN\fR for a description of what happens. .RE +.\" OPTION: -gmt .TP \fB\-gmt\fR boolean . @@ -145,6 +149,7 @@ zone. This usage is obsolete; the correct current usage is to specify the UTC time zone with .QW "\fB\-timezone\fI :UTC\fR" or any of the equivalent ways to specify it. +.\" OPTION: -locale .TP \fB\-locale\fR localeName . @@ -161,6 +166,7 @@ descriptions of the individual format groups under \fBFORMAT GROUPS\fR. The effect of locale on clock arithmetic is discussed under \fBCLOCK ARITHMETIC\fR. .RE +.\" OPTION: -timezone .TP \fB\-timezone\fR zoneName . @@ -488,81 +494,57 @@ if the clock had not changed. .PP The following format groups are recognized by the \fBclock scan\fR and \fBclock format\fR commands. -.TP -\fB%a\fR -. +.IP \fB%a\fR On output, produces an abbreviation (\fIe.g., \fBMon\fR) for the day of the week in the given locale. On input, matches the name of the day of the week in the given locale (in either abbreviated or full form, or any unique prefix of either form). -.TP -\fB%A\fR -. +.IP \fB%A\fR On output, produces the full name (\fIe.g., \fBMonday\fR) of the day of the week in the given locale. On input, matches the name of the day of the week in the given locale (in either abbreviated or full form, or any unique prefix of either form). -.TP -\fB%b\fR -. +.IP \fB%b\fR On output, produces an abbreviation (\fIe.g., \fBJan\fR) for the name of the month in the given locale. On input, matches the name of the month in the given locale (in either abbreviated or full form, or any unique prefix of either form). -.TP -\fB%B\fR -. +.IP \fB%B\fR On output, produces the full name (\fIe.g., \fBJanuary\fR) of the month in the given locale. On input, matches the name of the month in the given locale (in either abbreviated or full form, or any unique prefix of either form). -.TP -\fB%c\fR -. +.IP \fB%c\fR On output, produces a localized representation of date and time of day; the localized representation is expected to use the Gregorian calendar. On input, matches whatever \fB%c\fR produces. -.TP -\fB%C\fR -. +.IP \fB%C\fR On output, produces the number of the century in Indo-Arabic numerals. On input, matches one or two digits, possibly with leading whitespace, that are expected to be the number of the century. -.TP -\fB%d\fR -. +.IP \fB%d\fR On output, produces the number of the day of the month, as two decimal digits. On input, matches one or two digits, possibly with leading whitespace, that are expected to be the number of the day of the month. -.TP -\fB%D\fR -. +.IP \fB%D\fR This format group is synonymous with \fB%m/%d/%Y\fR. It should be used only in exchanging data within the \fBen_US\fR locale, since other locales typically do not use this order for the fields of the date. -.TP -\fB%e\fR -. +.IP \fB%e\fR On output, produces the number of the day of the month, as one or two decimal digits (with a leading blank for one-digit dates). On input, matches one or two digits, possibly with leading whitespace, that are expected to be the number of the day of the month. -.TP -\fB%Ec\fR -. +.IP \fB%Ec\fR On output, produces a locale-dependent representation of the date and time of day in the locale's alternative calendar. On input, matches whatever \fB%Ec\fR produces. The locale's alternative calendar need not be the Gregorian calendar. -.TP -\fB%EC\fR -. +.IP \fB%EC\fR On output, produces a locale-dependent name of an era in the locale's alternative calendar. On input, matches the name of the era or any unique prefix. -.TP -\fB%EE\fR -. +.IP \fB%EE\fR On output, produces the string \fBB.C.E.\fR or \fBC.E.\fR, or a string of the same meaning in the locale, to indicate whether \fB%Y\fR refers to years before or after Year 1 of the Common Era. On input, accepts @@ -570,242 +552,168 @@ the string \fBB.C.E.\fR, \fBB.C.\fR, \fBC.E.\fR, \fBA.D.\fR, or the 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%Ex\fR -. +.IP \fB%Ex\fR On output, produces a locale-dependent representation of the date in the locale's alternative calendar. On input, matches whatever \fB%Ex\fR produces. The locale's alternative calendar need not be the Gregorian calendar. -.TP -\fB%EX\fR -. +.IP \fB%EX\fR On output, produces a locale-dependent representation of the time of day in the locale's alternative numerals. On input, matches whatever \fB%EX\fR produces. -.TP -\fB%Ey\fR -. +.IP \fB%Ey\fR On output, produces a locale-dependent number of the year of the era in the locale's alternative calendar and numerals. On input, matches such a number. -.TP -\fB%EY\fR -. +.IP \fB%EY\fR On output, produces a representation of the year in the locale's alternative calendar and numerals. On input, matches what \fB%EY\fR produces. Often synonymous with \fB%EC%Ey\fR. -.TP -\fB%g\fR -. +.IP \fB%g\fR On output, produces a two-digit year number suitable for use with the week-based ISO8601 calendar; that is, the year number corresponds to the week number produced by \fB%V\fR. On input, accepts such a two-digit year number, possibly with leading whitespace. -.TP -\fB%G\fR -. +.IP \fB%G\fR On output, produces a four-digit year number suitable for use with the week-based ISO8601 calendar; that is, the year number corresponds to the week number produced by \fB%V\fR. On input, accepts such a four-digit year number, possibly with leading whitespace. -.TP -\fB%h\fR -. +.IP \fB%h\fR This format group is synonymous with \fB%b\fR. -.TP -\fB%H\fR -. +.IP \fB%H\fR On output, produces a two-digit number giving the hour of the day (00-23) on a 24-hour clock. On input, accepts such a number. -.TP -\fB%I\fR -. +.IP \fB%I\fR On output, produces a two-digit number giving the hour of the day (12-11) on a 12-hour clock. On input, accepts such a number. -.TP -\fB%j\fR -. +.IP \fB%j\fR 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 -. +.IP \fB%J\fR On output, produces a string of digits giving the 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 Julian calendar. The epoch time of 1 January 1970 corresponds to Julian Day Number 2440588. -.TP -\fB%k\fR -. +.IP \fB%k\fR On output, produces a one- or two-digit number giving the hour of the day (0-23) on a 24-hour clock. On input, accepts such a number. -.TP -\fB%l\fR -. +.IP \fB%l\fR On output, produces a one- or two-digit number giving the hour of the day (12-11) on a 12-hour clock. On input, accepts such a number. -.TP -\fB%m\fR -. +.IP \fB%m\fR On output, produces the number of the month (01-12) with exactly two digits. On input, accepts two digits and interprets them as the number of the month. -.TP -\fB%M\fR -. +.IP \fB%M\fR On output, produces the number of the minute of the hour (00-59) with exactly two digits. On input, accepts two digits and interprets them as the number of the minute of the hour. -.TP -\fB%N\fR -. +.IP \fB%N\fR On output, produces the number of the month (1-12) with one or two digits, and a leading blank for one-digit dates. On input, accepts one or two digits, possibly with leading whitespace, and interprets them as the number of the month. -.TP -\fB%Od\fR, \fB%Oe\fR, \fB%OH\fR, \fB%OI\fR, \fB%Ok\fR, \fB%Ol\fR, \fB%Om\fR, \fB%OM\fR, \fB%OS\fR, \fB%Ou\fR, \fB%Ow\fR, \fB%Oy\fR -. +.IP "\fB%Od\fR, \fB%Oe\fR, \fB%OH\fR, \fB%OI\fR, \fB%Ok\fR, \fB%Ol\fR, \fB%Om\fR, \fB%OM\fR, \fB%OS\fR, \fB%Ou\fR, \fB%Ow\fR, \fB%Oy\fR" All of these format groups are synonymous with their counterparts without the .QW \fBO\fR , except that the string is produced and parsed in the locale-dependent alternative numerals. -.TP -\fB%p\fR -. +.IP \fB%p\fR On output, produces an indicator for the part of the day, \fBAM\fR or \fBPM\fR, appropriate to the given locale. If the script of the given locale supports multiple letterforms, lowercase is preferred. On input, matches the representation \fBAM\fR or \fBPM\fR in the given locale, in either case. -.TP -\fB%P\fR -. +.IP \fB%P\fR On output, produces an indicator for the part of the day, \fBam\fR or \fBpm\fR, appropriate to the given locale. If the script of the given locale supports multiple letterforms, uppercase is preferred. On input, matches the representation \fBAM\fR or \fBPM\fR in the given locale, in either case. -.TP -\fB%Q\fR -. +.IP \fB%Q\fR This format group is reserved for internal use within the Tcl library. .\" It's the STARDATE! We're so Enterprise-ready... -.TP -\fB%r\fR -. +.IP \fB%r\fR On output, produces a locale-dependent time of day representation on a 12-hour clock. On input, accepts whatever \fB%r\fR produces. -.TP -\fB%R\fR -. +.IP \fB%R\fR On output, the time in 24-hour notation (%H:%M). For a version including the seconds, see \fB%T\fR below. On input, accepts whatever \fB%R\fR produces. -.TP -\fB%s\fR -. +.IP \fB%s\fR On output, simply formats the \fItimeVal\fR argument as a decimal integer and inserts it into the output string. On input, accepts a decimal integer and uses is as the time value without any further processing. Since \fB%s\fR uniquely determines a point in time, it overrides all other input formats. -.TP -\fB%S\fR -. +.IP \fB%S\fR On output, produces a two-digit number of the second of the minute (00-59). On input, accepts two digits and uses them as the second of the minute. -.TP -\fB%t\fR -. +.IP \fB%t\fR On output, produces a TAB character. On input, matches a TAB character. -.TP -\fB%T\fR -. +.IP \fB%T\fR Synonymous with \fB%H:%M:%S\fR. -.TP -\fB%u\fR -. +.IP \fB%u\fR On output, produces the number of the day of the week (\fB1\fR\(->Monday, \fB7\fR\(->Sunday). On input, accepts a single digit and interprets it as the day of the week. Sunday may be either \fB0\fR or \fB7\fR. -.TP -\fB%U\fR -. +.IP \fB%U\fR On output, produces the ordinal number of the week of the year (00-53). The first Sunday of the year is the first day of week 01. On input accepts two digits which are otherwise ignored. This format group is never used in determining an input date. This interpretation of the week of the year was once common in US banking but is now largely obsolete. See \fB%V\fR for the ISO8601 week number. -.TP -\fB%V\fR -. +.IP \fB%V\fR On output, produces the number of the ISO8601 week as a two digit number (01-53). Week 01 is the week containing January 4; or the first week of the year containing at least 4 days; or the week containing the first Thursday of the year (the three statements are equivalent). Each week begins on a Monday. On input, accepts the ISO8601 week number. -.TP -\fB%w\fR -. +.IP \fB%w\fR On output, produces the ordinal number of the day of the week (Sunday==0; Saturday==6). On input, accepts a single digit and interprets it as the day of the week; Sunday may be represented as either 0 or 7. Note that \fB%w\fR is not the ISO8601 weekday number, which is produced and accepted by \fB%u\fR. -.TP -\fB%W\fR -. +.IP \fB%W\fR On output, produces a week number (00-53) within the year; week 01 begins on the first Monday of the year. On input, accepts two digits, which are otherwise ignored. This format group is never used in determining an input date. It is not the ISO8601 week number; that week is produced and accepted by \fB%V\fR. -.TP -\fB%x\fR -. +.IP \fB%x\fR On output, produces the date in a locale-dependent representation. On input, accepts whatever \fB%x\fR produces and is used to determine calendar date. -.TP -\fB%X\fR -. +.IP \fB%X\fR On output, produces the time of day in a locale-dependent representation. On input, accepts whatever \fB%X\fR produces and is used to determine time of day. -.TP -\fB%y\fR -. +.IP \fB%y\fR On output, produces the two-digit year of the century. On input, accepts two digits, and is used to determine calendar date. The date is presumed to lie between 1938 and 2037 inclusive. Note that \fB%y\fR does not yield a year appropriate for use with the ISO8601 week number \fB%V\fR; programs should use \fB%g\fR for that purpose. -.TP -\fB%Y\fR -. +.IP \fB%Y\fR On output, produces the four-digit calendar year. On input, accepts four digits and may be used to determine calendar date. Note that \fB%Y\fR does not yield a year appropriate for use with the ISO8601 week number \fB%V\fR; programs should use \fB%G\fR for that purpose. -.TP -\fB%z\fR -. +.IP \fB%z\fR 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. -.TP -\fB%Z\fR -. +.IP \fB%Z\fR On output, produces the current time zone's name, possibly translated to the given locale. On input, accepts a time zone specifier (see \fBTIME ZONES\fR below) that will be used to determine the @@ -814,17 +722,13 @@ parsing RFC822 dates. Other uses are fraught with ambiguity; for instance, the string \fBBST\fR may represent British Summer Time or Brazilian Standard Time. It is recommended that date/time strings for use by computers use numeric time zones instead. -.TP -\fB%%\fR -. +.IP \fB%%\fR On output, produces a literal .QW \fB%\fR character. On input, matches a literal .QW \fB%\fR character. -.TP -\fB%+\fR -. +.IP \fB%+\fR Synonymous with .QW "\fB%a %b %e %H:%M:%S %Z %Y\fR" . .SH "TIME ZONES" @@ -976,7 +880,7 @@ acceptable formats are .QW "\fIdd monthname yy\fR" , .QW "?\fICC\fR?\fIyymmdd\fR" , and -.QW "\fIdd\fB-\fImonthname\fB-\fR?\fICC\fR?\fIyy\fR" . +.QW "\fIdd\fB\-\fImonthname\fB\-\fR?\fICC\fR?\fIyy\fR" . The default year is the current year. If the year is less than 100, we treat the years 00-68 as 2000-2068 and the years 69-99 as 1969-1999. Not all platforms can represent the years 38-70, so diff --git a/doc/configurable.n b/doc/configurable.n index 07335bd..7ab5b92 100644 --- a/doc/configurable.n +++ b/doc/configurable.n @@ -86,6 +86,7 @@ The \fBproperty\fR command takes the name of a property to define first, \fIwithout a leading hyphen\fR, followed by a number of option-value pairs that modify the basic behavior of the property. This can then be followed by an arbitrary number of other property definitions. The supported options are: +.\" OPTION: -get .TP \fB\-get \fIgetterScript\fR . @@ -99,6 +100,7 @@ of the instance variable with the same name as the property (e.g., will result in a method .QW being created). +.\" OPTION: -kind .TP \fB\-kind \fIpropertyKind\fR . @@ -114,6 +116,7 @@ Note that write-only properties are not particularly discoverable as they are never reported by the \fBconfigure\fR method other than by error messages when attempting to write to a property that does not exist. .RE +.\" OPTION: -set .TP \fB\-set \fIsetterScript\fR . diff --git a/doc/cookiejar.n b/doc/cookiejar.n index 224d488..7d8e99e 100644 --- a/doc/cookiejar.n +++ b/doc/cookiejar.n @@ -45,6 +45,7 @@ to be the given value. .RS .PP Supported options are: +.\" OPTION: -domainfile .TP \fB\-domainfile \fIfilename\fR . @@ -54,6 +55,7 @@ list of top-level domains (e.g., \fB.com\fR or \fB.co.jp\fR). Such domains domains is both security-sensitive and \fInot\fR constant and should be periodically refetched. Cookie jars maintain their own cache of the domain list. +.\" OPTION: -domainlist .TP \fB\-domainlist \fIurl\fR . @@ -62,33 +64,39 @@ A URL to fetch the list of top-level domains (e.g., \fB.com\fR or them. Note that the list of such domains is both security-sensitive and \fInot\fR constant and should be periodically refetched. Cookie jars maintain their own cache of the domain list. +.\" OPTION: -domainrefresh .TP \fB\-domainrefresh \fIintervalMilliseconds\fR . -The number of milliseconds between checks of the \fI\-domainlist\fR for new +The number of milliseconds between checks of the \fB\-domainlist\fR for new domains. +.\" OPTION: -loglevel .TP \fB\-loglevel \fIlevel\fR . The logging level of this package. The logging level must be (in order of decreasing verbosity) one of \fBdebug\fR, \fBinfo\fR, \fBwarn\fR, or \fBerror\fR. +.\" OPTION: -offline .TP \fB\-offline \fIflag\fR . -Allows the cookie managment engine to be placed into offline mode. In offline +Allows the cookie management engine to be placed into offline mode. In offline mode, the list of domains is read immediately from the file configured in the \fB\-domainfile\fR option, and the \fB\-domainlist\fR option is not used; it also makes the \fB\-domainrefresh\fR option be effectively ignored. +.\" OPTION: -purgeold .TP \fB\-purgeold \fIintervalMilliseconds\fR . The number of milliseconds between checks of the database for expired cookies; expired cookies are deleted. +.\" OPTION: -retain .TP \fB\-retain \fIcookieCount\fR . The maximum number of cookies to retain in the database. +.\" OPTION: -vacuumtrigger .TP \fB\-vacuumtrigger \fIdeletionCount\fR . @@ -104,8 +112,8 @@ creation methods (\fBcreate\fR or \fBnew\fR). . If a \fIfilename\fR argument is provided, it is the name of a file containing an SQLite database that will contain the persistent cookies maintained by the -cookie jar; the database will be created if the file does not already -exist. If \fIfilename\fR is not supplied, the database will be held entirely within +cookie jar; the database will be created if the file does not already exist. +If \fIfilename\fR is not supplied, the database will be held entirely within memory, which effectively forces all cookies within it to be session cookies. .SS "INSTANCE METHODS" .PP @@ -143,17 +151,11 @@ after the built-in security checks are done, and should return a boolean value; if the value is false, the operation is rejected and the database is not modified. The supported \fIoperation\fRs are: .RS -.TP -\fBdelete\fR -. +.IP \fBdelete\fR The \fIdomain\fR is seeking to delete a cookie. -.TP -\fBsession\fR -. +.IP \fBsession\fR The \fIdomain\fR is seeking to create or update a session cookie. -.TP -\fBset\fR -. +.IP \fBset\fR The \fIdomain\fR is seeking to create or update a persistent cookie (with a defined lifetime). .PP diff --git a/doc/define.n b/doc/define.n index 1344b32..91d927c 100644 --- a/doc/define.n +++ b/doc/define.n @@ -127,7 +127,6 @@ below), this command creates private forwarded methods. .VE TIP500 .RE .\" METHOD: initialise -.\" METHOD: initialize .TP \fBinitialise\fI script\fR .TP @@ -491,6 +490,7 @@ that the object is an instance of and cannot rename in an instance object the methods provided by those classes (though a \fBoo::objdefine forward\fRed method may provide an equivalent capability). Does not change the export status of the method; if it was exported before, it will be afterwards. +.\" METHOD: self .TP \fBself \fR .VS TIP470 @@ -514,32 +514,38 @@ Some of the configurable definitions of a class or object are \fIslotted definitions\fR. This means that the configuration is implemented by a slot object, that is an instance of the class \fBoo::Slot\fR, which manages a list of values (class names, variable names, etc.) that comprises the contents of -the slot. The class defines five operations (as methods) that may be done on +the slot. The class defines six operations (as methods) that may be done on the slot: +.\" METHOD: -append .TP \fIslot\fR \fB\-append\fR ?\fImember ...\fR? . This appends the given \fImember\fR elements to the slot definition. +.\" METHOD: -appendifnew .TP \fIslot\fR \fB\-appendifnew\fR ?\fImember ...\fR? .VS TIP558 This appends the given \fImember\fR elements to the slot definition if they do not already exist. .VE TIP558 +.\" METHOD: -clear .TP \fIslot\fR \fB\-clear\fR . This sets the slot definition to the empty list. +.\" METHOD: -prepend .TP \fIslot\fR \fB\-prepend\fR ?\fImember ...\fR? .VS TIP516 This prepends the given \fImember\fR elements to the slot definition. .VE TIP516 +.\" METHOD: -remove .TP \fIslot\fR \fB\-remove\fR ?\fImember ...\fR? .VS TIP516 This removes the given \fImember\fR elements from the slot definition. .VE TIP516 +.\" METHOD: -set .TP \fIslot\fR \fB\-set\fR ?\fImember ...\fR? . @@ -549,6 +555,7 @@ A consequence of this is that any use of a slot's default operation where the first member argument begins with a hyphen will be an error. One of the above operations should be used explicitly in those circumstances. .SS "SLOT IMPLEMENTATION" +.\" METHOD: --default-operation Internally, slot objects also define a method \fB\-\-default\-operation\fR which is forwarded to the default operation of the slot (thus, for the class .QW \fBvariable\fR diff --git a/doc/dict.n b/doc/dict.n index 9fcb05f..1517573 100644 --- a/doc/dict.n +++ b/doc/dict.n @@ -307,6 +307,7 @@ it is recommended that this command only be used in a local scope (\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of this, the variables set by \fBdict update\fR will continue to exist after the command finishes (unless explicitly \fBunset\fR). +.PP Note that the mapping of values to variables does not use traces; changes to the \fIdictionaryVariable\fR's contents only happen when \fIbody\fR terminates. @@ -348,6 +349,7 @@ it is recommended that this command only be used in a local scope (\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of this, the variables set by \fBdict with\fR will continue to exist after the command finishes (unless explicitly \fBunset\fR). +.PP Note that the mapping of values to variables does not use traces; changes to the \fIdictionaryVariable\fR's contents only happen when \fIbody\fR terminates. diff --git a/doc/encoding.n b/doc/encoding.n index b88dbc4..d556839 100644 --- a/doc/encoding.n +++ b/doc/encoding.n @@ -16,14 +16,15 @@ encoding \- Work with encodings .SH INTRODUCTION .PP In Tcl every string is composed of Unicode values. Text may be encoded into an -encoding such as cp1252, iso8859-1, Shitf\-JIS, utf-8, utf-16, etc. Not every -Unicode vealue is encodable in every encoding, and some encodings can encode +encoding such as cp1252, iso8859-1, Shift\-JIS, utf-8, utf-16, etc. Not every +Unicode value is encodable in every encoding, and some encodings can encode values that are not available in Unicode. .PP Even though Unicode is for encoding the written texts of human languages, any -sequence of bytes can be encoded as the first 255 Unicode values. iso8859-1 an -encoding for a subset of Unicode in which each byte is a Unicode value of 255 -or less. Thus, any sequence of bytes can be considered to be a Unicode string +sequence of bytes can be encoded as the first 255 Unicode values. In particular, +iso8859-1 is an encoding (a superset of classic ASCII) for a subset of Unicode +in which each byte is a Unicode value of 255 +or less; any sequence of bytes can be considered to be a Unicode string encoded in iso8859-1. To work with binary data in Tcl, decode it from iso8859-1 when reading it in, and encode it into iso8859-1 when writing it out, ensuring that each character in the string has a value of 255 or less. @@ -32,13 +33,14 @@ does nothing. .PP For example, the following is true: .CS + set text {In Tcl binary data is treated as Unicode text and it just works.} -set encoded [encoding convertto iso8859-1 $text] +set encoded [\fBencoding convertto\fR iso8859-1 $text] expr {$text eq $encoded}; #-> 1 .CE The following is also true: .CS -set decoded [encoding convertfrom iso8859-1 $text] +set decoded [\fBencoding convertfrom\fR iso8859-1 $text] expr {$text eq $decoded}; #-> 1 .CE .SH DESCRIPTION @@ -48,14 +50,14 @@ Performs one of the following encoding \fIoperations\fR: .TP \fBencoding convertfrom\fR ?\fIencoding\fR? \fIdata\fR .TP -\fBencoding convertfrom\fR ?\fB-profile \fIprofile\fR? ?\fB-failindex var\fR? \fIencoding data\fR +\fBencoding convertfrom\fR ?\fB\-profile \fIprofile\fR? ?\fB\-failindex var\fR? \fIencoding data\fR . Decodes \fIdata\fR encoded in \fIencoding\fR. If \fIencoding\fR is not specified the current system encoding is used. .VS "TCL8.7 TIP607, TIP656" -\fB-profile\fR determines how invalid data for the encoding are handled. See +\fB\-profile\fR determines how invalid data for the encoding are handled. See the \fBPROFILES\fR section below for details. Returns an error if decoding -fails. However, if \fB-failindex\fR given, returns the result of the +fails. However, if \fB\-failindex\fR given, returns the result of the conversion up to the point of termination, and stores in \fBvar\fR the index of the character that could not be converted. If no errors are encountered the entire result of the conversion is returned and the value \fB-1\fR is stored in @@ -65,12 +67,13 @@ entire result of the conversion is returned and the value \fB-1\fR is stored in .TP \fBencoding convertto\fR ?\fIencoding\fR? \fIdata\fR .TP -\fBencoding convertto\fR ?\fB-profile \fIprofile\fR? ?\fB-failindex var\fR? \fIencoding data\fR +\fBencoding convertto\fR ?\fB\-profile \fIprofile\fR? ?\fB\-failindex var\fR? \fIencoding data\fR . Converts \fIstring\fR to \fIencoding\fR. If \fIencoding\fR is not given, the current system encoding is used. .VS "TCL8.7 TIP607, TIP656" -See \fBencoding convertfrom\fR for the meaning of \fB-profile\fR and \fB-failindex\fR. +See \fBencoding convertfrom\fR for the meaning of \fB\-profile\fR and +\fB\-failindex\fR. .VE "TCL8.7 TIP607, TIP656" .\" METHOD: dirs .TP @@ -91,9 +94,10 @@ The encodings and .QW iso8859-1 are guaranteed to be present in the list. -.VS "TCL8.7 TIP656" +.\" METHOD: profiles .TP \fBencoding profiles\fR +.VS "TCL8.7 TIP656" Returns a list of names of available encoding profiles. See \fBPROFILES\fR below. .VE "TCL8.7 TIP656" diff --git a/doc/eval.n b/doc/eval.n index 448a459..018628b 100644 --- a/doc/eval.n +++ b/doc/eval.n @@ -22,6 +22,7 @@ script containing one or more commands. fashion as the \fBconcat\fR command, passes the concatenated string to the Tcl interpreter recursively, and returns the result of that evaluation (or any error generated by it). +.PP Note that the \fBlist\fR command quotes sequences of words in such a way that they are not further expanded by the \fBeval\fR command; for \fIany\fR values, $a, $b, and $c, these two lines are effectively diff --git a/doc/exec.n b/doc/exec.n index 612bd4e..ed1f45d 100644 --- a/doc/exec.n +++ b/doc/exec.n @@ -31,16 +31,19 @@ If the initial arguments to \fBexec\fR start with \fB\-\fR then they are treated as command-line switches and are not part of the pipeline specification. The following switches are currently supported: +.\" OPTION: -ignorestderr .TP 13 \fB\-ignorestderr\fR . Stops the \fBexec\fR command from treating the output of messages to the pipeline's standard error channel as an error case. +.\" OPTION: -keepnewline .TP 13 \fB\-keepnewline\fR . Retains a trailing newline in the pipeline's output. Normally a trailing newline will be deleted. +.\" OPTION: -- .TP 13 \fB\-\|\-\fR . diff --git a/doc/expr.n b/doc/expr.n index 340495c..1349809 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -54,15 +54,13 @@ ignored. Each operand is interpreted as a numeric value if at all possible. .PP Each operand has one of the following forms: .RS -.PP .TP A \fBnumeric value\fR .PP .RS -. Either integer or floating-point. The first two characters of an integer may also be \fB0d\fR for decimal, \fB0b\fR for binary, \fB0o\fR for octal or -\fB0x\fR for hexadicimal. +\fB0x\fR for hexadecimal. .PP A floating-point number may be take any of several common decimal formats, and may use the decimal point \fB.\fR, @@ -105,6 +103,7 @@ Backslash, variable, and command substitution are performed according to the rules for \fBTcl\fR. .TP A string enclosed in \fBbraces\fR. +. The operand is treated as a braced value according to the rule for braces in \fBTcl\fR. .TP @@ -113,8 +112,10 @@ A Tcl command enclosed in \fBbrackets\fR Command substitution is performed as according to the command substitution rule for \fBTcl\fR. .TP -A mathematical function such as \fBsin($x)\fR, whose arguments have any of the above -forms for operands. See \fBMATH FUNCTIONS\fR below for +A function call. +. +This is mathematical function such as \fBsin($x)\fR, whose arguments have any of +the above forms for operands. See \fBMATH FUNCTIONS\fR below for a discussion of how mathematical functions are handled. .RE .PP @@ -140,8 +141,8 @@ produces the value on the right side. For operators having both a numeric mode and a string mode, the numeric mode is chosen when all operands have a numeric interpretation. The integer interpretation of an operand is preferred over the floating-point -interpretation. To ensure string operations on arbitrary values it is generally a -good idea to use \fBeq\fR, \fBne\fR, or the \fBstring\fR command instead of +interpretation. To ensure string operations on arbitrary values it is generally +a good idea to use \fBeq\fR, \fBne\fR, or the \fBstring\fR command instead of more versatile operators such as \fB==\fR. .PP Unless otherwise specified, operators accept non-numeric operands. The value @@ -201,7 +202,7 @@ comparison operators below, which have the same precedence. Boolean string comparisons: less than, greater than, less than or equal, and greater than or equal. These always compare values using their UNICODE strings (also see \fBstring compare\fR), unlike with the numeric-preferring -comparisons abov, which have the same precedence. +comparisons above, which have the same precedence. .VE "8.7, TIP461" .TP 20 \fB==\0\0!=\fR @@ -289,8 +290,8 @@ For more details on the results produced by each operator, see the documentation for C. .SS "MATH FUNCTIONS" .PP -A mathematical function such as \fBsin($x)\fR is replaced with a call to an ordinary -Tcl command in the \fBtcl::mathfunc\fR namespace. The evaluation +A mathematical function such as \fBsin($x)\fR is replaced with a call to an +ordinary Tcl command in the \fBtcl::mathfunc\fR namespace. The evaluation of an expression such as .PP .CS @@ -310,12 +311,13 @@ tcl::mathfunc::sin [\fBexpr\fR {$x+$y}] .CE .PP \fBtcl::mathfunc::sin\fR is resolved as described in -\fBNAMESPACE RESOLUTION\fR in the \fBnamespace\fR(n) documentation. Given the +\fBNAMESPACE RESOLUTION\fR in the \fBnamespace\fR(n) documentation. Given the default value of \fBnamespace path\fR, \fB[namespace current]::tcl::mathfunc::sin\fR or \fB::tcl::mathfunc::sin\fR are the typical resolutions. .PP -As in C, a mathematical function may accept multiple arguments separated by commas. Thus, +As in C, a mathematical function may accept multiple arguments separated by +commas. Thus, .PP .CS \fBexpr\fR {hypot($x,$y)} @@ -386,13 +388,12 @@ the expression, resulting in better speed and smaller storage requirements. This also avoids issues that can arise if Tcl is allowed to perform substitution on the value before \fBexpr\fR is called. .PP -In the following example, the value of the expression is 11 because the Tcl parser first -substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR as part -of evaluating the expression +In the following example, the value of the expression is 11 because the Tcl +parser first substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR as +part of evaluating the expression .QW "$a + 2*4" . -Enclosing the -expression in braces would result in a syntax error as \fB$b\fR does -not evaluate to a numeric value. +Enclosing the expression in braces would result in a syntax error as \fB$b\fR +does not evaluate to a numeric value. .PP .CS set a 3 diff --git a/doc/fconfigure.n b/doc/fconfigure.n index e265fc4..468cd62 100644 --- a/doc/fconfigure.n +++ b/doc/fconfigure.n @@ -41,8 +41,10 @@ entry for the command that creates each type of channels for the options that that specific type of channel supports. For example, see the manual entry for the \fBsocket\fR command for additional options for sockets, and the \fBopen\fR command for additional options for serial devices. +.\" OPTION: -blocking .TP \fB\-blocking\fI boolean\fR +. The \fB\-blocking\fR option determines whether I/O operations on the channel can cause the process to block indefinitely. The value of the option must be a proper boolean value. @@ -54,6 +56,7 @@ see the documentation for those commands for details. For nonblocking mode to work correctly, the application must be using the Tcl event loop (e.g. by calling \fBTcl_DoOneEvent\fR or invoking the \fBvwait\fR command). +.\" OPTION: -buffering .TP \fB\-buffering\fI newValue\fR . @@ -67,6 +70,7 @@ automatically after every output operation. The default is for connect to terminal-like devices; for these channels the initial setting is \fBline\fR. Additionally, \fBstdin\fR and \fBstdout\fR are initially set to \fBline\fR, and \fBstderr\fR is set to \fBnone\fR. +.\" OPTION: -buffersize .TP \fB\-buffersize\fI newSize\fR . @@ -74,6 +78,7 @@ initially set to \fBline\fR, and \fBstderr\fR is set to \fBnone\fR. buffers, in bytes, subsequently allocated for this channel to store input or output. \fINewvalue\fR must be between one and one million, allowing buffers of one to one million bytes in size. +.\" OPTION: -encoding .TP \fB\-encoding\fI name\fR . @@ -100,6 +105,7 @@ The default encoding for newly opened channels is the same platform- and locale-dependent system encoding used for interfacing with the operating system, as returned by \fBencoding system\fR. .RE +.\" OPTION: -eofchar .TP \fB\-eofchar\fI char\fR . @@ -113,6 +119,7 @@ The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7F; attempting to set \fB\-eofchar\fR to a value outside of this range will generate an error. .VS "TCL8.7 TIP656" +.\" OPTION: -profile .TP \fB\-profile\fI profile\fR . @@ -122,6 +129,7 @@ rules of that profile. Any failures will result in a channel error. See \fBPROFILES\fR in the \fBencoding(n)\fR documentation for details about encoding profiles. .VE "TCL8.7 TIP656" +.\" OPTION: -translation .TP \fB\-translation\fI mode\fR .TP @@ -150,9 +158,7 @@ you can specify a single value that will apply to both reading and writing. When querying the translation mode of a read-write channel, a two-element list will always be returned. The following values are currently supported: -.TP -\fBauto\fR -. +.IP \fBauto\fR As the input translation mode, \fBauto\fR treats any of newline (\fBlf\fR), carriage return (\fBcr\fR), or carriage return followed by a newline (\fBcrlf\fR) as the end of line representation. The end of line @@ -162,9 +168,7 @@ chooses a platform specific representation; for sockets on all platforms Tcl chooses \fBcrlf\fR, for all Unix flavors, it chooses \fBlf\fR, and for the various flavors of Windows it chooses \fBcrlf\fR. The default setting for \fB\-translation\fR is \fBauto\fR for both input and output. -.TP -\fBbinary\fR -. +.IP \fBbinary\fR No end-of-line translations are performed. This is nearly identical to \fBlf\fR mode, except that in addition \fBbinary\fR mode also sets the end-of-file character to the empty string (which disables it) and sets the @@ -177,17 +181,13 @@ translator this value \fBis\fR identical to \fBlf\fR and is therefore reported as such when queried. Even if \fBbinary\fR was used to set the translation. .RE -.TP -\fBcr\fR -. +.IP \fBcr\fR The end of a line in the underlying file or device is represented by a single carriage return character. As the input translation mode, \fBcr\fR mode converts carriage returns to newline characters. As the output translation mode, \fBcr\fR mode translates newline characters to carriage returns. -.TP -\fBcrlf\fR -. +.IP \fBcrlf\fR The end of a line in the underlying file or device is represented by a carriage return character followed by a linefeed character. As the input translation mode, \fBcrlf\fR mode converts carriage-return-linefeed @@ -195,9 +195,7 @@ sequences to newline characters. As the output translation mode, \fBcrlf\fR mode translates newline characters to carriage-return-linefeed sequences. This mode is typically used on Windows platforms and for network connections. -.TP -\fBlf\fR -. +.IP \fBlf\fR The end of a line in the underlying file or device is represented by a single newline (linefeed) character. In this mode no translations occur during either input or output. This mode is typically used on UNIX @@ -249,7 +247,7 @@ Read a PPM-format image from a file: .CS # Open the file and put it into Unix ASCII mode set f [open teapot.ppm] -\fBfconfigure\fR $f \-encoding ascii \-translation lf +\fBfconfigure\fR $f -encoding ascii -translation lf # Get the header if {[gets $f] ne "P6"} { @@ -271,7 +269,7 @@ lassign $words xSize ySize depth # Now switch to binary mode to pull in the data, # one byte per channel (red,green,blue) per pixel. -\fBfconfigure\fR $f \-translation binary +\fBfconfigure\fR $f -translation binary set numDataBytes [expr {3 * $xSize * $ySize}] set data [read $f $numDataBytes] @@ -282,8 +280,8 @@ close(n), encoding(n), flush(n), gets(n), open(n), puts(n), read(n), socket(n), Tcl_StandardChannels(3) .SH KEYWORDS blocking, buffering, carriage return, end of line, encoding, flushing, linemode, -newline, nonblocking, platform, profile, translation, encoding, filter, byte array, -binary +newline, nonblocking, platform, profile, translation, encoding, filter, +byte array, binary '\" Local Variables: '\" mode: nroff '\" End: diff --git a/doc/fcopy.n b/doc/fcopy.n index 2eafdd7..e044fb7 100644 --- a/doc/fcopy.n +++ b/doc/fcopy.n @@ -16,20 +16,20 @@ fcopy \- Copy data from one channel to another .BE .SH DESCRIPTION .PP -The \fBfcopy\fR command copies data from one I/O channel, \fIinchan\fR to another I/O channel, \fIoutchan\fR. +The \fBfcopy\fR command copies data from one I/O channel, \fIinchan\fR, to +another I/O channel, \fIoutchan\fR. The \fBfcopy\fR command leverages the buffering in the Tcl I/O system to avoid extra copies and to avoid buffering too much data in main memory when copying large files to destinations like network sockets. -. .SS "DATA QUANTITY" All data until \fIEOF\fR is copied. -In addition, the quantity of copied data may be specified by the option \fB-size\fR. -The given size is in bytes, if the input channel is in binary mode. -Otherwise, it is in characters. +In addition, the quantity of copied data may be specified by the option +\fB\-size\fR. The given size is in bytes, if the input channel is in binary +mode. Otherwise, it is in characters. .PP -Depreciated feature: the transfer is treated as a binary transfer, if the encoding -profile is set to +Depreciated feature: the transfer is treated as a binary transfer, if the +encoding profile is set to .QW tcl8 and the input encoding matches the output encoding. In this case, eventual encoding errors are not handled. @@ -69,7 +69,8 @@ then all data already queued for \fIoutchan\fR is written out. Note that \fIinchan\fR can become readable during a background copy. You should turn off any \fBfileevent\fR handlers during a background copy so those handlers do not interfere with the copy. -Any wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) will get a +Any wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) will +get a .QW "channel busy" error. . @@ -109,15 +110,16 @@ channel is configured to the .QW strict encoding profile. .PP -If an encoding error arises on the input channel, any data before the error byte is -written to the output channel. The input file pointer is located just before the -values causing the encoding error. +If an encoding error arises on the input channel, any data before the error +byte is written to the output channel. The input file pointer is located just +before the values causing the encoding error. Error inspection or recovery is possible by changing the encoding parameters and invoking a file command (\fBread\fR, \fBfcopy\fR). .PP -If an encoding error arises on the output channel, the errorneous data is lost. -To make the difference between the input error case and the output error case, only the -error message may be inspected (read or write), as both throw the error code \fIEILSEQ\fR. +If an encoding error arises on the output channel, the erroneous data is lost. +To make the difference between the input error case and the output error case, +only the error message may be inspected (read or write), as both throw the +error code \fIEILSEQ\fR. .SH EXAMPLES .PP The first example transfers the contents of one channel exactly to diff --git a/doc/file.n b/doc/file.n index f35f40e..d37ed22 100644 --- a/doc/file.n +++ b/doc/file.n @@ -62,7 +62,7 @@ write permission for the file's group and other users. An \fBls\fR-style string of the form \fBrwxrwxrwx\fR is also accepted but must always be 9 characters long. E.g., \fBrwxr-xr-t\fR is equivalent to \fB01755\fR. On versions of Unix supporting file flags, -\fB-readonly\fR returns the value of, or sets, or clears the readonly +\fB\-readonly\fR returns the value of, or sets, or clears the readonly attribute of a file, i.e., the user immutable flag (\fBuchg\fR) to the \fBchflags\fR command. .PP @@ -86,14 +86,40 @@ off the file. .PP On all platforms, files in \fBzipfs\fR mounted archives return the following attributes. These are all read-only and cannot be directly set. -\fB-archive\fR gives the path of the mounted ZIP archive containing the file. -\fB-compsize\fR gives the compressed size of the file within the archive. -This is \fB0\fR for directories. -\fB-crc\fR gives the CRC of the file if present, else \fB0\fR. -\fB-mount\fR gives the path where the containing archive is mounted. -\fB-offset\fR gives the offset of the file within the archive. -\fB-uncompsize\fR gives the uncompressed size of the file. +.RS +.\" OPTION: -archive +.TP +\fB\-archive\fR +. +The path of the mounted ZIP archive containing the file. +.\" OPTION: -compsize +.TP +\fB\-compsize\fR +. +The compressed size of the file within the archive. This is \fB0\fR for directories. +.\" OPTION: -crc +.TP +\fB\-crc\fR +. +The CRC of the file if present, else \fB0\fR. +.\" OPTION: -mount +.TP +\fB\-mount\fR +. +The path where the containing archive is mounted. +.\" OPTION: -offset +.TP +\fB\-offset\fR +. +The offset of the file within the archive. +.\" OPTION: -uncompsize +.TP +\fB\-uncompsize\fR +. +The uncompressed size of the file. This is \fB0\fR for directories. +.RE +.PP Other attributes may be present in the returned list. These should be ignored. .RE @@ -503,7 +529,7 @@ between platforms: .\" METHOD: tempfile .TP \fBfile tempfile\fR ?\fInameVar\fR? ?\fItemplate\fR? -'\" TIP #210 +.\" TIP #210 Creates a temporary file and returns a read-write channel opened on that file. If the \fInameVar\fR is given, it specifies a variable that the name of the temporary file will be written into; if absent, Tcl will attempt to arrange @@ -564,12 +590,12 @@ Returns \fB1\fR if file \fIname\fR is writable by the current user, \fB0\fR otherwise. .SH "PORTABILITY ISSUES" .TP -\fBUnix\fR\0\0\0\0\0\0\0 +\fBUnix\fR . These commands always operate using the real user and group identifiers, not the effective ones. .TP -\fBWindows\fR\0\0\0\0 +\fBWindows\fR . The \fBfile owned\fR subcommand uses the user identifier (SID) of the process token, not the thread token which may be impersonating @@ -591,7 +617,7 @@ proc findMatchingCFiles {dir} { set ext .o } } - foreach file [glob \-nocomplain \-directory $dir *.c] { + foreach file [glob -nocomplain -directory $dir *.c] { set objectFile [\fBfile tail\fR [\fBfile rootname\fR $file]]$ext if {[\fBfile exists\fR $objectFile]} { lappend files $file @@ -612,7 +638,7 @@ if {![\fBfile isdirectory\fR [\fBfile dirname\fR $newName]]} { \fBfile mkdir\fR [\fBfile dirname\fR $newName] } \fBfile rename\fR $oldName $newName -\fBfile link\fR \-symbolic $oldName $newName +\fBfile link\fR -symbolic $oldName $newName .CE .PP On Windows, a file can be diff --git a/doc/filename.n b/doc/filename.n index 29ff1d7..373a8ee 100644 --- a/doc/filename.n +++ b/doc/filename.n @@ -41,6 +41,7 @@ The rules for native names depend on the value reported in the Tcl \fBplatform\fR element of the \fBtcl_platform\fR array: .TP 10 \fBUnix\fR +. On Unix and Apple MacOS X platforms, Tcl uses path names where the components are separated by slashes. Path names may be relative or absolute, and file names may contain any character other than slash. @@ -58,28 +59,35 @@ The following examples illustrate various forms of path names: .TP 15 \fB/\fR +. Absolute path to the root directory. .TP 15 \fB/etc/passwd\fR +. Absolute path to the file named \fBpasswd\fR in the directory \fBetc\fR in the root directory. .TP 15 \fB\&.\fR +. Relative path to the current directory. .TP 15 \fBfoo\fR +. Relative path to the file \fBfoo\fR in the current directory. .TP 15 \fBfoo/bar\fR +. Relative path to the file \fBbar\fR in the directory \fBfoo\fR in the current directory. .TP 15 \fB\&../foo\fR +. Relative path to the file \fBfoo\fR in the directory above the current directory. .RE .TP \fBWindows\fR +. On Microsoft Windows platforms, Tcl supports both drive-relative and UNC style names. Both \fB/\fR and \fB\e\fR may be used as directory separators in either type of name. Drive-relative names consist of an optional drive @@ -93,28 +101,34 @@ following examples illustrate various forms of path names: .RS .TP 15 \fB\&\e\eHost\eshare/file\fR +. Absolute UNC path to a file called \fBfile\fR in the root directory of the export point \fBshare\fR on the host \fBHost\fR. Note that repeated use of \fBfile dirname\fR on this path will give \fB//Host/share\fR, and will never give just \fB//Host\fR. .TP 15 \fBc:foo\fR +. Volume-relative path to a file \fBfoo\fR in the current directory on drive \fBc\fR. .TP 15 \fBc:/foo\fR +. Absolute path to a file \fBfoo\fR in the root directory of drive \fBc\fR. .TP 15 \fBfoo\ebar\fR +. Relative path to a file \fBbar\fR in the \fBfoo\fR directory in the current directory on the current volume. .TP 15 \fB\&\efoo\fR +. Volume-relative path to a file \fBfoo\fR in the root directory of the current volume. .TP 15 \fB\&\e\efoo\fR +. Volume-relative path to a file \fBfoo\fR in the root directory of the current volume. This is not a valid UNC path, so the assumption is that the extra backslashes are superfluous. diff --git a/doc/for.n b/doc/for.n index 759b66e..99d6003 100644 --- a/doc/for.n +++ b/doc/for.n @@ -37,7 +37,7 @@ The operation of \fBbreak\fR and \fBcontinue\fR are similar to the corresponding statements in C. \fBFor\fR returns an empty string. .PP -Note: \fItest\fR should almost always be enclosed in braces. If not, +Note that \fItest\fR should almost always be enclosed in braces. If not, variable substitutions will be made before the \fBfor\fR command starts executing, which means that variable changes made by the loop body will not be considered in the expression. diff --git a/doc/format.n b/doc/format.n index 1e70995..79de204 100644 --- a/doc/format.n +++ b/doc/format.n @@ -63,25 +63,20 @@ then all of the specifiers must be positional. .PP The second portion of a conversion specifier may contain any of the following flag characters, in any order: -.TP 10 -\fB\-\fR +.IP \fB\-\fR 10 Specifies that the converted argument should be left-justified in its field (numbers are normally right-justified with leading spaces if needed). -.TP 10 -\fB+\fR +.IP \fB+\fR 10 Specifies that a number should always be printed with a sign, even if positive. -.TP 10 -\fIspace\fR +.IP \fIspace\fR 10 Specifies that a space should be added to the beginning of the number if the first character is not a sign. -.TP 10 -\fB0\fR +.IP \fB0\fR 10 Specifies that the number should be padded on the left with zeroes instead of spaces. -.TP 10 -\fB#\fR +.IP \fB#\fR 10 Requests an alternate output form. For \fBo\fR conversions, \fB0o\fR will be added to the beginning of the result unless it is zero. For \fBx\fR or \fBX\fR conversions, \fB0x\fR @@ -125,8 +120,8 @@ be omitted unless the \fB#\fR flag has been specified). For integer conversions, it specifies a minimum number of digits to print (leading zeroes will be added if necessary). For \fBs\fR conversions it specifies the maximum number of characters to be -printed; if the string is longer than this then the trailing characters will be dropped. -If the precision is specified with \fB*\fR rather than a number +printed; if the string is longer than this then the trailing characters will +be dropped. If the precision is specified with \fB*\fR rather than a number then the next argument to the \fBformat\fR command determines the precision; it must be a numeric string. .SS "OPTIONAL SIZE MODIFIER" @@ -152,67 +147,53 @@ determined by the value of the \fBwordSize\fR element of the The last thing in a conversion specifier is an alphabetic character that determines what kind of conversion to perform. The following conversion characters are currently supported: -.TP 10 -\fBd\fR +.IP \fBd\fR 10 Convert integer to signed decimal string. -.TP 10 -\fBu\fR +.IP \fBu\fR 10 Convert integer to unsigned decimal string. -.TP 10 -\fBi\fR +.IP \fBi\fR 10 Convert integer to signed decimal string (equivalent to \fBd\fR). -.TP 10 -\fBo\fR +.IP \fBo\fR 10 Convert integer to unsigned octal string. -.TP 10 -\fBx\fR or \fBX\fR +.IP "\fBx\fR or \fBX\fR" 10 Convert integer to unsigned hexadecimal string, using digits .QW 0123456789abcdef for \fBx\fR and .QW 0123456789ABCDEF for \fBX\fR). -.TP 10 -\fBb\fR +.IP \fBb\fR 10 Convert integer to unsigned binary string, using digits 0 and 1. -.TP 10 -\fBc\fR +.IP \fBc\fR 10 Convert integer to the Unicode character it represents. -.TP 10 -\fBs\fR +.IP \fBs\fR 10 No conversion; just insert string. -.TP 10 -\fBf\fR +.IP \fBf\fR 10 Convert number to signed decimal string of the form \fIxx.yyy\fR, where the number of \fIy\fR's is determined by the precision (default: 6). If the precision is 0 then no decimal point is output. -.TP 10 -\fBe\fR or \fBE\fR +.IP "\fBe\fR or \fBE\fR" 10 Convert number to scientific notation in the form \fIx.yyy\fBe\(+-\fIzz\fR, where the number of \fIy\fR's is determined by the precision (default: 6). If the precision is 0 then no decimal point is output. If the \fBE\fR form is used then \fBE\fR is printed instead of \fBe\fR. -.TP 10 -\fBg\fR or \fBG\fR +.IP "\fBg\fR or \fBG\fR" 10 If the exponent is less than \-4 or greater than or equal to the precision, then convert number as for \fB%e\fR or \fB%E\fR. Otherwise convert as for \fB%f\fR. Trailing zeroes and a trailing decimal point are omitted. -.TP 10 -\fBa\fR or \fBA\fR +.IP "\fBa\fR or \fBA\fR" 10 Convert double to hexadecimal notation in the form \fI0x1.yyy\fBp\(+-\fIzz\fR, where the number of \fIy\fR's is determined by the precision (default: 13). If the \fBA\fR form is used then the hex characters are printed in uppercase. -.TP 10 -\fB%\fR +.IP \fB%\fR 10 No conversion: just insert \fB%\fR. -.TP 10 -\fBp\fR +.IP \fBp\fR 10 Shorthand form for \fB0x%zx\fR, so it outputs the integer in hexadecimal form with \fB0x\fR prefix. .SH "DIFFERENCES FROM ANSI SPRINTF" diff --git a/doc/fpclassify.n b/doc/fpclassify.n index b6eb0e6..18722dc 100644 --- a/doc/fpclassify.n +++ b/doc/fpclassify.n @@ -19,26 +19,16 @@ package require \fBtcl 8.7\fR .SH DESCRIPTION The \fBfpclassify\fR command takes a floating point number, \fIvalue\fR, and returns one of the following strings that describe it: -.TP -\fBzero\fR -. +.IP \fBzero\fR \fIvalue\fR is a floating point zero. -.TP -\fBsubnormal\fR -. +.IP \fBsubnormal\fR \fIvalue\fR is the result of a gradual underflow. -.TP -\fBnormal\fR -. +.IP \fBnormal\fR \fIvalue\fR is an ordinary floating-point number (not zero, subnormal, infinite, nor NaN). -.TP -\fBinfinite\fR -. +.IP \fBinfinite\fR \fIvalue\fR is a floating-point infinity. -.TP -\fBnan\fR -. +.IP \fBnan\fR \fIvalue\fR is Not-a-Number. .PP The \fBfpclassify\fR command throws an error if value is not a floating-point diff --git a/doc/glob.n b/doc/glob.n index 840d1b7..f93d6e6 100644 --- a/doc/glob.n +++ b/doc/glob.n @@ -28,6 +28,7 @@ in the list, so if a sorted list is required the caller should use If the initial arguments to \fBglob\fR start with \fB\-\fR then they are treated as switches. The following switches are currently supported: +.\" OPTION: -directory .TP \fB\-directory\fI directory\fR . @@ -37,17 +38,20 @@ contains glob-sensitive characters without the need to quote such characters explicitly. This option may not be used in conjunction with \fB\-path\fR, which is used to allow searching for complete file paths whose names may contain glob-sensitive characters. +.\" OPTION: -join .TP \fB\-join\fR . The remaining pattern arguments, after option processing, are treated as a single pattern obtained by joining the arguments with directory separators. +.\" OPTION: -nocomplain .TP \fB\-nocomplain\fR . Allows an empty list to be returned without error; This is the default behavior in Tcl 9.0, so this switch has no effect any more. +.\" OPTION: -path .TP \fB\-path\fI pathPrefix\fR . @@ -61,6 +65,7 @@ as $path, but differing extensions, you should use .QW "\fBglob \-path [file rootname $path] .*\fR" which will work even if \fB$path\fR contains numerous glob-sensitive characters. +.\" OPTION: -tails .TP \fB\-tails\fR . @@ -74,6 +79,7 @@ For \fB\-path\fR specifications, the returned names will include the last path segment, so .QW "\fBglob \-tails \-path [file rootname /home/fred/foo.tex] .*\fR" will return paths like \fBfoo.aux foo.bib foo.tex\fR etc. +.\" OPTION: -types .TP \fB\-types\fI typeList\fR . @@ -116,6 +122,7 @@ except that the first case doesn't return the trailing .QW / and is more platform independent. .RE +.\" OPTION: -- .TP \fB\-\|\-\fR . @@ -126,27 +133,17 @@ be treated as a \fIpattern\fR even if it starts with a \fB\-\fR. The \fIpattern\fR arguments may contain any of the following special characters, which are a superset of those supported by \fBstring match\fR: -.TP 10 -\fB?\fR -. +.IP \fB?\fR 10 Matches any single character. -.TP 10 -\fB*\fR -. +.IP \fB*\fR 10 Matches any sequence of zero or more characters. -.TP 10 -\fB[\fIchars\fB]\fR -. +.IP \fB[\fIchars\fB]\fR 10 Matches any single character in \fIchars\fR. If \fIchars\fR contains a sequence of the form \fIa\fB\-\fIb\fR then any character between \fIa\fR and \fIb\fR (inclusive) will match. -.TP 10 -\fB\e\fIx\fR -. +.IP \fB\e\fIx\fR 10 Matches the character \fIx\fR. -.TP 10 -\fB{\fIa\fB,\fIb\fB,\fI...\fR} -. +.IP \fB{\fIa\fB,\fIb\fB,\fI...\fB}\fR 10 Matches any of the sub-patterns \fIa\fR, \fIb\fR, etc. .PP On Unix, as with csh, a diff --git a/doc/history.n b/doc/history.n index 30a5eeb..1c2b581 100644 --- a/doc/history.n +++ b/doc/history.n @@ -37,8 +37,8 @@ matches the event in the sense of the \fBstring match\fR command. The \fBhistory\fR command can take any of the following forms: .TP \fBhistory\fR -Same -as \fBhistory info\fR, described below. +. +Same as \fBhistory info\fR, described below. .\" METHOD: add .TP \fBhistory add\fI command \fR?\fBexec\fR? diff --git a/doc/http.n b/doc/http.n index f35e917..93efbac 100644 --- a/doc/http.n +++ b/doc/http.n @@ -104,7 +104,7 @@ The response itself is returned by command \fB::http::responseBody\fR, unless it has been redirected to a file by the \fI\-channel\fR option of \fB::http::geturl\fR. .SH COMMANDS -.\" METHOD: config +.\" COMMAND: config .TP \fB::http::config\fR ?\fIoptions\fR? . @@ -116,6 +116,7 @@ of the flags described below. In this case the current value of that setting is returned. Otherwise, the options should be a set of flags and values that define the configuration: .RS +.\" OPTION: -accept .TP \fB\-accept\fI mimetypes\fR . @@ -124,6 +125,7 @@ all types of documents are accepted. Otherwise you can supply a comma-separated list of mime type patterns that you are willing to receive. For example, .QW "image/gif, image/jpeg, text/*" . +.\" OPTION: -cookiejar .TP \fB\-cookiejar\fI command\fR .VS TIP406 @@ -133,12 +135,14 @@ default value) is used, no cookies will be sent by requests or stored from responses. The command indicated by \fIcommand\fR, if supplied, must obey the \fBCOOKIE JAR PROTOCOL\fR described below. .VE TIP406 +.\" OPTION: -pipeline .TP \fB\-pipeline\fI boolean\fR . Specifies whether HTTP/1.1 transactions on a persistent socket will be pipelined. See the \fBPERSISTENT SOCKETS\fR section for details. The default is 1. +.\" OPTION: -postfresh .TP \fB\-postfresh\fI boolean\fR . @@ -146,6 +150,7 @@ Specifies whether requests that use the \fBPOST\fR method will always use a fresh socket, overriding the \fB\-keepalive\fR option of command \fBhttp::geturl\fR. See the \fBPERSISTENT SOCKETS\fR section for details. The default is 0. +.\" OPTION: -proxyauth .TP \fB\-proxyauth\fI string\fR . @@ -156,6 +161,7 @@ technique, e.g. Digest Authentication, the \fB\-proxyauth\fR option is not useful. In that case the caller must expect a 407 response from the proxy, compute the authentication value to be supplied, and use the \fB\-headers\fR option to supply it as the value of the Proxy-Authorization header. +.\" OPTION: -proxyfilter .TP \fB\-proxyfilter\fI command\fR . @@ -183,12 +189,14 @@ a \fBcatch\fR command. Therefore an error in the callback command does not call the \fBbgerror\fR handler. See the \fBERRORS\fR section for details. .RE +.\" OPTION: -proxyhost .TP \fB\-proxyhost\fI hostname\fR . The host name or IP address of the proxy server, if any. If this value is the empty string, the URL host is contacted directly. See \fB\-proxyfilter\fR for how the value is used. +.\" OPTION: -proxynot .TP \fB\-proxynot\fI list\fR . @@ -198,11 +206,13 @@ element using a case-insensitive \fBstring match\fR. It is often convenient to use the wildcard "*" at the start of a domain name (e.g. *.example.com) or at the end of an IP address (e.g. 192.168.0.*). See \fB\-proxyfilter\fR for how the value is used. +.\" OPTION: -proxyport .TP \fB\-proxyport\fI number\fR . The port number of the proxy server. See \fB\-proxyfilter\fR for how the value is used. +.\" OPTION: -repost .TP \fB\-repost\fI boolean\fR . @@ -215,30 +225,34 @@ that uses \fBhttp::geturl\fR is expected to seek user confirmation before retrying the POST. The value \fBtrue\fR should be used only under certain conditions. See the \fBPERSISTENT SOCKETS\fR section for details. The default is 0. +.\" OPTION: -threadlevel .TP \fB\-threadlevel\fI level\fR . Specifies whether and how to use the \fBThread\fR package. Possible values of \fIlevel\fR are 0, 1 or 2. .RS +.IP \fB0\fR +(the default) do not use Thread +.IP \fB1\fR +use Thread if it is available, do not use it if it is unavailable +.IP \fB2\fR +use Thread if it is available, raise an error if it is unavailable .PP -.DS -0 - (the default) do not use Thread -1 - use Thread if it is available, do not use it if it is unavailable -2 - use Thread if it is available, raise an error if it is unavailable -.DE The Tcl \fBsocket -async\fR command can block in adverse cases (e.g. a slow DNS lookup). Using the Thread package works around this problem, for both HTTP and HTTPS transactions. Values of \fIlevel\fR other than 0 are available only to the main interpreter in each thread. See section \fBTHREADS\fR for more information. .RE +.\" OPTION: -urlencoding .TP \fB\-urlencoding\fI encoding\fR . The \fIencoding\fR used for creating the x-url-encoded URLs with \fB::http::formatQuery\fR and \fB::http::quoteString\fR. The default is \fButf-8\fR, as specified by RFC 2718. +.\" OPTION: -useragent .TP \fB\-useragent\fI string\fR . @@ -249,6 +263,7 @@ the version numbers of \fBhttp\fR and \fBTcl\fR, and is (for example) A safe interpreter cannot determine its operating system, and so the default in a safe interpreter is to use a Windows 10 value with the current version numbers of \fBhttp\fR and \fBTcl\fR. +.\" OPTION: -zip .TP \fB\-zip\fI boolean\fR . @@ -260,7 +275,7 @@ In either case the default can be overridden for an individual request by supplying a custom \fBAccept-Encoding\fR header in the \fB\-headers\fR option of \fBhttp::geturl\fR. The default value is 1. .RE -.\" METHOD: geturl +.\" COMMAND: geturl .TP \fB::http::geturl\fI url\fR ?\fIoptions\fR? . @@ -276,6 +291,7 @@ completes, unless the \fB\-command\fR option specifies a callback that is invoked when the HTTP transaction completes. \fB::http::geturl\fR takes several options: .RS +.\" OPTION: -binary .TP \fB\-binary\fI boolean\fR . @@ -283,17 +299,20 @@ Specifies whether to force interpreting the URL data as binary. Normally this is auto-detected (anything not beginning with a \fBtext\fR content type or whose content encoding is \fBgzip\fR or \fBdeflate\fR is considered binary data). +.\" OPTION: -blocksize .TP \fB\-blocksize\fI size\fR . The block size used when reading the URL. At most \fIsize\fR bytes are read at once. After each block, a call to the \fB\-progress\fR callback is made (if that option is specified). +.\" OPTION: -channel .TP \fB\-channel\fI name\fR . Copy the URL contents to channel \fIname\fR instead of saving it in a Tcl variable for retrieval by \fB::http::responseBody\fR. +.\" OPTION: -command .TP \fB\-command\fI callback\fR . @@ -320,6 +339,7 @@ a \fBcatch\fR command. Therefore an error in the callback command does not call the \fBbgerror\fR handler. See the \fBERRORS\fR section for details. .RE +.\" OPTION: -guesstype .TP \fB\-guesstype\fI boolean\fR . @@ -333,7 +353,8 @@ detecting XML documents that begin with an XML declaration. In this case the \fBContent-Type\fR is changed to "application/xml", the binary flag state(binary) is changed to 0, and the character set is changed to the one specified by the "encoding" tag of the XML line, or to utf-8 if no -encoding is specified. Not used if a \fI\-channel\fR is specified. +encoding is specified. Not used if a \fB\-channel\fR is specified. +.\" OPTION: -handler .TP \fB\-handler\fI callback\fR . @@ -381,6 +402,7 @@ a \fBcatch\fR command. Therefore an error in the callback command does not call the \fBbgerror\fR handler. See the \fBERRORS\fR section for details. .RE +.\" OPTION: -headers .TP \fB\-headers\fI keyvaluelist\fR . @@ -398,11 +420,13 @@ HTTP request: Pragma: no-cache .CE .RE +.\" OPTION: -keepalive .TP \fB\-keepalive\fI boolean\fR . If boolean \fBtrue\fR, attempt to keep the connection open for servicing multiple requests. Default is 0. +.\" OPTION: -method .TP \fB\-method\fI type\fR . @@ -420,11 +444,13 @@ caller must also supply the option \-headers {Content-Length 0} .CE .RE +.\" OPTION: -myaddr .TP \fB\-myaddr\fI address\fR . Pass an specific local address to the underlying \fBsocket\fR call in case multiple interfaces are available. +.\" OPTION: -progress .TP \fB\-progress\fI callback\fR . @@ -451,12 +477,14 @@ proc httpProgress {token total current} { } .CE .RE +.\" OPTION: -protocol .TP \fB\-protocol\fI version\fR . Select the HTTP protocol version to use. This should be 1.0 or 1.1 (the default). Should only be necessary for servers that do not understand or otherwise complain about HTTP/1.1. +.\" OPTION: -query .TP \fB\-query\fI query\fR . @@ -475,6 +503,7 @@ x-url-encoding formatted query-string (this \fB\-type\fR and query format are used in a POST submitted from an html form). The \fB::http::formatQuery\fR procedure can be used to do the formatting. .RE +.\" OPTION: -queryblocksize .TP \fB\-queryblocksize\fI size\fR . @@ -484,6 +513,7 @@ At most bytes are written at once. After each block, a call to the \fB\-queryprogress\fR callback is made (if that option is specified). +.\" OPTION: -querychannel .TP \fB\-querychannel\fI channelID\fR . @@ -495,6 +525,7 @@ If a \fBContent-Length\fR header is not specified via the \fB\-headers\fR options, \fB::http::geturl\fR attempts to determine the size of the post data in order to create that header. If it is unable to determine the size, it returns an error. +.\" OPTION: -queryprogress .TP \fB\-queryprogress\fI callback\fR . @@ -503,12 +534,14 @@ then the \fIcallback\fR is made after each transfer of data to the URL in a POST request (i.e. a call to \fB::http::geturl\fR with option \fB\-query\fR or \fB\-querychannel\fR) and acts exactly like the \fB\-progress\fR option (the callback format is the same). +.\" OPTION: -strict .TP \fB\-strict\fI boolean\fR . If true then the command will test that the URL complies with RFC 3986, i.e. that it has no characters that should be "x-url-encoded" (e.g. a space should be encoded to "%20"). Default value is 1. +.\" OPTION: -timeout .TP \fB\-timeout\fI milliseconds\fR . @@ -519,12 +552,14 @@ the \fB\-command\fR callback, if specified. The return value of \fB::http::status\fR (and the value of the \fIstatus\fR key in the dictionary returned by \fB::http::responseInfo\fR) is \fBtimeout\fR after a timeout has occurred. +.\" OPTION: -type .TP \fB\-type\fI mime-type\fR . Use \fImime-type\fR as the \fBContent-Type\fR value, instead of the default value (\fBapplication/x-www-form-urlencoded\fR) during a POST operation. +.\" OPTION: -validate .TP \fB\-validate\fI boolean\fR . @@ -535,7 +570,7 @@ would for a HTTP GET request, but omits the response entity transaction using command \fB::http::responseHeaders\fR or, for selected information, \fB::http::responseInfo\fR. .RE -.\" METHOD: formatQuery +.\" COMMAND: formatQuery .TP \fB::http::formatQuery\fI key value\fR ?\fIkey value\fR ...? . @@ -544,20 +579,20 @@ number of arguments that are the keys and values of the query. It encodes the keys and values, and generates one string that has the proper & and = separators. The result is suitable for the \fB\-query\fR value passed to \fB::http::geturl\fR. -.\" METHOD: quoteString +.\" COMMAND: quoteString .TP \fB::http::quoteString\fI value\fR . This procedure does x-url-encoding of string. It takes a single argument and encodes it. -.\" METHOD: reset +.\" COMMAND: reset .TP \fB::http::reset\fI token\fR ?\fIwhy\fR? . This command resets the HTTP transaction identified by \fItoken\fR, if any. This sets the \fBstate(status)\fR value to \fIwhy\fR, which defaults to \fBreset\fR, and then calls the registered \fB\-command\fR callback. -.\" METHOD: wait +.\" COMMAND: wait .TP \fB::http::wait\fI token\fR . @@ -568,7 +603,7 @@ uses \fBvwait\fR. Also, it is not useful for the case where because in this case the \fB::http::geturl\fR call does not return until the HTTP transaction is complete, and thus there is nothing to wait for. -.\" METHOD: status +.\" COMMAND: status .TP \fB::http::status\fI token\fR . @@ -582,20 +617,20 @@ section \fBERRORS\fR (below). The name "status" is not related to the terms "status line" and "status code" that are defined for a HTTP response. .RE -.\" METHOD: size +.\" COMMAND: size .TP \fB::http::size\fI token\fR . This command returns the number of bytes received so far from the URL in the \fB::http::geturl\fR call. -.\" METHOD: error +.\" COMMAND: error .TP \fB::http::error\fI token\fR . This command returns the error information if the HTTP transaction failed, or the empty string if there was no error. The information is a Tcl list of the error message, stack trace, and error code. -.\" METHOD: postError +.\" COMMAND: postError .TP \fB::http::postError\fI token\fR . @@ -607,7 +642,7 @@ string if there was no error. The information is a Tcl list of the error message, stack trace, and error code. When this type of error occurs, the \fB::http::geturl\fR command continues the transaction and attempts to receive a response from the server. -.\" METHOD: cleanup +.\" COMMAND: cleanup .TP \fB::http::cleanup\fI token\fR . @@ -619,7 +654,7 @@ this function after you are done with a given HTTP request. Not doing so will result in memory not being freed, and if your app calls \fB::http::geturl\fR enough times, the memory leak could cause a performance hit...or worse. -.\" METHOD: requestLine +.\" COMMAND: requestLine .TP \fB::http::requestLine\fI token\fR . @@ -633,7 +668,7 @@ GET / HTTP/1.1 GET /introduction.html?subject=plumbing HTTP/1.1 POST /forms/order.html HTTP/1.1 .RE -.\" METHOD: requestHeaders +.\" COMMAND: requestHeaders .TP \fB::http::requestHeaders\fI token\fR ?\fIheaderName\fR? . @@ -646,7 +681,7 @@ are returned. If two arguments are supplied, the second provides the value of a header name. Only headers with the requested name (converted to lower case) are returned. If no such headers are found, an empty list is returned. -.\" METHOD: requestHeaderValue +.\" COMMAND: requestHeaderValue .TP \fB::http::requestHeaderValue\fI token headerName\fR . @@ -656,7 +691,7 @@ lower case. If no such header exists, the return value is the empty string. If there are multiple headers named \fIheaderName\fR, the result is obtained by joining the individual values with the string ", " (comma and space), preserving their order. -.\" METHOD: responseLine +.\" COMMAND: responseLine .TP \fB::http::responseLine\fI token\fR . @@ -684,7 +719,7 @@ and can be changed without affecting the HTTP protocol. The recommended values (RFC 7231 and IANA assignments) for each code are provided by the command \fB::http::reasonPhrase\fR. .RE -.\" METHOD: responseCode +.\" COMMAND: responseCode .TP \fB::http::responseCode\fI token\fR . @@ -692,7 +727,7 @@ This command returns the "status code" (200, 404, etc.) of the server "status line". If a three-digit code cannot be found, the full status line is returned. See command \fB::http::responseLine\fR for more information on the "status line". -.\" METHOD: reasonPhrase +.\" COMMAND: reasonPhrase .TP \fB::http::reasonPhrase\fI code\fR . @@ -715,7 +750,7 @@ the "reason phrase" stored in key \fIreasonPhrase\fR). A registry of valid status codes is maintained at https://www.iana.org/assignments/http-status-codes/http-status-codes.xhtml .RE -.\" METHOD: responseHeaders +.\" COMMAND: responseHeaders .TP \fB::http::responseHeaders\fI token\fR ?\fIheaderName\fR? . @@ -731,7 +766,7 @@ supplied, it provides the value of a header name. Only headers with the requested name (converted to lower case) are returned. If no such headers are found, an empty list is returned. See section \fBMETADATA\fR for more information. -.\" METHOD: responseHeaderValue +.\" COMMAND: responseHeaderValue .TP \fB::http::responseHeaderValue\fI token headerName\fR . @@ -745,7 +780,7 @@ in this manner, except \fBSet-Cookie\fR which does not conform to the comma-separated-list syntax and cannot be combined into a single value. Each \fBSet-Cookie\fR header must be treated individually, e.g. by processing the return value of \fB::http::responseHeaders\fI token\fR \fBSet-Cookie\fR. -.\" METHOD: responseInfo +.\" COMMAND: responseInfo .TP \fB::http::responseInfo\fI token\fR . @@ -769,7 +804,7 @@ text resource as a binary, or vice versa. After a POST transaction, check the value of \fIpostError\fR to verify that the request body was uploaded without error. .RE -.\" METHOD: responseBody +.\" COMMAND: responseBody .TP \fB::http::responseBody\fI token\fR . @@ -783,7 +818,7 @@ Other terms for "resource", "response body after decoding", "payload", "message body after decoding", "content(s)", and "file". .RE -.\" METHOD: register +.\" COMMAND: register .TP \fB::http::register\fI proto port command\fR ?\fIsocketCmdVarName\fR? ?\fIuseSockThread\fR? ?\fIendToEndProxy\fR? . @@ -821,7 +856,6 @@ For example, .PP .CS package require http - package require tls ::http::register https 443 ::tls::socket ::tls::socketCmd 1 1 @@ -830,7 +864,7 @@ set token [::http::geturl https://my.secure.site/] .CE .RE .RE -.\" METHOD: registerError +.\" COMMAND: registerError .TP \fB::http::registerError\fI sock\fR ?\fImessage\fR? . @@ -842,7 +876,7 @@ propagate to \fBhttp\fR. The command allows \fBhttp\fR to provide a precise error message rather than a general one. The command returns the value provided by the last call with argument \fImessage\fR, or the empty string if no such call has been made. -.\" METHOD: unregister +.\" COMMAND: unregister .TP \fB::http::unregister\fI proto\fR . @@ -850,22 +884,22 @@ This procedure unregisters a protocol handler that was previously registered via \fB::http::register\fR, returning a six-item list of the values that were previously supplied to \fB::http::register\fR if there was such a handler, and an error if there was no such handler. -.\" METHOD: code +.\" COMMAND: code .TP \fB::http::code\fI token\fR . An alternative name for the command \fB::http::responseLine\fR -.\" METHOD: data +.\" COMMAND: data .TP \fB::http::data\fI token\fR . An alternative name for the command \fB::http::responseBody\fR. -.\" METHOD: meta +.\" COMMAND: meta .TP \fB::http::meta\fI token\fR ?\fIheaderName\fR? . An alternative name for the command \fB::http::responseHeaders\fR -.\" METHOD: ncode +.\" COMMAND: ncode .TP \fB::http::ncode\fI token\fR . @@ -916,41 +950,29 @@ determined by examining the status from \fB::http::status\fR (or the value of the \fIstatus\fR key in the dictionary returned by \fB::http::responseInfo\fR). These are described below. -.TP -\fBok\fR -. +.IP \fBok\fR If the HTTP transaction completes entirely, then status will be \fBok\fR. However, you should still check the \fB::http::responseLine\fR value to get the HTTP status. The \fB::http::responseCode\fR procedure provides just the numeric error (e.g., 200, 404 or 500) while the \fB::http::responseLine\fR procedure returns a value like .QW "HTTP 404 File not found" . -.TP -\fBeof\fR -. +.IP \fBeof\fR If the server closes the socket without replying, then no error is raised, but the status of the transaction will be \fBeof\fR. -.TP -\fBerror\fR -. +.IP \fBerror\fR The error message, stack trace, and error code are accessible via \fB::http::error\fR. The error message is also provided by the value of the \fIerror\fR key in the dictionary returned by \fB::http::responseInfo\fR. -.TP -\fBtimeout\fR -. +.IP \fBtimeout\fR A timeout occurred before the transaction could complete. -.TP -\fBreset\fR -. +.IP \fBreset\fR The user has called \fB::http::reset\fR. -.TP -\fB""\fR -. +.IP \fB""\fR (empty string) The transaction has not yet finished. .PP Another error possibility is that \fB::http::geturl\fR failed to -write the whole of the POST request body (\fB-query\fR or \fB-querychannel\fR +write the whole of the POST request body (\fB\-query\fR or \fB\-querychannel\fR data) to the server. \fB::http::geturl\fR stores the error message for later retrieval by the \fB::http::postError\fR or \fB::http::responseInfo\fR commands, and then attempts to complete the transaction. @@ -976,46 +998,35 @@ the \fBdict\fR are: .PP .RS .RS +.\" TODO: Find a better way to mark this up! \fB===== Essential Values =====\fR .RE .RE -.TP -\fBstage\fR -. +.IP \fBstage\fR This value, set by \fB::http::geturl\fR, describes the stage that the transaction has reached. Values, in order of the transaction lifecycle, are: "created", "connecting", "header", "body", and "complete". The other \fBdict\fR keys will not be available until the value of \fBstage\fR is "body" or "complete". The key \fBcurrentSize\fR has its final value only when \fBstage\fR is "complete". -.TP -\fBstatus\fR -. +.IP \fBstatus\fR This value, set by \fB::http::geturl\fR, is "ok" for a successful transaction; "eof", "error", "timeout", or "reset" for an unsuccessful transaction; or "" if the transaction is still in progress. The value is the same as that returned by command \fB::http::status\fR. The meaning of these values is described in the section \fBERRORS\fR (above). -.TP -\fBresponseCode\fR -. +.IP \fBresponseCode\fR The "HTTP status code" sent by the server in the first line (the "status line") of the response. If the value cannot be extracted from the status line, the full status line is returned. -.TP -\fBreasonPhrase\fR -. +.IP \fBreasonPhrase\fR The "reason phrase" sent by the server as a description of the HTTP status code. If the value cannot be extracted from the status line, the full status line is returned. -.TP -\fBcontentType\fR -. +.IP \fBcontentType\fR The value of the \fBContent-Type\fR response header or, if the header was not supplied, the default value "application/octet-stream". -.TP -\fBbinary\fR -. +.IP \fBbinary\fR This boolean value, set by \fB::http::geturl\fR, describes how the command has interpreted the entity returned by the server (after decoding any compression specified by the \fBContent-Encoding\fR response header). @@ -1027,7 +1038,7 @@ The value is \fBtrue\fR if http has interpreted the decoded entity as binary. The value returned by \fB::http::responseBody\fR is a Tcl binary string. This is a suitable format for image data, zip files, etc. \fB::http::geturl\fR chooses this value if the user has requested a binary -interpretation by passing the option \fI\-binary\fR to the command, or if the +interpretation by passing the option \fB\-binary\fR to the command, or if the server has supplied a binary content type in a \fBContent-Type\fR response header, or if the server has not supplied any \fBContent-Type\fR header. .PP @@ -1040,15 +1051,11 @@ It is always worth checking the value of "binary" after a HTTP transaction, to determine whether a misconfigured server has caused http to interpret a text resource as a binary, or vice versa. .RE -.TP -\fBredirection\fR -. +.IP \fBredirection\fR The URL that is the redirection target. The value is that of the \fBLocation\fR response header. This header is sent when a response has status code 3XX (redirection). -.TP -\fBupgrade\fR -. +.IP \fBupgrade\fR If not empty, the value indicates the protocol(s) to which the server will switch after completion of this transaction, while continuing to use the same connection. When the server intends to switch protocols, it will also @@ -1056,14 +1063,10 @@ send the value "101" as the status code (the \fBresponseCode\fR key), and the word "upgrade" as an element of the \fBConnection\fR response header (the \fBconnectionResponse\fR key), and it will not send a response body. See the section \fBPROTOCOL UPGRADES\fR for more information. -.TP -\fBerror\fR -. +.IP \fBerror\fR The error message, if there is one. Further information, including a stack trace and error code, are available from command \fB::http::error\fR. -.TP -\fBpostError\fR -. +.IP \fBpostError\fR The error message (if any) generated when a HTTP POST request sends its request-body to the server. Further information, including a stack trace and error code, are available from command \fB::http::postError\fR. A POST @@ -1077,13 +1080,9 @@ the request-body. \fB===== Informational Values =====\fR .RE .RE -.TP -\fBmethod\fR -. +.IP \fBmethod\fR The HTTP method used in the request. -.TP -\fBcharset\fR -. +.IP \fBcharset\fR The value of the charset attribute of the \fBContent-Type\fR response header. The charset value is used only for a text resource. If the server did not specify a charset, the value defaults to that of the @@ -1091,72 +1090,48 @@ variable \fB::http::defaultCharset\fR, which unless it has been deliberately modified by the caller is \fBiso8859-1\fR. Incoming text data is automatically converted from the character set defined by \fBcharset\fR to Tcl's internal Unicode representation, i.e. to a Tcl string. -.TP -\fBcompression\fR -. +.IP \fBcompression\fR A copy of the \fBContent-Encoding\fR response-header value. -.TP -\fBhttpRequest\fR -. +.IP \fBhttpRequest\fR The version of HTTP specified in the request (i.e. sent in the request line). The value is that of the option \fB\-protocol\fR supplied to \fB::http::geturl\fR (default value "1.1"), unless the command reduced the value to "1.0" because it was passed the \fB\-handler\fR option. -.TP -\fBhttpResponse\fR -. +.IP \fBhttpResponse\fR The version of HTTP used by the server (obtained from the response "status line"). The server uses this version of HTTP in its response, but ensures that this response is compatible with the HTTP version specified in the client's request. If the value cannot be extracted from the status line, the full status line is returned. -.TP -\fBurl\fR -. +.IP \fBurl\fR The requested URL, typically the URL supplied as an argument to \fB::http::geturl\fR but without its "fragment" (the final part of the URL beginning with "#"). -.TP -\fBconnectionRequest\fR -. +.IP \fBconnectionRequest\fR The value, if any, sent to the server in \fBConnection\fR request header(s). -.TP -\fBconnectionResponse\fR -. +.IP \fBconnectionResponse\fR The value, if any, received from the server in \fBConnection\fR response header(s). -.TP -\fBconnectionActual\fR -. +.IP \fBconnectionActual\fR This value, set by \fB::http::geturl\fR, reports whether the connection was closed after the transaction (value "close"), or left open (value "keep-alive"). -.TP -\fBtransferEncoding\fR -. +.IP \fBtransferEncoding\fR The value of the Transfer-Encoding response header, if it is present. The value is either "chunked" (indicating HTTP/1.1 "chunked encoding") or the empty string. -.TP -\fBtotalPost\fR -. +.IP \fBtotalPost\fR The total length of the request body in a POST request. -.TP -\fBcurrentPost\fR -. +.IP \fBcurrentPost\fR The number of bytes of the POST request body sent to the server so far. The value is the same as that returned by command \fB::http::size\fR. -.TP -\fBtotalSize\fR -. +.IP \fBtotalSize\fR A copy of the \fBContent-Length\fR response-header value. The number of bytes specified in a \fBContent-Length\fR header, if one was sent. If none was sent, the value is 0. A correctly configured server omits this header if the transfer-encoding is "chunked", or (for older servers) if the server closes the connection when it reaches the end of the resource. -.TP -\fBcurrentSize\fR -. +.IP \fBcurrentSize\fR The number of bytes fetched from the server so far. .PP .SS "MORE METADATA" @@ -1181,63 +1156,49 @@ Some of the header names (metadata keys) are listed below, but the HTTP standard defines several more, and servers are free to add their own. When a dictionary key is mentioned below, this refers to the \fBdict\fR value returned by command \fB::http::responseInfo\fR. -.TP -\fBContent-Type\fR -. +.IP \fBContent-Type\fR The content type of the URL contents. Examples include \fBtext/html\fR, \fBimage/gif,\fR \fBapplication/postscript\fR and \fBapplication/x-tcl\fR. Text values typically specify a character set, e.g. \fBtext/html; charset=UTF-8\fR. Dictionary key \fIcontentType\fR. -.TP -\fBContent-Length\fR -. +.IP \fBContent-Length\fR The advertised size in bytes of the contents, available as dictionary key \fItotalSize\fR. The actual number of bytes read by \fB::http::geturl\fR so far is available as dictionary key \fBcurrentSize\fR. -.TP -\fBContent-Encoding\fR -. +.IP \fBContent-Encoding\fR The compression algorithm used for the contents. Examples include \fBgzip\fR, \fBdeflate\fR. Dictionary key \fIcontent\fR. -.TP -\fBLocation\fR -. +.IP \fBLocation\fR This header is sent when a response has status code 3XX (redirection). It provides the URL that is the redirection target. Dictionary key \fIredirection\fR. -.TP -\fBSet-Cookie\fR -. +.IP \fBSet-Cookie\fR This header is sent to offer a cookie to the client. Cookie management is -done by the \fB::http::config\fR option \fI\-cookiejar\fR, and so +done by the \fB::http::config\fR option \fB\-cookiejar\fR, and so the \fBSet-Cookie\fR headers need not be parsed by user scripts. See section \fBCOOKIE JAR PROTOCOL\fR. -.TP -\fBConnection\fR -. +.IP \fBConnection\fR The value can be supplied as a comma-separated list, or by multiple headers. The list often has only one element, either "close" or "keep-alive". The value "upgrade" indicates a successful upgrade request and is typically combined with the status code 101, an \fBUpgrade\fR response header, and no response body. Dictionary key \fIconnectionResponse\fR. -.TP -\fBUpgrade\fR -. +.IP \fBUpgrade\fR The value indicates the protocol(s) to which the server will switch immediately after the empty line that terminates the 101 response headers. Dictionary key \fIupgrade\fR. .RE .PP .SS "EVEN MORE METADATA" -.PP -1. Details of the HTTP request. The request is determined by the options +.IP 1. +Details of the HTTP request. The request is determined by the options supplied to \fB::http::geturl\fR and \fB::http::config\fR. However, it is sometimes helpful to examine what \fB::http::geturl\fR actually sent to the server, and this information is available through commands \fB::http::requestHeaders\fR and \fB::http::requestLine\fR. -.PP -2. The state array: the internal variables of \fB::http::geturl\fR. +.IP 2. +The state array: the internal variables of \fB::http::geturl\fR. It may sometimes be helpful to examine this array. Details are given in the next section. .SH "STATE ARRAY" @@ -1265,114 +1226,60 @@ values returned by commands as described below. When a dictionary key is mentioned below, this refers to the \fBdict\fR value returned by command \fB::http::responseInfo\fR. .RS -.TP -\fBbinary\fR -. +.IP \fBbinary\fR For dictionary key \fIbinary\fR. -.TP -\fBbody\fR -. +.IP \fBbody\fR For command \fB::http::responseBody\fR. -.TP -\fBcharset\fR -. +.IP \fBcharset\fR For dictionary key \fIcharset\fR. -.TP -\fBcoding\fR -. +.IP \fBcoding\fR For dictionary key \fIcompression\fR. -.TP -\fBconnection\fR -. +.IP \fBconnection\fR For dictionary key \fIconnectionActual\fR. -.TP -\fBcurrentsize\fR -. +.IP \fBcurrentsize\fR For command \fB::http::size\fR; and for dictionary key \fIcurrentSize\fR. -.TP -\fBerror\fR -. +.IP \fBerror\fR For command \fB::http::error\fR; part is used in dictionary key \fIerror\fR. -.TP -\fBhttp\fR -. +.IP \fBhttp\fR For command \fB::http::responseLine\fR. -.TP -\fBhttpResponse\fR -. +.IP \fBhttpResponse\fR For dictionary key \fIhttpResponse\fR. -.TP -\fBmeta\fR -. +.IP \fBmeta\fR For command \fB::http::responseHeaders\fR. Further discussion above in the section \fBMORE METADATA\fR. -.TP -\fBmethod\fR -. +.IP \fBmethod\fR For dictionary key \fImethod\fR. -.TP -\fBposterror\fR -. +.IP \fBposterror\fR For dictionary key \fIpostError\fR. -.TP -\fBpostErrorFull\fR -. +.IP \fBpostErrorFull\fR For command \fB::http::postError\fR. -.TP -\fB\-protocol\fR -. +.IP \fB\-protocol\fR For dictionary key \fIhttpRequest\fR. -.TP -\fBquerylength\fR -. +.IP \fBquerylength\fR For dictionary key \fItotalPost\fR. -.TP -\fBqueryoffset\fR -. +.IP \fBqueryoffset\fR For dictionary key \fIcurrentPost\fR. -.TP -\fBreasonPhrase\fR -. +.IP \fBreasonPhrase\fR For dictionary key \fIreasonPhrase\fR. -.TP -\fBrequestHeaders\fR -. +.IP \fBrequestHeaders\fR For command \fB::http::requestHeaders\fR. -.TP -\fBrequestLine\fR -. +.IP \fBrequestLine\fR For command \fB::http::requestLine\fR. -.TP -\fBresponseCode\fR -. +.IP \fBresponseCode\fR For dictionary key \fIresponseCode\fR. -.TP -\fBstate\fR -. +.IP \fBstate\fR For dictionary key \fIstage\fR. -.TP -\fBstatus\fR -. +.IP \fBstatus\fR For command \fB::http::status\fR; and for dictionary key \fIstatus\fR. -.TP -\fBtotalsize\fR -. +.IP \fBtotalsize\fR For dictionary key \fItotalSize\fR. -.TP -\fBtransfer\fR -. +.IP \fBtransfer\fR For dictionary key \fItransferEncoding\fR. -.TP -\fBtype\fR -. +.IP \fBtype\fR For dictionary key \fIcontentType\fR. -.TP -\fBupgrade\fR -. +.IP \fBupgrade\fR For dictionary key \fIupgrade\fR. -.TP -\fBurl\fR -. +.IP \fBurl\fR For dictionary key \fIurl\fR. .RE .SH "PERSISTENT CONNECTIONS" @@ -1483,7 +1390,7 @@ Cookies are short key-value pairs used to implement sessions within the otherwise-stateless HTTP protocol. (See RFC 6265 for details; Tcl does not implement the Cookie2 protocol as that is rarely seen in the wild.) .PP -Cookie storage managment commands \(em +Cookie storage management commands \(em .QW "cookie jars" \(em must support these subcommands which form the HTTP cookie storage management protocol. Note that \fIcookieJar\fR below does not have to be a @@ -1521,58 +1428,40 @@ returned by a request; the result of this command is ignored. The cookie (which will have been parsed by the http package) is described by a dictionary, \fIcookieDictionary\fR, that may have the following keys: .RS -.TP -\fBdomain\fR -. +.IP \fBdomain\fR This is always present. Its value describes the domain hostname \fIor prefix\fR that the cookie should be returned for. The checking of the domain against the origin (below) should be careful since sites that issue cookies should only do so for domains related to themselves. Cookies that do not obey a relevant origin matching rule should be ignored. -.TP -\fBexpires\fR -. +.IP \fBexpires\fR This is optional. If present, the cookie is intended to be a persistent cookie and the value of the option is the Tcl timestamp (in seconds from the same base as \fBclock seconds\fR) of when the cookie expires (which may be in the past, which should result in the cookie being deleted immediately). If absent, the cookie is intended to be a session cookie that should be not persisted beyond the lifetime of the cookie jar. -.TP -\fBhostonly\fR -. +.IP \fBhostonly\fR This is always present. Its value is a boolean that describes whether the cookie is a single host cookie (true) or a domain-level cookie (false). -.TP -\fBhttponly\fR -. +.IP \fBhttponly\fR This is always present. Its value is a boolean that is true when the site wishes the cookie to only ever be used with HTTP (or HTTPS) traffic. -.TP -\fBkey\fR -. +.IP \fBkey\fR This is always present. Its value is the \fIkey\fR of the cookie, which is part of the information that must be return when sending this cookie back in a future request. -.TP -\fBorigin\fR -. +.IP \fBorigin\fR This is always present. Its value describes where the http package believes it received the cookie from, which may be useful for checking whether the cookie's domain is valid. -.TP -\fBpath\fR -. +.IP \fBpath\fR This is always present. Its value describes the path prefix of requests to the cookie domain where the cookie should be returned. -.TP -\fBsecure\fR -. +.IP \fBsecure\fR This is always present. Its value is a boolean that is true when the cookie should only used on requests sent over secure channels (typically HTTPS). -.TP -\fBvalue\fR -. +.IP \fBvalue\fR This is always present. Its value is the value of the cookie, which is part of the information that must be return when sending this cookie back in a future request. @@ -1622,19 +1511,19 @@ See https://w3c.github.io/webappsec-upgrade-insecure-requests/ .SS "PURPOSE" .PP Command \fB::http::geturl\fR uses the Tcl \fB::socket\fR command with -the \fI\-async\fR option to connect to a remote server, but the return from +the \fB\-async\fR option to connect to a remote server, but the return from this command can be delayed in adverse cases (e.g. a slow DNS lookup), preventing the event loop from processing other events. This delay is avoided if the \fB::socket\fR command is evaluated in another thread. The Thread package is not part of Tcl but is provided in "Batteries Included" distributions. Instead of the \fB::socket\fR command, the http package uses \fB::http::socket\fR which makes connections in the -manner specified by the value of \fI\-threadlevel\fR and the availability +manner specified by the value of \fB\-threadlevel\fR and the availability of package Thread. .PP .SS "WITH TLS (HTTPS)" .PP -The same \fI\-threadlevel\fR configuration applies to both HTTP and HTTPS +The same \fB\-threadlevel\fR configuration applies to both HTTP and HTTPS connections. HTTPS is enabled by using the \fBhttp::register\fR command, typically by specifying the \fB::tls::socket\fR command of the tls package to handle TLS @@ -1652,10 +1541,10 @@ for integrating \fB::http::socket\fR into its own replacement command. .PP The peer thread can transfer the socket only to the main interpreter of the script's thread. Therefore the thread-based \fB::http::socket\fR works with -non-zero \fI\-threadlevel\fR values only if the script runs in the main -interpreter. A child interpreter must use \fI\-threadlevel 0\fR unless the +non-zero \fB\-threadlevel\fR values only if the script runs in the main +interpreter. A child interpreter must use \fB\-threadlevel 0\fR unless the parent interpreter has provided alternative facilities. The main parent -interpreter may grant full \fI\-threadlevel\fR facilities to a child +interpreter may grant full \fB\-threadlevel\fR facilities to a child interpreter, for example by aliasing, to \fB::http::socket\fR in the child, a command that runs \fBhttp::socket\fR in the parent, and then transfers the socket to the child. @@ -1695,7 +1584,7 @@ proc httpcopy { url file {chunk 4096} } { return $token } proc httpCopyProgress {args} { - puts \-nonewline stderr . + puts -nonewline stderr . flush stderr } .CE diff --git a/doc/info.n b/doc/info.n index a7896a9..96c0375 100644 --- a/doc/info.n +++ b/doc/info.n @@ -176,60 +176,37 @@ is seen by \fBinfo frame\fR invoked within .QW x . .PP The dictionary may contain the following keys: -.TP -\fBtype\fR -. +.IP \fBtype\fR Always present. Possible values are \fBsource\fR, \fBproc\fR, \fBeval\fR, and \fBprecompiled\fR. .RS -.TP -\fBsource\fR\0\0\0\0\0\0\0\0 -. -A script loaded via the \fBsource\fR -command. -.TP -\fBproc\fR\0\0\0\0\0\0\0\0 -. +.IP \fBsource\fR +A script loaded via the \fBsource\fR command. +.IP \fBproc\fR The body of a procedure that could not be traced back to a line in a particular script. -.TP -\fBeval\fR\0\0\0\0\0\0\0\0 -. +.IP \fBeval\fR The body of a script provided to \fBeval\fR or \fBuplevel\fR. -.TP -\fBprecompiled\fR\0\0\0\0\0\0\0\0 -. +.IP \fBprecompiled\fR A precompiled script (loadable by the package \fBtbcload\fR), and no further information is available. .RE -.TP -\fBline\fR -. +.IP \fBline\fR The line number of of the command inside its script. Not available for \fBprecompiled\fR commands. When the type is \fBsource\fR, the line number is relative to the beginning of the file, whereas for the last two types it is relative to the start of the script. -.TP -\fBfile\fR -. +.IP \fBfile\fR For type \fBsource\fR, provides the normalized path of the file that contains the command. -.TP -\fBcmd\fR -. +.IP \fBcmd\fR The command before substitutions were performed. -.TP -\fBproc\fR -. +.IP \fBproc\fR For type \fBprod\fR, the name of the procedure containing the command. -.TP -\fBlambda\fR -. +.IP \fBlambda\fR For a command in a script evaluated as the body of an unnamed routine via the \fBapply\fR command, the definition of that routine. -.TP -\fBlevel\fR -. +.IP \fBlevel\fR For a frame that corresponds to a level, (to be determined). .PP When a command can be traced to its literal definition in some script, e.g. @@ -295,7 +272,7 @@ If \fInumber\fR is not given, the level this routine was called from. Otherwise returns the complete command active at the given level. If \fInumber\fR is greater than \fB0\fR, it is the desired level. Otherwise, it is \fInumber\fR levels up from the current level. A complete command is the -words in the command, with all subsitutions performed, meaning that it is a +words in the command, with all substitutions performed, meaning that it is a list. See \fBuplevel\fR for more information on levels. .\" METHOD: library .TP @@ -488,6 +465,7 @@ This subcommand returns a list of all public (i.e. exported) methods of the class called \fIclass\fR. Any of the following \fIoption\fRs may be given, controlling exactly which method names are returned: .RS +.\" OPTION: -all .TP \fB\-all\fR . @@ -498,6 +476,7 @@ and the \fB\-scope\fR flag is not given, the list of methods will include those methods defined not just by the class, but also by the class's superclasses and mixins. +.\" OPTION: -private .TP \fB\-private\fR . @@ -512,6 +491,7 @@ mixins, if \fB\-all\fR is also given). Note that this naming is an unfortunate clash with true private methods; this option name is retained for backward compatibility. .VE TIP500 +.\" OPTION: -scope .TP \fB\-scope\fI scope\fR .VS TIP500 @@ -520,14 +500,14 @@ Returns a list of all methods on \fIclass\fR that have the given visibility \fB\-private\fR options are ignored. The valid values for \fIscope\fR are: .RS .IP \fBpublic\fR 3 -Only methods with \fIpublic\fR scope (i.e., callable from anywhere by any instance -of this class) are to be returned. +Only methods with \fIpublic\fR scope (i.e., callable from anywhere by any +instance of this class) are to be returned. .IP \fBunexported\fR 3 -Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to -be returned. +Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) +are to be returned. .IP \fBprivate\fR 3 -Only methods with \fIprivate\fR scope (i.e., only callable from within this class's -methods) are to be returned. +Only methods with \fIprivate\fR scope (i.e., only callable from within this +class's methods) are to be returned. .RE .VE TIP500 .RE @@ -553,16 +533,19 @@ class named \fIclass\fR. This subcommand returns a sorted list of properties defined on the class named \fIclass\fR. The \fIoptions\fR define exactly which properties are returned: .RS +.\" OPTION: -all .TP \fB\-all\fR . With this option, the properties from the superclasses and mixins of the class are also returned. +.\" OPTION: -readable .TP \fB\-readable\fR . This option (the default behavior) asks for the readable properties to be returned. Only readable or writable properties are returned, not both. +.\" OPTION: -writable .TP \fB\-writable\fR . @@ -709,6 +692,7 @@ This subcommand returns a list of all public (i.e. exported) methods of the object called \fIobject\fR. Any of the following \fIoption\fRs may be given, controlling exactly which method names are returned: .RS +.\" OPTION: -all .TP \fB\-all\fR . @@ -719,6 +703,7 @@ and the \fB\-scope\fR flag is not given, the list of methods will include those methods defined not just by the object, but also by the object's class and mixins, plus the superclasses of those classes. +.\" OPTION: -private .TP \fB\-private\fR . @@ -733,6 +718,7 @@ the non-exported methods of the object (and classes, if Note that this naming is an unfortunate clash with true private methods; this option name is retained for backward compatibility. .VE TIP500 +.\" OPTION: -scope .TP \fB\-scope\fI scope\fR .VS TIP500 @@ -744,11 +730,11 @@ Returns a list of all methods on \fIobject\fR that have the given visibility Only methods with \fIpublic\fR scope (i.e., callable from anywhere) are to be returned. .IP \fBunexported\fR 3 -Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to -be returned. +Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) +are to be returned. .IP \fBprivate\fR 3 -Only methods with \fIprivate\fR scope (i.e., only callable from within this object's -instance methods) are to be returned. +Only methods with \fIprivate\fR scope (i.e., only callable from within this +object's instance methods) are to be returned. .RE .VE TIP500 .RE @@ -781,16 +767,19 @@ This subcommand returns a sorted list of properties defined on the object named \fIobject\fR. The \fIoptions\fR define exactly which properties are returned: .RS +.\" OPTION: -all .TP \fB\-all\fR . With this option, the properties from the class, superclasses and mixins of the object are also returned. +.\" OPTION: -readable .TP \fB\-readable\fR . This option (the default behavior) asks for the readable properties to be returned. Only readable or writable properties are returned, not both. +.\" OPTION: -writable .TP \fB\-writable\fR . @@ -800,7 +789,7 @@ writable properties are returned, not both. .VE "TIP 558" .\" METHOD: variables .TP -\fBinfo object variables\fI object\fRR ?\fB\-private\fR? +\fBinfo object variables\fI object\fR ?\fB\-private\fR? . This subcommand returns a list of all variables that have been declared for the object named \fIobject\fR (i.e. that are automatically present in the diff --git a/doc/interp.n b/doc/interp.n index 7cff9c2..2c08533 100644 --- a/doc/interp.n +++ b/doc/interp.n @@ -266,11 +266,14 @@ a Tcl script in the child interpreter identified by \fIpath\fR. The result of this evaluation (including all \fBreturn\fR options, such as \fB\-errorinfo\fR and \fB\-errorcode\fR information, if an error occurs) is returned to the invoking interpreter. +.RS +.PP Note that the script will be executed in the current context stack frame of the \fIpath\fR interpreter; this is so that the implementations (in a parent interpreter) of aliases in a child interpreter can execute scripts in the child that find out information about the child's current state and stack frame. +.RE .\" METHOD: exists .TP \fBinterp exists \fIpath\fR @@ -333,9 +336,13 @@ The \fB\-\|\-\fR flag allows the \fIhiddenCmdName\fR argument to start with a character, and is otherwise unnecessary. If both the \fB\-namespace\fR and \fB\-global\fR flags are present, the \fB\-namespace\fR flag is ignored. +.RS +.PP Note that the hidden command will be executed (by default) in the current context stack frame of the \fIpath\fR interpreter. +.PP Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below. +.RE .\" METHOD: issafe .TP \fBinterp issafe\fR ?\fIpath\fR? @@ -484,11 +491,14 @@ the resulting string as a Tcl script in \fIchild\fR. The result of this evaluation (including all \fBreturn\fR options, such as \fB\-errorinfo\fR and \fB\-errorcode\fR information, if an error occurs) is returned to the invoking interpreter. +.RS +.PP Note that the script will be executed in the current context stack frame of \fIchild\fR; this is so that the implementations (in a parent interpreter) of aliases in a child interpreter can execute scripts in the child that find out information about the child's current state and stack frame. +.RE .\" METHOD: expose .TP \fIchild \fBexpose \fIhiddenName \fR?\fIexposedCmdName\fR? @@ -540,10 +550,13 @@ The \fB\-\|\-\fR flag allows the \fIhiddenCmdName\fR argument to start with a character, and is otherwise unnecessary. If both the \fB\-namespace\fR and \fB\-global\fR flags are given, the \fB\-namespace\fR flag is ignored. +.RS +.PP Note that the hidden command will be executed (by default) in the current context stack frame of \fIchild\fR. -For more details on hidden commands, -see \fBHIDDEN COMMANDS\fR, below. +.PP +For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below. +.RE .\" METHOD: issafe .TP \fIchild \fBissafe\fR @@ -823,6 +836,7 @@ catch and handle. Every limit has a number of options associated with it, some of which are common across all kinds of limits, and others of which are particular to the kind of limit. +.\" OPTION: -command .TP \fB\-command\fR . @@ -833,9 +847,13 @@ The callback may modify the limit on the interpreter if it wishes the limited interpreter to continue executing. If the callback generates an exception, it is reported through the background exception mechanism (see \fBBACKGROUND EXCEPTION HANDLING\fR). +.RS +.PP Note that the callbacks defined by one interpreter are completely isolated from the callbacks defined by another, and that the order in which those callbacks are called is undefined. +.RE +.\" OPTION: -granularity .TP \fB\-granularity\fR . @@ -844,6 +862,7 @@ points when the Tcl interpreter is in a consistent state where limit checking is possible) that the limit is actually checked. This allows the tuning of how frequently a limit is checked, and hence how often the limit-checking overhead (which may be substantial in the case of time limits) is incurred. +.\" OPTION: -milliseconds .TP \fB\-milliseconds\fR . @@ -851,6 +870,7 @@ This option specifies the number of milliseconds after the moment defined in the \fB\-seconds\fR option that the time limit will fire. It should only ever be specified in conjunction with the \fB\-seconds\fR option (whether it was set previously or is being set this invocation.) +.\" OPTION: -seconds .TP \fB\-seconds\fR . @@ -860,6 +880,7 @@ limit will be triggered at the start of the second unless specified at a sub-second level using the \fB\-milliseconds\fR option. This option may be the empty string, which indicates that a time limit is not set for the interpreter. +.\" OPTION: -value .TP \fB\-value\fR . @@ -879,14 +900,15 @@ necessary. .PP When an exception happens in a situation where it cannot be reported directly up the stack (e.g. when processing events in an \fBupdate\fR or \fBvwait\fR call) -the exception is instead reported through the background exception handling mechanism. -Every interpreter has a background exception handler registered; the default exception +the exception is instead reported through the background exception handling +mechanism. Every interpreter has a background exception handler registered; +the default exception handler arranges for the \fBbgerror\fR command in the interpreter's global namespace to be called, but other exception handlers may be installed and process background exceptions in substantially different ways. .PP -A background exception handler consists of a non-empty list of words to which will -be appended two further words at invocation time. The first word will be the +A background exception handler consists of a non-empty list of words to which +will be appended two further words at invocation time. The first word will be the interpreter result at time of the exception, typically an error message, and the second will be the dictionary of return options at the time of the exception. These are the same values that \fBcatch\fR can capture @@ -934,7 +956,8 @@ set i [\fBinterp create\fR] } .CE .SH "SEE ALSO" -bgerror(n), load(n), safe(n), Tcl_CreateChild(3), Tcl_Eval(3), Tcl_BackgroundException(3) +bgerror(n), load(n), safe(n), +Tcl_CreateChild(3), Tcl_Eval(3), Tcl_BackgroundException(3) .SH KEYWORDS alias, parent interpreter, safe interpreter, child interpreter '\"Local Variables: diff --git a/doc/load.n b/doc/load.n index dfaca58..e741204 100644 --- a/doc/load.n +++ b/doc/load.n @@ -117,7 +117,7 @@ use this when you know what you are doing, you will not get a nice error message when something is wrong with the loaded library. .SH "PORTABILITY ISSUES" .TP -\fBWindows\fR\0\0\0\0\0 +\fBWindows\fR . When a load fails with .QW "library not found" diff --git a/doc/lrange.n b/doc/lrange.n index 38c4abf..8dac91f 100644 --- a/doc/lrange.n +++ b/doc/lrange.n @@ -29,7 +29,8 @@ If \fIlast\fR is greater than or equal to the number of elements in the list, then it is treated as if it were \fBend\fR. If \fIfirst\fR is greater than \fIlast\fR then an empty string is returned. -Note: +.PP +Note that .QW "\fBlrange \fIlist first first\fR" does not always produce the same result as .QW "\fBlindex \fIlist first\fR" diff --git a/doc/lrepeat.n b/doc/lrepeat.n index cd672db..8e4cc41 100644 --- a/doc/lrepeat.n +++ b/doc/lrepeat.n @@ -18,7 +18,9 @@ lrepeat \- Build a list by repeating elements The \fBlrepeat\fR command creates a list of size \fIcount * number of elements\fR by repeating \fIcount\fR times the sequence of elements \fIelement ...\fR. \fIcount\fR must be a non-negative integer, -\fIelement\fR can be any Tcl value. Note that \fBlrepeat 1 element ...\fR +\fIelement\fR can be any Tcl value. +.PP +Note that \fBlrepeat 1 element ...\fR is identical to \fBlist element ...\fR. .SH EXAMPLES .CS diff --git a/doc/lsearch.n b/doc/lsearch.n index c8d2ec9..cc5d795 100644 --- a/doc/lsearch.n +++ b/doc/lsearch.n @@ -31,22 +31,26 @@ indicates how the elements of the list are to be matched against If all matching style options are omitted, the default matching style is \fB\-glob\fR. If more than one matching style is specified, the last matching style given takes precedence. +.\" OPTION: -exact .TP \fB\-exact\fR . \fIPattern\fR is a literal string that is compared for exact equality against each list element. +.\" OPTION: -glob .TP \fB\-glob\fR . \fIPattern\fR is a glob-style pattern which is matched against each list element using the same rules as the \fBstring match\fR command. +.\" OPTION: -regexp .TP \fB\-regexp\fR . \fIPattern\fR is treated as a regular expression and matched against each list element using the rules described in the \fBre_syntax\fR reference page. +.\" OPTION: -sorted .TP \fB\-sorted\fR . @@ -60,6 +64,7 @@ is treated exactly like \fB\-exact\fR when either \fB\-all\fR or .SS "GENERAL MODIFIER OPTIONS" .PP These options may be given with all matching styles. +.\" OPTION: -all .TP \fB\-all\fR . @@ -67,17 +72,20 @@ Changes the result to be the list of all matching indices (or all matching values if \fB\-inline\fR is specified as well.) If indices are returned, the indices will be in ascending numeric order. If values are returned, the order of the values will be the order of those values within the input \fIlist\fR. +.\" OPTION: -inline .TP \fB\-inline\fR . The matching value is returned instead of its index (or an empty string if no value matches.) If \fB\-all\fR is also specified, then the result of the command is the list of all values that matched. +.\" OPTION: -not .TP \fB\-not\fR . This negates the sense of the match, returning the index of the first non-matching value in the list. +.\" OPTION: -start .TP \fB\-start\fR\0\fIindex\fR . @@ -91,11 +99,13 @@ These options describe how to interpret the items in the list being searched. They are only meaningful when used with the \fB\-exact\fR and \fB\-sorted\fR options. If more than one is specified, the last one takes precedence. The default is \fB\-ascii\fR. +.\" OPTION: -ascii .TP \fB\-ascii\fR . The list elements are to be examined as Unicode strings (the name is for backward-compatibility reasons.) +.\" OPTION: -dictionary .TP \fB\-dictionary\fR . @@ -104,16 +114,19 @@ comparisons (see \fBlsort\fR for a fuller description). Note that this only makes a meaningful difference from the \fB\-ascii\fR option when the \fB\-sorted\fR option is given, because values are only dictionary-equal when exactly equal. +.\" OPTION: -integer .TP \fB\-integer\fR . The list elements are to be compared as integers. +.\" OPTION: -nocase .TP \fB\-nocase\fR . Causes comparisons to be handled in a case-insensitive manner. Has no effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or \fB\-real\fR options. +.\" OPTION: -real .TP \fB\-real\fR . @@ -123,18 +136,22 @@ The list elements are to be compared as floating-point values. These options (only meaningful with the \fB\-sorted\fR option) specify how the list is sorted. If more than one is given, the last one takes precedence. The default option is \fB\-increasing\fR. +.\" OPTION: -decreasing .TP \fB\-decreasing\fR . The list elements are sorted in decreasing order. This option is only meaningful when used with \fB\-sorted\fR. +.\" OPTION: -increasing .TP \fB\-increasing\fR . The list elements are sorted in increasing order. This option is only meaningful when used with \fB\-sorted\fR. +.\" OPTION: -bisect .TP \fB\-bisect\fR +. Inexact search when the list elements are in sorted order. For an increasing list the last index where the element is less than or equal to the pattern is returned. For a decreasing list the last index where the element is greater @@ -146,6 +163,7 @@ or \fB\-not\fR. .PP These options are used to search lists of lists. They may be used with any other options. +.\" OPTION: -stride .TP \fB\-stride\0\fIstrideLength\fR . @@ -159,6 +177,7 @@ index always points to the first element in a group. The list length must be an integer multiple of \fIstrideLength\fR, which in turn must be at least 1. A \fIstrideLength\fR of 1 is the default and indicates no grouping. +.\" OPTION: -index .TP \fB\-index\fR\0\fIindexList\fR . @@ -166,6 +185,7 @@ This option is designed for use when searching within nested lists. The \fIindexList\fR argument gives a path of indices (much as might be used with the \fBlindex\fR or \fBlset\fR commands) within each element to allow the location of the term being matched against. +.\" OPTION: -subindices .TP \fB\-subindices\fR . diff --git a/doc/lsort.n b/doc/lsort.n index 1695ea8..4e4f720 100644 --- a/doc/lsort.n +++ b/doc/lsort.n @@ -20,18 +20,20 @@ lsort \- Sort the elements of a list .PP This command sorts the elements of \fIlist\fR, returning a new list in sorted order. The implementation of the \fBlsort\fR command -uses the merge\-sort algorithm which is a stable sort that has O(n log +uses the merge-sort algorithm which is a stable sort that has O(n log n) performance characteristics. .PP By default ASCII sorting is used with the result returned in increasing order. However, any of the following options may be specified before \fIlist\fR to control the sorting process (unique abbreviations are accepted): +.\" OPTION: -ascii .TP \fB\-ascii\fR . Use string comparison with Unicode code-point collation order (the name is for backward-compatibility reasons.) This is the default. +.\" OPTION: -dictionary .TP \fB\-dictionary\fR . @@ -42,14 +44,17 @@ not characters. For example, in \fB\-dictionary\fR mode, \fBbigBoy\fR sorts between \fBbigbang\fR and \fBbigboy\fR, and \fBx10y\fR sorts between \fBx9y\fR and \fBx11y\fR. Overrides the \fB\-nocase\fR option. +.\" OPTION: -integer .TP \fB\-integer\fR . Convert list elements to integers and use integer comparison. +.\" OPTION: -real .TP \fB\-real\fR . Convert list elements to floating-point values and use floating comparison. +.\" OPTION: -command .TP \fB\-command\0\fIcommand\fR . @@ -60,22 +65,26 @@ arguments. The script should return an integer less than, equal to, or greater than zero if the first element is to be considered less than, equal to, or greater than the second, respectively. +.\" OPTION: -increasing .TP \fB\-increasing\fR . Sort the list in increasing order .PQ smallest "items first" . This is the default. +.\" OPTION: -decreasing .TP \fB\-decreasing\fR . Sort the list in decreasing order .PQ largest "items first" . +.\" OPTION: -indices .TP \fB\-indices\fR . Return a list of indices into \fIlist\fR in sorted order instead of the values themselves. +.\" OPTION: -index .TP \fB\-index\0\fIindexList\fR . @@ -119,6 +128,7 @@ returns \fB{{d e m o} 34512} {{b i g} 12345} {{c o d e} 54321}\fR This option is much more efficient than using \fB\-command\fR to achieve the same effect. .RE +.\" OPTION: -stride .TP \fB\-stride\0\fIstrideLength\fR . @@ -136,7 +146,7 @@ in turn must be at least 2. For example, .PP .CS -\fBlsort\fR \-stride 2 {carrot 10 apple 50 banana 25} +\fBlsort\fR -stride 2 {carrot 10 apple 50 banana 25} .CE .PP returns @@ -144,18 +154,20 @@ returns and .PP .CS -\fBlsort\fR \-stride 2 \-index 1 \-integer {carrot 10 apple 50 banana 25} +\fBlsort\fR -stride 2 -index 1 -integer {carrot 10 apple 50 banana 25} .CE .PP returns .QW "carrot 10 banana 25 apple 50" . .RE +.\" OPTION: -nocase .TP \fB\-nocase\fR . Causes comparisons to be handled in a case-insensitive manner. Has no effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or \fB\-real\fR options. +.\" OPTION: -unique .TP \fB\-unique\fR . @@ -234,7 +246,7 @@ Sorting using striding and multiple indices: .PP .CS \fI%\fR # Note the first index value is relative to the group -\fI%\fR \fBlsort\fR \-stride 3 \-index {0 1} \e +\fI%\fR \fBlsort\fR -stride 3 -index {0 1} \e {{Bob Smith} 25 Audi {Jane Doe} 40 Ford} {{Jane Doe} 40 Ford {Bob Smith} 25 Audi} .CE diff --git a/doc/msgcat.n b/doc/msgcat.n index 43ea95d..21b6aa1 100644 --- a/doc/msgcat.n +++ b/doc/msgcat.n @@ -18,7 +18,7 @@ msgcat \- Tcl message catalog \fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR? \fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR? .VS "TIP 412" -\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? \fIsrc-string\fR +\fB::msgcat::mcexists\fR ?\fB\-exactnamespace\fR? ?\fB\-exactlocale\fR? \fIsrc-string\fR .VE "TIP 412" .VS "TIP 490" \fB::msgcat::mcpackagenamespaceget\fR @@ -58,14 +58,16 @@ the application source code. New languages or locales may be provided by adding a new file to the message catalog. .PP -\fBmsgcat\fR distinguishes packages by its namespace. -Each package has its own message catalog and configuration settings in \fBmsgcat\fR. +\fBmsgcat\fR distinguishes packages by its namespace. Each package has +its own message catalog and configuration settings in \fBmsgcat\fR. .PP -A \fIlocale\fR is a specification string describing a user language like \fBde_ch\fR for Swiss German. -In \fBmsgcat\fR, there is a global locale initialized by the system locale of the current system. -Each package may decide to use the global locale or to use a package specific locale. +A \fIlocale\fR is a specification string describing a user language like +\fBde_ch\fR for Swiss German. In \fBmsgcat\fR, there is a global locale +initialized by the system locale of the current system. Each package may +decide to use the global locale or to use a package specific locale. .PP -The global locale may be changed on demand, for example by a user initiated language change or within a multi user application like a web server. +The global locale may be changed on demand, for example by a user initiated +language change or within a multi user application like a web server. .PP .VS tip490 Object oriented programming is supported by the use of a package namespace. @@ -100,11 +102,13 @@ later simply by defining new message catalog entries. .TP \fB::msgcat::mcn \fInamespace src-string\fR ?\fIarg arg ...\fR? .VS "TIP 490" -Like \fB::msgcat::mc\fR, but with the message namespace specified as first argument. +Like \fB::msgcat::mc\fR, but with the message namespace specified as first +argument. .PP .RS -\fBmcn\fR may be used for cases where the package namespace is not the namespace of the caller. -An example is shown within the description of the command \fB::msgcat::mcpackagenamespaceget\fR below. +\fBmcn\fR may be used for cases where the package namespace is not the +namespace of the caller. An example is shown within the description of the +command \fB::msgcat::mcpackagenamespaceget\fR below. .RE .VE .\" COMMAND: mcmax @@ -117,18 +121,21 @@ localized GUIs, which may require that all buttons, for example, be a fixed width (which will be the width of the widest button). .\" COMMAND: mcexists .TP -\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? ?\fB-namespace\fI namespace\fR? \fIsrc-string\fR +\fB::msgcat::mcexists\fR ?\fB\-exactnamespace\fR? ?\fB\-exactlocale\fR? ?\fB\-namespace\fI namespace\fR? \fIsrc-string\fR .VS "TIP 412" Return true, if there is a translation for the given \fIsrc-string\fR. .PP .RS -The search may be limited by the option \fB\-exactnamespace\fR to only check the current namespace and not any parent namespaces. +The search may be limited by the option \fB\-exactnamespace\fR to only check +the current namespace and not any parent namespaces. .PP -It may also be limited by the option \fB\-exactlocale\fR to only check the first prefered locale (e.g. first element returned by \fB::msgcat::mcpreferences\fR if global locale is used). +It may also be limited by the option \fB\-exactlocale\fR to only check the +first prefered locale (e.g. first element returned by +\fB::msgcat::mcpreferences\fR if global locale is used). .PP .VE "TIP 412" .VS "TIP 490" -An explicit package namespace may be specified by the option \fB-namespace\fR. +An explicit package namespace may be specified by the option \fB\-namespace\fR. The namespace of the caller is used if not explicitly specified. .RE .PP @@ -137,11 +144,12 @@ The namespace of the caller is used if not explicitly specified. .TP \fB::msgcat::mcpackagenamespaceget\fR .VS "TIP 490" -Return the package namespace of the caller. -This command handles all cases described in section \fBOBJECT ORIENTED PROGRAMMING\fR. +Return the package namespace of the caller. This command handles all cases +described in section \fBOBJECT ORIENTED PROGRAMMING\fR. .PP .RS -Example usage is a tooltip package, which saves the caller package namespace to update the translation each time the tooltip is shown: +Example usage is a tooltip package, which saves the caller package namespace +to update the translation each time the tooltip is shown: .CS proc ::tooltip::tooltip {widget message} { ... @@ -163,16 +171,20 @@ proc ::tooltip::show {widget messagenamespace message} { .TP \fB::msgcat::mclocale \fR?\fInewLocale\fR? . -If \fInewLocale\fR is omitted, the current locale is returned, otherwise the current locale -is set to \fInewLocale\fR. +If \fInewLocale\fR is omitted, the current locale is returned, otherwise the +current locale is set to \fInewLocale\fR. .PP .RS -If the new locale is set to \fInewLocale\fR, the corresponding preferences are calculated and set. -For example, if the current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR returns \fB{en_us_funky en_us en {}}\fR. +If the new locale is set to \fInewLocale\fR, the corresponding preferences +are calculated and set. +For example, if the current locale is en_US_funky, then +\fB::msgcat::mcpreferences\fR returns \fB{en_us_funky en_us en {}}\fR. .PP -The same result may be acheved by \fB::msgcat::mcpreferences\fR {*}[\fB::msgcat::mcutil getpreferences\fI newLocale\fR]. +The same result may be achieved by \fB::msgcat::mcpreferences\fR +{*}[\fB::msgcat::mcutil getpreferences\fI newLocale\fR]. .PP -The current locale is always the first element of the list returned by \fBmcpreferences\fR. +The current locale is always the first element of the list returned by +\fBmcpreferences\fR. .PP msgcat stores and compares the locale in a case-insensitive manner, and returns locales in lowercase. @@ -196,11 +208,13 @@ The list is ordered from most specific to least preference. .VS "TIP 499" .RS A set of locale preferences may be given to set the list of locale preferences. -The current locale is also set, which is the first element of the locale preferences list. +The current locale is also set, which is the first element of the locale +preferences list. .PP Locale preferences are loaded now, if not jet loaded. .PP -As an example, the user may prefer French or English text. This may be configured by: +As an example, the user may prefer French or English text. This may be +configured by: .CS ::msgcat::mcpreferences fr en {} .CE @@ -210,12 +224,14 @@ As an example, the user may prefer French or English text. This may be configure .TP \fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR? .VS "TIP 499" -This group of commands manage the list of loaded locales for packages not setting a package locale. +This group of commands manage the list of loaded locales for packages not +setting a package locale. .PP .RS The subcommand \fBloaded\fR returns the list of currently loaded locales. .PP -The subcommand \fBclear\fR removes all locales and their data, which are not in the current preference list. +The subcommand \fBclear\fR removes all locales and their data, which are not in +the current preference list. .RE .VE .\" COMMAND: mcload @@ -224,7 +240,8 @@ The subcommand \fBclear\fR removes all locales and their data, which are not in .VS "TIP 412" Searches the specified directory for files that match the language specifications returned by \fB::msgcat::mcloadedlocales loaded\fR -(or \fBmsgcat::mcpackagelocale preferences\fR if a package locale is set) (note that these are all lowercase), extended by the file extension +(or \fBmsgcat::mcpackagelocale preferences\fR if a package locale is set) +(note that these are all lowercase), extended by the file extension .QW .msg . Each matching file is read in order, assuming a UTF-8 encoding. The file contents are @@ -297,30 +314,37 @@ to \fB::msgcat::mc\fR. .VS "TIP 412" .RS .PP -Note that this routine is only called if the concerned package did not set a package locale unknown command name. +Note that this routine is only called if the concerned package did not set a +package locale unknown command name. .RE .\" COMMAND: mcforgetpackage .TP \fB::msgcat::mcforgetpackage\fR . -The calling package clears all its state within the \fBmsgcat\fR package including all settings and translations. +The calling package clears all its state within the \fBmsgcat\fR package +including all settings and translations. .VE "TIP 412" .PP .\" COMMAND: mcutil +.\" METHOD: getpreferences .VS "TIP 499" .TP \fB::msgcat::mcutil getpreferences\fI locale\fR . -Return the preferences list of the given locale as described in section \fBLOCALE SPECIFICATION\fR. -An example is the composition of a preference list for the bilingual region "Biel/Bienne" as a concatenation of swiss german and swiss french: +Return the preferences list of the given locale as described in the section +\fBLOCALE SPECIFICATION\fR. +An example is the composition of a preference list for the bilingual region +"Biel/Bienne" as a concatenation of swiss german and swiss french: .CS % concat [lrange [msgcat::mcutil getpreferences fr_CH] 0 end-1] [msgcat::mcutil getpreferences de_CH] fr_ch fr de_ch de {} .CE +.\" METHOD: getsystemlocale .TP \fB::msgcat::mcutil getsystemlocale\fR . -The system locale is returned as described by the section \fBLOCALE SPECIFICATION\fR. +The system locale is returned as described by the section +\fBLOCALE SPECIFICATION\fR. .VE "TIP 499" .PP .SH "LOCALE SPECIFICATION" @@ -361,7 +385,7 @@ msgcat will attempt to extract locale information from the registry. From Windows Vista on, the RFC4747 locale name "lang-script-country-options" is transformed to the locale as "lang_country_script" (Example: sr-Latn-CS -> sr_cs_latin). For Windows XP, the language id is -transformed analoguously (Example: 0c1a -> sr_yu_cyrillic). +transformed analogously (Example: 0c1a -> sr_yu_cyrillic). If all these attempts to discover an initial locale from the user's environment fail, msgcat defaults to an initial locale of .QW C . @@ -534,58 +558,73 @@ A package using \fBmsgcat\fR may choose to use its own package private locale and its own set of loaded locales, independent to the global locale set by \fB::msgcat::mclocale\fR. .PP -This allows a package to change its locale without causing any locales load or removal in other packages and not to invoke the global locale change callback (see below). +This allows a package to change its locale without causing any locales load or +removal in other packages and not to invoke the global locale change callback +(see below). .PP This action is controled by the following ensemble: +.\" COMMAND: mcpackagelocale +.\" METHOD: set .TP \fB::msgcat::mcpackagelocale set\fR ?\fIlocale\fR? . Set or change a package private locale. -The package private locale is set to the given \fIlocale\fR if the \fIlocale\fR is given. -If the option \fIlocale\fR is not given, the package is set to package private locale mode, but no locale is changed (e.g. if the global locale was valid for the package before, it is copied to the package private locale). +The package private locale is set to the given \fIlocale\fR if the \fIlocale\fR +is given. If the option \fIlocale\fR is not given, the package is set to package +private locale mode, but no locale is changed (e.g. if the global locale was +valid for the package before, it is copied to the package private locale). .PP .RS This command may cause the load of locales. .RE +.\" METHOD: get .TP \fB::msgcat::mcpackagelocale get\fR . -Return the package private locale or the global locale, if no package private locale is set. +Return the package private locale or the global locale, if no package private +locale is set. +.\" METHOD: preferences .TP \fB::msgcat::mcpackagelocale preferences\fR ?\fIlocale preference\fR? ... . -With no parameters, return the package private preferences or the global preferences, -if no package private locale is set. -The package locale state (set or not) is not changed (in contrast to the command \fB::msgcat::mcpackagelocale set\fR). +With no parameters, return the package private preferences or the global +preferences, if no package private locale is set. +The package locale state (set or not) is not changed (in contrast to the +command \fB::msgcat::mcpackagelocale set\fR). .PP .RS .VS "TIP 499" -If a set of locale preferences is given, it is set as package locale preference list. -The package locale is set to the first element of the preference list. +If a set of locale preferences is given, it is set as package locale preference +list. The package locale is set to the first element of the preference list. A package locale is activated, if it was not set so far. .PP Locale preferences are loaded now for the package, if not jet loaded. .VE "TIP 499" .RE .PP +.\" METHOD: loaded .TP \fB::msgcat::mcpackagelocale loaded\fR . Return the list of locales loaded for this package. +.\" METHOD: isset .TP \fB::msgcat::mcpackagelocale isset\fR . Returns true, if a package private locale is set. +.\" METHOD: unset .TP \fB::msgcat::mcpackagelocale unset\fR . -Unset the package private locale and use the globale locale. +Unset the package private locale and use the global locale. Load and remove locales to adjust the list of loaded locales for the package to the global loaded locales list. +.\" METHOD: present .TP \fB::msgcat::mcpackagelocale present\fI locale\fR . Returns true, if the given locale is loaded for the package. +.\" METHOD: clear .TP \fB::msgcat::mcpackagelocale clear\fR . @@ -595,22 +634,29 @@ Clear any loaded locales of the package not present in the package preferences. .PP Each package using msgcat has a set of options within \fBmsgcat\fR. The package options are described in the next sectionPackage options. -Each package option may be set or unset individually using the following ensemble: +Each package option may be set or unset individually using the following +ensemble: +.\" COMMAND: mcpackageconfig +.\" METHOD: get .TP \fB::msgcat::mcpackageconfig get\fI option\fR . Return the current value of the given \fIoption\fR. This call returns an error if the option is not set for the package. +.\" METHOD: isset .TP \fB::msgcat::mcpackageconfig isset\fI option\fR . Returns 1, if the given \fIoption\fR is set for the package, 0 otherwise. +.\" METHOD: set .TP \fB::msgcat::mcpackageconfig set\fI option value\fR . Set the given \fIoption\fR to the given \fIvalue\fR. This may invoke additional actions in dependency of the \fIoption\fR. -The return value is 0 or the number of loaded packages for the option \fBmcfolder\fR. +The return value is 0 or the number of loaded packages for the option +\fBmcfolder\fR. +.\" METHOD: unset .TP \fB::msgcat::mcpackageconfig unset\fI option\fR . @@ -623,30 +669,40 @@ The following package options are available for each package: .TP \fBmcfolder\fR . -This is the message folder of the package. This option is set by mcload and by the subcommand set. Both are identical and both return the number of loaded message catalog files. +This is the message folder of the package. This option is set by mcload and by +the subcommand set. Both are identical and both return the number of loaded +message catalog files. .RS .PP -Setting or changing this value will load all locales contained in the preferences valid for the package. This implies also to invoke any set loadcmd (see below). +Setting or changing this value will load all locales contained in the +preferences valid for the package. This implies also to invoke any set +loadcmd (see below). .PP Unsetting this value will disable message file load for the package. .RE .TP \fBloadcmd\fR . -This callback is invoked before a set of message catalog files are loaded for the package which has this property set. +This callback is invoked before a set of message catalog files are loaded for +the package which has this property set. .PP .RS -This callback may be used to do any preparation work for message file load or to get the message data from another source like a data base. In this case, no message files are used (mcfolder is unset). +This callback may be used to do any preparation work for message file load or +to get the message data from another source like a data base. In this case, no +message files are used (mcfolder is unset). .PP See section \fBcallback invocation\fR below. The parameter list appended to this callback is the list of locales to load. .PP -If this callback is changed, it is called with the preferences valid for the package. +If this callback is changed, it is called with the preferences valid for the +package. .RE .TP \fBchangecmd\fR . -This callback is invoked when a default local change was performed. Its purpose is to allow a package to update any dependency on the default locale like showing the GUI in another language. +This callback is invoked when a default local change was performed. Its +purpose is to allow a package to update any dependency on the default locale +like showing the GUI in another language. .PP .RS See the callback invocation section below. @@ -656,15 +712,19 @@ The registered callbacks are invoked in no particular order. .TP \fBunknowncmd\fR . -Use a package locale mcunknown procedure instead of the standard version supplied by the msgcat package (msgcat::mcunknown). +Use a package locale mcunknown procedure instead of the standard version +supplied by the msgcat package (\fBmsgcat::mcunknown\fR). .PP .RS -The called procedure must return the formatted message which will finally be returned by msgcat::mc. +The called procedure must return the formatted message which will finally be +returned by \fBmsgcat::mc\fR. .PP -A generic unknown handler is used if set to the empty string. This consists in returning the key if no arguments are given. With given arguments, format is used to process the arguments. +A generic unknown handler is used if set to the empty string. This consists of +returning the key if no arguments are given. With given arguments, the +\fBformat\fR command is used to process the arguments. .PP See section \fBcallback invocation\fR below. -The appended arguments are identical to \fB::msgcat::mcunknown\fR. +The appended arguments are identical to \fBmsgcat::mcunknown\fR. .RE .SH "Callback invocation" A package may decide to register one or multiple callbacks, as described above. @@ -677,15 +737,20 @@ Callbacks are invoked, if: .PP 3. the registering namespace exists. .PP -If a called routine fails with an error, the \fBbgerror\fR routine for the interpreter is invoked after command completion. -Only exception is the callback \fBunknowncmd\fR, where an error causes the invoking \fBmc\fR-command to fail with that error. +If a called routine fails with an error, the \fBbgerror\fR routine for the +interpreter is invoked after command completion. +Only exception is the callback \fBunknowncmd\fR, where an error causes the +invoking \fBmc\fR-command to fail with that error. .PP .VS tip490 .SH "OBJECT ORIENTED PROGRAMMING" \fBmsgcat\fR supports packages implemented by object oriented programming. Objects and classes should be defined within a package namespace. .PP -There are 3 supported cases where package namespace sensitive commands of msgcat (\fBmc\fR, \fBmcexists\fR, \fBmcpackagelocale\fR, \fBmcforgetpackage\fR, \fBmcpackagenamespaceget\fR, \fBmcpackageconfig\fR, \fBmcset\fR and \fBmcmset\fR) may be called: +There are 3 supported cases where package namespace sensitive commands of msgcat +(\fBmc\fR, \fBmcexists\fR, \fBmcpackagelocale\fR, \fBmcforgetpackage\fR, +\fBmcpackagenamespaceget\fR, \fBmcpackageconfig\fR, \fBmcset\fR and \fBmcmset\fR) +may be called: .PP .TP \fB1) In class definition script\fR @@ -701,7 +766,8 @@ namespace eval ::N2 { .TP \fB2) method defined in a class\fR . -\fBmsgcat\fR command is called from a method in an object and the method is defined in a class. +\fBmsgcat\fR command is called from a method in an object and the method is +defined in a class. .CS namespace eval ::N3Class { mcload $dir/msgs @@ -728,8 +794,8 @@ namespace eval ::N4 { .PP .VE tip490 .SH EXAMPLES -Packages which display a GUI may update their widgets when the global locale changes. -To register to a callback, use: +Packages which display a GUI may update their widgets when the global locale +changes. To register to a callback, use: .CS namespace eval gui { msgcat::mcpackageconfig changecmd updateGUI @@ -743,7 +809,8 @@ fr % New locale is 'fr'. .CE .PP -If locales (or additional locales) are contained in another source like a data base, a package may use the load callback and not mcload: +If locales (or additional locales) are contained in another source like a +database, a package may use the load callback and not \fBmcload\fR: .CS namespace eval db { msgcat::mcpackageconfig loadcmd loadMessages @@ -758,10 +825,12 @@ namespace eval db { } .CE .PP -The \fBclock\fR command implementation uses \fBmsgcat\fR with a package locale to implement the command line parameter \fB-locale\fR. +The \fBclock\fR command implementation uses \fBmsgcat\fR with a package +locale to implement the command line parameter \fB\-locale\fR. Here are some sketches of the implementation: .PP -First, a package locale is initialized and the generic unknown function is desactivated: +First, a package locale is initialized and the generic unknown function is +deactivated: .CS msgcat::mcpackagelocale set msgcat::mcpackageconfig unknowncmd "" @@ -770,13 +839,15 @@ As an example, the user requires the week day in a certain locale as follows: .CS clock format [clock seconds] -format %A -locale fr .CE -\fBclock\fR sets the package locale to \fBfr\fR and looks for the day name as follows: +\fBclock\fR sets the package locale to \fBfr\fR and looks for the day name as +follows: .CS msgcat::mcpackagelocale set $locale return [lindex [msgcat::mc DAYS_OF_WEEK_FULL] $day] ### Returns "mercredi" .CE -Within \fBclock\fR, some message-catalog items are heavy in computation and thus are dynamically cached using: +Within \fBclock\fR, some message-catalog items are heavy in computation and +thus are dynamically cached using: .CS proc ::tcl::clock::LocalizeFormat { locale format } { set key FORMAT_$format @@ -795,7 +866,8 @@ The message catalog code was developed by Mark Harrison. .SH "SEE ALSO" format(n), scan(n), namespace(n), package(n), oo::class(n), oo::object .SH KEYWORDS -internationalization, i18n, localization, l10n, message, text, translation, class, object +internationalization, i18n, localization, l10n, message, text, translation, +class, object .\" Local Variables: .\" mode: nroff .\" End: diff --git a/doc/my.n b/doc/my.n index 3464a87..425324e 100644 --- a/doc/my.n +++ b/doc/my.n @@ -35,9 +35,9 @@ defined by that object or class. .VE TIP500 .PP The object upon which the method is invoked via \fBmy\fR is the one that owns -the namespace that the \fBmy\fR command is contained in initially (\fBNB:\fR the link -remains if the command is renamed), which is the currently invoked object by -default. +the namespace that the \fBmy\fR command is contained in initially (\fBNB:\fR the +link remains if the command is renamed), which is the currently invoked object +by default. .VS TIP478 Similarly, the object on which the method is invoked via \fBmyclass\fR is the object that is the current class of the object that owns the namespace that diff --git a/doc/namespace.n b/doc/namespace.n index 5e90d13..5f02082 100644 --- a/doc/namespace.n +++ b/doc/namespace.n @@ -287,8 +287,7 @@ For the \fIstring\fR \fB::foo::bar::x\fR, this command returns \fB::foo::bar\fR, and for \fB::\fR it returns an empty string. This command is the complement of the \fBnamespace tail\fR command. -Note that it does not check whether the -namespace names are, in fact, +It does not check whether the namespace names are, in fact, the names of currently defined namespaces. .\" METHOD: tail .TP @@ -546,14 +545,14 @@ about name resolution. For example, the command: .PP .CS -\fBnamespace eval\fR Foo::Debug {\fBnamespace which\fR \-variable traceLevel} +\fBnamespace eval\fR Foo::Debug {\fBnamespace which\fR -variable traceLevel} .CE .PP returns \fB::traceLevel\fR. On the other hand, the command, .PP .CS -\fBnamespace eval\fR Foo {\fBnamespace which\fR \-variable traceLevel} +\fBnamespace eval\fR Foo {\fBnamespace which\fR -variable traceLevel} .CE .PP returns \fB::Foo::traceLevel\fR. @@ -595,7 +594,7 @@ like BLT are contained in a namespace called \fBBlt\fR. Then you might access these commands like this: .PP .CS -Blt::graph .g \-background red +Blt::graph .g -background red Blt::table . .g 0,0 .CE .PP @@ -612,7 +611,7 @@ This adds all exported commands from the \fBBlt\fR namespace into the current namespace context, so you can write code like this: .PP .CS -graph .g \-background red +graph .g -background red table . .g 0,0 .CE .PP @@ -641,7 +640,7 @@ that have appeared in a namespace. In that case, you can use the \fB\-force\fR option, and existing commands will be silently overwritten: .PP .CS -\fBnamespace import\fR \-force Blt::graph Blt::table +\fBnamespace import\fR -force Blt::graph Blt::table .CE .PP If for some reason, you want to stop using the imported commands, @@ -793,6 +792,7 @@ the \fBuplevel\fR or \fBinfo level\fR commands. The following options, supported by the \fBnamespace ensemble create\fR and \fBnamespace ensemble configure\fR commands, control how an ensemble command behaves: +.\" OPTION: -map .TP \fB\-map\fR . @@ -808,12 +808,15 @@ will be from the local name of the subcommand to its fully-qualified name. Note that when this option is non-empty and the \fB\-subcommands\fR option is empty, the ensemble subcommand names will be exactly those words that have mappings in the dictionary. +.\" OPTION: -parameters .TP \fB\-parameters\fR +. This option gives a list of named arguments (the names being used during generation of error messages) that are passed by the caller of the ensemble between the name of the ensemble and the subcommand argument. By default, it is the empty list. +.\" OPTION: -prefixes .TP \fB\-prefixes\fR . @@ -821,6 +824,7 @@ This option (which is enabled by default) controls whether the ensemble command recognizes unambiguous prefixes of its subcommands. When turned off, the ensemble command requires exact matching of subcommand names. +.\" OPTION: -subcommands .TP \fB\-subcommands\fR . @@ -832,6 +836,7 @@ empty, the subcommands of the namespace will either be the keys of the dictionary listed in the \fB\-map\fR option or the exported commands of the linked namespace at the time of the invocation of the ensemble command. +.\" OPTION: -unknown .TP \fB\-unknown\fR . @@ -846,6 +851,7 @@ unable to determine how to implement a particular subcommand. See .PP The following extra option is allowed by \fBnamespace ensemble create\fR: +.\" OPTION: -command .TP \fB\-command\fR . @@ -857,6 +863,7 @@ command is invoked. .PP The following extra option is allowed by \fBnamespace ensemble configure\fR: +.\" OPTION: -namespace .TP \fB\-namespace\fR . diff --git a/doc/next.n b/doc/next.n index 624e058..9f25ca2 100644 --- a/doc/next.n +++ b/doc/next.n @@ -34,10 +34,10 @@ chain. .PP The \fBnextto\fR command is the same as the \fBnext\fR command, except that it takes an additional \fIclass\fR argument that identifies a class whose -implementation of the current method chain (see \fBinfo object\fR \fBcall\fR) should -be used; the method implementation selected will be the one provided by the -given class, and it must refer to an existing non-filter invocation that lies -further along the chain than the current implementation. +implementation of the current method chain (see \fBinfo object\fR \fBcall\fR) +should be used; the method implementation selected will be the one provided by +the given class, and it must refer to an existing non-filter invocation that +lies further along the chain than the current implementation. .SH "THE METHOD CHAIN" .PP When a method of an object is invoked, things happen in several stages: diff --git a/doc/open.n b/doc/open.n index 1c63f8f..03a58e6 100644 --- a/doc/open.n +++ b/doc/open.n @@ -31,35 +31,23 @@ conventions described in the \fBfilename\fR manual entry. The \fIaccess\fR argument, if present, indicates the way in which the file (or command pipeline) is to be accessed. In the first form \fIaccess\fR may have any of the following values: -.TP 15 -\fBr\fR -. +.IP \fBr\fR Open the file for reading only; the file must already exist. This is the default value if \fIaccess\fR is not specified. -.TP 15 -\fBr+\fR -. +.IP \fBr+\fR Open the file for both reading and writing; the file must already exist. -.TP 15 -\fBw\fR -. +.IP \fBw\fR Open the file for writing only. Truncate it if it exists. If it does not exist, create a new file. -.TP 15 -\fBw+\fR -. +.IP \fBw+\fR Open the file for reading and writing. Truncate it if it exists. If it does not exist, create a new file. -.TP 15 -\fBa\fR -. +.IP \fBa\fR Open the file for writing only. If the file does not exist, create a new empty file. Set the file pointer to the end of the file prior to each write. -.TP 15 -\fBa+\fR -. +.IP \fBa+\fR Open the file for reading and writing. If the file does not exist, create a new empty file. Set the initial access position to the end of the file. @@ -73,44 +61,26 @@ reading or writing of binary data. In the second form, \fIaccess\fR consists of a list of any of the following flags, most of which have the standard POSIX meanings. One of the flags must be either \fBRDONLY\fR, \fBWRONLY\fR or \fBRDWR\fR. -.TP 15 -\fBRDONLY\fR -. +.IP \fBRDONLY\fR Open the file for reading only. -.TP 15 -\fBWRONLY\fR -. +.IP \fBWRONLY\fR Open the file for writing only. -.TP 15 -\fBRDWR\fR -. +.IP \fBRDWR\fR Open the file for both reading and writing. -.TP 15 -\fBAPPEND\fR -. +.IP \fBAPPEND\fR Set the file pointer to the end of the file prior to each write. -.TP 15 -\fBBINARY\fR -. +.IP \fBBINARY\fR Configure the opened channel with the \fB\-translation binary\fR option. -.TP 15 -\fBCREAT\fR -. +.IP \fBCREAT\fR Create the file if it does not already exist (without this flag it is an error for the file not to exist). -.TP 15 -\fBEXCL\fR -. +.IP \fBEXCL\fR If \fBCREAT\fR is also specified, an error is returned if the file already exists. -.TP 15 -\fBNOCTTY\fR -. +.IP \fBNOCTTY\fR If the file is a terminal device, this flag prevents the file from becoming the controlling terminal of the process. -.TP 15 -\fBNONBLOCK\fR -. +.IP \fBNONBLOCK\fR Prevents the process from blocking while opening the file, and possibly in subsequent I/O operations. The exact behavior of this flag is system- and device-dependent; its use is discouraged @@ -118,9 +88,7 @@ this flag is system- and device-dependent; its use is discouraged in nonblocking mode). For details refer to your system documentation on the \fBopen\fR system call's \fBO_NONBLOCK\fR flag. -.TP 15 -\fBTRUNC\fR -. +.IP \fBTRUNC\fR If the file exists it is truncated to zero length. .PP If a new file is created as part of opening it, \fIpermissions\fR @@ -132,6 +100,7 @@ conjunction with the process's file mode creation mask. When the file opened is an ordinary disk file, the \fBchan configure\fR and \fBfconfigure\fR commands can be used to query this additional configuration option: +.\" OPTION: -stat .TP \fB\-stat\fR . @@ -190,6 +159,7 @@ the PORTABILITY ISSUES section. The \fBchan configure\fR and \fBfconfigure\fR commands can be used to query and set additional configuration options specific to serial ports (where supported): +.\" OPTION: -mode .TP \fB\-mode\fI baud\fB,\fIparity\fB,\fIdata\fB,\fIstop\fR . @@ -207,6 +177,7 @@ or \fIData\fR is the number of data bits and should be an integer from 5 to 8, while \fIstop\fR is the number of stop bits and should be the integer 1 or 2. +.\" OPTION: -handshake .TP \fB\-handshake\fI type\fR . @@ -225,12 +196,14 @@ There is no default handshake configuration, the initial value depends on your operating system settings. The \fB\-handshake\fR option cannot be queried. .RE +.\" OPTION: -queue .TP \fB\-queue\fR . (Windows and Unix). The \fB\-queue\fR option can only be queried. It returns a list of two integers representing the current number of bytes in the input and output queue respectively. +.\" OPTION: -timeout .TP \fB\-timeout\fI msec\fR . @@ -241,6 +214,7 @@ For Unix systems the granularity is 100 milliseconds. The \fB\-timeout\fR option does not affect write operations or nonblocking reads. This option cannot be queried. +.\" OPTION: -ttycontrol .TP \fB\-ttycontrol\fI {signal boolean signal boolean ...}\fR . @@ -254,6 +228,7 @@ It is not a good idea to change the \fBRTS\fR (or \fBDTR\fR) signal with active hardware handshake \fBrtscts\fR (or \fBdtrdsr\fR). The result is unpredictable. The \fB\-ttycontrol\fR option cannot be queried. +.\" OPTION: -ttystatus .TP \fB\-ttystatus\fR . @@ -263,6 +238,7 @@ queried. It returns the current modem status and handshake input signals The result is a list of signal,value pairs with a fixed order, e.g. \fB{CTS 1 DSR 0 RING 1 DCD 0}\fR. The \fIsignal\fR names are returned upper case. +.\" OPTION: -xchar .TP \fB\-xchar\fI {xonChar xoffChar}\fR . @@ -270,6 +246,7 @@ The \fIsignal\fR names are returned upper case. handshake characters. Normally the operating system default should be DC1 (0x11) and DC3 (0x13) representing the ASCII standard XON and XOFF characters. +.\" OPTION: -closemode .TP \fB\-closemode\fI closeMode\fR .VS "8.7, TIP 160" @@ -278,24 +255,19 @@ the serial channel, which defines how pending output in operating system buffers is handled when the channel is closed. The following values for \fIcloseMode\fR are supported: .RS -.TP -\fBdefault\fR -. +.IP \fBdefault\fR indicates that a system default operation should be used; all serial channels default to this. -.TP -\fBdiscard\fR -. +.IP \fBdiscard\fR indicates that the contents of the OS buffers should be discarded. Note that this is \fInot recommended\fR when writing to a POSIX terminal, as it can interact unexpectedly with handling of \fBstderr\fR. -.TP -\fBdrain\fR -. +.IP \fBdrain\fR indicates that Tcl should wait when closing the channel until all output has been consumed. This may slow down \fBclose\fR noticeably. .RE .VE "8.7, TIP 160" +.\" OPTION: -inputmode .TP \fB\-inputmode\fI inputMode\fR .VS "8.7, TIP 160" @@ -305,26 +277,18 @@ the assumption that it is talking to a terminal, which controls how interactive input from users is handled. The following values for \fIinputMode\fR are supported: .RS -.TP -\fBnormal\fR -. +.IP \fBnormal\fR indicates that normal line-oriented input should be used, with standard terminal editing capabilities enabled. -.TP -\fBpassword\fR -. +.IP \fBpassword\fR indicates that non-echoing input should be used, with standard terminal editing capabilities enabled but no writing of typed characters to the terminal (except for newlines). Some terminals may indicate this specially. -.TP -\fBraw\fR -. +.IP \fBraw\fR indicates that all keyboard input should be given directly to Tcl with the terminal doing no processing at all. It does not echo the keys, leaving it up to the Tcl script to interpret what to do. -.TP -\fBreset\fR (set only) -. +.IP "\fBreset\fR (set only)" indicates that the terminal should be reset to what state it was in when the terminal was opened. .PP @@ -332,6 +296,7 @@ Note that setting this option (technically, anything that changes the terminal state from its initial value \fIvia this option\fR) will cause the channel to turn on an automatic reset of the terminal when the channel is closed. .RE +.\" OPTION: -winsize .TP \fB\-winsize\fR . @@ -339,6 +304,7 @@ turn on an automatic reset of the terminal when the channel is closed. option is query only. It retrieves a two-element list with the the current width and height of the terminal. .VE "8.7, TIP 160" +.\" OPTION: -pollinterval .TP \fB\-pollinterval\fI msec\fR . @@ -348,6 +314,7 @@ This affects the time interval between checking for events throughout the Tcl interpreter (the smallest value always wins). Use this option only if you want to poll the serial port more or less often than 10 msec (the default). +.\" OPTION: -sysbuffer .TP \fB\-sysbuffer\fI inSize\fR .TP @@ -358,6 +325,7 @@ system buffers for a serial channel. Especially at higher communication rates the default input buffer size of 4096 bytes can overrun for latent systems. The first form specifies the input buffer size, in the second form both input and output buffers are defined. +.\" OPTION: -lasterror .TP \fB\-lasterror\fR . @@ -376,29 +344,29 @@ lines and handshaking. Here we are using the terms \fIworkstation\fR for your computer and \fImodem\fR for the external device, because some signal names (DCD, RI) come from modems. Of course your external device may use these signal lines for other purposes. -.IP \fBTXD\fR(output) +.IP "\fBTXD\fR (output)" \fBTransmitted Data:\fR Outgoing serial data. -.IP \fBRXD\fR(input) +.IP "\fBRXD\fR (input)" \fBReceived Data:\fRIncoming serial data. -.IP \fBRTS\fR(output) +.IP "\fBRTS\fR (output)" \fBRequest To Send:\fR This hardware handshake line informs the modem that your workstation is ready to receive data. Your workstation may automatically reset this signal to indicate that the input buffer is full. -.IP \fBCTS\fR(input) +.IP "\fBCTS\fR (input)" \fBClear To Send:\fR The complement to RTS. Indicates that the modem is ready to receive data. -.IP \fBDTR\fR(output) +.IP "\fBDTR\fR (output)" \fBData Terminal Ready:\fR This signal tells the modem that the workstation is ready to establish a link. DTR is often enabled automatically whenever a serial port is opened. -.IP \fBDSR\fR(input) +.IP "\fBDSR\fR (input)" \fBData Set Ready:\fR The complement to DTR. Tells the workstation that the modem is ready to establish a link. -.IP \fBDCD\fR(input) +.IP "\fBDCD\fR (input)" \fBData Carrier Detect:\fR This line becomes active when a modem detects a .QW Carrier signal. -.IP \fBRI\fR(input) +.IP "\fBRI\fR (input)" \fBRing Indicator:\fR Goes active when the modem detects an incoming call. .IP \fBBREAK\fR A BREAK condition is not a hardware signal line, but a logical zero on the @@ -416,39 +384,27 @@ settings may be wrong. That is why a reliable software should always \fBcatch\fR serial read operations. In cases of an error Tcl returns a general file I/O error. Then \fBfconfigure\fR \fB\-lasterror\fR may help to locate the problem. The following error codes may be returned. -.TP 10 -\fBRXOVER\fR -. +.IP \fBRXOVER\fR Windows input buffer overrun. The data comes faster than your scripts reads -it or your system is overloaded. Use \fBfconfigure\fR \fB\-sysbuffer\fR to avoid a -temporary bottleneck and/or make your script faster. -.TP 10 -\fBTXFULL\fR -. +it or your system is overloaded. Use \fBfconfigure\fR \fB\-sysbuffer\fR to +avoid a temporary bottleneck and/or make your script faster. +.IP \fBTXFULL\fR Windows output buffer overrun. Complement to RXOVER. This error should practically not happen, because Tcl cares about the output buffer status. -.TP 10 -\fBOVERRUN\fR -. +.IP \fBOVERRUN\fR UART buffer overrun (hardware) with data lost. The data comes faster than the system driver receives it. Check your advanced serial port settings to enable the FIFO (16550) buffer and/or setup a lower(1) interrupt threshold value. -.TP 10 -\fBRXPARITY\fR -. +.IP \fBRXPARITY\fR A parity error has been detected by your UART. -Wrong parity settings with \fBfconfigure\fR \fB\-mode\fR or a noisy data line (RXD) -may cause this error. -.TP 10 -\fBFRAME\fR -. +Wrong parity settings with \fBfconfigure\fR \fB\-mode\fR or a noisy data line +(RXD) may cause this error. +.IP \fBFRAME\fR A stop-bit error has been detected by your UART. -Wrong mode settings with \fBfconfigure\fR \fB\-mode\fR or a noisy data line (RXD) -may cause this error. -.TP 10 -\fBBREAK\fR -. +Wrong mode settings with \fBfconfigure\fR \fB\-mode\fR or a noisy data line +(RXD) may cause this error. +.IP \fBBREAK\fR A BREAK condition has been detected by your UART (see above). .SS "PORTABILITY ISSUES" .TP @@ -482,7 +438,7 @@ before each write, which is not an atomic operation and does not carry the guarantee of strict appending that is present on POSIX platforms. .RE .TP -\fBUnix\fR\0\0\0\0\0\0\0 +\fBUnix \fR . Valid values for \fIfileName\fR to open a serial port are generally of the form \fB/dev/tty\fIX\fR, where \fIX\fR is \fBa\fR or \fBb\fR, but the name @@ -509,6 +465,7 @@ applications on the various platforms .VS "8.7, TIP 160" On Windows only, console channels (usually \fBstdin\fR or \fBstdout\fR) support the following options: +.\" OPTION: -inputmode .TP \fB\-inputmode\fI inputMode\fR . @@ -516,20 +473,14 @@ This option is used to query or change the input mode of the console channel, which controls how interactive input from users is handled. The following values for \fIinputMode\fR are supported: .RS -.TP -\fBnormal\fR -. +.IP \fBnormal\fR indicates that normal line-oriented input should be used, with standard console editing capabilities enabled. -.TP -\fBpassword\fR -. +.IP \fBpassword\fR indicates that non-echoing input should be used, with standard console -editing capabilitied enabled but no writing of typed characters to the +editing capabilities enabled but no writing of typed characters to the terminal (except for newlines). -.TP -\fBraw\fR -. +.IP \fBraw\fR indicates that all keyboard input should be given directly to Tcl with the console doing no processing at all. It does not echo the keys, leaving it up to the Tcl script to interpret what to do. @@ -543,11 +494,12 @@ Note that setting this option (technically, anything that changes the console state from its default \fIvia this option\fR) will cause the channel to turn on an automatic reset of the console when the channel is closed. .RE +.\" OPTION: -winsize .TP \fB\-winsize\fR . This option is query only. -It retrieves a two-element list with the the current width and height of the +It retrieves a two-element list with the current width and height of the console that this channel is talking to. .PP Note that the equivalent options exist on Unix, but are on the serial channel diff --git a/doc/package.n b/doc/package.n index dc21093..d27a44a 100644 --- a/doc/package.n +++ b/doc/package.n @@ -208,33 +208,23 @@ Returns 1 if the \fIversion\fR satisfies at least one of the given requirements, and 0 otherwise. Each \fIrequirement\fR is allowed to have any of the forms: .RS -.TP -min -. +.IP \fImin\fR This form is called .QW min-bounded . -.TP -min- -. +.IP \fImin\fB\-\fR This form is called .QW min-unbound . -.TP -min-max -. +.IP \fImin\fB\-\fImax\fR This form is called .QW bounded . -.RE -.RS .PP where -.QW min +.QW \fImin\fR and -.QW max +.QW \fImax\fR are valid version numbers. The legacy syntax is a special case of the extended syntax, keeping backward compatibility. Regarding satisfaction the rules are: -.RE -.RS .IP [1] The \fIversion\fR has to pass at least one of the listed \fIrequirement\fRs to be satisfactory. diff --git a/doc/packagens.n b/doc/packagens.n index ebb7372..42a0686 100644 --- a/doc/packagens.n +++ b/doc/packagens.n @@ -19,14 +19,20 @@ command for a given package specification. It can be used to construct a \fBpkgIndex.tcl\fR file for use with the \fBpackage\fR mechanism. .SH OPTIONS The parameters supported are: +.\" OPTION: -name .TP \fB\-name \fIpackageName\fR +. This parameter specifies the name of the package. It is required. +.\" OPTION: -version .TP \fB\-version \fIpackageVersion\fR +. This parameter specifies the version of the package. It is required. +.\" OPTION: -load .TP \fB\-load \fIfilespec\fR +. This parameter specifies a library that must be loaded with the \fBload\fR command. \fIfilespec\fR is a list with two elements. The first element is the name of the file to load. The second, optional @@ -34,8 +40,10 @@ element is a list of commands supplied by loading that file. If the list of procedures is empty or omitted, \fB::pkg::create\fR will set up the library for direct loading (see \fBpkg_mkIndex\fR). Any number of \fB\-load\fR parameters may be specified. +.\" OPTION: -source .TP \fB\-source \fIfilespec\fR +. This parameter is similar to the \fB\-load\fR parameter, except that it specifies a Tcl library that must be loaded with the \fBsource\fR command. Any number of \fB\-source\fR parameters may be diff --git a/doc/pkgMkIndex.n b/doc/pkgMkIndex.n index f98cbcd..3d10360 100644 --- a/doc/pkgMkIndex.n +++ b/doc/pkgMkIndex.n @@ -96,29 +96,39 @@ Different versions of a package may be loaded in different interpreters. .SH OPTIONS The optional switches are: +.\" OPTION: -direct .TP 15 \fB\-direct\fR +. The generated index will implement direct loading of the package upon \fBpackage require\fR. This is the default. +.\" OPTION: -lazy .TP 15 \fB\-lazy\fR +. The generated index will manage to delay loading the package until the use of one of the commands provided by the package, instead of loading it immediately upon \fBpackage require\fR. This is not compatible with the use of \fIauto_reset\fR, and therefore its use is discouraged. +.\" OPTION: -load .TP 15 \fB\-load \fIpkgPat\fR +. The index process will preload any packages that exist in the current interpreter and match \fIpkgPat\fR into the child interpreter used to generate the index. The pattern match uses string match rules, but without making case distinctions. See \fBCOMPLEX CASES\fR below. +.\" OPTION: -verbose .TP 15 \fB\-verbose\fR +. Generate output during the indexing process. Output is via the \fBtclLog\fR procedure, which by default prints to stderr. +.\" OPTION: -- .TP 15 \fB\-\-\fR +. End of the flags, in case \fIdir\fR begins with a dash. .SH "PACKAGES AND THE AUTO-LOADER" .PP diff --git a/doc/platform.n b/doc/platform.n index 18754b6..3ff0568 100644 --- a/doc/platform.n +++ b/doc/platform.n @@ -43,7 +43,7 @@ establishes a standard naming convention for architectures running Tcl and makes it more convenient for developers to identify the current architecture a Tcl program is running on. .SH COMMANDS -.\" METHOD: identify +.\" COMMAND: identify .TP \fBplatform::identify\fR . @@ -53,7 +53,7 @@ core is running on. The returned identifier has the general format details like kernel version, libc version, etc., and this information may contain dashes as well. The \fICPU\fR part will not contain dashes, making the preceding dash the last dash in the result. -.\" METHOD: generic +.\" COMMAND: generic .TP \fBplatform::generic\fR . @@ -61,7 +61,7 @@ This command returns a simplified identifier describing the platform the Tcl core is running on. In contrast to \fBplatform::identify\fR it leaves out details like kernel version, libc version, etc. The returned identifier has the general format \fIOS\fR-\fICPU\fR. -.\" METHOD: patterns +.\" COMMAND: patterns .TP \fBplatform::patterns \fIidentifier\fR . diff --git a/doc/platform_shell.n b/doc/platform_shell.n index 7103e6a..22c2ca4 100644 --- a/doc/platform_shell.n +++ b/doc/platform_shell.n @@ -41,19 +41,19 @@ the architecture of the shell which will actually run the installed packages, versus the architecture of the shell running the repository software. .SH COMMANDS -.\" METHOD: identify +.\" COMMAND: identify .TP \fBplatform::shell::identify \fIshell\fR . This command does the same identification as \fBplatform::identify\fR, for the specified Tcl shell, in contrast to the running shell. -.\" METHOD: generic +.\" COMMAND: generic .TP \fBplatform::shell::generic \fIshell\fR . This command does the same identification as \fBplatform::generic\fR, for the specified Tcl shell, in contrast to the running shell. -.\" METHOD: platform +.\" COMMAND: platform .TP \fBplatform::shell::platform \fIshell\fR . diff --git a/doc/prefix.n b/doc/prefix.n index abd337a..a2180e5 100644 --- a/doc/prefix.n +++ b/doc/prefix.n @@ -44,15 +44,18 @@ before use with this subcommand, so that the list of matches presented in the error message also becomes sorted, though this is not strictly necessary for the operation of this subcommand itself.) .RS +.\" OPTION: -exact .TP -\fB\-exact\fR\0 +\fB\-exact\fR . Accept only exact matches. +.\" OPTION: -message .TP \fB\-message\0\fIstring\fR . Use \fIstring\fR in the error message at a mismatch. Default is .QW option . +.\" OPTION: -error .TP \fB\-error\0\fIoptions\fR . @@ -67,7 +70,7 @@ is used, an error would be generated as: .RS .PP .CS -return \-errorcode MyError \-level 1 \-code error \e +return -errorcode MyError -level 1 -code error \e "ambiguous option ..." .CE .RE @@ -82,9 +85,9 @@ namespace import ::tcl::prefix \fI\(-> apa\fR \fBprefix match\fR {apa bepa cepa} a \fI\(-> apa\fR -\fBprefix match\fR \-exact {apa bepa cepa} a +\fBprefix match\fR -exact {apa bepa cepa} a \fI\(-> bad option "a": must be apa, bepa, or cepa\fR -\fBprefix match\fR \-message "switch" {apa ada bepa cepa} a +\fBprefix match\fR -message "switch" {apa ada bepa cepa} a \fI\(-> ambiguous switch "a": must be apa, ada, bepa, or cepa\fR \fBprefix longest\fR {fblocked fconfigure fcopy file fileevent flush} fc \fI\(-> fco\fR @@ -95,9 +98,9 @@ namespace import ::tcl::prefix Simplifying option matching: .PP .CS -array set opts {\-apa 1 \-bepa "" \-cepa 0} +array set opts {-apa 1 -bepa "" -cepa 0} foreach {arg val} $args { - set opts([\fBprefix match\fR {\-apa \-bepa \-cepa} $arg]) $val + set opts([\fBprefix match\fR {-apa -bepa -cepa} $arg]) $val } .CE .PP diff --git a/doc/proc.n b/doc/proc.n index fdccaca..d4de9b0 100644 --- a/doc/proc.n +++ b/doc/proc.n @@ -57,10 +57,10 @@ There is one special case to permit procedures with variable numbers of arguments. If the last formal argument has the name .QW \fBargs\fR , then a call to the procedure may contain more actual arguments -than the procedure has formal arguments. In this case, all of the actual arguments -starting at the one that would be assigned to \fBargs\fR are combined into -a list (as if the \fBlist\fR command had been used); this combined value -is assigned to the local variable \fBargs\fR. +than the procedure has formal arguments. In this case, all of the actual +arguments starting at the one that would be assigned to \fBargs\fR are +combined into a list (as if the \fBlist\fR command had been used); this +combined value is assigned to the local variable \fBargs\fR. .PP When \fIbody\fR is being executed, variable names normally refer to local variables, which are created automatically when referenced and diff --git a/doc/process.n b/doc/process.n index f69811e..78c05ad 100644 --- a/doc/process.n +++ b/doc/process.n @@ -57,16 +57,16 @@ processes, the status is a list with the following format: where: .RS .TP -\fIcode\fR\0 +\fIcode\fR . is a standard Tcl return code, i.e., \fB0\fR for TCL_OK and \fB1\fR for TCL_ERROR, .TP -\fImsg\fR\0 +\fImsg\fR . is the human-readable error message, .TP -\fIerrorCode\fR\0 +\fIerrorCode\fR . uses the same format as the \fBerrorCode\fR global variable .PP @@ -76,14 +76,16 @@ hood this command calls \fBTcl_WaitPid\fR with the \fBWNOHANG\fR flag set for non-blocking behavior, unless the \fB\-wait\fR switch is set (see below). .PP Additionally, \fB::tcl::process status\fR accepts the following switches: +.\" OPTION: -wait .TP -\fB\-wait\fR\0 +\fB\-wait\fR . By default the command returns immediately (the underlying \fBTcl_WaitPid\fR is called with the \fBWNOHANG\fR flag set) unless this switch is set. If \fIpids\fR is specified as a list of PIDs then the command waits until the status of the matching subprocesses are available. If \fIpids\fR was not specified, this command will wait for all known subprocesses. +.\" OPTION: -- .TP \fB\-\|\-\fR . diff --git a/doc/re_syntax.n b/doc/re_syntax.n index f68135e..1ece560 100644 --- a/doc/re_syntax.n +++ b/doc/re_syntax.n @@ -57,29 +57,17 @@ Without a quantifier, it matches a single match for the atom. The quantifiers, and what a so-quantified atom matches, are: .RS 2 -.TP 6 -\fB*\fR -. +.IP \fB*\fR 6 a sequence of 0 or more matches of the atom -.TP -\fB+\fR -. +.IP \fB+\fR 6 a sequence of 1 or more matches of the atom -.TP -\fB?\fR -. +.IP \fB?\fR 6 a sequence of 0 or 1 matches of the atom -.TP -\fB{\fIm\fB}\fR -. +.IP \fB{\fIm\fB}\fR 6 a sequence of exactly \fIm\fR matches of the atom -.TP -\fB{\fIm\fB,}\fR -. +.IP \fB{\fIm\fB,}\fR 6 a sequence of \fIm\fR or more matches of the atom -.TP -\fB{\fIm\fB,\fIn\fB}\fR -. +.IP \fB{\fIm\fB,\fIn\fB}\fR 6 a sequence of \fIm\fR through \fIn\fR (inclusive) matches of the atom; \fIm\fR may not exceed \fIn\fR .TP @@ -99,32 +87,32 @@ An atom is one of: .IP \fB(\fIre\fB)\fR 6 matches a match for \fIre\fR (\fIre\fR is any regular expression) with the match noted for possible reporting -.IP \fB(?:\fIre\fB)\fR +.IP \fB(?:\fIre\fB)\fR 6 as previous, but does no reporting (a .QW non-capturing set of parentheses) -.IP \fB()\fR +.IP \fB()\fR 6 matches an empty string, noted for possible reporting -.IP \fB(?:)\fR +.IP \fB(?:)\fR 6 matches an empty string, without reporting -.IP \fB[\fIchars\fB]\fR +.IP \fB[\fIchars\fB]\fR 6 a \fIbracket expression\fR, matching any one of the \fIchars\fR (see \fBBRACKET EXPRESSIONS\fR for more detail) -.IP \fB.\fR +.IP \fB.\fR 6 matches any single character -.IP \fB\e\fIk\fR +.IP \fB\e\fIk\fR 6 matches the non-alphanumeric character \fIk\fR taken as an ordinary character, e.g. \fB\e\e\fR matches a backslash character -.IP \fB\e\fIc\fR +.IP \fB\e\fIc\fR 6 where \fIc\fR is alphanumeric (possibly followed by other characters), an \fIescape\fR (AREs only), see \fBESCAPES\fR below -.IP \fB{\fR +.IP \fB{\fR 6 when followed by a character other than a digit, matches the left-brace character .QW \fB{\fR ; when followed by a digit, it is the beginning of a \fIbound\fR (see above) -.IP \fIx\fR +.IP \fIx\fR 6 where \fIx\fR is a single character with no other significance, matches that character. .RE @@ -334,82 +322,50 @@ is the one actual incompatibility between EREs and AREs.) Character-entry escapes (AREs only) exist to make it easier to specify non-printing and otherwise inconvenient characters in REs: .RS 2 -.TP 5 -\fB\ea\fR -. +.IP \fB\ea\fR 5 alert (bell) character, as in C -.TP -\fB\eb\fR -. +.IP \fB\eb\fR 5 backspace, as in C -.TP -\fB\eB\fR -. +.IP \fB\eB\fR 5 synonym for \fB\e\fR to help reduce backslash doubling in some applications where there are multiple levels of backslash processing -.TP -\fB\ec\fIX\fR -. +.IP \fB\ec\fIX\fR 5 (where \fIX\fR is any character) the character whose low-order 5 bits are the same as those of \fIX\fR, and whose other bits are all zero -.TP -\fB\ee\fR -. +.IP \fB\ee\fR 5 the character whose collating-sequence name is .QW \fBESC\fR , or failing that, the character with octal value 033 -.TP -\fB\ef\fR -. +.IP \fB\ef\fR 5 formfeed, as in C -.TP -\fB\en\fR -. +.IP \fB\en\fR 5 newline, as in C -.TP -\fB\er\fR -. +.IP \fB\er\fR 5 carriage return, as in C -.TP -\fB\et\fR -. +.IP \fB\et\fR 5 horizontal tab, as in C -.TP -\fB\eu\fIwxyz\fR -. +.IP \fB\eu\fIwxyz\fR 5 (where \fIwxyz\fR is one up to four hexadecimal digits) the Unicode character \fBU+\fIwxyz\fR in the local byte ordering -.TP -\fB\eU\fIstuvwxyz\fR -. +.IP \fB\eU\fIstuvwxyz\fR 5 (where \fIstuvwxyz\fR is one up to eight hexadecimal digits) reserved for a Unicode extension up to 21 bits. The digits are parsed until the -first non-hexadecimal character is encountered, the maximun of eight +first non-hexadecimal character is encountered, the maximum of eight hexadecimal digits are reached, or an overflow would occur in the maximum value of \fBU+\fI10ffff\fR. -.TP -\fB\ev\fR -. +.IP \fB\ev\fR 5 vertical tab, as in C -.TP -\fB\ex\fIhh\fR -. +.IP \fB\ex\fIhh\fR 5 (where \fIhh\fR is one or two hexadecimal digits) the character whose hexadecimal value is \fB0x\fIhh\fR. -.TP -\fB\e0\fR -. +.IP \fB\e0\fR 5 the character whose value is \fB0\fR -.TP -\fB\e\fIxyz\fR -. +.IP \fB\e\fIxyz\fR 5 (where \fIxyz\fR is exactly three octal digits, and is not a \fIback reference\fR (see below)) the character whose octal value is \fB0\fIxyz\fR. The first digit must be in the range 0-3, otherwise the two-digit form is assumed. -.TP -\fB\e\fIxy\fR -. +.IP \fB\e\fIxy\fR 5 (where \fIxy\fR is exactly two octal digits, and is not a \fIback reference\fR (see below)) the character whose octal value is \fB0\fIxy\fR @@ -446,7 +402,8 @@ commonly-used character classes: .TP \fB\ew\fR . -\fB[[:alnum:]_\eu203F\eu2040\eu2054\euFE33\euFE34\euFE4D\euFE4E\euFE4F\euFF3F]\fR (including punctuation connector characters) +\fB[[:alnum:]_\eu203F\eu2040\eu2054\euFE33\euFE34\euFE4D\euFE4E\euFE4F\euFF3F]\fR +(including punctuation connector characters) .TP \fB\eD\fR . @@ -458,7 +415,8 @@ commonly-used character classes: .TP \fB\eW\fR . -\fB[^[:alnum:]_\eu203F\eu2040\eu2054\euFE33\euFE34\euFE4D\euFE4E\euFE4F\euFF3F]\fR (including punctuation connector characters) +\fB[^[:alnum:]_\eu203F\eu2040\eu2054\euFE33\euFE34\euFE4D\euFE4E\euFE4F\euFF3F]\fR +(including punctuation connector characters) .RE .PP Within bracket expressions, @@ -484,41 +442,25 @@ is illegal.) A constraint escape (AREs only) is a constraint, matching the empty string if specific conditions are met, written as an escape: .RS 2 -.TP 6 -\fB\eA\fR -. +.IP \fB\eA\fR 6 matches only at the beginning of the string (see \fBMATCHING\fR, below, for how this differs from .QW \fB^\fR ) -.TP -\fB\em\fR -. +.IP \fB\em\fR 6 matches only at the beginning of a word -.TP -\fB\eM\fR -. +.IP \fB\eM\fR 6 matches only at the end of a word -.TP -\fB\ey\fR -. +.IP \fB\ey\fR 6 matches only at the beginning or end of a word -.TP -\fB\eY\fR -. +.IP \fB\eY\fR 6 matches only at a point that is not the beginning or end of a word -.TP -\fB\eZ\fR -. +.IP \fB\eZ\fR 6 matches only at the end of the string (see \fBMATCHING\fR, below, for how this differs from .QW \fB$\fR ) -.TP -\fB\e\fIm\fR -. +.IP \fB\e\fIm\fR 6 (where \fIm\fR is a nonzero digit) a \fIback reference\fR, see below -.TP -\fB\e\fImnn\fR -. +.IP \fB\e\fImnn\fR 6 (where \fIm\fR is a nonzero digit, and \fInn\fR is some more digits, and the decimal value \fImnn\fR is not greater than the number of closing capturing parentheses seen so far) a \fIback reference\fR, see diff --git a/doc/read.n b/doc/read.n index 7c0c155..a19e2a2 100644 --- a/doc/read.n +++ b/doc/read.n @@ -62,14 +62,14 @@ In blocking mode, the error is directly thrown, even, if there is a leading decodable data portion. The file pointer is advanced just before the encoding error. An eventual well decoded data chunk before the encoding error is returned -in the error option dictionary key \fB-data\fR. +in the error option dictionary key \fB\-data\fR. The value of the key contains the empty string, if the error arises at the first data position. .PP In non blocking mode, first, any data without encoding error is returned (without error state). In the next call, no data is returned and the \fBEILSEQ\fR error state is set. -The key \fB-data\fR is not present. +The key \fB\-data\fR is not present. .PP Here is an example with an encoding error in UTF-8 encoding, which is then introspected by a switch to the binary encoding. The test file contains a not @@ -101,7 +101,7 @@ file35a65a0 % close $f .CE The already decoded data "A" is returned in the error options dictionary key -\fB-data\fR. +\fB\-data\fR. The file position is advanced on the encoding error position 1. The data at the error position is thus recovered by the next \fBread\fR command. .PP @@ -156,7 +156,8 @@ set lines [split $data \en] .SH "SEE ALSO" file(n), eof(n), fblocked(n), fconfigure(n), Tcl_StandardChannels(3) .SH KEYWORDS -blocking, channel, end of line, end of file, nonblocking, read, translation, encoding +blocking, channel, end of line, end of file, nonblocking, read, translation, +encoding '\"Local Variables: '\"mode: nroff '\"End: diff --git a/doc/refchan.n b/doc/refchan.n index 2b79da2..b997ddb 100644 --- a/doc/refchan.n +++ b/doc/refchan.n @@ -244,17 +244,11 @@ the channel. .PP The \fIbase\fR argument is the same as the equivalent argument of the builtin \fBchan seek\fR, namely: -.TP 10 -\fBstart\fR -. +.IP \fBstart\fR 10 Seeking is relative to the beginning of the channel. -.TP 10 -\fBcurrent\fR -. +.IP \fBcurrent\fR 10 Seeking is relative to the current seek position. -.TP 10 -\fBend\fR -. +.IP \fBend\fR 10 Seeking is relative to the end of the channel. .PP The \fIoffset\fR is an integer number specifying the amount of diff --git a/doc/regexp.n b/doc/regexp.n index f39f389..f37ccbe 100644 --- a/doc/regexp.n +++ b/doc/regexp.n @@ -34,6 +34,7 @@ subexpression to the right in \fIexp\fR, and so on. If the initial arguments to \fBregexp\fR start with \fB\-\fR then they are treated as switches. The following switches are currently supported: +.\" OPTION: -about .TP 15 \fB\-about\fR . @@ -42,12 +43,14 @@ containing information about the regular expression. The first element of the list is a subexpression count. The second element is a list of property names that describe various attributes of the regular expression. This switch is primarily intended for debugging purposes. +.\" OPTION: -expanded .TP 15 \fB\-expanded\fR . Enables use of the expanded regular expression syntax where whitespace and comments are ignored. This is the same as specifying the \fB(?x)\fR embedded option (see the \fBre_syntax\fR manual page). +.\" OPTION: -indices .TP 15 \fB\-indices\fR . @@ -57,6 +60,7 @@ each variable will contain a list of two decimal strings giving the indices in \fIstring\fR of the first and last characters in the matching range of characters. +.\" OPTION: -line .TP 15 \fB\-line\fR . @@ -75,6 +79,7 @@ matches an empty string before any newline in addition to its normal function. This flag is equivalent to specifying both \fB\-linestop\fR and \fB\-lineanchor\fR, or the \fB(?n)\fR embedded option (see the \fBre_syntax\fR manual page). +.\" OPTION: -linestop .TP 15 \fB\-linestop\fR . @@ -85,6 +90,7 @@ bracket expressions and so that they stop at newlines. This is the same as specifying the \fB(?p)\fR embedded option (see the \fBre_syntax\fR manual page). +.\" OPTION: -lineanchor .TP 15 \fB\-lineanchor\fR . @@ -98,11 +104,13 @@ so they match the beginning and end of a line respectively. This is the same as specifying the \fB(?w)\fR embedded option (see the \fBre_syntax\fR manual page). +.\" OPTION: -nocase .TP 15 \fB\-nocase\fR . Causes upper-case characters in \fIstring\fR to be treated as lower case during the matching process. +.\" OPTION: -all .TP 15 \fB\-all\fR . @@ -110,6 +118,7 @@ Causes the regular expression to be matched as many times as possible in the string, returning the total number of matches found. If this is specified with match variables, they will contain information for the last match only. +.\" OPTION: -inline .TP 15 \fB\-inline\fR . @@ -129,6 +138,7 @@ regular expression. Examples are: \fI\(-> in n li i ne e\fR .CE .RE +.\" OPTION: -start .TP 15 \fB\-start\fI index\fR . @@ -143,6 +153,7 @@ match the start of the string at \fIindex\fR. If \fB\-indices\fR is specified, the indices will be indexed starting from the absolute beginning of the input string. \fIindex\fR will be constrained to the bounds of the input string. +.\" OPTION: -- .TP 15 \fB\-\|\-\fR . @@ -175,7 +186,7 @@ Find the index of the word \fBbadger\fR (in any case) within a string and store that in the variable \fBlocation\fR: .PP .CS -\fBregexp\fR \-indices {(?i)\embadger\eM} $string location +\fBregexp\fR -indices {(?i)\embadger\eM} $string location .CE .PP This could also be written as a \fIbasic\fR regular expression (as opposed @@ -183,13 +194,13 @@ to using the default syntax of \fIadvanced\fR regular expressions) match by prefixing the expression with a suitable flag: .PP .CS -\fBregexp\fR \-indices {(?ib)\e} $string location +\fBregexp\fR -indices {(?ib)\e} $string location .CE .PP This counts the number of octal digits in a string: .PP .CS -\fBregexp\fR \-all {[0\-7]} $string +\fBregexp\fR -all {[0-7]} $string .CE .PP This lists all words (consisting of all sequences of non-whitespace @@ -197,7 +208,7 @@ characters) in a string, and is useful as a more powerful version of the \fBsplit\fR command: .PP .CS -\fBregexp\fR \-all \-inline {\eS+} $string +\fBregexp\fR -all -inline {\eS+} $string .CE .SH "SEE ALSO" re_syntax(n), regsub(n), string(n) diff --git a/doc/registry.n b/doc/registry.n index 58215ff..4defbad 100644 --- a/doc/registry.n +++ b/doc/registry.n @@ -144,53 +144,35 @@ data, but does not actually change the representation. For some types, the \fBregistry\fR command returns the data in a different form to make it easier to manipulate. The following types are recognized by the registry command: -.TP 17 -\fBbinary\fR -. +.IP \fBbinary\fR The registry value contains arbitrary binary data. The data is represented exactly in Tcl, including any embedded nulls. -.TP -\fBnone\fR -. +.IP \fBnone\fR The registry value contains arbitrary binary data with no defined type. The data is represented exactly in Tcl, including any embedded nulls. -.TP -\fBsz\fR -. +.IP \fBsz\fR The registry value contains a null-terminated string. The data is represented in Tcl as a string. -.TP -\fBexpand_sz\fR -. +.IP \fBexpand_sz\fR The registry value contains a null-terminated string that contains unexpanded references to environment variables in the normal Windows style (for example, .QW %PATH% ). The data is represented in Tcl as a string. -.TP -\fBdword\fR -. +.IP \fBdword\fR The registry value contains a little-endian 32-bit number. The data is represented in Tcl as a decimal string. -.TP -\fBdword_big_endian\fR -. +.IP \fBdword_big_endian\fR The registry value contains a big-endian 32-bit number. The data is represented in Tcl as a decimal string. -.TP -\fBlink\fR -. +.IP \fBlink\fR The registry value contains a symbolic link. The data is represented exactly in Tcl, including any embedded nulls. -.TP -\fBmulti_sz\fR -. +.IP \fBmulti_sz\fR The registry value contains an array of null-terminated strings. The data is represented in Tcl as a list of strings. -.TP -\fBresource_list\fR -. +.IP \fBresource_list\fR The registry value contains a device-driver resource list. The data is represented exactly in Tcl, including any embedded nulls. .PP diff --git a/doc/regsub.n b/doc/regsub.n index 439ad49..f7931af 100644 --- a/doc/regsub.n +++ b/doc/regsub.n @@ -54,6 +54,7 @@ backslashes. If the initial arguments to \fBregsub\fR start with \fB\-\fR then they are treated as switches. The following switches are currently supported: +.\" OPTION: -all .TP \fB\-all\fR . @@ -67,6 +68,7 @@ and .QW \e\fIn\fR sequences are handled for each substitution using the information from the corresponding match. +.\" OPTION: -command .TP \fB\-command\fR .VS 8.7 @@ -80,7 +82,7 @@ command prefix, that is, a non-empty list. The substring of \fIstring\fR that matches \fIexp\fR, and then each substring that matches each capturing sub-RE within \fIexp\fR are appended as additional elements to that list. (The items appended to the list are much like what -\fBregexp\fR \fB-inline\fR would return). The completed list is then +\fBregexp\fR \fB\-inline\fR would return). The completed list is then evaluated as a Tcl command, and the result of that command is the substitution string. Any error or exception from command evaluation becomes an error or exception from the \fBregsub\fR command. @@ -94,12 +96,14 @@ The exact location indices that matched are not made available to the script. See \fBEXAMPLES\fR below for illustrative cases. .RE .VE 8.7 +.\" OPTION: -expanded .TP \fB\-expanded\fR . Enables use of the expanded regular expression syntax where whitespace and comments are ignored. This is the same as specifying the \fB(?x)\fR embedded option (see the \fBre_syntax\fR manual page). +.\" OPTION: -line .TP \fB\-line\fR . @@ -117,6 +121,7 @@ matches an empty string before any newline in addition to its normal function. This flag is equivalent to specifying both \fB\-linestop\fR and \fB\-lineanchor\fR, or the \fB(?n)\fR embedded option (see the \fBre_syntax\fR manual page). +.\" OPTION: -linestop .TP \fB\-linestop\fR . @@ -127,6 +132,7 @@ bracket expressions and so that they stop at newlines. This is the same as specifying the \fB(?p)\fR embedded option (see the \fBre_syntax\fR manual page). +.\" OPTION: -lineanchor .TP \fB\-lineanchor\fR . @@ -140,12 +146,14 @@ so they match the beginning and end of a line respectively. This is the same as specifying the \fB(?w)\fR embedded option (see the \fBre_syntax\fR manual page). +.\" OPTION: -nocase .TP \fB\-nocase\fR . Upper-case characters in \fIstring\fR will be converted to lower-case before matching against \fIexp\fR; however, substitutions specified by \fIsubSpec\fR use the original unconverted form of \fIstring\fR. +.\" OPTION: -start .TP \fB\-start\fI index\fR . @@ -158,6 +166,7 @@ When using this switch, will not match the beginning of the line, and \eA will still match the start of the string at \fIindex\fR. \fIindex\fR will be constrained to the bounds of the input string. +.\" OPTION: -- .TP \fB\-\|\-\fR . @@ -256,6 +265,15 @@ set decoded [\fBregsub\fR -all -command $RE $string {apply {{- p h} { format %c $charNumber }}}] .CE +.PP +The \fB\-command\fR option can also be useful for restricting the range of +commands such as \fBstring totitle\fR: +.PP +.CE +set message "the quIck broWn fOX JUmped oVer the laZy dogS..." +puts [\fBregsub\fR -all -command {\ew+} $message {string totitle}] +# \(-> \fIThe Quick Brown Fox Jumped Over The Lazy Dogs..\fR +.CE .VE 8.7 .SH "SEE ALSO" regexp(n), re_syntax(n), subst(n), string(n) diff --git a/doc/return.n b/doc/return.n index a7eb197..9bf1ae2 100644 --- a/doc/return.n +++ b/doc/return.n @@ -105,6 +105,7 @@ script. As documented above, the \fB\-code\fR entry in the return options dictionary receives special treatment by Tcl. There are other return options also recognized and treated specially by Tcl. They are: +.\" OPTION: -errorcode .TP \fB\-errorcode \fIlist\fR . @@ -117,6 +118,7 @@ the \fB\-code error\fR option is provided, Tcl will set the value of the \fB\-errorcode\fR entry in the return options dictionary to the default value of \fBNONE\fR. The \fB\-errorcode\fR return option will also be stored in the global variable \fBerrorCode\fR. +.\" OPTION: -errorinfo .TP \fB\-errorinfo \fIinfo\fR . @@ -135,11 +137,14 @@ the procedure. Typically the \fIinfo\fR value is supplied from the value of \fB\-errorinfo\fR in a return options dictionary captured by the \fBcatch\fR command (or from the copy of that information stored in the global variable \fBerrorInfo\fR). +.\" OPTION: -errorstack .TP \fB\-errorstack \fIlist\fR +. The \fB\-errorstack\fR option receives special treatment only when the value of the \fB\-code\fR option is \fBTCL_ERROR\fR. Then \fIlist\fR is the initial -error stack, recording actual argument values passed to each proc level. The error stack will +error stack, recording actual argument values passed to each proc level. +The error stack will also be reachable through \fBinfo errorstack\fR. If no \fB\-errorstack\fR option is provided to \fBreturn\fR when the \fB\-code error\fR option is provided, Tcl will provide its own @@ -151,6 +156,7 @@ the procedure. Typically the \fIlist\fR value is supplied from the value of \fB\-errorstack\fR in a return options dictionary captured by the \fBcatch\fR command (or from the copy of that information from \fBinfo errorstack\fR). +.\" OPTION: -level .TP \fB\-level \fIlevel\fR . @@ -163,6 +169,7 @@ be \fIcode\fR. If no \fB\-level\fR option is provided, the default value of \fIlevel\fR is 1, so that \fBreturn\fR sets the return code that the current procedure returns to its caller, 1 level up the call stack. The mechanism by which these options work is described in more detail below. +.\" OPTION: -options .TP \fB\-options \fIoptions\fR . diff --git a/doc/safe.n b/doc/safe.n index 44375e5..982ff37 100644 --- a/doc/safe.n +++ b/doc/safe.n @@ -114,16 +114,17 @@ Example of use: set i1 [safe::interpCreate {*}[safe::interpConfigure $i0]] # Get the current deleteHook -set dh [safe::interpConfigure $i0 \-del] +set dh [safe::interpConfigure $i0 -del] # Change (only) the statics loading ok attribute of an # interp and its deleteHook (leaving the rest unchanged): -safe::interpConfigure $i0 \-delete {foo bar} \-statics 0 +safe::interpConfigure $i0 -delete {foo bar} -statics 0 .CE .RE .\" COMMAND: interpDelete .TP \fB::safe::interpDelete\fI child\fR +. Deletes the safe interpreter and cleans up the corresponding parent interpreter data structures. If a \fIdeleteHook\fR script was specified for this interpreter it is @@ -216,6 +217,7 @@ and \fB::safe::interpConfigure\fR. Any option name can be abbreviated to its minimal non-ambiguous name. Option names are not case sensitive. +.\" OPTION: -accessPath .TP \fB\-accessPath\fI directoryList\fR . @@ -226,6 +228,7 @@ empty list, the safe interpreter will use the same directories as its parent for auto-loading. See the section \fBSECURITY\fR below for more detail about virtual paths, tokens and access control. +.\" OPTION: -autoPath .TP \fB\-autoPath\fI directoryList\fR . @@ -234,6 +237,7 @@ This option sets the list of directories in the safe interpreter's - in that case the safe interpreter's ::auto_path is managed by the Safe Base and is a tokenized form of its access path. See the section \fBSYNC MODE\fR below for details. +.\" OPTION: -statics .TP \fB\-statics\fI boolean\fR . @@ -241,12 +245,14 @@ This option specifies if the safe interpreter will be allowed to load statically linked packages (like \fBload {} Tk\fR). The default value is \fBtrue\fR : safe interpreters are allowed to load statically linked packages. +.\" OPTION: -noStatics .TP \fB\-noStatics\fR . This option is a convenience shortcut for \fB\-statics false\fR and thus specifies that the safe interpreter will not be allowed to load statically linked packages. +.\" OPTION: -nested .TP \fB\-nested\fI boolean\fR . @@ -255,12 +261,14 @@ to load packages into its own sub-interpreters. The default value is \fBfalse\fR : safe interpreters are not allowed to load packages into their own sub-interpreters. +.\" OPTION: -nestedLoadOk .TP \fB\-nestedLoadOk\fR . This option is a convenience shortcut for \fB\-nested true\fR and thus specifies the safe interpreter will be allowed to load packages into its own sub-interpreters. +.\" OPTION: -deleteHook .TP \fB\-deleteHook\fI script\fR . @@ -295,7 +303,7 @@ the safe interpreter for it to be found successfully. Additionally, the shared object file must contain a safe entry point; see the manual page for the \fBload\fR command for more details. .TP -\fBfile\fR ?\fIsubCmd args...\fR? +\fBfile\fR ?\fIsubcommand args...\fR? . The \fBfile\fR alias provides access to a safe subset of the subcommands of the \fBfile\fR command; it allows only \fBdirname\fR, \fBjoin\fR, @@ -303,7 +311,7 @@ the \fBfile\fR command; it allows only \fBdirname\fR, \fBjoin\fR, subcommands. For more details on what these subcommands do see the manual page for the \fBfile\fR command. .TP -\fBencoding\fR ?\fIsubCmd args...\fR? +\fBencoding\fR ?\fIsubcommand args...\fR? . The \fBencoding\fR alias provides access to a safe subset of the subcommands of the \fBencoding\fR command; it disallows setting of @@ -462,9 +470,9 @@ parent interpreter to packages, modules, and autoloader files. With parent's ::auto_path, and will set the child's ::auto_path to a tokenized form of the parent's ::auto_path. .PP -With "Sync Mode" off, if a value is specified for \fB\-autoPath\fR, even the empty -list, in a call to \fB::safe::interpCreate\fR, \fB::safe::interpInit\fR, or -\fB::safe::interpConfigure\fR, it will be tokenized and used as the safe +With "Sync Mode" off, if a value is specified for \fB\-autoPath\fR, even the +empty list, in a call to \fB::safe::interpCreate\fR, \fB::safe::interpInit\fR, +or \fB::safe::interpConfigure\fR, it will be tokenized and used as the safe interpreter's ::auto_path. Any directories that do not also belong to the access path cannot be tokenized and will be silently ignored. However, the value of \fB\-autoPath\fR will remain as specified, and will be used to @@ -473,15 +481,15 @@ to change the value of \fB\-accessPath\fR. .PP With "Sync Mode" off, if the access path is reset to the values in the parent interpreter by calling \fB::safe::interpConfigure\fR with arguments -\fB\-accessPath\fR {}, then the ::auto_path will also be reset unless the argument -\fB\-autoPath\fR is supplied to specify a different value. +\fB\-accessPath\fR {}, then the ::auto_path will also be reset unless the +argument \fB\-autoPath\fR is supplied to specify a different value. .PP With "Sync Mode" off, if a non-empty value of \fB\-accessPath\fR is supplied, the safe interpreter's ::auto_path will be set to {} (by \fB::safe::interpCreate\fR, \fB::safe::interpInit\fR) or left unchanged (by \fB::safe::interpConfigure\fR). If the same command specifies a new -value for \fB\-autoPath\fR, it will be applied after the \fB\-accessPath\fR argument has -been processed. +value for \fB\-autoPath\fR, it will be applied after the \fB\-accessPath\fR +argument has been processed. .PP Examples of use with "Sync Mode" off: any of these commands will set the ::auto_path to a tokenized form of its value in the parent interpreter: @@ -551,7 +559,7 @@ safe::interpConfigure foo -autoPath $childAutoPath interp(n), library(n), load(n), package(n), pkg_mkIndex(n), source(n), tm(n), unknown(n) .SH KEYWORDS -alias, auto\-loading, auto_mkindex, load, parent interpreter, safe +alias, auto-loading, auto_mkindex, load, parent interpreter, safe interpreter, child interpreter, source '\" Local Variables: '\" mode: nroff diff --git a/doc/scan.n b/doc/scan.n index e87bef1..0f9ed06 100644 --- a/doc/scan.n +++ b/doc/scan.n @@ -86,33 +86,23 @@ the integer range to be stored is unlimited. .SS "MANDATORY CONVERSION CHARACTER" .PP The following conversion characters are supported: -.TP -\fBd\fR -. +.IP \fBd\fR The input substring must be a decimal integer. It is read in and the integer value is stored in the variable, truncated as required by the size modifier value. -.TP -\fBo\fR -. +.IP \fBo\fR The input substring must be an octal integer. It is read in and the integer value is stored in the variable, truncated as required by the size modifier value. -.TP -\fBx\fR or \fBX\fR -. +.IP "\fBx\fR or \fBX\fR" The input substring must be a hexadecimal integer. It is read in and the integer value is stored in the variable, truncated as required by the size modifier value. -.TP -\fBb\fR -. +.IP \fBb\fR The input substring must be a binary integer. It is read in and the integer value is stored in the variable, truncated as required by the size modifier value. -.TP -\fBu\fR -. +.IP \fBu\fR The input substring must be a decimal integer. The integer value is truncated as required by the size modifier value, and the corresponding unsigned value for that truncated @@ -120,35 +110,28 @@ range is computed and stored in the variable as a decimal string. The conversion makes no sense without reference to a truncation range, so the size modifier \fBll\fR is not permitted in combination with conversion character \fBu\fR. -.TP -\fBi\fR -. -The input substring must be an integer. The base (i.e. decimal, octal, or hexadecimal) is determined by the C convention (leading 0 for octal; prefix 0x for hexadecimal). The integer value is stored in the variable, -truncated as required by the size modifier value. -.TP -\fBc\fR -. +.IP \fBi\fR +The input substring must be an integer. The base (i.e. decimal, +octal, or hexadecimal) is determined by the C convention (leading +0 for octal; prefix 0x for hexadecimal). The integer value is +stored in the variable, truncated as required by the size modifier +value. +.IP \fBc\fR A single character is read in and its Unicode value is stored in the variable as an integer value. Initial white space is not skipped in this case, so the input substring may be a white-space character. -.TP -\fBs\fR -. +.IP \fBs\fR The input substring consists of all the characters up to the next white-space character; the characters are copied to the variable. -.TP -\fBe\fR or \fBf\fR or \fBg\fR or \fBE\fR or \fBG\fR -. +.IP "\fBe\fR or \fBf\fR or \fBg\fR or \fBE\fR or \fBG\fR" The input substring must be a floating-point number consisting of an optional sign, a string of decimal digits possibly containing a decimal point, and an optional exponent consisting of an \fBe\fR or \fBE\fR followed by an optional sign and a string of decimal digits. It is read in and stored in the variable as a floating-point value. -.TP -\fB[\fIchars\fB]\fR -. +.IP \fB[\fIchars\fB]\fR The input substring consists of one or more characters in \fIchars\fR. The matching string is stored in the variable. If the first character between the brackets is a \fB]\fR then @@ -159,9 +142,7 @@ contains a sequence of the form \fIa\fB\-\fIb\fR then any character between \fIa\fR and \fIb\fR (inclusive) will match. If the first or last character between the brackets is a \fB\-\fR, then it is treated as part of \fIchars\fR rather than indicating a range. -.TP -\fB[^\fIchars\fB]\fR -. +.IP \fB[^\fIchars\fB]\fR The input substring consists of one or more characters not in \fIchars\fR. The matching string is stored in the variable. If the character immediately following the \fB^\fR is a \fB]\fR then it is @@ -173,9 +154,7 @@ character between \fIa\fR and \fIb\fR (inclusive) will be excluded from the set. If the first or last character between the brackets is a \fB\-\fR, then it is treated as part of \fIchars\fR rather than indicating a range value. -.TP -\fBn\fR -. +.IP \fBn\fR No input is consumed from the input string. Instead, the total number of characters scanned from the input string so far is stored in the variable. .PP diff --git a/doc/seek.n b/doc/seek.n index 3b206d1..68d40f7 100644 --- a/doc/seek.n +++ b/doc/seek.n @@ -27,20 +27,14 @@ The \fIoffset\fR and \fIorigin\fR arguments specify the position at which the next read or write will occur for \fIchannelId\fR. \fIOffset\fR must be an integer (which may be negative) and \fIorigin\fR must be one of the following: -.TP 10 -\fBstart\fR -. +.IP \fBstart\fR 10 The new access position will be \fIoffset\fR bytes from the start of the underlying file or device. -.TP 10 -\fBcurrent\fR -. +.IP \fBcurrent\fR 10 The new access position will be \fIoffset\fR bytes from the current access position; a negative \fIoffset\fR moves the access position backwards in the underlying file or device. -.TP 10 -\fBend\fR -. +.IP \fBend\fR 10 The new access position will be \fIoffset\fR bytes from the end of the file or device. A negative \fIoffset\fR places the access position before the end of file, and a positive \fIoffset\fR places the access diff --git a/doc/set.n b/doc/set.n index 890ef1d..ed1fc41 100644 --- a/doc/set.n +++ b/doc/set.n @@ -70,7 +70,8 @@ practice instead of doing double-dereferencing): \fBset\fR out [\fBset\fR $vbl] .CE .SH "SEE ALSO" -expr(n), global(n), namespace(n), proc(n), trace(n), unset(n), upvar(n), variable(n) +expr(n), global(n), namespace(n), proc(n), trace(n), unset(n), upvar(n), +variable(n) .SH KEYWORDS read, write, variable '\" Local Variables: diff --git a/doc/singleton.n b/doc/singleton.n index 3ccbdd3..ce35593 100644 --- a/doc/singleton.n +++ b/doc/singleton.n @@ -47,6 +47,7 @@ The \fBoo::singleton\fR class does not define an explicit destructor; destroying an instance of it is just like destroying an ordinary class (and will destroy the singleton object). .SS "EXPORTED METHODS" +.\" METHOD: new .TP \fIcls \fBnew \fR?\fIarg ...\fR? . @@ -63,7 +64,8 @@ identical call signature to the superclass's implementation. .SS "NON-EXPORTED METHODS" The \fBoo::singleton\fR class explicitly states that \fBcreate\fR and \fBcreateWithNamespace\fR are unexported; callers should not assume that they -have control over either the name or the namespace name of the singleton instance. +have control over either the name or the namespace name of the singleton +instance. .SH EXAMPLE .PP This example demonstrates that there is only one instance even though the diff --git a/doc/socket.n b/doc/socket.n index 8cc5029..06d3b5b 100644 --- a/doc/socket.n +++ b/doc/socket.n @@ -49,6 +49,7 @@ Use \fIlocalhost\fR to refer to the host on which the command is invoked. .PP The following options may also be present before \fIhost\fR to specify additional information about the connection: +.\" OPTION: -myaddr .TP \fB\-myaddr\fI addr\fR . @@ -57,6 +58,7 @@ the client-side network interface to use for the connection. This option may be useful if the client machine has multiple network interfaces. If the option is omitted then the client-side interface will be chosen by the system software. +.\" OPTION: -myport .TP \fB\-myport\fI port\fR . @@ -65,6 +67,7 @@ supported and understood by the host operating system) to use for the client's side of the connection. If this option is omitted, the client's port number will be chosen at random by the system software. +.\" OPTION: -async .TP \fB\-async\fR . @@ -98,9 +101,12 @@ asynchronous connection has succeeded or failed. See the \fBvwait\fR and the \fBchan\fR commands for more details on the event loop and channel events. .PP -The \fBchan configure\fR option \fB-connecting\fR may be used to check if the connect is still running. To verify a successful connect, the option \fB-error\fR may be checked when \fB-connecting\fR returned 0. +The \fBchan configure\fR option \fB\-connecting\fR may be used to check +if the connect is still running. To verify a successful connect, the +option \fB\-error\fR may be checked when \fB\-connecting\fR returned 0. .PP -Operation without the event queue requires at the moment calls to \fBchan configure\fR to advance the internal state machine. +Operation without the event queue requires at the moment calls to +\fBchan configure\fR to advance the internal state machine. .RE .SH "SERVER SOCKETS" .PP @@ -120,6 +126,7 @@ network address notation, of the client's host, and the client's port number. .PP The following additional option may also be specified before \fIport\fR: +.\" OPTION: -myaddr .TP \fB\-myaddr\fI addr\fR . @@ -131,11 +138,13 @@ wildcard address so that it can accept connections from any interface. If \fIaddr\fR is a domain name that resolves to multiple IP addresses that are available on the local machine, the socket will listen on all of them. +.\" OPTION: -reuseaddr .TP \fB\-reuseaddr\fI boolean\fR . Tells the kernel whether to reuse the local address if there is no socket actively listening on it. This is the default on Windows. +.\" OPTION: -reuseport .TP \fB\-reuseport\fI boolean\fR . @@ -164,6 +173,7 @@ described below. The \fBchan configure\fR command can be used to query several readonly configuration options for socket channels or in some cases to set alternative properties on socket channels: +.\" OPTION: -error .TP \fB\-error\fR . @@ -176,6 +186,7 @@ returned. If there was no error, an empty string is returned. Note that the error status is reset by the read operation; this mimics the underlying getsockopt(SO_ERROR) call. .RE +.\" OPTION: -sockname .TP \fB\-sockname\fR . @@ -193,6 +204,7 @@ was created without \fB\-myaddr\fR or with the argument to \fB\-myaddr\fR being a domain name that resolves multiple IP addresses that are local to the invoking host. .RE +.\" OPTION: -peername .TP \fB\-peername\fR . @@ -201,15 +213,19 @@ sockets, this option returns a list of three elements; these are the address, the host name and the port to which the peer socket is connected or bound. If the host name cannot be computed, the second element of the list is identical to the address, its first element. +.\" OPTION: -connecting .TP \fB\-connecting\fR . -This option is not supported by server sockets. For client sockets, this option returns 1 if an asyncroneous connect is still in progress, 0 otherwise. +This option is not supported by server sockets. For client sockets, this +option returns 1 if an asynchronous connect is still in progress, 0 otherwise. +.\" OPTION: -keepalive .TP \fB\-keepalive\fR . This option sets or queries the TCP keepalive option on the socket as 1 if keepalive is turned on, 0 otherwise. +.\" OPTION: -nodelay .TP \fB\-nodelay\fR . @@ -250,7 +266,8 @@ Support for IPv6 was added in Tcl 8.6. .SH "SEE ALSO" chan(n), flush(n), open(n), read(n) .SH KEYWORDS -asynchronous I/O, bind, channel, connection, domain name, host, network address, socket, tcp +asynchronous I/O, bind, channel, connection, domain name, host, +network address, socket, tcp '\" Local Variables: '\" mode: nroff '\" End: diff --git a/doc/source.n b/doc/source.n index cee1312..d4d8332 100644 --- a/doc/source.n +++ b/doc/source.n @@ -41,7 +41,8 @@ in code for string comparison, you can use which will be safely substituted by the Tcl interpreter into .QW ^Z . .PP -A leading BOM (Byte order mark) contained in the file is ignored for unicode encodings (utf-8, utf-16, ucs-2). +A leading BOM (Byte order mark) contained in the file is ignored for +unicode encodings (utf-8, utf-16, ucs-2). .PP The \fB\-encoding\fR option is used to specify the encoding of the data stored in \fIfileName\fR. When the \fB\-encoding\fR option diff --git a/doc/string.n b/doc/string.n index 6e87deb..3b9af03 100644 --- a/doc/string.n +++ b/doc/string.n @@ -183,10 +183,11 @@ 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. -. -Warning: this option is under discussion and may be renamed or replaced -by another solution withhin the TCL 9.0 series. -. +.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 @@ -489,14 +490,14 @@ set length [\fBstring length\fR $string] if {$length == 0} { set isPrefix 0 } else { - set isPrefix [\fBstring equal\fR \-length $length $string "foobar"] + set isPrefix [\fBstring equal\fR -length $length $string "foobar"] } .CE .SH "SEE ALSO" expr(n), list(n) .SH KEYWORDS -case conversion, compare, index, integer value, match, pattern, string, word, equal, -ctype, character, reverse +case conversion, compare, index, integer value, match, pattern, string, +word, equal, ctype, character, reverse .\" Local Variables: .\" mode: nroff .\" End: diff --git a/doc/subst.n b/doc/subst.n index 4518140..4c9a519 100644 --- a/doc/subst.n +++ b/doc/subst.n @@ -158,7 +158,8 @@ not .SH "SEE ALSO" Tcl(n), eval(n), break(n), continue(n) .SH KEYWORDS -backslash substitution, command substitution, quoting, substitution, variable substitution +backslash substitution, command substitution, quoting, substitution, +variable substitution .\" Local Variables: .\" mode: nroff .\" End: diff --git a/doc/switch.n b/doc/switch.n index d35c650..61449a9 100644 --- a/doc/switch.n +++ b/doc/switch.n @@ -35,26 +35,31 @@ unless there are exactly two arguments to \fBswitch\fR (in which case the first must the \fIstring\fR and the second must be the \fIpattern\fR/\fIbody\fR list). The following options are currently supported: +.\" OPTION: -exact .TP 10 \fB\-exact\fR . Use exact matching when comparing \fIstring\fR to a pattern. This is the default. +.\" OPTION: -glob .TP 10 \fB\-glob\fR . When matching \fIstring\fR to the patterns, use glob-style matching (i.e. the same as implemented by the \fBstring match\fR command). +.\" OPTION: -regexp .TP 10 \fB\-regexp\fR . When matching \fIstring\fR to the patterns, use regular expression matching (as described in the \fBre_syntax\fR reference page). +.\" OPTION: -nocase .TP 10 \fB\-nocase\fR . Causes comparisons to be handled in a case-insensitive manner. +.\" OPTION: -matchvar .TP 10 \fB\-matchvar\fI varName\fR . @@ -68,6 +73,7 @@ capturing parenthesis in the regular expression that matched, and so on. When a \fBdefault\fR branch is taken, the variable will have the empty list written to it. This option may be specified at the same time as the \fB\-indexvar\fR option. +.\" OPTION: -indexvar .TP 10 \fB\-indexvar\fI varName\fR . @@ -85,6 +91,7 @@ capturing parenthesis in the regular expression that matched, and so on. When a \fBdefault\fR branch is taken, the variable will have the empty list written to it. This option may be specified at the same time as the \fB\-matchvar\fR option. +.\" OPTION: -- .TP 10 \fB\-\|\-\fR . @@ -128,7 +135,7 @@ literals, as shown here (the result is \fI2\fR): .PP .CS set foo "abc" -\fBswitch\fR abc a \- b {expr {1}} $foo {expr {2}} default {expr {3}} +\fBswitch\fR abc a - b {expr {1}} $foo {expr {2}} default {expr {3}} .CE .PP Using glob matching and the fall-through body is an alternative to @@ -136,8 +143,8 @@ writing regular expressions with alternations, as can be seen here (this returns \fI1\fR): .PP .CS -\fBswitch\fR \-glob aaab { - a*b \- +\fBswitch\fR -glob aaab { + a*b - b {expr {1}} a* {expr {2}} default {expr {3}} @@ -149,7 +156,7 @@ last) is taken. This example has a result of \fI3\fR: .PP .CS \fBswitch\fR xyz { - a \- + a - b { # Correct Comment Placement expr {1} @@ -167,7 +174,7 @@ When matching against regular expressions, information about what exactly matched is easily obtained using the \fB\-matchvar\fR option: .PP .CS -\fBswitch\fR \-regexp \-matchvar foo \-\- $bar { +\fBswitch\fR -regexp -matchvar foo -- $bar { a(b*)c { puts "Found [string length [lindex $foo 1]] 'b's" } diff --git a/doc/tclsh.1 b/doc/tclsh.1 index 28ad14c..91df79d 100644 --- a/doc/tclsh.1 +++ b/doc/tclsh.1 @@ -112,21 +112,25 @@ the binary. \fBTclsh\fR sets the following global Tcl variables in addition to those created by the Tcl library itself (such as \fBenv\fR, which maps environment variables such as \fBPATH\fR into Tcl): +.\" VARIABLE: argc .TP 15 \fBargc\fR . Contains a count of the number of \fIarg\fR arguments (0 if none), not including the name of the script file. +.\" VARIABLE: argv .TP 15 \fBargv\fR . Contains a Tcl list whose elements are the \fIarg\fR arguments, in order, or an empty string if there are no \fIarg\fR arguments. +.\" VARIABLE: argv0 .TP 15 \fBargv0\fR . Contains \fIfileName\fR if it was specified. Otherwise, contains the name by which \fBtclsh\fR was invoked. +.\" VARIABLE: tcl_interactive .TP 15 \fBtcl_interactive\fR . @@ -134,6 +138,8 @@ Contains 1 if \fBtclsh\fR is running interactively (no \fIfileName\fR was specified and standard input is a terminal-like device), 0 otherwise. .SH PROMPTS +.\" VARIABLE: tcl_prompt1 +.\" VARIABLE: tcl_prompt2 .PP When \fBtclsh\fR is invoked interactively it normally prompts for each command with diff --git a/doc/tcltest.n b/doc/tcltest.n index c29b05e..f78f7a2 100644 --- a/doc/tcltest.n +++ b/doc/tcltest.n @@ -525,6 +525,7 @@ description for regression tests. If the test case exists to reproduce a bug, include the bug ID in the description. .PP Valid attributes and associated values are: +.\" OPTION: -constraints .TP \fB\-constraints \fIkeywordList\fR|\fIexpression\fR . @@ -535,9 +536,12 @@ defined by a call to \fBtestConstraint\fR. If any of the listed constraints is false or does not exist, the test is skipped. If the \fB\-constraints\fR value is an expression, that expression is evaluated. If the expression evaluates to true, then the test is run. +.RS +.PP Note that the expression form of \fB\-constraints\fR may interfere with the operation of \fBconfigure \-constraints\fR and \fBconfigure \-limitconstraints\fR, and is not recommended. +.PP Appropriate constraints should be added to any tests that should not always be run. That is, conditional evaluation of a test should be accomplished by the \fB\-constraints\fR option, not by @@ -547,6 +551,8 @@ the number skipped may change based on the testing environment. The default value is an empty list. See \fBTEST CONSTRAINTS\fR below for a list of built-in constraints and information on how to add your own constraints. +.RE +.\" OPTION: -setup .TP \fB\-setup \fIscript\fR . @@ -554,6 +560,7 @@ The optional \fB\-setup\fR attribute indicates a \fIscript\fR that will be run before the script indicated by the \fB\-body\fR attribute. If evaluation of \fIscript\fR raises an error, the test will fail. The default value is an empty script. +.\" OPTION: -body .TP \fB\-body \fIscript\fR . @@ -563,6 +570,7 @@ If evaluation of \fIscript\fR raises an error, the test will fail (unless the \fB\-returnCodes\fR option is used to state that an error is expected). The default value is an empty script. +.\" OPTION: -cleanup .TP \fB\-cleanup \fIscript\fR . @@ -570,6 +578,7 @@ The optional \fB\-cleanup\fR attribute indicates a \fIscript\fR that will be run after the script indicated by the \fB\-body\fR attribute. If evaluation of \fIscript\fR raises an error, the test will fail. The default value is an empty script. +.\" OPTION: -match .TP \fB\-match \fImode\fR . @@ -578,12 +587,14 @@ The \fB\-match\fR attribute determines how expected answers supplied by values for \fImode\fR are \fBregexp\fR, \fBglob\fR, \fBexact\fR, and any value registered by a prior call to \fBcustomMatch\fR. The default value is \fBexact\fR. +.\" OPTION: -result .TP \fB\-result \fIexpectedValue\fR . The \fB\-result\fR attribute supplies the \fIexpectedValue\fR against which the return value from script will be compared. The default value is an empty string. +.\" OPTION: -output .TP \fB\-output \fIexpectedValue\fR . @@ -593,6 +604,7 @@ of the script(s) will be compared. Note that only output printed using the global \fBputs\fR command is used for comparison. If \fB\-output\fR is not specified, output sent to \fBstdout\fR and \fBoutputChannel\fR is not processed for comparison. +.\" OPTION: -errorOutput .TP \fB\-errorOutput \fIexpectedValue\fR . @@ -602,6 +614,7 @@ evaluation of the script(s) will be compared. Note that only output printed using the global \fBputs\fR command is used for comparison. If \fB\-errorOutput\fR is not specified, output sent to \fBstderr\fR and \fBerrorChannel\fR is not processed for comparison. +.\" OPTION: -returnCodes .TP \fB\-returnCodes \fIexpectedCodeList\fR . @@ -613,6 +626,7 @@ return codes known to \fBreturn\fR, in both numeric and symbolic form, including extended return codes, are acceptable elements in the \fIexpectedCodeList\fR. Default value is .QW "\fBok return\fR" . +.\" OPTION: -errorCode .TP \fB\-errorCode \fIexpectedErrorCode\fR . @@ -669,134 +683,82 @@ options. .PP The following is a list of constraints predefined by the \fBtcltest\fR package itself: -.TP -\fIsingleTestInterp\fR -. +.IP \fIsingleTestInterp\fR This test can only be run if all test files are sourced into a single interpreter. -.TP -\fIunix\fR -. +.IP \fIunix\fR This test can only be run on any Unix platform. -.TP -\fIwin\fR -. +.IP \fIwin\fR This test can only be run on any Windows platform. -.TP -\fInt\fR -. +.IP \fInt\fR This test can only be run on any Windows NT platform. -.TP -\fImac\fR -. +.IP \fImac\fR This test can only be run on any Mac platform. -.TP -\fIunixOrWin\fR -. +.IP \fIunixOrWin\fR This test can only be run on a Unix or Windows platform. -.TP -\fImacOrWin\fR -. +.IP \fImacOrWin\fR This test can only be run on a Mac or Windows platform. -.TP -\fImacOrUnix\fR -. +.IP \fImacOrUnix\fR This test can only be run on a Mac or Unix platform. -.TP -\fItempNotWin\fR -. +.IP \fItempNotWin\fR This test can not be run on Windows. This flag is used to temporarily disable a test. -.TP -\fItempNotMac\fR -. +.IP \fItempNotMac\fR This test can not be run on a Mac. This flag is used to temporarily disable a test. -.TP -\fIunixCrash\fR -. +.IP \fIunixCrash\fR This test crashes if it is run on Unix. This flag is used to temporarily disable a test. -.TP -\fIwinCrash\fR -. +.IP \fIwinCrash\fR This test crashes if it is run on Windows. This flag is used to temporarily disable a test. -.TP -\fImacCrash\fR -. +.IP \fImacCrash\fR This test crashes if it is run on a Mac. This flag is used to temporarily disable a test. -.TP -\fIemptyTest\fR -. +.IP \fIemptyTest\fR This test is empty, and so not worth running, but it remains as a place-holder for a test to be written in the future. This constraint has value false to cause tests to be skipped unless the user specifies otherwise. -.TP -\fIknownBug\fR -. +.IP \fIknownBug\fR This test is known to fail and the bug is not yet fixed. This constraint has value false to cause tests to be skipped unless the user specifies otherwise. -.TP -\fInonPortable\fR -. +.IP \fInonPortable\fR This test can only be run in some known development environment. Some tests are inherently non-portable because they depend on things like word length, file system configuration, window manager, etc. This constraint has value false to cause tests to be skipped unless the user specifies otherwise. -.TP -\fIuserInteraction\fR -. +.IP \fIuserInteraction\fR This test requires interaction from the user. This constraint has value false to causes tests to be skipped unless the user specifies otherwise. -.TP -\fIinteractive\fR -. +.IP \fIinteractive\fR This test can only be run in if the interpreter is in interactive mode -(when the global tcl_interactive variable is set to 1). -.TP -\fInonBlockFiles\fR -. +(when the global \fB::tcl_interactive\fR variable is set to 1). +.IP \fInonBlockFiles\fR This test can only be run if platform supports setting files into nonblocking mode. -.TP -\fIasyncPipeClose\fR -. +.IP \fIasyncPipeClose\fR This test can only be run if platform supports async flush and async close on a pipe. -.TP -\fIunixExecs\fR -. +.IP \fIunixExecs\fR This test can only be run if this machine has Unix-style commands \fBcat\fR, \fBecho\fR, \fBsh\fR, \fBwc\fR, \fBrm\fR, \fBsleep\fR, \fBfgrep\fR, \fBps\fR, \fBchmod\fR, and \fBmkdir\fR available. -.TP -\fIhasIsoLocale\fR -. +.IP \fIhasIsoLocale\fR This test can only be run if can switch to an ISO locale. -.TP -\fIroot\fR -. +.IP \fIroot\fR This test can only run if Unix user is root. -.TP -\fInotRoot\fR -. +.IP \fInotRoot\fR This test can only run if Unix user is not root. -.TP -\fIeformat\fR -. +.IP \fIeformat\fR This test can only run if app has a working version of sprintf with respect to the .QW e format of floating-point numbers. -.TP -\fIstdio\fR -. +.IP \fIstdio\fR This test can only be run if \fBinterpreter\fR can be \fBopen\fRed as a pipe. .PP @@ -881,12 +843,14 @@ command. .SH "CONFIGURABLE OPTIONS" The \fBconfigure\fR command is used to set and query the configurable options of \fBtcltest\fR. The valid options are: +.\" OPTION: -singleproc .TP \fB\-singleproc \fIboolean\fR . Controls whether or not \fBrunAllTests\fR spawns a child process for each test file. No spawning when \fIboolean\fR is true. Default value is false. +.\" OPTION: -debug .TP \fB\-debug \fIlevel\fR . @@ -912,6 +876,7 @@ that exist in the current namespace as they are used. Display information regarding what individual procs in the test harness are doing. .RE +.\" OPTION: -verbose .TP \fB\-verbose \fIlevel\fR . @@ -941,7 +906,7 @@ Print each test's execution time in milliseconds Print each test's execution time in microseconds .PP Note that the \fBmsec\fR and \fBusec\fR verbosity levels are provided as -indicative measures only. They do not tackle the problem of repeatibility which +indicative measures only. They do not tackle the problem of repeatability which should be considered in performance tests or benchmarks. To use these verbosity levels to thoroughly track performance degradations, consider wrapping your test bodies with \fBtime\fR commands. @@ -952,6 +917,7 @@ so that is the same as .QW "\fBconfigure \-verbose {pass start}\fR" . .RE +.\" OPTION: -preservecore .TP \fB\-preservecore \fIlevel\fR . @@ -969,11 +935,13 @@ Also check for core files at the end of each \fBtest\fR command. Check for core files at all times described above, and save a copy of each core file produced in \fBconfigure \-tmpdir\fR. .RE +.\" OPTION: -limitconstraints .TP \fB\-limitconstraints \fIboolean\fR . Sets the mode by which \fBtest\fR honors constraints as described in \fBTESTS\fR above. Default value is false. +.\" OPTION: -constraints .TP \fB\-constraints \fIlist\fR . @@ -981,6 +949,7 @@ Sets all the constraints in \fIlist\fR to true. Also used in combination with \fBconfigure \-limitconstraints true\fR to control an alternative constraint mode as described in \fBTESTS\fR above. Default value is an empty list. +.\" OPTION: -tmpdir .TP \fB\-tmpdir \fIdirectory\fR . @@ -989,17 +958,20 @@ Sets the temporary directory to be used by \fBmakeFile\fR, and \fBremoveDirectory\fR as the default directory where temporary files and directories created by test files should be created. Default value is \fBworkingDirectory\fR. +.\" OPTION: -testdir .TP \fB\-testdir \fIdirectory\fR . Sets the directory searched by \fBrunAllTests\fR for test files and subdirectories. Default value is \fBworkingDirectory\fR. +.\" OPTION: -file .TP \fB\-file \fIpatternList\fR . Sets the list of patterns used by \fBrunAllTests\fR to determine what test files to evaluate. Default value is .QW \fB*.test\fR . +.\" OPTION: -notfile .TP \fB\-notfile \fIpatternList\fR . @@ -1007,6 +979,7 @@ Sets the list of patterns used by \fBrunAllTests\fR to determine what test files to skip. Default value is .QW \fBl.*.test\fR , so that any SCCS lock files are skipped. +.\" OPTION: -relateddir .TP \fB\-relateddir \fIpatternList\fR . @@ -1014,40 +987,47 @@ Sets the list of patterns used by \fBrunAllTests\fR to determine what subdirectories to search for an \fBall.tcl\fR file. Default value is .QW \fB*\fR . +.\" OPTION: -asidefromdir .TP \fB\-asidefromdir \fIpatternList\fR . Sets the list of patterns used by \fBrunAllTests\fR to determine what subdirectories to skip when searching for an \fBall.tcl\fR file. Default value is an empty list. +.\" OPTION: -match .TP \fB\-match \fIpatternList\fR . Set the list of patterns used by \fBtest\fR to determine whether a test should be run. Default value is .QW \fB*\fR . +.\" OPTION: -skip .TP \fB\-skip \fIpatternList\fR . Set the list of patterns used by \fBtest\fR to determine whether a test should be skipped. Default value is an empty list. +.\" OPTION: -load .TP \fB\-load \fIscript\fR . Sets a script to be evaluated by \fBloadTestedCommands\fR. Default value is an empty script. +.\" OPTION: -loadfile .TP \fB\-loadfile \fIfilename\fR . Sets the filename from which to read a script to be evaluated by \fBloadTestedCommands\fR. This is an alternative to \fB\-load\fR. They cannot be used together. +.\" OPTION: -outfile .TP \fB\-outfile \fIfilename\fR . Sets the file to which all output produced by tcltest should be written. A file named \fIfilename\fR will be \fBopen\fRed for writing, and the resulting channel will be set as the value of \fBoutputChannel\fR. +.\" OPTION: -errfile .TP \fB\-errfile \fIfilename\fR . diff --git a/doc/tclvars.n b/doc/tclvars.n index a08f525..04cbc6c 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -297,71 +297,48 @@ retrieve any relevant information. In addition, extensions and applications may add additional values to the array. The predefined elements are: .RS -.TP -\fBbyteOrder\fR -. +.IP \fBbyteOrder\fR The native byte order of this machine: either \fBlittleEndian\fR or \fBbigEndian\fR. -.TP -\fBdebug\fR -. +.IP \fBdebug\fR If this variable exists, then the interpreter was compiled with and linked to a debug-enabled C run-time. This variable will only exist on Windows, so extension writers can specify which package to load depending on the C run-time library that is in use. This is not an indication that this core contains symbols. -.TP -\fBengine\fR -. +.IP \fBengine\fR The name of the Tcl language implementation. When the interpreter is first created, this is always set to the string \fBTcl\fR. -.TP -\fBmachine\fR -. +.IP \fBmachine\fR The instruction set executed by this machine, such as \fBintel\fR, \fBPPC\fR, \fB68k\fR, or \fBsun4m\fR. On UNIX machines, this is the value returned by \fBuname -m\fR. -.TP -\fBos\fR -. +.IP \fBos\fR The name of the operating system running on this machine, such as \fBWindows NT\fR or \fBSunOS\fR. On UNIX machines, this is the value returned by \fBuname -s\fR. -.TP -\fBosVersion\fR -. +.IP \fBosVersion\fR The version number for the operating system running on this machine. On UNIX machines, this is the value returned by \fBuname -r\fR. -.TP -\fBpathSeparator\fR +.IP \fBpathSeparator\fR '\" Defined by TIP #315 The character that should be used to \fBsplit\fR PATH-like environment variables into their corresponding list of directory names. -.TP -\fBplatform\fR -. +.IP \fBplatform\fR Either \fBwindows\fR, or \fBunix\fR. This identifies the general operating environment of the machine. -.TP -\fBpointerSize\fR -. +.IP \fBpointerSize\fR This gives the size of the native-machine pointer in bytes (strictly, it is same as the result of evaluating \fIsizeof(void*)\fR in C.) -.TP -\fBthreaded\fR -. +.IP \fBthreaded\fR If this variable exists, then the interpreter was compiled with threads enabled. -.TP -\fBuser\fR -. +.IP \fBuser\fR This identifies the current user based on the login information available on the platform. This value comes from the getuid() and getpwuid() system calls on Unix, and the value from the GetUserName() system call on Windows. -.TP -\fBwordSize\fR -. +.IP \fBwordSize\fR This gives the size of the native-machine word in bytes (strictly, it is same as the result of evaluating \fIsizeof(long)\fR in C.) .RE @@ -383,6 +360,7 @@ tracking down suspected problems with the Tcl compiler. .RS This variable and functionality only exist if \fBTCL_COMPILE_DEBUG\fR was defined during Tcl's compilation. +.\" tcl::unsupported::disassemble always works, but we don't document it .RE .\" VARIABLE: tcl_traceExec .TP @@ -423,6 +401,7 @@ selecting a word by double-clicking in text in Tk. It is platform dependent. On Windows, it defaults to \fB\eS\fR, meaning anything but a Unicode space character. Otherwise it defaults to \fB\ew\fR, which is any Unicode word character (number, letter, or underscore). +.\" VARIABLE: tcl_nonwordchars .TP \fBtcl_nonwordchars\fR . diff --git a/doc/timerate.n b/doc/timerate.n index f5f960c..0207fd8 100644 --- a/doc/timerate.n +++ b/doc/timerate.n @@ -46,15 +46,18 @@ It will then return a canonical Tcl-list of the form: .PP which indicates: .IP \(bu 3 -the average amount of time required per iteration, in microseconds ([\fBlindex\fR $result 0]) +the average amount of time required per iteration, in microseconds +([\fBlindex\fR $result 0]) .IP \(bu 3 the count how many times it was executed ([\fBlindex\fR $result 2]) .IP \(bu 3 the estimated rate per second ([\fBlindex\fR $result 4]) .IP \(bu 3 -the estimated real execution time without measurement overhead ([\fBlindex\fR $result 6]) +the estimated real execution time without measurement overhead +([\fBlindex\fR $result 6]) .PP The following options may be supplied to the \fBtimerate\fR command: +.\" OPTION: -calibrate .TP \fB\-calibrate\fR . @@ -66,8 +69,10 @@ for future invocations of the \fBtimerate\fR command. If the \fItime\fR parameter is not specified, the calibrate procedure runs for up to 10 seconds. .RS .PP -Note that the calibration process is not thread safe in the current implementation. +Note that the calibration process is not thread safe in the current +implementation. .RE +.\" OPTION: -overhead .TP \fB\-overhead \fIestimate\fR . @@ -77,21 +82,23 @@ measurement overhead of each iteration of the tested script. This quantity will be subtracted from the measured time prior to reporting results. This can be useful for removing the cost of interpreter state reset commands from the script being measured. +.\" OPTION: -direct .TP \fB\-direct\fR . -The \fB-direct\fR option causes direct execution of the supplied script, +The \fB\-direct\fR option causes direct execution of the supplied script, without compilation, in a manner similar to the \fBtime\fR command. It can be used to measure the cost of \fBTcl_EvalObjEx\fR, of the invocation of canonical lists, and of the uncompiled versions of bytecoded commands. .PP -As opposed to the \fBtime\fR commmand, which runs the tested script for a fixed +As opposed to the \fBtime\fR command, which runs the tested script for a fixed number of iterations, the \fBtimerate\fR command runs it for a fixed time. Additionally, the compiled variant of the script will be used during the entire -measurement, as if the script were part of a compiled procedure, if the \fB\-direct\fR -option is not specified. The fixed time period and possibility of compilation allow -for more precise results and prevent very long execution times by slow scripts, making -it practical for measuring scripts with highly uncertain execution times. +measurement, as if the script were part of a compiled procedure, +if the \fB\-direct\fR option is not specified. The fixed time period and +possibility of compilation allow for more precise results and prevent very long +execution times by slow scripts, making it practical for measuring scripts with +highly uncertain execution times. .SH EXAMPLES Estimate how fast it takes for a simple Tcl \fBfor\fR loop (including operations on variable \fIi\fR) to count to ten: @@ -117,9 +124,9 @@ set i 0; \fBtimerate\fR -calibrate {expr {$i<10}; incr i} 1000 } 5000 .CE .PP -Estimate the speed of calculating the hour of the day using \fBclock format\fR only, -ignoring overhead of the portion of the script that prepares the time for it to -calculate: +Estimate the speed of calculating the hour of the day using \fBclock format\fR +only, ignoring overhead of the portion of the script that prepares the time for +it to calculate: .PP .CS \fI# calibrate\fR diff --git a/doc/trace.n b/doc/trace.n index a60b36c..6eba974 100644 --- a/doc/trace.n +++ b/doc/trace.n @@ -90,10 +90,12 @@ an error will be thrown. one or more of the following items: .TP \fBenter\fR +. Invoke \fIcommandPrefix\fR whenever the command \fIname\fR is executed, just before the actual execution takes place. .TP \fBleave\fR +. Invoke \fIcommandPrefix\fR whenever the command \fIname\fR is executed, just after the actual execution takes place. .TP @@ -157,6 +159,7 @@ the result string. \fIOp\fR indicates what operation is being performed on the command execution, and is one of \fBleave\fR or \fBleavestep\fR as defined above. +.PP Note that the creation of many \fBenterstep\fR or \fBleavestep\fR traces can lead to unintuitive results, since the invoked commands from one trace can themselves lead to further @@ -188,6 +191,7 @@ The behavior of execution traces is currently undefined for a command .RE .TP \fBtrace add variable\fI name ops commandPrefix\fR +. Arrange for \fIcommandPrefix\fR to be executed whenever variable \fIname\fR is accessed in one of the ways given by the list \fIops\fR. \fIName\fR may refer to a normal variable, an element of an array, or to an array @@ -203,6 +207,7 @@ queries, but not to \fBinfo exists\fR queries. one or more of the following items: .TP \fBarray\fR +. Invoke \fIcommandPrefix\fR whenever the variable is accessed or modified via the \fBarray\fR command, provided that \fIname\fR is not a scalar variable at the time that the \fBarray\fR command is invoked. If @@ -210,12 +215,15 @@ variable at the time that the \fBarray\fR command is invoked. If command will not trigger the trace. .TP \fBread\fR +. Invoke \fIcommandPrefix\fR whenever the variable is read. .TP \fBwrite\fR +. Invoke \fIcommandPrefix\fR whenever the variable is written. .TP \fBunset\fR +. Invoke \fIcommandPrefix\fR whenever the variable is unset. Variables can be unset explicitly with the \fBunset\fR command, or implicitly when procedures return (all of their local variables @@ -306,10 +314,12 @@ This command returns an empty string. .\" METHOD: remove .TP \fBtrace remove \fItype name opList commandPrefix\fR +. Where \fItype\fR is either \fBcommand\fR, \fBexecution\fR or \fBvariable\fR. .RS .TP \fBtrace remove command\fI name opList commandPrefix\fR +. If there is a trace set on command \fIname\fR with the operations and command given by \fIopList\fR and \fIcommandPrefix\fR, then the trace is removed, so that \fIcommandPrefix\fR will never again be invoked. Returns @@ -317,6 +327,7 @@ an empty string. If \fIname\fR does not exist, the command will throw an error. .TP \fBtrace remove execution\fI name opList commandPrefix\fR +. If there is a trace set on command \fIname\fR with the operations and command given by \fIopList\fR and \fIcommandPrefix\fR, then the trace is removed, so that \fIcommandPrefix\fR will never again be invoked. Returns @@ -324,6 +335,7 @@ an empty string. If \fIname\fR does not exist, the command will throw an error. .TP \fBtrace remove variable\fI name opList commandPrefix\fR +. If there is a trace set on variable \fIname\fR with the operations and command given by \fIopList\fR and \fIcommandPrefix\fR, then the trace is removed, so that \fIcommandPrefix\fR will never again be invoked. Returns @@ -332,10 +344,12 @@ an empty string. .\" METHOD: info .TP \fBtrace info \fItype name\fR +. Where \fItype\fR is either \fBcommand\fR, \fBexecution\fR or \fBvariable\fR. .RS .TP \fBtrace info command\fI name\fR +. Returns a list containing one element for each trace currently set on command \fIname\fR. Each element of the list is itself a list containing two elements, which are the \fIopList\fR and \fIcommandPrefix\fR @@ -344,6 +358,7 @@ then the result of the command will be an empty string. If \fIname\fR does not exist, the command will throw an error. .TP \fBtrace info execution\fI name\fR +. Returns a list containing one element for each trace currently set on command \fIname\fR. Each element of the list is itself a list containing two elements, which are the \fIopList\fR and \fIcommandPrefix\fR @@ -352,6 +367,7 @@ then the result of the command will be an empty string. If \fIname\fR does not exist, the command will throw an error. .TP \fBtrace info variable\fI name\fR +. Returns a list containing one element for each trace currently set on variable \fIname\fR. Each element of the list is itself a list containing two elements, which are the \fIopList\fR and \fIcommandPrefix\fR diff --git a/doc/transchan.n b/doc/transchan.n index a424981..a511c75 100644 --- a/doc/transchan.n +++ b/doc/transchan.n @@ -70,13 +70,9 @@ This mandatory subcommand is called first, and then never again (for the given transformation at the Tcl level. The \fImode\fR is a list containing any of \fBread \fRand \fBwrite\fR. .RS -.TP -\fBwrite\fR -. +.IP \fBwrite\fR implies that the channel is writable. -.TP -\fBread\fR -. +.IP \fBread\fR implies that the channel is readable. .PP The return value of the subcommand should be a list containing the names of diff --git a/doc/unload.n b/doc/unload.n index d5bbde8..fdc3555 100644 --- a/doc/unload.n +++ b/doc/unload.n @@ -36,16 +36,19 @@ interpreter in which the \fBunload\fR command was invoked. If the initial arguments to \fBunload\fR start with \fB\-\fR then they are treated as switches. The following switches are currently supported: +.\" OPTION: -nocomplain .TP \fB\-nocomplain\fR . Suppresses all error messages. If this switch is given, \fBunload\fR will never report an error. +.\" OPTION: -keeplibrary .TP \fB\-keeplibrary\fR . This switch will prevent \fBunload\fR from issuing the operating system call that will unload the library from the process. +.\" OPTION: -- .TP \fB\-\|\-\fR . @@ -81,10 +84,10 @@ instead of \fIpkg\fB_Unload\fR. If \fBunload\fR determines that a library is not unloadable (or unload functionality has been disabled during compilation), an error will be returned. If the library is unloadable, then \fBunload\fR will call the unload -procedure. If the unload procedure returns \fBTCL_OK\fR, \fBunload\fR will proceed -and decrease the proper reference count (depending on the target interpreter -type). When both reference counts have reached 0, the library will be -detached from the process. +procedure. If the unload procedure returns \fBTCL_OK\fR, \fBunload\fR will +proceed and decrease the proper reference count (depending on the target +interpreter type). When both reference counts have reached 0, the library will +be detached from the process. .SS "UNLOAD HOOK PROTOTYPE" .PP The unload procedure must match the following prototype: @@ -130,7 +133,7 @@ For example, the command \fBunload libxyz4.2.so\fR uses the prefix prefix \fBLast\fR. .SH "PORTABILITY ISSUES" .TP -\fBUnix\fR\0\0\0\0\0 +\fBUnix\fR . Not all unix operating systems support library unloading. Under such an operating system \fBunload\fR returns an error (unless \fB\-nocomplain\fR diff --git a/doc/uplevel.n b/doc/uplevel.n index cda1652..8687416 100644 --- a/doc/uplevel.n +++ b/doc/uplevel.n @@ -26,7 +26,8 @@ it gives a distance (up the procedure calling stack) to move before executing the command. If \fIlevel\fR consists of \fB#\fR followed by a integer then the level gives an absolute level. If \fIlevel\fR is omitted then it defaults to \fB1\fR. \fILevel\fR cannot be -defaulted if the first \fIcommand\fR argument is an integer or starts with \fB#\fR. +defaulted if the first \fIcommand\fR argument is an integer or starts +with \fB#\fR. .PP For example, suppose that procedure \fBa\fR was invoked from top-level, and that it called \fBb\fR, and that \fBb\fR called \fBc\fR. diff --git a/doc/vwait.n b/doc/vwait.n index 951dbaa..1ff6caa 100644 --- a/doc/vwait.n +++ b/doc/vwait.n @@ -28,52 +28,63 @@ namespace's variables if the fully-qualified name is given. .PP In the second more complex command form \fIoptions\fR allow for finer control of the wait operation and to deal with multiple event sources. -\fIOptions\fR can be made up of +\fIOptions\fR can be made up of: +.\" OPTION: -- .TP \fB\-\-\fR . Marks the end of options. All following arguments are handled as variable names. +.\" OPTION: -all .TP \fB\-all\fR . All conditions for the wait operation must be met to complete the wait operation. Otherwise (the default) the first event completes the wait. +.\" OPTION: -extended .TP \fB\-extended\fR . An extended result in list form is returned, see below for explanation. +.\" OPTION: -nofileevents .TP \fB\-nofileevents\fR . File events are not handled in the wait operation. +.\" OPTION: -noidleevents .TP \fB\-noidleevents\fR . Idle handlers are not invoked during the wait operation. +.\" OPTION: -notimerevents .TP \fB\-notimerevents\fR . Timer handlers are not serviced during the wait operation. +.\" OPTION: -nowindowevents .TP \fB\-nowindowevents\fR . Events of the windowing system are not handled during the wait operation. +.\" OPTION: -readable .TP \fB\-readable\fI channel\fR . \fIChannel\fR must name a Tcl channel open for reading. If \fIchannel\fR is or becomes readable the wait operation completes. +.\" OPTION: -timeout .TP \fB\-timeout\fI milliseconds\fR . The wait operation is constrained to \fImilliseconds\fR. +.\" OPTION: -variable .TP \fB\-variable\fI varName\fR . \fIVarName\fR must be the name of a global variable. Writing or unsetting this variable completes the wait operation. +.\" OPTION: -writable .TP \fB\-writable\fI channel\fR . @@ -81,11 +92,11 @@ unsetting this variable completes the wait operation. is or becomes writable the wait operation completes. .PP The result returned by \fBvwait\fR is for the simple form an empty -string. If the \fI\-timeout\fR option is specified, the result is the +string. If the \fB\-timeout\fR option is specified, the result is the number of milliseconds remaining when the wait condition has been met, or -1 if the wait operation timed out. .PP -If the \fI\-extended\fR option is specified, the result is made up +If the \fB\-extended\fR option is specified, the result is made up of a Tcl list with an even number of elements. Odd elements take the values \fBreadable\fR, \fBtimeleft\fR, \fBvariable\fR, and \fBwritable\fR. Even elements are the corresponding variable diff --git a/doc/while.n b/doc/while.n index 6acc909..bacc782 100644 --- a/doc/while.n +++ b/doc/while.n @@ -30,7 +30,7 @@ commands may be executed inside \fIbody\fR to cause immediate termination of the \fBwhile\fR command. The \fBwhile\fR command always returns an empty string. .PP -Note: \fItest\fR should almost always be enclosed in braces. If not, +Note that \fItest\fR should almost always be enclosed in braces. If not, variable substitutions will be made before the \fBwhile\fR command starts executing, which means that variable changes made by the loop body will not be considered in the expression. diff --git a/doc/zipfs.3 b/doc/zipfs.3 index 18b9ea5..c15ba02 100644 --- a/doc/zipfs.3 +++ b/doc/zipfs.3 @@ -83,7 +83,7 @@ example, the Tcl 8.7.2 release would be searched for in a file On Windows, \fBTclZipfs_AppHook\fR has a slightly different signature, since it uses WCHAR instead of char. As a result, it requires your application to be compiled with the UNICODE preprocessor symbol defined (e.g., via the -\fB-DUNICODE\fR compiler flag). +\fB\-DUNICODE\fR compiler flag). .PP The result of \fBTclZipfs_AppHook\fR is the full Tcl version with build information (e.g., \fB9.0.0+abcdef...abcdef.gcc-1002\fR). diff --git a/doc/zipfs.n b/doc/zipfs.n index 520c11b..d4f97a8 100644 --- a/doc/zipfs.n +++ b/doc/zipfs.n @@ -16,7 +16,7 @@ zipfs \- Mount and work with ZIP files within Tcl .nf \fBpackage require tcl::zipfs \fR?\fB1.0\fR? -\fBzipfs canonical\fR ?\fImntpnt\fR? \fIfilename\fR ?\fIZIPFS\fR? +\fBzipfs canonical\fR ?\fImountpoint\fR? \fIfilename\fR ?\fIZIPFS\fR? \fBzipfs exists\fI filename\fR \fBzipfs find\fI directoryName\fR \fBzipfs info\fI filename\fR @@ -87,9 +87,9 @@ the compressed size of the file, and .IP (4) the offset of the compressed data in the ZIP archive file. .PP -As a special case, querying the mount point gives the start of the zip data as the offset -in (4), which can be used to truncate the zip information from an executable. -Querying an ancestor of a mount point will raise an error. +As a special case, querying the mount point gives the start of the zip data +as the offset in (4), which can be used to truncate the zip information from +an executable. Querying an ancestor of a mount point will raise an error. .RE .\" METHOD: list .TP @@ -97,9 +97,9 @@ Querying an ancestor of a mount point will raise an error. . If \fIpattern\fR is not specified, the command returns a list of files across all zipfs mounted archives. If \fIpattern\fR is specified, only those paths -matching the pattern are returned. By default, or with the \fB-glob\fR option, +matching the pattern are returned. By default, or with the \fB\-glob\fR option, the pattern is treated as a glob pattern and matching is done as described for -the \fBstring match\fR command. Alternatively, the \fB-regexp\fR option may be +the \fBstring match\fR command. Alternatively, the \fB\-regexp\fR option may be used to specify matching \fBpattern\fR as a regular expression. The file names are returned in arbitrary order. Note that path separators are treated as ordinary characters in the matching. Thus forward slashes should be used @@ -124,10 +124,10 @@ mount points to the path of the corresponding ZIP archive. In the single argument form, the command returns the file path of the ZIP archive mounted at the specified mount point. .PP -In the third form, the command mounts the ZIP archive \fIzipfile\fR as a Tcl virtual -filesystem at \fImountpoint\fR. After this command executes, files contained -in \fIzipfile\fR will appear to Tcl to be regular files at the mount point. -If \fImountpoint\fR is +In the third form, the command mounts the ZIP archive \fIzipfile\fR as a Tcl +virtual filesystem at \fImountpoint\fR. After this command executes, files +contained in \fIzipfile\fR will appear to Tcl to be regular files at the +mount point. If \fImountpoint\fR is specified as an empty string, it is defaulted to the \fB[zipfs root]\fR. The command returns the normalized mount point path. .PP diff --git a/doc/zlib.n b/doc/zlib.n index 8bf6f2b..4c6cb2b 100644 --- a/doc/zlib.n +++ b/doc/zlib.n @@ -51,37 +51,23 @@ have been in gzip format. If \fB\-headerVar\fR is given, store a dictionary describing the contents of the gzip header in the variable called \fIvarName\fR. The keys of the dictionary that may be present are: .RS -.TP -\fBcomment\fR -. +.IP \fBcomment\fR The comment field from the header, if present. -.TP -\fBcrc\fR -. +.IP \fBcrc\fR A boolean value describing whether a CRC of the header is computed. -.TP -\fBfilename\fR -. +.IP \fBfilename\fR The filename field from the header, if present. -.TP -\fBos\fR -. +.IP \fBos\fR The operating system type code field from the header (if not the QW unknown value). See RFC 1952 for the meaning of these codes. -.TP -\fBsize\fR -. +.IP \fBsize\fR The size of the uncompressed data. -.TP -\fBtime\fR -. +.IP \fBtime\fR The time field from the header if non-zero, expected to be time that the file named by the \fBfilename\fR field was modified. Suitable for use with \fBclock format\fR. -.TP -\fBtype\fR -. +.IP \fBtype\fR The type of the uncompressed data (\fBbinary\fR or \fBtext\fR) if known. .RE .\" METHOD: gzip @@ -94,33 +80,21 @@ If \fB\-level\fR is given, \fIlevel\fR gives the compression level to use is given, \fIdict\fR is a dictionary containing values used for the gzip header. The following keys may be defined: .RS -.TP -\fBcomment\fR -. +.IP \fBcomment\fR Add the given comment to the header of the gzip-format data. -.TP -\fBcrc\fR -. +.IP \fBcrc\fR A boolean saying whether to compute a CRC of the header. Note that if the data is to be interchanged with the \fBgzip\fR program, a header CRC should \fInot\fR be computed. -.TP -\fBfilename\fR -. +.IP \fBfilename\fR The name of the file that the data to be compressed came from. -.TP -\fBos\fR -. +.IP \fBos\fR The operating system type code, which should be one of the values described in RFC 1952. -.TP -\fBtime\fR -. +.IP \fBtime\fR The time that the file named in the \fBfilename\fR key was last modified. This will be in the same as is returned by \fBclock seconds\fR or \fBfile mtime\fR. -.TP -\fBtype\fR -. +.IP \fBtype\fR The type of the data being compressed, being \fBbinary\fR or \fBtext\fR. .RE .\" METHOD: inflate @@ -141,34 +115,22 @@ The transformation can be removed again with \fBchan pop\fR. The \fImode\fR argument determines what type of transformation is pushed; the following are supported: .RS -.TP -\fBcompress\fR -. +.IP \fBcompress\fR The transformation will be a compressing transformation that produces zlib-format data on \fIchannel\fR, which must be writable. -.TP -\fBdecompress\fR -. +.IP \fBdecompress\fR The transformation will be a decompressing transformation that reads zlib-format data from \fIchannel\fR, which must be readable. -.TP -\fBdeflate\fR -. +.IP \fBdeflate\fR The transformation will be a compressing transformation that produces raw compressed data on \fIchannel\fR, which must be writable. -.TP -\fBgunzip\fR -. +.IP \fBgunzip\fR The transformation will be a decompressing transformation that reads gzip-format data from \fIchannel\fR, which must be readable. -.TP -\fBgzip\fR -. +.IP \fBgzip\fR The transformation will be a compressing transformation that produces gzip-format data on \fIchannel\fR, which must be writable. -.TP -\fBinflate\fR -. +.IP \fBinflate\fR The transformation will be a decompressing transformation that reads raw compressed data from \fIchannel\fR, which must be readable. .PP @@ -176,6 +138,7 @@ The following options may be set when creating a transformation via the .QW "\fIoptions ...\fR" to the \fBzlib push\fR command: +.\" OPTION: -dictionary .TP \fB\-dictionary\fI binData\fR .VS "TIP 400" @@ -187,16 +150,19 @@ with the most commonly used strings preferably put towards the end of the dictionary. Tcl provides no mechanism for choosing a good such dictionary for a particular data sequence. .VE +.\" OPTION: -header .TP \fB\-header\fI dictionary\fR . Passes a description of the gzip header to create, in the same format that \fBzlib gzip\fR understands. +.\" OPTION: -level .TP \fB\-level\fI compressionLevel\fR . How hard to compress the data. Must be an integer from 0 (uncompressed) to 9 (maximally compressed). +.\" OPTION: -limit .TP \fB\-limit\fI readaheadLimit\fR . @@ -216,6 +182,7 @@ to further readers. Both compressing and decompressing channel transformations add extra configuration options that may be accessed through \fBchan configure\fR. The options are: +.\" OPTION: -checksum .TP \fB\-checksum\fI checksum\fR . @@ -223,6 +190,7 @@ This read-only option gets the current checksum for the uncompressed data that the compression engine has seen so far. It is valid for both compressing and decompressing transforms, but not for the raw inflate and deflate formats. The compression algorithm depends on what format is being produced or consumed. +.\" OPTION: -dictionary .TP \fB\-dictionary\fI binData\fR .VS "TIP 400" @@ -234,6 +202,7 @@ the transformation is stacked. Note that this cannot be used to get the current active compression dictionary mid-stream, as that information is not exposed by the underlying library. .VE +.\" OPTION: -flush .TP \fB\-flush\fI type\fR . @@ -243,12 +212,14 @@ underlying channel. It is only valid for compressing transformations. The expensive flush respectively. Flushing degrades the compression ratio, but makes it easier for a decompressor to recover more of the file in the case of data corruption. +.\" OPTION: -header .TP \fB\-header\fI dictionary\fR . This read-only option, only valid for decompressing transforms that are processing gzip-format data, returns the dictionary describing the header read off the data stream. +.\" OPTION: -limit .TP \fB\-limit\fI readaheadLimit\fR . @@ -406,12 +377,14 @@ buffers while applying the transformation. The following \fIoption\fRs are supported (or an unambiguous prefix of them), which are used to modify the way in which the transformation is applied: .RS +.\" OPTION: -dictionary .TP \fB\-dictionary\fI binData\fR .VS "TIP 400" Sets the compression dictionary to use when working with compressing or decompressing the data to be \fIbinData\fR. .VE +.\" OPTION: -finalize .TP \fB\-finalize\fR . @@ -425,6 +398,7 @@ of the stream with the \fBget\fR subcommand. This option is mutually exclusive with the \fB\-flush\fR and \fB\-fullflush\fR options. .RE +.\" OPTION: -flush .TP \fB\-flush\fR . @@ -436,6 +410,7 @@ compressed so far, at some performance penalty. This option is mutually exclusive with the \fB\-finalize\fR and \fB\-fullflush\fR options. .RE +.\" OPTION: -fullflush .TP \fB\-fullflush\fR . -- cgit v0.12 From 00205e1477500658003372ff091a65ff9af7c0d3 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 25 Jan 2024 20:26:52 +0000 Subject: Tidy up a bit by adding some comments to findDocWords --- tools/findDocWords.tcl | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/tools/findDocWords.tcl b/tools/findDocWords.tcl index 2b585d5..0b25315 100644 --- a/tools/findDocWords.tcl +++ b/tools/findDocWords.tcl @@ -1,3 +1,17 @@ +# findDocWords.tcl -- +# +# This script attempts to find all non-dictionary words in the Tcl or Tk +# documentation tree. It handles the fairly common compoundWord trick our +# docs use, and isn't confused by nroff formatting directives, so it isn't +# just a standard spell check. +# +# Arguments: +# 1: Directory to look for man source files in. +# 2: Path to a plain text dictionary. Try /usr/share/dict/words on Linux. +# +# Copyright © 2024 Donal K Fellows. +# See "license.terms" for the license. + lassign $argv dir dictionary set f [open $dictionary] -- cgit v0.12 From 4f868f4026ad68c90c861dcb715d33738e49b366 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 26 Jan 2024 12:51:15 +0000 Subject: Improve tcl_startOfPreviousWord, so it can handle indices like "" (from Tk) and "end-1" --- library/word.tcl | 15 ++++- tests/word.test | 194 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 207 insertions(+), 2 deletions(-) create mode 100644 tests/word.test diff --git a/library/word.tcl b/library/word.tcl index e86c44a..5b6131d 100644 --- a/library/word.tcl +++ b/library/word.tcl @@ -65,6 +65,9 @@ namespace eval ::tcl { proc tcl_wordBreakAfter {str start} { variable ::tcl::WordBreakRE set result {-1 -1} + if {$start < 0} { + set start 0; + } regexp -indices -start $start -- $WordBreakRE(after) $str result return [lindex $result 1] } @@ -83,7 +86,9 @@ proc tcl_wordBreakAfter {str start} { proc tcl_wordBreakBefore {str start} { variable ::tcl::WordBreakRE set result {-1 -1} - regexp -indices -- $WordBreakRE(before) [string range $str 0 $start] result + if {$start >= 0} { + regexp -indices -- $WordBreakRE(before) [string range $str 0 $start] result + } return [lindex $result 1] } @@ -102,6 +107,9 @@ proc tcl_wordBreakBefore {str start} { proc tcl_endOfWord {str start} { variable ::tcl::WordBreakRE set result {-1 -1} + if {$start < 0} { + set start 0 + } regexp -indices -start $start -- $WordBreakRE(end) $str result return [lindex $result 1] } @@ -120,6 +128,9 @@ proc tcl_endOfWord {str start} { proc tcl_startOfNextWord {str start} { variable ::tcl::WordBreakRE set result {-1 -1} + if {$start < 0} { + set start 0 + } regexp -indices -start $start -- $WordBreakRE(next) $str result return [lindex $result 1] } @@ -137,7 +148,7 @@ proc tcl_startOfPreviousWord {str start} { variable ::tcl::WordBreakRE set word {-1 -1} if {$start > 0} { - regexp -indices -- $WordBreakRE(previous) [string range $str 0 $start-1] \ + regexp -indices -- $WordBreakRE(previous) [string range [string range $str 0 $start] 0 end-1]\ result word } return [lindex $word 0] diff --git a/tests/word.test b/tests/word.test new file mode 100644 index 0000000..8e5bac5 --- /dev/null +++ b/tests/word.test @@ -0,0 +1,194 @@ +# This file is a Tcl script to test the [tcl_startOf|endOf]* functions in +# word.tcl. It is organized in the standard fashion for Tcl tests. +# +# Copyright © 1994 The Regents of the University of California. +# Copyright © 1994-1995 Sun Microsystems, Inc. +# Copyright © 1998-1999 Scriptics Corporation. +# All rights reserved. + +if {"::tcltest" ni [namespace children]} { + package require tcltest 2.5 + namespace import -force ::tcltest::* +} + +::tcltest::loadTestedCommands +catch [list package require -exact tcl::test [info patchlevel]] + +test word-3.0 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" -1 +} -result 2 +test word-3.1 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" 0 +} -result 2 +test word-3.2 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" 1 +} -result 2 +test word-3.3 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" 2 +} -result -1 +test word-3.4 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" 3 +} -result -1 +test word-3.5 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" 4 +} -result -1 +test word-3.6 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" 5 +} -result -1 +test word-3.7 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" end +} -result -1 +test word-3.8 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" {} +} -result 2 +test word-3.9 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" end-1 +} -result -1 + +test word-4.0 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" -1 +} -result -1 +test word-4.1 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" 0 +} -result -1 +test word-4.2 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" 1 +} -result 0 +test word-4.3 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" 2 +} -result 0 +test word-4.4 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" 3 +} -result 0 +test word-4.5 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" 4 +} -result 3 +test word-4.6 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" 5 +} -result 3 +test word-4.7 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" end +} -result 3 +test word-4.8 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" {} +} -result -1 +test word-4.9 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" end-1 +} -result 0 + +test word-5.0 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" -1 +} -result 3 +test word-5.1 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" 0 +} -result 3 +test word-5.2 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" 1 +} -result 3 +test word-5.3 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" 2 +} -result 3 +test word-5.4 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" 3 +} -result -1 +test word-5.5 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" 4 +} -result -1 +test word-5.6 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" 5 +} -result -1 +test word-5.7 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" end +} -result -1 +test word-5.8 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" {} +} -result 3 +test word-5.9 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" end-1 +} -result -1 + +test word-6.0 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" -1 +} -result -1 +test word-6.1 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" 0 +} -result -1 +test word-6.2 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" 1 +} -result -1 +test word-6.3 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" 2 +} -result 2 +test word-6.4 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" 3 +} -result 3 +test word-6.5 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" 4 +} -result 3 +test word-6.6 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" 5 +} -result 3 +test word-6.7 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" end +} -result 3 +test word-6.8 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" {} +} -result -1 +test word-6.9 {tcl_wordBreakBefore} -body { + tcl_startOfNextWord "ab cd" end-1 +} -result -1 + +test word-7.0 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" -1 +} -result 2 +test word-7.1 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" 0 +} -result 2 +test word-7.2 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" 1 +} -result 2 +test word-7.3 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" 2 +} -result 3 +test word-7.4 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" 3 +} -result -1 +test word-7.5 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" 4 +} -result -1 +test word-7.6 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" 5 +} -result -1 +test word-7.7 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" end +} -result -1 +test word-7.8 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" {} +} -result 2 +test word-7.9 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" end-1 +} -result -1 + +test word-8.2 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord a b c d +} -returnCodes 1 -result {wrong # args: should be "tcl_startOfPreviousWord str start"} +test word-8.3 {tcl_startOfNextWord} -body { + tcl_startOfNextWord a b c d +} -returnCodes 1 -result {wrong # args: should be "tcl_startOfNextWord str start"} +test word-8.4 {tcl_endOfWord} -body { + tcl_endOfWord a b c d +} -returnCodes 1 -result {wrong # args: should be "tcl_endOfWord str start"} +test word-8.5 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore a b c d +} -returnCodes 1 -result {wrong # args: should be "tcl_wordBreakBefore str start"} +test word-8.6 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter a b c d +} -returnCodes 1 -result {wrong # args: should be "tcl_wordBreakAfter str start"} + +# cleanup +::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# End: -- cgit v0.12 From d04358a7db334200fd94ee8887cb772c066ff347 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 26 Jan 2024 13:37:13 +0000 Subject: Add testcases for library/word.tcl --- tests/word.test | 177 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 177 insertions(+) create mode 100644 tests/word.test diff --git a/tests/word.test b/tests/word.test new file mode 100644 index 0000000..453a635 --- /dev/null +++ b/tests/word.test @@ -0,0 +1,177 @@ +# This file is a Tcl script to test the [tcl_startOf|endOf]* functions in +# word.tcl. It is organized in the standard fashion for Tcl tests. +# +# Copyright (c) 2024 Jan Nijtmans +# All rights reserved. + +if {"::tcltest" ni [namespace children]} { + package require tcltest 2.5 + namespace import -force ::tcltest::* +} + +::tcltest::loadTestedCommands +catch [list package require -exact tcl::test [info patchlevel]] + +test word-1.0 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" -1 +} -result 2 +test word-1.1 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" 0 +} -result 2 +test word-1.2 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" 1 +} -result 2 +test word-1.3 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" 2 +} -result -1 +test word-1.4 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" 3 +} -result -1 +test word-1.5 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" 4 +} -result -1 +test word-1.6 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" 5 +} -result -1 +test word-1.7 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" end +} -result -1 +test word-1.8 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" end-1 +} -result -1 + +test word-2.0 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" -1 +} -result -1 +test word-2.1 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" 0 +} -result -1 +test word-2.2 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" 1 +} -result 0 +test word-2.3 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" 2 +} -result 0 +test word-2.4 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" 3 +} -result 0 +test word-2.5 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" 4 +} -result 3 +test word-2.6 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" 5 +} -result 3 +test word-2.7 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" end +} -result 3 +test word-2.8 {tcl_startOfPreviousWord, bug [16e25e1402]} -constraints knownBug -body { + tcl_startOfPreviousWord "ab cd" end-1 +} -result 0 + +test word-3.0 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" -1 +} -result 3 +test word-3.1 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" 0 +} -result 3 +test word-3.2 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" 1 +} -result 3 +test word-3.3 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" 2 +} -result 3 +test word-3.4 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" 3 +} -result -1 +test word-3.5 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" 4 +} -result -1 +test word-3.6 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" 5 +} -result -1 +test word-3.7 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" end +} -result -1 +test word-3.8 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" end-1 +} -result -1 + +test word-4.0 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" -1 +} -result -1 +test word-4.1 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" 0 +} -result -1 +test word-4.2 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" 1 +} -result -1 +test word-4.3 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" 2 +} -result 2 +test word-4.4 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" 3 +} -result 3 +test word-4.5 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" 4 +} -result 3 +test word-4.6 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" 5 +} -result 3 +test word-4.7 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" end +} -result 3 +test word-4.8 {tcl_wordBreakBefore} -body { + tcl_startOfNextWord "ab cd" end-1 +} -result -1 + +test word-5.0 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" -1 +} -result 2 +test word-5.1 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" 0 +} -result 2 +test word-5.2 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" 1 +} -result 2 +test word-5.3 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" 2 +} -result 3 +test word-5.4 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" 3 +} -result -1 +test word-5.5 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" 4 +} -result -1 +test word-5.6 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" 5 +} -result -1 +test word-5.7 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" end +} -result -1 +test word-5.8 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" end-1 +} -result -1 + +test word-6.0 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord a b c d +} -returnCodes 1 -result {wrong # args: should be "tcl_startOfPreviousWord str start"} +test word-6.1 {tcl_startOfNextWord} -body { + tcl_startOfNextWord a b c d +} -returnCodes 1 -result {wrong # args: should be "tcl_startOfNextWord str start"} +test word-6.2 {tcl_endOfWord} -body { + tcl_endOfWord a b c d +} -returnCodes 1 -result {wrong # args: should be "tcl_endOfWord str start"} +test word-6.3 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore a b c d +} -returnCodes 1 -result {wrong # args: should be "tcl_wordBreakBefore str start"} +test word-6.4 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter a b c d +} -returnCodes 1 -result {wrong # args: should be "tcl_wordBreakAfter str start"} + +# cleanup +::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# End: -- cgit v0.12 From ffc7e95486dffe836d6c5a7d9477a986d4db4d21 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 26 Jan 2024 13:40:47 +0000 Subject: Fix [16e25e1402]: tcl_startOfPreviousWord cannot handle "end-1" --- library/word.tcl | 2 +- tests/word.test | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/library/word.tcl b/library/word.tcl index 0c8e01c..a993918 100644 --- a/library/word.tcl +++ b/library/word.tcl @@ -147,7 +147,7 @@ proc tcl_startOfPreviousWord {str start} { variable ::tcl::WordBreakRE set word {-1 -1} if {$start > 0} { - regexp -indices -- $WordBreakRE(previous) [string range $str 0 $start-1] \ + regexp -indices -- $WordBreakRE(previous) [string range [string range $str 0 $start] 0 end-1] \ result word } return [lindex $word 0] diff --git a/tests/word.test b/tests/word.test index 453a635..c141aba 100644 --- a/tests/word.test +++ b/tests/word.test @@ -64,7 +64,7 @@ test word-2.6 {tcl_startOfPreviousWord} -body { test word-2.7 {tcl_startOfPreviousWord} -body { tcl_startOfPreviousWord "ab cd" end } -result 3 -test word-2.8 {tcl_startOfPreviousWord, bug [16e25e1402]} -constraints knownBug -body { +test word-2.8 {tcl_startOfPreviousWord, bug [16e25e1402]} -body { tcl_startOfPreviousWord "ab cd" end-1 } -result 0 -- cgit v0.12 From 0908f2ec1d8a680a41f811cc6181c4a719bd6fa7 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 26 Jan 2024 22:18:14 +0000 Subject: added channel regression tests (for read command) to illustrate bugs [db4f2843cd], [da16d15574] --- tests-perf/chan.perf.tcl | 93 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 93 insertions(+) create mode 100644 tests-perf/chan.perf.tcl diff --git a/tests-perf/chan.perf.tcl b/tests-perf/chan.perf.tcl new file mode 100644 index 0000000..b3bd1c4 --- /dev/null +++ b/tests-perf/chan.perf.tcl @@ -0,0 +1,93 @@ +#!/usr/bin/tclsh + +# ------------------------------------------------------------------------ +# +# chan.perf.tcl -- +# +# This file provides performance tests for comparison of tcl-speed +# of channel subsystem. +# +# ------------------------------------------------------------------------ +# +# Copyright (c) 2024 Serg G. Brester (aka sebres) +# +# See the file "license.terms" for information on usage and redistribution +# of this file. +# + + +if {![namespace exists ::tclTestPerf]} { + source [file join [file dirname [info script]] test-performance.tcl] +} + + +namespace eval ::tclTestPerf-Chan { + +namespace path {::tclTestPerf} + +proc _get_test_chan {{bufSize 4096}} { + lassign [chan pipe] ch wch; + fconfigure $ch -translation binary -encoding utf-8 -buffersize $bufSize -buffering full + fconfigure $wch -translation binary -encoding utf-8 -buffersize $bufSize -buffering full + + exec [info nameofexecutable] -- $bufSize >@$wch << { + set bufSize [lindex $::argv end] + fconfigure stdout -translation binary -encoding utf-8 -buffersize $bufSize -buffering full + set buf [string repeat test 1000]; # 4K + # write ~ 10*1M + 10*2M + 10*10M + 1*20M: + set i 0; while {$i < int((10*1e6 + 10*2e6 + 10*10e6 + 1*20e6)/4e3)} { + #puts -nonewline stdout $i\t + puts stdout $buf + flush stdout + incr i + } + } & + close $wch + return $ch +} + +# regression tests for [bug-da16d15574] (fix for [db4f2843cd]): +proc test-read-regress {{reptime {50000 10}}} { + _test_run -no-result $reptime { + # with 4KB buffersize: + setup { set ch [::tclTestPerf-Chan::_get_test_chan 4096]; fconfigure $ch -buffersize } + # 10 * 1M: + {read $ch [expr {int(1e6)}]} + # 10 * 2M: + {read $ch [expr {int(2e6)}]} + # 10 * 10M: + {read $ch [expr {int(10e6)}]} + # 1 * 20M: + {read $ch; break} + cleanup { close $ch } + + # with 1MB buffersize: + setup { set ch [::tclTestPerf-Chan::_get_test_chan 1048576]; fconfigure $ch -buffersize } + # 10 * 1M: + {read $ch [expr {int(1e6)}]} + # 10 * 2M: + {read $ch [expr {int(2e6)}]} + # 10 * 10M: + {read $ch [expr {int(10e6)}]} + # 1 * 20M: + {read $ch; break} + cleanup { close $ch } + } +} + +proc test {{reptime 1000}} { + test-read-regress + + puts \n**OK** +} + +}; # end of ::tclTestPerf-Chan + +# ------------------------------------------------------------------------ + +# if calling direct: +if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} { + array set in {-time 500} + array set in $argv + ::tclTestPerf-Chan::test $in(-time) +} -- cgit v0.12 From ca170ba542c781a2505f9d1eb72f9971c90ce7a3 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 27 Jan 2024 12:09:52 +0000 Subject: More testcases --- tests/word.test | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/tests/word.test b/tests/word.test index de5c985..effcd20 100644 --- a/tests/word.test +++ b/tests/word.test @@ -39,6 +39,9 @@ test word-1.7 {tcl_endOfWord} -body { test word-1.8 {tcl_endOfWord} -body { tcl_endOfWord "ab cd" end-1 } -result -1 +test word-1.9 {tcl_endOfWord} -body { + tcl_endOfWord "ab cd" {} +} -result 2 test word-2.0 {tcl_startOfPreviousWord} -body { tcl_startOfPreviousWord "ab cd" -1 @@ -67,6 +70,9 @@ test word-2.7 {tcl_startOfPreviousWord} -body { test word-2.8 {tcl_startOfPreviousWord, bug [16e25e1402]} -body { tcl_startOfPreviousWord "ab cd" end-1 } -result 0 +test word-2.9 {tcl_startOfPreviousWord} -body { + tcl_startOfPreviousWord "ab cd" {} +} -result -1 test word-3.0 {tcl_startOfNextWord} -body { tcl_startOfNextWord "ab cd" -1 @@ -95,6 +101,9 @@ test word-3.7 {tcl_startOfNextWord} -body { test word-3.8 {tcl_startOfNextWord} -body { tcl_startOfNextWord "ab cd" end-1 } -result -1 +test word-3.9 {tcl_startOfNextWord} -body { + tcl_startOfNextWord "ab cd" {} +} -result 3 test word-4.0 {tcl_wordBreakBefore} -body { tcl_wordBreakBefore "ab cd" -1 @@ -123,6 +132,9 @@ test word-4.7 {tcl_wordBreakBefore} -body { test word-4.8 {tcl_wordBreakBefore} -body { tcl_startOfNextWord "ab cd" end-1 } -result -1 +test word-4.9 {tcl_wordBreakBefore} -body { + tcl_wordBreakBefore "ab cd" {} +} -result -1 test word-5.0 {tcl_wordBreakAfter} -body { tcl_wordBreakAfter "ab cd" -1 @@ -151,6 +163,9 @@ test word-5.7 {tcl_wordBreakAfter} -body { test word-5.8 {tcl_wordBreakAfter} -body { tcl_wordBreakAfter "ab cd" end-1 } -result -1 +test word-5.9 {tcl_wordBreakAfter} -body { + tcl_wordBreakAfter "ab cd" {} +} -result 2 test word-6.0 {tcl_startOfPreviousWord} -body { tcl_startOfPreviousWord a b c d -- cgit v0.12 From 59f73d4a40efe8019c5fc169f1cb8c3252c79cef Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 28 Jan 2024 20:42:38 +0000 Subject: Backport regsub.n from 9.0 --- doc/regsub.n | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/doc/regsub.n b/doc/regsub.n index 29c118a..cb8c2d4 100644 --- a/doc/regsub.n +++ b/doc/regsub.n @@ -54,6 +54,7 @@ backslashes. If the initial arguments to \fBregsub\fR start with \fB\-\fR then they are treated as switches. The following switches are currently supported: +.\" OPTION: -all .TP \fB\-all\fR . @@ -67,6 +68,7 @@ and .QW \e\fIn\fR sequences are handled for each substitution using the information from the corresponding match. +.\" OPTION: -command .TP \fB\-command\fR .VS 8.7 @@ -80,7 +82,7 @@ command prefix, that is, a non-empty list. The substring of \fIstring\fR that matches \fIexp\fR, and then each substring that matches each capturing sub-RE within \fIexp\fR are appended as additional elements to that list. (The items appended to the list are much like what -\fBregexp\fR \fB-inline\fR would return). The completed list is then +\fBregexp\fR \fB\-inline\fR would return). The completed list is then evaluated as a Tcl command, and the result of that command is the substitution string. Any error or exception from command evaluation becomes an error or exception from the \fBregsub\fR command. @@ -94,12 +96,14 @@ The exact location indices that matched are not made available to the script. See \fBEXAMPLES\fR below for illustrative cases. .RE .VE 8.7 +.\" OPTION: -expanded .TP \fB\-expanded\fR . Enables use of the expanded regular expression syntax where whitespace and comments are ignored. This is the same as specifying the \fB(?x)\fR embedded option (see the \fBre_syntax\fR manual page). +.\" OPTION: -line .TP \fB\-line\fR . @@ -117,6 +121,7 @@ matches an empty string before any newline in addition to its normal function. This flag is equivalent to specifying both \fB\-linestop\fR and \fB\-lineanchor\fR, or the \fB(?n)\fR embedded option (see the \fBre_syntax\fR manual page). +.\" OPTION: -linestop .TP \fB\-linestop\fR . @@ -127,6 +132,7 @@ bracket expressions and so that they stop at newlines. This is the same as specifying the \fB(?p)\fR embedded option (see the \fBre_syntax\fR manual page). +.\" OPTION: -lineanchor .TP \fB\-lineanchor\fR . @@ -140,14 +146,16 @@ so they match the beginning and end of a line respectively. This is the same as specifying the \fB(?w)\fR embedded option (see the \fBre_syntax\fR manual page). +.\" OPTION: -nocase .TP \fB\-nocase\fR . Upper-case characters in \fIstring\fR will be converted to lower-case before matching against \fIexp\fR; however, substitutions specified by \fIsubSpec\fR use the original unconverted form of \fIstring\fR. +.\" OPTION: -start .TP -\fB\-start\fR \fIindex\fR +\fB\-start\fI index\fR . Specifies a character index offset into the string to start matching the regular expression at. @@ -158,6 +166,7 @@ When using this switch, will not match the beginning of the line, and \eA will still match the start of the string at \fIindex\fR. \fIindex\fR will be constrained to the bounds of the input string. +.\" OPTION: -- .TP \fB\-\|\-\fR . @@ -256,6 +265,15 @@ set decoded [\fBregsub\fR -all -command $RE $string {apply {{- p h} { format %c $charNumber }}}] .CE +.PP +The \fB\-command\fR option can also be useful for restricting the range of +commands such as \fBstring totitle\fR: +.PP +.CS +set message "the quIck broWn fOX JUmped oVer the laZy dogS..." +puts [\fBregsub\fR -all -command {\ew+} $message {string totitle}] +# \(-> \fIThe Quick Brown Fox Jumped Over The Lazy Dogs..\fR +.CE .VE 8.7 .SH "SEE ALSO" regexp(n), re_syntax(n), subst(n), string(n) -- cgit v0.12 From c95d2cdab74b6d57af133bdc3478dc300f171481 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 28 Jan 2024 21:12:57 +0000 Subject: Missing "const" --- generic/tclTest.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 02e1fac..08b3306 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -8436,7 +8436,7 @@ TestparseargsCmd( static int foo = 0; Tcl_Size count = objc; Tcl_Obj **remObjv, *result[3]; - Tcl_ArgvInfo argTable[] = { + 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 }; -- cgit v0.12 From 946d0bc4d7570b445d3d058095c1b51c4f40603d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 28 Jan 2024 22:25:28 +0000 Subject: zlib-1.3.1 --- compat/zlib/CMakeLists.txt | 43 +- compat/zlib/ChangeLog | 10 + compat/zlib/FAQ | 3 +- compat/zlib/LICENSE | 22 + compat/zlib/Makefile.in | 16 +- compat/zlib/README | 6 +- compat/zlib/configure | 9 +- compat/zlib/contrib/delphi/ZLib.pas | 2 +- .../zlib/contrib/dotzlib/DotZLib/ChecksumImpl.cs | 402 ++++----- .../zlib/contrib/dotzlib/DotZLib/CircularBuffer.cs | 166 ++-- compat/zlib/contrib/dotzlib/DotZLib/CodecBase.cs | 396 ++++----- compat/zlib/contrib/dotzlib/DotZLib/Deflater.cs | 212 ++--- compat/zlib/contrib/dotzlib/DotZLib/DotZLib.cs | 576 ++++++------- compat/zlib/contrib/dotzlib/DotZLib/GZipStream.cs | 602 ++++++------- compat/zlib/contrib/dotzlib/DotZLib/Inflater.cs | 210 ++--- compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs | 2 +- compat/zlib/contrib/infback9/inftree9.c | 6 +- compat/zlib/contrib/infback9/inftree9.h | 4 +- compat/zlib/contrib/iostream3/zfstream.h | 4 +- compat/zlib/contrib/minizip/Makefile | 2 +- compat/zlib/contrib/minizip/configure.ac | 2 +- compat/zlib/contrib/minizip/ioapi.h | 2 +- compat/zlib/contrib/minizip/miniunz.c | 18 +- compat/zlib/contrib/minizip/unzip.c | 8 +- compat/zlib/contrib/minizip/unzip.h | 2 +- compat/zlib/contrib/minizip/zip.c | 21 +- compat/zlib/contrib/minizip/zip.h | 4 +- compat/zlib/contrib/nuget/nuget.csproj | 43 + compat/zlib/contrib/nuget/nuget.sln | 22 + compat/zlib/contrib/pascal/zlibpas.pas | 2 +- compat/zlib/contrib/puff/puff.c | 8 +- compat/zlib/contrib/vstudio/readme.txt | 156 ++-- compat/zlib/contrib/vstudio/vc10/zlib.rc | 8 +- compat/zlib/contrib/vstudio/vc10/zlibvc.def | 2 +- compat/zlib/contrib/vstudio/vc11/zlib.rc | 8 +- compat/zlib/contrib/vstudio/vc11/zlibvc.def | 2 +- compat/zlib/contrib/vstudio/vc12/zlib.rc | 8 +- compat/zlib/contrib/vstudio/vc12/zlibvc.def | 2 +- compat/zlib/contrib/vstudio/vc14/zlib.rc | 8 +- compat/zlib/contrib/vstudio/vc14/zlibvc.def | 2 +- compat/zlib/contrib/vstudio/vc17/miniunz.vcxproj | 409 +++++++++ compat/zlib/contrib/vstudio/vc17/minizip.vcxproj | 405 +++++++++ compat/zlib/contrib/vstudio/vc17/testzlib.vcxproj | 473 ++++++++++ .../zlib/contrib/vstudio/vc17/testzlibdll.vcxproj | 409 +++++++++ compat/zlib/contrib/vstudio/vc17/zlib.rc | 32 + compat/zlib/contrib/vstudio/vc17/zlibstat.vcxproj | 602 +++++++++++++ compat/zlib/contrib/vstudio/vc17/zlibvc.def | 158 ++++ compat/zlib/contrib/vstudio/vc17/zlibvc.sln | 179 ++++ compat/zlib/contrib/vstudio/vc17/zlibvc.vcxproj | 875 +++++++++++++++++++ compat/zlib/contrib/vstudio/vc9/zlib.rc | 8 +- compat/zlib/contrib/vstudio/vc9/zlibvc.def | 2 +- compat/zlib/deflate.c | 47 +- compat/zlib/deflate.h | 35 +- compat/zlib/doc/algorithm.txt | 209 +++++ compat/zlib/doc/crc-doc.1.0.pdf | Bin 0 -> 776142 bytes compat/zlib/doc/rfc1950.txt | 619 +++++++++++++ compat/zlib/doc/rfc1951.txt | 955 +++++++++++++++++++++ compat/zlib/doc/rfc1952.txt | 675 +++++++++++++++ compat/zlib/doc/txtvsbin.txt | 107 +++ compat/zlib/examples/gzlog.c | 4 +- compat/zlib/examples/zran.c | 2 +- compat/zlib/gzguts.h | 8 +- compat/zlib/gzlib.c | 12 +- compat/zlib/inflate.c | 2 +- compat/zlib/inftrees.c | 6 +- compat/zlib/inftrees.h | 4 +- compat/zlib/old/visual-basic.txt | 2 +- compat/zlib/os400/README400 | 2 +- compat/zlib/os400/zlib.inc | 6 +- compat/zlib/qnx/package.qpg | 10 +- compat/zlib/test/example.c | 25 +- compat/zlib/test/minigzip.c | 32 +- compat/zlib/treebuild.xml | 4 +- compat/zlib/trees.c | 20 +- compat/zlib/win32/DLL_FAQ.txt | 20 +- compat/zlib/win32/README-WIN32.txt | 8 +- compat/zlib/zconf.h | 10 +- compat/zlib/zconf.h.cmakein | 10 +- compat/zlib/zconf.h.in | 10 +- compat/zlib/zlib.3 | 6 +- compat/zlib/zlib.3.pdf | Bin 19505 -> 25523 bytes compat/zlib/zlib.h | 22 +- compat/zlib/zlib.map | 200 ++--- compat/zlib/zutil.h | 27 +- 84 files changed, 7959 insertions(+), 1713 deletions(-) create mode 100644 compat/zlib/LICENSE create mode 100644 compat/zlib/contrib/nuget/nuget.csproj create mode 100644 compat/zlib/contrib/nuget/nuget.sln create mode 100644 compat/zlib/contrib/vstudio/vc17/miniunz.vcxproj create mode 100644 compat/zlib/contrib/vstudio/vc17/minizip.vcxproj create mode 100644 compat/zlib/contrib/vstudio/vc17/testzlib.vcxproj create mode 100644 compat/zlib/contrib/vstudio/vc17/testzlibdll.vcxproj create mode 100644 compat/zlib/contrib/vstudio/vc17/zlib.rc create mode 100644 compat/zlib/contrib/vstudio/vc17/zlibstat.vcxproj create mode 100644 compat/zlib/contrib/vstudio/vc17/zlibvc.def create mode 100644 compat/zlib/contrib/vstudio/vc17/zlibvc.sln create mode 100644 compat/zlib/contrib/vstudio/vc17/zlibvc.vcxproj create mode 100644 compat/zlib/doc/algorithm.txt create mode 100644 compat/zlib/doc/crc-doc.1.0.pdf create mode 100644 compat/zlib/doc/rfc1950.txt create mode 100644 compat/zlib/doc/rfc1951.txt create mode 100644 compat/zlib/doc/rfc1952.txt create mode 100644 compat/zlib/doc/txtvsbin.txt diff --git a/compat/zlib/CMakeLists.txt b/compat/zlib/CMakeLists.txt index 7f1b69f..15ceebe 100644 --- a/compat/zlib/CMakeLists.txt +++ b/compat/zlib/CMakeLists.txt @@ -3,7 +3,9 @@ set(CMAKE_ALLOW_LOOSE_LOOP_CONSTRUCTS ON) project(zlib C) -set(VERSION "1.3") +set(VERSION "1.3.1") + +option(ZLIB_BUILD_EXAMPLES "Enable Zlib Examples" ON) set(INSTALL_BIN_DIR "${CMAKE_INSTALL_PREFIX}/bin" CACHE PATH "Installation directory for executables") set(INSTALL_LIB_DIR "${CMAKE_INSTALL_PREFIX}/lib" CACHE PATH "Installation directory for libraries") @@ -148,7 +150,9 @@ if(MINGW) endif(MINGW) add_library(zlib SHARED ${ZLIB_SRCS} ${ZLIB_DLL_SRCS} ${ZLIB_PUBLIC_HDRS} ${ZLIB_PRIVATE_HDRS}) +target_include_directories(zlib PUBLIC ${CMAKE_CURRENT_BINARY_DIR} ${CMAKE_CURRENT_SOURCE_DIR}) add_library(zlibstatic STATIC ${ZLIB_SRCS} ${ZLIB_PUBLIC_HDRS} ${ZLIB_PRIVATE_HDRS}) +target_include_directories(zlibstatic PUBLIC ${CMAKE_CURRENT_BINARY_DIR} ${CMAKE_CURRENT_SOURCE_DIR}) set_target_properties(zlib PROPERTIES DEFINE_SYMBOL ZLIB_DLL) set_target_properties(zlib PROPERTIES SOVERSION 1) @@ -166,7 +170,7 @@ endif() if(UNIX) # On unix-like platforms the library is almost always called libz set_target_properties(zlib zlibstatic PROPERTIES OUTPUT_NAME z) - if(NOT APPLE) + if(NOT APPLE AND NOT(CMAKE_SYSTEM_NAME STREQUAL AIX)) set_target_properties(zlib PROPERTIES LINK_FLAGS "-Wl,--version-script,\"${CMAKE_CURRENT_SOURCE_DIR}/zlib.map\"") endif() elseif(BUILD_SHARED_LIBS AND WIN32) @@ -193,21 +197,22 @@ endif() #============================================================================ # Example binaries #============================================================================ - -add_executable(example test/example.c) -target_link_libraries(example zlib) -add_test(example example) - -add_executable(minigzip test/minigzip.c) -target_link_libraries(minigzip zlib) - -if(HAVE_OFF64_T) - add_executable(example64 test/example.c) - target_link_libraries(example64 zlib) - set_target_properties(example64 PROPERTIES COMPILE_FLAGS "-D_FILE_OFFSET_BITS=64") - add_test(example64 example64) - - add_executable(minigzip64 test/minigzip.c) - target_link_libraries(minigzip64 zlib) - set_target_properties(minigzip64 PROPERTIES COMPILE_FLAGS "-D_FILE_OFFSET_BITS=64") +if(ZLIB_BUILD_EXAMPLES) + add_executable(example test/example.c) + target_link_libraries(example zlib) + add_test(example example) + + add_executable(minigzip test/minigzip.c) + target_link_libraries(minigzip zlib) + + if(HAVE_OFF64_T) + add_executable(example64 test/example.c) + target_link_libraries(example64 zlib) + set_target_properties(example64 PROPERTIES COMPILE_FLAGS "-D_FILE_OFFSET_BITS=64") + add_test(example64 example64) + + add_executable(minigzip64 test/minigzip.c) + target_link_libraries(minigzip64 zlib) + set_target_properties(minigzip64 PROPERTIES COMPILE_FLAGS "-D_FILE_OFFSET_BITS=64") + endif() endif() diff --git a/compat/zlib/ChangeLog b/compat/zlib/ChangeLog index 8707988..b801a10 100644 --- a/compat/zlib/ChangeLog +++ b/compat/zlib/ChangeLog @@ -1,6 +1,16 @@ ChangeLog file for zlib +Changes in 1.3.1 (22 Jan 2024) +- Reject overflows of zip header fields in minizip +- Fix bug in inflateSync() for data held in bit buffer +- Add LIT_MEM define to use more memory for a small deflate speedup +- Fix decision on the emission of Zip64 end records in minizip +- Add bounds checking to ERR_MSG() macro, used by zError() +- Neutralize zip file traversal attacks in miniunz +- Fix a bug in ZLIB_DEBUG compiles in check_match() +- Various portability and appearance improvements + Changes in 1.3 (18 Aug 2023) - Remove K&R function definitions and zlib2ansi - Fix bug in deflateBound() for level 0 and memLevel 9 diff --git a/compat/zlib/FAQ b/compat/zlib/FAQ index 55f1cdc..92f5d3e 100644 --- a/compat/zlib/FAQ +++ b/compat/zlib/FAQ @@ -14,8 +14,7 @@ The latest zlib FAQ is at http://zlib.net/zlib_faq.html 2. Where can I get a Windows DLL version? The zlib sources can be compiled without change to produce a DLL. See the - file win32/DLL_FAQ.txt in the zlib distribution. Pointers to the - precompiled DLL are found in the zlib web site at http://zlib.net/ . + file win32/DLL_FAQ.txt in the zlib distribution. 3. Where can I get a Visual Basic interface to zlib? diff --git a/compat/zlib/LICENSE b/compat/zlib/LICENSE new file mode 100644 index 0000000..ab8ee6f --- /dev/null +++ b/compat/zlib/LICENSE @@ -0,0 +1,22 @@ +Copyright notice: + + (C) 1995-2022 Jean-loup Gailly and Mark Adler + + This software is provided 'as-is', without any express or implied + warranty. In no event will the authors be held liable for any damages + arising from the use of this software. + + Permission is granted to anyone to use this software for any purpose, + including commercial applications, and to alter it and redistribute it + freely, subject to the following restrictions: + + 1. The origin of this software must not be misrepresented; you must not + claim that you wrote the original software. If you use this software + in a product, an acknowledgment in the product documentation would be + appreciated but is not required. + 2. Altered source versions must be plainly marked as such, and must not be + misrepresented as being the original software. + 3. This notice may not be removed or altered from any source distribution. + + Jean-loup Gailly Mark Adler + jloup@gzip.org madler@alumni.caltech.edu diff --git a/compat/zlib/Makefile.in b/compat/zlib/Makefile.in index 34d3cd7..cb8b00a 100644 --- a/compat/zlib/Makefile.in +++ b/compat/zlib/Makefile.in @@ -1,5 +1,5 @@ # Makefile for zlib -# Copyright (C) 1995-2017 Jean-loup Gailly, Mark Adler +# Copyright (C) 1995-2024 Jean-loup Gailly, Mark Adler # For conditions of distribution and use, see copyright notice in zlib.h # To compile and test, type: @@ -22,13 +22,13 @@ CFLAGS=-O SFLAGS=-O LDFLAGS= -TEST_LDFLAGS=$(LDFLAGS) -L. libz.a +TEST_LIBS=-L. libz.a LDSHARED=$(CC) CPP=$(CC) -E STATICLIB=libz.a SHAREDLIB=libz.so -SHAREDLIBV=libz.so.1.3 +SHAREDLIBV=libz.so.1.3.1 SHAREDLIBM=libz.so.1 LIBS=$(STATICLIB) $(SHAREDLIBV) @@ -282,10 +282,10 @@ placebo $(SHAREDLIBV): $(PIC_OBJS) libz.a -@rmdir objs example$(EXE): example.o $(STATICLIB) - $(CC) $(CFLAGS) -o $@ example.o $(TEST_LDFLAGS) + $(CC) $(CFLAGS) $(LDFLAGS) -o $@ example.o $(TEST_LIBS) minigzip$(EXE): minigzip.o $(STATICLIB) - $(CC) $(CFLAGS) -o $@ minigzip.o $(TEST_LDFLAGS) + $(CC) $(CFLAGS) $(LDFLAGS) -o $@ minigzip.o $(TEST_LIBS) examplesh$(EXE): example.o $(SHAREDLIBV) $(CC) $(CFLAGS) -o $@ example.o $(LDFLAGS) -L. $(SHAREDLIBV) @@ -294,10 +294,10 @@ minigzipsh$(EXE): minigzip.o $(SHAREDLIBV) $(CC) $(CFLAGS) -o $@ minigzip.o $(LDFLAGS) -L. $(SHAREDLIBV) example64$(EXE): example64.o $(STATICLIB) - $(CC) $(CFLAGS) -o $@ example64.o $(TEST_LDFLAGS) + $(CC) $(CFLAGS) $(LDFLAGS) -o $@ example64.o $(TEST_LIBS) minigzip64$(EXE): minigzip64.o $(STATICLIB) - $(CC) $(CFLAGS) -o $@ minigzip64.o $(TEST_LDFLAGS) + $(CC) $(CFLAGS) $(LDFLAGS) -o $@ minigzip64.o $(TEST_LIBS) install-libs: $(LIBS) -@if [ ! -d $(DESTDIR)$(exec_prefix) ]; then mkdir -p $(DESTDIR)$(exec_prefix); fi @@ -360,7 +360,7 @@ zconf: $(SRCDIR)zconf.h.in cp -p $(SRCDIR)zconf.h.in zconf.h minizip-test: static - cd contrib/minizip && { CFLAGS="$(CFLAGS)" $(MAKE) test ; cd ../.. ; } + cd contrib/minizip && { CC="$(CC)" CFLAGS="$(CFLAGS)" $(MAKE) test ; cd ../.. ; } minizip-clean: cd contrib/minizip && { $(MAKE) clean ; cd ../.. ; } diff --git a/compat/zlib/README b/compat/zlib/README index e02fc5a..c5f9175 100644 --- a/compat/zlib/README +++ b/compat/zlib/README @@ -1,6 +1,6 @@ ZLIB DATA COMPRESSION LIBRARY -zlib 1.3 is a general purpose data compression library. All the code is +zlib 1.3.1 is a general purpose data compression library. All the code is thread safe. The data format used by the zlib library is described by RFCs (Request for Comments) 1950 to 1952 in the files http://tools.ietf.org/html/rfc1950 (zlib format), rfc1951 (deflate format) and @@ -31,7 +31,7 @@ Mark Nelson wrote an article about zlib for the Jan. 1997 issue of Dr. Dobb's Journal; a copy of the article is available at https://marknelson.us/posts/1997/01/01/zlib-engine.html . -The changes made in version 1.3 are documented in the file ChangeLog. +The changes made in version 1.3.1 are documented in the file ChangeLog. Unsupported third party contributions are provided in directory contrib/ . @@ -83,7 +83,7 @@ Acknowledgments: Copyright notice: - (C) 1995-2023 Jean-loup Gailly and Mark Adler + (C) 1995-2024 Jean-loup Gailly and Mark Adler This software is provided 'as-is', without any express or implied warranty. In no event will the authors be held liable for any damages diff --git a/compat/zlib/configure b/compat/zlib/configure index cc867c9..c55098a 100755 --- a/compat/zlib/configure +++ b/compat/zlib/configure @@ -25,7 +25,7 @@ if test $SRCDIR = "."; then ZINCOUT="-I." SRCDIR="" else - ZINC='-include zconf.h' + ZINC='-I. -include zconf.h' ZINCOUT='-I. -I$(SRCDIR)' SRCDIR="$SRCDIR/" fi @@ -44,7 +44,8 @@ STATICLIB=libz.a # extract zlib version numbers from zlib.h VER=`sed -n -e '/VERSION "/s/.*"$.*$".*/\1/p' < ${SRCDIR}zlib.h` -VER1=`sed -n -e '/VERSION "/s/.*"$[0-9]*$\\..*/\1/p' < ${SRCDIR}zlib.h` +VER3=`echo ${VER}|sed -n -e 's/$[0-9]\{1,\}\(\\.[0-9]\{1,\}$\{1,2\}\).*/\1/p'` +VER1=`echo ${VER}|sed -n -e 's/$[0-9]\{1,\}$\\..*/\1/p'` # establish commands for library building if "${CROSS_PREFIX}ar" --version >/dev/null 2>/dev/null || test $? -lt 126; then @@ -263,7 +264,7 @@ if test "$gcc" -eq 1 && ($cc -c $test.c) >> configure.log 2>&1; then SHAREDLIB=libz$shared_ext SHAREDLIBV=libz.$VER$shared_ext SHAREDLIBM=libz.$VER1$shared_ext - LDSHARED=${LDSHARED-"$cc -dynamiclib -install_name $libdir/$SHAREDLIBM -compatibility_version $VER1 -current_version $VER"} + LDSHARED=${LDSHARED-"$cc -dynamiclib -install_name $libdir/$SHAREDLIBM -compatibility_version $VER1 -current_version $VER3"} if "${CROSS_PREFIX}libtool" -V 2>&1 | grep Apple > /dev/null; then AR="${CROSS_PREFIX}libtool" elif libtool -V 2>&1 | grep Apple > /dev/null; then @@ -441,7 +442,7 @@ EOF if test $shared -eq 1; then echo Checking for shared library support... | tee -a configure.log # we must test in two steps (cc then ld), required at least on SunOS 4.x - if try $CC -w -c $SFLAGS $test.c && + if try $CC -c $SFLAGS $test.c && try $LDSHARED $SFLAGS -o $test$shared_ext $test.o; then echo Building shared library $SHAREDLIBV with $CC. | tee -a configure.log elif test -z "$old_cc" -a -z "$old_cflags"; then diff --git a/compat/zlib/contrib/delphi/ZLib.pas b/compat/zlib/contrib/delphi/ZLib.pas index 814ffa6..93fa4c9 100644 --- a/compat/zlib/contrib/delphi/ZLib.pas +++ b/compat/zlib/contrib/delphi/ZLib.pas @@ -152,7 +152,7 @@ procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer; const OutBuf: Pointer; BufSize: Integer); const - zlib_version = '1.3.0'; + zlib_version = '1.3.1'; type EZlibError = class(Exception); diff --git a/compat/zlib/contrib/dotzlib/DotZLib/ChecksumImpl.cs b/compat/zlib/contrib/dotzlib/DotZLib/ChecksumImpl.cs index 4b2eee2..3149653 100644 --- a/compat/zlib/contrib/dotzlib/DotZLib/ChecksumImpl.cs +++ b/compat/zlib/contrib/dotzlib/DotZLib/ChecksumImpl.cs @@ -1,202 +1,202 @@ -// -// © Copyright Henrik Ravn 2004 -// -// Use, modification and distribution are subject to the Boost Software License, Version 1.0. -// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) -// - -using System; -using System.Runtime.InteropServices; -using System.Text; - - -namespace DotZLib -{ - #region ChecksumGeneratorBase - ///

- /// - public abstract class ChecksumGeneratorBase : ChecksumGenerator - { - ///

- protected uint _current; - - ///

- public ChecksumGeneratorBase() - { - _current = 0; - } - - ///

- /// The value to set the current checksum to - public ChecksumGeneratorBase(uint initialValue) - { - _current = initialValue; - } - - ///

- public void Reset() { _current = 0; } - - ///

- public uint Value { get { return _current; } } - - ///

- /// The data to update the checksum with - /// Where in to start updating - /// The number of bytes from to use - /// - /// - /// - /// - public abstract void Update(byte[] data, int offset, int count); - - ///

- /// The data to update the checksum with - public void Update(byte[] data) - { - Update(data, 0, data.Length); - } - - ///

- /// The string to update the checksum with - /// - public void Update(string data) - { - Update(Encoding.UTF8.GetBytes(data)); - } - - ///

- /// The string to update the checksum with - /// The encoding to use - public void Update(string data, Encoding encoding) - { - Update(encoding.GetBytes(data)); - } - - } - #endregion - - #region CRC32 - ///

- public sealed class CRC32Checksum : ChecksumGeneratorBase - { - #region DLL imports - - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] - private static extern uint crc32(uint crc, int data, uint length); - - #endregion - - ///

- public CRC32Checksum() : base() {} - - ///

- /// The value to set the current checksum to - public CRC32Checksum(uint initialValue) : base(initialValue) {} - - ///

- public sealed class AdlerChecksum : ChecksumGeneratorBase - { - #region DLL imports - - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] - private static extern uint adler32(uint adler, int data, uint length); - - #endregion - - ///

- public AdlerChecksum() : base() {} - - ///

- /// The value to set the current checksum to - public AdlerChecksum(uint initialValue) : base(initialValue) {} - - ///

- /// The data to update the checksum with - /// Where in to start updating - /// The number of bytes from to use - /// - /// - /// - public override void Update(byte[] data, int offset, int count) - { - if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); - if ((offset+count) > data.Length) throw new ArgumentException(); - GCHandle hData = GCHandle.Alloc(data, GCHandleType.Pinned); - try - { - _current = adler32(_current, hData.AddrOfPinnedObject().ToInt32()+offset, (uint)count); - } - finally - { - hData.Free(); - } - } - - } - #endregion - +// +// © Copyright Henrik Ravn 2004 +// +// Use, modification and distribution are subject to the Boost Software License, Version 1.0. +// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) +// + +using System; +using System.Runtime.InteropServices; +using System.Text; + + +namespace DotZLib +{ + #region ChecksumGeneratorBase + ///

+ /// + public abstract class ChecksumGeneratorBase : ChecksumGenerator + { + ///

+ protected uint _current; + + ///

+ public ChecksumGeneratorBase() + { + _current = 0; + } + + ///

+ /// The value to set the current checksum to + public ChecksumGeneratorBase(uint initialValue) + { + _current = initialValue; + } + + ///

+ public void Reset() { _current = 0; } + + ///

+ public uint Value { get { return _current; } } + + ///

+ /// The data to update the checksum with + /// Where in to start updating + /// The number of bytes from to use + /// + /// + /// + /// + public abstract void Update(byte[] data, int offset, int count); + + ///

+ /// The data to update the checksum with + public void Update(byte[] data) + { + Update(data, 0, data.Length); + } + + ///

+ /// The string to update the checksum with + /// + public void Update(string data) + { + Update(Encoding.UTF8.GetBytes(data)); + } + + ///

+ /// The string to update the checksum with + /// The encoding to use + public void Update(string data, Encoding encoding) + { + Update(encoding.GetBytes(data)); + } + + } + #endregion + + #region CRC32 + ///

+ public sealed class CRC32Checksum : ChecksumGeneratorBase + { + #region DLL imports + + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] + private static extern uint crc32(uint crc, int data, uint length); + + #endregion + + ///

+ public CRC32Checksum() : base() {} + + ///

+ /// The value to set the current checksum to + public CRC32Checksum(uint initialValue) : base(initialValue) {} + + ///

+ public sealed class AdlerChecksum : ChecksumGeneratorBase + { + #region DLL imports + + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] + private static extern uint adler32(uint adler, int data, uint length); + + #endregion + + ///

+ public AdlerChecksum() : base() {} + + ///

+ /// The value to set the current checksum to + public AdlerChecksum(uint initialValue) : base(initialValue) {} + + ///

+ /// The data to update the checksum with + /// Where in to start updating + /// The number of bytes from to use + /// + /// + /// + public override void Update(byte[] data, int offset, int count) + { + if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); + if ((offset+count) > data.Length) throw new ArgumentException(); + GCHandle hData = GCHandle.Alloc(data, GCHandleType.Pinned); + try + { + _current = adler32(_current, hData.AddrOfPinnedObject().ToInt32()+offset, (uint)count); + } + finally + { + hData.Free(); + } + } + + } + #endregion + } \ No newline at end of file diff --git a/compat/zlib/contrib/dotzlib/DotZLib/CircularBuffer.cs b/compat/zlib/contrib/dotzlib/DotZLib/CircularBuffer.cs index 3967e48..e7a88b9 100644 --- a/compat/zlib/contrib/dotzlib/DotZLib/CircularBuffer.cs +++ b/compat/zlib/contrib/dotzlib/DotZLib/CircularBuffer.cs @@ -1,83 +1,83 @@ -// -// © Copyright Henrik Ravn 2004 -// -// Use, modification and distribution are subject to the Boost Software License, Version 1.0. -// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) -// - -using System; -using System.Diagnostics; - -namespace DotZLib -{ - - ///

- internal class CircularBuffer - { - #region Private data - private int _capacity; - private int _head; - private int _tail; - private int _size; - private byte[] _buffer; - #endregion - - public CircularBuffer(int capacity) - { - Debug.Assert( capacity > 0 ); - _buffer = new byte[capacity]; - _capacity = capacity; - _head = 0; - _tail = 0; - _size = 0; - } - - public int Size { get { return _size; } } - - public int Put(byte[] source, int offset, int count) - { - Debug.Assert( count > 0 ); - int trueCount = Math.Min(count, _capacity - Size); - for (int i = 0; i < trueCount; ++i) - _buffer[(_tail+i) % _capacity] = source[offset+i]; - _tail += trueCount; - _tail %= _capacity; - _size += trueCount; - return trueCount; - } - - public bool Put(byte b) - { - if (Size == _capacity) // no room - return false; - _buffer[_tail++] = b; - _tail %= _capacity; - ++_size; - return true; - } - - public int Get(byte[] destination, int offset, int count) - { - int trueCount = Math.Min(count,Size); - for (int i = 0; i < trueCount; ++i) - destination[offset + i] = _buffer[(_head+i) % _capacity]; - _head += trueCount; - _head %= _capacity; - _size -= trueCount; - return trueCount; - } - - public int Get() - { - if (Size == 0) - return -1; - - int result = (int)_buffer[_head++ % _capacity]; - --_size; - return result; - } - - } -} +// +// © Copyright Henrik Ravn 2004 +// +// Use, modification and distribution are subject to the Boost Software License, Version 1.0. +// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) +// + +using System; +using System.Diagnostics; + +namespace DotZLib +{ + + ///

+ internal class CircularBuffer + { + #region Private data + private int _capacity; + private int _head; + private int _tail; + private int _size; + private byte[] _buffer; + #endregion + + public CircularBuffer(int capacity) + { + Debug.Assert( capacity > 0 ); + _buffer = new byte[capacity]; + _capacity = capacity; + _head = 0; + _tail = 0; + _size = 0; + } + + public int Size { get { return _size; } } + + public int Put(byte[] source, int offset, int count) + { + Debug.Assert( count > 0 ); + int trueCount = Math.Min(count, _capacity - Size); + for (int i = 0; i < trueCount; ++i) + _buffer[(_tail+i) % _capacity] = source[offset+i]; + _tail += trueCount; + _tail %= _capacity; + _size += trueCount; + return trueCount; + } + + public bool Put(byte b) + { + if (Size == _capacity) // no room + return false; + _buffer[_tail++] = b; + _tail %= _capacity; + ++_size; + return true; + } + + public int Get(byte[] destination, int offset, int count) + { + int trueCount = Math.Min(count,Size); + for (int i = 0; i < trueCount; ++i) + destination[offset + i] = _buffer[(_head+i) % _capacity]; + _head += trueCount; + _head %= _capacity; + _size -= trueCount; + return trueCount; + } + + public int Get() + { + if (Size == 0) + return -1; + + int result = (int)_buffer[_head++ % _capacity]; + --_size; + return result; + } + + } +} diff --git a/compat/zlib/contrib/dotzlib/DotZLib/CodecBase.cs b/compat/zlib/contrib/dotzlib/DotZLib/CodecBase.cs index 1c77cca..d03e740 100644 --- a/compat/zlib/contrib/dotzlib/DotZLib/CodecBase.cs +++ b/compat/zlib/contrib/dotzlib/DotZLib/CodecBase.cs @@ -1,198 +1,198 @@ -// -// © Copyright Henrik Ravn 2004 -// -// Use, modification and distribution are subject to the Boost Software License, Version 1.0. -// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) -// - -using System; -using System.Runtime.InteropServices; - -namespace DotZLib -{ - ///

- public abstract class CodecBase : Codec, IDisposable - { - - #region Data members - - ///

- internal ZStream _ztream = new ZStream(); - - ///

- protected bool _isDisposed = false; - - ///

- protected const int kBufferSize = 16384; - - private byte[] _outBuffer = new byte[kBufferSize]; - private byte[] _inBuffer = new byte[kBufferSize]; - - private GCHandle _hInput; - private GCHandle _hOutput; - - private uint _checksum = 0; - - #endregion - - ///

- public CodecBase() - { - try - { - _hInput = GCHandle.Alloc(_inBuffer, GCHandleType.Pinned); - _hOutput = GCHandle.Alloc(_outBuffer, GCHandleType.Pinned); - } - catch (Exception) - { - CleanUp(false); - throw; - } - } - - - #region Codec Members - - ///

- public event DataAvailableHandler DataAvailable; - - ///

- protected void OnDataAvailable() - { - if (_ztream.total_out > 0) - { - if (DataAvailable != null) - DataAvailable( _outBuffer, 0, (int)_ztream.total_out); - resetOutput(); - } - } - - ///

- /// Byte array containing the data to be added to the codec - /// - public void Add(byte[] data) - { - Add(data,0,data.Length); - } - - ///

- /// Byte array containing the data to be added to the codec - /// The index of the first byte to add from - /// The number of bytes to add - /// - /// - public abstract void Add(byte[] data, int offset, int count); - - ///

- /// - public abstract void Finish(); - - ///

- public uint Checksum { get { return _checksum; } } - - #endregion - - #region Destructor & IDisposable stuff - - ///

- ~CodecBase() - { - CleanUp(false); - } - - ///

- public void Dispose() - { - CleanUp(true); - } - - ///

- /// - protected abstract void CleanUp(); - - // performs the release of the handles and calls the derived CleanUp() - private void CleanUp(bool isDisposing) - { - if (!_isDisposed) - { - CleanUp(); - if (_hInput.IsAllocated) - _hInput.Free(); - if (_hOutput.IsAllocated) - _hOutput.Free(); - - _isDisposed = true; - } - } - - - #endregion - - #region Helper methods - - ///

- /// The byte array that contains the data to copy - /// The index of the first byte to copy - /// The number of bytes to copy from - protected void copyInput(byte[] data, int startIndex, int count) - { - Array.Copy(data, startIndex, _inBuffer,0, count); - _ztream.next_in = _hInput.AddrOfPinnedObject(); - _ztream.total_in = 0; - _ztream.avail_in = (uint)count; - - } - - ///

- protected void resetOutput() - { - _ztream.total_out = 0; - _ztream.avail_out = kBufferSize; - _ztream.next_out = _hOutput.AddrOfPinnedObject(); - } - - ///

- /// The new checksum value - protected void setChecksum(uint newSum) - { - _checksum = newSum; - } - #endregion - - } -} +// +// © Copyright Henrik Ravn 2004 +// +// Use, modification and distribution are subject to the Boost Software License, Version 1.0. +// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) +// + +using System; +using System.Runtime.InteropServices; + +namespace DotZLib +{ + ///

+ public abstract class CodecBase : Codec, IDisposable + { + + #region Data members + + ///

+ internal ZStream _ztream = new ZStream(); + + ///

+ protected bool _isDisposed = false; + + ///

+ protected const int kBufferSize = 16384; + + private byte[] _outBuffer = new byte[kBufferSize]; + private byte[] _inBuffer = new byte[kBufferSize]; + + private GCHandle _hInput; + private GCHandle _hOutput; + + private uint _checksum = 0; + + #endregion + + ///

+ public CodecBase() + { + try + { + _hInput = GCHandle.Alloc(_inBuffer, GCHandleType.Pinned); + _hOutput = GCHandle.Alloc(_outBuffer, GCHandleType.Pinned); + } + catch (Exception) + { + CleanUp(false); + throw; + } + } + + + #region Codec Members + + ///

+ public event DataAvailableHandler DataAvailable; + + ///

+ protected void OnDataAvailable() + { + if (_ztream.total_out > 0) + { + if (DataAvailable != null) + DataAvailable( _outBuffer, 0, (int)_ztream.total_out); + resetOutput(); + } + } + + ///

+ /// Byte array containing the data to be added to the codec + /// + public void Add(byte[] data) + { + Add(data,0,data.Length); + } + + ///

+ /// Byte array containing the data to be added to the codec + /// The index of the first byte to add from + /// The number of bytes to add + /// + /// + public abstract void Add(byte[] data, int offset, int count); + + ///

+ /// + public abstract void Finish(); + + ///

+ public uint Checksum { get { return _checksum; } } + + #endregion + + #region Destructor & IDisposable stuff + + ///

+ ~CodecBase() + { + CleanUp(false); + } + + ///

+ public void Dispose() + { + CleanUp(true); + } + + ///

+ /// + protected abstract void CleanUp(); + + // performs the release of the handles and calls the derived CleanUp() + private void CleanUp(bool isDisposing) + { + if (!_isDisposed) + { + CleanUp(); + if (_hInput.IsAllocated) + _hInput.Free(); + if (_hOutput.IsAllocated) + _hOutput.Free(); + + _isDisposed = true; + } + } + + + #endregion + + #region Helper methods + + ///

+ /// The byte array that contains the data to copy + /// The index of the first byte to copy + /// The number of bytes to copy from + protected void copyInput(byte[] data, int startIndex, int count) + { + Array.Copy(data, startIndex, _inBuffer,0, count); + _ztream.next_in = _hInput.AddrOfPinnedObject(); + _ztream.total_in = 0; + _ztream.avail_in = (uint)count; + + } + + ///

+ protected void resetOutput() + { + _ztream.total_out = 0; + _ztream.avail_out = kBufferSize; + _ztream.next_out = _hOutput.AddrOfPinnedObject(); + } + + ///

+ /// The new checksum value + protected void setChecksum(uint newSum) + { + _checksum = newSum; + } + #endregion + + } +} diff --git a/compat/zlib/contrib/dotzlib/DotZLib/Deflater.cs b/compat/zlib/contrib/dotzlib/DotZLib/Deflater.cs index 0f12498..778a679 100644 --- a/compat/zlib/contrib/dotzlib/DotZLib/Deflater.cs +++ b/compat/zlib/contrib/dotzlib/DotZLib/Deflater.cs @@ -1,106 +1,106 @@ -// -// © Copyright Henrik Ravn 2004 -// -// Use, modification and distribution are subject to the Boost Software License, Version 1.0. -// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) -// - -using System; -using System.Diagnostics; -using System.Runtime.InteropServices; - -namespace DotZLib -{ - - ///

- public sealed class Deflater : CodecBase - { - #region Dll imports - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl, CharSet=CharSet.Ansi)] - private static extern int deflateInit_(ref ZStream sz, int level, string vs, int size); - - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] - private static extern int deflate(ref ZStream sz, int flush); - - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] - private static extern int deflateReset(ref ZStream sz); - - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] - private static extern int deflateEnd(ref ZStream sz); - #endregion - - ///

- /// The compression level to use for this - public Deflater(CompressLevel level) : base() - { - int retval = deflateInit_(ref _ztream, (int)level, Info.Version, Marshal.SizeOf(_ztream)); - if (retval != 0) - throw new ZLibException(retval, "Could not initialize deflater"); - - resetOutput(); - } - - ///

- /// Byte array containing the data to be added to the codec - /// The index of the first byte to add from - /// The number of bytes to add - /// - public override void Add(byte[] data, int offset, int count) - { - if (data == null) throw new ArgumentNullException(); - if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); - if ((offset+count) > data.Length) throw new ArgumentException(); - - int total = count; - int inputIndex = offset; - int err = 0; - - while (err >= 0 && inputIndex < total) - { - copyInput(data, inputIndex, Math.Min(total - inputIndex, kBufferSize)); - while (err >= 0 && _ztream.avail_in > 0) - { - err = deflate(ref _ztream, (int)FlushTypes.None); - if (err == 0) - while (_ztream.avail_out == 0) - { - OnDataAvailable(); - err = deflate(ref _ztream, (int)FlushTypes.None); - } - inputIndex += (int)_ztream.total_in; - } - } - setChecksum( _ztream.adler ); - } - - - ///

- public override void Finish() - { - int err; - do - { - err = deflate(ref _ztream, (int)FlushTypes.Finish); - OnDataAvailable(); - } - while (err == 0); - setChecksum( _ztream.adler ); - deflateReset(ref _ztream); - resetOutput(); - } - - ///

- protected override void CleanUp() { deflateEnd(ref _ztream); } - - } -} +// +// © Copyright Henrik Ravn 2004 +// +// Use, modification and distribution are subject to the Boost Software License, Version 1.0. +// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) +// + +using System; +using System.Diagnostics; +using System.Runtime.InteropServices; + +namespace DotZLib +{ + + ///

+ public sealed class Deflater : CodecBase + { + #region Dll imports + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl, CharSet=CharSet.Ansi)] + private static extern int deflateInit_(ref ZStream sz, int level, string vs, int size); + + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] + private static extern int deflate(ref ZStream sz, int flush); + + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] + private static extern int deflateReset(ref ZStream sz); + + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] + private static extern int deflateEnd(ref ZStream sz); + #endregion + + ///

+ /// The compression level to use for this + public Deflater(CompressLevel level) : base() + { + int retval = deflateInit_(ref _ztream, (int)level, Info.Version, Marshal.SizeOf(_ztream)); + if (retval != 0) + throw new ZLibException(retval, "Could not initialize deflater"); + + resetOutput(); + } + + ///

+ /// Byte array containing the data to be added to the codec + /// The index of the first byte to add from + /// The number of bytes to add + /// + public override void Add(byte[] data, int offset, int count) + { + if (data == null) throw new ArgumentNullException(); + if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); + if ((offset+count) > data.Length) throw new ArgumentException(); + + int total = count; + int inputIndex = offset; + int err = 0; + + while (err >= 0 && inputIndex < total) + { + copyInput(data, inputIndex, Math.Min(total - inputIndex, kBufferSize)); + while (err >= 0 && _ztream.avail_in > 0) + { + err = deflate(ref _ztream, (int)FlushTypes.None); + if (err == 0) + while (_ztream.avail_out == 0) + { + OnDataAvailable(); + err = deflate(ref _ztream, (int)FlushTypes.None); + } + inputIndex += (int)_ztream.total_in; + } + } + setChecksum( _ztream.adler ); + } + + + ///

+ public override void Finish() + { + int err; + do + { + err = deflate(ref _ztream, (int)FlushTypes.Finish); + OnDataAvailable(); + } + while (err == 0); + setChecksum( _ztream.adler ); + deflateReset(ref _ztream); + resetOutput(); + } + + ///

+ protected override void CleanUp() { deflateEnd(ref _ztream); } + + } +} diff --git a/compat/zlib/contrib/dotzlib/DotZLib/DotZLib.cs b/compat/zlib/contrib/dotzlib/DotZLib/DotZLib.cs index dcd9118..a48ed49 100644 --- a/compat/zlib/contrib/dotzlib/DotZLib/DotZLib.cs +++ b/compat/zlib/contrib/dotzlib/DotZLib/DotZLib.cs @@ -1,288 +1,288 @@ -// -// © Copyright Henrik Ravn 2004 -// -// Use, modification and distribution are subject to the Boost Software License, Version 1.0. -// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) -// - -using System; -using System.IO; -using System.Runtime.InteropServices; -using System.Text; - - -namespace DotZLib -{ - - #region Internal types - - ///

- internal enum FlushTypes - { - None, Partial, Sync, Full, Finish, Block - } - - #region ZStream structure - // internal mapping of the zlib zstream structure for marshalling - [StructLayoutAttribute(LayoutKind.Sequential, Pack=4, Size=0, CharSet=CharSet.Ansi)] - internal struct ZStream - { - public IntPtr next_in; - public uint avail_in; - public uint total_in; - - public IntPtr next_out; - public uint avail_out; - public uint total_out; - - [MarshalAs(UnmanagedType.LPStr)] - string msg; - uint state; - - uint zalloc; - uint zfree; - uint opaque; - - int data_type; - public uint adler; - uint reserved; - } - - #endregion - - #endregion - - #region Public enums - ///

- public enum CompressLevel : int - { - ///

- Default = -1, - ///

- None = 0, - ///

- Best = 9, - ///

- Fastest = 1 - } - #endregion - - #region Exception classes - ///

- public class ZLibException : ApplicationException - { - ///

- /// The zlib error code that caused the exception - /// A message that (hopefully) describes the error - public ZLibException(int errorCode, string msg) : base(String.Format("ZLib error {0} {1}", errorCode, msg)) - { - } - - ///

- /// The zlib error code that caused the exception - public ZLibException(int errorCode) : base(String.Format("ZLib error {0}", errorCode)) - { - } - } - #endregion - - #region Interfaces - - ///

- public interface ChecksumGenerator - { - ///

- uint Value { get; } - - ///

- void Reset(); - - ///

- /// The data to update the checksum with - void Update(byte[] data); - - ///

- /// The data to update the checksum with - /// Where in to start updating - /// The number of bytes from to use - /// - /// - /// - void Update(byte[] data, int offset, int count); - - ///

- /// The string to update the checksum with - /// - void Update(string data); - - ///

- /// The string to update the checksum with - /// The encoding to use - void Update(string data, Encoding encoding); - } - - - ///

- /// - /// - /// - /// - public delegate void DataAvailableHandler(byte[] data, int startIndex, int count); - - ///

- public interface Codec - { - ///

- event DataAvailableHandler DataAvailable; - - ///

- /// Byte array containing the data to be added to the codec - /// - void Add(byte[] data); - - ///

- /// Byte array containing the data to be added to the codec - /// The index of the first byte to add from - /// The number of bytes to add - /// - void Add(byte[] data, int offset, int count); - - ///

- void Finish(); - - ///

- uint Checksum { get; } - - - } - - #endregion - - #region Classes - ///

- public class Info - { - #region DLL imports - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] - private static extern uint zlibCompileFlags(); - - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] - private static extern string zlibVersion(); - #endregion - - #region Private stuff - private uint _flags; - - // helper function that unpacks a bitsize mask - private static int bitSize(uint bits) - { - switch (bits) - { - case 0: return 16; - case 1: return 32; - case 2: return 64; - } - return -1; - } - #endregion - - ///

- public Info() - { - _flags = zlibCompileFlags(); - } - - ///

- public bool HasDebugInfo { get { return 0 != (_flags & 0x100); } } - - ///

- public bool UsesAssemblyCode { get { return 0 != (_flags & 0x200); } } - - ///

- public int SizeOfUInt { get { return bitSize(_flags & 3); } } - - ///

- public int SizeOfULong { get { return bitSize((_flags >> 2) & 3); } } - - ///

- public int SizeOfPointer { get { return bitSize((_flags >> 4) & 3); } } - - ///

- public int SizeOfOffset { get { return bitSize((_flags >> 6) & 3); } } - - ///

- public static string Version { get { return zlibVersion(); } } - } - - #endregion - -} +// +// © Copyright Henrik Ravn 2004 +// +// Use, modification and distribution are subject to the Boost Software License, Version 1.0. +// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) +// + +using System; +using System.IO; +using System.Runtime.InteropServices; +using System.Text; + + +namespace DotZLib +{ + + #region Internal types + + ///

+ internal enum FlushTypes + { + None, Partial, Sync, Full, Finish, Block + } + + #region ZStream structure + // internal mapping of the zlib zstream structure for marshalling + [StructLayoutAttribute(LayoutKind.Sequential, Pack=4, Size=0, CharSet=CharSet.Ansi)] + internal struct ZStream + { + public IntPtr next_in; + public uint avail_in; + public uint total_in; + + public IntPtr next_out; + public uint avail_out; + public uint total_out; + + [MarshalAs(UnmanagedType.LPStr)] + string msg; + uint state; + + uint zalloc; + uint zfree; + uint opaque; + + int data_type; + public uint adler; + uint reserved; + } + + #endregion + + #endregion + + #region Public enums + ///

+ public enum CompressLevel : int + { + ///

+ Default = -1, + ///

+ None = 0, + ///

+ Best = 9, + ///

+ Fastest = 1 + } + #endregion + + #region Exception classes + ///

+ public class ZLibException : ApplicationException + { + ///

+ /// The zlib error code that caused the exception + /// A message that (hopefully) describes the error + public ZLibException(int errorCode, string msg) : base(String.Format("ZLib error {0} {1}", errorCode, msg)) + { + } + + ///

+ /// The zlib error code that caused the exception + public ZLibException(int errorCode) : base(String.Format("ZLib error {0}", errorCode)) + { + } + } + #endregion + + #region Interfaces + + ///

+ public interface ChecksumGenerator + { + ///

+ uint Value { get; } + + ///

+ void Reset(); + + ///

+ /// The data to update the checksum with + void Update(byte[] data); + + ///

+ /// The data to update the checksum with + /// Where in to start updating + /// The number of bytes from to use + /// + /// + /// + void Update(byte[] data, int offset, int count); + + ///

+ /// The string to update the checksum with + /// + void Update(string data); + + ///

+ /// The string to update the checksum with + /// The encoding to use + void Update(string data, Encoding encoding); + } + + + ///

+ /// + /// + /// + /// + public delegate void DataAvailableHandler(byte[] data, int startIndex, int count); + + ///

+ public interface Codec + { + ///

+ event DataAvailableHandler DataAvailable; + + ///

+ /// Byte array containing the data to be added to the codec + /// + void Add(byte[] data); + + ///

+ /// Byte array containing the data to be added to the codec + /// The index of the first byte to add from + /// The number of bytes to add + /// + void Add(byte[] data, int offset, int count); + + ///

+ void Finish(); + + ///

+ uint Checksum { get; } + + + } + + #endregion + + #region Classes + ///

+ public class Info + { + #region DLL imports + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] + private static extern uint zlibCompileFlags(); + + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] + private static extern string zlibVersion(); + #endregion + + #region Private stuff + private uint _flags; + + // helper function that unpacks a bitsize mask + private static int bitSize(uint bits) + { + switch (bits) + { + case 0: return 16; + case 1: return 32; + case 2: return 64; + } + return -1; + } + #endregion + + ///

+ public Info() + { + _flags = zlibCompileFlags(); + } + + ///

+ public bool HasDebugInfo { get { return 0 != (_flags & 0x100); } } + + ///

+ public bool UsesAssemblyCode { get { return 0 != (_flags & 0x200); } } + + ///

+ public int SizeOfUInt { get { return bitSize(_flags & 3); } } + + ///

+ public int SizeOfULong { get { return bitSize((_flags >> 2) & 3); } } + + ///

+ public int SizeOfPointer { get { return bitSize((_flags >> 4) & 3); } } + + ///

+ public int SizeOfOffset { get { return bitSize((_flags >> 6) & 3); } } + + ///

+ public static string Version { get { return zlibVersion(); } } + } + + #endregion + +} diff --git a/compat/zlib/contrib/dotzlib/DotZLib/GZipStream.cs b/compat/zlib/contrib/dotzlib/DotZLib/GZipStream.cs index efacd4d..864fa43 100644 --- a/compat/zlib/contrib/dotzlib/DotZLib/GZipStream.cs +++ b/compat/zlib/contrib/dotzlib/DotZLib/GZipStream.cs @@ -1,301 +1,301 @@ -// -// © Copyright Henrik Ravn 2004 -// -// Use, modification and distribution are subject to the Boost Software License, Version 1.0. -// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) -// - -using System; -using System.IO; -using System.Runtime.InteropServices; - -namespace DotZLib -{ - ///

- public class GZipStream : Stream, IDisposable - { - #region Dll Imports - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl, CharSet=CharSet.Ansi)] - private static extern IntPtr gzopen(string name, string mode); - - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] - private static extern int gzclose(IntPtr gzFile); - - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] - private static extern int gzwrite(IntPtr gzFile, int data, int length); - - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] - private static extern int gzread(IntPtr gzFile, int data, int length); - - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] - private static extern int gzgetc(IntPtr gzFile); - - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] - private static extern int gzputc(IntPtr gzFile, int c); - - #endregion - - #region Private data - private IntPtr _gzFile; - private bool _isDisposed = false; - private bool _isWriting; - #endregion - - #region Constructors - ///

- /// The name of the compressed file to create - /// The compression level to use when adding data - /// - public GZipStream(string fileName, CompressLevel level) - { - _isWriting = true; - _gzFile = gzopen(fileName, String.Format("wb{0}", (int)level)); - if (_gzFile == IntPtr.Zero) - throw new ZLibException(-1, "Could not open " + fileName); - } - - ///

- /// The name of the file to open - /// - public GZipStream(string fileName) - { - _isWriting = false; - _gzFile = gzopen(fileName, "rb"); - if (_gzFile == IntPtr.Zero) - throw new ZLibException(-1, "Could not open " + fileName); - - } - #endregion - - #region Access properties - ///

- public override bool CanRead - { - get - { - return !_isWriting; - } - } - - - ///

- public override bool CanSeek - { - get - { - return false; - } - } - - ///

- public override bool CanWrite - { - get - { - return _isWriting; - } - } - #endregion - - #region Destructor & IDispose stuff - - ///

- ~GZipStream() - { - cleanUp(false); - } - - ///

- public void Dispose() - { - cleanUp(true); - } - - // Does the actual closing of the file handle. - private void cleanUp(bool isDisposing) - { - if (!_isDisposed) - { - gzclose(_gzFile); - _isDisposed = true; - } - } - #endregion - - #region Basic reading and writing - ///

- /// The destination data buffer - /// The index of the first destination byte in - /// The number of bytes requested - /// - /// - /// - /// - /// - /// - public override int Read(byte[] buffer, int offset, int count) - { - if (!CanRead) throw new NotSupportedException(); - if (buffer == null) throw new ArgumentNullException(); - if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); - if ((offset+count) > buffer.Length) throw new ArgumentException(); - if (_isDisposed) throw new ObjectDisposedException("GZipStream"); - - GCHandle h = GCHandle.Alloc(buffer, GCHandleType.Pinned); - int result; - try - { - result = gzread(_gzFile, h.AddrOfPinnedObject().ToInt32() + offset, count); - if (result < 0) - throw new IOException(); - } - finally - { - h.Free(); - } - return result; - } - - ///

- /// - public override int ReadByte() - { - if (!CanRead) throw new NotSupportedException(); - if (_isDisposed) throw new ObjectDisposedException("GZipStream"); - return gzgetc(_gzFile); - } - - ///

- /// - /// - /// - /// - /// - /// - /// - /// - public override void Write(byte[] buffer, int offset, int count) - { - if (!CanWrite) throw new NotSupportedException(); - if (buffer == null) throw new ArgumentNullException(); - if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); - if ((offset+count) > buffer.Length) throw new ArgumentException(); - if (_isDisposed) throw new ObjectDisposedException("GZipStream"); - - GCHandle h = GCHandle.Alloc(buffer, GCHandleType.Pinned); - try - { - int result = gzwrite(_gzFile, h.AddrOfPinnedObject().ToInt32() + offset, count); - if (result < 0) - throw new IOException(); - } - finally - { - h.Free(); - } - } - - ///

- /// The byte to add to the stream. - /// - /// - public override void WriteByte(byte value) - { - if (!CanWrite) throw new NotSupportedException(); - if (_isDisposed) throw new ObjectDisposedException("GZipStream"); - - int result = gzputc(_gzFile, (int)value); - if (result < 0) - throw new IOException(); - } - #endregion - - #region Position & length stuff - ///

- /// - /// - public override void SetLength(long value) - { - throw new NotSupportedException(); - } - - ///

- /// - /// - /// - /// - public override long Seek(long offset, SeekOrigin origin) - { - throw new NotSupportedException(); - } - - ///

- /// - public override void Flush() - { - // left empty on purpose - } - - ///

- /// - /// - public override long Position - { - get - { - throw new NotSupportedException(); - } - set - { - throw new NotSupportedException(); - } - } - - ///

- /// - /// - public override long Length - { - get - { - throw new NotSupportedException(); - } - } - #endregion - } -} +// +// © Copyright Henrik Ravn 2004 +// +// Use, modification and distribution are subject to the Boost Software License, Version 1.0. +// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) +// + +using System; +using System.IO; +using System.Runtime.InteropServices; + +namespace DotZLib +{ + ///

+ public class GZipStream : Stream, IDisposable + { + #region Dll Imports + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl, CharSet=CharSet.Ansi)] + private static extern IntPtr gzopen(string name, string mode); + + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] + private static extern int gzclose(IntPtr gzFile); + + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] + private static extern int gzwrite(IntPtr gzFile, int data, int length); + + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] + private static extern int gzread(IntPtr gzFile, int data, int length); + + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] + private static extern int gzgetc(IntPtr gzFile); + + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] + private static extern int gzputc(IntPtr gzFile, int c); + + #endregion + + #region Private data + private IntPtr _gzFile; + private bool _isDisposed = false; + private bool _isWriting; + #endregion + + #region Constructors + ///

+ /// The name of the compressed file to create + /// The compression level to use when adding data + /// + public GZipStream(string fileName, CompressLevel level) + { + _isWriting = true; + _gzFile = gzopen(fileName, String.Format("wb{0}", (int)level)); + if (_gzFile == IntPtr.Zero) + throw new ZLibException(-1, "Could not open " + fileName); + } + + ///

+ /// The name of the file to open + /// + public GZipStream(string fileName) + { + _isWriting = false; + _gzFile = gzopen(fileName, "rb"); + if (_gzFile == IntPtr.Zero) + throw new ZLibException(-1, "Could not open " + fileName); + + } + #endregion + + #region Access properties + ///

+ public override bool CanRead + { + get + { + return !_isWriting; + } + } + + + ///

+ public override bool CanSeek + { + get + { + return false; + } + } + + ///

+ public override bool CanWrite + { + get + { + return _isWriting; + } + } + #endregion + + #region Destructor & IDispose stuff + + ///

+ ~GZipStream() + { + cleanUp(false); + } + + ///

+ public void Dispose() + { + cleanUp(true); + } + + // Does the actual closing of the file handle. + private void cleanUp(bool isDisposing) + { + if (!_isDisposed) + { + gzclose(_gzFile); + _isDisposed = true; + } + } + #endregion + + #region Basic reading and writing + ///

+ /// The destination data buffer + /// The index of the first destination byte in + /// The number of bytes requested + /// + /// + /// + /// + /// + /// + public override int Read(byte[] buffer, int offset, int count) + { + if (!CanRead) throw new NotSupportedException(); + if (buffer == null) throw new ArgumentNullException(); + if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); + if ((offset+count) > buffer.Length) throw new ArgumentException(); + if (_isDisposed) throw new ObjectDisposedException("GZipStream"); + + GCHandle h = GCHandle.Alloc(buffer, GCHandleType.Pinned); + int result; + try + { + result = gzread(_gzFile, h.AddrOfPinnedObject().ToInt32() + offset, count); + if (result < 0) + throw new IOException(); + } + finally + { + h.Free(); + } + return result; + } + + ///

+ /// + public override int ReadByte() + { + if (!CanRead) throw new NotSupportedException(); + if (_isDisposed) throw new ObjectDisposedException("GZipStream"); + return gzgetc(_gzFile); + } + + ///

+ /// + /// + /// + /// + /// + /// + /// + /// + public override void Write(byte[] buffer, int offset, int count) + { + if (!CanWrite) throw new NotSupportedException(); + if (buffer == null) throw new ArgumentNullException(); + if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); + if ((offset+count) > buffer.Length) throw new ArgumentException(); + if (_isDisposed) throw new ObjectDisposedException("GZipStream"); + + GCHandle h = GCHandle.Alloc(buffer, GCHandleType.Pinned); + try + { + int result = gzwrite(_gzFile, h.AddrOfPinnedObject().ToInt32() + offset, count); + if (result < 0) + throw new IOException(); + } + finally + { + h.Free(); + } + } + + ///

+ /// The byte to add to the stream. + /// + /// + public override void WriteByte(byte value) + { + if (!CanWrite) throw new NotSupportedException(); + if (_isDisposed) throw new ObjectDisposedException("GZipStream"); + + int result = gzputc(_gzFile, (int)value); + if (result < 0) + throw new IOException(); + } + #endregion + + #region Position & length stuff + ///

+ /// + /// + public override void SetLength(long value) + { + throw new NotSupportedException(); + } + + ///

+ /// + /// + /// + /// + public override long Seek(long offset, SeekOrigin origin) + { + throw new NotSupportedException(); + } + + ///

+ /// + public override void Flush() + { + // left empty on purpose + } + + ///

+ /// + /// + public override long Position + { + get + { + throw new NotSupportedException(); + } + set + { + throw new NotSupportedException(); + } + } + + ///

+ /// + /// + public override long Length + { + get + { + throw new NotSupportedException(); + } + } + #endregion + } +} diff --git a/compat/zlib/contrib/dotzlib/DotZLib/Inflater.cs b/compat/zlib/contrib/dotzlib/DotZLib/Inflater.cs index e11b5b5..8e900ae 100644 --- a/compat/zlib/contrib/dotzlib/DotZLib/Inflater.cs +++ b/compat/zlib/contrib/dotzlib/DotZLib/Inflater.cs @@ -1,105 +1,105 @@ -// -// © Copyright Henrik Ravn 2004 -// -// Use, modification and distribution are subject to the Boost Software License, Version 1.0. -// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) -// - -using System; -using System.Diagnostics; -using System.Runtime.InteropServices; - -namespace DotZLib -{ - - ///

- public class Inflater : CodecBase - { - #region Dll imports - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl, CharSet=CharSet.Ansi)] - private static extern int inflateInit_(ref ZStream sz, string vs, int size); - - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] - private static extern int inflate(ref ZStream sz, int flush); - - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] - private static extern int inflateReset(ref ZStream sz); - - [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] - private static extern int inflateEnd(ref ZStream sz); - #endregion - - ///

- public Inflater() : base() - { - int retval = inflateInit_(ref _ztream, Info.Version, Marshal.SizeOf(_ztream)); - if (retval != 0) - throw new ZLibException(retval, "Could not initialize inflater"); - - resetOutput(); - } - - - ///

- /// Byte array containing the data to be added to the codec - /// The index of the first byte to add from - /// The number of bytes to add - /// - public override void Add(byte[] data, int offset, int count) - { - if (data == null) throw new ArgumentNullException(); - if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); - if ((offset+count) > data.Length) throw new ArgumentException(); - - int total = count; - int inputIndex = offset; - int err = 0; - - while (err >= 0 && inputIndex < total) - { - copyInput(data, inputIndex, Math.Min(total - inputIndex, kBufferSize)); - err = inflate(ref _ztream, (int)FlushTypes.None); - if (err == 0) - while (_ztream.avail_out == 0) - { - OnDataAvailable(); - err = inflate(ref _ztream, (int)FlushTypes.None); - } - - inputIndex += (int)_ztream.total_in; - } - setChecksum( _ztream.adler ); - } - - - ///

- public override void Finish() - { - int err; - do - { - err = inflate(ref _ztream, (int)FlushTypes.Finish); - OnDataAvailable(); - } - while (err == 0); - setChecksum( _ztream.adler ); - inflateReset(ref _ztream); - resetOutput(); - } - - ///

- protected override void CleanUp() { inflateEnd(ref _ztream); } - - - } -} +// +// © Copyright Henrik Ravn 2004 +// +// Use, modification and distribution are subject to the Boost Software License, Version 1.0. +// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt) +// + +using System; +using System.Diagnostics; +using System.Runtime.InteropServices; + +namespace DotZLib +{ + + ///

+ public class Inflater : CodecBase + { + #region Dll imports + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl, CharSet=CharSet.Ansi)] + private static extern int inflateInit_(ref ZStream sz, string vs, int size); + + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] + private static extern int inflate(ref ZStream sz, int flush); + + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] + private static extern int inflateReset(ref ZStream sz); + + [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)] + private static extern int inflateEnd(ref ZStream sz); + #endregion + + ///

+ public Inflater() : base() + { + int retval = inflateInit_(ref _ztream, Info.Version, Marshal.SizeOf(_ztream)); + if (retval != 0) + throw new ZLibException(retval, "Could not initialize inflater"); + + resetOutput(); + } + + + ///

+ /// Byte array containing the data to be added to the codec + /// The index of the first byte to add from + /// The number of bytes to add + /// + public override void Add(byte[] data, int offset, int count) + { + if (data == null) throw new ArgumentNullException(); + if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException(); + if ((offset+count) > data.Length) throw new ArgumentException(); + + int total = count; + int inputIndex = offset; + int err = 0; + + while (err >= 0 && inputIndex < total) + { + copyInput(data, inputIndex, Math.Min(total - inputIndex, kBufferSize)); + err = inflate(ref _ztream, (int)FlushTypes.None); + if (err == 0) + while (_ztream.avail_out == 0) + { + OnDataAvailable(); + err = inflate(ref _ztream, (int)FlushTypes.None); + } + + inputIndex += (int)_ztream.total_in; + } + setChecksum( _ztream.adler ); + } + + + ///

+ public override void Finish() + { + int err; + do + { + err = inflate(ref _ztream, (int)FlushTypes.Finish); + OnDataAvailable(); + } + while (err == 0); + setChecksum( _ztream.adler ); + inflateReset(ref _ztream); + resetOutput(); + } + + ///

+ protected override void CleanUp() { inflateEnd(ref _ztream); } + + + } +} diff --git a/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs b/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs index c5fce22..d4f0980 100644 --- a/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs +++ b/compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs @@ -156,7 +156,7 @@ namespace DotZLibTests public void Info_Version() { Info info = new Info(); - Assert.AreEqual("1.3.0", Info.Version); + Assert.AreEqual("1.3.1", Info.Version); Assert.AreEqual(32, info.SizeOfUInt); Assert.AreEqual(32, info.SizeOfULong); Assert.AreEqual(32, info.SizeOfPointer); diff --git a/compat/zlib/contrib/infback9/inftree9.c b/compat/zlib/contrib/infback9/inftree9.c index dc38f24..ac707ed 100644 --- a/compat/zlib/contrib/infback9/inftree9.c +++ b/compat/zlib/contrib/infback9/inftree9.c @@ -1,5 +1,5 @@ /* inftree9.c -- generate Huffman trees for efficient decoding - * Copyright (C) 1995-2023 Mark Adler + * Copyright (C) 1995-2024 Mark Adler * For conditions of distribution and use, see copyright notice in zlib.h */ @@ -9,7 +9,7 @@ #define MAXBITS 15 const char inflate9_copyright[] = - " inflate9 1.3 Copyright 1995-2023 Mark Adler "; + " inflate9 1.3.1 Copyright 1995-2024 Mark Adler "; /* If you use the zlib library in a product, an acknowledgment is welcome in the documentation of your product. If for some reason you cannot @@ -59,7 +59,7 @@ int inflate_table9(codetype type, unsigned short FAR *lens, unsigned codes, static const unsigned short lext[31] = { /* Length codes 257..285 extra */ 128, 128, 128, 128, 128, 128, 128, 128, 129, 129, 129, 129, 130, 130, 130, 130, 131, 131, 131, 131, 132, 132, 132, 132, - 133, 133, 133, 133, 144, 198, 203}; + 133, 133, 133, 133, 144, 203, 77}; static const unsigned short dbase[32] = { /* Distance codes 0..31 base */ 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, 257, 385, 513, 769, 1025, 1537, 2049, 3073, diff --git a/compat/zlib/contrib/infback9/inftree9.h b/compat/zlib/contrib/infback9/inftree9.h index 2c1252f..ab2ea28 100644 --- a/compat/zlib/contrib/infback9/inftree9.h +++ b/compat/zlib/contrib/infback9/inftree9.h @@ -41,8 +41,8 @@ typedef struct { examples/enough.c found in the zlib distribution. The arguments to that program are the number of symbols, the initial root table size, and the maximum bit length of a code. "enough 286 9 15" for literal/length codes - returns returns 852, and "enough 32 6 15" for distance codes returns 594. - The initial root table size (9 or 6) is found in the fifth argument of the + returns 852, and "enough 32 6 15" for distance codes returns 594. The + initial root table size (9 or 6) is found in the fifth argument of the inflate_table() calls in infback9.c. If the root table size is changed, then these maximum sizes would be need to be recalculated and updated. */ #define ENOUGH_LENS 852 diff --git a/compat/zlib/contrib/iostream3/zfstream.h b/compat/zlib/contrib/iostream3/zfstream.h index 8574479..3dabc0f 100644 --- a/compat/zlib/contrib/iostream3/zfstream.h +++ b/compat/zlib/contrib/iostream3/zfstream.h @@ -413,7 +413,7 @@ template