home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / os2 / OS2 / REXX / t / rx_tievar.t < prev    next >
Encoding:
Text File  |  1999-10-23  |  1.6 KB  |  90 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.  
  13. #
  14. # DLL
  15. #
  16. load OS2::REXX "ydbautil"
  17.   or print "1..0 # skipped: cannot find YDBAUTIL.DLL\n" and exit;
  18.  
  19. print "1..19\n";
  20.  
  21. REXX_call {
  22.   print "ok 1\n";
  23.  
  24.   #
  25.   # scalar
  26.   #
  27.   tie $s, OS2::REXX, "TEST";
  28.   print "ok 2\n";
  29.   $s = 1;
  30.   print "ok 3\n" if $s eq 1;
  31.   print "not ok 3\n# `$s'\n" unless $s eq 1;
  32.   untie $s;
  33.  
  34.   #
  35.   # hash
  36.   #
  37.  
  38.   tie %all, OS2::REXX, "";    # all REXX vars
  39.   print "ok 4\n";
  40.  
  41.   sub show {
  42.     # show all REXX vars
  43.     print "--@_--\n";
  44.     foreach (keys %all) {
  45.         $v = $all{$_};
  46.         print "$_ => $v\n";
  47.     }
  48.   }
  49.  
  50.   sub check {
  51.     # check all REXX vars
  52.     my ($test, @arr) = @_;
  53.     my @rx;
  54.     foreach $key (sort keys %all) { push @rx, $key, $all{$key} }
  55.     if ("@rx" eq "@arr") {print "ok $test\n"}
  56.     else { print "not ok $test\n# expect `@arr', got `@rx'\n" }
  57.   }
  58.  
  59.  
  60.   tie %h, OS2::REXX, "TEST.";
  61.   print "ok 5\n";
  62.   check(6);
  63.  
  64.   $h{"one"} = 1;
  65.   check(7, "TEST.one", 1);
  66.  
  67.   $h{"two"} = 2;
  68.   check(8, "TEST.one", 1, "TEST.two", 2);
  69.  
  70.   $h{"one"} = "";
  71.   check(9, "TEST.one", "", "TEST.two", 2);
  72.   print "ok 10\n" if exists $h{"one"};
  73.   print "ok 11\n" if exists $h{"two"};
  74.  
  75.   delete $h{"one"};
  76.   check(12, "TEST.two", 2);
  77.   print "ok 13\n" if not exists $h{"one"};
  78.   print "ok 14\n" if exists $h{"two"};
  79.  
  80.   OS2::REXX::dropall("TEST.");
  81.   print "ok 15\n";
  82.   check(16);
  83.   print "ok 17\n" if not exists $h{"one"};
  84.   print "ok 18\n" if not exists $h{"two"};
  85.  
  86.   untie %h;
  87.   print "ok 19";
  88.  
  89. };
  90.