Repatch (from linux) of OSX IRAF

16 files changed, 318 insertions, 0 deletions

diff --git a/pkg/vocl/errtest/errif.cl b/pkg/vocl/errtest/errif.cl
new file mode 100644
index 00000000..6328fab6
--- /dev/null
+++ b/pkg/vocl/errtest/errif.cl
@@ -0,0 +1,24 @@
+#{  ERRIF -- Test error types.
+
+procedure errif (type)
+
+int	type			{ prompt = "Error test code: " 	}
+
+begin
+	int 	code
+
+	# get local script variable of param
+	code = type
+
+	if (code == 1) {			# FPE test
+	    fpe ()
+	} else if (code == 2) {			# SEGVIO test
+	    segvio ()
+	} else if (code == 3) {			# SPP error() call test
+	    spperr ()
+	} else if (code == 4) {			# non-existant task test
+	    foo ()
+	} else if (code == 5) {			# CL error() command
+	    error (code, "cl error() command")
+	}
+end
diff --git a/pkg/vocl/errtest/errtest.cl b/pkg/vocl/errtest/errtest.cl
new file mode 100644
index 00000000..9fea81e4
--- /dev/null
+++ b/pkg/vocl/errtest/errtest.cl
@@ -0,0 +1,25 @@
+#{ ERRTEST.CL -- Package declaration for the CLERR recovery/test suite.
+
+package errtest
+
+task	$fpe,
+	$segvio,
+	$spperr		= "errtest$spperrs.e"
+
+task	errif		= "errtest$errif.cl"
+task	errtype		= "errtest$errtype.cl"
+task	$sfpe		= "errtest$sfpe.cl"
+task	nested		= "errtest$nested.cl"
+task	recursion	= "errtest$recursion.cl"
+
+task	$zztest		= "errtest$zztest.cl"
+task	$printvals	= "errtest$printvals.cl"
+
+task	nest0		= "errtest$nest0.cl"
+task	recur0		= "errtest$recur0.cl"
+
+task	test_iferr	= "errtest$test_iferr.cl"
+
+hidetask nest0, recur0
+
+clbye()
diff --git a/pkg/vocl/errtest/errtest.hd b/pkg/vocl/errtest/errtest.hd
new file mode 100644
index 00000000..8f9c33a2
--- /dev/null
+++ b/pkg/vocl/errtest/errtest.hd
@@ -0,0 +1,9 @@
+# Help directory for the CLERR (CL error recovery test) package.
+
+$clerr		= "./"
+
+# Define help files for the packages.
+
+clerr		men = clerr$clerr.men,
+		pkg = clerr$clerr.hd,
+		src = clerr$clerr.cl
diff --git a/pkg/vocl/errtest/errtest.men b/pkg/vocl/errtest/errtest.men
new file mode 100644
index 00000000..e523a64f
--- /dev/null
+++ b/pkg/vocl/errtest/errtest.men
@@ -0,0 +1,14 @@
+
+     		CL Script Test Tasks
+     		--------------------------
+     errtype -- Script to call task of particular error type
+       errif -- Errtype using 'if' instead of 'switch'
+      nested -- Nested calls of error scripts
+        sfpe -- Simple wrapper of 'fpe' task
+
+
+     		SPP Error Generating Tasks
+     		--------------------------
+         fpe -- Generate a floating point error
+      segvio -- Generate a segmentation fault
+      spperr -- SPP error() function call
diff --git a/pkg/vocl/errtest/errtest.par b/pkg/vocl/errtest/errtest.par
new file mode 100644
index 00000000..1b950a60
--- /dev/null
+++ b/pkg/vocl/errtest/errtest.par
@@ -0,0 +1,3 @@
+# Package parameters for the CLERR package.
+
+version,s,h,"Apr 01, 2004"
diff --git a/pkg/vocl/errtest/errtype.cl b/pkg/vocl/errtest/errtype.cl
new file mode 100644
index 00000000..58df9623
--- /dev/null
+++ b/pkg/vocl/errtest/errtype.cl
@@ -0,0 +1,74 @@
+#{  ERRTYPE -- Test error types.
+
+procedure errtype (type)
+
+int	type			{ prompt = "Error test type: " 	}
+
+begin
+	if (type == 0) 							#  8
+	    goto usage_							#  9
+									# 10
+	switch (type) {							# 11
+									# 12
+	# SPP task errors.						# 13
+	case 1: 			# FPE test			# 14
+	    	fpe ()							# 15
+	case 2: 			# SEGVIO test			# 16
+	    	segvio ()						# 17
+	case 3: 			# SPP error() call test		# 18
+	    	spperr ()						# 19
+									# 20
+									# 21
+	# CL-generated errors.						# 22
+	case 4: 			# non-existant task test 	# 23
+	    	nonexist ()						# 24
+	case 5: 			# CL error command		# 25
+	    	error (type, "cl error() command")			# 26
+	case 6: 			# CL div by zero		# 27
+		i = 1.0 / 0.0						# 28
+	case 7: 			# function error		# 29
+		s1 = envget (1)						# 30
+	case 8: 			# legal return from script	# 31
+	    {								# 32
+		print ("simple CL return")				# 33
+	    	return							# 34
+	    }								# 35
+									# 36
+	# Grammar tests.						# 37
+	case 9: fpe() 			# FPE test w/ no newline	# 38
+	case 10:  			# FPE test w/in compound block	# 39
+		{ i = 0; fpe(); i = 1;					# 40
+		}							# 41
+									# 42
+	# Pipe tests.							# 43
+	case 11:							# 44
+		{ print ("fpe") | cl()	# FPE from a piped command	# 45
+		}							# 46
+	case 12:							# 47
+		{ print ("foo") | cl()	# invalid command in a pipe	# 48
+		}							# 49
+									# 50
+	# New features tests.						# 51
+#	case -1: 			# Test negative case constant	# 52
+#		print ("negative code")					# 53
+									# 54
+	default:							# 55
+		print ("default case reached")				# 56
+	}								# 57
+
+	return
+
+usage_:
+	print ("1:	fpe				recoverable")
+	print ("2	segvio				recoverable")
+	print ("3:	spperr				recoverable")
+	print ("4:	nonexistant task		recoverable")
+	print ("5:	CL error command		recoverable")
+	print ("6	CL div by zero			recoverable")
+	print ("7:	intrinsic function error	non-recoverable")
+	print ("8	CL return			non-error")
+	print ("9	FPE test w/ no newline		recoverable - grammar")
+	print ("10	FPE test w/in compound block	recoverable - grammar")
+	print ("11	FPE from piped command		recoverable")
+	print ("12	invalid command in a pipe	internal error")
+end									# 74
diff --git a/pkg/vocl/errtest/mkpkg b/pkg/vocl/errtest/mkpkg
new file mode 100644
index 00000000..ae7ddb80
--- /dev/null
+++ b/pkg/vocl/errtest/mkpkg
@@ -0,0 +1,9 @@
+
+$call	relink
+$exit
+
+
+relink:
+	$omake	spperrs.x
+	$link	spperrs.o
+	;
diff --git a/pkg/vocl/errtest/nest0.cl b/pkg/vocl/errtest/nest0.cl
new file mode 100644
index 00000000..0cbb533b
--- /dev/null
+++ b/pkg/vocl/errtest/nest0.cl
@@ -0,0 +1,14 @@
+#{  NEST0 -- Test error types from nested scripts.
+
+procedure nest0 (type)
+
+int	type			{ prompt = "Error test code: " 	}
+
+begin
+	# dummy space
+	# dummy space
+	# dummy space
+	# dummy space
+
+	errtype (type)
+end
diff --git a/pkg/vocl/errtest/nested.cl b/pkg/vocl/errtest/nested.cl
new file mode 100644
index 00000000..ff452eaa
--- /dev/null
+++ b/pkg/vocl/errtest/nested.cl
@@ -0,0 +1,12 @@
+#{  NESTED -- Test error types from nested scripts.
+
+procedure nested (type)
+
+int	type			{ prompt = "Error test code: " 	}
+
+begin
+	# dummy space
+	# dummy space
+
+	nest0 (type)
+end
diff --git a/pkg/vocl/errtest/printvals.cl b/pkg/vocl/errtest/printvals.cl
new file mode 100644
index 00000000..d7e1a30d
--- /dev/null
+++ b/pkg/vocl/errtest/printvals.cl
@@ -0,0 +1,20 @@
+procedure printvals ()
+
+begin
+
+time
+return
+	printf ("PRINTVALS:\n");
+	printf ("\t$errno = %d\n", $errno)
+	printf ("\t$errmsg = %d\n", $errmsg)
+	printf ("\t$errtask = %d\n", $errtask)
+
+	i  =  cl.$errno
+	s1 =  cl.$errmsg
+	s2 =  cl.$errtask
+
+	=i
+	=s1
+	=s2
+	keep
+end
diff --git a/pkg/vocl/errtest/recur0.cl b/pkg/vocl/errtest/recur0.cl
new file mode 100644
index 00000000..35266292
--- /dev/null
+++ b/pkg/vocl/errtest/recur0.cl
@@ -0,0 +1,13 @@
+#{ RECURS0.CL -- Test CL calling recursion.
+
+procedure recurs0 (level)
+
+int	level
+
+begin
+	j = level + 1
+	if (level == 0)
+	    recursion (j)
+	else
+	    sfpe ()
+end
diff --git a/pkg/vocl/errtest/recursion.cl b/pkg/vocl/errtest/recursion.cl
new file mode 100644
index 00000000..2b66c27f
--- /dev/null
+++ b/pkg/vocl/errtest/recursion.cl
@@ -0,0 +1,13 @@
+#{ RECURSION.CL -- Test CL calling recursion.
+
+procedure recursion (level)
+
+int	level
+
+begin
+	if (level == 0)
+	    i = 0
+	else
+	    i = level
+	recur0 (i)
+end
diff --git a/pkg/vocl/errtest/sfpe.cl b/pkg/vocl/errtest/sfpe.cl
new file mode 100644
index 00000000..75e89e2f
--- /dev/null
+++ b/pkg/vocl/errtest/sfpe.cl
@@ -0,0 +1,6 @@
+#{ sfpe -- Simple FPE error test.
+
+procedure sfpe ()
+begin
+	fpe ()
+end
diff --git a/pkg/vocl/errtest/spperrs.x b/pkg/vocl/errtest/spperrs.x
new file mode 100644
index 00000000..0715393b
--- /dev/null
+++ b/pkg/vocl/errtest/spperrs.x
@@ -0,0 +1,25 @@
+task fpe 	= t_fpe,
+     segvio 	= t_segvio,
+     spperr	= t_spperr
+
+procedure t_fpe ()
+real	x, y, z
+begin
+	x = 1.0
+	y = 0.0
+	z = x / y
+end
+
+
+procedure t_segvio ()
+pointer	ip
+begin
+	ip = 0
+	Memc[ip] = 'x'
+end
+
+
+procedure t_spperr ()
+begin
+	call error (123, "test spp error()")
+end
diff --git a/pkg/vocl/errtest/test_iferr.cl b/pkg/vocl/errtest/test_iferr.cl
new file mode 100644
index 00000000..5cf40d6c
--- /dev/null
+++ b/pkg/vocl/errtest/test_iferr.cl
@@ -0,0 +1,33 @@
+#{  TEST_IFERR -- Test various iferr constructs.
+
+procedure test_iferr (type)
+
+int	type			{ prompt = "Error test code: " 	}
+
+begin
+	printf ("Testing iferr....\n\t")
+	for (i=1; i <= 5; i=i+1) {
+	    iferr { errif (i) } then {
+	        print ("    error from test #"//i)
+	    } else {
+	        print ("    NO error from test #"//i)
+	    }
+	}
+
+	printf ("\n\n")
+	printf ("Testing divzero error....\n\t")
+	iferr { i = 1 / 0 } then {
+	    print ("    error from divzero test")
+	} else {
+	    print ("    NO error from divzero test")
+	}
+	;
+
+	printf ("\n\n")
+	printf ("Testing fdivzero error....\n\t")
+	iferr { x = 1.0 / 0.0 } then {
+	    print ("    error from fdivzero test")
+	} else {
+	    print ("    NO error from fdivzero test")
+	}
+end
diff --git a/pkg/vocl/errtest/zztest.cl b/pkg/vocl/errtest/zztest.cl
new file mode 100644
index 00000000..d63151f1
--- /dev/null
+++ b/pkg/vocl/errtest/zztest.cl
@@ -0,0 +1,24 @@
+#{  ZZTEST -- Test various iferr constructs.
+
+procedure zztest ()
+
+begin
+	int	nerrs
+
+	onerror ("flpr")
+
+	printf ("Testing iferr....\n")
+	nerrs = 0
+
+	for (i=1; i <= 5; i=i+1) {
+	    iferr { fpe () } then {
+	        print ("    error from test #"//i)
+		nerrs = nerrs + 1
+	    } else {
+	        print ("    NO error from test #"//i)
+	    }
+	}
+
+	if (nerrs > 0) 
+	    error (999, "errors found in script")
+end