mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Merge commit '37b1453032'

Browse source
This commit is contained in:
Andy Wingo 2015-01-22 14:37:52 +01:00
commit baa74d3695
2 changed files with 22 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

11
libguile/fports.c
View file

@ -1,6 +1,6 @@
/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
* 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, * 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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; SCM port;
int fdes, flags = 0, binary = 0; int fdes, flags = 0, binary = 0;
unsigned int retries; unsigned int retries;
char *file, *md, *ptr; char *file;
const char *md, *ptr;
if (SCM_UNLIKELY (!(scm_is_false (encoding) || scm_is_string (encoding)))) if (SCM_UNLIKELY (!(scm_is_false (encoding) || scm_is_string (encoding))))
scm_wrong_type_arg_msg (FUNC_NAME, 0, 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); file = scm_to_locale_string (filename);
scm_dynwind_free (file); scm_dynwind_free (file);
md = scm_to_locale_string (mode); if (SCM_UNLIKELY (!scm_i_try_narrow_string (mode)))
scm_dynwind_free (md); scm_out_of_range (FUNC_NAME, mode);
md = scm_i_string_chars (mode);
switch (*md) switch (*md)
{ {

16
test-suite/tests/ports.test
View file

@ -2,7 +2,7 @@
;;;; Jim Blandy <jimb@red-bean.com> --- May 1999 ;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
;;;; ;;;;
;;;; Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010, ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -308,6 +308,20 @@
(delete-file filename) (delete-file filename)
(string=? line2 test-string))))) (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-test-prefix "keyword arguments for file openers"
(with-fluids ((%default-port-encoding "UTF-8")) (with-fluids ((%default-port-encoding "UTF-8"))
(let ((filename (test-file))) (let ((filename (test-file)))