Tcl Source Code

1 January 1970, 00:00 UTC.  Note that the count of seconds does not
include any leap seconds; seconds are counted as if each UTC day has
exactly 86400 seconds.  Tcl responds to leap seconds by speeding or
slowing its clock by a tiny fraction for some minutes until it is
back in sync with UTC; its data model does not represent minutes that
have 59 or 61 seconds.
.TP
\fI\now\fR
Instead of \fItimeVal\fR a non-integer option \fI\now\fR can be used as
replacement for today, which is simply interpolated to the runt-time as value
of \fBclock seconds\fR. For example:
.sp
\fBclock format now -f %a; # current day of the week\fR
.sp
\fBclock add now 1 month; # next month\fR
.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,
for example, \fI3 seconds\fR or \fI1 year\fR.
.SS "OPTIONS"

    }

    /* Base (by scan or add) or clock value (by format) */

    if (opts->baseObj != NULL) {
	Tcl_Obj *baseObj = opts->baseObj;

	/* bypass integer recognition if looks like "now" or "-now" */
	if ((baseObj->bytes && 
		((baseObj->length == 3 && baseObj->bytes[0] == 'n') ||
		 (baseObj->length == 4 && baseObj->bytes[1] == 'n')))
		|| TclGetWideIntFromObj(NULL, baseObj, &baseVal) != TCL_OK) {
	    /* we accept "now" and "-now" as current date-time */
	    static const char *const nowOpts[] = {
		"now", "-now", NULL
	    };
	    int idx;

	    if (Tcl_GetIndexFromObj(NULL, baseObj, nowOpts, "seconds",
		    TCL_EXACT, &idx) == TCL_OK) {
		goto baseNow;
	    }

	    if (TclHasInternalRep(baseObj, &tclBignumType)) {
		goto baseOverflow;
	    }

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad seconds \"%s\": must be now or integer",
		TclGetString(baseObj)));
	    i = baseIdx;
	    goto badOption;
	}
	/*
	 * Seconds could be an unsigned number that overflowed. Make sure
	 * that it isn't. Additionally it may be too complex to calculate
	 * julianday etc (forwards/backwards) by too large/small values, thus

ClockFormatObjCmd(
    void *clientData,		/* Client data containing literal pool */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[])	/* Parameter values */
{
    ClockClientData *dataPtr = (ClockClientData *)clientData;
    static const char *syntax = "clock format clockval|now "
	    "?-format string? "
	    "?-gmt boolean? "
	    "?-locale LOCALE? ?-timezone ZONE?";
    int ret;
    ClockFmtScnCmdArgs opts;	/* Format, locale, timezone and base */
    DateFormat dateFmt;		/* Common structure used for formatting */

int
ClockAddObjCmd(
    void *clientData,		/* Client data containing literal pool */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[])	/* Parameter values */
{
    static const char *syntax = "clock add clockval|now ?number units?..."
	    "?-gmt boolean? "
	    "?-locale LOCALE? ?-timezone ZONE?";
    ClockClientData *dataPtr = (ClockClientData *)clientData;
    int ret;
    ClockFmtScnCmdArgs opts;	/* Format, locale, timezone and base */
    DateInfo yy;		/* Common structure used for parsing */
    DateInfo *info = &yy;

    set i [interp create]; # because clock can be used somewhere, test it in new interp:
} -body {
    $i eval {
	lappend ret ens:[namespace ensemble exists ::clock]
	clock seconds; # init ensemble (but not yet stubs, loading of clock.tcl retarded)
	lappend ret ens:[namespace ensemble exists ::clock]
	lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}]
	clock format now; # clock.tcl stubs expected
	lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}]
    }
} -cleanup {
    interp delete $i
} -result {ens:1 ens:1 stubs:0 stubs:1}
test clock-0.1a "initial: safe interpreter shares clock command with parent" -setup {
    set i [interp create]
    $i eval {set sci [interp create -safe]}
} -body {
    $i eval {
	lappend ret ens:[namespace ensemble exists ::clock]
	$sci eval { clock seconds }; # init ensemble (but not yet stubs, loading of clock.tcl retarded)
	lappend ret ens:[namespace ensemble exists ::clock]
	lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}]
	$sci eval { clock format now }; # clock.tcl stubs expected
	lappend ret stubs:[expr {[namespace which -command ::tcl::clock::GetSystemTimeZone] ne ""}]
    }
} -cleanup {
    interp delete $i
} -result {ens:1 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 "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 "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 "clock format $syntax"} {CLOCK wrongNumArgs}}]

test clock-1.1 "clock format - bad time" {
    list [catch {clock format foo} msg opt] $msg [dict getd $opt -errorcode {}]
} {1 {bad seconds "foo": must be now or integer} {CLOCK badOption foo}}

test clock-1.2 "clock format - bad gmt val" {
    list [catch {clock format 0 -gmt foo} msg] $msg
} {1 {expected boolean value but got "foo"}}

test clock-1.3 "clock format - empty val" {
    clock format 0 -gmt 1 -format ""

    clock format 0 -g true -f "%Y-%m-%d"
} 1970-01-01

test clock-1.7.1 "clock format - command abbreviations (compat regression test)" {
    clock f 0 -g 1 -f "%Y-%m-%d"
} 1970-01-01

test clock-1.8 "clock format now" {
    # give one second more for test (if on boundary of the current second):
    set n [clock format [clock seconds] -g 1 -f "%s"]
    expr {[clock format now -g 1 -f "%s"] in [list $n [incr n]]}
} 1

test clock-1.9 "clock arguments: option doubly present" {
    list [catch {clock format 0 -gmt 1 -gmt 0} result] $result
} {1 {bad option "-gmt": doubly present}}

test clock-1.10 {clock format: text with token (bug [a858d95f4bfddafb])} {

test clock-6.8 {input of seconds} {
    clock scan {9223372036854775807} -format %s -gmt true
} 9223372036854775807

test clock-6.8b "clock scan - bad base" {
    list [catch {clock scan "" -base foo -gmt 1} msg opt] $msg [dict getd $opt -errorcode {}]
} {1 {bad seconds "foo": must be now or integer} {CLOCK badOption foo}}

test clock-6.9 {input of seconds - overflow} {
    list [catch {clock scan -9223372036854775809 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""]
} {1 {integer value too large to represent} {CLOCK dateTooLarge}}
test clock-6.10 {input of seconds - overflow} {
    list [catch {clock scan 9223372036854775808 -format %s -gmt true} result opt] $result [dict getd $opt -errorcode ""]
} {1 {integer value too large to represent} {CLOCK dateTooLarge}}