| ︙ | | | ︙ | |
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
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,
NULL, NULL);
Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
|
|
|
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
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,
NULL, NULL);
Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
|
| ︙ | | | ︙ | |
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
}
initialized = 1;
}
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
" option ... \"", NULL);
return TCL_ERROR;
}
pipePtr = NULL;
if (argc >= 3) {
if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) {
return TCL_ERROR;
}
if (i >= MAX_PIPES) {
|
|
|
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
}
initialized = 1;
}
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
" option ... \"", NULL);
return TCL_ERROR;
}
pipePtr = NULL;
if (argc >= 3) {
if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) {
return TCL_ERROR;
}
if (i >= MAX_PIPES) {
|
| ︙ | | | ︙ | |
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
|
} else if (strcmp(argv[1], "empty") == 0) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " empty index\"", NULL);
return TCL_ERROR;
}
while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) {
/* Empty loop body. */
}
} else if (strcmp(argv[1], "fill") == 0) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " fill index\"", NULL);
return TCL_ERROR;
}
memset(buffer, 'a', 4000);
while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
/* Empty loop body. */
}
} else if (strcmp(argv[1], "fillpartial") == 0) {
char buf[TCL_INTEGER_SPACE];
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " fillpartial index\"", NULL);
return TCL_ERROR;
|
|
|
|
|
|
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
|
} else if (strcmp(argv[1], "empty") == 0) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " empty index\"", NULL);
return TCL_ERROR;
}
while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) {
/* Empty loop body. */
}
} else if (strcmp(argv[1], "fill") == 0) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " fill index\"", NULL);
return TCL_ERROR;
}
memset(buffer, 'a', 4000);
while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
/* Empty loop body. */
}
} else if (strcmp(argv[1], "fillpartial") == 0) {
char buf[TCL_INTEGER_SPACE];
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"",
argv[0], " fillpartial index\"", NULL);
return TCL_ERROR;
|
| ︙ | | | ︙ | |
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
|
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
ClientData filePtr;
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" channelName forWriting\"", NULL);
return TCL_ERROR;
}
if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr)
== TCL_ERROR) {
return TCL_ERROR;
}
if (filePtr == NULL) {
Tcl_AppendResult(interp,
"Tcl_GetOpenFile succeeded but FILE * NULL!", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
|
|
|
|
|
|
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
|
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
ClientData filePtr;
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" channelName forWriting\"", NULL);
return TCL_ERROR;
}
if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr)
== TCL_ERROR) {
return TCL_ERROR;
}
if (filePtr == NULL) {
Tcl_AppendResult(interp,
"Tcl_GetOpenFile succeeded but FILE * NULL!", NULL);
return TCL_ERROR;
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | | | ︙ | |
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
|
TestsetdefencdirCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" defaultDir\"", NULL);
return TCL_ERROR;
}
Tcl_SetDefaultEncodingDir(argv[1]);
return TCL_OK;
}
/*
|
|
|
|
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
|
TestsetdefencdirCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" defaultDir\"", NULL);
return TCL_ERROR;
}
Tcl_SetDefaultEncodingDir(argv[1]);
return TCL_OK;
}
/*
|
| ︙ | | | ︙ | |
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
|
Tcl_Interp *interp, /* Current interpreter. */
int 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;
}
/* Only needed when pthread_atfork is not present,
* should not hurt otherwise. */
if (pid==0) {
Tcl_InitNotifier();
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(pid));
|
|
|
|
|
|
|
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
|
Tcl_Interp *interp, /* Current interpreter. */
int 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;
}
/* Only needed when pthread_atfork is not present,
* should not hurt otherwise. */
if (pid==0) {
Tcl_InitNotifier();
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(pid));
|
| ︙ | | | ︙ | |
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
|
TestgetdefencdirCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
if (argc != 1) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL);
return TCL_ERROR;
}
Tcl_AppendResult(interp, Tcl_GetDefaultEncodingDir(), NULL);
return TCL_OK;
}
/*
|
|
|
|
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
|
TestgetdefencdirCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
if (argc != 1) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL);
return TCL_ERROR;
}
Tcl_AppendResult(interp, Tcl_GetDefaultEncodingDir(), NULL);
return TCL_OK;
}
/*
|
| ︙ | | | ︙ | |