1*b39c5158SmillertBEGIN { 2*b39c5158Smillert chdir 't' if -d 't/lib'; 3*b39c5158Smillert @INC = '../lib' if -d 'lib'; 4*b39c5158Smillert require Config; import Config; 5*b39c5158Smillert if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) { 6*b39c5158Smillert print "1..0\n"; 7*b39c5158Smillert exit 0; 8*b39c5158Smillert } 9*b39c5158Smillert} 10*b39c5158Smillert 11*b39c5158Smillertuse OS2::REXX; 12*b39c5158Smillert 13*b39c5158Smillert# 14*b39c5158Smillert# DLL 15*b39c5158Smillert# 16*b39c5158Smillertload OS2::REXX "rxu" 17*b39c5158Smillert or print "1..0 # skipped: cannot find RXU.DLL\n" and exit; 18*b39c5158Smillert 19*b39c5158Smillertprint "1..19\n"; 20*b39c5158Smillert 21*b39c5158SmillertREXX_call { 22*b39c5158Smillert print "ok 1\n"; 23*b39c5158Smillert 24*b39c5158Smillert # 25*b39c5158Smillert # scalar 26*b39c5158Smillert # 27*b39c5158Smillert tie $s, OS2::REXX, "TEST"; 28*b39c5158Smillert print "ok 2\n"; 29*b39c5158Smillert $s = 1; 30*b39c5158Smillert print "ok 3\n" if $s eq 1; 31*b39c5158Smillert print "not ok 3\n# `$s'\n" unless $s eq 1; 32*b39c5158Smillert untie $s; 33*b39c5158Smillert 34*b39c5158Smillert # 35*b39c5158Smillert # hash 36*b39c5158Smillert # 37*b39c5158Smillert 38*b39c5158Smillert tie %all, OS2::REXX, ""; # all REXX vars 39*b39c5158Smillert print "ok 4\n"; 40*b39c5158Smillert 41*b39c5158Smillert sub show { 42*b39c5158Smillert # show all REXX vars 43*b39c5158Smillert print "--@_--\n"; 44*b39c5158Smillert foreach (keys %all) { 45*b39c5158Smillert $v = $all{$_}; 46*b39c5158Smillert print "$_ => $v\n"; 47*b39c5158Smillert } 48*b39c5158Smillert } 49*b39c5158Smillert 50*b39c5158Smillert sub check { 51*b39c5158Smillert # check all REXX vars 52*b39c5158Smillert my ($test, @arr) = @_; 53*b39c5158Smillert my @rx; 54*b39c5158Smillert foreach $key (sort keys %all) { push @rx, $key, $all{$key} } 55*b39c5158Smillert if ("@rx" eq "@arr") {print "ok $test\n"} 56*b39c5158Smillert else { print "not ok $test\n# expect `@arr', got `@rx'\n" } 57*b39c5158Smillert } 58*b39c5158Smillert 59*b39c5158Smillert 60*b39c5158Smillert tie %h, OS2::REXX, "TEST."; 61*b39c5158Smillert print "ok 5\n"; 62*b39c5158Smillert check(6); 63*b39c5158Smillert 64*b39c5158Smillert $h{"one"} = 1; 65*b39c5158Smillert check(7, "TEST.one", 1); 66*b39c5158Smillert 67*b39c5158Smillert $h{"two"} = 2; 68*b39c5158Smillert check(8, "TEST.one", 1, "TEST.two", 2); 69*b39c5158Smillert 70*b39c5158Smillert $h{"one"} = ""; 71*b39c5158Smillert check(9, "TEST.one", "", "TEST.two", 2); 72*b39c5158Smillert print "ok 10\n" if exists $h{"one"}; 73*b39c5158Smillert print "ok 11\n" if exists $h{"two"}; 74*b39c5158Smillert 75*b39c5158Smillert delete $h{"one"}; 76*b39c5158Smillert check(12, "TEST.two", 2); 77*b39c5158Smillert print "ok 13\n" if not exists $h{"one"}; 78*b39c5158Smillert print "ok 14\n" if exists $h{"two"}; 79*b39c5158Smillert 80*b39c5158Smillert OS2::REXX::dropall("TEST."); 81*b39c5158Smillert print "ok 15\n"; 82*b39c5158Smillert check(16); 83*b39c5158Smillert print "ok 17\n" if not exists $h{"one"}; 84*b39c5158Smillert print "ok 18\n" if not exists $h{"two"}; 85*b39c5158Smillert 86*b39c5158Smillert untie %h; 87*b39c5158Smillert print "ok 19"; 88*b39c5158Smillert 89*b39c5158Smillert}; 90