Re: string-set! examples in r5rs.html

[Ludovic Courtès]

Hi,

"Bill Schottstaedt" <address@hidden> writes:

> according to r5rs.html, these should signal an error, I believe:
>
> guile> (string-set! (symbol->string 'immutable)
>              0
>              #\?)
> guile> (define (g) "***")
> guile> (string-set! (g) 0 #\?)
> guile> (g)
> "?**"

The attached patches against 1.8.x fix this.

Neil: OK to apply?

If yes, I would eventually take this opportunity to make
`make-read-only-string' public.

Thanks,
Ludo'.

>From ee5cc17a4887ede871c256a222f097c256353971 Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <address@hidden>
Date: Mon, 22 Sep 2008 22:51:36 +0200
Subject: [PATCH] Make `symbol->string' return a read-only string.

* libguile/strings.c (scm_i_symbol_substring): Return a read-only string
  since R5RS requires `symbol->string' to return a read-only string.
  Reported by Bill Schottstaedt <address@hidden>.

* test-suite/tests/symbols.test: Add `define-module' clause.
  (exception:immutable-string): Adjust to current exception.
  ("symbol->string")["result is an immutable string"]: Use
  `pass-if-exception' instead of `expect-fail-exception'.

* NEWS: Update.
---
 NEWS                          |    1 +
 libguile/strings.c            |    2 +-
 test-suite/tests/symbols.test |   12 ++++++------
 3 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/NEWS b/NEWS
index f4ca739..9f6e0ed 100644
--- a/NEWS
+++ b/NEWS
@@ -26,6 +26,7 @@ available: Guile is now always configured in "maintainer 
mode".
 
 * Bugs fixed
 
+** `symbol->string' now returns a read-only string, as per R5RS
 ** `guile-config link' now prints `-L$libdir' before `-lguile'
 ** Fix memory corruption involving GOOPS' `class-redefinition'
 ** Fix possible deadlock in `mutex-lock'
diff --git a/libguile/strings.c b/libguile/strings.c
index 4d387fb..b0b9506 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -491,7 +491,7 @@ scm_i_symbol_substring (SCM sym, size_t start, size_t end)
   scm_i_pthread_mutex_lock (&stringbuf_write_mutex);
   SET_STRINGBUF_SHARED (buf);
   scm_i_pthread_mutex_unlock (&stringbuf_write_mutex);
-  return scm_double_cell (STRING_TAG, SCM_UNPACK(buf),
+  return scm_double_cell (RO_STRING_TAG, SCM_UNPACK(buf),
                          (scm_t_bits)start, (scm_t_bits) end - start);
 }
 
diff --git a/test-suite/tests/symbols.test b/test-suite/tests/symbols.test
index b57667f..3fe3402 100644
--- a/test-suite/tests/symbols.test
+++ b/test-suite/tests/symbols.test
@@ -1,6 +1,6 @@
 ;;;; symbols.test --- test suite for Guile's symbols    -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006, 2008 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -17,17 +17,17 @@
 ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 ;;;; Boston, MA 02110-1301 USA
 
-(use-modules (ice-9 documentation))
+(define-module (test-suite test-symbols)
+  #:use-module (test-suite lib)
+  #:use-module (ice-9 documentation))
 
 
 ;;;
 ;;; miscellaneous
 ;;;
 
-;; FIXME:  As soon as guile supports immutable strings, this has to be
-;; replaced with the appropriate error type and message.
 (define exception:immutable-string
-  (cons 'some-error-type "^trying to modify an immutable string"))
+  (cons 'misc-error "^string is read-only"))
 
 (define (documented? object)
   (not (not (object-documentation object))))
@@ -55,7 +55,7 @@
 
 (with-test-prefix "symbol->string"
 
-  (expect-fail-exception "result is an immutable string"
+  (pass-if-exception "result is an immutable string"
     exception:immutable-string
     (string-set! (symbol->string 'abc) 1 #\space)))
 
-- 
1.6.0

>From 3edbf7465422b976dc26f64d9646e7e371a7b971 Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <address@hidden>
Date: Mon, 22 Sep 2008 23:03:20 +0200
Subject: [PATCH] Make literal strings (i.e., returned by `read') read-only.

* libguile/read.c (scm_read_string): Use `scm_i_make_read_only_string ()' to
  return a read-only string, as mandated by R5RS.  Reported by Bill
  Schottstaedt <address@hidden>.

* libguile/strings.c (scm_i_make_read_only_string): New function.

* libguile/strings.h (scm_i_make_read_only_string): New declaration.

* test-suite/tests/strings.test ("string-set!")["literal string"]: New test.

* NEWS: Update.
---
 NEWS                          |    1 +
 libguile/read.c               |    2 +-
 libguile/strings.c            |   11 +++++++++++
 libguile/strings.h            |    3 ++-
 test-suite/tests/strings.test |    8 ++++++--
 5 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/NEWS b/NEWS
index 9f6e0ed..da88315 100644
--- a/NEWS
+++ b/NEWS
@@ -27,6 +27,7 @@ available: Guile is now always configured in "maintainer 
mode".
 * Bugs fixed
 
 ** `symbol->string' now returns a read-only string, as per R5RS
+** `read' now returns read-only strings, as per R5RS
 ** `guile-config link' now prints `-L$libdir' before `-lguile'
 ** Fix memory corruption involving GOOPS' `class-redefinition'
 ** Fix possible deadlock in `mutex-lock'
diff --git a/libguile/read.c b/libguile/read.c
index ff50735..9600ecc 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -514,7 +514,7 @@ scm_read_string (int chr, SCM port)
   else
     str = (str == SCM_BOOL_F) ? scm_nullstr : str;
 
-  return str;
+  return scm_i_make_read_only_string (str);
 }
 #undef FUNC_NAME
 
diff --git a/libguile/strings.c b/libguile/strings.c
index b0b9506..220aac2 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -218,6 +218,17 @@ get_str_buf_start (SCM *str, SCM *buf, size_t *start)
 }
 
 SCM
+scm_i_make_read_only_string (SCM str)
+{
+  if (SCM_UNLIKELY (STRING_LENGTH (str)) == 0)
+    /* We want the empty string to be `eq?' with the read-only empty
+       string.  */
+    return str;
+
+  return scm_i_substring_read_only (str, 0, STRING_LENGTH (str));
+}
+
+SCM
 scm_i_substring (SCM str, size_t start, size_t end)
 {
   SCM buf;
diff --git a/libguile/strings.h b/libguile/strings.h
index dcc1f11..c895708 100644
--- a/libguile/strings.h
+++ b/libguile/strings.h
@@ -3,7 +3,7 @@
 #ifndef SCM_STRINGS_H
 #define SCM_STRINGS_H
 
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2004, 2005, 2006 Free Software 
Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2004, 2005, 2006, 2008 Free 
Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -82,6 +82,7 @@ SCM_API SCM scm_make_string (SCM k, SCM chr);
 SCM_API SCM scm_string_length (SCM str);
 SCM_API SCM scm_string_ref (SCM str, SCM k);
 SCM_API SCM scm_string_set_x (SCM str, SCM k, SCM chr);
+SCM_API SCM scm_i_make_read_only_string (SCM str);
 SCM_API SCM scm_substring (SCM str, SCM start, SCM end);
 SCM_API SCM scm_substring_read_only (SCM str, SCM start, SCM end);
 SCM_API SCM scm_substring_shared (SCM str, SCM start, SCM end);
diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test
index aa9196e..735258a 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 <address@hidden> --- August 1999
 ;;;;
-;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008 Free Software 
Foundation, Inc.
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -168,7 +168,11 @@
 
   (pass-if-exception "read-only string"
     exception:read-only-string
-    (string-set! (substring/read-only "abc" 0) 1 #\space)))
+    (string-set! (substring/read-only "abc" 0) 1 #\space))
+
+  (pass-if-exception "literal string"
+    exception:read-only-string
+    (string-set! "an immutable string" 0 #\a)))
 
 (with-test-prefix "string-split"
 
-- 
1.6.0