diff --git a/runtime/runtime.c b/runtime/runtime.c index 20e243100..2bfbff6d4 100644 --- a/runtime/runtime.c +++ b/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)); diff --git a/stdlib/regression/orig/test18.log b/stdlib/regression/orig/test18.log new file mode 100644 index 000000000..8d01ee80a --- /dev/null +++ b/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 diff --git a/stdlib/regression/test18.lama b/stdlib/regression/test18.lama new file mode 100644 index 000000000..4427405a2 --- /dev/null +++ b/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) +} \ No newline at end of file