summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-07-12 17:31:38 +0200
committerLudovic Courtès <ludo@gnu.org>2010-07-13 00:08:09 +0200
commit7614c983a56a30f2cda3e014840524ac7030e6d9 (patch)
treef61385407b7fa382e5898b642473fd95904518b3
parent080391439568fa3b27283c266ed4b47fa635620f (diff)
downloadguile-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.c3
-rw-r--r--test-suite/tests/strings.test12
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<?