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 qw(:DEFAULT register); 12 13$| = 1; # Otherwise data from REXX may come first 14 15print "1..18\n"; 16 17$n = 1; 18sub do_me { 19 print "ok $n\n"; 20 "OK"; 21} 22 23@res = REXX_call(\&do_me); 24print "ok 2\n"; 25@res == 1 ? print "ok 3\n" : print "not ok 3\n"; 26$res[0] eq "OK" ? print "ok 4\n" : print "not ok 4\n# `$res[0]'\n"; 27 28# Try again 29$n = 5; 30@res = REXX_call(\&do_me); 31print "ok 6\n"; 32@res == 1 ? print "ok 7\n" : print "not ok 7\n"; 33$res[0] eq "OK" ? print "ok 8\n" : print "not ok 8\n# `$res[0]'\n"; 34 35REXX_call { print "ok 9\n" }; 36REXX_eval 'say "ok 10"'; 37# Try again 38REXX_eval 'say "ok 11"'; 39print "ok 12\n" if REXX_eval("return 2 + 3") eq 5; 40REXX_eval_with 'say myfunc()', myfunc => sub {"ok 13"}; 41REXX_eval_with "call myout 'ok' 14", myout => sub {print shift, "\n"}; 42REXX_eval_with "say 'ok 'myfunc(3,5)", myfunc => sub {shift() * shift()}; 43 44sub MYFUNC1 {shift} 45sub MYFUNC2 {3 * shift} 46REXX_eval_with "call myfunc 47 say 'ok 'myfunc1(1)myfunc2(2)", 48 myfunc => sub { register qw(myfunc1 myfunc2) }; 49 50REXX_eval_with "say 'ok 'myfunc(10,7)", 51 myfunc => sub { REXX_eval "return $_[0] + $_[1]" }; 52 53sub MyFunc3 {print 'ok ', shift() + shift(), "\n"} 54REXX_eval "address perleval\n'MyFunc3(10,8)'"; 55