Commit | Line | Data |
---|---|---|
622913ab IZ |
1 | /* Test PERLREXX.DLL */ |
2 | /* Example: | |
3 | perlrexx.cmd BEGIN {push @INC, 'lib'} use OS2::REXX; REXX_eval "address cmd\n'copyy'"; | |
4 | */ | |
5 | ||
6 | call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs' | |
7 | call SysLoadFuncs | |
8 | ||
9 | parse arg args | |
10 | retval = runperl(args) | |
11 | say 'retval = "'retval'"' | |
12 | exit 0 | |
13 | ||
14 | addperl: procedure | |
15 | parse arg perlf | |
16 | pathname='perlrexx' | |
17 | r = RxFuncAdd(perlf, pathname, perlf) | |
18 | say "RxFuncAdd("perlf","pathname") -> "r | |
19 | return | |
20 | ||
21 | runperl1: procedure | |
22 | parse arg perlarg | |
23 | call addperl('PERL') | |
24 | call addperl('PERLTERM') | |
25 | call addperl('PERLEXIT') | |
26 | call addperl('PERLEVAL') | |
27 | call addperl('PERLLASTERROR') | |
28 | signal on syntax name runperl_error | |
29 | /* signal on error name runperl_error | |
30 | signal on failure name runperl_error */ | |
31 | say "doing PERLEVAL("perlarg")" | |
32 | tmp = PERLEVAL(perlarg) | |
33 | say "PERLEVAL -> '"tmp"'" | |
34 | signal off syntax | |
35 | call RxFuncDrop 'PERL' | |
36 | call RxFuncDrop 'PERLLASTERROR' | |
37 | call RxFuncDrop 'PERLTERM' | |
38 | call RxFuncDrop 'PERLEVAL' | |
39 | call PERLEXIT | |
40 | call RxFuncDrop 'PERLEXIT' | |
41 | return pathname ': PERLEVAL('perlarg') =' tmp | |
42 | ||
43 | runperl: procedure | |
44 | parse arg perlarg | |
45 | pathname='perlrexx' | |
46 | r = RxFuncAdd("PerlExportAll", pathname, "PERLEXPORTALL") | |
47 | say "RxFuncAdd("'PerlExportAll'","pathname") -> "r | |
48 | r = PerlExportAll() | |
49 | say "PerlExportAll() -> "r | |
50 | signal on syntax name runperl_error | |
51 | /* signal on error name runperl_error | |
52 | signal on failure name runperl_error */ | |
53 | say "doing PERLEVAL("perlarg")" | |
54 | tmp = PERLEVAL(perlarg) | |
55 | say "PERLEVAL -> '"tmp"'" | |
56 | address evalperl perlarg | |
57 | say "Did address evalperl "perlarg | |
58 | signal off syntax | |
59 | r = PerlDropAllExit() | |
60 | /* The following line is not reached... Why? */ | |
61 | say "PerlDropAllExit() -> "r | |
62 | return pathname ': PERLEVAL('perlarg') =' tmp | |
63 | ||
64 | ||
65 | runperl_error: | |
66 | return pathname ': REXX->Perl interface not available; rc="'rc'", .rs="'.rs'", errstr="'errortext(rc)'", perlerr="'PERLLASTERROR()'"' | |
67 | ||
68 | /* return pathname ': REXX->Perl interface not available; rc="'rc'", .rs="'.rs'", errstr="'errortext(rc)'", perlerr="???"' */ |