guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-165-g9f6e3


From: Ludovic Courtès
Subject: [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-165-g9f6e3f5
Date: Wed, 30 May 2012 22:56:00 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=9f6e3f5a997f484548bd03e7e7573c38a95c8d09

The branch, stable-2.0 has been updated
       via  9f6e3f5a997f484548bd03e7e7573c38a95c8d09 (commit)
       via  b22e94db7c91d7661204e33f3bc2bfead002c9b7 (commit)
       via  478848cb706b23bcc4c2afe9a4ad33c595bc33f6 (commit)
       via  1a6ff60da8d824230e186a8c8bef8c21b23ae377 (commit)
      from  2de74cb56e3af44ce624638facfa061603d39c0d (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 9f6e3f5a997f484548bd03e7e7573c38a95c8d09
Author: Ludovic Courtès <address@hidden>
Date:   Tue May 29 23:39:05 2012 +0200

    Have string ports honor `%default-port-conversion-strategy'.
    
    * libguile/strports.c (scm_mkstrport): Remove initialization of
      `pt->ilseq_handler'.
    
    * module/ice-9/pretty-print.scm (truncated-print)[ellipsis]: Set
      %DEFAULT-PORT-CONVERSION-STRATEGY to 'error.
    
    * test-suite/tests/ports.test ("string
      ports")["%default-port-conversion-strategy is honored"]: New test.
      ["wrong encoding"]: Rename to...
      ["wrong encoding, error"]: ... this.  Explicitly set
      %DEFAULT-PORT-CONVERSION-STRATEGY to 'error.  Return #f when no
      exception is raised.

commit b22e94db7c91d7661204e33f3bc2bfead002c9b7
Author: Ludovic Courtès <address@hidden>
Date:   Tue May 29 23:39:05 2012 +0200

    Add the `%default-port-conversion-strategy' fluid.
    
    Fixes <http://bugs.gnu.org/11468>.
    
    * libguile/ports.c (scm_conversion_strategy): Remove.
      (default_conversion_strategy_var, sym_error, sym_substitute,
      sym_escape): New variables.
      (scm_i_get_conversion_strategy, scm_i_set_conversion_strategy_x):
      Remove.
      (scm_i_default_port_conversion_handler,
      scm_i_set_default_port_conversion_handler): New functions.
      (scm_port_conversion_strategy): Use
      `scm_i_default_port_conversion_handler' when PORT is #f.
      (scm_set_port_conversion_strategy_x): Use SYM_ERROR, SYM_SUBSTITUTE,
      and SYM_ESCAPE.  Use `scm_i_set_default_port_conversion_handler' when
      PORT is #f.
      (scm_init_ports): Initialize DEFAULT_CONVERSION_STRATEGY_VAR.
    
    * libguile/ports.h: Update declarations accordingly.
    
    * libguile/foreign.c: Change
      `scm_i_get_conversion_strategy (SCM_BOOL_F)' to
      `scm_i_default_port_conversion_handler ()'.
    * libguile/strings.c: Likewise.
    
    * test-suite/tests/ports.test ("%default-port-conversion-strategy"): New
      test prefix.
    
    * test-suite/tests/foreign.test 
("pointer<->string")["%default-port-conversion-strategy
      is error", "%default-port-conversion-strategy is soft"]: New tests.
    
    * test-suite/test-suite/lib.scm (exception:encoding-error): Allow the
      regexp to match `scm_to_stringn' error messages.
    
    * doc/ref/api-io.texi (Ports): Document `%default-port-conversion-strategy'.

commit 478848cb706b23bcc4c2afe9a4ad33c595bc33f6
Author: Ludovic Courtès <address@hidden>
Date:   Tue May 29 23:39:05 2012 +0200

    Access `pt->ilseq_handler' directly when needed.
    
    * libguile/print.c (PORT_CONVERSION_HANDLER): New macro.
      (print_extended_symbol, iprin1, write_character, scm_write_char): Use
      it instead of `scm_i_get_conversion_strategy'.
    
    * libguile/strports.c (scm_mkstrport): Assign `pt->ilseq_handler'
      directly instead of via `scm_i_set_conversion_strategy_x'.

commit 1a6ff60da8d824230e186a8c8bef8c21b23ae377
Author: Ludovic Courtès <address@hidden>
Date:   Wed May 16 00:04:07 2012 +0200

    coverage: Add test for applicable structs.
    
    * test-suite/tests/coverage.test ("procedure-execution-count")["applicable
      struct"]: New test.

-----------------------------------------------------------------------

Summary of changes:
 doc/ref/api-io.texi            |   15 ++++
 libguile/foreign.c             |    4 +-
 libguile/ports.c               |  167 +++++++++++++++++++++-------------------
 libguile/ports.h               |    9 ++-
 libguile/print.c               |   13 ++-
 libguile/strings.c             |    6 +-
 libguile/strports.c            |    6 +-
 module/ice-9/pretty-print.scm  |    7 +-
 test-suite/test-suite/lib.scm  |    2 +-
 test-suite/tests/coverage.test |   12 +++-
 test-suite/tests/foreign.test  |   17 ++++
 test-suite/tests/ports.test    |   50 +++++++++++-
 12 files changed, 204 insertions(+), 104 deletions(-)

diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index 24c2706..de3684c 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -166,6 +166,21 @@ returned.  New ports will have this default behavior when 
they are
 created.
 @end deffn
 
address@hidden {Scheme Variable} %default-port-conversion-strategy
+The fluid that defines the conversion strategy for newly created ports,
+and for other conversion routines such as @code{scm_to_stringn},
address@hidden, @code{string->pointer}, and
address@hidden>string}.
+
+Its value must be one of the symbols described above, with the same
+semantics: @code{'error}, @code{'substitute}, or @code{'escape}.
+
+When Guile starts, its value is @code{'substitute}.
+
+Note that @code{(set-port-conversion-strategy! #f @var{sym})} is
+equivalent to @code{(fluid-set! %default-port-conversion-strategy
address@hidden)}.
address@hidden deffn
 
 
 @node Reading
diff --git a/libguile/foreign.c b/libguile/foreign.c
index f1d9607..3559349 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -375,7 +375,7 @@ SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 1, 
0,
 
       ret = scm_from_pointer
         (scm_to_stringn (string, NULL, enc,
-                         scm_i_get_conversion_strategy (SCM_BOOL_F)),
+                         scm_i_default_port_conversion_handler ()),
          free);
 
       scm_dynwind_end ();
@@ -420,7 +420,7 @@ SCM_DEFINE (scm_pointer_to_string, "pointer->string", 1, 2, 
0,
       scm_dynwind_free (enc);
 
       ret = scm_from_stringn (SCM_POINTER_VALUE (pointer), len, enc,
-                              scm_i_get_conversion_strategy (SCM_BOOL_F));
+                              scm_i_default_port_conversion_handler ());
 
       scm_dynwind_end ();
 
diff --git a/libguile/ports.c b/libguile/ports.c
index 3ef92b9..ccf6587 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -628,7 +628,7 @@ scm_new_port_table_entry (scm_t_bits tag)
   entry->input_cd = (iconv_t) -1;
   entry->output_cd = (iconv_t) -1;
 
-  entry->ilseq_handler = scm_i_get_conversion_strategy (SCM_BOOL_F);
+  entry->ilseq_handler = scm_i_default_port_conversion_handler ();
 
   SCM_SET_CELL_TYPE (z, tag);
   SCM_SETPTAB_ENTRY (z, entry);
@@ -2309,62 +2309,81 @@ SCM_DEFINE (scm_set_port_encoding_x, 
"set-port-encoding!", 2, 0, 0,
 #undef FUNC_NAME
 
 
-/* This determines how conversions handle unconvertible characters.  */
-SCM_GLOBAL_VARIABLE (scm_conversion_strategy, "%port-conversion-strategy");
+/* A fluid specifying the default conversion handler for newly created
+   ports.  Its value should be one of the symbols below.  */
+SCM_VARIABLE (default_conversion_strategy_var,
+             "%default-port-conversion-strategy");
+
+/* Whether the above fluid is initialized.  */
 static int scm_conversion_strategy_init = 0;
 
+/* The possible conversion strategies.  */
+SCM_SYMBOL (sym_error, "error");
+SCM_SYMBOL (sym_substitute, "substitute");
+SCM_SYMBOL (sym_escape, "escape");
+
+/* Return the default failed encoding conversion policy for new created
+   ports.  */
 scm_t_string_failed_conversion_handler
-scm_i_get_conversion_strategy (SCM port)
+scm_i_default_port_conversion_handler (void)
 {
-  SCM encoding;
-  
-  if (scm_is_false (port))
-    {
-      if (!scm_conversion_strategy_init
-         || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
-       return SCM_FAILED_CONVERSION_QUESTION_MARK;
-      else
-       {
-         encoding = scm_fluid_ref (SCM_VARIABLE_REF (scm_conversion_strategy));
-         if (scm_is_false (encoding))
-           return SCM_FAILED_CONVERSION_QUESTION_MARK;
-         else 
-           return (scm_t_string_failed_conversion_handler) scm_to_int 
(encoding);
-       }
-    }
+  scm_t_string_failed_conversion_handler handler;
+
+  if (!scm_conversion_strategy_init
+      || !scm_is_fluid (SCM_VARIABLE_REF (default_conversion_strategy_var)))
+    handler = SCM_FAILED_CONVERSION_QUESTION_MARK;
   else
     {
-      scm_t_port *pt;
-      pt = SCM_PTAB_ENTRY (port);
-      return pt->ilseq_handler;
+      SCM fluid, value;
+
+      fluid = SCM_VARIABLE_REF (default_conversion_strategy_var);
+      value = scm_fluid_ref (fluid);
+
+      if (scm_is_eq (sym_substitute, value))
+       handler = SCM_FAILED_CONVERSION_QUESTION_MARK;
+      else if (scm_is_eq (sym_escape, value))
+       handler = SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE;
+      else
+       /* Default to 'error also when the fluid's value is not one of
+          the valid symbols.  */
+       handler = SCM_FAILED_CONVERSION_ERROR;
     }
-      
+
+  return handler;
 }
 
+/* Use HANDLER as the default conversion strategy for future ports.  */
 void
-scm_i_set_conversion_strategy_x (SCM port, 
-                                scm_t_string_failed_conversion_handler handler)
+scm_i_set_default_port_conversion_handler 
(scm_t_string_failed_conversion_handler
+                                          handler)
 {
   SCM strategy;
-  scm_t_port *pt;
-  
-  strategy = scm_from_int ((int) handler);
-  
-  if (scm_is_false (port))
-    {
-      /* Set the default encoding for future ports.  */
-      if (!scm_conversion_strategy_init
-         || !scm_is_fluid (SCM_VARIABLE_REF (scm_conversion_strategy)))
-       scm_misc_error (NULL, "tried to set conversion strategy fluid before it 
is initialized",
-                       SCM_EOL);
-      scm_fluid_set_x (SCM_VARIABLE_REF (scm_conversion_strategy), strategy);
-    }
-  else
+
+  if (!scm_conversion_strategy_init
+      || !scm_is_fluid (SCM_VARIABLE_REF (default_conversion_strategy_var)))
+    scm_misc_error (NULL, "tried to set conversion strategy fluid before it is 
initialized",
+                   SCM_EOL);
+
+  switch (handler)
     {
-      /* Set the character encoding for this port.  */
-      pt = SCM_PTAB_ENTRY (port);
-      pt->ilseq_handler = handler;
+    case SCM_FAILED_CONVERSION_ERROR:
+      strategy = sym_error;
+      break;
+
+    case SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE:
+      strategy = sym_escape;
+      break;
+
+    case SCM_FAILED_CONVERSION_QUESTION_MARK:
+      strategy = sym_substitute;
+      break;
+
+    default:
+      abort ();
     }
+
+  scm_fluid_set_x (SCM_VARIABLE_REF (default_conversion_strategy_var),
+                  strategy);
 }
 
 SCM_DEFINE (scm_port_conversion_strategy, "port-conversion-strategy",
@@ -2384,14 +2403,18 @@ SCM_DEFINE (scm_port_conversion_strategy, 
"port-conversion-strategy",
 {
   scm_t_string_failed_conversion_handler h;
 
-  SCM_VALIDATE_OPPORT (1, port);
-
-  if (!scm_is_false (port))
+  if (scm_is_false (port))
+    h = scm_i_default_port_conversion_handler ();
+  else
     {
+      scm_t_port *pt;
+
       SCM_VALIDATE_OPPORT (1, port);
+      pt = SCM_PTAB_ENTRY (port);
+
+      h = pt->ilseq_handler;
     }
 
-  h = scm_i_get_conversion_strategy (port);
   if (h == SCM_FAILED_CONVERSION_ERROR)
     return scm_from_latin1_symbol ("error");
   else if (h == SCM_FAILED_CONVERSION_QUESTION_MARK)
@@ -2426,40 +2449,25 @@ SCM_DEFINE (scm_set_port_conversion_strategy_x, 
"set-port-conversion-strategy!",
            "this thread.\n")
 #define FUNC_NAME s_scm_set_port_conversion_strategy_x
 {
-  SCM err;
-  SCM qm;
-  SCM esc;
-
-  if (!scm_is_false (port))
-    {
-      SCM_VALIDATE_OPPORT (1, port);
-    }
-
-  err = scm_from_latin1_symbol ("error");
-  if (scm_is_true (scm_eqv_p (sym, err)))
-    {
-      scm_i_set_conversion_strategy_x (port, SCM_FAILED_CONVERSION_ERROR);
-      return SCM_UNSPECIFIED;
-    }
+  scm_t_string_failed_conversion_handler handler;
 
-  qm = scm_from_latin1_symbol ("substitute");
-  if (scm_is_true (scm_eqv_p (sym, qm)))
-    {
-      scm_i_set_conversion_strategy_x (port, 
-                                       SCM_FAILED_CONVERSION_QUESTION_MARK);
-      return SCM_UNSPECIFIED;
-    }
+  if (scm_is_eq (sym, sym_error))
+    handler = SCM_FAILED_CONVERSION_ERROR;
+  else if (scm_is_eq (sym, sym_substitute))
+    handler = SCM_FAILED_CONVERSION_QUESTION_MARK;
+  else if (scm_is_eq (sym, sym_escape))
+    handler = SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE;
+  else
+    SCM_MISC_ERROR ("unknown conversion strategy ~s", scm_list_1 (sym));
 
-  esc = scm_from_latin1_symbol ("escape");
-  if (scm_is_true (scm_eqv_p (sym, esc)))
+  if (scm_is_false (port))
+    scm_i_set_default_port_conversion_handler (handler);
+  else
     {
-      scm_i_set_conversion_strategy_x (port,
-                                       SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
-      return SCM_UNSPECIFIED;
+      SCM_VALIDATE_OPPORT (1, port);
+      SCM_PTAB_ENTRY (port)->ilseq_handler = handler;
     }
 
-  SCM_MISC_ERROR ("unknown conversion behavior ~s", scm_list_1 (sym));
-
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -2577,11 +2585,10 @@ scm_init_ports ()
                     scm_make_fluid_with_default (SCM_BOOL_F));
   scm_port_encoding_init = 1;
 
-  SCM_VARIABLE_SET (scm_conversion_strategy,
-                    scm_make_fluid_with_default
-                    (scm_from_int ((int) 
SCM_FAILED_CONVERSION_QUESTION_MARK)));
+  SCM_VARIABLE_SET (default_conversion_strategy_var,
+                    scm_make_fluid_with_default (sym_substitute));
   scm_conversion_strategy_init = 1;
-  
+
   /* These bindings are used when boot-9 turns `current-input-port' et
      al into parameters.  They are then removed from the guile module.  */
   scm_c_define ("%current-input-port-fluid", cur_inport_fluid);
diff --git a/libguile/ports.h b/libguile/ports.h
index d1e1fd6..d4d59b7 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -308,9 +308,12 @@ SCM_INTERNAL void scm_i_set_default_port_encoding (const 
char *);
 SCM_INTERNAL void scm_i_set_port_encoding_x (SCM port, const char *str);
 SCM_API SCM scm_port_encoding (SCM port);
 SCM_API SCM scm_set_port_encoding_x (SCM port, SCM encoding);
-SCM_INTERNAL scm_t_string_failed_conversion_handler 
scm_i_get_conversion_strategy (SCM port);
-SCM_INTERNAL void scm_i_set_conversion_strategy_x (SCM port, 
-                                                  
scm_t_string_failed_conversion_handler h);
+SCM_INTERNAL scm_t_string_failed_conversion_handler
+scm_i_default_port_conversion_handler (void);
+/* Use HANDLER as the default conversion strategy for future ports.  */
+SCM_INTERNAL void
+scm_i_set_default_port_conversion_handler 
(scm_t_string_failed_conversion_handler);
+
 SCM_API SCM scm_port_conversion_strategy (SCM port);
 SCM_API SCM scm_set_port_conversion_strategy_x (SCM port, SCM behavior);
 SCM_API int scm_port_print (SCM exp, SCM port, scm_print_state *);
diff --git a/libguile/print.c b/libguile/print.c
index c2dcd28..2fc536b 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -61,6 +61,9 @@
 
 /* Character printers.  */
 
+#define PORT_CONVERSION_HANDLER(port)          \
+  SCM_PTAB_ENTRY (port)->ilseq_handler
+
 static size_t display_string (const void *, int, size_t, SCM,
                              scm_t_string_failed_conversion_handler);
 
@@ -393,7 +396,7 @@ print_extended_symbol (SCM sym, SCM port)
   scm_t_string_failed_conversion_handler strategy;
 
   len = scm_i_symbol_length (sym);
-  strategy = scm_i_get_conversion_strategy (port);
+  strategy = PORT_CONVERSION_HANDLER (port);
 
   scm_lfwrite ("#{", 2, port);
 
@@ -500,7 +503,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
          else
            {
              if (!display_character (SCM_CHAR (exp), port,
-                                     scm_i_get_conversion_strategy (port)))
+                                     PORT_CONVERSION_HANDLER (port)))
                scm_encoding_error (__func__, errno,
                                    "cannot convert to output locale",
                                    port, exp);
@@ -586,7 +589,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
              printed = display_string (scm_i_string_data (exp),
                                        scm_i_is_narrow_string (exp),
                                        len, port,
-                                       scm_i_get_conversion_strategy (port));
+                                       PORT_CONVERSION_HANDLER (port));
              if (SCM_UNLIKELY (printed < len))
                scm_encoding_error (__func__, errno,
                                    "cannot convert to output locale",
@@ -1116,7 +1119,7 @@ write_character (scm_t_wchar ch, SCM port, int 
string_escapes_p)
   int printed = 0;
   scm_t_string_failed_conversion_handler strategy;
 
-  strategy = scm_i_get_conversion_strategy (port);
+  strategy = PORT_CONVERSION_HANDLER (port);
 
   if (string_escapes_p)
     {
@@ -1469,7 +1472,7 @@ SCM_DEFINE (scm_write_char, "write-char", 1, 1, 0,
 
   port = SCM_COERCE_OUTPORT (port);
   if (!display_character (SCM_CHAR (chr), port,
-                         scm_i_get_conversion_strategy (port)))
+                         PORT_CONVERSION_HANDLER (port)))
     scm_encoding_error (__func__, errno,
                        "cannot convert to output locale",
                        port, chr);
diff --git a/libguile/strings.c b/libguile/strings.c
index 07356fc..414951e 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -1577,7 +1577,7 @@ SCM
 scm_from_locale_stringn (const char *str, size_t len)
 {
   return scm_from_stringn (str, len, locale_charset (),
-                           scm_i_get_conversion_strategy (SCM_BOOL_F));
+                           scm_i_default_port_conversion_handler ());
 }
 
 SCM
@@ -1802,9 +1802,9 @@ scm_to_locale_string (SCM str)
 char *
 scm_to_locale_stringn (SCM str, size_t *lenp)
 {
-  return scm_to_stringn (str, lenp, 
+  return scm_to_stringn (str, lenp,
                          locale_charset (),
-                         scm_i_get_conversion_strategy (SCM_BOOL_F));
+                         scm_i_default_port_conversion_handler ());
 }
 
 char *
diff --git a/libguile/strports.c b/libguile/strports.c
index b7fec47..ca3a2cf 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -1,5 +1,6 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006, 2009, 
2010, 2011 Free Software Foundation, Inc.
- * 
+/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2005, 2006,
+ *   2009, 2010, 2011, 2012 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
  * as published by the Free Software Foundation; either version 3 of
@@ -336,7 +337,6 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char 
*caller)
   if ((modes & SCM_WRTNG) && pt->write_pos == pt->write_end)
     st_flush (z);
 
-  scm_i_set_conversion_strategy_x (z, SCM_FAILED_CONVERSION_ERROR);
   return z;
 }
 
diff --git a/module/ice-9/pretty-print.scm b/module/ice-9/pretty-print.scm
index bf45eed..5c23cb0 100644
--- a/module/ice-9/pretty-print.scm
+++ b/module/ice-9/pretty-print.scm
@@ -320,9 +320,10 @@ sub-expression, via the @var{breadth-first?} keyword 
argument."
       (let ((e "…"))
         (catch 'encoding-error
           (lambda ()
-            (with-output-to-string
-              (lambda ()
-                (display e))))
+            (with-fluids ((%default-port-conversion-strategy 'error))
+              (with-output-to-string
+                (lambda ()
+                  (display e)))))
           (lambda (key . args)
             "..."))))
 
diff --git a/test-suite/test-suite/lib.scm b/test-suite/test-suite/lib.scm
index 5785378..385cdfa 100644
--- a/test-suite/test-suite/lib.scm
+++ b/test-suite/test-suite/lib.scm
@@ -283,7 +283,7 @@
 (define exception:system-error
   (cons 'system-error ".*"))
 (define exception:encoding-error
-  (cons 'encoding-error "(cannot convert to output locale|input (locale 
conversion|decoding) error)"))
+  (cons 'encoding-error "(cannot convert.* to output locale|input (locale 
conversion|decoding) error)"))
 (define exception:miscellaneous-error
   (cons 'misc-error "^.*"))
 (define exception:read-error
diff --git a/test-suite/tests/coverage.test b/test-suite/tests/coverage.test
index 4ac4043..b29de0f 100644
--- a/test-suite/tests/coverage.test
+++ b/test-suite/tests/coverage.test
@@ -1,6 +1,6 @@
 ;;;; coverage.test --- Code coverage.    -*- mode: scheme; coding: utf-8; -*-
 ;;;;
-;;;;   Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2010, 2011, 2012 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
@@ -216,6 +216,16 @@
              (= 3 result)
              (not (procedure-execution-count data proc))))))
 
+  (pass-if "applicable struct"
+    (let* ((<box> (make-struct <applicable-struct-vtable> 0 'pw))
+           (proc  (lambda args (length args)))
+           (b     (make-struct <box> 0 proc)))
+      (let-values (((data result)
+                    (with-code-coverage %test-vm b)))
+        (and (coverage-data? data)
+             (= 0 result)
+             (= (procedure-execution-count data proc) 1)))))
+
   (pass-if "called from C"
     ;; The `scm_call_N' functions use the VM returned by `the-vm'.  This
     ;; test makes sure that they get to use %TEST-VM.
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 6eafe95..14fad09 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -25,6 +25,7 @@
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (ice-9 format)
   #:use-module (test-suite lib))
 
 
@@ -160,6 +161,22 @@
 
 (with-test-prefix "pointer<->string"
 
+  (pass-if-exception "%default-port-conversion-strategy is error"
+    exception:encoding-error
+    (let ((s "χαοσ"))
+      (with-fluids ((%default-port-conversion-strategy 'error))
+        (string->pointer s "ISO-8859-1"))))
+
+  (pass-if "%default-port-conversion-strategy is soft"
+    (let ((s "teĥniko"))
+      (equal? (map (lambda (strategy)
+                     (with-fluids ((%default-port-conversion-strategy 
strategy))
+                       (pointer->string (string->pointer s "ISO-8859-1"))))
+                   '(substitute escape))
+              (list "te?niko"
+                    (format #f "te\\u~4,'0xniko"
+                            (char->integer #\Ä¥))))))
+
   (pass-if "bijection"
     (let ((s "hello, world"))
       (string=? s (pointer->string (string->pointer s)))))
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 2aec1f0..7728e25 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -58,6 +58,34 @@
     string))
 
 
+
+(with-test-prefix "%default-port-conversion-strategy"
+
+  (pass-if "initial value"
+    (eq? 'substitute (fluid-ref %default-port-conversion-strategy)))
+
+  (pass-if "file port"
+    (let ((strategies '(error substitute escape)))
+      (equal? (map (lambda (s)
+                     (with-fluids ((%default-port-conversion-strategy s))
+                       (call-with-output-file "/dev/null"
+                         (lambda (p)
+                           (port-conversion-strategy p)))))
+                   strategies)
+              strategies)))
+
+  (pass-if "(set-port-conversion-strategy! #f sym)"
+    (begin
+      (set-port-conversion-strategy! #f 'error)
+      (and (eq? (fluid-ref %default-port-conversion-strategy) 'error)
+           (begin
+             (set-port-conversion-strategy! #f 'substitute)
+             (eq? (fluid-ref %default-port-conversion-strategy)
+                  'substitute)))))
+
+)
+
+
 ;;;; Normal file ports.
 
 ;;; Write out an s-expression, and read it back.
@@ -396,6 +424,20 @@
                    encodings)
               encodings)))
 
+  (pass-if "%default-port-conversion-strategy is honored"
+    (let ((strategies '(error substitute escape)))
+      (equal? (map (lambda (s)
+                     (with-fluids ((%default-port-conversion-strategy s))
+                       (call-with-output-string
+                        (lambda (p)
+                          (and (eq? s (port-conversion-strategy p))
+                               (begin
+                                 (set-port-conversion-strategy! p s)
+                                 (display (port-conversion-strategy p)
+                                          p)))))))
+                   strategies)
+              (map symbol->string strategies))))
+
   (pass-if "suitable encoding [latin-1]"
     (let ((str "hello, world"))
       (with-fluids ((%default-port-encoding "ISO-8859-1"))
@@ -412,15 +454,17 @@
                   (lambda ()
                     (display str)))))))
 
-  (pass-if "wrong encoding"
+  (pass-if "wrong encoding, error"
     (let ((str "ĉu bone?"))
       (catch 'encoding-error
         (lambda ()
           ;; Latin-1 cannot represent ‘ĉ’.
-          (with-fluids ((%default-port-encoding "ISO-8859-1"))
+          (with-fluids ((%default-port-encoding "ISO-8859-1")
+                        (%default-port-conversion-strategy 'error))
             (with-output-to-string
               (lambda ()
-                (display str)))))
+                (display str))))
+          #f)                            ; so the test really fails here
         (lambda (key subr message errno port chr)
           (and (eq? chr #\ĉ)
                (string? (strerror errno)))))))


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]