home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / os2 / OS2 / REXX / t / rx_tieydb.t < prev    next >
Encoding:
Text File  |  1999-10-23  |  982 b   |  34 lines
  1. BEGIN {
  2.     chdir 't' if -d 't/lib';
  3.     @INC = '../lib' if -d 'lib';
  4.     require Config; import Config;
  5.     if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) {
  6.     print "1..0\n";
  7.     exit 0;
  8.     }
  9. }
  10.  
  11. use OS2::REXX;
  12. $rx = load OS2::REXX "ydbautil"     # from RXU17.ZIP
  13.   or print "1..0 # skipped: cannot find YDBAUTIL.DLL\n" and exit;
  14.  
  15. print "1..7\n", "ok 1\n";
  16.  
  17. $rx->prefix("Rx");                         # implicit function prefix
  18. print "ok 2\n";
  19.  
  20. REXX_call {
  21.   tie @pib, OS2::REXX, "IB.P";       # bind array to REXX stem variable
  22.   print "ok 3\n";
  23.   tie %tib, OS2::REXX, "IB.T.";      # bind associative array to REXX stem var
  24.   print "ok 4\n";
  25.  
  26.   $rx->GetInfoBlocks("IB.");    # call REXX function
  27.   print "ok 5\n";
  28.   defined $pib[6] ? print "ok 6\n" : print "not ok 6\n# pib\n";
  29.   defined $tib{7} && $tib{7} =~ /^\d+$/ ? print "ok 7\n"
  30.     : print "not ok 7\n# tib\n";
  31.   print "# Process status is ", unpack("I", $pib[6]),
  32.         ", thread ordinal is $tib{7}\n";
  33. };
  34.