mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00
Code Activity

Fix type-checking in the optimized path of `string=?'.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2010-07-12 17:31:38 +02:00
parent 0803914395
commit 7614c983a5
2 changed files with 12 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

3
libguile/srfi-13.c
View file

@ -1168,7 +1168,8 @@ SCM_DEFINE (scm_string_eq, "string=", 2, 4, 0,
"value otherwise.") "value otherwise.")
#define FUNC_NAME s_scm_string_eq #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 (start1) && SCM_UNBNDP (end1)
&& SCM_UNBNDP (start2) && SCM_UNBNDP (end2))) && SCM_UNBNDP (start2) && SCM_UNBNDP (end2)))
{ {

12
test-suite/tests/strings.test
View file

@ -1,7 +1,7 @@
;;;; strings.test --- test suite for Guile's string functions -*- scheme -*- ;;;; strings.test --- test suite for Guile's string functions -*- scheme -*-
;;;; Jim Blandy <jimb@red-bean.com> --- August 1999 ;;;; 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 ;;;; 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
@ -279,7 +279,15 @@
(pass-if-exception "2nd argument symbol" (pass-if-exception "2nd argument symbol"
exception:wrong-type-arg 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<? ;; string<?