Ensure -DUSE_PERLIO gets into Config's ccflags when using dmake on Windows
[perl.git] / os2 / perlrexx.cmd
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="???"' */