Strings, i18n: Limit the use of alloca to approximately 8 kilobytes.

* libguile/i18n.c (SCM_MAX_ALLOCA): New macro.
(SCM_STRING_TO_U32_BUF): Accept an additional variable to remember
whether we used malloc to allocate the buffer.  Use malloc if the
allocation size is greater than SCM_MAX_ALLOCA.
(SCM_CLEANUP_U32_BUF): New macro.
(compare_u32_strings, compare_u32_strings_ci, str_to_case): Adapt.
* libguile/strings.c (SCM_MAX_ALLOCA): New macro.
(normalize_str, unistring_escapes_to_r6rs_escapes): Use malloc if the
allocation size is greater than SCM_MAX_ALLOCA.
* test-suite/tests/i18n.test, test-suite/tests/strings.test: Add tests.

2 files changed, 28 insertions, 1 deletions

diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test
index 811be7b10..427aef4f5 100644
--- a/test-suite/tests/i18n.test
+++ b/test-suite/tests/i18n.test
@@ -78,7 +78,13 @@
   (pass-if "string-locale-ci<?"
     (and (string-locale-ci<? "hello" "WORLD")
          (string-locale-ci<? "hello" "WORLD"
-                             (make-locale (list LC_COLLATE) "C")))))
+                             (make-locale (list LC_COLLATE) "C"))))
+  (pass-if "large strings"
+    ;; In Guile <= 2.2.4, these would overflow the C stack and crash.
+    (let ((large (make-string 4000000 #\a)))
+      (and (string-locale-ci=? large large)
+           (not (string-locale-ci<? large large))
+           (not (string-locale<? large large))))))
 
 
 (define mingw?
@@ -333,6 +339,15 @@
 	 (string=? "Hello, World" (string-locale-titlecase 
 				   "hello, world" (make-locale LC_ALL "C")))))
 
+  (pass-if "large strings"
+    ;; In Guile <= 2.2.4, these would overflow the C stack and crash.
+    (let ((hellos (string-join (make-list 700000 "hello")))
+          (HELLOs (string-join (make-list 700000 "HELLO")))
+          (Hellos (string-join (make-list 700000 "Hello"))))
+      (and (string=? hellos (string-locale-downcase Hellos))
+           (string=? HELLOs (string-locale-upcase   Hellos))
+           (string=? Hellos (string-locale-titlecase hellos)))))
+
   (pass-if "string-locale-upcase German"
     (under-german-utf8-locale-or-unresolved
      (lambda ()
diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test
index b404253ce..3258feb61 100644
--- a/test-suite/tests/strings.test
+++ b/test-suite/tests/strings.test
@@ -476,6 +476,18 @@
     (equal? (string-normalize-nfkc "\u1e9b\u0323") "\u1e69")))
 
 ;;
+;; normalizing large strings
+;;
+
+(pass-if "string-normalize-{nfd,nfc,nfkd,nfkc} on large strings"
+  ;; In Guile <= 2.2.4, these would overflow the C stack and crash.
+  (let ((large (make-string 4000000 #\a)))
+    (and (string=? large (string-normalize-nfd large))
+         (string=? large (string-normalize-nfc large))
+         (string=? large (string-normalize-nfkd large))
+         (string=? large (string-normalize-nfkc large)))))
+
+;;
 ;; string-utf8-length
 ;;