start test cases for <cons.h> material.

Small documentation tweak. Numerous bugfixes as a result of
testing: null, endp, stringp, symbolp, box, unbox, cdr,
equal all found to have some issues.

4 files changed, 391 insertions, 38 deletions

diff --git a/cppawk-cons.1 b/cppawk-cons.1
index 5cd6c82..8de5fe7 100644
--- a/cppawk-cons.1
+++ b/cppawk-cons.1
@@ -623,10 +623,12 @@ function creates a Lisp object from a native Awk value
 .IR av .
 If
 .I av
-is a number, then
+is numeric, then
 .B box
 returns
 .IR av .
+Note that a value like \fB"1abc\fB is numeric in Awk and
+behaves like 1 under arithmetic.
 If
 .I av
 is the Awk undefined value, such as the value of a variable that
diff --git a/cppawk-include/cons-priv.h b/cppawk-include/cons-priv.h
index 1e32624..271d840 100644
--- a/cppawk-include/cons-priv.h
+++ b/cppawk-include/cons-priv.h
@@ -134,17 +134,16 @@ function __atom(__obj)
 
 function __null(__obj)
 {
-  return __obj == __nil
+  return __obj == __nil && __obj != 0
 }
-#define __null(obj) ((obj) == __nil)
 
 function __endp(__obj)
 {
-  if (__obj == __nil)
+  if (__obj == __nil && __obj != 0)
     return 1
-      if (__consp(__obj))
-        return __nil
-          __error("endp: a proper list ends with nil, not %s", __obj)
+  if (__consp(__obj))
+    return 0
+  __error("endp: a proper list ends with nil, not %s", __obj)
 }
 
 function __bs_esc(raw)
@@ -161,15 +160,14 @@ function __numberp(__obj)
 
 function __stringp(__obj)
 {
-  return __typecode(obj) == "T"
+  return __typecode(__obj) == "T"
 }
-#define __stringp(obj) (substr(obj, 1, 1) == "T")
+#define __stringp(obj) (__typecode(obj) == "T")
 
 function __symbolp(__obj)
 {
-  return __typecode(obj) ~ /^S?$/
+  return __obj != 0 && __typecode(__obj) ~ /^S?$/
 }
-#define __symbolp(obj) (substr(obj, 1, 1) ~ /^S?$/)
 
 function __box(__raw,
                __check,
@@ -181,18 +179,19 @@ function __box(__raw,
   if (__present(__check))
     __error("box; excess argument %s", __check)
 
-  __case (__typecode(__raw)) {
-    __of ("T", "S", "C")
-      __cret ("T" __raw) // represent as unescaped string
-    __otherwise
-      __cret (__raw)
-  }
+  if (__numberp(__raw))
+    return __raw;
+
+  return "T" __raw;
 }
 
 function __unbox(__obj,
                  __check,
                  __case_temps)
 {
+  if (!__present(__obj))
+    __error("unbox: missing or undefined argument")
+
   if (__present(__check))
     __error("unbox; excess argument %s", __check)
 
@@ -247,14 +246,14 @@ function __cdr(__cell,
     __col = match(__cell, /:/)
     __com = match(__cell, /,/)
     if (__col == 0 || __com == 0 || __col <= __com)
-      __error("car: %s has a malformed cons header", __cell)
+      __error("cdr: %s has a malformed cons header", __cell)
     __alen = substr(__cell, 2, __com - 2 + 1)
     __dlen = substr(__cell, __com + 1, __col - __com)
     return substr(__cell, __col + 1 + __alen, __dlen)
   } else if (__null(__cell)) {
     return __nil
   } else {
-    __error("car: %s isn't a cons", __cell)
+    __error("cdr: %s isn't a cons", __cell)
   }
 }
 
@@ -354,6 +353,15 @@ function __keys(__array,
   return __list_end(__tmp)
 }
 
+
+function __equal(__obj1, __obj2)
+{
+  if (__obj1 == __obj2)
+    return 1;
+  return __slow_equal(__obj1, __obj2)
+}
+#define __equal(obj1, obj2) ((obj1) == (obj2) ? 1 : __slow_equal(obj1, obj2))
+
 function __slow_equal(__obj1, __obj2,
                       __tc1, __tc2, __case_temps)
 {
@@ -364,7 +372,7 @@ function __slow_equal(__obj1, __obj2,
     __of ("CC")
       __cret (__equal(__car(__obj1), __car(__obj2)) &&
               __equal(__cdr(__obj1), __cdr(__obj2)))
-    __matching (/[TSC][TSC]/)
+    __matching (/[UTSC][UTSC]/)
       __cret (0);
   }
 
@@ -374,21 +382,13 @@ function __slow_equal(__obj1, __obj2,
   if (__tc2 == "T")
     return __obj1 == __unbox(__obj2);
 
-  if (__numberp(__obj1))
-    return __obj1 + 0 == __obj2
+  if (__numberp(__obj1) && __numberp(__obj2)) {
+    return __obj1 + 0 == __obj2 + 0
+  }
 
   return 0;
 }
 
-function __equal(__obj1, __obj2)
-{
-  if (__obj1 == __obj2)
-    return 1;
-  return __slow_equal(__obj1, __obj2)
-}
-
-#define __equal(obj1, obj2) ((obj1) == (obj2) ? 1 : __slow_equal(obj1, obj2))
-
 function __pack(__stk, __item)
 {
   return length(__item) ":" __item __stk
diff --git a/runtests b/runtests
index f7f8991..6bb4c68 100755
--- a/runtests
+++ b/runtests
@@ -1,13 +1,28 @@
 #!/bin/sh
 trap 'rm -f output script.sh' EXIT INT TERM
 
-cppawk=./cppawk ./testsuite.awk testcases
-cppawk="./cppawk --nobash" ./testsuite.awk testcases
+suite=$1
 
-cppawk=./cppawk ./testsuite.awk testcases-case
-cppawk="./cppawk --awk=mawk" ./testsuite.awk testcases-case
+if [ -z "$suite" ] ; then
+  cppawk=./cppawk ./testsuite.awk testcases
+  cppawk="./cppawk --nobash" ./testsuite.awk testcases
+fi
 
-cppawk=./cppawk ./testsuite.awk testcases-narg
+if [ -z "$suite" -o "$suite" = "case" ] ; then
+  cppawk=./cppawk ./testsuite.awk testcases-case
+  cppawk="./cppawk --awk=mawk" ./testsuite.awk testcases-case
+fi
 
-cppawk=./cppawk ./testsuite.awk testcases-iter
-cppawk="./cppawk --awk=mawk" ./testsuite.awk testcases-iter
+if [ -z "$suite" -o "$suite" = "narg" ] ; then
+  cppawk=./cppawk ./testsuite.awk testcases-narg
+fi
+
+if [ -z "$suite" -o "$suite" = "iter" ] ; then
+  cppawk=./cppawk ./testsuite.awk testcases-iter
+  cppawk="./cppawk --awk=mawk" ./testsuite.awk testcases-iter
+fi
+
+if [ -z "$suite" -o "$suite" = "cons" ] ; then
+  cppawk=./cppawk ./testsuite.awk testcases-cons
+  cppawk="./cppawk --awk=mawk" ./testsuite.awk testcases-cons
+fi
diff --git a/testcases-cons b/testcases-cons
new file mode 100644
index 0000000..b4352ae
--- /dev/null
+++ b/testcases-cons
@@ -0,0 +1,336 @@
+1:
+$cppawk '
+#include <cons.h>
+function f()
+{
+  return ++count
+}
+
+BEGIN {
+  print prog(f(), f(), f(), f())
+  print progn(f(), f(), f(), f())
+  print prog(f())
+  print progn(f())
+  print count
+}'
+:
+1
+8
+1
+10
+10
+--
+2:
+$cppawk '
+#include <cons.h>
+function f()
+{
+  return ++count
+}
+
+BEGIN {
+  print and(f(), f(), f(), f())
+  print count
+  print and(f())
+  print count
+  print and(0, f())
+  print count
+  print and("", f())
+  print count
+  print and(1, f(), "abc")
+  print count
+  print and(0)
+  print and(3)
+}'
+:
+4
+4
+5
+5
+0
+5
+
+5
+abc
+6
+0
+3
+--
+3:
+$cppawk '
+#include <cons.h>
+function f()
+{
+  count++
+  return 0
+}
+
+BEGIN {
+  print or(f(), f(), f(), f())
+  print count
+  print or(f())
+  print count
+  print or(1, f())
+  print count
+  print or(0, "", "abc", f())
+  print count
+  print or("")
+  print or(0)
+}'
+:
+0
+4
+0
+5
+1
+5
+abc
+5
+
+0
+--
+4:
+$cppawk '
+#include <cons.h>
+BEGIN {
+  print nil == ""
+  print nil == 0
+}'
+:
+1
+0
+--
+5:
+$cppawk '
+#include <cons.h>
+BEGIN {
+  print consp(nil), consp("abc"), consp(cons(1, 2)), consp(3)
+  print consp(undef), consp(box_sym("x")), consp(box(undef)), consp(box("abc"))
+  print atom(nil), atom("abc"), atom(cons(1, 2)), atom(3)
+  print atom(undef), atom(box_sym("x")), atom(box(undef)), atom(box("abc"))
+  print null(nil), null("abc"), null(cons(1, 2)), null(3)
+  print null(undef), null(box_sym("x")), null(box(undef)), null(box("abc"))
+}'
+:
+0 0 1 0
+0 0 0 0
+1 1 0 1
+1 1 1 1
+1 0 0 0
+0 0 0 0
+--
+6:
+$cppawk '
+#include <cons.h>
+BEGIN { endp(3) }'
+:
+ERR
+--
+7:
+$cppawk '
+#include <cons.h>
+BEGIN { endp(undef) }'
+:
+ERR
+--
+8:
+$cppawk '
+#include <cons.h>
+BEGIN { print endp(nil), endp(cons(1, 2)) }'
+:
+1 0
+--
+9:
+$cppawk '
+#include <cons.h>
+BEGIN {
+  print numberp(undef), numberp(nil), numberp("abc"), numberp(0)
+  print numberp("123x"), numberp(cons(1, 2)), numberp(box_sym("1abc"))
+}'
+:
+0 0 0 1
+1 0 0
+--
+10:
+$cppawk '
+#include <cons.h>
+BEGIN {
+  print stringp(undef), stringp(nil), stringp("abc"), stringp(0)
+  print stringp(cons(1, 2)), stringp(box("abc")), stringp(box("1"))
+}'
+:
+0 0 0 0
+0 1 0
+--
+11:
+$cppawk '
+#include <cons.h>
+BEGIN {
+  print symbolp(undef), symbolp(nil), symbolp("abc"), symbolp(0)
+  print symbolp(cons(1, 2)), symbolp(box("abc")), symbolp(box_sym("1"))
+}'
+:
+0 1 0 0
+0 0 1
+--
+12:
+$cppawk '
+#include <cons.h>
+BEGIN {
+  print box(1), box("1a"), box(0), box(-1.34)
+  print box(undef), box(""), box("abc")
+}'
+:
+1 1a 0 -1.34
+U T Tabc
+--
+13:
+for expr in undef 'cons(1, 1)' '""' 0; do
+  $cppawk "#include <cons.h>
+           BEGIN { print unbox($expr) }" || echo fail
+done
+:
+unbox: missing or undefined argument
+fail
+unbox: C1,1:11 looks like a cons
+fail
+nil
+0
+--
+14:
+$cppawk '
+#include <cons.h>
+BEGIN {
+  print unbox(box(1)), unbox(box("1a")), unbox(box(0)), unbox(box(-1.34))
+  print "X" unbox(box("")) "Y", unbox(box("abc"))
+  print unbox(nil), unbox("Sabc")
+}'
+:
+1 1a 0 -1.34
+XY abc
+nil abc
+--
+15:
+$cppawk '
+#include <cons.h>
+BEGIN {
+  print box_sym(undef), box_sym(1), box_sym("1a"), box_sym(0), box_sym(-1.34)
+  print "A" box_sym("nil") "B", box_sym("abc"), box_sym("()")
+}'
+:
+S S1 S1a S0 S-1.34
+AB Sabc S()
+--
+16:
+$cppawk '
+#include <cons.h>
+BEGIN {
+  print cons(undef, undef), cons(box(undef), box(undef)), cons(nil, nil), cons(1, 2)
+  print cons("()xz$3%", "5#d_@")
+}'
+:
+C0,0: C1,1:UU C0,0: C1,1:12
+C7,5:()xz$3%5#d_@
+--
+17:
+$cppawk '
+#include <cons.h>
+BEGIN {
+  c = cons("()xz$3%", "5#d_@")
+  print car(c), cdr(c)
+}'
+:
+()xz$3% 5#d_@
+--
+18:
+for expr in 'box_sym("abc")' 'box("abc")' '1' '0' \
+             'undef' '"C"' '"C1"' '"C1,2"' '"C1,1:"'
+do
+  $cppawk "#include <cons.h>
+           BEGIN { print car($expr) }" || echo fail
+done
+:
+car: Sabc isn't a cons
+fail
+car: Tabc isn't a cons
+fail
+car: 1 isn't a cons
+fail
+car: 0 isn't a cons
+fail
+car:  isn't a cons
+fail
+car: C has a malformed cons header
+fail
+car: C1 has a malformed cons header
+fail
+car: C1,2 has a malformed cons header
+fail
+
+--
+19:
+for expr in 'box_sym("abc")' 'box("abc")' '1' '0' \
+             'undef' '"C"' '"C1"' '"C1,2"' '"C1,1:"'
+do
+  $cppawk "#include <cons.h>
+           BEGIN { print cdr($expr) }" || echo fail
+done
+:
+cdr: Sabc isn't a cons
+fail
+cdr: Tabc isn't a cons
+fail
+cdr: 1 isn't a cons
+fail
+cdr: 0 isn't a cons
+fail
+cdr:  isn't a cons
+fail
+cdr: C has a malformed cons header
+fail
+cdr: C1 has a malformed cons header
+fail
+cdr: C1,2 has a malformed cons header
+fail
+
+--
+20:
+$cppawk '
+#include <cons.h>
+
+#define a(x) car(cons(x, nil))
+#define d(x) cdr(cons(nil, x))
+
+BEGIN {
+  print "A" a(undef) "B", "A" a("") "B", a(0), a(1), a(cons(1, 2)), a(box("a"))
+  print "A" d(undef) "B", "A" d("") "B", d(0), d(1), d(cons(1, 2)), d(box("a"))
+}'
+:
+AB AB 0 1 C1,1:12 Ta
+AB AB 0 1 C1,1:12 Ta
+--
+21:
+$cppawk '
+#include <cons.h>
+
+BEGIN {
+  print sexp(undef)
+}
+:
+ERR
+--
+22:
+$cppawk '
+#include <cons.h>
+
+BEGIN {
+  print sexp(nil), sexp(0), sexp(1), sexp(-1.3), sexp("abc"), sexp("a\"bc")
+  print sexp("Sabc"), sexp("Tabc"), sexp("U")
+  print sexp(cons(1, 2)), sexp(cons(1, nil)), sexp(cons(1, cons(2, 3)))
+  print sexp(cons(cons(1, nil), cons(cons(2 , 3), cons(4, cons(5 , nil)))))
+}'
+:
+nil 0 1 -1.3 "abc" "a\"bc"
+abc "abc" #U
+(1 . 2) (1) (1 2 . 3)
+((1) (2 . 3) 4 5)