diff options
author | Mark H Weaver <mhw@netris.org> | 2019-05-06 21:11:26 -0400 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2019-05-23 17:51:36 +0200 |
commit | bd50407d1f9adc3eedd6687c9a84aa7a503b7ce1 (patch) | |
tree | f192426504933a93f0fca52afebd1e8ea67244fe /test-suite/tests/i18n.test | |
parent | 2bfa4f73f188e4ad2bde22594d5173e71c1d3d2f (diff) | |
download | guile-bd50407d1f9adc3eedd6687c9a84aa7a503b7ce1.tar.gz |
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.
Diffstat (limited to 'test-suite/tests/i18n.test')
-rw-r--r-- | test-suite/tests/i18n.test | 17 |
1 files changed, 16 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 () |