diff options
author | Ludovic Courtès <ludo@gnu.org> | 2010-07-12 17:31:38 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2010-07-13 00:08:09 +0200 |
commit | 7614c983a56a30f2cda3e014840524ac7030e6d9 (patch) | |
tree | f61385407b7fa382e5898b642473fd95904518b3 | |
parent | 080391439568fa3b27283c266ed4b47fa635620f (diff) | |
download | guile-7614c983a56a30f2cda3e014840524ac7030e6d9.tar.gz |
Fix type-checking in the optimized path of `string=?'.
* libguile/srfi-13.c (scm_string_eq): Properly type-check S1 and S2.
* test-suite/tests/strings.test ("string=?")["1st argument EOF", "2nd
argument EOF"]: New tests exposing the problem.
-rw-r--r-- | libguile/srfi-13.c | 3 | ||||
-rw-r--r-- | test-suite/tests/strings.test | 12 |
2 files changed, 12 insertions, 3 deletions
diff --git a/libguile/srfi-13.c b/libguile/srfi-13.c index eec2961d4..e9bf94e9f 100644 --- a/libguile/srfi-13.c +++ b/libguile/srfi-13.c @@ -1168,7 +1168,8 @@ SCM_DEFINE (scm_string_eq, "string=", 2, 4, 0, "value otherwise.") #define FUNC_NAME s_scm_string_eq { - if (SCM_LIKELY (scm_i_is_narrow_string (s1) == scm_i_is_narrow_string (s2) + if (SCM_LIKELY (scm_is_string (s1) && scm_is_string (s2) && + scm_i_is_narrow_string (s1) == scm_i_is_narrow_string (s2) && SCM_UNBNDP (start1) && SCM_UNBNDP (end1) && SCM_UNBNDP (start2) && SCM_UNBNDP (end2))) { diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test index e04c0260d..fa8e6e1af 100644 --- a/test-suite/tests/strings.test +++ b/test-suite/tests/strings.test @@ -1,7 +1,7 @@ ;;;; strings.test --- test suite for Guile's string functions -*- scheme -*- ;;;; Jim Blandy <jimb@red-bean.com> --- August 1999 ;;;; -;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008, 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008, 2009, 2010 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -279,7 +279,15 @@ (pass-if-exception "2nd argument symbol" exception:wrong-type-arg - (string=? "a" 'b)))) + (string=? "a" 'b)) + + (pass-if-exception "1st argument EOF" + exception:wrong-type-arg + (string=? (with-input-from-string "" read) "b")) + + (pass-if-exception "2nd argument EOF" + exception:wrong-type-arg + (string=? "a" (with-input-from-string "" read))))) ;; ;; string<? |