os2/OS2/REXX/t/rx_tievar.t

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