core: Fixes for int-max, int-min.

* src/math.c (greater_p): Fix INT_MAX > 0.
  (less_p): Fix INT_MIN < 0.
* tests/math.test ("< INT-MIN"): Test it.
  ("< INT-MAX"):
  ("> INT-MAX"):
  ("> INT-MAX 0"):
  ("> INT-MIN"):
* tests/srfi-13.test ("string->number INT-MAX"): Test it.
  ("string->number INT-MIN"):
  ("number->string INT-MAX"):
  ("number->string INT-MIN"):
* scaffold/tests/60-math.c (test): Test it.
This commit is contained in:
Jan Nieuwenhuizen 2018-05-02 23:11:27 +02:00
parent f8eaebf713
commit 99718a8b7a
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
4 changed files with 86 additions and 39 deletions

View file

@ -18,6 +18,7 @@
* along with Mes. If not, see <http://www.gnu.org/licenses/>. * along with Mes. If not, see <http://www.gnu.org/licenses/>.
*/ */
#include <limits.h>
#include <stdio.h> #include <stdio.h>
#include <string.h> #include <string.h>
@ -146,5 +147,30 @@ test ()
puts ("t: 0x11 == 3\n"); puts ("t: 0x11 == 3\n");
if (0x11 != 17) return 32; if (0x11 != 17) return 32;
puts ("t: i = INT_MAX\n");
i = INT_MAX;
if (strcmp ("2147483647", itoa (i)))
return 33;
puts ("t: i = 2147483646\n");
i = 2147483646;
puts ("t: i++\n");
i++;
puts ("t: i = INT_MIN\n");
i = INT_MIN;
if (strcmp ("-2147483648", itoa (i)))
return 34;
puts ("t: i = -2147483647\n");
i = -2147483647;
puts ("t: i--\n");
i--;
return 0; return 0;
} }

View file

@ -33,7 +33,11 @@ assert_number (char const* name, SCM x)
SCM SCM
greater_p (SCM x) ///((name . ">") (arity . n)) greater_p (SCM x) ///((name . ">") (arity . n))
{ {
int n = INT_MAX; if (x == cell_nil)
return cell_t;
assert_number ("greater_p", CAR (x));
int n = VALUE (CAR (x));
x = CDR (x);
while (x != cell_nil) while (x != cell_nil)
{ {
assert_number ("greater_p", CAR (x)); assert_number ("greater_p", CAR (x));
@ -48,7 +52,11 @@ greater_p (SCM x) ///((name . ">") (arity . n))
SCM SCM
less_p (SCM x) ///((name . "<") (arity . n)) less_p (SCM x) ///((name . "<") (arity . n))
{ {
int n = INT_MIN; if (x == cell_nil)
return cell_t;
assert_number ("less_p", CAR (x));
int n = VALUE (CAR (x));
x = CDR (x);
while (x != cell_nil) while (x != cell_nil)
{ {
assert_number ("less_p", CAR (x)); assert_number ("less_p", CAR (x));
@ -81,8 +89,7 @@ SCM
minus (SCM x) ///((name . "-") (arity . n)) minus (SCM x) ///((name . "-") (arity . n))
{ {
assert_number ("minus", CAR (x)); assert_number ("minus", CAR (x));
SCM a = CAR (x); int n = VALUE (CAR (x));
int n = VALUE (a);
x = cdr (x); x = cdr (x);
if (x == cell_nil) if (x == cell_nil)
n = -n; n = -n;

View file

@ -29,54 +29,60 @@ exit $?
(mes-use-module (srfi srfi-0)) (mes-use-module (srfi srfi-0))
(mes-use-module (mes test)) (mes-use-module (mes test))
(pass-if "+" (seq? (+ 1 2 3) 6)) (pass-if-equal "+" 6 (+ 1 2 3))
(pass-if "*" (seq? (* 3 3 3) 27)) (pass-if-equal "*" 27 (* 3 3 3))
(pass-if "/" (seq? (/ 9 3) 3)) (pass-if-equal "/" 3 (/ 9 3))
(pass-if "remainder" (seq? (remainder 11 3) 2)) (pass-if-equal "remainder" 2 (remainder 11 3))
(pass-if "modulo" (seq? (modulo 11 3) 2)) (pass-if-equal "modulo" 2 (modulo 11 3))
(pass-if "expt" (seq? (expt 2 3) 8)) (pass-if-equal "expt" 8 (expt 2 3))
(pass-if "logior" (seq? (logior 0 1 2 4) 7)) (pass-if-equal "logior" 7 (logior 0 1 2 4))
(pass-if-equal "ash" (pass-if-equal "ash"
8 (ash 1 3)) 8 (ash 1 3))
(pass-if-equal "ash -1" (pass-if-equal "ash -1"
5 (ash 10 -1)) 5 (ash 10 -1))
(pass-if "=" (seq? 3 '3)) (pass-if-equal "=" 3 '3)
(pass-if "= 2" (not (= 3 '4))) (pass-if "= 2" (not (= 3 '4)))
(pass-if "=" (seq? (=) #t)) (pass-if "=" (=))
(pass-if "= 1" (seq? (= 0) #t)) (pass-if "= 1" (= 0))
(pass-if "= 2" (seq? (= 0 0) #t)) (pass-if "= 2" (= 0 0))
(pass-if "= 3" (seq? (= 0 0) #t)) (pass-if "= 3" (= 0 0))
(pass-if "= 4" (seq? (= 0 1 0) #f)) (pass-if-not "= 4" (= 0 1 0))
(pass-if "<" (seq? (<) #t)) (pass-if "<" (<))
(pass-if "< 1" (seq? (< 0) #t)) (pass-if "< 1" (< 0))
(pass-if "< 2" (seq? (< 0 1) #t)) (pass-if "< 2" (< 0 1))
(pass-if "< 3" (seq? (< 1 0) #f)) (pass-if-not "< 3" (< 1 0))
(pass-if "< 4" (seq? (< 0 1 2) #t)) (pass-if "< 4" (< 0 1 2))
(pass-if "< 5" (seq? (< 0 2 1) #f)) (pass-if-not "< 5" (< 0 2 1))
(pass-if "< INT-MIN" (< -2147483648))
(pass-if "< INT-MIN" (< -2147483648 0))
(pass-if "< INT-MAX" (< 2147483647))
(pass-if ">" (seq? (>) #t)) (pass-if ">" (>))
(pass-if "> 1" (seq? (> 0) #t)) (pass-if "> 1" (> 0))
(pass-if "> 2" (seq? (> 1 0) #t)) (pass-if "> 2" (> 1 0))
(pass-if "> 3" (seq? (> 0 1) #f)) (pass-if-not "> 3" (> 0 1))
(pass-if "> 4" (seq? (> 2 1 0) #t)) (pass-if "> 4" (> 2 1 0))
(pass-if "> 5" (seq? (> 1 2 0) #f)) (pass-if-not "> 5" (> 1 2 0))
(pass-if "> INT-MAX" (> 2147483647))
(pass-if "> INT-MAX 0" (> 2147483647 0))
(pass-if "> INT-MIN" (> -2147483648))
(pass-if ">=" (seq? (>= 3 2 1) #t)) (pass-if ">=" (>= 3 2 1))
(pass-if ">= 2" (seq? (>= 1 2 3) #f)) (pass-if-not ">= 2" (>= 1 2 3))
(pass-if "<=" (seq? (<= 3 2 1) #f)) (pass-if-not "<=" (<= 3 2 1))
(pass-if "<= 2" (seq? (<= 1 2 3) #t)) (pass-if "<= 2" (<= 1 2 3))
(pass-if "max" (seq? (max 0) 0)) (pass-if-equal "max" 0 (max 0))
(pass-if "max 1" (seq? (max 0 1) 1)) (pass-if-equal "max 1" 1 (max 0 1))
(pass-if "max 2" (seq? (max 1 0 2) 2)) (pass-if-equal "max 2" 2 (max 1 0 2))
(pass-if "min" (seq? (min 0) 0)) (pass-if-equal "min" 0 (min 0))
(pass-if "min 1" (seq? (min 0 1) 0)) (pass-if-equal "min 1" 0 (min 0 1))
(pass-if "min 2" (seq? (min 1 0 2) 0)) (pass-if-equal "min 2" 0 (min 1 0 2))
(pass-if-equal "#x-10" -16 #x-10) (pass-if-equal "#x-10" -16 #x-10)

View file

@ -47,6 +47,14 @@ exit $?
3 3
(string-index "foo:bar" #\:)) (string-index "foo:bar" #\:))
(pass-if-equal "string->number" 42 (string->number "42"))
(pass-if-equal "string->number INT-MAX" 2147483647 (string->number "2147483647"))
(pass-if-equal "string->number INT-MIN" -2147483648 (string->number "-2147483648"))
(pass-if-equal "number->string" "16" (number->string 16))
(pass-if-equal "number->string INT-MAX" "2147483647" (number->string 2147483647))
(pass-if-equal "number->string INT-MIN" "-2147483648" (number->string -2147483648))
(pass-if-equal "number->string" "-4" (number->string -4))
(pass-if-equal "string-fold" (pass-if-equal "string-fold"
"oof" "oof"
(list->string (string-fold cons '() "foo"))) (list->string (string-fold cons '() "foo")))