aboutsummaryrefslogtreecommitdiff
path: root/pkg/vocl/errtest
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/vocl/errtest')
-rw-r--r--pkg/vocl/errtest/errif.cl24
-rw-r--r--pkg/vocl/errtest/errtest.cl25
-rw-r--r--pkg/vocl/errtest/errtest.hd9
-rw-r--r--pkg/vocl/errtest/errtest.men14
-rw-r--r--pkg/vocl/errtest/errtest.par3
-rw-r--r--pkg/vocl/errtest/errtype.cl74
-rw-r--r--pkg/vocl/errtest/mkpkg9
-rw-r--r--pkg/vocl/errtest/nest0.cl14
-rw-r--r--pkg/vocl/errtest/nested.cl12
-rw-r--r--pkg/vocl/errtest/printvals.cl20
-rw-r--r--pkg/vocl/errtest/recur0.cl13
-rw-r--r--pkg/vocl/errtest/recursion.cl13
-rw-r--r--pkg/vocl/errtest/sfpe.cl6
-rw-r--r--pkg/vocl/errtest/spperrs.x25
-rw-r--r--pkg/vocl/errtest/test_iferr.cl33
-rw-r--r--pkg/vocl/errtest/zztest.cl24
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
generated by cgit (git 2.34.1) at 2025-09-20 07:06:11 -0400