| ︙ | | |
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
-
+
|
#define GetFd(file) (PTR2INT(file)-1)
/*
* The stuff below is used to keep track of file handlers created and
* exercised by the "testfilehandler" command.
*/
typedef struct Pipe {
typedef struct {
TclFile readFile; /* File handle for reading from the pipe. NULL
* means pipe doesn't exist yet. */
TclFile writeFile; /* File handle for writing from the pipe. */
int readCount; /* Number of times the file handler for this
* file has triggered and the file was
* readable. */
int writeCount; /* Number of times the file handler for this
|
| ︙ | | |
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
+
-
+
-
+
|
*/
static Tcl_CmdProc TestalarmCmd;
static Tcl_CmdProc TestchmodCmd;
static Tcl_CmdProc TestfilehandlerCmd;
static Tcl_CmdProc TestfilewaitCmd;
static Tcl_CmdProc TestfindexecutableCmd;
static Tcl_ObjCmdProc TestforkObjCmd;
static Tcl_CmdProc TestgetdefencdirCmd;
static Tcl_ObjCmdProc TestgetdefencdirCmd;
static Tcl_CmdProc TestgetopenfileCmd;
static Tcl_CmdProc TestgotsigCmd;
static Tcl_CmdProc TestsetdefencdirCmd;
static Tcl_ObjCmdProc TestsetdefencdirCmd;
static Tcl_FileProc TestFileHandlerProc;
static void AlarmHandler(int signum);
/*
*----------------------------------------------------------------------
*
* TclplatformtestInit --
|
| ︙ | | |
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
+
+
-
+
-
+
|
NULL, NULL);
Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
Tcl_CreateObjCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
Tcl_CreateObjCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
NULL, NULL);
return TCL_OK;
}
|
| ︙ | | |
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
|
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
|
-
+
-
-
+
+
|
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " counts index\"", NULL);
return TCL_ERROR;
}
sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount);
Tcl_SetResult(interp, buf, TCL_VOLATILE);
Tcl_AppendResult(interp, buf, NULL);
} else if (strcmp(argv[1], "create") == 0) {
if (argc != 5) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " create index readMode writeMode\"", NULL);
return TCL_ERROR;
}
if (pipePtr->readFile == NULL) {
if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) {
Tcl_AppendResult(interp, "couldn't open pipe: ",
Tcl_PosixError(interp), NULL);
return TCL_ERROR;
}
#ifdef O_NONBLOCK
fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK);
fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK);
#else
Tcl_SetResult(interp, "can't make pipes non-blocking",
TCL_STATIC);
Tcl_AppendResult(interp, "can't make pipes non-blocking",
NULL);
return TCL_ERROR;
#endif
}
pipePtr->readCount = 0;
pipePtr->writeCount = 0;
if (strcmp(argv[3], "readable") == 0) {
|
| ︙ | | |
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
|
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
|
-
+
|
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " fillpartial index\"", NULL);
return TCL_ERROR;
}
memset(buffer, 'b', 10);
TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10));
Tcl_SetResult(interp, buf, TCL_VOLATILE);
Tcl_AppendResult(interp, buf, NULL);
} else if (strcmp(argv[1], "oneevent") == 0) {
Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT);
} else if (strcmp(argv[1], "wait") == 0) {
if (argc != 5) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " wait index readable|writable timeout\"", NULL);
return TCL_ERROR;
|
| ︙ | | |
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
|
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
|
-
+
|
Tcl_AppendResult(interp, "bad argument \"", argv[2],
"\": must be readable, writable, or both", NULL);
return TCL_ERROR;
}
if (Tcl_GetChannelHandle(channel,
(mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
(ClientData*) &data) != TCL_OK) {
Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
Tcl_AppendResult(interp, "couldn't get channel file", NULL);
return TCL_ERROR;
}
fd = PTR2INT(data);
if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) {
return TCL_ERROR;
}
result = TclUnixWaitForFile(fd, mask, timeout);
|
| ︙ | | |
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
|
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
|
-
-
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
|
*----------------------------------------------------------------------
*/
static int
TestsetdefencdirCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
size_t argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
Tcl_Obj *searchPath;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" defaultDir\"", NULL);
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "defaultDir");
return TCL_ERROR;
}
searchPath = Tcl_GetEncodingSearchPath();
searchPath = Tcl_DuplicateObj(searchPath);
Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &objv[1]);
Tcl_SetEncodingSearchPath(searchPath);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TestforkObjCmd --
*
* This function implements the "testfork" command. It is used to
* fork the Tcl process for specific test cases.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
TestforkObjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
pid_t pid;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
pid = fork();
if (pid == -1) {
Tcl_AppendResult(interp,
"Cannot fork", NULL);
return TCL_ERROR;
}
#if !defined(HAVE_PTHREAD_ATFORK) || defined(MAC_OSX_TCL)
/* Only needed when pthread_atfork is not present or on OSX. */
if (pid==0) {
Tcl_InitNotifier();
Tcl_SetDefaultEncodingDir(argv[1]);
}
#endif
Tcl_SetObjResult(interp, Tcl_NewIntObj(pid));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TestgetdefencdirCmd --
|
| ︙ | | |
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
|
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
|
-
-
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
-
+
|
*----------------------------------------------------------------------
*/
static int
TestgetdefencdirCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
size_t argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
size_t objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument strings. */
{
int numDirs;
Tcl_Obj *first, *searchPath;
if (argc != 1) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL);
return TCL_ERROR;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
searchPath = Tcl_GetEncodingSearchPath();
Tcl_ListObjLength(interp, searchPath, &numDirs);
if (numDirs == 0) {
return TCL_ERROR;
}
Tcl_ListObjIndex(NULL, searchPath, 0, &first);
Tcl_AppendResult(interp, Tcl_GetDefaultEncodingDir(), NULL);
Tcl_SetObjResult(interp, first);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TestalarmCmd --
|
| ︙ | | |