Attachment "file-tempname.patch" to
ticket [999162ffff]
added by
techentin
2004-07-28 12:13:25.
Index: doc/file.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/file.n,v
retrieving revision 1.35
diff -c -r1.35 file.n
*** doc/file.n 2 Jun 2004 14:24:05 -0000 1.35
--- doc/file.n 28 Jul 2004 05:03:50 -0000
***************
*** 405,410 ****
--- 405,417 ----
\fBfile tail a/b\fR, \fBfile tail a/b/\fR and \fBfile tail b\fR all
return \fBb\fR.
.TP
+ \fBfile tempname
+ .
+ Returns a string that is a valid filename, which does not exist.
+ More specifically, it did not exist at some point in the past.
+ The filename is suitable for a temporary file. Each call will
+ return a different, unique filename.
+ .TP
\fBfile type \fIname\fR
.
Returns a string giving the type of file \fIname\fR, which will be one of
Index: generic/tclCmdAH.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdAH.c,v
retrieving revision 1.45
diff -c -r1.45 tclCmdAH.c
*** generic/tclCmdAH.c 13 May 2004 12:59:21 -0000 1.45
--- generic/tclCmdAH.c 28 Jul 2004 05:03:52 -0000
***************
*** 869,875 ****
"pathtype", "readable", "readlink", "rename",
"rootname", "separator", "size", "split",
"stat", "system",
! "tail", "type", "volumes", "writable",
(char *) NULL
};
enum options {
--- 869,876 ----
"pathtype", "readable", "readlink", "rename",
"rootname", "separator", "size", "split",
"stat", "system",
! "tail", "tempname", "type", "volumes",
! "writable",
(char *) NULL
};
enum options {
***************
*** 882,888 ****
FCMD_PATHTYPE, FCMD_READABLE, FCMD_READLINK, FCMD_RENAME,
FCMD_ROOTNAME, FCMD_SEPARATOR, FCMD_SIZE, FCMD_SPLIT,
FCMD_STAT, FCMD_SYSTEM,
! FCMD_TAIL, FCMD_TYPE, FCMD_VOLUMES, FCMD_WRITABLE
};
if (objc < 2) {
--- 883,890 ----
FCMD_PATHTYPE, FCMD_READABLE, FCMD_READLINK, FCMD_RENAME,
FCMD_ROOTNAME, FCMD_SEPARATOR, FCMD_SIZE, FCMD_SPLIT,
FCMD_STAT, FCMD_SYSTEM,
! FCMD_TAIL, FCMD_TEMPNAME, FCMD_TYPE, FCMD_VOLUMES,
! FCMD_WRITABLE
};
if (objc < 2) {
***************
*** 1425,1430 ****
--- 1427,1434 ----
return TCL_OK;
}
}
+ case FCMD_TEMPNAME:
+ return TclFileTempnameCmd(interp, objc, objv);
case FCMD_TYPE: {
Tcl_StatBuf buf;
Index: generic/tclFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclFCmd.c,v
retrieving revision 1.26
diff -c -r1.26 tclFCmd.c
*** generic/tclFCmd.c 6 Apr 2004 22:25:51 -0000 1.26
--- generic/tclFCmd.c 28 Jul 2004 05:03:53 -0000
***************
*** 417,422 ****
--- 417,454 ----
/*
*---------------------------------------------------------------------------
*
+ * TclFileTempnameCmd
+ *
+ * This procedure implements the "tempname" subcommand of the "file"
+ * command.
+ *
+ * Results:
+ * Returns a temporary file name.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+ int
+ TclFileTempnameCmd(interp, objc, objv)
+ Tcl_Interp *interp; /* Used for error reporting */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings passed to Tcl_FileCmd. */
+ {
+ char filename[FILENAME_MAX];
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(interp, tmpnam(filename), NULL);
+ return TCL_OK;
+ }
+
+ /*
+ *---------------------------------------------------------------------------
+ *
* CopyRenameOneFile
*
* Copies or renames specified source file or directory hierarchy
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.170
diff -c -r1.170 tclInt.h
*** generic/tclInt.h 21 Jul 2004 01:45:44 -0000 1.170
--- generic/tclInt.h 28 Jul 2004 05:03:57 -0000
***************
*** 1731,1736 ****
--- 1731,1738 ----
int objc, Tcl_Obj *CONST objv[])) ;
EXTERN int TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[])) ;
+ EXTERN int TclFileTempnameCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]));
EXTERN void TclFinalizeAllocSubsystem _ANSI_ARGS_((void));
EXTERN void TclFinalizeCompExecEnv _ANSI_ARGS_((void));
EXTERN void TclFinalizeCompilation _ANSI_ARGS_((void));
Index: tests/cmdAH.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/cmdAH.test,v
retrieving revision 1.43
diff -c -r1.43 cmdAH.test
*** tests/cmdAH.test 23 Jun 2004 15:46:45 -0000 1.43
--- tests/cmdAH.test 28 Jul 2004 05:03:58 -0000
***************
*** 184,190 ****
} {1 {wrong # args: should be "file option ?arg ...?"}}
test cmdAH-5.2 {Tcl_FileObjCmd} {
list [catch {file x} msg] $msg
! } {1 {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-5.3 {Tcl_FileObjCmd} {
list [catch {file exists} msg] $msg
} {1 {wrong # args: should be "file exists name"}}
--- 184,190 ----
} {1 {wrong # args: should be "file option ?arg ...?"}}
test cmdAH-5.2 {Tcl_FileObjCmd} {
list [catch {file x} msg] $msg
! } {1 {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempname, type, volumes, or writable}}
test cmdAH-5.3 {Tcl_FileObjCmd} {
list [catch {file exists} msg] $msg
} {1 {wrong # args: should be "file exists name"}}
***************
*** 1412,1436 ****
test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} {
list [catch {file gorp x} msg] $msg
! } {1 {bad option "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} {
list [catch {file ex x} msg] $msg
! } {1 {ambiguous option "ex": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} {
list [catch {file is x} msg] $msg
! } {1 {ambiguous option "is": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} {
list [catch {file z x} msg] $msg
! } {1 {bad option "z": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} {
list [catch {file read x} msg] $msg
! } {1 {ambiguous option "read": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} {
list [catch {file s x} msg] $msg
! } {1 {ambiguous option "s": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} {
list [catch {file t x} msg] $msg
! } {1 {ambiguous option "t": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} {
list [catch {file dirname ~woohgy} msg] $msg
} {1 {user "woohgy" doesn't exist}}
--- 1412,1436 ----
test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} {
list [catch {file gorp x} msg] $msg
! } {1 {bad option "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempname, type, volumes, or writable}}
test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} {
list [catch {file ex x} msg] $msg
! } {1 {ambiguous option "ex": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempname, type, volumes, or writable}}
test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} {
list [catch {file is x} msg] $msg
! } {1 {ambiguous option "is": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempname, type, volumes, or writable}}
test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} {
list [catch {file z x} msg] $msg
! } {1 {bad option "z": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempname, type, volumes, or writable}}
test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} {
list [catch {file read x} msg] $msg
! } {1 {ambiguous option "read": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempname, type, volumes, or writable}}
test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} {
list [catch {file s x} msg] $msg
! } {1 {ambiguous option "s": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempname, type, volumes, or writable}}
test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} {
list [catch {file t x} msg] $msg
! } {1 {ambiguous option "t": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempname, type, volumes, or writable}}
test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} {
list [catch {file dirname ~woohgy} msg] $msg
} {1 {user "woohgy" doesn't exist}}
Index: tests/fCmd.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/fCmd.test,v
retrieving revision 1.41
diff -c -r1.41 fCmd.test
*** tests/fCmd.test 23 Jun 2004 15:36:56 -0000 1.41
--- tests/fCmd.test 28 Jul 2004 05:04:01 -0000
***************
*** 2429,2434 ****
--- 2429,2451 ----
catch {set res [open [file join ~a_totally_bogus_user_id/foo bar]]}
} 1
+ test fCmd-30.1 {TclFileTempfileCmd: returns non-existing filename} {} {
+ set fname [file tempname]
+ set length [expr {[string length $fname] > 0}]
+ set exists [file exists $fname]
+ list $length $exists
+ } {1 0}
+ test fCmd-30.2 {TclFileTempfileCmd: too many args} {} {
+ list [catch {file tempname tf1} msg] $msg
+ } {1 {wrong # args: should be "file tempname"}}
+ test fCmd-30.3 {TclFileTempfileCmd: unique name on each call} {} {
+ set tf1 [file tempname]
+ set tf2 [file tempname]
+ expr {$tf1 eq $tf2}
+ } {0}
+
+
+
cd [temporaryDirectory]
file delete -force abc.link
file delete -force d1/d2
