[Guile-commits] 01/12: Add test for 'string-ref' with a negative index at -O2.

[Ludovic Courtès]

civodul pushed a commit to branch main
in repository guile.

commit cd9fc16ba001b783c90d4f037fb1699cd954537f
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue Jan 17 10:32:47 2023 +0100

    Add test for 'string-ref' with a negative index at -O2.
    
    This test would segfault prior to
    c0004442b7691f59a0e37869ef288eb26382ad9e.
    
    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.
---
 test-suite/tests/strings.test | 19 ++++++++++++++-----
 1 file changed, 14 insertions(+), 5 deletions(-)

diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test
index 7393bc8ec..c6df15844 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-2006,2008-2011,2013,2015,2018,2020
+;;;; Copyright (C) 1999,2001,2004-2006,2008-2011,2013,2015,2018,2020,2023
 ;;;;   Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -504,7 +504,7 @@
 ;; string-ref
 ;;
 
-(with-test-prefix "string-ref"
+(with-test-prefix/c&e "string-ref"
 
   (pass-if-exception "empty string"
     exception:out-of-range
@@ -518,9 +518,18 @@
     exception:out-of-range
     (string-ref "hello" 123))
 
-  (pass-if-exception "negative index"
-    exception:out-of-range
-    (string-ref "hello" -1))
+  (pass-if-equal "negative index"          ;<https://bugs.gnu.org/60488>
+      '(0 upper -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"
     (char=? (string-ref "GNU Guile" 4) #\G))