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