From 40c1dee7647ddb7d4768a2eadf9915ab29e62f59 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku 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. --- tests/016/arith.tl | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) (limited to 'tests/016/arith.tl') 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) -- cgit v1.2.3