Mercurial > repo

comparison perl-5.22.2/os2/perlrexx.cmd @ 8045:a16537d2fe07

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
<xfix> tar xf perl-5.22.2.tar.gz # Ah, whatever, I\'m doing it anyway
author HackBot
date Sat, 14 May 2016 14:54:38 +0000
parents
children
comparison
equal deleted inserted replaced
8044:711c038a7dce 8045:a16537d2fe07
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="???"' */