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

<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
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/perl-5.22.2/os2/perlrexx.cmd	Sat May 14 14:54:38 2016 +0000
@@ -0,0 +1,68 @@
+/* Test PERLREXX.DLL */
+/* Example:
+   perlrexx.cmd BEGIN {push @INC, 'lib'} use OS2::REXX; REXX_eval "address cmd\n'copyy'";
+ */
+
+call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
+call SysLoadFuncs
+
+parse arg args
+retval = runperl(args)
+say 'retval = "'retval'"'
+exit 0
+
+addperl: procedure
+  parse arg perlf
+  pathname='perlrexx'
+  r = RxFuncAdd(perlf, pathname, perlf)
+  say "RxFuncAdd("perlf","pathname") -> "r
+  return
+
+runperl1: procedure
+  parse arg perlarg
+  call addperl('PERL')
+  call addperl('PERLTERM')
+  call addperl('PERLEXIT')
+  call addperl('PERLEVAL')
+  call addperl('PERLLASTERROR')
+  signal on syntax name runperl_error
+/*  signal on error name runperl_error
+  signal on failure name runperl_error */
+  say "doing PERLEVAL("perlarg")"
+  tmp = PERLEVAL(perlarg)
+  say "PERLEVAL -> '"tmp"'"
+  signal off syntax
+  call RxFuncDrop 'PERL'
+  call RxFuncDrop 'PERLLASTERROR'
+  call RxFuncDrop 'PERLTERM'
+  call RxFuncDrop 'PERLEVAL'
+  call PERLEXIT
+  call RxFuncDrop 'PERLEXIT'
+  return pathname ': PERLEVAL('perlarg') =' tmp
+
+runperl: procedure
+  parse arg perlarg
+  pathname='perlrexx'
+  r = RxFuncAdd("PerlExportAll", pathname, "PERLEXPORTALL")
+  say "RxFuncAdd("'PerlExportAll'","pathname") -> "r
+  r = PerlExportAll()
+  say "PerlExportAll() -> "r
+  signal on syntax name runperl_error
+/*  signal on error name runperl_error
+  signal on failure name runperl_error */
+  say "doing PERLEVAL("perlarg")"
+  tmp = PERLEVAL(perlarg)
+  say "PERLEVAL -> '"tmp"'"
+  address evalperl perlarg
+  say "Did address evalperl "perlarg
+  signal off syntax
+  r = PerlDropAllExit()
+  /* The following line is not reached...  Why? */
+  say "PerlDropAllExit() -> "r
+  return pathname ': PERLEVAL('perlarg') =' tmp
+
+
+runperl_error:
+  return pathname ': REXX->Perl interface not available; rc="'rc'", .rs="'.rs'", errstr="'errortext(rc)'", perlerr="'PERLLASTERROR()'"'
+
+/*  return pathname ': REXX->Perl interface not available; rc="'rc'", .rs="'.rs'", errstr="'errortext(rc)'", perlerr="???"' */