[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-56-gd900843

[Andy Wingo]

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=d900843c72ee1f34d79527deb38787e581592cf5

The branch, stable-2.0 has been updated
       via  d900843c72ee1f34d79527deb38787e581592cf5 (commit)
       via  8d795c83d463e893cdac16733fd42bef809c0d79 (commit)
       via  51c0fd808683fdea689a91fb13b367fd98998c7a (commit)
      from  9c3fa20a561e6693314fda9ad713ce70a80b88de (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 d900843c72ee1f34d79527deb38787e581592cf5
Author: Andy Wingo <address@hidden>
Date:   Thu Mar 3 12:46:49 2011 +0100

    fix encoding scanning for non-seekable ports
    
    * libguile/read.c (scm_i_scan_for_encoding): If possible, just use the
      read buffer for the encoding scan, and avoid seeking.  Fixes
      `(open-input-file "/dev/urandom")', because /dev/urandom can't be
      seeked backwards.

commit 8d795c83d463e893cdac16733fd42bef809c0d79
Author: Andy Wingo <address@hidden>
Date:   Thu Mar 3 11:29:27 2011 +0100

    more module-use-interfaces! tweaks
    
    * module/ice-9/boot-9.scm (module-use-interfaces!): Fix up to prevent
      duplication in the use list of multiple incoming interfaces.
    
    * test-suite/tests/modules.test ("module-use"): Add tests.

commit 51c0fd808683fdea689a91fb13b367fd98998c7a
Author: Andreas Rottmann <address@hidden>
Date:   Thu Mar 3 11:09:54 2011 +0100

    Use module identity to filter for existing modules
    
    This fixes a problem with R6RS's `import' in particuliar: when importing
    a subset of a library/module, the interface created for that purpose
    inherits the name of the module it is derived from.  The low-level
    primitives that are used for importing would then disregard earlier
    imports from the same module.
    
    An example for this bug can be seen with the following library
    definition:
    
    (library (test-guile2)
      (export foo)
      (import (only (rnrs base) define)
              (only (rnrs base) error))
    
      (define (foo . args)
        #t))
    
    In the above, the import of `define' would be disregarded when `error'
    is imported, thus leading to a syntax error, since `(foo . args)' is
    treated as an application, since the binding of `define' would be not
    present.
    
    * module/ice-9/boot-9.scm (module-use!): Remove the filtering of the
      existing imports of the module by name; a check for identity is
      already done beforehand.
      (module-use-interfaces!): Filter the existing imports by identity
      instead of filtering them by their names.

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

Summary of changes:
 libguile/read.c               |   48 +++++++++++++++++++++++++++++++++++------
 module/ice-9/boot-9.scm       |   30 ++++++++++++-------------
 test-suite/tests/modules.test |   45 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 100 insertions(+), 23 deletions(-)

diff --git a/libguile/read.c b/libguile/read.c
index 4057e4f..a889133 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -1650,6 +1650,7 @@ scm_get_hash_procedure (int c)
 char *
 scm_i_scan_for_encoding (SCM port)
 {
+  scm_t_port *pt;
   char header[SCM_ENCODING_SEARCH_SIZE+1];
   size_t bytes_read, encoding_length, i;
   char *encoding = NULL;
@@ -1657,15 +1658,46 @@ scm_i_scan_for_encoding (SCM port)
   char *pos, *encoding_start;
   int in_comment;
 
-  if (SCM_FPORTP (port) && !SCM_FDES_RANDOM_P (SCM_FPORT_FDES (port)))
-    /* PORT is a non-seekable file port (e.g., as created by Bash when using
-       "guile <(echo '(display "hello")')") so bail out.  */
-    return NULL;
+  pt = SCM_PTAB_ENTRY (port);
 
-  bytes_read = scm_c_read (port, header, SCM_ENCODING_SEARCH_SIZE);
-  header[bytes_read] = '\0';
+  if (pt->rw_active == SCM_PORT_WRITE)
+    scm_flush (port);
 
-  scm_seek (port, scm_from_int (0), scm_from_int (SEEK_SET));
+  if (pt->rw_random)
+    pt->rw_active = SCM_PORT_READ;
+
+  if (pt->read_pos == pt->read_end)
+    {
+      /* We can use the read buffer, and thus avoid a seek. */
+      if (scm_fill_input (port) == EOF)
+        return NULL;
+
+      bytes_read = pt->read_end - pt->read_pos;
+      if (bytes_read > SCM_ENCODING_SEARCH_SIZE)
+        bytes_read = SCM_ENCODING_SEARCH_SIZE;
+
+      if (bytes_read <= 1)
+        /* An unbuffered port -- don't scan.  */
+        return NULL;
+
+      memcpy (header, pt->read_pos, bytes_read);
+      header[bytes_read] = '\0';
+    }
+  else
+    {
+      /* Try to read some bytes and then seek back.  Not all ports
+         support seeking back; and indeed some file ports (like
+         /dev/urandom) will succeed on an lseek (fd, 0, SEEK_CUR)---the
+         check performed by SCM_FPORT_FDES---but fail to seek
+         backwards.  Hence this block comes second.  We prefer to use
+         the read buffer in-place.  */
+      if (SCM_FPORTP (port) && !SCM_FDES_RANDOM_P (SCM_FPORT_FDES (port)))
+        return NULL;
+
+      bytes_read = scm_c_read (port, header, SCM_ENCODING_SEARCH_SIZE);
+      header[bytes_read] = '\0';
+      scm_seek (port, scm_from_int (0), scm_from_int (SEEK_SET));
+    }
 
   if (bytes_read > 3 
       && header[0] == '\xef' && header[1] == '\xbb' && header[2] == '\xbf')
@@ -1757,6 +1789,8 @@ SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0,
   char *enc;
   SCM s_enc;
 
+  SCM_VALIDATE_OPINPORT (SCM_ARG1, port);
+
   enc = scm_i_scan_for_encoding (port);
   if (enc == NULL)
     return SCM_BOOL_F;
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 9f621d9..7ca0806 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1987,29 +1987,27 @@ VALUE."
         ;; Newly used modules must be appended rather than consed, so that
         ;; `module-variable' traverses the use list starting from the first
         ;; used module.
-        (set-module-uses! module
-                          (append (filter (lambda (m)
-                                            (not
-                                             (equal? (module-name m)
-                                                     (module-name interface))))
-                                          (module-uses module))
-                                  (list interface)))
+        (set-module-uses! module (append (module-uses module)
+                                         (list interface)))
         (hash-clear! (module-import-obarray module))
         (module-modified module))))
 
 ;; MODULE-USE-INTERFACES! module interfaces
 ;;
-;; Same as MODULE-USE! but add multiple interfaces and check for duplicates
+;; Same as MODULE-USE!, but only notifies module observers after all
+;; interfaces are added to the inports list.
 ;;
 (define (module-use-interfaces! module interfaces)
-  (let ((prev (filter (lambda (used)
-                        (and-map (lambda (iface)
-                                   (not (equal? (module-name used)
-                                                (module-name iface))))
-                                 interfaces))
-                      (module-uses module))))
-    (set-module-uses! module
-                      (append prev interfaces))
+  (let* ((cur (module-uses module))
+         (new (let lp ((in interfaces) (out '()))
+                (if (null? in)
+                    (reverse out)
+                    (lp (cdr in)
+                        (let ((iface (car in)))
+                          (if (or (memq iface cur) (memq iface out))
+                              out
+                              (cons iface out))))))))
+    (set-module-uses! module (append cur new))
     (hash-clear! (module-import-obarray module))
     (module-modified module)))
 
diff --git a/test-suite/tests/modules.test b/test-suite/tests/modules.test
index 29abd09..5f34d9e 100644
--- a/test-suite/tests/modules.test
+++ b/test-suite/tests/modules.test
@@ -146,6 +146,51 @@
 
 
 ;;;
+;;; module-use! / module-use-interfaces!
+;;;
+(with-test-prefix "module-use"
+  (let ((m (make-module)))
+    (pass-if "no uses initially"
+      (null? (module-uses m)))
+
+    (pass-if "using ice-9 q"
+      (begin
+        (module-use! m (resolve-interface '(ice-9 q)))
+        (equal? (module-uses m)
+                (list (resolve-interface '(ice-9 q))))))
+
+    (pass-if "using ice-9 q again"
+      (begin
+        (module-use! m (resolve-interface '(ice-9 q)))
+        (equal? (module-uses m)
+                (list (resolve-interface '(ice-9 q))))))
+
+    (pass-if "using ice-9 ftw"
+      (begin
+        (module-use-interfaces! m (list (resolve-interface '(ice-9 ftw))))
+        (equal? (module-uses m)
+                (list (resolve-interface '(ice-9 q))
+                      (resolve-interface '(ice-9 ftw))))))
+
+    (pass-if "using ice-9 ftw again"
+      (begin
+        (module-use-interfaces! m (list (resolve-interface '(ice-9 ftw))))
+        (equal? (module-uses m)
+                (list (resolve-interface '(ice-9 q))
+                      (resolve-interface '(ice-9 ftw))))))
+
+    (pass-if "using ice-9 control twice"
+      (begin
+        (module-use-interfaces! m (list (resolve-interface '(ice-9 control))
+                                        (resolve-interface '(ice-9 control))))
+        (equal? (module-uses m)
+                (list (resolve-interface '(ice-9 q))
+                      (resolve-interface '(ice-9 ftw))
+                      (resolve-interface '(ice-9 control))))))))
+
+
+
+;;;
 ;;; Resolve-module.
 ;;;
 


hooks/post-receive
-- 
GNU Guile