regina/execiser.c

   1 #include <stdio.h>
   2 #include <string.h>
   3 #include <stdlib.h>
   4
   5 #define INCL_RXSHV
   6 #define INCL_RXFUNC
   7 #define INCL_RXSYSEXIT
   8 #define INCL_RXSUBCOM
   9 #define INCL_RXQUEUE
  10
  11 #include "rexxsaa.h"
  12
  13 #define STARTUPMSG "       +++ Interactive trace.  \"Trace Off\" to end debug. ENTER to continue."
  14
  15 #ifdef _MSC_VER
  16 /* This picky compiler claims about unused formal parameters.
  17  * This is correct but hides (for human eyes) other errors since they
  18  * are many and we can't reduce them all.
  19  * Error 4100 is "unused formal parameter".
  20  */
  21 # pragma warning(disable:4100)
  22 #endif
  23
  24 static void message( char *msg )
  25 {
  26    printf( "  %s", msg ) ;
  27    fflush(stdout) ;
  28 }
  29
  30
  31 static void mycomplain( char *msg )
  32 {
  33    fprintf( stderr, "Complaint: %s\n", msg ) ;
  34 }
  35
  36 static void iverify( char *msg, int first, int second )
  37 {
  38    if (first != second)
  39       printf( "\nInt verify: %s: %d ^= %d\n", msg, first, second ) ;
  40 }
  41
  42 static void sverify( char *msg, PRXSTRING first, char *second )
  43 {
  44    if (!second)
  45    {
  46       if (first->strptr)
  47          printf( "\nSecond is null, first: %d<%s>\n", (int) first->strlength,
  48                  first->strptr  ) ;
  49    }
  50    else if (strlen(second) != first->strlength)
  51    {
  52       printf( "\nString length: %s: %d ^=%d\n", msg,
  53               (int) first->strlength, (int) strlen(second)) ;
  54       printf( "   first=%4d<%s>\n", (int) first->strlength, first->strptr ) ;
  55       printf( "   secnd=%4d<%s>\n", (int) strlen(second), second ) ;
  56    }
  57    else
  58       if (memcmp(second, first->strptr, first->strlength))
  59          printf( "\nString contents: %s: <%s> ^== <%s>\n", msg,
  60                  first->strptr, second ) ;
  61 }
  62
  63
  64
  65
  66 LONG APIENTRY instore_exit( LONG ExNum, LONG Subfun, PEXIT PBlock )
  67 {
  68    RXSIOSAY_PARM *psiosay;
  69    iverify( "Exitfunction", ExNum, RXSIO ) ;
  70    iverify( "Subfunction", Subfun, RXSIOSAY ) ;
  71    psiosay = (RXSIOSAY_PARM *)PBlock;
  72    sverify( "Exit string", &(psiosay->rxsio_string), "foobar" ) ;
  73
  74    return RXEXIT_HANDLED ;
  75 }
  76
  77 static void instore( void )
  78 {
  79    RXSTRING Instore[2] ;
  80    RXSYSEXIT Exits[2] ;
  81    int rc ;
  82
  83    message( "instore" ) ;
  84
  85    RexxRegisterExitExe( "Foo", instore_exit, NULL ) ;
  86
  87    Exits[0].sysexit_name = "Foo" ;
  88    Exits[0].sysexit_code = RXSIO ;
  89    Exits[1].sysexit_code = RXENDLST ;
  90
  91    Instore[0].strptr = "say 'foobar'" ;
  92    Instore[0].strlength = strlen( Instore[0].strptr ) ;
  93    Instore[1].strptr = NULL ;
  94    rc = RexxStart( 0, NULL, "Testing", Instore, "Foo", RXCOMMAND,
  95                    Exits, NULL, NULL ) ;
  96
  97    rc = RexxStart( 0, NULL, "Testing", Instore, "", RXCOMMAND,
  98                    Exits, NULL, NULL ) ;
  99
 100    Instore[0].strptr = NULL ;
 101    rc = RexxStart( 0, NULL, "Testing", Instore, "", RXCOMMAND,
 102                    Exits, NULL, NULL ) ;
 103
 104    rc = RexxStart( 0, NULL, "Testing", Instore, "", RXCOMMAND,
 105                    Exits, NULL, NULL ) ;
 106
 107    RexxFreeMemory( Instore[1].strptr ) ;
 108    RexxDeregisterExit( "Foo", NULL ) ;
 109 }
 110
 111
 112 LONG APIENTRY trace_exit( LONG ExNum, LONG Subfun, PEXIT PBlock )
 113 {
 114    RXSIOTRC_PARM *psiotrc;
 115    iverify( "Exitfunction", ExNum, RXSIO ) ;
 116    if (Subfun==RXSIOTRC)
 117    {
 118       psiotrc = (RXSIOTRC_PARM *)PBlock;
 119       sverify( "Exit string", &(psiotrc->rxsio_string),
 120                "     1 *-* trace off" ) ;
 121    }
 122    else
 123       mycomplain( "Unexpected subfunction\n" ) ;
 124
 125    return RXEXIT_HANDLED ;
 126 }
 127
 128 static void trace( void )
 129 {
 130    RXSTRING Instore[2] ;
 131    RXSYSEXIT Exits[2] ;
 132    int rc ;
 133
 134    message( "trace" ) ;
 135
 136    RexxRegisterExitExe( "Foo", trace_exit, NULL ) ;
 137
 138    Exits[0].sysexit_name = "Foo" ;
 139    Exits[0].sysexit_code = RXSIO ;
 140    Exits[1].sysexit_code = RXENDLST ;
 141
 142    Instore[0].strptr = "trace all;trace off" ;
 143    Instore[0].strlength = strlen( Instore[0].strptr ) ;
 144    Instore[1].strptr = NULL ;
 145
 146    rc = RexxStart( 0, NULL, "Testing", Instore, "Foo", RXCOMMAND,
 147                    Exits, NULL, NULL ) ;
 148
 149    RexxDeregisterExit( "Foo", NULL ) ;
 150 }
 151
 152 static void assign_new_rxstring( PRXSTRING dest, const char *source )
 153 {
 154    int len;
 155    char *buf;
 156
 157    len = strlen( source );
 158    if ( ( buf = (char *)RexxAllocateMemory( len + 1 ) ) == NULL )
 159    {
 160       fprintf( stderr, "RexxAllocateMemory returns NULL.\n" );
 161       exit( 1 );
 162    }
 163    strcpy( buf, source );
 164    MAKERXSTRING( *dest, buf, len );
 165
 166 }
 167
 168 LONG APIENTRY intertrc_exit( LONG ExNum, LONG Subfun, PEXIT PBlock )
 169 {
 170    static int cnt=0 ;
 171    static char *data[] = {
 172       "",
 173       "     2 *-* say 'hallo'",
 174       "       >L>   \"hallo\"",
 175       "hallo",
 176       STARTUPMSG,
 177       "=",
 178       "       *-* say 'hallo'",
 179       "       >L>   \"hallo\"",
 180       "hallo",
 181       "",
 182       "       *-* trace off",
 183       "",
 184    };
 185    RXSIOTRC_PARM *psiotrc;
 186    RXSIOSAY_PARM *psiosay;
 187    RXSIODTR_PARM *psiodtr;
 188
 189    iverify( "Exitfunction", ExNum, RXSIO ) ;
 190    switch (++cnt)
 191    {
 192        case 1:
 193        case 2:
 194        case 4:
 195        case 6:
 196        case 7:
 197        case 10:
 198        case 11:
 199           iverify( "Subfunction", Subfun, RXSIOTRC ) ;
 200           psiotrc = (RXSIOTRC_PARM *)PBlock;
 201           sverify( "Trace output", &(psiotrc->rxsio_string),data[cnt]);
 202           break ;
 203
 204        case 3:
 205        case 8:
 206           iverify( "Subfunction", Subfun, RXSIOSAY ) ;
 207           psiosay = (RXSIOSAY_PARM *)PBlock;
 208           sverify( "Say output", &(psiosay->rxsio_string), data[cnt]);
 209           break ;
 210
 211        case 5:
 212        case 9:
 213           iverify( "Subfunction", Subfun, RXSIODTR ) ;
 214           psiodtr = (RXSIODTR_PARM *)PBlock;
 215           assign_new_rxstring( &psiodtr->rxsiodtr_retc, data[cnt] );
 216           break ;
 217
 218        default:
 219           fprintf( stderr, "Out of order msg subfunc=%ld\n", Subfun) ;
 220           return RXEXIT_NOT_HANDLED ;
 221    }
 222    return RXEXIT_HANDLED ;
 223 }
 224
 225 static void intertrc( void )
 226 {
 227    RXSTRING Instore[2] ;
 228    RXSYSEXIT Exits[2] ;
 229    int rc ;
 230
 231    message( "intertrc" ) ;
 232
 233    RexxRegisterExitExe( "Foo", intertrc_exit, NULL ) ;
 234
 235    Exits[0].sysexit_name = "Foo" ;
 236    Exits[0].sysexit_code = RXSIO ;
 237    Exits[1].sysexit_code = RXENDLST ;
 238
 239    Instore[0].strptr = "trace ?int\nsay 'hallo'; trace off" ;
 240    Instore[0].strlength = strlen( Instore[0].strptr ) ;
 241    Instore[1].strptr = NULL ;
 242
 243    rc = RexxStart( 0, NULL, "Testing", Instore, "Foo", RXCOMMAND,
 244                    Exits, NULL, NULL ) ;
 245
 246    RexxDeregisterExit( "Foo", NULL ) ;
 247 }
 248
 249
 250
 251
 252
 253 LONG APIENTRY pull_exit( LONG ExNum, LONG Subfun, PEXIT PBlock )
 254 {
 255    static int cnt=0 ;
 256    static char *data[] = {
 257       "",
 258       "alpha",
 259       "ALPHA",
 260       "FOO",
 261       "beta",
 262       "beta",
 263    };
 264    RXSIOSAY_PARM *psiosay;
 265    RXSIOTRD_PARM *psiotrd;
 266
 267    iverify( "Exitfunction", ExNum, RXSIO ) ;
 268    switch (++cnt)
 269    {
 270        case 2:
 271        case 3:
 272        case 5:
 273           iverify( "Subfunction", Subfun, RXSIOSAY ) ;
 274           psiosay = (RXSIOSAY_PARM *)PBlock;
 275           sverify( "Trace output", &(psiosay->rxsio_string),data[cnt]);
 276           break ;
 277
 278        case 1:
 279        case 4:
 280           iverify( "Subfunction", Subfun, RXSIOTRD ) ;
 281           psiotrd = (RXSIOTRD_PARM *)PBlock;
 282           assign_new_rxstring( &psiotrd->rxsiotrd_retc, data[cnt] );
 283           break ;
 284
 285        default:
 286           fprintf( stderr, "Out of order msg subfunc=%ld\n", Subfun) ;
 287           return RXEXIT_NOT_HANDLED ;
 288    }
 289    return RXEXIT_HANDLED ;
 290 }
 291
 292 static void pull( void )
 293 {
 294    RXSTRING Instore[2] ;
 295    RXSYSEXIT Exits[2] ;
 296    int rc ;
 297
 298    message( "pull" ) ;
 299
 300    RexxRegisterExitExe( "Foo", pull_exit, NULL ) ;
 301
 302    Exits[0].sysexit_name = "Foo" ;
 303    Exits[0].sysexit_code = RXSIO ;
 304    Exits[1].sysexit_code = RXENDLST ;
 305
 306    Instore[0].strptr =
 307      "pull bar;say bar;push 'foo';pull bar;say bar;parse pull bar;say bar" ;
 308    Instore[0].strlength = strlen( Instore[0].strptr ) ;
 309    Instore[1].strptr = NULL ;
 310
 311    rc = RexxStart( 0, NULL, "Testing", Instore, "Foo", RXCOMMAND,
 312                    Exits, NULL, NULL ) ;
 313
 314    RexxDeregisterExit( "Foo", NULL ) ;
 315 }
 316
 317
 318 LONG APIENTRY env_exit( LONG ExNum, LONG Subfun, PEXIT PBlock )
 319 {
 320    static int cnt=0 ;
 321    static char data[10];
 322    RXENVGET_PARM *penvget;
 323    RXENVSET_PARM *penvset;
 324
 325    iverify( "Exitfunction", ExNum, RXENV ) ;
 326    switch (++cnt)
 327    {
 328        case 1:
 329           iverify( "Subfunction", Subfun, RXENVGET ) ;
 330           penvget = (RXENVGET_PARM *)PBlock;
 331           sverify( "Envget name", &(penvget->rxenv_name),"FRED");
 332           assign_new_rxstring( &penvget->rxenv_value, "initial" );
 333           break ;
 334
 335        case 2:
 336           iverify( "Subfunction", Subfun, RXENVSET ) ;
 337           penvset = (RXENVSET_PARM *)PBlock;
 338           sverify( "Envset name", &(penvset->rxenv_name),"FRED");
 339           sverify( "Envset value", &(penvset->rxenv_value),"junk");
 340           strcpy( data, "mess" );
 341           break ;
 342
 343        case 3:
 344           iverify( "Subfunction", Subfun, RXENVGET ) ;
 345           penvget = (RXENVGET_PARM *)PBlock;
 346           sverify( "Envget name", &(penvget->rxenv_name),"FRED");
 347           assign_new_rxstring( &penvget->rxenv_value, data );
 348           break ;
 349
 350        default:
 351           fprintf( stderr, "Out of order msg subfunc=%ld\n", Subfun) ;
 352           return RXEXIT_NOT_HANDLED ;
 353    }
 354    return RXEXIT_HANDLED ;
 355 }
 356
 357 static void env( void )
 358 {
 359    RXSTRING Instore[2] ;
 360    RXSYSEXIT Exits[2] ;
 361    int rc ;
 362
 363    message( "env") ;
 364
 365    RexxRegisterExitExe( "Foo", env_exit, NULL ) ;
 366
 367    Exits[0].sysexit_name = "Foo" ;
 368    Exits[0].sysexit_code = RXENV ;
 369    Exits[1].sysexit_code = RXENDLST ;
 370
 371    Instore[0].strptr =
 372      "call value 'FRED', 'junk', 'ENVIRONMENT'; if value('FRED',,'ENVIRONMENT') <> 'mess' then say 'setenv/getenv failed'" ;
 373    Instore[0].strlength = strlen( Instore[0].strptr ) ;
 374    Instore[1].strptr = NULL ;
 375
 376    rc = RexxStart( 0, NULL, "Testing", Instore, "Foo", RXCOMMAND,
 377                    Exits, NULL, NULL ) ;
 378
 379    RexxDeregisterExit( "Foo", NULL ) ;
 380 }
 381
 382
 383
 384
 385 LONG APIENTRY query_init_exit( LONG ExNum, LONG Subfun, PEXIT PBlock )
 386 {
 387    char *name="TEST1" ;
 388    int rc ;
 389    char result[100];
 390    ULONG dup;
 391    RXSTRING data;
 392
 393    data.strptr = result;
 394    rc = RexxCreateQueue( result, sizeof(result), name, &dup ) ;
 395    iverify( "Query Init exit", rc, RXQUEUE_OK ) ;
 396    data.strlength = strlen(result);
 397    sverify( "Query Init exit", &data, name ) ;
 398    iverify( "Query Init dup", dup, 0L ) ;
 399
 400    data.strptr = "line1";
 401    data.strlength = strlen(data.strptr);
 402    rc = RexxAddQueue( name, &data, RXQUEUE_FIFO ) ;
 403    iverify( "Query Init exit", rc, RXQUEUE_OK ) ;
 404
 405    data.strptr = "line2";
 406    data.strlength = strlen(data.strptr);
 407    rc = RexxAddQueue( name, &data, RXQUEUE_FIFO ) ;
 408    iverify( "Query Init exit", rc, RXQUEUE_OK ) ;
 409
 410    return RXEXIT_HANDLED ;
 411 }
 412
 413 LONG APIENTRY query_term_exit( LONG ExNum, LONG Subfun, PEXIT PBlock )
 414 {
 415    int rc ;
 416    ULONG count;
 417    RXSTRING data;
 418    DATETIME timestamp;
 419
 420    rc = RexxQueryQueue( "FRED", &count ) ;
 421    iverify( "Query Term exit", rc, RXQUEUE_OK ) ;
 422    iverify( "Query Term count", count, 2L ) ;
 423
 424    data.strptr = NULL;
 425    rc = RexxPullQueue( "FRED", &data, &timestamp, RXQUEUE_NOWAIT );
 426    iverify( "Query Term exit", rc, RXQUEUE_OK ) ;
 427    sverify( "Query Term data", &data, "2line" ) ;
 428    RexxFreeMemory( data.strptr ) ;
 429
 430    data.strptr = NULL;
 431    rc = RexxPullQueue( "FRED", &data, &timestamp, RXQUEUE_NOWAIT );
 432    iverify( "Query Term exit", rc, RXQUEUE_OK ) ;
 433    sverify( "Query Term data", &data, "1line" ) ;
 434    RexxFreeMemory( data.strptr ) ;
 435
 436    rc = RexxDeleteQueue( "FRED" );
 437    iverify( "Query Term exit", rc, RXQUEUE_OK ) ;
 438
 439    rc = RexxDeleteQueue( "TEST1" );
 440    iverify( "Query Term exit", rc, RXQUEUE_OK ) ;
 441
 442    return RXEXIT_HANDLED ;
 443 }
 444
 445 LONG APIENTRY it_init_exit( LONG ExNum, LONG Subfun, PEXIT PBlock )
 446 {
 447    SHVBLOCK shv ;
 448    char *name="FOO" ;
 449    int rc ;
 450    char *value="foz" ;
 451
 452    shv.shvnext = NULL ;
 453    shv.shvname.strptr = name ;
 454    shv.shvnamelen = shv.shvname.strlength = strlen(name) ;
 455    shv.shvvalue.strptr = value ;
 456    shv.shvvaluelen = shv.shvvalue.strlength = strlen(value) ;
 457    shv.shvcode = RXSHV_SYSET ;
 458
 459    rc = RexxVariablePool( &shv ) ;
 460    iverify( "Init exit", rc, RXSHV_NEWV ) ;
 461    iverify( "Init exit", shv.shvret, RXSHV_NEWV ) ;
 462    return RXEXIT_HANDLED ;
 463 }
 464
 465
 466 LONG APIENTRY it_term_exit( LONG ExNum, LONG Subfun, PEXIT PBlock )
 467 {
 468    SHVBLOCK shv ;
 469    char *name ;
 470    int rc ;
 471    char value[64] ;
 472
 473    strcpy( value, "" ) ;
 474    shv.shvnext = NULL ;
 475    name = "MYVAR" ;
 476    shv.shvname.strptr = name ;
 477    shv.shvnamelen = shv.shvname.strlength = strlen(name) ;
 478    shv.shvvalue.strptr = value ;
 479    shv.shvvaluelen = 64 ;
 480    shv.shvcode = RXSHV_SYFET ;
 481
 482    rc = RexxVariablePool( &shv ) ;
 483    iverify( "Term exit", rc, RXSHV_NEWV ) ;
 484    iverify( "Term exit", shv.shvret, RXSHV_NEWV ) ;
 485    sverify( "Term exit:", &(shv.shvvalue), "MYVAR" ) ;
 486
 487    shv.shvnext = NULL ;
 488    name = "bar" ;
 489    shv.shvname.strptr = name ;
 490    shv.shvnamelen = shv.shvname.strlength = strlen(name) ;
 491
 492    /* The value is the same as above (value) and therefore valid */
 493 #if 0
 494     shv.shvvalue.strptr = value ;
 495     shv.shvvaluelen = 64 ;
 496    shv.shvvalue.strlength = strlen(value) ; /* not allowed! not 0-terminated */
 497 #endif
 498    shv.shvcode = RXSHV_SYFET ;
 499
 500    rc = RexxVariablePool( &shv ) ;
 501    iverify( "Term exit", rc, RXSHV_OK ) ;
 502    iverify( "Term exit", shv.shvret, RXSHV_OK ) ;
 503    sverify( "Term exit:", &(shv.shvvalue), "baz" ) ;
 504
 505    return RXEXIT_HANDLED ;
 506 }
 507
 508
 509 LONG APIENTRY it_say_exit( LONG ExNum, LONG Subfun, PEXIT PBlock )
 510 {
 511    SHVBLOCK shv ;
 512    char *name ;
 513    int rc ;
 514    char value[64] ;
 515    RXSIOSAY_PARM *psiosay;
 516
 517    iverify( "Say exit", ExNum, RXSIO ) ;
 518    iverify( "Say exit", Subfun, RXSIOSAY ) ;
 519    psiosay = (RXSIOSAY_PARM *)PBlock;
 520    sverify( "Say exit", &(psiosay->rxsio_string), "foz" ) ;
 521
 522    shv.shvnext = NULL ;
 523    name = "myvar.1" ;
 524    shv.shvname.strptr = name ;
 525    shv.shvnamelen = shv.shvname.strlength = strlen(name) ;
 526    shv.shvvalue.strptr = value ;
 527    shv.shvvaluelen = 64 ;
 528    shv.shvcode = RXSHV_SYFET ;
 529
 530    rc = RexxVariablePool( &shv ) ;
 531    iverify( "Say exit", rc, RXSHV_NEWV ) ;
 532    iverify( "Say exit", shv.shvret, RXSHV_NEWV ) ;
 533    sverify( "Say exit:", &(shv.shvvalue), "MYVAR.1" ) ;
 534
 535    return RXEXIT_HANDLED ;
 536 }
 537
 538 static void init_term(void)
 539 {
 540    RXSTRING Instore[2] ;
 541    RXSYSEXIT Exits[4] ;
 542    int rc ;
 543
 544    message( "init/term" ) ;
 545
 546    RexxRegisterExitExe( "init", it_init_exit, NULL ) ;
 547    RexxRegisterExitExe( "term", it_term_exit, NULL ) ;
 548    RexxRegisterExitExe( "say", it_say_exit, NULL ) ;
 549
 550    Exits[0].sysexit_name = "init" ;
 551    Exits[0].sysexit_code = RXINI ;
 552    Exits[1].sysexit_name = "term" ;
 553    Exits[1].sysexit_code = RXTER ;
 554    Exits[2].sysexit_name = "say" ;
 555    Exits[2].sysexit_code = RXSIO ;
 556    Exits[3].sysexit_code = RXENDLST ;
 557
 558    Instore[0].strptr =
 559      "say foo\n\n\nbar='baz'\nexit" ;
 560    Instore[0].strlength = strlen( Instore[0].strptr ) ;
 561    Instore[1].strptr = NULL ;
 562
 563    rc = RexxStart( 0, NULL, "Testing", Instore, "Foo", RXCOMMAND,
 564                    Exits, NULL, NULL ) ;
 565
 566    RexxDeregisterExit( "init", NULL ) ;
 567    RexxDeregisterExit( "term", NULL ) ;
 568    RexxDeregisterExit( "say", NULL ) ;
 569 }
 570
 571
 572
 573 LONG APIENTRY vars_exit( LONG ExNum, LONG Subfun, PEXIT PBlock )
 574 {
 575    SHVBLOCK shv[10] ;
 576    int rc ;
 577    RXSIOSAY_PARM *psiosay;
 578
 579    iverify( "Say exit", ExNum, RXSIO ) ;
 580    iverify( "Say exit", Subfun, RXSIOSAY ) ;
 581
 582    psiosay = (RXSIOSAY_PARM *)PBlock;
 583    sverify( "Say exit", &(psiosay->rxsio_string), "Hello" ) ;
 584
 585    shv[0].shvnext = &(shv[1]) ;
 586    shv[0].shvname.strptr = "BAR" ;
 587    shv[0].shvname.strlength = strlen( shv[0].shvname.strptr ) ;
 588    shv[0].shvnamelen = shv[0].shvname.strlength ;
 589    shv[0].shvvalue.strptr = "B-value-AR" ;
 590    shv[0].shvvalue.strlength = strlen( shv[0].shvvalue.strptr ) ;
 591    shv[0].shvvaluelen = shv[0].shvvalue.strlength ;
 592    shv[0].shvcode = RXSHV_SYSET ;
 593
 594    /* Try to get it with lower case letters */
 595    shv[1].shvnext = &(shv[2]) ;
 596    shv[1].shvname.strptr = "bar " ;
 597    shv[1].shvname.strlength = strlen( shv[1].shvname.strptr ) ;
 598    shv[1].shvnamelen = shv[1].shvname.strlength ;
 599    shv[1].shvvalue.strptr = (char *)RexxAllocateMemory( 64 ) ;
 600    shv[1].shvvalue.strlength = 64 ;
 601    shv[1].shvvaluelen = shv[1].shvvalue.strlength ;
 602    shv[1].shvcode = RXSHV_SYFET ;
 603
 604    /* then we use capital letters */
 605    shv[2].shvnext = &(shv[3]) ;
 606    shv[2].shvname.strptr = "BAR" ;
 607    shv[2].shvname.strlength = strlen( shv[2].shvname.strptr ) ;
 608    shv[2].shvnamelen = shv[2].shvname.strlength ;
 609    shv[2].shvvalue.strptr = (char *)RexxAllocateMemory( 64 ) ;
 610    shv[2].shvvalue.strlength = 64 ;
 611    shv[2].shvvaluelen = shv[2].shvvalue.strlength ;
 612    shv[2].shvcode = RXSHV_SYFET ;
 613
 614    /* Then we set it to something else */
 615    shv[3].shvnext = &(shv[4]) ;
 616    shv[3].shvname.strptr = "BAR" ;
 617    shv[3].shvname.strlength = strlen( shv[3].shvname.strptr ) ;
 618    shv[3].shvnamelen = shv[3].shvname.strlength ;
 619    shv[3].shvvalue.strptr = "new value" ;
 620    shv[3].shvvalue.strlength = strlen( shv[3].shvvalue.strptr ) ;
 621    shv[3].shvvaluelen = shv[3].shvvalue.strlength ;
 622    shv[3].shvcode = RXSHV_SYSET ;
 623
 624    /* And get it */
 625    shv[4].shvnext = &(shv[5]) ;
 626    shv[4].shvname.strptr = "BAR" ;
 627    shv[4].shvname.strlength = strlen( shv[4].shvname.strptr ) ;
 628    shv[4].shvnamelen = shv[4].shvname.strlength ;
 629    shv[4].shvvalue.strptr = (char *)RexxAllocateMemory( 64 ) ;
 630    shv[4].shvvalue.strlength =  64 ;
 631    shv[4].shvvaluelen = shv[4].shvvalue.strlength ;
 632    shv[4].shvcode = RXSHV_SYFET ;
 633
 634    /* And drop it */
 635    shv[5].shvnext = &(shv[6]) ;
 636    shv[5].shvname.strptr = "BAR" ;
 637    shv[5].shvname.strlength = strlen( shv[5].shvname.strptr ) ;
 638    shv[5].shvnamelen = shv[5].shvname.strlength ;
 639    shv[5].shvvalue.strptr = NULL ;
 640    shv[5].shvvalue.strlength = 0 ;
 641    shv[5].shvvaluelen = shv[5].shvvalue.strlength ;
 642    shv[5].shvcode = RXSHV_SYDRO ;
 643
 644    /* And then we try to get it again */
 645    shv[6].shvnext = &(shv[7]) ;
 646    shv[6].shvname.strptr = "BAR" ;
 647    shv[6].shvname.strlength = strlen( shv[6].shvname.strptr ) ;
 648    shv[6].shvnamelen = shv[6].shvname.strlength ;
 649    shv[6].shvvalue.strptr = (char *)RexxAllocateMemory( 64 ) ;
 650    shv[6].shvvalue.strlength = 64 ;
 651    shv[6].shvvaluelen = shv[6].shvvalue.strlength ;
 652    shv[6].shvcode = RXSHV_SYFET ;
 653
 654    shv[7].shvnext = &(shv[8]) ;
 655    shv[7].shvname.strptr = "FOO" ;
 656    shv[7].shvname.strlength = strlen( shv[7].shvname.strptr ) ;
 657    shv[7].shvnamelen = shv[7].shvname.strlength ;
 658    shv[7].shvvalue.strptr = "OOPS" ;
 659    shv[7].shvvalue.strlength = strlen( shv[7].shvvalue.strptr ) ;
 660    shv[7].shvvaluelen = shv[7].shvvalue.strlength ;
 661    shv[7].shvcode = RXSHV_SYSET ;
 662
 663    shv[8].shvnext = &(shv[9]) ;
 664    shv[8].shvname.strptr = "ABC.FOO" ;
 665    shv[8].shvname.strlength = strlen( shv[8].shvname.strptr ) ;
 666    shv[8].shvnamelen = shv[8].shvname.strlength ;
 667    shv[8].shvvalue.strptr = "hello, there! ... this is a long string" ;
 668    shv[8].shvvalue.strlength = strlen( shv[8].shvvalue.strptr ) ;
 669    shv[8].shvvaluelen = shv[8].shvvalue.strlength ;
 670    shv[8].shvcode = RXSHV_SYSET ;
 671
 672    shv[9].shvnext = NULL ;
 673    shv[9].shvname.strptr = "ABC.OOPS" ;
 674    shv[9].shvname.strlength = strlen( shv[9].shvname.strptr ) ;
 675    shv[9].shvnamelen = shv[9].shvname.strlength ;
 676    shv[9].shvvalue.strptr = (char *)RexxAllocateMemory(16) ;
 677    shv[9].shvvalue.strlength = 16 ;
 678    shv[9].shvvaluelen = shv[9].shvvalue.strlength ;
 679    shv[9].shvcode = RXSHV_SYFET ;
 680
 681
 682    rc = RexxVariablePool( shv ) ;
 683    iverify( "Term exit", rc, RXSHV_TRUNC | RXSHV_BADN | RXSHV_NEWV ) ;
 684
 685    iverify( "Term exit1 ", shv[0].shvret, RXSHV_NEWV ) ;
 686    iverify( "Term exit2 ", shv[1].shvret, RXSHV_BADN ) ;
 687    iverify( "Term exit3 ", shv[2].shvret, RXSHV_OK ) ;
 688    iverify( "Term exit4 ", shv[3].shvret, RXSHV_OK ) ;
 689    iverify( "Term exit5 ", shv[4].shvret, RXSHV_OK ) ;
 690    iverify( "Term exit6 ", shv[5].shvret, RXSHV_OK ) ;
 691    iverify( "Term exit7 ", shv[6].shvret, RXSHV_NEWV ) ;
 692    iverify( "Term exit8 ", shv[7].shvret, RXSHV_NEWV ) ;
 693    iverify( "Term exit9 ", shv[8].shvret, RXSHV_NEWV ) ;
 694    iverify( "Term exit10", shv[9].shvret, RXSHV_TRUNC ) ;
 695
 696
 697    sverify( "Term exit1 ", &(shv[2].shvvalue), "B-value-AR" ) ;
 698    sverify( "Term exit2 ", &(shv[4].shvvalue), "new value" ) ;
 699    sverify( "Term exit3 ", &(shv[6].shvvalue), "BAR" ) ;
 700    sverify( "Term exit4 ", &(shv[9].shvvalue), "hello, there! .." ) ;
 701
 702    return RXEXIT_HANDLED ;
 703 }
 704
 705 static void vars(void)
 706 {
 707    RXSTRING Instore[2] ;
 708    RXSYSEXIT Exits[4] ;
 709    int rc ;
 710
 711    message( "vars" ) ;
 712
 713    RexxRegisterExitExe( "hepp", vars_exit, NULL ) ;
 714
 715    Exits[0].sysexit_name = "hepp" ;
 716    Exits[0].sysexit_code = RXSIO ;
 717    Exits[1].sysexit_code = RXENDLST ;
 718
 719    Instore[0].strptr =
 720      "say 'Hello'" ;
 721    Instore[0].strlength = strlen( Instore[0].strptr ) ;
 722    Instore[1].strptr = NULL ;
 723
 724    rc = RexxStart( 0, NULL, "Testing", Instore, "Foo", RXCOMMAND,
 725                    Exits, NULL, NULL ) ;
 726
 727    RexxDeregisterExit( "hepp", NULL ) ;
 728 }
 729
 730
 731
 732
 733 LONG APIENTRY source_exit( LONG code, LONG subcode, PEXIT ptr )
 734 {
 735    SHVBLOCK Req[6] ;
 736
 737    Req[0].shvnext = &(Req[1]) ;
 738    Req[0].shvcode = RXSHV_PRIV ;
 739    Req[0].shvname.strptr = "SOURCE" ;
 740    Req[0].shvname.strlength = strlen( Req[0].shvname.strptr ) ;
 741    Req[0].shvnamelen = Req[0].shvname.strlength ;
 742    Req[0].shvvalue.strptr = NULL ;
 743
 744    Req[1].shvnext = &(Req[2]) ;
 745    Req[1].shvcode = RXSHV_PRIV ;
 746    Req[1].shvname.strptr = "VERSION" ;
 747    Req[1].shvname.strlength = strlen( Req[1].shvname.strptr ) ;
 748    Req[1].shvnamelen = Req[1].shvname.strlength ;
 749    Req[1].shvvalue.strptr = NULL ;
 750
 751    Req[2].shvnext = &(Req[3]) ;
 752    Req[2].shvcode = RXSHV_PRIV ;
 753    Req[2].shvname.strptr = "PARM" ;
 754    Req[2].shvname.strlength = strlen( Req[2].shvname.strptr ) ;
 755    Req[2].shvnamelen = Req[2].shvname.strlength ;
 756    Req[2].shvvalue.strptr = NULL ;
 757
 758    Req[3].shvnext = &(Req[4]) ;
 759    Req[3].shvcode = RXSHV_PRIV ;
 760    Req[3].shvname.strptr = "PARM.1" ;
 761    Req[3].shvname.strlength = strlen( Req[3].shvname.strptr ) ;
 762    Req[3].shvnamelen = Req[3].shvname.strlength ;
 763    Req[3].shvvalue.strptr = NULL ;
 764
 765    Req[4].shvnext = &(Req[5]) ;
 766    Req[4].shvcode = RXSHV_PRIV ;
 767    Req[4].shvname.strptr = "PARM.2" ;
 768    Req[4].shvname.strlength = strlen( Req[4].shvname.strptr ) ;
 769    Req[4].shvnamelen = Req[4].shvname.strlength ;
 770    Req[4].shvvalue.strptr = NULL ;
 771
 772    Req[5].shvnext = NULL ;
 773    Req[5].shvcode = RXSHV_PRIV ;
 774    Req[5].shvname.strptr = "QUENAME" ;
 775    Req[5].shvname.strlength = strlen( Req[5].shvname.strptr ) ;
 776    Req[5].shvnamelen = Req[5].shvname.strlength ;
 777    Req[5].shvvalue.strptr = NULL ;
 778
 779    iverify( "Termin exit", code, RXTER ) ;
 780    iverify( "Termin exit", subcode, RXTEREXT ) ;
 781
 782    RexxVariablePool( Req ) ;
 783
 784    iverify( "Source", Req[0].shvret, RXSHV_OK ) ;
 785    iverify( "Version", Req[1].shvret, RXSHV_OK ) ;
 786    if (memcmp(Req[1].shvvalue.strptr, "REXX", 4 ))
 787       mycomplain( "Invalid Rexx source string\n" ) ;
 788
 789    iverify( "Parms", Req[2].shvret, RXSHV_OK ) ;
 790    sverify( "Parms", &(Req[2].shvvalue), "1" ) ;
 791
 792    iverify( "Parm1a", Req[3].shvret, RXSHV_OK ) ;
 793    sverify( "Parm1b", &(Req[3].shvvalue), "one two three" ) ;
 794
 795    iverify( "Parm2a", Req[4].shvret, RXSHV_OK ) ;
 796    sverify( "Parm2b", &(Req[4].shvvalue), NULL ) ;
 797
 798    iverify( "QueName", Req[5].shvret, RXSHV_OK ) ;
 799    sverify( "QueName", &(Req[5].shvvalue), "SESSION" ) ;
 800
 801    return RXEXIT_HANDLED ;
 802 }
 803
 804
 805
 806 static void source( void )
 807 {
 808    RXSYSEXIT Exits[2] ;
 809    RXSTRING Instore[2] ;
 810    RXSTRING Params[2] ;
 811    int rc ;
 812
 813    message("private") ;
 814
 815    RexxRegisterExitExe("hei", source_exit, NULL ) ;
 816
 817    Exits[0].sysexit_name = "hei" ;
 818    Exits[0].sysexit_code = RXTER ;
 819    Exits[1].sysexit_code = RXENDLST ;
 820
 821    Params[0].strptr = "one two three" ;
 822    Params[0].strlength = strlen( Params[0].strptr ) ;
 823
 824    Instore[0].strptr = "nop" ;
 825    Instore[0].strlength = strlen( Instore[0].strptr ) ;
 826    Instore[1].strptr = NULL ;
 827
 828    rc = RexxStart( 1, Params, "Testing", Instore, "Foo", RXCOMMAND,
 829                    Exits, NULL, NULL ) ;
 830
 831    RexxDeregisterExit( "hei", NULL ) ;
 832 }
 833
 834
 835
 836
 837 LONG APIENTRY parms( LONG code, LONG subcode, PEXIT ptr )
 838 {
 839    RXSYSEXIT Exits[2] ;
 840    RXSTRING Instore[2] ;
 841    RXSTRING Params[5] ;
 842    int rc ;
 843    static int done = 0 ;
 844
 845    if (code == -1)
 846    {
 847       message("parms") ;
 848
 849       RexxRegisterExitExe("hei", parms, NULL ) ;
 850
 851       Exits[0].sysexit_name = "hei" ;
 852       Exits[0].sysexit_code = RXTER ;
 853       Exits[1].sysexit_code = RXENDLST ;
 854
 855       Params[0].strptr = "one two three" ;
 856       Params[0].strlength = strlen( Params[0].strptr ) ;
 857       Params[1].strptr = NULL ;
 858       Params[1].strlength = 5 ;
 859       Params[2].strptr = "" ;
 860       Params[2].strlength = strlen( Params[2].strptr ) ;
 861       Params[3].strptr = "four five" ;
 862       Params[3].strlength = strlen( Params[3].strptr ) ;
 863       Params[4].strptr = NULL ;
 864       Params[4].strlength = 10 ;
 865
 866       Instore[0].strptr = "nop" ;
 867       Instore[0].strlength = strlen( Instore[0].strptr ) ;
 868       Instore[1].strptr = NULL ;
 869
 870       rc = RexxStart( 5, Params, "Testing", Instore, "Foo", RXFUNCTION,
 871                       Exits, NULL, NULL ) ;
 872
 873       if (!done)
 874          printf("not done\n") ;
 875
 876       RexxDeregisterExit( "hei", NULL ) ;
 877       return 0 ;
 878    }
 879    else
 880    {
 881       SHVBLOCK Req[7] ;
 882
 883       done = 1 ;
 884       Req[0].shvnext = &(Req[1]) ;
 885       Req[0].shvcode = RXSHV_PRIV ;
 886       Req[0].shvname.strptr = "PARM" ;
 887       Req[0].shvname.strlength = strlen( Req[0].shvname.strptr ) ;
 888       Req[0].shvnamelen = Req[0].shvname.strlength ;
 889       Req[0].shvvalue.strptr = NULL ;
 890
 891       Req[1].shvnext = &(Req[2]) ;
 892       Req[1].shvcode = RXSHV_PRIV ;
 893       Req[1].shvname.strptr = "PARM.1" ;
 894       Req[1].shvname.strlength = strlen( Req[1].shvname.strptr ) ;
 895       Req[1].shvnamelen = Req[1].shvname.strlength ;
 896       Req[1].shvvalue.strptr = NULL ;
 897
 898       Req[2].shvnext = &(Req[3]) ;
 899       Req[2].shvcode = RXSHV_PRIV ;
 900       Req[2].shvname.strptr = "PARM.2" ;
 901       Req[2].shvname.strlength = strlen( Req[2].shvname.strptr ) ;
 902       Req[2].shvnamelen = Req[2].shvname.strlength ;
 903       Req[2].shvvalue.strptr = NULL ;
 904
 905       Req[3].shvnext = &(Req[4]) ;
 906       Req[3].shvcode = RXSHV_PRIV ;
 907       Req[3].shvname.strptr = "PARM.3" ;
 908       Req[3].shvname.strlength = strlen( Req[3].shvname.strptr ) ;
 909       Req[3].shvnamelen = Req[3].shvname.strlength ;
 910       Req[3].shvvalue.strptr = NULL ;
 911
 912       Req[4].shvnext = &(Req[5]) ;
 913       Req[4].shvcode = RXSHV_PRIV ;
 914       Req[4].shvname.strptr = "PARM.4" ;
 915       Req[4].shvname.strlength = strlen( Req[4].shvname.strptr ) ;
 916       Req[4].shvnamelen = Req[4].shvname.strlength ;
 917       Req[4].shvvalue.strptr = NULL ;
 918
 919       Req[5].shvnext = &(Req[6]) ;
 920       Req[5].shvcode = RXSHV_PRIV ;
 921       Req[5].shvname.strptr = "PARM.5" ;
 922       Req[5].shvname.strlength = strlen( Req[5].shvname.strptr ) ;
 923       Req[5].shvnamelen = Req[5].shvname.strlength ;
 924       Req[5].shvvalue.strptr = NULL ;
 925
 926       Req[6].shvnext = NULL ;
 927       Req[6].shvcode = RXSHV_PRIV ;
 928       Req[6].shvname.strptr = "PARM.6" ;
 929       Req[6].shvname.strlength = strlen( Req[6].shvname.strptr ) ;
 930       Req[6].shvnamelen = Req[6].shvname.strlength ;
 931       Req[6].shvvalue.strptr = NULL ;
 932
 933       iverify( "Termin exit", code, RXTER ) ;
 934       iverify( "Termin exit", subcode, RXTEREXT ) ;
 935
 936       RexxVariablePool( Req ) ;
 937
 938       iverify( "Parm", Req[0].shvret, RXSHV_OK ) ;
 939       sverify( "Parm", &(Req[0].shvvalue), "5" ) ;
 940
 941       iverify( "Parm1", Req[1].shvret, RXSHV_OK ) ;
 942       sverify( "Parm1", &(Req[1].shvvalue), "one two three" ) ;
 943
 944       iverify( "Parm2", Req[2].shvret, RXSHV_OK ) ;
 945       sverify( "Parm2", &(Req[2].shvvalue), NULL ) ;
 946
 947       iverify( "Parm3", Req[3].shvret, RXSHV_OK ) ;
 948       sverify( "Parm3", &(Req[3].shvvalue), "" ) ;
 949
 950       iverify( "Parm4", Req[4].shvret, RXSHV_OK ) ;
 951       sverify( "Parm4", &(Req[4].shvvalue), "four five" ) ;
 952
 953       iverify( "Parm5", Req[5].shvret, RXSHV_OK ) ;
 954       sverify( "Parm5", &(Req[5].shvvalue), NULL ) ;
 955
 956       iverify( "Parm6", Req[6].shvret, RXSHV_OK ) ;
 957       sverify( "Parm6", &(Req[6].shvvalue), NULL ) ;
 958
 959       return RXEXIT_HANDLED ;
 960    }
 961 }
 962
 963
 964
 965
 966
 967 LONG APIENTRY allvars( LONG code, LONG subcode, PEXIT ptr )
 968 {
 969    RXSYSEXIT Exits[2] ;
 970    RXSTRING Instore[2] ;
 971    RXSTRING Params[5] ;
 972    int rc ;
 973    static int done = 0 ;
 974
 975    if (code == -1)
 976    {
 977       message("allvars") ;
 978
 979       RexxRegisterExitExe("hei", allvars, NULL ) ;
 980
 981       Exits[0].sysexit_name = "hei" ;
 982       Exits[0].sysexit_code = RXTER ;
 983       Exits[1].sysexit_code = RXENDLST ;
 984
 985       Params[0].strptr = "one two three" ;
 986       Params[0].strlength = strlen( Params[0].strptr ) ;
 987       Params[1].strptr = NULL ;
 988       Params[1].strlength = 5 ;
 989       Params[2].strptr = "" ;
 990       Params[2].strlength = strlen( Params[2].strptr ) ;
 991       Params[3].strptr = "four five" ;
 992       Params[3].strlength = strlen( Params[3].strptr ) ;
 993       Params[4].strptr = NULL ;
 994       Params[4].strlength = 10 ;
 995
 996       Instore[0].strptr = "foo='one';bar='';foo.='two';foo.bar='three';"
 997                           "foo.4='four';foo.5='five';drop foo.5 foo.6" ;
 998
 999       Instore[0].strlength = strlen( Instore[0].strptr ) ;
1000       Instore[1].strptr = NULL ;
1001
1002       rc = RexxStart( 5, Params, "Testing", Instore, "Foo", RXFUNCTION,
1003                       Exits, NULL, NULL ) ;
1004
1005       if (!done)
1006          printf("not done\n") ;
1007
1008       RexxDeregisterExit( "hei", NULL ) ;
1009       return 0 ;
1010    }
1011    else
1012    {
1013       SHVBLOCK Req[10] ;
1014       int i ;
1015
1016       done = 1 ;
1017       for (i=0; i<10; i++)
1018       {
1019           Req[i].shvnext = (i<10-1) ? (&(Req[i+1])) : NULL ;
1020           Req[i].shvcode = RXSHV_NEXTV ;
1021           Req[i].shvname.strptr = Req[i].shvvalue.strptr = NULL ;
1022       }
1023
1024       iverify( "Termin exit", code, RXTER ) ;
1025       iverify( "Termin exit", subcode, RXTEREXT ) ;
1026
1027       RexxVariablePool( Req ) ;
1028
1029       iverify( "Parm0", Req[0].shvret, RXSHV_OK ) ;
1030       sverify( "Parm0a", &(Req[0].shvname), "BAR" ) ;
1031       sverify( "Parm0b", &(Req[0].shvvalue), "" ) ;
1032
1033       iverify( "Parm1", Req[1].shvret, RXSHV_OK ) ;
1034       sverify( "Parm1a", &(Req[1].shvname), "FOO." ) ;
1035       sverify( "Parm1b", &(Req[1].shvvalue), "three" ) ;
1036
1037       iverify( "Parm2", Req[2].shvret, RXSHV_OK ) ;
1038       sverify( "Parm2a", &(Req[2].shvname), "FOO.4" ) ;
1039       sverify( "Parm2b", &(Req[2].shvvalue), "four" ) ;
1040
1041       iverify( "Parm3", Req[3].shvret, RXSHV_OK ) ;
1042       sverify( "Parm3a", &(Req[3].shvname), "FOO.5" ) ;
1043       sverify( "Parm3b", &(Req[3].shvvalue), "FOO.5" ) ;
1044
1045       iverify( "Parm4", Req[4].shvret, RXSHV_OK ) ;
1046       sverify( "Parm4a", &(Req[4].shvname), "FOO.6" ) ;
1047       sverify( "Parm4b", &(Req[4].shvvalue), "FOO.6" ) ;
1048
1049       iverify( "Parm5", Req[5].shvret, RXSHV_OK ) ;
1050       sverify( "Parm5a", &(Req[5].shvname), "FOO." ) ;
1051       sverify( "Parm5b", &(Req[5].shvvalue), "two" ) ;
1052
1053       iverify( "Parm6", Req[6].shvret, RXSHV_OK ) ;
1054       sverify( "Parm6a", &(Req[6].shvname), "FOO" ) ;
1055       sverify( "Parm6b", &(Req[6].shvvalue), "one" ) ;
1056
1057       iverify( "Parm", Req[7].shvret, RXSHV_LVAR ) ;
1058       iverify( "Parm", Req[8].shvret, RXSHV_OK ) ;
1059       iverify( "Parm", Req[9].shvret, RXSHV_OK ) ;
1060
1061       return RXEXIT_HANDLED ;
1062    }
1063 }
1064
1065
1066
1067
1068
1069
1070 ULONG APIENTRY extfunc( PCSZ name, ULONG params, RXSTRING *parm, PCSZ stck, RXSTRING *ptr )
1071 {
1072    RXSTRING Instore[2] ;
1073    RXSTRING Result ;
1074    int rc ;
1075    short nret ;
1076    static int done = 0 ;
1077
1078    if (name == NULL)
1079    {
1080       message("extfunc") ;
1081
1082       RexxRegisterFunctionExe("EXTFUNC", extfunc ) ;
1083
1084       Instore[0].strptr = "return extfunc('asdf','qwer',,'zxcv') + 'EXTFUNC'('asdf',,'wer','werrew')" ;
1085       Instore[0].strlength = strlen( Instore[0].strptr ) ;
1086       Instore[1].strptr = NULL ;
1087
1088       Result.strlength = 10 ;
1089       Result.strptr = (char *)RexxAllocateMemory( 10 ) ;
1090
1091       rc = RexxStart( 0, NULL, "Testing", Instore, "Foo", RXFUNCTION,
1092                       NULL, &nret, &Result ) ;
1093
1094       sverify( "extfunc", &Result, "7" ) ;
1095       iverify( "extfunc", nret, 7 ) ;
1096
1097       if (!done)
1098          printf("not done\n") ;
1099
1100       RexxDeregisterFunction( "EXTFUNC" ) ;
1101       return 0 ;
1102    }
1103    else
1104    {
1105       static int once=0 ;
1106
1107       done = 1 ;
1108       if (!once)
1109       {
1110          ptr->strptr[0] = '3' ;
1111          ptr->strlength = 1 ;
1112          once = 1 ;
1113       }
1114       else
1115       {
1116          ptr->strptr[0] = '4' ;
1117          ptr->strlength = 1 ;
1118       }
1119       return 0 ;
1120    }
1121 }
1122
1123 LONG APIENTRY subcom_exit( LONG ExNum, LONG Subfun, PEXIT PBlock )
1124 {
1125    RXCMDHST_PARM *pcmdhst;
1126
1127    iverify( "Subcom Funcion", ExNum, RXCMD ) ;
1128    iverify( "Subcom Subfunc", Subfun, RXCMDHST ) ;
1129    pcmdhst = (RXCMDHST_PARM *)PBlock;
1130    pcmdhst->rxcmd_retc.strlength = 2;
1131    strcpy(pcmdhst->rxcmd_retc.strptr,"16");
1132
1133    return RXEXIT_HANDLED ;
1134 }
1135
1136 ULONG APIENTRY run_subcom(PRXSTRING Command, PUSHORT Flags, PRXSTRING Retstr)
1137 {
1138    RXSYSEXIT Exits[4] ;
1139    RXSTRING Instore[2] ;
1140    RXSTRING Result ;
1141    int rc ;
1142    short nret ;
1143
1144    if (Command == NULL)
1145    {
1146       message("subcom") ;
1147
1148       RexxRegisterExitExe( "slhepp", subcom_exit, NULL ) ;
1149
1150       Exits[0].sysexit_name = "slhepp" ;
1151       Exits[0].sysexit_code = RXCMD ;
1152       Exits[1].sysexit_code = RXENDLST ;
1153
1154       RexxRegisterSubcomExe("SUBCOM", run_subcom, NULL ) ;
1155
1156       Instore[0].strptr = "'foobar asdf qwer'" ;
1157       Instore[0].strlength = strlen( Instore[0].strptr ) ;
1158       Instore[1].strptr = NULL ;
1159
1160       Result.strlength = 20 ;
1161       Result.strptr = (char *)RexxAllocateMemory( 20 ) ;
1162
1163       rc = RexxStart( 0, NULL, "Testing", Instore, "SUBCOM", RXCOMMAND,
1164                       Exits, &nret, &Result ) ;
1165
1166 /*      sverify( "subcom result", &Result, "16" ) ; */
1167 /*      iverify( "subcom retc", nret, 16 ) ; */
1168
1169       RexxDeregisterSubcom( "SUBCOM" , NULL) ;
1170       RexxDeregisterExit( "slhepp", NULL ) ;
1171
1172       return 0 ;
1173    }
1174    else
1175    {
1176       sprintf(Retstr->strptr,"%ld",Command->strlength) ;
1177       Retstr->strlength = strlen(Retstr->strptr);
1178       *Flags = RXSUBCOM_OK;
1179       return 0 ;
1180    }
1181
1182 }
1183
1184 static void qtest( void )
1185 {
1186    RXSTRING Instore[2] ;
1187    RXSYSEXIT Exits[3] ;
1188    int rc ;
1189    char result[100];
1190    ULONG dup;
1191
1192    message( "queue" ) ;
1193
1194    rc = RexxCreateQueue( result, sizeof(result), NULL, &dup ) ;
1195    iverify( "qtest-before", rc, RXQUEUE_OK ) ;
1196    iverify( "qtest-before", dup, 0L ) ;
1197
1198    Exits[0].sysexit_name = "query_init" ;
1199    Exits[0].sysexit_code = RXINI ;
1200    Exits[1].sysexit_name = "query_term" ;
1201    Exits[1].sysexit_code = RXTER ;
1202    Exits[2].sysexit_code = RXENDLST ;
1203    RexxRegisterExitExe( "query_init", query_init_exit, NULL ) ;
1204    RexxRegisterExitExe( "query_term", query_term_exit, NULL ) ;
1205
1206    Instore[0].strptr = "call rxqueue 'Set', 'test1';"
1207                        "if queued() \\= 2 then say 'error:line 2';"
1208                        "parse pull line;"
1209                        "if line \\= 'line1' then say 'error:line 4';"
1210                        "parse pull line;"
1211                        "if line \\= 'line2' then say 'error:line 5';"
1212                        "if rxqueue('Create','FRED') \\= 'FRED' then say 'error:line 6';"
1213                        "if rxqueue('Set','FRED') \\= 'TEST1' then say 'error:line 7';"
1214                        "push '1line';push '2line';" ;
1215    Instore[0].strlength = strlen( Instore[0].strptr ) ;
1216    Instore[1].strptr = NULL ;
1217    rc = RexxStart( 0, NULL, "Testing", Instore, "Foo", RXCOMMAND,
1218                    Exits, NULL, NULL ) ;
1219
1220    RexxFreeMemory( Instore[1].strptr ) ;
1221    RexxDeregisterExit( "query_init", NULL ) ;
1222    RexxDeregisterExit( "query_term", NULL ) ;
1223
1224    rc = RexxDeleteQueue( result );
1225    iverify( "qtest-after", rc, RXQUEUE_OK ) ;
1226 }
1227
1228 static void (*(routines[]))(void) = {
1229     instore,
1230     trace,
1231     intertrc,
1232     pull,
1233     env,
1234     init_term,
1235     vars,
1236     source,
1237     NULL
1238 } ;
1239
1240
1241 static RexxExitHandler *(exits[]) = {
1242    parms,
1243    allvars,
1244    NULL
1245 } ;
1246
1247
1248 static RexxFunctionHandler *(efuncs[]) = {
1249    extfunc,
1250    NULL
1251 } ;
1252
1253 static RexxSubcomHandler *(scfuncs[]) = {
1254    run_subcom,
1255    NULL
1256 } ;
1257
1258 char char82( void )
1259 {
1260    return (char) 0x82;
1261 }
1262
1263 char char0( void )
1264 {
1265    return '\0';
1266 }
1267
1268 int main( int argc, char *argv[] )
1269 {
1270    void (**fptr)( void ) ;
1271    RexxExitHandler **eptr ;
1272    RexxFunctionHandler **gptr ;
1273    RexxSubcomHandler **sptr;
1274    RXSTRING version;
1275    ULONG versioncode;
1276
1277    /* We want to see surprisings at once: */
1278    setvbuf(stdout,NULL,_IONBF,0);
1279    setvbuf(stderr,NULL,_IONBF,0);
1280    printf( "Regina Rexx API Tester\n" );
1281    printf( "----------------------\n" );
1282
1283    version.strlength = 0;
1284    version.strptr = NULL;
1285    /* This might not work if we check another Rexx: */
1286    versioncode = ReginaVersion(&version);
1287    printf("Regina's version is %lu.%lu",
1288           versioncode >> 8,
1289           versioncode & 0xFF);
1290    if (version.strptr)
1291    {
1292       printf(" (in complete \"%s\")",version.strptr);
1293       RexxFreeMemory(version.strptr);
1294    }
1295    printf("\n");
1296
1297    if ( char82() < char0() )
1298       printf( "WARNING: Current compiler uses `signed char' as default!\n" );
1299
1300    for( fptr=routines; *fptr; fptr++ )
1301       (*fptr)() ;
1302
1303    for( eptr=exits; *eptr; eptr++ )
1304       (*eptr)( -1, -1, NULL ) ;
1305
1306    for( gptr=efuncs; *gptr; gptr++ )
1307       (*gptr)( NULL, 0, NULL, NULL, NULL ) ;
1308
1309    for( sptr=scfuncs; *sptr; sptr++ )
1310       (*sptr)( NULL, 0, NULL ) ;
1311 #if !defined(NO_EXTERNAL_QUEUES)
1312    qtest();
1313 #endif
1314    ReginaCleanup();
1315    printf( "\n" ) ;
1316    return 0 ;
1317 }