mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Add test for 'string-ref' with a negative index at -O2.

Browse source 
This test would segfault prior to
c0004442b7.

See <https://bugs.gnu.org/60488>.

* test-suite/tests/strings.test ("string-ref"): Use 'with-test-prefix/c&e'.
["negative index"]: Check the reported bounds.
This commit is contained in:
Ludovic Courtès 2023-01-17 10:32:47 +01:00
parent e903b76795
commit cd9fc16ba0
1 changed files with 14 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

19
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-2006,2008-2011,2013,2015,2018,2020 ;;;; Copyright (C) 1999,2001,2004-2006,2008-2011,2013,2015,2018,2020,2023
;;;; Free Software Foundation, Inc. ;;;; 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
@ -504,7 +504,7 @@
;; string-ref ;; string-ref
;; ;;
(with-test-prefix "string-ref" (with-test-prefix/c&e "string-ref"
(pass-if-exception "empty string" (pass-if-exception "empty string"
exception:out-of-range exception:out-of-range
@ -518,9 +518,18 @@
exception:out-of-range exception:out-of-range
(string-ref "hello" 123)) (string-ref "hello" 123))
(pass-if-exception "negative index" (pass-if-equal "negative index" ;<https://bugs.gnu.org/60488>
exception:out-of-range '(0 upper -1)
(string-ref "hello" -1)) (catch 'out-of-range
(lambda ()
(string-ref "hello" -1))
(lambda args
(let ((bounds+index (list-ref args 3)))
;; At -O2, the out-of-range error is raised when converting
;; "-1" to uint64, so the upper bound that's reported is
;; UINT64_MAX.
(list (list-ref bounds+index 0) 'upper
(list-ref bounds+index 2))))))
(pass-if "regular string, ASCII char" (pass-if "regular string, ASCII char"
(char=? (string-ref "GNU Guile" 4) #\G)) (char=? (string-ref "GNU Guile" 4) #\G))