Tcl Source Code

Changes On Branch tip-594
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch tip-594 Excluding Merge-Ins

This is equivalent to a diff from d19ee61498 to 450cb4123c

2022-09-25
19:34
TIP #594: Modernize "file stat" interface check-in: 132524dc2b user: jan.nijtmans tags: core-8-branch
2022-09-08
16:44
Merge http-bugfixes-2022H2 - workaround for bug [824251] (async client sockets block for DNS). check-in: 608f2fbab4 user: kjnash tags: core-8-branch
14:56
Merge 8.7 Closed-Leaf check-in: 3c1f042d02 user: jan.nijtmans tags: tip-220
14:56
Merge 8.7 check-in: 194684822d user: kjnash tags: http-bugfixes-2022H2
14:54
Merge 8.7 check-in: 5ed7ab6b87 user: jan.nijtmans tags: tip-618
14:53
Mrge 8.7. Make it work with C++, adapt win/Makefile.in to make it build on Windows with gcc check-in: d2353bc1fb user: jan.nijtmans tags: abstractlist-with-625
14:20
Merge 8.7 Closed-Leaf check-in: 49fe365e3e user: jan.nijtmans tags: rfe-655300
14:19
Merge 8.7 check-in: 04e160b7a7 user: jan.nijtmans tags: tip-629
14:18
Merge 8.7 check-in: 2d527d2c3e user: jan.nijtmans tags: tip-344
14:16
Merge 8.7 Closed-Leaf check-in: 450cb4123c user: jan.nijtmans tags: tip-594
14:14
Merge 8.7 check-in: eabc05de29 user: jan.nijtmans tags: trunk, main
14:06
Combine flags and testFlags in TcpState. That should unbreak socket testcase failure check-in: d19ee61498 user: jan.nijtmans tags: core-8-branch
13:01
Fix cmdAH-23.* testcases check-in: 4f957abf68 user: jan.nijtmans tags: tip-594
2022-09-07
07:42
Merge 8.6 check-in: cecb37eb5e user: jan.nijtmans tags: core-8-branch

Changes to doc/file.n.

247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
to absolute form.  When creating links on filesystems that either do not
support any links, or do not support the specific type requested, an
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
.TP
\fBfile lstat \fIname varName\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
refers to a symbolic link the information returned in \fIvarName\fR
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.
.TP
\fBfile mkdir\fR ?\fIdir\fR ...?
.
Creates each directory specified.  For each pathname \fIdir\fR specified,
this command will create all non-existing parent directories as
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






|



|
|
|
|







247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
to absolute form.  When creating links on filesystems that either do not
support any links, or do not support the specific type requested, an
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
.TP
\fBfile lstat \fIname ?varName?\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
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.
.TP
\fBfile mkdir\fR ?\fIdir\fR ...?
.
Creates each directory specified.  For each pathname \fIdir\fR specified,
this command will create all non-existing parent directories as
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
389
390
391
392
393
394
395
396
397
398
399

400

401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
returns
.QW \fB/\0\0foo\0\0./~bar\0\0baz\fR
to ensure that later commands
that use the third component do not attempt to perform tilde
substitution.
.RE
.TP
\fBfile stat \fIname varName\fR
.
Invokes the \fBstat\fR kernel call on \fIname\fR, and uses the variable
given by \fIvarName\fR to hold information returned from the kernel call.

\fIVarName\fR is treated as an array variable, and the following elements

of that variable are set: \fBatime\fR, \fBctime\fR, \fBdev\fR, \fBgid\fR,
\fBino\fR, \fBmode\fR, \fBmtime\fR, \fBnlink\fR, \fBsize\fR, \fBtype\fR,
\fBuid\fR.  Each element except \fBtype\fR is a decimal string with the
value of the corresponding 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.  This command returns an
empty string.
.TP
\fBfile system \fIname\fR
.
Returns a list of one or two elements, the first of which is the name of
the filesystem to use for the file, and the second, if given, an
arbitrary string representing the filesystem-specific nature or type of
the location within that filesystem.  If a filesystem only supports one






|

|
|
>
|
>
|
|
|
|
|
|
|
<







389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409

410
411
412
413
414
415
416
returns
.QW \fB/\0\0foo\0\0./~bar\0\0baz\fR
to ensure that later commands
that use the third component do not attempt to perform tilde
substitution.
.RE
.TP
\fBfile stat \fIname ?varName?\fR
.
Invokes the \fBstat\fR kernel call on \fIname\fR, and returns a
dictionary with the information returned from the kernel call. If
\fIvarName\fR is given, it uses the variable to hold the information.
\fIVarName\fR is treated as an array variable, and in such case the
command returns the empty string. The following elements are set:
\fBatime\fR, \fBctime\fR, \fBdev\fR, \fBgid\fR, \fBino\fR, \fBmode\fR,
\fBmtime\fR, \fBnlink\fR, \fBsize\fR, \fBtype\fR, \fBuid\fR.  Each element
except \fBtype\fR is a decimal string with the value of the corresponding
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.

.TP
\fBfile system \fIname\fR
.
Returns a list of one or two elements, the first of which is the name of
the filesystem to use for the file, and the second, if given, an
arbitrary string representing the filesystem-specific nature or type of
the location within that filesystem.  If a filesystem only supports one

Changes to generic/tclCmdAH.c.

1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418



1419

1420
1421
1422
1423
1424
1425
1426
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name varName");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }



    return StoreStatData(interp, objv[2], &buf);

}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrStatCmd --
 *






|
|





>
>
>
|
>







1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?varName?");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
    if (objc == 2) {
	return StoreStatData(interp, NULL, &buf);
    } else {
	return StoreStatData(interp, objv[2], &buf);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrStatCmd --
 *
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454



1455

1456
1457
1458
1459
1460
1461
1462
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name varName");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }



    return StoreStatData(interp, objv[2], &buf);

}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrTypeCmd --
 *






|
|





>
>
>
|
>







1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?varName?");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
    if (objc == 2) {
	return StoreStatData(interp, NULL, &buf);
    } else {
	return StoreStatData(interp, objv[2], &buf);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrTypeCmd --
 *
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376































2377
2378
2379
2380
2381
2382
2383
/*
 *----------------------------------------------------------------------
 *
 * StoreStatData --
 *
 *	This is a utility procedure that breaks out the fields of a "stat"
 *	structure and stores them in textual form into the elements of an
 *	associative array.
 *
 * Results:
 *	Returns a standard Tcl return value. If an error occurs then a message
 *	is left in interp's result.
 *
 * Side effects:
 *	Elements of the associative array given by "varName" are modified.
 *
 *----------------------------------------------------------------------
 */

static int
StoreStatData(
    Tcl_Interp *interp,		/* Interpreter for error reports. */
    Tcl_Obj *varName,		/* Name of associative array variable in which
				 * to store stat results. */
    Tcl_StatBuf *statPtr)	/* Pointer to buffer containing stat data to
				 * store in varName. */
{
    Tcl_Obj *field, *value;
    unsigned short mode;
































    /*
     * Assume Tcl_ObjSetVar2() does not keep a copy of the field name!
     *
     * Might be a better idea to call Tcl_SetVar2Ex() instead, except we want
     * to have an object (i.e. possibly cached) array variable name but a
     * string element name, so no API exists. Messy.






|



















|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
/*
 *----------------------------------------------------------------------
 *
 * StoreStatData --
 *
 *	This is a utility procedure that breaks out the fields of a "stat"
 *	structure and stores them in textual form into the elements of an
 *	associative array (if given) or returns a dictionary.
 *
 * Results:
 *	Returns a standard Tcl return value. If an error occurs then a message
 *	is left in interp's result.
 *
 * Side effects:
 *	Elements of the associative array given by "varName" are modified.
 *
 *----------------------------------------------------------------------
 */

static int
StoreStatData(
    Tcl_Interp *interp,		/* Interpreter for error reports. */
    Tcl_Obj *varName,		/* Name of associative array variable in which
				 * to store stat results. */
    Tcl_StatBuf *statPtr)	/* Pointer to buffer containing stat data to
				 * store in varName. */
{
    Tcl_Obj *field, *value, *result;
    unsigned short mode;

    if (varName == NULL) {
        result = Tcl_NewObj();
        Tcl_IncrRefCount(result);
#define DOBJPUT(key, objValue)                  \
        Tcl_DictObjPut(NULL, result,            \
            Tcl_NewStringObj((key), -1),        \
            (objValue));
        DOBJPUT("dev",	Tcl_NewWideIntObj((long)statPtr->st_dev));
        DOBJPUT("ino",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
        DOBJPUT("nlink",	Tcl_NewWideIntObj((long)statPtr->st_nlink));
        DOBJPUT("uid",	Tcl_NewWideIntObj((long)statPtr->st_uid));
        DOBJPUT("gid",	Tcl_NewWideIntObj((long)statPtr->st_gid));
        DOBJPUT("size",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
        DOBJPUT("blocks",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
        DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
#endif
        DOBJPUT("atime",	Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
        DOBJPUT("mtime",	Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
        DOBJPUT("ctime",	Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
        mode = (unsigned short) statPtr->st_mode;
        DOBJPUT("mode",	Tcl_NewWideIntObj(mode));
        DOBJPUT("type",	Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef DOBJPUT
        Tcl_SetObjResult(interp, result);
        Tcl_DecrRefCount(result);
        return TCL_OK;
    }

    /*
     * Assume Tcl_ObjSetVar2() does not keep a copy of the field name!
     *
     * Might be a better idea to call Tcl_SetVar2Ex() instead, except we want
     * to have an object (i.e. possibly cached) array variable name but a
     * string element name, so no API exists. Messy.

Changes to tests/cmdAH.test.

1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
test cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile $dirfile} 0

# lstat and readlink: don't run these tests everywhere, since not all sites
# will have symbolic links
catch {file link -symbolic $linkfile $gorpfile}
test cmdAH-23.1 {Tcl_FileObjCmd: lstat} -returnCodes error -body {
    file lstat a
} -result {wrong # args: should be "file lstat name varName"}
test cmdAH-23.2 {Tcl_FileObjCmd: lstat} -returnCodes error -body {
    file lstat a b c
} -result {wrong # args: should be "file lstat name varName"}
test cmdAH-23.3 {Tcl_FileObjCmd: lstat} -setup {
    unset -nocomplain stat
} -constraints {unix nonPortable} -body {
    file lstat $linkfile stat
    lsort [array names stat]
} -result {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-23.4 {Tcl_FileObjCmd: lstat} -setup {






|


|







1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
test cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile $dirfile} 0

# lstat and readlink: don't run these tests everywhere, since not all sites
# will have symbolic links
catch {file link -symbolic $linkfile $gorpfile}
test cmdAH-23.1 {Tcl_FileObjCmd: lstat} -returnCodes error -body {
    file lstat a
} -result {could not read "a": no such file or directory}
test cmdAH-23.2 {Tcl_FileObjCmd: lstat} -returnCodes error -body {
    file lstat a b c
} -result {wrong # args: should be "file lstat name ?varName?"}
test cmdAH-23.3 {Tcl_FileObjCmd: lstat} -setup {
    unset -nocomplain stat
} -constraints {unix nonPortable} -body {
    file lstat $linkfile stat
    lsort [array names stat]
} -result {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-23.4 {Tcl_FileObjCmd: lstat} -setup {
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
catch {testsetplatform $platform}
removeFile $gorpfile
set gorpfile [makeFile "Test string" gorp.file]
catch {file attributes $gorpfile -permissions 0o765}

# stat
test cmdAH-28.1 {Tcl_FileObjCmd: stat} -returnCodes error -body {
    file stat _bogus_
} -result {wrong # args: should be "file stat name varName"}
test cmdAH-28.2 {Tcl_FileObjCmd: stat} -returnCodes error -body {
    file stat _bogus_ a b
} -result {wrong # args: should be "file stat name varName"}
test cmdAH-28.3 {Tcl_FileObjCmd: stat} -setup {
    unset -nocomplain stat
    set stat(blocks) [set stat(blksize) {}]
} -body {
    file stat $gorpfile stat
    unset stat(blocks) stat(blksize); # Ignore these fields; not always set
    lsort [array names stat]
} -result {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-28.4 {Tcl_FileObjCmd: stat} -setup {
    unset -nocomplain stat






|
|


|


|







1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
catch {testsetplatform $platform}
removeFile $gorpfile
set gorpfile [makeFile "Test string" gorp.file]
catch {file attributes $gorpfile -permissions 0o765}

# stat
test cmdAH-28.1 {Tcl_FileObjCmd: stat} -returnCodes error -body {
    file stat
} -result {wrong # args: should be "file stat name ?varName?"}
test cmdAH-28.2 {Tcl_FileObjCmd: stat} -returnCodes error -body {
    file stat _bogus_ a b
} -result {wrong # args: should be "file stat name ?varName?"}
test cmdAH-28.3 {Tcl_FileObjCmd: stat} -setup {
    unset -nocomplain stat
    array set stat {blocks {} blksize {}}
} -body {
    file stat $gorpfile stat
    unset stat(blocks) stat(blksize); # Ignore these fields; not always set
    lsort [array names stat]
} -result {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-28.4 {Tcl_FileObjCmd: stat} -setup {
    unset -nocomplain stat
1623
1624
1625
1626
1627
1628
1629










1630
1631
1632
1633
1634
1635
1636
	file stat [file join [temporaryDirectory] CON.txt] stat
	set res [lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}]
    } trap {POSIX ENOENT} {} {
	set res {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
    }
    set res
} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}










unset -nocomplain stat

# type
test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body {
    file type a b
} -result {wrong # args: should be "file type name"}
test cmdAH-29.2 {Tcl_FileObjCmd: type} {






>
>
>
>
>
>
>
>
>
>







1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
	file stat [file join [temporaryDirectory] CON.txt] stat
	set res [lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}]
    } trap {POSIX ENOENT} {} {
	set res {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
    }
    set res
} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
test cmdAH-28.14 {Tcl_FileObjCmd: stat} -setup {
    unset -nocomplain stat
} -body {
    file stat $gorpfile stat
    expr {
		[lsort -stride 2 [array get stat]]
		eq
		[lsort -stride 2 [file stat $gorpfile]]
	}
} -result {1}
unset -nocomplain stat

# type
test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body {
    file type a b
} -result {wrong # args: should be "file type name"}
test cmdAH-29.2 {Tcl_FileObjCmd: type} {