← Back to branch summary

~ubuntu-branches/ubuntu/natty/expect/natty

« back to all changes in this revision

Viewing changes to exp_main_sub.c

  • Committer: Bazaar Package Importer
  • Author(s): Sergei Golovan
  • Date: 2009-10-23 12:24:40 UTC
  • mfrom: (5.1.4 sid)
  • Revision ID: james.westby@ubuntu.com-20091023122440-5uujs2py5bx5v7vs
http://bugs.debian.org/551332
* Added buid conflict with autoconf2.13 because autoconf 2.50 or newer is
  required to process configure.in template.
* Fixed building with the current config.sub and config.guess from
  autotools-dev package (closes: #551332).
* Fixed cleaning after build is done.

Show diffs side-by-side

added added

removed removed

Lines of Context:
exp_main_sub.c
28
28
#include "tcldbg.h"
29
29
#endif
30
30
 
 
31
#ifndef EXP_VERSION
 
32
#define EXP_VERSION PACKAGE_VERSION
 
33
#endif
31
34
#ifdef __CENTERLINE__
32
35
#undef  EXP_VERSION
33
 
#define EXP_VERSION             "5.0.3"         /* I give up! */
 
36
#define EXP_VERSION             "5.43.0"                /* I give up! */
34
37
                                        /* It is not necessary that number */
35
38
                                        /* be accurate.  It is just here to */
36
39
                                        /* pacify Centerline which doesn't */
41
44
#undef  EXECSCRIPTDIR
42
45
#define EXECSCRIPTDIR   "example/"
43
46
#endif
44
 
char exp_version[] = EXP_VERSION;
 
47
char exp_version[] = PACKAGE_VERSION;
45
48
#define NEED_TCL_MAJOR          7
46
49
#define NEED_TCL_MINOR          5
47
50
 
61
64
 
62
65
int exp_getpid;
63
66
 
 
67
int exp_strict_write = 0;
 
68
 
 
69
 
64
70
static void
65
71
usage(interp)
66
72
Tcl_Interp *interp;
169
175
 
170
176
/*ARGSUSED*/
171
177
int
172
 
Exp_Prompt1Cmd(clientData, interp, objc, objv)
 
178
Exp_Prompt1ObjCmd(clientData, interp, objc, objv)
173
179
ClientData clientData;
174
180
Tcl_Interp *interp;
175
181
int objc;
186
192
 
187
193
/*ARGSUSED*/
188
194
int
189
 
Exp_Prompt2Cmd(clientData, interp, objc, objv)
 
195
Exp_Prompt2ObjCmd(clientData, interp, objc, objv)
190
196
ClientData clientData;
191
197
Tcl_Interp *interp;
192
198
int objc;
223
229
        char *msg;
224
230
 
225
231
        /* if errorInfo has something, print it */
226
 
        /* else use what's in interp->result */
 
232
    /* else use what's in the interp result */
227
233
 
228
234
        msg = Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY);
229
 
        if (!msg) msg = interp->result;
 
235
    if (!msg) msg = Tcl_GetStringResult (interp);
230
236
        else if (check_for_nostack) {
231
237
                /* suppress errorInfo if generated via */
232
238
                /* error ... -nostack */
275
281
    Tcl_Channel inChannel, outChannel;
276
282
    ExpState *esPtr = expStdinoutGet();
277
283
    /*  int fd = fileno(stdin);*/
278
 
        
 
284
 
279
285
    expect_key++;
280
 
 
281
286
    commandPtr = Tcl_NewObj();
282
287
    Tcl_IncrRefCount(commandPtr);
283
288
 
284
289
    gotPartial = 0;
285
290
    while (TRUE) {
 
291
        if (Tcl_IsShared(commandPtr)) {
 
292
            Tcl_DecrRefCount(commandPtr);
 
293
            commandPtr = Tcl_DuplicateObj(commandPtr);
 
294
            Tcl_IncrRefCount(commandPtr);
 
295
        }
286
296
        outChannel = expStdinoutGet()->channel;
287
297
        if (outChannel) {
288
298
            Tcl_Flush(outChannel);
352
362
         * Add the newline removed by Tcl_GetsObj back to the string.
353
363
         */
354
364
 
 
365
        if (Tcl_IsShared(commandPtr)) {
 
366
            Tcl_DecrRefCount(commandPtr);
 
367
            commandPtr = Tcl_DuplicateObj(commandPtr);
 
368
            Tcl_IncrRefCount(commandPtr);
 
369
        }
355
370
        Tcl_AppendToObj(commandPtr, "\n", 1);
356
371
        if (!TclObjCommandComplete(commandPtr)) {
357
372
            gotPartial = 1;
358
373
            continue;
359
 
        }       
 
374
        }
360
375
 
361
376
        Tcl_AppendToObj(commandPtr, "\n", 1);
362
377
        if (!TclObjCommandComplete(commandPtr)) {
369
384
        if (tty_changed) exp_tty_set(interp,&tty_old,was_raw,was_echo);
370
385
 
371
386
        code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
372
 
        Tcl_SetObjLength(commandPtr, 0);
 
387
        Tcl_DecrRefCount(commandPtr);
 
388
        commandPtr = Tcl_NewObj();
 
389
        Tcl_IncrRefCount(commandPtr);
373
390
        switch (code) {
374
391
            char *str;
375
392
 
411
428
 
412
429
/*ARGSUSED*/
413
430
int
414
 
Exp_ExpVersionCmd(clientData, interp, argc, argv)
 
431
Exp_ExpVersionObjCmd(clientData, interp, objc, objv)
415
432
ClientData clientData;
416
433
Tcl_Interp *interp;
417
 
int argc;
418
 
char **argv;
 
434
     int objc;
 
435
     Tcl_Obj *CONST objv[];             /* Argument objects. */
419
436
{
420
437
        int emajor, umajor;
421
438
        char *user_version;     /* user-supplied version string */
422
439
 
423
 
        if (argc == 1) {
 
440
    if (objc == 1) {
424
441
                Tcl_SetResult(interp,exp_version,TCL_STATIC);
425
442
                return(TCL_OK);
426
443
        }
427
 
        if (argc > 3) {
 
444
    if (objc > 3) {
428
445
                exp_error(interp,"usage: expect_version [[-exit] version]");
429
446
                return(TCL_ERROR);
430
447
        }
431
448
 
432
 
        user_version = argv[argc==2?1:2];
 
449
    user_version = Tcl_GetString (objv[objc==2?1:2]);
433
450
        emajor = atoi(exp_version);
434
451
        umajor = atoi(user_version);
435
452
 
450
467
                if (e >= u) return(TCL_OK);
451
468
        }
452
469
 
453
 
        if (argc == 2) {
 
470
    if (objc == 2) {
454
471
                exp_error(interp,"%s requires Expect version %s (but using %s)",
455
472
                        exp_argv0,user_version,exp_version);
456
473
                return(TCL_ERROR);
475
492
    lappend auto_path $exp_exec_library\n\
476
493
}";
477
494
 
 
495
static void
 
496
DeleteCmdInfo (clientData, interp)
 
497
     ClientData clientData;
 
498
     Tcl_Interp *interp;
 
499
{
 
500
  ckfree (clientData);
 
501
}
 
502
 
 
503
 
478
504
int
479
505
Expect_Init(interp)
480
506
Tcl_Interp *interp;
481
507
{
482
508
    static int first_time = TRUE;
483
509
 
 
510
    Tcl_CmdInfo* close_info  = NULL;
 
511
    Tcl_CmdInfo* return_info = NULL;
 
512
 
484
513
    if (first_time) {
 
514
#ifndef USE_TCL_STUBS
485
515
        int tcl_major = atoi(TCL_VERSION);
486
516
        char *dot = strchr(TCL_VERSION,'.');
487
517
        int tcl_minor = atoi(dot+1);
488
518
 
489
519
        if (tcl_major < NEED_TCL_MAJOR || 
490
520
            (tcl_major == NEED_TCL_MAJOR && tcl_minor < NEED_TCL_MINOR)) {
491
 
            sprintf(interp->result,
492
 
                    "%s compiled with Tcl %d.%d but needs at least Tcl %d.%d\n",
493
 
                    exp_argv0,tcl_major,tcl_minor,
494
 
                    NEED_TCL_MAJOR,NEED_TCL_MINOR);
 
521
 
 
522
            char bufa [20];
 
523
            char bufb [20];
 
524
            Tcl_Obj* s = Tcl_NewStringObj (exp_argv0,-1);
 
525
 
 
526
            sprintf(bufa,"%d.%d",tcl_major,tcl_minor);
 
527
            sprintf(bufb,"%d.%d",NEED_TCL_MAJOR,NEED_TCL_MINOR);
 
528
 
 
529
            Tcl_AppendStringsToObj (s,
 
530
                                    " compiled with Tcl ", bufa,
 
531
                                    " but needs at least Tcl ", bufb,
 
532
                                    "\n", NULL);
 
533
            Tcl_SetObjResult (interp, s);
495
534
            return TCL_ERROR;
496
535
        }
 
536
#endif
497
537
    }
498
538
 
 
539
#ifndef USE_TCL_STUBS
499
540
    if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
500
541
      return TCL_ERROR;
501
542
    }
502
 
    if (Tcl_PkgProvide(interp, "Expect", EXP_VERSION) != TCL_OK) {
 
543
#else
 
544
    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
 
545
      return TCL_ERROR;
 
546
    }
 
547
#endif
 
548
 
 
549
    /*
 
550
     *  Save initial close and return for later use
 
551
     */
 
552
 
 
553
    close_info = (Tcl_CmdInfo*) ckalloc (sizeof (Tcl_CmdInfo));
 
554
    if (Tcl_GetCommandInfo(interp, "close", close_info) == 0) {
 
555
        ckfree ((char*) close_info);
 
556
        return TCL_ERROR;
 
557
    }
 
558
    return_info = (Tcl_CmdInfo*) ckalloc (sizeof (Tcl_CmdInfo));
 
559
    if (Tcl_GetCommandInfo(interp, "return", return_info) == 0){
 
560
        ckfree ((char*) close_info);
 
561
        ckfree ((char*) return_info);
 
562
        return TCL_ERROR;
 
563
    }
 
564
    Tcl_SetAssocData (interp, EXP_CMDINFO_CLOSE,  DeleteCmdInfo, (ClientData) close_info);
 
565
    Tcl_SetAssocData (interp, EXP_CMDINFO_RETURN, DeleteCmdInfo, (ClientData) return_info);
 
566
 
 
567
    /*
 
568
     * Expect redefines close so we need to save the original (pre-expect)
 
569
     * definition so it can be restored before exiting.
 
570
     *
 
571
     * Needed when expect is dynamically loaded after close has
 
572
     * been redefined e.g. the virtual file system in tclkit
 
573
     */
 
574
    if (TclRenameCommand(interp, "close", "_close.pre_expect") != TCL_OK) {
 
575
        return TCL_ERROR;
 
576
    }
 
577
 
 
578
    if (Tcl_PkgProvide(interp, "Expect", PACKAGE_VERSION) != TCL_OK) {
503
579
      return TCL_ERROR;
504
580
    }
505
581
 
574
650
 
575
651
static char sigint_init_default[80];
576
652
static char sigterm_init_default[80];
577
 
static char debug_init_default[]   = "trap {exp_debug 1} SIGINT";
 
653
static char debug_init_default[] = "trap {exp_debug 1} SIGINT";
578
654
 
579
655
void
580
656
exp_parse_argv(interp,argc,argv)
793
869
        exp_interpret_rcfiles(interp,my_rc,sys_rc);
794
870
}
795
871
 
 
872
static void
 
873
print_result (interp)
 
874
     Tcl_Interp* interp;
 
875
{
 
876
    char* msg = Tcl_GetStringResult (interp);
 
877
    if (msg[0] != 0) {
 
878
        expErrorLogU(msg);
 
879
        expErrorLogU("\r\n");
 
880
    }
 
881
}
 
882
 
 
883
static void
 
884
run_exit (interp)
 
885
     Tcl_Interp* interp;
 
886
{
 
887
    /* SF #439042 -- Allow overide of "exit" by user / script
 
888
     */
 
889
    char buffer [] = "exit 1";
 
890
    Tcl_Eval(interp, buffer); 
 
891
}
 
892
 
796
893
/* read rc files */
797
894
void
798
895
exp_interpret_rcfiles(interp,my_rc,sys_rc)
812
909
                    expErrorLog("error executing system initialization file: %s\r\n",file);
813
910
                    if (rc != TCL_ERROR)
814
911
                        expErrorLog("Tcl_Eval = %d\r\n",rc);
815
 
                    if (*interp->result != 0) {
816
 
                        expErrorLogU(interp->result);
817
 
                        expErrorLogU("\r\n");
818
 
                    }
819
 
                    /* SF #439042 -- Allow overide of "exit" by user / script
820
 
                     */
821
 
                    {
822
 
                      char buffer [] = "exit 1";
823
 
                      Tcl_Eval(interp, buffer); 
824
 
                    }
 
912
                print_result (interp);
 
913
                run_exit (interp);
825
914
                }
826
915
                close(fd);
827
916
            }
840
929
                        expErrorLog("error executing file: %s\r\n",file);
841
930
                        if (rc != TCL_ERROR)
842
931
                                expErrorLog("Tcl_Eval = %d\r\n",rc);
843
 
                        if (*interp->result != 0) {
844
 
                            expErrorLogU(interp->result);
845
 
                            expErrorLogU("\r\n");
846
 
                        }
847
 
                        /* SF #439042 -- Allow overide of "exit" by user / script
848
 
                         */
849
 
                        {
850
 
                          char buffer [] = "exit 1";
851
 
                          Tcl_Eval(interp, buffer); 
852
 
                        }
 
932
                    print_result (interp);
 
933
                    run_exit (interp);
853
934
                    }
854
935
                    close(fd);
855
936
                }
920
1001
}
921
1002
 
922
1003
static struct exp_cmd_data cmd_data[]  = {
923
 
{"exp_version", exp_proc(Exp_ExpVersionCmd),    0,      0},
924
 
{"prompt1",     exp_proc(Exp_Prompt1Cmd),       0,      EXP_NOPREFIX},
925
 
{"prompt2",     exp_proc(Exp_Prompt2Cmd),       0,      EXP_NOPREFIX},
 
1004
    {"exp_version", Exp_ExpVersionObjCmd, 0,    0,      0},
 
1005
    {"prompt1",     Exp_Prompt1ObjCmd,    0,    0,      EXP_NOPREFIX},
 
1006
    {"prompt2",     Exp_Prompt2ObjCmd,    0,    0,      EXP_NOPREFIX},
926
1007
{0}};
927
1008
 
928
1009
void
931
1012
{
932
1013
        exp_create_commands(interp,cmd_data);
933
1014
}
 
1015
 
 
1016
/*
 
1017
 * Local Variables:
 
1018
 * mode: c
 
1019
 * c-basic-offset: 4
 
1020
 * fill-column: 78
 
1021
 * End:
 
1022
 */