| Commit | Line | Data |
|---|
| 622913ab |
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="???"' */ |
projects / p5sagit/p5-mst-13.2.git / blame