https://perl5.git.perl.org / perl5.git / blame
| 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="???"' */ |