1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

fix `hash' for inf and nan

* libguile/hash.c (scm_hasher): Fix to work on inf and nan.
* test-suite/tests/hash.test ("hash"): Add tests.
This commit is contained in:
Andy Wingo 2011-05-08 16:05:27 +02:00
parent 2252321bb7
commit 10483f9e64
2 changed files with 7 additions and 3 deletions

View file

@ -26,6 +26,7 @@
#include <wchar.h> #include <wchar.h>
#endif #endif
#include <math.h>
#include <unistr.h> #include <unistr.h>
#include "libguile/_scm.h" #include "libguile/_scm.h"
@ -192,7 +193,7 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
case scm_tc16_real: case scm_tc16_real:
{ {
double r = SCM_REAL_VALUE (obj); double r = SCM_REAL_VALUE (obj);
if (floor (r) == r) if (floor (r) == r && !isinf (r) && !isnan (r))
{ {
obj = scm_inexact_to_exact (obj); obj = scm_inexact_to_exact (obj);
return scm_to_ulong (scm_modulo (obj, scm_from_ulong (n))); return scm_to_ulong (scm_modulo (obj, scm_from_ulong (n)));

View file

@ -1,6 +1,6 @@
;;;; hash.test --- test guile hashing -*- scheme -*- ;;;; hash.test --- test guile hashing -*- scheme -*-
;;;; ;;;;
;;;; Copyright (C) 2004, 2005, 2006, 2008 Free Software Foundation, Inc. ;;;; Copyright (C) 2004, 2005, 2006, 2008, 2011 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -32,7 +32,10 @@
(hash #t 0)) (hash #t 0))
(pass-if (= 0 (hash #t 1))) (pass-if (= 0 (hash #t 1)))
(pass-if (= 0 (hash #f 1))) (pass-if (= 0 (hash #f 1)))
(pass-if (= 0 (hash noop 1)))) (pass-if (= 0 (hash noop 1)))
(pass-if (= 0 (hash +inf.0 1)))
(pass-if (= 0 (hash -inf.0 1)))
(pass-if (= 0 (hash +nan.0 1))))
;;; ;;;
;;; hashv ;;; hashv