[Guile-commits] 02/06: Avoid converting the 'mode' argument of 'open-file'.

[Ludovic Courtès]

civodul pushed a commit to branch stable-2.0
in repository guile.

commit 37b1453032488de582175270d1b3a1653ea81457
Author: Ludovic Courtès <address@hidden>
Date:   Sun Jan 11 20:58:34 2015 +0100

    Avoid converting the 'mode' argument of 'open-file'.
    
    * libguile/fports.c (scm_open_file_with_encoding): const-qualify 'md'
      and 'ptr'.  Add call to 'scm_i_try_narrow_string'.  Use
      'scm_i_string_chars' instead of 'scm_to_locale_string' plus '
      scm_dynwind_free'.
    * test-suite/tests/ports.test ("invalid wide mode string",
      "valid wide mode string"): New tests.
---
 libguile/fports.c           |   11 +++++++----
 test-suite/tests/ports.test |   16 +++++++++++++++-
 2 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/libguile/fports.c b/libguile/fports.c
index 29edc51..fdd34da 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,6 +1,6 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
  *   2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013,
- *   2014 Free Software Foundation, Inc.
+ *   2014, 2015 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 License
@@ -342,7 +342,8 @@ scm_open_file_with_encoding (SCM filename, SCM mode,
   SCM port;
   int fdes, flags = 0, binary = 0;
   unsigned int retries;
-  char *file, *md, *ptr;
+  char *file;
+  const char *md, *ptr;
 
   if (SCM_UNLIKELY (!(scm_is_false (encoding) || scm_is_string (encoding))))
     scm_wrong_type_arg_msg (FUNC_NAME, 0, encoding,
@@ -353,8 +354,10 @@ scm_open_file_with_encoding (SCM filename, SCM mode,
   file = scm_to_locale_string (filename);
   scm_dynwind_free (file);
 
-  md = scm_to_locale_string (mode);
-  scm_dynwind_free (md);
+  if (SCM_UNLIKELY (!scm_i_try_narrow_string (mode)))
+    scm_out_of_range (FUNC_NAME, mode);
+
+  md = scm_i_string_chars (mode);
 
   switch (*md)
     {
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 3791876..e41271f 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -2,7 +2,7 @@
 ;;;; Jim Blandy <address@hidden> --- May 1999
 ;;;;
 ;;;;   Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010,
-;;;;      2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+;;;;      2011, 2012, 2013, 2014, 2015 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
@@ -308,6 +308,20 @@
                    (delete-file filename)
                    (string=? line2 test-string)))))
 
+(pass-if-exception "invalid wide mode string"
+    exception:out-of-range
+  (open-file "/dev/null" "λ"))
+
+(pass-if "valid wide mode string"
+  ;; Pass 'open-file' a valid mode string, but as a wide string.
+  (let ((mode "λ"))
+    (string-set! mode 0 #\r)
+    (let ((port (open-file "/dev/null" mode)))
+      (and (input-port? port)
+           (begin
+             (close-port port)
+             #t)))))
+
 (with-test-prefix "keyword arguments for file openers"
   (with-fluids ((%default-port-encoding "UTF-8"))
     (let ((filename (test-file)))