1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
-
+
|
/*
* tclUnixTest.c --
*
* Contains platform specific test commands for the Unix platform.
*
* Copyright (c) 1996-1997 Sun Microsystems, Inc.
* Copyright (c) 1998 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tclUnixTest.c,v 1.21 2005/11/02 23:26:50 dkf Exp $
* RCS: @(#) $Id: tclUnixTest.c,v 1.22 2006/03/14 19:34:30 vincentdarley Exp $
*/
#include "tclInt.h"
/*
* The headers are needed for the testalarm command that verifies the use of
* SA_RESTART in signal handlers.
|
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
+
+
|
Tcl_Interp *interp, int argc, CONST char **argv);
int TclplatformtestInit(Tcl_Interp *interp);
static int TestalarmCmd(ClientData dummy,
Tcl_Interp *interp, int argc, CONST char **argv);
static int TestgotsigCmd(ClientData dummy,
Tcl_Interp *interp, int argc, CONST char **argv);
static void AlarmHandler(int signum);
static int TestchmodCmd(ClientData dummy,
Tcl_Interp *interp, int argc, CONST char **argv);
/*
*----------------------------------------------------------------------
*
* TclplatformtestInit --
*
* Defines commands that test platform specific functionality for Unix
|
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
+
+
|
*----------------------------------------------------------------------
*/
int
TclplatformtestInit(
Tcl_Interp *interp) /* Interpreter to add commands to. */
{
Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
(ClientData) 0, NULL);
Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
(ClientData) 0, NULL);
Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
(ClientData) 0, NULL);
Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
(ClientData) 0, NULL);
Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
|
669
670
671
672
673
674
675
|
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
int argc, /* Number of arguments. */
CONST char **argv) /* Argument strings. */
{
Tcl_AppendResult(interp, gotsig, NULL);
gotsig = "0";
return TCL_OK;
}
/*
*---------------------------------------------------------------------------
*
* TestchmodCmd --
*
* Implements the "testchmod" cmd. Used when testing "file" command.
* The only attribute used by the Windows platform is the user write
* flag; if this is not set, the file is made read-only. Otehrwise, the
* file is made read-write.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* Changes permissions of specified files.
*
*---------------------------------------------------------------------------
*/
static int
TestchmodCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
CONST char **argv; /* Argument strings. */
{
int i, mode;
char *rest;
if (argc < 2) {
usage:
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" mode file ?file ...?", NULL);
return TCL_ERROR;
}
mode = (int) strtol(argv[1], &rest, 8);
if ((rest == argv[1]) || (*rest != '\0')) {
goto usage;
}
for (i = 2; i < argc; i++) {
Tcl_DString buffer;
CONST char *translated;
translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
if (translated == NULL) {
return TCL_ERROR;
}
if (chmod(translated, (unsigned) mode) != 0) {
Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
NULL);
return TCL_ERROR;
}
Tcl_DStringFree(&buffer);
}
return TCL_OK;
}
|