Added test18 on cyclic equality

runtime/runtime.c

@@ -194,9 +194,9 @@ extern int LcompareTags (void *p, void *q) {
   if (TAG(pd->tag) == SEXP_TAG && TAG(qd->tag) == SEXP_TAG) {
     return
     #ifndef DEBUG_PRINT
-      (TO_SEXP(p)->tag) - (TO_SEXP(q)->tag);
+      BOX((TO_SEXP(p)->tag) - (TO_SEXP(q)->tag));
     #else
-      (GET_SEXP_TAG(TO_SEXP(p)->tag)) - (GET_SEXP_TAG(TO_SEXP(p)->tag));
+      BOX((GET_SEXP_TAG(TO_SEXP(p)->tag)) - (GET_SEXP_TAG(TO_SEXP(p)->tag)));
     #endif      
   }
   else failure ("not a sexpr in compareTags: %d, %d\n", TAG(pd->tag), TAG(qd->tag));    

stdlib/regression/orig/test18.log

@@ -0,0 +1,32 @@
+1 =?= 1 = 0
+symmetricity: ok
+1 =?= 10 = -1
+symmetricity: ok
+"abc" =?= "abc" = 0
+symmetricity: ok
+"abc" =?= "def" = -1
+symmetricity: ok
+1 =?= "abc" = 1
+symmetricity: ok
+S (1) =?= S (1) = 0
+symmetricity: ok
+S (2) =?= S (1) = 1
+symmetricity: ok
+S (1, 2, 3) =?= S (1, 3, 2) = -1
+symmetricity: ok
+S (1, 2, 3) =?= D (5, 6) = 1
+symmetricity: ok
+1 =?= S (5) = 1
+symmetricity: ok
+"abs" =?= S (5, 6) = -1
+symmetricity: ok
+[1, 2, 3] =?= S (1, 2, 3) = -1
+symmetricity: ok
+"abc" =?= [1, 2, 3] = -1
+symmetricity: ok
+1 =?= [1, 2, 3] = 1
+symmetricity: ok
+0
+0
+0
+0

stdlib/regression/test18.lama

@@ -0,0 +1,65 @@
+import Data;
+
+fun normalize (x) {
+  if  x == 0 then 0
+  elif x < 0 then -1
+  else 1
+  fi
+}
+
+fun not (x) {
+  0 - x
+}
+
+fun test (a, b) {
+  local f = normalize (a =?= b);
+
+  printf ("%s =?= %s = %d\n", a.string, b.string, f);
+  printf ("symmetricity: %s\n", if normalize (b =?= a) == not (f) then "ok" else "fail" fi)
+}
+
+test (1, 1);
+test (1, 10);
+
+test ("abc", "abc");
+test ("abc", "def");
+
+test (1, "abc");
+
+test (S (1), S (1));
+test (S (2), S (1));
+test (S (1, 2, 3), S (1, 3, 2));
+test (S (1, 2, 3), D (5, 6));
+
+test (1, S (5));
+test ("abs", S (5, 6));
+test ([1, 2, 3], S (1, 2, 3));
+test ("abc", [1, 2, 3]);
+test (1, [1, 2, 3]);
+
+{
+ local a = [1], b = [1];
+
+ a [0] := a;
+ b [0] := b;
+
+ printf ("%d\n", a =?= b);
+
+ a[0] := b;
+ b[0] := a;
+
+ printf ("%d\n", a =?= b);
+
+ a := S (1);
+ b := S (1);
+
+ a[0] := a;
+ b[0] := b;
+
+ printf ("%d\n", a =?= b);
+
+ a[0] := b;
+ b[0] := a;
+
+ printf ("%d\n", a =?= b)
+}