Update tests and fix PIPE problem.

4 files changed, 82 insertions, 25 deletions

diff --git a/vms/ChangeLog b/vms/ChangeLog
index faa1e409..2fcb4fba 100644
--- a/vms/ChangeLog
+++ b/vms/ChangeLog
@@ -1,3 +1,7 @@
+Sat May 14 22:42:28 2011  Pat Rankin  <rankin@pactechdata.com>
+
+	* vmstest.com (exit): Fixed test to work.
+
 Mon May  9 01:43:40 2011  Pat Rankin  <rankin@pactechdata.com>
 
 	* vmstest.com (arraysort, delsub, exit, next, ofmta, sortu): New
diff --git a/vms/gawk.cld b/vms/gawk.cld
index fce15cdf..2848e7e4 100644
--- a/vms/gawk.cld
+++ b/vms/gawk.cld
@@ -38,7 +38,7 @@ define verb GAWK
     qualifier non_decimal_data
     qualifier characters_as_bytes
     qualifier use_lc_numeric
-    qualifier get_pot
+    qualifier gen_pot
     qualifier reg_expr, value(type=reg_expr_keywords)		!(OBSOLETE)
     disallow  progfile and program  !or not progfile and not program
     !disallow lint.warn and (lint.fatal or lint.invalid)
diff --git a/vms/vms_gawk.c b/vms/vms_gawk.c
index 1fb956e0..222d803d 100644
--- a/vms/vms_gawk.c
+++ b/vms/vms_gawk.c
@@ -119,26 +119,10 @@ vms_gawk()
 
     misc_argp = misc_args;
     *misc_argp++ = '-';		/* now points at &misc_args[1] */
-#if 0		/* as of 2.12, -a and -e are obsolete */
-    if (Present("REG_EXPR")) {
-	if (Present("REG_EXPR.AWK"))		/* /reg_exp=awk -> -a */
-	    *misc_argp++ = 'a';
-	else if (Present("REG_EXPR.EGREP")	/* /reg_exp=egrep -> -e */
-	      || Present("REG_EXPR.POSIX"))	/* /reg_exp=posix -> -e */
-	    *misc_argp++ = 'e';
-    }
-#endif	/* 0 */
-#if 0	/* gawk 2.11.1 */
-    if (Present("STRICT"))		/* /strict -> -c */
-	*misc_argp++ = 'c';
-    if (Present("COPYRIGHT"))		/* /copyright -> -C */
-	*misc_argp++ = 'C';
-    if (Present("VERSION"))		/* /version -> -V */
-	*misc_argp++ = 'V';
-#else	/* gawk 2.12 and later */
+    if (Present("OPTIMIZE"))
+	*misc_argp++ = 'O';
     W_cnt = 0,	buf.arg.buf[0] = '\0';
     strncpy(buf.arg.prefix, "-W", 2);
-    chk_option("OPTIMIZE", "optimize");
     if (Present("LINT")) {
 	if (!Present("LINT.FATAL") && !Present("LINT.INVALID"))
 	    chk_option("LINT.WARN", "lint");
@@ -166,7 +150,7 @@ vms_gawk()
 # endif
     if (W_cnt > 0)			/* got something */
 	v_add_arg(++argc, strdup(buf.value));
-#endif	/*0*/
+
 #ifdef DEBUG /* most debugging functionality moved to separate DGAWK program */
     if (Present("DEBUG"))
 	    *misc_argp++ = 'Y';		/* --parsedebug */
diff --git a/vms/vmstest.com b/vms/vmstest.com
index d5130e54..90d61b8d 100644
--- a/vms/vmstest.com
+++ b/vms/vmstest.com
@@ -47,7 +47,7 @@ $		list = "msg addcomma anchgsub argarray arrayparm arrayref" -
 		  + " clobber closebad clsflnam compare compare2 concat1"
 $		gosub list_of_tests
 $		list = "concat2 concat3 concat4 convfmt datanonl defref" -
-		  + " delarprm delarpm2 delfunc dynlj eofsplit exit exitval1" -
+		  + " delarprm delarpm2 delfunc dynlj eofsplit exitval1" -
 		  + " exitval2 fcall_exit fcall_exit2 fldchg fldchgnf" -
 		  + " fnamedat fnarray fnarray2 fnaryscl fnasgnm fnmisc" -
 		  + " fordel forref forsimp fsbs fsspcoln fsrs fstabplus" -
@@ -58,7 +58,7 @@ $		list = "getlnbuf getnr2tb getnr2tm gsubasgn gsubtest" -
 		  + " hsprint inputred intest intprec iobug1" -
 		  + " leaddig leadnl litoct longsub longwrds"-
 		  + " manglprm math membug1 messages minusstr mmap8k" -
-		  + " mtchi18n nasty nasty2 negexp negrange nested next" -
+		  + " mtchi18n nasty nasty2 negexp negrange nested" -
 		  + " nfldstr nfneg"
 $		gosub list_of_tests
 $		list = "nfset nlfldsep nlinstr nlstrina noeffect nofile" -
@@ -94,14 +94,14 @@ $gnu:
 $gawk_ext:	echo "gawk_ext... (gawk.extensions)"
 $		list = "aadelete1 aadelete2 aarray1 aasort aasorti" -
 		  + " argtest arraysort backw badargs beginfile1 binmode1" -
-		  + " clos1way delsub devfd devfd1 devfd2 dumpvars fieldwdth" -
-		  + " fpat1 funlen fsfwfs fwtest fwtest2 gensub" -
+		  + " clos1way delsub devfd devfd1 devfd2 dumpvars exit" -
+		  + " fieldwdth fpat1 funlen fsfwfs fwtest fwtest2 gensub" -
 		  + " gensub2 getlndir gnuops2 gnuops3 gnureops icasefs" -
 		  + " icasers igncdym igncfs ignrcase ignrcas2"
 $		gosub list_of_tests
 $		list = "indirectcall lint lintold lintwarn match1" -
 		  + " match2 match3 manyfiles mbprintf3 mbstr1" -
-		  + " nastyparm nondec" -
+		  + " nastyparm next nondec" -
 		  + " nondec2 patsplit posix profile1 procinfs printfbad1" -
 		  + " printfbad2 regx8bit rebuf reint reint2 rsstart1" -
 		  + " rsstart2 rsstart3 rstest6 shadow sortfor sortu" -
@@ -1487,6 +1487,75 @@ $	if $status then  rm _exit.tmp;
 $	return
 $
 $do__exit: subroutine
+$	gawk = gawk !PIPE won't propagate local symbols from outer procedure
+$	x = "BEGIN{print 1; exit; print 2}; NR>1{print}; END{print 3; exit; print 4}"
+$	pipe gawk -- "BEGIN { print ""a\nb"" }" | gawk -- "''x'"
+$	echo "-- 1"
+$	x = "function f(){exit}; END{print NR;f();print NR}"
+$	pipe gawk -- "BEGIN { print ""a\nb"" }" | gawk -- "''x'"
+$	echo "-- 2"
+$	x = "function f(){exit}; NR>1 {f()}; END{print NR; f();print NR}"
+$	pipe gawk -- "BEGIN { print ""a\nb"" }" | gawk -- "''x'"
+$	echo "-- 3"
+$	x = "function f(){exit}; NR>1 {f()}; END{print NR;print NR}"
+$	pipe gawk -- "BEGIN { print ""a\nb"" }" | gawk -- "''x'"
+$	echo "-- 4"
+$	x = "function f(){exit}; BEGINFILE {f()}; NR>1 {f()}; END{print NR}"
+$	pipe gawk -- "BEGIN { print ""a\nb"" }" | gawk -- "''x'"
+$	echo "-- 5"
+$!	Ugh; extra quotes are needed here to end up with """" after "''y'"
+$!	expansion and finally "" when gawk actually sees its command line.
+$	y = "function strip(f) { sub(/.*\//, """""""", f); return f };"
+$	x = "BEGINFILE{if(++i==1) exit;}; END{print i, strip(FILENAME)}"
+$	gawk "''y'''x'" /dev/null exit.sh
+$	echo "-- 6"
+$	x = "BEGINFILE{if(++i==1) exit;}; ENDFILE{print i++}; END{print i, strip(FILENAME)}"
+$	gawk "''y'''x'" /dev/null exit.sh
+$	echo "-- 7"
+$	x = "function f(){exit}; BEGINFILE{i++ && f()}; END{print NR,strip(FILENAME)}"
+$	gawk "''y'''x'" /dev/null exit.sh
+$	echo "-- 8"
+$	x = "function f(){exit}; BEGINFILE{i++ && f()}; ENDFILE{print i}; END{print NR,strip(FILENAME)}"
+$	gawk "''y'''x'" /dev/null exit.sh
+$	echo "-- 9"
+$	x = "function f(){exit}; BEGINFILE{i++}; ENDFILE{f(); print i}; END{print NR,strip(FILENAME)}"
+$	gawk "''y'''x'" /dev/null exit.sh
+$	echo "-- 10"
+$	x = "function f(){exit}; BEGINFILE{i++}; ENDFILE{i>1 && f(); print i, strip(FILENAME)}"
+$	gawk "''y'''x'" /dev/null exit.sh
+$	echo "-- 11"
+$ endsubroutine !do__exit
+$
+$next:	echo "next"
+$	set noOn
+$	gawk "{next}" _NL:                                   > _next.tmp 2>&1
+$	gawk "function f() {next}; {f()}" _NL:               >>_next.tmp 2>&1
+$	gawk "function f() {next}; BEGIN{f()}" _NL:          >>_next.tmp 2>&1
+$	gawk "function f() {next}; {f()}; END{f()}" _NL:     >>_next.tmp 2>&1
+$	gawk "function f() {next}; BEGINFILE{f()}" _NL:      >>_next.tmp 2>&1
+$	gawk "function f() {next}; {f()}; ENDFILE{f()}" _NL: >>_next.tmp 2>&1
+$	set On
+$	cmp next.ok _next.tmp
+$	if $status then  rm _next.tmp;
+$	return
+$
+$exit:	echo "exit"
+$	if .not.pipeok
+$	then	echo "Without the PIPE command, ''test' can't be run."
+$		On warning then  return
+$		pipe echo "PIPE command is available; running exit test"
+$		On warning then  $
+$		pipeok = 1
+$	else	echo "PIPE command is available; running exit test"
+$	endif
+$	set noOn
+$	call/Output=_exit.tmp do__exit
+$	set On
+$	cmp exit.ok _exit.tmp
+$	if $status then  rm _exit.tmp;
+$	return
+$
+$do__exit: subroutine
 $	x = "BEGIN{print 1; exit; print 2}; NR>1{print}; END{print 3; exit; print 4}"
 $	pipe gawk -- "BEGIN { print ""a\nb"" }" | gawk -- "''x'"
 $	echo "-- 1"