From 40c1dee7647ddb7d4768a2eadf9915ab29e62f59 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 15 Jun 2021 22:16:34 -0700
Subject: math: forbid dubious inequality comparisons.

The issue, reported by Paul A. Patience, is that
code like (< 1 "abc") is successfully producing a result.
The root cause is that 1 is an iterable object, and so
is treated as a sequence opposite to the "abc" operand.

We should allow only true sequences in this situation.

* arith.c (seq_lt_compat_check): New static function. Checks
that neither of two sequences is SEQ_NOTSEQ or SEQ_HASHLIKE.
(seq_lt, seq_le): Use seq_lt_compat_check to reject dubious
inputs.

* txr.1: Minor wording change in the related documentation,
removing a gratuitous adjective.

* tests/016/arith.tl: Inequality tests.
---
 arith.c            | 14 ++++++++++++++
 tests/016/arith.tl | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 txr.1              |  2 +-
 3 files changed, 71 insertions(+), 1 deletion(-)

diff --git a/arith.c b/arith.c
index 225d6586..941ed681 100644
--- a/arith.c
+++ b/arith.c
@@ -1884,12 +1884,24 @@ val pppred(val num)
   return minus(num, three);
 }
 
+static void seq_lt_compat_check(seq_iter_t *ita, seq_iter_t *itb,
+                                val a, val b, val self)
+{
+  if (ita->inf.kind == SEQ_NOTSEQ || ita->inf.kind == SEQ_HASHLIKE ||
+      itb->inf.kind == SEQ_NOTSEQ || itb->inf.kind == SEQ_HASHLIKE)
+  {
+    uw_throwf(error_s, lit("~a: invalid operands ~s ~s"), self, a, b, nao);
+  }
+}
+
 static val seq_lt(val self, val aseq, val bseq)
 {
   seq_iter_t ita, itb;
   seq_iter_init(self, &ita, aseq);
   seq_iter_init(self, &itb, bseq);
 
+  seq_lt_compat_check(&ita, &itb, aseq, bseq, self);
+
   for (;;) {
     val aelem, belem;
     switch (seq_peek(&ita, &aelem) << 1 | seq_peek(&itb, &belem)) {
@@ -1919,6 +1931,8 @@ static val seq_le(val self, val aseq, val bseq)
   seq_iter_init(self, &ita, aseq);
   seq_iter_init(self, &itb, bseq);
 
+  seq_lt_compat_check(&ita, &itb, aseq, bseq, self);
+
   for (;;) {
     val aelem, belem;
     switch (seq_peek(&ita, &aelem) << 1 | seq_peek(&itb, &belem)) {
diff --git a/tests/016/arith.tl b/tests/016/arith.tl
index 52e8667b..be0d512b 100644
--- a/tests/016/arith.tl
+++ b/tests/016/arith.tl
@@ -166,3 +166,59 @@
   (prod #(1 2 3) (op * 10)) 6000
   (prod 2..8) 5040
   (prod 3..8) 2520)
+
+(mtest
+  (< 1 2) t
+  (< 2 1) nil
+  (< 1.0 2) t
+  (< 2 1.0) nil
+  (< #\c #\d) t
+  (< #\d #\c) nil
+  (< 1.0 1) nil
+  (< #R(0 0) #R(0 0)) nil
+  (< #R(0 0) #R(0 1)) t
+  (< #R(0 0) #R(1 0)) t
+  (< #R(0 0) #R(1 1)) t
+  (< #R(1 0) #R(1 0)) nil
+  (< #R(1 0) #R(1 1)) t
+  (< 1 #R(1 0)) :error
+  (< #R(1 0) 1) :error
+  (< 1.0 #R(1 0)) :error
+  (< #R(1 0) 1.0) :error
+  (< #\c #R(1 0)) :error
+  (< #R(1 0) #\c) :error
+  (< 1 "abc") :error
+  (< "abc" 1) :error
+  (< 1 nil) :error
+  (< nil 1) :error
+  (< 1 '(1 2 3)) :error
+  (< '(1 2 3) 1) :error
+  (< 1 #(1 2 3)) :error
+  (< #(1 2 3) 1) :error)
+
+(mtest
+  (< #\A 66 67.0) t
+  (> 67.0 66 #\A) t
+  (>= #\A 65.0 65) t)
+
+(mtest
+  (< "abc" "abc") nil
+  (<= "abc" "abc") t
+  (< "abc" "abcd") t
+  (< "abc" "abd") t
+  (< #(1 2 3) #(1 2 3)) nil
+  (< #(1 2 3) #(1 2 3.0)) nil
+  (< #(1 2 3) #(1 2 3 4)) t
+  (< #(1 2 3) #(1 2 4)) t
+  (< #(1 2 3) '(1 2 3)) nil
+  (< #(1 2 3) '(1 2 3.0)) nil
+  (< #(1 2 3) '(1 2 3 4)) t
+  (< #(1 2 3) '(1 2 4)) t
+  (< '(1 2 3) '(1 2 3)) nil
+  (< '(1 2 3) '(1 2 3.0)) nil
+  (< '(1 2 3) '(1 2 3 4)) t
+  (< '(1 2 3) '(1 2 4)) t
+  (< '(1 2 3) #(1 2 3)) nil
+  (< '(1 2 3) #(1 2 3.0)) nil
+  (< '(1 2 3) #(1 2 3 4)) t
+  (< '(1 2 3) #(1 2 4)) t)
diff --git a/txr.1 b/txr.1
index 7c7554fb..5a633d4c 100644
--- a/txr.1
+++ b/txr.1
@@ -44843,7 +44843,7 @@ First, if the numbers do not have the same type, then the one
 which has the lower ranking type is converted to the type of
 the other, according to this ranking: character < integer < float.
 For instance if a character and integer are compared, the character
-is converted to integer. Then a straightforward numeric comparison
+is converted to its integer character code. Then a numeric comparison
 is applied.
 
 Three or more arguments may be given, in which case the comparison proceeds
-- 
cgit v1.2.3