/* ------------------------------------------------------------------------- */
/* REXFUNDG: - Diagnostic package for REXX builtin functions.                */
/*                                                                           */
/*    Parameters: NONE                                                       */
/*                                                                           */
/*    Invocation: from OS/2 full screen prompt \batch]snf002                 */
/*                                                                           */
/*    Uses OS2 environment variables to determine testcase drive.            */
/* ------------------------------------------------------------------------- */
arg parm.1 comments
'cls'
say ''
if left(parm.1,1) = '?' then signal INFO_PLEASE
/* ------------------------------------------------------------------------- */
os2drv = value('PCM_BOOTDRV',,'OS2ENVIRONMENT') /* get OS2 boot drive letter */
tstdrv = value('PCM_TESTDRV',,'OS2ENVIRONMENT') /* get testcase drive letter */
if pos(os2drv,'CDEFGHIJKLMNOPQRSTUVWXYZ') = 0 then do
   say '[1;09;41m ***************************************************************[0;40;37m'
   say '[1;09;41m * OS2 environment variable PCM_BOOTDRV not set.  Run PCMSETUP *[0;40;37m'
   say '[1;09;41m * to update config.sys, then shutdown & reboot to continue.   *[0;40;37m'
   say '[1;09;41m ***************************************************************[0;40;37m'
   exit
   end
if pos(tstdrv,'CDEFGHIJKLMNOPQRSTUVWXYZ') = 0 then do
   say '[1;09;41m ***************************************************************[0;40;37m'
   say '[1;09;41m * OS2 environment variable PCM_TESTDRV not set.  Run PCMSETUP *[0;40;37m'
   say '[1;09;41m * to update config.sys, then shutdown & reboot to continue.   *[0;40;37m'
   say '[1;09;41m ***************************************************************[0;40;37m'
   exit
   end

/* ------------------------------------------------------------------------- */
parse source . . commname .;
arg function fns;
hi=' ';lo=' ';
if function='?' then do;
  say 'Test out REX builtin functions.';
  say 'Call as:'hi commname lo'<fn1 fn2 ......>';
  say 'The default is to try ALL the functions.';
  exit 100; end;

signal on syntax;  /* Trap syntax errors */
trace off
call initialise;   /* Set up function names, and variables */

tstfn='parse arg arg; if retry then trace int;',
   'if erroron then do; fnresult=1; signal value fn||err; end;';
evaluate='trace off; signal tell;';
retry = 0;                             /* Initialise error flag       */

errors = function='ERRORS'
if errors then do; parse var fns function fns; fnresult='1'; end;
tststr=functions;

if functionª='' then tststr=function fns;

do while tststrª='';                   /* 'TSTSTR' contains functions */
  parse var tststr fn tststr;          /* Test ONE at a time          */
  actual=fn;                           /* copy for internal use       */
  erroron = errors;                    /* Basic tests before errors   */
  say 'Calling' actual'...';
  interpret 'CALL !'actual;            /* Call function on test       */
  if ªfnresult then do;                /* Error somewhere.....        */
    say 'Proceed to next function?';   /* Might wish to test others.. */
    pull a +1 .; if a='N' then exit;
    end;
end;
exit;

/************************** Trap syntax errors ************************/
syntax: trace off;
  signal on syntax;                    /* Reset SYNTAX error handling */
  if rc=43 then do;                    /* Unknown label - or rc=43 ?  */
    say 'That function ('fn') does not exist.';
    exit rc;
    end;
  if rcª=40 & rc \=26 & rcª=24 & rc \=41 then do
                                       /* RCª=40 means error in exec  */
                                       /* RC=24, invalid TRACE request*/
    say 'Unexpected error ('rc') running test routine. Please check';
    do i=sigl-1 to sigl+1;
      say i':'sourceline(i);
    end;
    say 'Error text:'hi||errortext(rc) lo
    say 'Line in error is' sigl;
    exit rc;
    end;
  else do;                             /* RC=40 means function error  */
    if erroron then return 1;          /* Deliberately testing errors */
    else do;                           /* BAD RESULT - analyse        */
      if retry then do;                /* Second time through now...  */
        say ' Function'hi|| fn ||lo'still has a syntax error';
        retry=0;                       /* Reset retry flag            */
        end
      else do;                         /* First occurrence of error   */
        say 'Invalid call to function'hi||fn lo' Retry.....?';
        pull a +1 .; retry=   a='Y';
        if retry then do;
                      say 'Calling' actual'...';
                      interpret 'call !'actual;
                      end;
        end;
      end;
    return 0;
    end;                               /* RC == 40                    */


/*************************************/
/** Test each function individually **/
/*************************************/


/**********************************************************************/
/* ABBREV(keyword_string, test_string <,min_length>)                  */
/*  returns 0 or 1                                                    */
/*  Test whether 'test_string' is a valid abbreviation of 'keyword'.  */
/*  Test string must be at least 'min_length'. Error if 'keyword' is  */
/*  null,  matches if test is null.                                   */

!ABBREV: interpret tstfn;
    fnresult= '1'==abbrev('abcdef','abc');
    if fnresult then fnresult= '1'==abbrev(123,12);
    if fnresult then fnresult= '1'==abbrev(123,123);
    if fnresult then fnresult= '0'==abbrev(124,123);
    if fnresult then fnresult= '0'==abbrev(124,122);
    if fnresult then fnresult= '0'==abbrev(123,12,3);
    if fnresult then fnresult= '0'==abbrev(123,'',3);
    if fnresult then fnresult= '1'==abbrev(123,'',0);
    if fnresult then fnresult= '0'==Abbrev("muddy", "much", 0)
 ABBREVERR:   /* Now test errors for ABBREV function       */
    if fnresult then do;
      erroron=1;
      call error 'abbrev()';    /* No arguments..              */
      if result then call error 'abbrev(s)'; /* Only one arg   */
      if result then call error 'abbrev(123,123,bb)'; /* Number*/
      if result then call error 'abbrev(123,123,1,1)';/* 4 args*/
      if result then call error 'abbrev(,123,1)';  /* Null arg */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* ABS(NUMBER)                                                        */
/*  where NUMBER is a valid REX number. The absolute (positive) value */
/*  is returned.                                                      */

!ABS:      interpret tstfn;
    fnresult= '3'==abs('3');
    if fnresult then fnresult= '3'==abs(' - 3 ');
    if fnresult then fnresult= '3'==abs(-3);
    if fnresult then fnresult= '3.71'==abs(-3.71);
    if fnresult then fnresult= '3.71'==abs(3.71*1);
 ABSERR:   /* Now test errors for ABS function       */
    if fnresult then do;
      erroron=1;
      call error 'abs(sss)';           /* Non-numeric argument..      */
      if result then call error 'abs()';    /* At least one arg       */
      if result then call error 'abs(1,1)'; /* Only one arg           */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* ADDRESS()                                                          */
/*  returns current address environment                               */

!ADDRESS:  interpret tstfn;
    initial_address = 'CMD';
    fnresult=  address()==initial_address;
    if fnresult then do;
      address boo;
      fnresult= 'BOO' == address();
      fnresult= 'BOO' == address(,);
      address;
      end;
 ADDRESSERR:   /* Now test errors for ADDRESS function       */
    if fnresult then do;
      erroron=1;
      call error 'address(a)';         /* Pass an argument..          */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* ARG: Use as: ARG(<n <, <Option>>>)                                 */
/*                                                                    */
/* Purpose:  Allow internal/external functions to accurately          */
/*           check on the input ARG string(s).                        */
/*                                                                    */
/* Input:  none                                                       */
/* Output: Count of ARG string(s) present                             */
/*                                                                    */
/* Input:  n                                                          */
/* Output: The 'n'th ARG string (may be null)                         */
/*         If N > ARG() a null string is returned                     */
/*         An Error is signalled if n<=0                              */
/*                                                                    */
/* Input:  n, Option                                                  */
/*         where Option is 'Exists' or 'Omitted', first letter        */
/*         only significant.  Check on ARG string N.                  */
/*         If N > ARG(), ARG(N) is assumed to be omitted              */
/*         An Error is signalled if n<=0                              */

!ARG:  interpret tstfn;
    fnresult=  argtest()==0 0 1 ''
    if fnresult then fnresult= arg()==0
    if fnresult then fnresult= arg(,)==0
    if fnresult then fnresult= argtest(a,b,c,d)==4 1 0 a
    if fnresult then fnresult= argtest( , )    ==0 0 1 ''
 ARGERR:   /* Now test errors for ARG function       */
    if fnresult then do;
      erroron=1;
      call error 'arg(1e12)';          /* Number too big              */
      if result then call error 'arg(,"E")'; /* Pass null first arg   */
      if result then call error 'arg(1,"E",2)'; /* Too many parameters */
      if result then call error 'arg(1,"X" )'; /* Bad second arg      */
      fnresult=result;
      end;
    interpret evaluate;

 ARGTEST:  /* Internal function to evaluate ARG function */
          /* Return result of ARG() ARG(1,E) ARG(1,O) ARG(1) */
    return arg() arg(1,'e') arg(1,'O') arg(1)

/**********************************************************************/
/* BITAND(string1,string2<,pad>)                                      */
/* String1 is logically ANDed with string2, byte for byte, until the  */
/* shorter of the two strings is exhausted. Each result byte replaces */
/* the corresponding byte of the longer string, and the longer string */
/* is then returned as the result.  If a pad byte is specified, then  */
/* the shorter string is extended on the right with the pad byte.     */
/* The two strings may be of any length.                              */

!BITAND:      interpret tstfn;
     fnresult =    bitand('1111'x,'222222'x)     == '000022'x
    if fnresult then fnresult =  bitand('string') == 'string'
    if fnresult then fnresult =  bitand(string)   == string
    if fnresult then fnresult =  bitand(longstring a) == longstring a
    if fnresult then
       fnresult =  bitand('1111'x,'222222'x,' ') == '000020'x
    if fnresult then
       fnresult =  bitand('1111'x,'444444'x)     == '000044'x
    if fnresult then
       fnresult =  bitand('1111'x,'444444'x,' ') == '000000'x
    if fnresult then
       fnresult =  bitand('1256'x,'3f3f'x)       == '1216'x
 BITANDERR:   /* Now test errors for BITAND function       */
    if fnresult then do;
      erroron=1;
      call error 'bitand( )';                   /* At least one arg   */
      if result then call error 'bitand( ,1)';  /* Bad first arg      */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* BITOR(string1,string2<,pad>)                                       */
/* String1 is logically ORed with string2, byte for byte, until the   */
/* shorter of the two strings is exhausted. Each result byte replaces */
/* the corresponding byte of the longer string, and the longer string */
/* is then returned as the result.  If a pad byte is specified, then  */
/* the shorter string is extended on the right with the pad byte.     */
/* The two strings may be of any length.                              */

!BITOR:       interpret tstfn;
     fnresult =    bitor('1111'x,'222222'x)     == '333322'x
    if fnresult then fnresult =  bitor('string') == 'string'
    if fnresult then fnresult =  bitor(string)   == string
    if fnresult then fnresult =  bitor(longstring a) == longstring a
    if fnresult then
       fnresult =  bitor('1111'x,'222222'x,' ') == '333322'x
    if fnresult then
       fnresult =  bitor('1111'x,'444444'x)     == '555544'x
    if fnresult then
       fnresult =  bitor('1111'x,'444444'x,' ') == '555564'x
    if fnresult then
       fnresult =  bitor('1111'x,'')            == '1111'x
    if fnresult then
       fnresult =  bitor('1111'x,'',' ')        == '3131'x
    if fnresult then
       fnresult =  bitor('1234'x,'4040'x)       == '5274'x
 BITORERR:   /* Now test errors for BITOR function       */
    if fnresult then do;
      erroron=1;
                     call error 'bitor( )';     /* At least one arg   */
      if result then call error 'bitor( ,1)';   /* Bad first arg      */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* BITXOR(string1,string2<,pad>)                                      */
/* String1 is logically XORed with string2, byte for byte, until the  */
/* shorter of the two strings is exhausted. Each result byte replaces */
/* the corresponding byte of the longer string, and the longer string */
/* is then returned as the result.  If a pad byte is specified, then  */
/* the shorter string is extended on the right with the pad byte.     */
/* The two strings may be of any length.                              */

!BITXOR:      interpret tstfn;
     fnresult =    bitxor('1111'x,'222222'x)     == '333322'x
    if fnresult then fnresult =  bitxor('string') == 'string'
    if fnresult then fnresult =  bitxor(string)   == string
    if fnresult then fnresult =  bitxor(longstring a) == longstring a
    if fnresult then
       fnresult =  bitxor('1111'x,'222222'x,' ') == '333302'x
    if fnresult then
       fnresult =  bitxor('1111'x,'444444'x)     == '555544'x
    if fnresult then
       fnresult =  bitxor('1111'x,'444444'x,' ') == '555564'x
 BITXORERR:   /* Now test errors for BITXOR function       */
    if fnresult then do;
      erroron=1;
                     call error 'bitxor( )';    /* At least one arg   */
      if result then call error 'bitxor( ,1)';  /* Bad first arg      */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* B2X(BINSTRING)                                                     */
/* Where BINSTRING is a string of valid bin codes (e.g. C'011010')    */
/* and may be of any length. The packed string is returned. Blanks    */
/* may be inserted to improve readability (e.g. B2X(1ff 11110000)) at */
/* byte boundaries.  A leading zero is added if required.             */
!B2X:      interpret tstfn;
    fnresult=                   b2x('001001010101')      == 255
    if fnresult then fnresult=  b2x('1010 10111100')     == 'ABC'
    if fnresult then fnresult=  b2x('10100001')          == 'A1'
    if fnresult then fnresult=  b2x('10010 10100001')    == '12A1'
    if fnresult then fnresult=  b2x('10100001 11110000') == 'A1F0'
    if fnresult then fnresult=  b2x('1010 00011111')     == 'A1F'
 B2XERR:   /* Now test errors for B2X function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'b2x();'              /* No argument specified       */
      if result then call error 'b2x(,)';             /* Invalid call       */
      if result then call error 'b2x(" 1010")';       /* Invalid call       */
      if result then call error 'b2x("1010 10 10")';  /* Invalid call       */
      if result then call error 'b2x(" 1010 1010")';  /* Invalid call       */
      if result then call error 'b2x("1010 1010 ")';  /* Invalid call       */
      if result then call error 'b2x("    ")';        /* Invalid call       */
      if result then call error 'b2x("h")';           /* Invalid bin digit  */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* CENTRE(STRING,K<,PAD>)     (synonyms:   CENTER, CENT)              */
/*  where STRING is a valid REX string (and may be the null string).  */
/*  1 <= k <= MAXPOS.  Note: Large "k" may exhaust machine storage.   */
/*  K must be an integer value.  PAD is a one character string.       */

!CENTRE:     interpret tstfn;
    fnresult= ' 14 '==centre(14,4);
    if fnresult then fnresult=  '234'==centre(12345,3);
    if fnresult then fnresult=  '   ab  cd  '==centre(' ab  cd',11)
    if fnresult then fnresult=  ' ab  cd '==centre(' ab  cd',8)
    if fnresult then fnresult=  ' ab  cd,'==centre(' ab  cd',8,',')
    if fnresult then fnresult=  '--234--'==centre(234,7,'-');
 CENTREERR:   /* Now test errors for CENTRE function       */
    if fnresult then do;
      erroron=1;
      call error 'centre()';           /* No argument provided        */
      if result then call error 'centre(1,a)';     /* Non-numeric     */
      if result then call error 'centre(1, )';     /* No length       */
      if result then call error 'centre(1,3,"")';  /* Missing padchar */
      if result then call error 'centre(1,3,"zz")';  /* L'Pad > 1     */
      if result then call error 'centre(1,3,"c",z)'; /* Four args     */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* COMPARE(STRING1,STRING2<,PAD>)                                     */
/*  where STRING1/STRING2 are valid REX strings (and may be null).    */
/*  If no padding character is supplied a blank is assumed.           */
/*  PAD is a SINGLE character.                                        */

!COMPARE:  interpret tstfn;
    fnresult= compare('abcdef','abcdef')==0;
    if fnresult then fnresult= compare('abcdef','abcdFf')==5;
    if fnresult then fnresult= compare('abcdef','abcd f')==5;
    if fnresult then fnresult= Compare('',' ') ==0;
    if fnresult then fnresult= Compare('','a') ==1;
    if fnresult then fnresult= Compare('ab','a')==2;
    if fnresult then fnresult= Compare('a','ab')==2;
    if fnresult then fnresult= Compare('a','ab','X')==2;
    if fnresult then do;
      string=copies('1',256);
      fnresult= compare(string,'1','1')== 0
      if fnresult then fnresult= compare(string,'1')== 2
      if fnresult then fnresult= compare(longstring'1','a','a')== 301
      drop string;
      end;
 COMPAREERR:   /* Now test errors for COMPARE function       */
    if fnresult then do;
      erroron=1;                       /* Flag deliberate errors      */
      call error 'compare(1)';         /* No argument provided        */
      if result then call error 'compare(1,2,"")';
      if result then call error 'compare(1,2,,2)';
      if result then call error 'compare(1,3,"zz")';
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* COPIES(STRING,N)                                                   */
/*  where STRING is a valid REX string (and may be the null string).  */
/*  K is a non-negative integer.                                      */

!COPIES:   interpret tstfn;
    fnresult= copies('123-',3)=='123-123-123-';
    if fnresult then fnresult= copies('aa',0)=='';
    if fnresult then fnresult= copies('b',4)=='bbbb';
    if fnresult then fnresult= copies('bc',4)=='bcbcbcbc';
    if fnresult then fnresult= copies('abc',1)=='abc';
    if fnresult then fnresult= Copies('',2)=='';
 COPIESERR:   /* Now test errors for COPIES function       */
    if fnresult then do;
      erroron=1;                       /* Flag deliberate errors      */
      call error 'copies()';           /* No arguments                */
      if result then call error 'copies(,2)'; /* Missing first arg.   */
      if result then call error 'copies(1)';  /* Only one argument    */
      if result then call error 'copies(1,2,3)';  /* Three arguments  */
      if result then call error 'copies(1, )';    /* Missing 2nd arg. */
      if result then call error 'copies(1,b)';    /* Non-numeric      */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* C2D(STRING)                                                        */

!C2D:      interpret tstfn;
    fnresult=                   c2d('FF'x)         == 255
    if fnresult then fnresult=  c2d('FF')          == 17990
    if fnresult then fnresult=  c2d('FF'x,1)       == -1
    if fnresult then fnresult=  c2d('01'x)         == 1
    if fnresult then fnresult=  c2d('FFFFFFFE'x,4) == -2
    if fnresult then fnresult=  c2d('FFFFFE'x,3)   == -2
 C2DERR:   /* Now test errors for C2D function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'c2d();'              /* No argument specified       */
      if result then call error 'c2d(,)';       /* Invalid call       */
      if result then do;
/*      parse numeric digits .;*/
        digits=digits()
        numeric digits 2;
        call error 'c2d("65"x)';       /* 101 does not fit            */
        if result then call error 'c2d("ff9b"x,2)'; /* nor does -101  */
        numeric digits digits;         /* Reset to previous value     */
        end;
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* C2X(STRING)                                                        */

!C2X:      interpret tstfn;
    fnresult=                   c2x(255)         == '323535'
    if fnresult then fnresult=  c2x('fffffffe'x) == 'FFFFFFFE'
    if fnresult then fnresult=  c2x('-1')        == '2D31'
 C2XERR:   /* Now test errors for C2X function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'c2x();'             /* No argument specified       */
      if result then call error 'c2x(,)';      /* Invalid call       */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* DATATYPE(STRING<,Type>)                                            */
/*  where STRING is a valid REX string (and may be the null string).  */
/*  Type is an optional type to match against (1st letter significant)*/
/*  With no type, the returned result is NUM or CHAR                  */
/*  When type is given the result is 0 (false) or 1 (true). The null  */
/*  string will always result in 0 being returned                     */
/*  Valid types are: W - whole number check                           */
/*                   N - numeric check                                */
/*                   B - string is 0s and/or 1s only                  */
/*                   A - alphanumeric, a-z, A-Z and 0-9               */
/*                   X - a-f, A-F, and 0-9                            */
/*                   U - Upper case A-Z                               */
/*                   L - lower case a-z                               */
/*                   M - Mixed case a-z and A-Z                       */
/*                   S - symbol, characters valid in a REX symbol     */

!DATATYPE:
    interpret tstfn;
    fnresult= datatype('0')=='NUM';
    if fnresult then fnresult= datatype('1.23')=='NUM';
    if fnresult then fnresult= datatype('01.1234567890')=='NUM';
    if fnresult then fnresult= datatype('1234567890.3')=='NUM';
    if fnresult then fnresult= datatype('123.3e-4')=='NUM';
    if fnresult then fnresult= datatype('A')  =='CHAR';
    if fnresult then fnresult= datatype('.')  =='CHAR';
    if fnresult then fnresult= datatype('')   =='CHAR';
    if fnresult then fnresult= datatype('',)  =='CHAR';

    if fnresult then fnresult= datatype(1,'n')=='1';
    if fnresult then fnresult= datatype(1e200,'n')=='1';
    if fnresult then fnresult= datatype(1ee1,'n')=='0';
    if fnresult then fnresult= datatype(1.11,'N')=='1';
    if fnresult then fnresult= datatype(1e200,'W')=='0';
    if fnresult then fnresult= datatype(1e2,'W')=='1';
    if fnresult then fnresult= datatype(1.11e2,'W')=='1';
    if fnresult then fnresult= datatype(1.11,'W')=='0';

    if fnresult then fnresult= datatype(1e2,'A')=='1';
    if fnresult then fnresult= datatype('e2+','A')=='0';
    if fnresult then fnresult= datatype('1e20'x,'A')=='0';
    if fnresult then fnresult= datatype(longstring,'L')=='1';
    if fnresult then fnresult= datatype(longstring'A','L')=='0';
    if fnresult then fnresult= datatype('1e2','L')=='0';
    if fnresult then fnresult= datatype('abc','L')=='1';
    if fnresult then fnresult= datatype('aaA','L')=='0';
    if fnresult then fnresult= datatype('1e2','U')=='0';
    if fnresult then fnresult= datatype('ABC','U')=='1';
    if fnresult then fnresult= datatype('aaA','U')=='0';
    if fnresult then fnresult= datatype('1e2','M')=='0';
    if fnresult then fnresult= datatype('ABC+','M')=='0';
    if fnresult then fnresult= datatype('aaA','M')=='1';

/****************** Split into two pages on printout ******************/
    if fnresult then fnresult= datatype(111,'B')=='1';
    if fnresult then fnresult= datatype(110,'B')=='1';
    if fnresult then fnresult= datatype(1e2,'B')=='0';
    if fnresult then fnresult= datatype(1e2,'S')=='1';
    if fnresult then fnresult= datatype('_+,.','S')=='0';
    if fnresult then fnresult= datatype('_!?.','S')=='1';
    if fnresult then fnresult= datatype(1e2,'X')=='1';
    if fnresult then fnresult= datatype('1e2','X')=='1';
    if fnresult then fnresult= datatype('gG','X')=='0';
    if fnresult then fnresult= datatype('  ','X')=='0';
    if fnresult then fnresult= datatype('aA Bb','X')=='1';
    if fnresult then fnresult= datatype('','N')=='0';
    if fnresult then fnresult= datatype('','W')=='0';
    if fnresult then fnresult= datatype('','A')=='0';
    if fnresult then fnresult= datatype('','U')=='0';
    if fnresult then fnresult= datatype('','L')=='0';
    if fnresult then fnresult= datatype('','M')=='0';
    if fnresult then fnresult= datatype('','S')=='0';
    if fnresult then fnresult= datatype('','B')=='0';
    if fnresult then fnresult= datatype('','X')=='1'; /* "" is valid */

    if fnresult then fnresult= datatype(c256,'M')=='1';
    if fnresult then fnresult= datatype(c256||'A','M')=='1';
    if fnresult then fnresult= datatype(c256||'A','L')=='0';
    if fnresult then fnresult= datatype(c256||'1','m')=='0';

 DATATYPEERR:   /* Now test errors for DATATYPE function       */
    if fnresult then do;
      erroron=1;                       /* Flag deliberate errors      */
      call error 'datatype(,)';
      if result then call error 'datatype(1,2)';
      if result then call error 'datatype(1,n,1)';
      if result then call error 'datatype(1,"")';
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* DELSTR(STRING,N<,K>)                                               */
/*  where STRING is a valid REX string (and may be the null string).  */
/*  N is a POSITIVE integer value.  K is a non-negative INTEGER value */

!DELSTR:   interpret tstfn;
    fnresult= 'S'==delstr('STRING',2);
    if fnresult then fnresult= 'SG'==delstr('STRING',2,4);
    if fnresult then fnresult= 'STRING'==delstr('STRING',8,4);
    if fnresult then fnresult= ''==delstr('STRING',1,111);
    if fnresult then fnresult= ''==delstr('',2);
 DELSTRERR:   /* Now test errors for DELSTR function       */
    if fnresult then do;
      erroron=1;                       /* Flag deliberate errors      */
      call error 'delstr("string",)';  /* Missing numeric             */
      if result then call error 'delstr("abc",a)'; /* Invalid numeric */
      if result then call error 'delstr(,2)';/* Missing string        */
      if result then call error 'delstr()';  /* No arguments at all   */
      if result then call error 'delstr("ab",2,"")'; /* Bad 3rd arg.  */
      if result then call error 'delstr("ab",,2)'; /* Bad second arg. */
      if result then call error 'delstr("ab",1,2,3,xx)'; /* Five args */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* DELWORD(STRING,N<,K>)                                              */
/*  where STRING is a valid REX string (and may be the null string).  */
/*  N is a POSITIVE integer value.  K is a non-negative INTEGER value */

!DELWORD:  interpret tstfn;
    fnresult= ' abc '==delword(' xyz abc ',1,1);
    if fnresult then fnresult= ' abc '==delword(' xyz  p abc ',1,2);
    if fnresult then fnresult=' ee abc '==delword(' ee xyz  p abc ',2,2)
    if fnresult then fnresult= ' yyy '==delword(' yyy xyz  p',2,2);
    if fnresult then fnresult= ' yyy '==delword(' yyy xyz  p',2);
    if fnresult then fnresult= ' yyy '==delword(' yyy xyz  p',2,);
 DELWORDERR:   /* Now test errors for DELWORD function       */
    if fnresult then do;
      erroron=1;                       /* Flag deliberate errors      */
      call error 'delword("string",,)'; /* Missing numeric            */
      if result then call error 'delword("abc",a)'; /* Invalid numeric*/
      if result then call error 'delword(,2)';/* Missing string       */
      if result then call error 'delword()';  /* No arguments at all  */
      if result then call error 'delword("ab",,2)'; /* Bad second arg.*/
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* D2C(NUMBER<,K>)                                                    */
/*  where NUMBER is in the -(MAXPOS+1) -> MAXPOS                      */
/*  K is integer in the range 1 to 4.                                 */

!D2C:      interpret tstfn;
    fnresult=                  d2c(255)         == 'FF'x
    if fnresult then fnresult= d2c(255,4)       == '000000FF'x
    if fnresult then fnresult= d2c(-1,7)        == 'FFFFFFFFFFFFFF'x
    if fnresult then fnresult= d2c(-1,2)        == 'FFFF'x
    if fnresult then fnresult= d2c(305419896)   =='12345678'x
    if fnresult then fnresult= d2c(305419896,6) =='000012345678'x
    if fnresult then fnresult= d2c(-305419896,4)=='edcba988'x
    if fnresult then fnresult= d2c(-305419896,6)=='FFFFedcba988'x
 D2CERR:   /* Now test errors for D2C function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'd2c()';              /* No arguments specified      */
      if result then call error 'd2c(aaa)'; /* Non-numeric argument   */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* D2X(NUMBER<,K>)                                                    */
/*  where NUMBER is in the -(MAXPOS+1) -> MAXPOS                      */
/*  K is integer in the range 1 to 8.                                 */

!D2X:      interpret tstfn;
    fnresult=                  d2x(255)          == 'FF'
    if fnresult then fnresult= d2x(255,10)       == '00000000FF'
    if fnresult then fnresult= d2x(-1,8)         == 'FFFFFFFF'
    if fnresult then fnresult= d2x(-1,4)         == 'FFFF'
    if fnresult then fnresult= d2x(305419896)    =='12345678'
    if fnresult then fnresult= d2x(305419896,12) =='000012345678'
    if fnresult then fnresult= d2x(-305419896,8) =='EDCBA988'
    if fnresult then fnresult= d2x(-305419896,12)=='FFFFEDCBA988'
    if fnresult then do; /* Now large numbers */
      numeric digits 40;
      large=2**34;
      fnresult                 = d2x(large)     == myd2x(large)
      if fnresult then fnresult= d2x(-large,12) == myd2x(-large,12)
      if fnresult then fnresult= d2x(-large-3,12) == myd2x(-large-3,12)
      numeric digits;  /* Reset to default */
      end;
 D2XERR:   /* Now test errors for D2X function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'd2x()';              /* No arguments specified      */
      if result then call error 'd2x(aaa)'; /* Non-numeric argument   */
      if result then call error 'd2x(-1 )'; /* Non-numeric argument   */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* ERRORTEXT(n)   Return error message text corresponding to given    */
/*                REX error code.                                     */
!ERRORTEXT:   interpret tstfn;
    fnresult= errortext('0')==''
    if fnresult then fnresult= errortext(5)=='Machine resources exhausted'
    if fnresult then fnresult= errortext(15)=='Invalid hexadecimal or binary string'
    if fnresult then fnresult= errortext(43)=='Routine not found'
 ERRORTEXTERR:   /* Now test errors for ERRORTEXT function       */
    if fnresult then do;
      erroron=1;                       /* Flag deliberate errors      */
      call error 'errortext()';           /* No arguments             */
      if result then call error 'errortext(,)'; /* Missing first arg. */
      if result then call error 'errortext(b)'; /* Non-numeric        */
      if result then call error 'errortext(100)'; /* Number too big   */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* FILESPEC(REQUEST, STRING)                                          */
/*  where STRING is a valid REX string containing drive+path+filename */
/*  and REQUEST is 'DRIVE', 'PATH' or 'NAME'.                         */

!FILESPEC: interpret tstfn;
    fnresult= os2drv':'==filespec('DRIVE',os2drv':\MISC\SUB\MISC_NEW.TXT');
    if fnresult then
      fnresult= '\MISC\SUB\'==filespec('PATH',os2drv':\MISC\SUB\MISC_NEW.TXT');
    if fnresult then
      fnresult= 'MISC_NEW.TXT'==filespec('NAME',os2drv':\MISC\SUB\MISC_NEW.TXT');
    if fnresult then
      fnresult= os2drv':'==filespec('DRIVE',os2drv':MISC_NEW.TXT');
    if fnresult then
      fnresult= os2drv':'==filespec('DRIVE',os2drv':\MISC\SUB\');
    if fnresult then
      fnresult= os2drv':'==filespec('DRIVE',os2drv':');
    if fnresult then
      fnresult= '\MISC\SUB\'==filespec('PATH','\MISC\SUB\MISC_NEW.TXT');
    if fnresult then
      fnresult= '\MISC\SUB\'==filespec('PATH',os2drv':\MISC\SUB\');
    if fnresult then
      fnresult= '\MISC\SUB\'==filespec('PATH','\MISC\SUB\');
    if fnresult then
      fnresult= 'MISC_NEW.TXT'==filespec('NAME','\MISC\SUB\MISC_NEW.TXT');
    if fnresult then
      fnresult= 'MISC_NEW.TXT'==filespec('NAME',os2drv':MISC_NEW.TXT');
    if fnresult then
      fnresult= 'MISC_NEW.TXT'==filespec('NAME','MISC_NEW.TXT');
    if fnresult then
      fnresult= ''==filespec('DRIVE','\MISC\SUB\MISC_NEW.TXT');
    if fnresult then
      fnresult= ''==filespec('PATH',os2drv':MISC_NEW.TXT');
    if fnresult then
      fnresult= ''==filespec('NAME',os2drv':\MISC\SUB\');
 FILESPECERR:  /* Now test errors for FILESPEC function       */
    if fnresult then do;
      erroron=1;
      call error 'filespec()';             /* No argument provided        */
      if result then call error 'filespec(,"a:\c\b.d")'; /* Missing string       */
      if result then call error 'filespec("drive",)'; /* Missing phrase       */
      if result then call error 'filespec("drive","a:\c\b.d",1)'; /* 3 arguments      */
      if result then call error 'filespec("drive",,)';    /* Bad 2nd argument */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* FORMAT(NUMBER<,<BEFORE><,<AFTER><,<EXPP><,EXPT>>>>)                */

!FORMAT: interpret tstfn; /* Diagnostics for FORMAT function */
/* First no format control */
   fnresult=      format(12.3)             == 12.3;
if fnresult then fnresult= format(' - 12.3 ')       == -12.3;
if fnresult then fnresult= format(' + 12.3 ')       == 12.3;

/* Control integer part */
if fnresult then fnresult= format('12.3 ',2)        == 12.3;
if fnresult then fnresult= format('12.3 ',9)        == '       12.3';
if fnresult then fnresult= format(-'12.3 ',9)       == '      -12.3';
if fnresult then fnresult= format('12.3 ',10)       == '        12.3';
str=format('-12.3 ',400);
if fnresult then
   fnresult= 'LENGTH'(str)=402 & str=='COPIES'(' ', 390)'       -12.3';

/* Control both parts */
if fnresult then fnresult= format('0',2,1)          == ' 0.0'
if fnresult then fnresult= format('0.66',2,2)       == ' 0.66'
if fnresult then fnresult= format('0.03',2,1)       == ' 0.0'
if fnresult then fnresult= format('0.06',2,1)       == ' 0.1'
if fnresult then fnresult= format('0.006',2,2)      == ' 0.01'
if fnresult then fnresult= format('0.66',2,1)       == ' 0.7'
if fnresult then fnresult= format('0.66',2,0)       == ' 1'
if fnresult then fnresult= format('0.33',2,0)       == ' 0'
if fnresult then fnresult= format('12.38',2,0)      == 12;
if fnresult then fnresult= format('12.50',2,0)      == 13;
if fnresult then fnresult= format('12.30',2,1)      == 12.3;
if fnresult then fnresult= format('12.38',2,1)      == 12.4;
if fnresult then fnresult= format('12.38',2,2)      == 12.38;
if fnresult then fnresult= format('12.38',2,3)      == 12.380;
if fnresult then fnresult= format('12.38',3,9)      == ' 12.380000000';
if fnresult then fnresult= format('0.0')            == '0';

/* Control decimal part only */
if fnresult then fnresult= format('12.3 ',,2)        == 12.30;
if fnresult then fnresult= format('- 12.3 ',,4)      == '-12.3000';
if fnresult then fnresult= format('+ 12.35',,1)      == 12.4;
if fnresult then fnresult= format('- 12.35',,1)      == '-12.4';
if fnresult then fnresult= format('+ 12.34',,1)      == 12.3;
if fnresult then fnresult= format('12.3 ',,9)        == '12.300000000';

/* Now exponential control */
if fnresult then fnresult= format('123.456',4,5,1,1) == '   1.23456E+2';
if fnresult then fnresult= format('123.456',4,5,1,2) == '   1.23456E+2';
if fnresult then fnresult= format('123.456',4,,1,3)  == ' 123.456';
if fnresult then fnresult= format('123.456',4,5,2,2) == '   1.23456E+02'
if fnresult then fnresult= format('123.456',4,4,3,2) == '   1.2346E+002'
if fnresult then fnresult= format('123.456',4,4,,2)  == '   1.2346E+2';
if fnresult then fnresult= format('123.456',,4,,2)   == '1.2346E+2';
if fnresult then fnresult= format('1234.56',,,2,2)   == '1.23456E+03';
if fnresult then fnresult= format('12.3456',,,,0)    == '1.23456E+1';
if fnresult then fnresult= format('12.3456',,,0,0)   == '12.3456';
if fnresult then fnresult= format('1.23456',,,2,0)   == '1.23456    ';
 FORMATERR:   /* Now test errors for FORMAT function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'format();'           /* No argument specified       */
      if result then call error 'format(,)';    /* Invalid call       */
      if result then call error 'format(,)';    /* Invalid call       */
      if result then call error 'Format('4',0)';    /* Invalid call       */
      if result then call error 'Format('4.5',0,0)';    /* Invalid call       */
      if result then call error 'Format('4.5',0,10)';    /* Invalid call       */
      fnresult=result;
      end;

    interpret evaluate;

/**********************************************************************/
/* INSERT(NEW,TARGET<,<N><,<K><,PAD>>>)                               */
/*  where NEW and TARGET are valid REX strings (both may be null).    */
/*  PAD is ONE character in length. N and K are non-negative integers */

!INSERT:   interpret tstfn;
    fnresult= 'Olnewd'=insert('new','Old',2);
    if fnresult then fnresult= 'abc=12=' ==  insert('12','abc',4,3,'=');
    if fnresult then fnresult= '1abc'    == insert('1','abc');
    if fnresult then fnresult= '1  abc'  == insert('1','abc',,3);
    if fnresult then fnresult= 'ab1c'    == insert('1','abc',2,,'-');
    if fnresult then fnresult= '12  34'  == insert('12','  34',,,'0');
    if fnresult then fnresult= '12  34'  == insert('12','  34',,,'01'x);
    if fnresult then fnresult= '  34a'   == insert('  34','a',,,'01'x);
    if fnresult then do;
      res='01'x||'FOOBAR  '||'0101010101'x;
      fnresult=   res == insert("FOOBAR  ","",1,13,"01"x)
      drop res
      end
 INSERTERR:   /* Now test errors for INSERT function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'insert()';           /* No arguments specified      */
      if result then call error 'insert(a,b,1,2,"zz")';
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* LASTPOS(NEEDLE,HAYSTACK<,START>)                                   */
/*  where HAYSTACK is a valid REX string (and may be the null string) */
/*  and PHRASE is also a REX string (and may be the null string).     */
/*  OFFSET is an (optional) integer (default=length(haystack)) giving */
/*  the start of the backwards search.                                */

!LASTPOS:  interpret tstfn;
    fnresult= 0==lastpos('ccccc','cc');
    if fnresult then fnresult= 5==lastpos('A','a A A a');
    if fnresult then fnresult= 0==lastpos('','a A A a');
    if fnresult then fnresult= 0==lastpos('abc','');
    if fnresult then fnresult= 5==lastpos('bc','abcabc');
    if fnresult then fnresult= 2==lastpos('bc','abcabc',5);
    if fnresult then fnresult= 0==lastpos('bc','abcabc',1);
    if fnresult then fnresult= 3==lastpos('c','abc');
    if fnresult then fnresult= 2==lastpos('bc','abc');
    if fnresult then fnresult= 1==lastpos('a','abc');
    if fnresult then fnresult= 1==lastpos('ab','abc');
    if fnresult then fnresult= 2==lastpos('ab',' abc');
 LASTPOSERR:   /* Now test errors for LASTPOS function       */
    if fnresult then do;
      erroron=1;
      call error 'lastpos("ab")';      /* Only one argument           */
      if result then call error 'lastpos()';    /* No arguments       */
      if result then call error 'lastpos(a,b,"")' /* Bad third arg.   */
      if result then call error 'lastpos(a,b,c)'/* Non-numeric 3rd    */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* LEFT(STRING,K<,PAD>)                                               */
/*  where STRING is a valid REX string (and may be the null string).  */
/*  K is a non-negative integer.                                      */
/*  PAD is a single character string                                  */


!LEFT:     interpret tstfn;
    fnresult= '14  '==left(14,4);
    if fnresult then fnresult=  '123'==left(12345,3);
    if fnresult then fnresult=  '   '==left('    12345   ',3);
    if fnresult then fnresult=  ' 12345  '==left(' 12345   ',8);
    if fnresult then fnresult=  '123=='==left('123',5,'=');
 LEFTERR:   /* Now test errors for LEFT function       */
    if fnresult then do;
      erroron=1;
      call error 'left()';             /* No argument provided        */
      if result then call error 'left(1,a)';       /* Non-numeric     */
      if result then call error 'left(1, )';       /* Non-numeric     */
      if result then call error 'left(1,3,"")';    /* Missing padchar */
      if result then call error 'left(1,3,"zz")';  /* L'Pad > 1       */
      if result then call error 'left(1,3,"z",z)'; /* Four args       */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* LENGTH(STRING)                                                     */
/*  where STRING is a valid REX string (and may be the null string).  */

!LENGTH:   interpret tstfn;
    fnresult= 5==length('abcde');
    if fnresult then fnresult= 0==length('');
 LENGTHERR:   /* Now test errors for LENGTH function       */
    if fnresult then do;
      erroron=1;
      call error 'length()';           /* Missing argument            */
      if result then call error 'length(,)';   /* No initial string   */
      if result then call error 'length(a,b)'; /* Only one please     */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* MAX(NUMBER<,NUMBER>...)                                            */

!MAX:       interpret tstfn;
    fnresult= '3'==max('3');
    if fnresult then fnresult= '3'==max(' - 3 ',3);
    if fnresult then fnresult= '3'==max(' - 3 ','+3 ');
    if fnresult then fnresult= '-3'==max(-4,-7.3,-3);
    if fnresult then fnresult= '-3.71'==max(-12,-3.71);
    if fnresult then fnresult= '100'==max(3.71*1,1.2,'1e2');
    if fnresult then fnresult= '1.71E+10'==max(3.71*1,-1.2,1.71e10)
 MAXERR:   /* Now test errors for MAX function       */
    if fnresult then do;
      erroron=1;
      call error 'max(,1)';        /* Missing argument            */
      if result then call error 'max(,1)';     /* No initial string   */
      if result then call error 'max(,1)';     /* No second number    */
      if result then call error 'max(1,a)';    /* Non numeric         */
      if result then call error 'max(   )';    /* No arguments at all */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* MIN(NUMBER<,NUMBER>...)                                            */

!MIN:       interpret tstfn;
    fnresult= '3'==min('3');
    if fnresult then fnresult= '-3'==min(' - 3 ',3);
    if fnresult then fnresult= '-7.3'==min(-4,-7.3,-3);
    if fnresult then fnresult= '-12'==min(-12,-3.71);
    if fnresult then fnresult= '1.2'==min(3.71*1,1.2,1e2);
    if fnresult then fnresult= '-1.2'==min(3.71*1,-1.2,1.71e2);
    if fnresult then fnresult= '0.2'==min(3.71*1,2e-1,1.71e2);
    if fnresult then fnresult= '2E-100'==min(3.71*1,2e-100,1.71e2);
 MINERR:   /* Now test errors for MIN function       */
    if fnresult then do;
      erroron=1;
      call error 'min(,1)';        /* Missing argument            */
      if result then call error 'min(,1)';     /* No initial string   */
      if result then call error 'min(,1)';     /* No second number    */
      if result then call error 'min(1,a)';    /* Non numeric         */
      if result then call error 'min(   )';    /* No arguments at all */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* OVERLAY(NEW,TARGET<,<N><,<K><,PAD>>>)                              */

!OVERLAY:  interpret tstfn;
    fnresult= '1aaa'==overlay('aaa','1234',2);
    if fnresult then fnresult= 'aaa4'==overlay('aaa','1234');
    if fnresult then fnresult= 'a  4'==overlay('a','1234',1,3);
    if fnresult then fnresult= '1234+a' == overlay('a','1234',6,1,'+');
    if fnresult then fnresult= '1234+a' == overlay('a','1234',6,,'+');
    if fnresult then fnresult= '+++++a' == overlay('a','',6,,'+')
    if fnresult then fnresult= '1  '    == overlay('1','abc',,3);
    if fnresult then fnresult= 'a1c'    == overlay('1','abc',2,,'-');
    if fnresult then fnresult= '1234'   == overlay('12','  34',,,'0');
    if fnresult then fnresult= '1234'   == overlay('12','  34',,,'00'x);
    if fnresult then fnresult= '  34'   == overlay('  34','a',,,'00'x);
 OVERLAYERR:   /* Now test errors for OVERLAY function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'overlay()';         /* No arguments specified      */
      if result then call error 'overlay(a,b,1,2,"zz")';
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* POS(NEEDLE,HAYSTACK<,START>)                                       */
/*  where HAYSTACK is a valid REX string (and may be the null string) */
/*  and PHRASE is also a REX string (and may be the null string).     */
/*  OFFSET is an (optional) integer (default=1) specifying the first  */
/*  character in the haystack to be checked against.                  */

!POS:      interpret tstfn;
    fnresult= 0==pos(abcde,bc);
    if fnresult then fnresult= 2==pos(bc,abcde);
    if fnresult then fnresult= 0==pos('','a A A a');
    if fnresult then fnresult= 0==pos('abc','');
    if fnresult then fnresult= 2==pos('bc','abcabc');
    if fnresult then fnresult= 1==pos('ab','abcabc');
    if fnresult then fnresult= 1==pos('ab','abcabc',1);
    if fnresult then fnresult= 5==pos('bc','abcabc',5);
    if fnresult then fnresult= 5==pos('bc','abcabc',3);
    if fnresult then fnresult= 2==pos('bc','abcabc',1);
    if fnresult then fnresult= 0==pos('bc','abcabc',7);
    if fnresult then fnresult= 0==pos('bc','abcabc',6);
 POSERR:   /* Now test errors for POS function       */
    if fnresult then do;
      erroron=1;
      call error 'pos("abcd")';        /* Only one argument */
      if result then call error 'pos("b",)';   /* No initial string */
      if result then call error 'pos(,abc)';   /* Bad second string */
      if result then call error 'pos("b",abc,c)';
      if result then call error 'pos("b",abc,1,1)';
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* QUEUED()                                                           */

!QUEUED:    interpret tstfn;
    stacked=queued();
    push 111;
    fnresult=  stacked + 1 == queued();
    if fnresult then do;
      push 222;  push 333;
      fnresult= stacked+ 3 == queued();
      if fnresult then do;
        push '123' '15'x '123';
        fnresult=stacked+4 == queued();
        pull;
        end;
      pull; pull;
      end;
    pull; drop stacked;
 QUEUEDERR:   /* Now test errors for QUEUED function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'queued(a);'          /* Invalid argument            */
      if result then call error 'queued("")'; /* Null argument        */
      if result then call error 'queued(,1)'; /* Two arguments        */
      fnresult=result;
      end;
    trace o
    interpret evaluate;

/**********************************************************************/
/* RANDOM(<MIN> <,> <MAX> <,SEED>)                                    */
/* Defaults are 1, 9999, and ??????                                   */

!RANDOM:  interpret tstfn;
    do i=245 by 333 to 1000 until ªfnresult;
      num=random(,,i);
      fnresult= num==random(,,i)
    end;
    if fnresult then fnresult= 1==random(1,1)
    if fnresult then do;
      c=trace('O');
      do 40 until ªfnresult;
        num=random(10,15);
        fnresult= num>9 & num<16;
        if fnresult then do;
          num=random(9);
          fnresult= num>=0 & num<10;
          end;
      end
      trace value c;
      drop i;
      end;
    drop num;
 RANDOMERR:   /* Now test errors for RANDOM function       */
    if fnresult then do;
      erroron=1;
      call error 'random(a)';            /* Non-numeric argument      */
      if result then call error 'random(1,a)';      /* Non-numeric    */
      if result then call error 'random(1,3,"")';   /* Missing seed   */
      if result then call error 'random(3,1)';      /* Bad range      */
      if result then call error 'random(0,11111111)';  /* Bad range   */
      if result then call error 'random(1,3,"z",z)';   /* Four args   */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* REVERSE(STRING)                                                    */
/*  where STRING is a valid REX string (and may be the null string).  */

!REVERSE:  interpret tstfn;
    fnresult= reverse('123-')=='-321';
    if fnresult then fnresult= reverse('abcdef')=='fedcba';
    if fnresult then fnresult= reverse('abcdef'x)=='efcdab'x;
    if fnresult then
      fnresult=reverse('1'longstring'2')=='2'longstring'1';
 REVERSEERR:   /* Now test errors for REVERSE function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'reverse();'          /* No arguments specified      */
      if result then call error 'reverse(,)'; /* Missing argument     */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* RIGHT(STRING,K<,PAD>)                                              */
/*  where STRING is a valid REX string (and may be the null string).  */
/*  K is a non-negative integer.                                      */
/*  PAD is a single character string                                  */

!RIGHT:    interpret tstfn;
    fnresult= '  41'==right(41,4);
    if fnresult then fnresult=  '345'==right(12345,3);
    if fnresult then fnresult=  '  ab  cd'==right('ab  cd',8);
    if fnresult then fnresult=  '---ab cd'==right('ab cd',8,'-');
    interpret evaluate;
 RIGHTERR:   /* Now test errors for RIGHT function       */
    if fnresult then do;
      erroron=1;
      call error 'right()';           /* No argument provided         */
      if result then call error 'right(1,a)';      /* Non-numeric     */
      if result then call error 'right(1, )';      /* Non-numeric     */
      if result then call error 'right(1,3,"zz")'; /* L'Pad > 1       */
      if result then call error 'right(1,3,"z",z)'; /* Four args      */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* SIGN(NUMBER)                                                       */
/*  where NUMBER is a valid REX number. 0, 1, or -1 is returned,      */
/*  depending on the sign of the input number                         */

!SIGN:     interpret tstfn;
    fnresult= '1'==sign('3');
    if fnresult then fnresult= '-1'==sign(' - 3 ');
    if fnresult then fnresult= '-1'==sign(-13);
    if fnresult then fnresult= '0'==sign(-0);
    if fnresult then fnresult= '0'==sign(0);
    if fnresult then fnresult= '0'==sign(0.00);
 SIGNERR:   /* Now test errors for SIGN function       */
    if fnresult then do;
      erroron=1;
      call error 'sign(sss)';          /* Non-numeric argument..      */
      if result then call error 'sign()';    /* At least one arg   */
      if result then call error 'sign(1,1)'; /* Only one arg    */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* SOURCELINE(<N>)                                                    */
/*  where "N" is a valid REX number.   The extent of the program is   */
/*  returned if 'N' is omitted, otherwise the 'N'th line of the       */
/*  program is returned                                               */

!SOURCELINE:     interpret tstfn;
    max=sourceline();  /* Get maximum value we can test */
    signal SOURCELINE1;  SOURCELINE1: /* Find out where we are */
    /* Skip */
    fnresult= sourceline(sigl+1)=='    /* Skip */'

 SOURCELINEERR:   /* Now test errors for SOURCELINE function       */
    if fnresult then do;
      erroron=1;
      call error 'sourceline(nnn)';    /* Non-numeric argument..      */
      if result then call error 'sourceline(99999)'; /* Too big       */
      if max='MAX' then max=sourceline()
      if result then call error 'sourceline('max+1')'; /* 1 too big   */
      fnresult=result;
      end;
    drop max;
    interpret evaluate;

/**********************************************************************/
/* SPACE(STRING,N<,PAD>)                                              */
/*  where STRING is a valid REX string (and may be the null string).  */
/*  N is a non-negative integer.                                      */
/*  PAD is a single character string                                  */

!SPACE:    interpret tstfn;
    fnresult= 'xyz abc'==space(' xyz abc ','  1  ');
    if fnresult then fnresult= 'xyz  abc'==space(' xyz abc',2);
    if fnresult then fnresult= 'xyzabc'==space(' xyz abc',' 0 ');
    if fnresult then fnresult= 'xy0ab'==space(' xy ab',1,'0');
    if fnresult then fnresult= 'xy0ab'==space(' xy ab', ,'0');
    if fnresult then fnresult= 'a b c'==space(' a b c  ');
    if fnresult then fnresult= 'a b c'==space(' a b c  ',);
 SPACEERR:   /* Now test errors for SPACE function       */
    if fnresult then do;
      erroron=1;
      call error 'space()';            /* No argument provided        */
      if result then call error 'space(1,a)';       /* Non-numeric    */
      if result then call error 'space(1,"")';      /* Non-numeric    */
      if result then call error 'space(1,3,"zz")';  /* L'pad > 1      */
      if result then call error 'space(1,3,"z",z)'; /* Four args      */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* STRIP(STRING<,<OPTION><,CHAR>>)                                    */
/* The option can be any non-null string which starts with one of the */
/* following letters:   B   - to strip characters from front and end  */
/*                      L   - to strip leading characters             */
/*                      T   - to strip trailing characters            */
/* By default the character to be removed is a blank (x'40'). This is */
/* altering by specifying a SINGLE character as the strip character.  */

!STRIP:    interpret tstfn;
    fnresult= 'T'==strip('  T  ');
    if fnresult then fnresult= 'T  '==strip('  T  ',l);
    if fnresult then fnresult= '  T'==strip('  T  ',t);
    if fnresult then fnresult= 'T'==strip('  T  ','b');
 STRIPERR:   /* Now test errors for STRIP function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'strip()';            /* No arguments specified      */
      if result then call error 'strip(,)'; /* Non-numeric argument   */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* SUBSTR(STRING,N<,<K><,PAD>>)                                       */

!SUBSTR:   interpret tstfn;
    fnresult= 'TRING'==substr('STRING',2);
    if fnresult then fnresult= 'TRIN'==substr('STRING',2,4);
    if fnresult then fnresult= 'G   '==substr('STRING',6,4);
    if fnresult then fnresult= 'G   '==substr('STRING',6,4, );
    if fnresult then fnresult= 'G...'==substr('STRING',6,4,'.');
    if fnresult then fnresult= 'G'   ==substr('STRING',6, ,'.');
    if fnresult then fnresult= 'G.'  ==substr('STRING',6,2,'.');
    if fnresult then fnresult= 'G '  ==substr('STRING',6,2,   );
 SUBSTRERR:   /* Now test errors for SUBSTR function       */
    if fnresult then do;
      erroron=1;                       /* Flag deliberate errors      */
      call error 'substr("string",)';  /* Missing numeric             */
      if result then call error 'substr("abc",a)'; /* Invalid numeric */
      if result then call error 'substr(,2)';/* Missing string        */
      if result then call error 'substr()';  /* No arguments at all   */
      if result then call error 'substr("ab",,2)'; /* Bad second arg. */
      if result then call error 'substr("ab",1,2,xx)';   /* >1 pad.   */
      if result then call error 'substr("ab",1,2,3,x)';  /* Five args */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* SUBWORD(STRING,N<,K>)                                              */

!SUBWORD:  interpret tstfn;
    fnresult= 'xyz'==subword(' xyz abc ',1,1);
    if fnresult then fnresult= 'xyz  p'==subword(' xyz  p abc ',1,2);
    if fnresult then fnresult= 'xyz  p'==subword(' eee xyz  p abc ',2,2)
    if fnresult then fnresult= 'xyz  p'==subword(' yyy xyz  p',2,2);
    if fnresult then fnresult= 'xyz  p'==subword(' yyy xyz  p ',2,2);
    if fnresult then fnresult= 'xyz  p'==subword(' yyy xyz  p',2);
    if fnresult then fnresult= 'xyz  p'==subword(' yyy xyz  p ',2);
    if fnresult then fnresult= 'xyz  p'==subword(' yyy xyz  p ',2,);
 SUBWORDERR:   /* Now test errors for SUBWORD function       */
    if fnresult then do;
      erroron=1;                       /* Flag deliberate errors      */
      call error 'subword("string",,)';/* Missing numeric             */
      if result then call error 'subword("abc",a)'; /* Invalid numeric*/
      if result then call error 'subword(,2)';/* Missing string       */
      if result then call error 'subword()';  /* No arguments at all  */
      if result then call error 'subword("ab",,2)'; /* Bad second arg.*/
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* SYMBOL(NAME)                                                       */

!SYMBOL:   interpret tstfn;
    fnresult = symbol('tttttttt')=='LIT'; /* Should be 'LIT'          */
    if fnresult then fnresult = symbol('fnresult')=='VAR';
    if fnresult then fnresult = symbol('')        =='BAD';
    if fnresult then fnresult = symbol(1.fnresult)=='LIT';
    if fnresult then fnresult = symbol(' ')       =='BAD';
    if fnresult then fnresult = symbol('01C1'x)   =='BAD';
    if fnresult then fnresult = symbol('FNRESULT')=='VAR';
    if fnresult then do;
      a.1='Set';
      fnresult= symbol('a.fnresult')=='VAR';
      drop a.1
      end;
 SYMBOLERR:   /* Now test errors for SYMBOL function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'symbol()';          /* No arguments specified       */
      if result then call error 'symbol(,)'; /* Too many arguments    */
      if result then call error 'symbol("A",1)';
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* TRACE(<arg>)                                                       */
/* Use to get the current trace setting, and to optionally set to a   */
/* new value. Only valid trace characters are allowed.                */

!TRACE:    interpret tstfn;
    if retry then tr='I'; else tr='O';
    fnresult=  trace(N)==tr;
    if fnresult then fnresult=  trace('O')=='N'
 TRACEERR:   /* Now test errors for TRACE function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'trace(,x)';          /* Two arguments specified     */
      if result then call error 'trace(x)'; /* Invalid arguement      */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* TRANSLATE(STRING<,<TABO><,<TABI><,PAD>>>)                          */

!TRANSLATE:interpret tstfn;
    string=xrange();     /* Test uppercase translation first */
    parse upper var string ups;
    fnresult= ups==translate(string);
    drop string;
    if fnresult then fnresult= '1234'==translate('abcd',1234,'abcd');
    if fnresult then fnresult= '4321'==translate('00010203'x,'4321');
    if fnresult then fnresult= ' a @'==translate('-ª-!','a@','ª!--');
    if fnresult then fnresult= '1a1' ==translate('1a1',,'x');
    if fnresult then fnresult= '1a1' ==translate('1a1',,'d');
    if fnresult then fnresult= '1R1' ==translate('1a1','R','a');
    if fnresult then fnresult= '1a1' ==translate('1a1',,'x');
    if fnresult then fnresult= '1 1' ==translate('1B1',,'B');
    if fnresult then fnresult= '1P1' ==translate('1a1',,'a','P');
    if fnresult then fnresult= '1Q1' ==translate('1a1','Q','a');
    if fnresult then fnresult= '1Q1' ==translate('1a1',,'za','Q');
    if fnresult then fnresult= '1P1' ==translate('1a1','y','za','P');
    if fnresult then do; /* Used to cause an ADDRESSING EXCEPTION */
      d=translate(longstring' 12345 'longstring,'abcdef','1234567890')
      fnresult= d== longstring' abcde 'longstring
      if fnresult then do;
        d=translate(longstring' 12345 ','abcde+','12345 ')
        fnresult= d== longstring'+abcde+'
        if fnresult then ,
          fnresult= c256||'b' == translate(c256||'-','b','-')
        if fnresult then ,
          fnresult= c256 'b' == translate(c256 '-','b','-')
        end
      drop d;
      end
 TRANSLATEERR:   /* Now test errors for TRANSLATE function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'translate()';        /* No arguments specified      */
      if result then call error 'translate(a,b,1,"zz")'; /* L'pad > 1 */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* TRUNC(NUMBER<,N>)                                                  */

!TRUNC:    interpret tstfn;
    fnresult= '2.000'==trunc(2,3);
    if fnresult then fnresult=    '12'==trunc('  1.22e1');
    if fnresult then fnresult=     '0'==trunc('  2.22e-4');
    if fnresult then fnresult=   '129'==trunc(' +  129.99');
    if fnresult then fnresult=   '123'==trunc('  123.33');
    if fnresult then fnresult= '123.4'==trunc('123.45',1);
 TRUNCERR:   /* Now test errors for TRUNC function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'trunc()';            /* No argument specified       */
      if result then call error 'trunc(,)';  /* Invalid argument      */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* VALUE(NAME)                                                        */
!VALUE:   interpret tstfn;
    fnresult = value('ttttt')=='TTTTT';
    if fnresult then fnresult = value('fnresult')==1;
    if fnresult then fnresult = value('longstring')==longstring;
    if fnresult then do;
      a='BOO';
      a.boo='Test it'
      fnresult= value('A.A') == 'Test it';
      if fnresult then fnresult= value('A.boo') == 'Test it';
      drop a.boo a
      end;
 VALUEERR:   /* Now test errors for VALUE function       */
    if fnresult then do;
      erroron=1;                 /* Signal error testing in progress */
      call error 'value()';          /* No arguments specified       */
      if result then call error 'value(,)'; /* Too many arguments    */
/*    if result then call error 'value("A",)';*/
      if result then call error 'value("")';   /* Null string        */
      if result then call error 'value(" ",)'; /* Bad symbol passed  */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* VERIFY(STRING,REFERENCE<,'Match'>)                                 */

!VERIFY:   interpret tstfn;
                     fnresult =  verify('ABC','123456','M')     == '0'
    if fnresult then fnresult =  verify('ABC','123456','Mat')   == '0'
    if fnresult then fnresult =  verify('abcdef','abc')         == '4'
    if fnresult then fnresult =  verify('    This',' ')         == '5'
    if fnresult then fnresult =  verify('    This',' ','M')     == '1'
    if fnresult then fnresult =  verify('    This',' ','Match') == '1'
    if fnresult then fnresult = verify('123','1234567890')      ==  0
    if fnresult then fnresult = verify('1Z3','1234567890')      ==  2
    if fnresult then fnresult = verify('AB3','1234567890','M')  ==  3
    if fnresult then fnresult = verify('AB3','','M')            ==  0
    if fnresult then fnresult = verify('AB3','')                ==  1
 VERIFYERR:   /* Now test errors for VERIFY function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'verify()';           /* No argument specified       */
      if result then call error 'verify(,)'; /* Invalid argument      */
      if result then call error 'verify(abcd,1234,"X")';
      if result then call error 'verify(abcd,1234,"")';
      if result then call error 'verify(abcd,1234," ",2)';
      if result then call error 'verify(abcd,1234," ",5)';
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* WORD(STRING,N)                                                     */
/*  where STRING is a valid REX string (and may be the null string).  */
/*  N is a non-negative integer.                                      */

!WORD:     interpret tstfn;
    fnresult= 'abc'==word('xyz abc def',2);
    if fnresult then fnresult= ''==word('abc def',6);
    if fnresult then fnresult= word('Now is the time',3) == 'the'
 WORDERR:   /* Now test errors for WORD function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'word(,)';            /* Two arguments specified     */
      if result then call error 'word(x)';  /* Invalid argument       */
      if result then call error 'word(x,0)'; /* Zero is invalid       */
      if result then call error 'word(x, )'; /* No second parm        */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* WORDINDEX(STRING,N)                                                */
/*  where STRING is a valid REX string (and may be the null string).  */
/*  N is a non-negative integer.                                      */

!WORDINDEX: interpret tstfn;
    fnresult= '2'==wordindex(' xyz abc ',1);
    if fnresult then fnresult= '1'==wordindex('xyz  p abc ',1);
    if fnresult then fnresult= '6'==wordindex('xyz  p abc ',2);
    if fnresult then fnresult= '0'==wordindex('xyz  p abc ',4);
    if fnresult then fnresult= '0'==wordindex('',4);
 WORDINDEXERR:   /* Now test errors for WORDINDEX function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'wordindex();'        /* No argument specified       */
      if result then call error 'wordindex(,)'; /* Invalid call       */
      if result then call error 'wordindex('a b c',0)';
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* WORDLENGTH(STRING,N)                                               */
/*  where STRING is a valid REX string (and may be the null string).  */
/*  N is a non-negative integer.                                      */

!WORDLENGTH: interpret tstfn;
    fnresult= '3'==wordlength(' xyz abc ',1);
    if fnresult then fnresult= '3'==wordlength('xyz  p abc ',1);
    if fnresult then fnresult= '1'==wordlength('xyz  p abc ',2);
    if fnresult then fnresult= '0'==wordlength('xyz  p abc ',4);
    if fnresult then fnresult= '0'==wordlength('',4);
 WORDLENGTHERR:   /* Now test errors for WORDLENGTH function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'wordlength();'        /* No argument specified      */
      if result then call error 'wordlength(, )'; /* Invalid call     */
      if result then call error 'wordindex('a b c',0)';
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* WORDS(STRING)                                                      */
/*  where STRING is a valid REX string (and may be the null string).  */
/*  The number of words in the string is returned.                    */

!WORDS:    interpret tstfn;
    fnresult= '4'==words('1 2 3 4');
    if fnresult then fnresult = '3'==words(' aa bb cc ');
    if fnresult then fnresult = '0'==words(' ');
    if fnresult then fnresult = '0'==words('');
 WORDSERR:   /* Now test errors for WORDS function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'words();'            /* No argument specified       */
      if result then call error 'words(,)';     /* Invalid call       */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* XRANGE(<M><,N>)                                                    */
/* M and N are one byte packed HEX values (e.g. XRANGE('a','01'x))    */
/* or a two byte hex value (e.g. XRANGE('01','FF'). Both may be used  */
/* on the same call. The defaults are '00' and 'FF'.  Wrap may occur  */

!XRANGE:   interpret tstfn;
    fnresult= 'FAFBFCFDFEFF'x=='XRANGE'('FA'x);
    if fnresult then fnresult= '000102'x=='XRANGE'(,'02'x);
    if fnresult then fnresult= 'FDFEFF'x=='XRANGE'('FD'x, );
    if fnresult then do;
      string=xrange();
      fnresult= 256==length(string);
      if fnresult then fnresult= 256==length(xrange('ff'x,'fe'x));
      if fnresult then do;
        do 10;                  /* Choose 10 bytes at random   */
         n=random(0,255);
         if fnresult then fnresult= d2c(n)==substr(string,n+1,1);
        end;
        end;
      drop string;
      end;
 XRANGEERR:   /* Now test errors for XRANGE function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'xrange(aa);'         /* No argument specified       */
      if result then call error 'xrange(,aa)';  /* Invalid call       */
      if result then call error 'xrange(1,2,3)';/* Invalid call       */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* X2B(HEXSTRING)                                                     */
/* Where HEXSTRING is a string of valid hex codes (e.g. C'FA1230')    */
/* and may be of any length. The packed string is returned. Blanks    */
/* may be inserted to improve readability (e.g. X2B(1ff f0 00)) at    */
/* byte boundaries.  A leading zero is added if required.             */
!X2B:      interpret tstfn;
    fnresult=                   x2b(255)        == '001001010101'
    if fnresult then fnresult=  x2b('A BC')     == '101010111100'
    if fnresult then fnresult=  x2b(A1)         == '10100001'
    if fnresult then fnresult=  x2b('12 A1')    == '0001001010100001'
    if fnresult then fnresult=  x2b('A1 F0')    == '1010000111110000'
    if fnresult then fnresult=  x2b('A  1F')    == '101000011111'
 X2BERR:   /* Now test errors for X2B function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'x2b();'              /* No argument specified       */
      if result then call error 'x2b(,)';       /* Invalid call       */
      if result then call error 'x2b(" a")';    /* Invalid call       */
      if result then call error 'x2b("a a")';   /* Invalid call       */
      if result then call error 'x2b(" a a")';  /* Invalid call       */
      if result then call error 'x2b("a a ")';  /* Invalid call       */
      if result then call error 'x2b("    ")';  /* Invalid call       */
      if result then call error 'x2b("h")';     /* Invalid hex digit  */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* X2C(HEXSTRING)                                                     */
/* Where HEXSTRING is a string of valid hex codes (e.g. C'FA1230')    */
/* and may be of any length. The packed string is returned. Blanks    */
/* may be inserted to improve readability (e.g. X2c(1ff f0 00)) at    */
/* byte boundaries.  A leading zero is added if required.             */
!X2C:      interpret tstfn;
    fnresult=                   x2c(255)        == '0255'x
    if fnresult then fnresult=  x2c('A BC')     == '0ABC'x
    if fnresult then fnresult=  x2c(A1)         == 'A1'x
    if fnresult then fnresult=  x2c('12 A1')    == '12A1'x
    if fnresult then fnresult=  x2c('A1 F0')    == 'A1F0'x
    if fnresult then fnresult=  x2c('A  1F')    == '0A1F'x
 X2CERR:   /* Now test errors for X2C function       */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'x2c();'              /* No argument specified       */
      if result then call error 'x2c(,)';       /* Invalid call       */
      if result then call error 'x2c(" a")';    /* Invalid call       */
      if result then call error 'x2c("a a")';   /* Invalid call       */
      if result then call error 'x2c(" a a")';  /* Invalid call       */
      if result then call error 'x2c("a a ")';  /* Invalid call       */
      if result then call error 'x2c("    ")';  /* Invalid call       */
      if result then call error 'x2c("h")';     /* Invalid hex digit  */
      fnresult=result;
      end;
    interpret evaluate;

/**********************************************************************/
/* X2D(HEXSTRING)                                                     */
/* Where HEXSTRING is a string of valid hex codes (e.g. C'FA1230')    */
/* which is treated as a SIGNED fullword. (Max. length is 8)          */

!X2D:      interpret tstfn;
    fnresult=                   x2d(255)          == 597
    if fnresult then fnresult=  x2d('ABC')        == 2748
    if fnresult then fnresult=  x2d('Fffffffe',8) == -2
    if fnresult then fnresult=  x2d('Fffffffe',5) == -2
    if fnresult then fnresult=  x2d('f58',3)      == -168
    if fnresult then fnresult=  x2d('f58',2)      == 88
    if fnresult then fnresult=  x2d('f58',1)      == -8
    if fnresult then fnresult=  x2d('',0)         == 0
    if fnresult then fnresult=  x2d('')           == 0
    if fnresult then fnresult=  x2d('fdf',0)      == 0
    if fnresult then fnresult=  x2d(c256 c256 aa,40) == -86
    if fnresult then fnresult=  X2D('aa',3)==170
    if fnresult then fnresult=  X2D('aabb',4)==-21829
    if fnresult then fnresult=  X2D('aabb',5)==43707
    if fnresult then fnresult=  X2D('aabb',6)==43707
    if fnresult then fnresult=  X2D('aabb',7)==43707
 X2DERR:   /* Now test errors for                    */
    if fnresult then do;
      erroron=1;             /* Signal error testing in progress */
      call error 'x2d();'             /* No argument specified       */
      if result then call error 'x2d(,)';      /* Invalid call       */
      if result then call error 'x2d(c256 c256 aa)'; /* Too long     */
      fnresult=result;
      end;
    interpret evaluate;


/*** IUO functions ***/
/**********************************************************************/
 TELL:     if fnresult then do; if retry then a='  second time around';
             else a=''; say ' Function'hi|| fn ||lo'OK' a;
             retry=0; erroron=0;
             return fnresult; end;
           if retry then do;
             retry=0; say 'Function still fails....'; erroron=0;
             end;           else do;
             say hi'Error'lo'in function'hi||fn lo' Retry.....?';
             pull a +1; retry= a='Y';
             if retry then do;
                           say 'Calling' actual'...';
                           interpret 'call !'actual;
                           end;
             end;
           return fnresult;
/*--------------------------------------------------------------------*/
 ERROR:    parse arg fnstring;
           interpret "errv=" fnstring; /* Should go to SYNTAX:        */
           say 'Error not detected executing'hi fnstring lo
           say '              which yielded:'hi'==>'errv'<=='lo
           return 0;                   /* No error detected.....      */
/*--------------------------------------------------------------------*/
INITIALISE:
longstring=, /* Each line is 60 characters long - total length=300 */
    'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa',
 || 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa',
 || 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa',
 || 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa',
 || 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa';

c256=, /* Each line is 64 characters long - total length=256 */
    'ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff',
 || 'ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff',
 || 'ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff',
 || 'ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff';

if length(c256)ª=256 then say 'Problem C256.....' length(c256)
if length(longstring)ª=300 then say 'Problem.....' length(longstring)

functions= 'ABBREV ABS ADDRESS ARG BITAND BITOR BITXOR B2X CENTRE COMPARE',
           'COPIES C2D C2X DATATYPE DELSTR DELWORD D2C D2X',
           'ERRORTEXT FILESPEC FORMAT INSERT ',
           'LASTPOS LEFT LENGTH MAX MIN OVERLAY POS QUEUED',
           'RANDOM REVERSE RIGHT SIGN SOURCELINE SPACE STRIP SUBSTR',
           'SUBWORD SYMBOL TRACE TRANSLATE TRUNC VALUE',
           'VERIFY WORD WORDINDEX WORDLENGTH WORDS XRANGE X2B X2C X2D'
say 'There are' words(functions) 'functions included in the total list';

return;
/*--------------------------------------------------------------------*/
myd2x: procedure; parse arg number , length
  if length='' then length=0
  if number<0 then do;
    n= -number-1;
    char= 'FF'x
    strip='F'
    end;
  else do;
    n= number;
    char= '00'x
    strip='0'
    end;
  str='';
  do while nª=0
    res=n//256;  n=n%256
    str = bitxor( d2c(res), char ) || str
  end
  str=strip(c2x(str),'L',strip)
  if str='' then str=strip
  if length=0 then return str;
              else return right(str,length,strip);

myx2d: procedure; parse arg string , length
  if length='' then length=0;
  hex=translate(string)
  if lengthª=0 then hex= right(hex,length,'0')
  if x2d(left( right(hex,length,'0') , 1))>7 then do;
    add=1;
    hex= right(c2x( bitxor( x2c(hex) ,'', 'FF'x)),length)
    sign='-'
    end;
  else do
    add=0;
    sign='';
    end;
  dec=0
  do while hexª=''
    dec=dec*16
    parse var hex digit +1 hex
    dec=dec+x2d(digit)
  end
  return sign||(dec +  add)

SKIPBAD: procedure
    SKANSWER = -1
    say '  Do you wish to try it anyway?'
SKBD2:
    pull response
    if response = 'Y' then SKANSWER = 1
    if response = 'N' then SKANSWER = 0
    if SKANSWER = -1 then do
        say '     *** Improper response ***'
        say '  Do you wish to try it anyway?'
        signal SKBD2
        end
    return SKANSWER

/*-------------------------------------------------------------------------- */
exit
INFO_PLEASE:
say ''
say '[1;26;45m  ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»  '
say '  º REXFUNDG.CMD is copied to \REXX directory on testcase partition  º  '
say '  º                                                                  º  '
say '  º Parameters: NONE   - CALLED BY \BATCH\SNFREXX.CMD -              º  '
say '  º                                                                  º  '
say '  º Tests REXX language processing                                   º  '
say '  º                                                                  º  '
say '  º Uses OS/2 environment variables to determine testcase drive.     º  '
say '  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼  [0;40;37m'
exit
