Efficiency patchlet for pp_aassign()
[p5sagit/p5-mst-13.2.git] / os2 / OS2 / REXX / t / rx_tievar.t
CommitLineData
760ac839 1BEGIN {
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
11use OS2::REXX;
12
13#
14# DLL
15#
16load OS2::REXX "ydbautil" or die "1..0\n# load\n";
17
18print "1..19\n";
19
20REXX_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};