Commit | Line | Data |
760ac839 |
1 | BEGIN { |
2 | chdir 't' if -d 't/lib'; |
3 | @INC = '../lib' if -d 'lib'; |
4 | require Config; import Config; |
bbad3607 |
5 | if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) { |
760ac839 |
6 | print "1..0\n"; |
7 | exit 0; |
8 | } |
9 | } |
10 | |
11 | use OS2::REXX; |
12 | |
13 | # |
14 | # DLL |
15 | # |
146174a9 |
16 | load OS2::REXX "ydbautil" |
17 | or print "1..0 # skipped: cannot find YDBAUTIL.DLL\n" and exit; |
760ac839 |
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 | }; |