guile-commits
[Top][All Lists]
Advanced

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

[Guile-commits] GNU Guile branch, master, updated. v2.1.0-257-ga3ded46


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. v2.1.0-257-ga3ded46
Date: Tue, 08 May 2012 20:44:48 +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=a3ded46520b35a8dbda22097b74792b8282d12ce

The branch, master has been updated
       via  a3ded46520b35a8dbda22097b74792b8282d12ce (commit)
       via  33672b071118f54ee637afa00349f2a4404a84da (commit)
       via  e8b21eecb11d261eeecbc7a14fa7f7c16e819a3d (commit)
       via  0eba699d12f638c624efcdc2b617b0aa9099ee1f (commit)
       via  520850ad2768dbc0fe16254b90a52b16bfad1f14 (commit)
       via  be52f329b68e5427c25247d0d97d8dfef79e7820 (commit)
       via  4cec6c221aef72825a05963c95eb633af9a43fcf (commit)
       via  ff4d3672757fec3c8509e26bc60abf95f9e8f51a (commit)
       via  5bbd632fc36b14f59d51e4ba2d8e189fd3cc0f76 (commit)
       via  7be3c2fcbfe2335d069a5c13b0ddf74b69383c46 (commit)
       via  82171a2ea4d81d1dd2f71142ed6021ab383d836b (commit)
       via  e9c898bf24c2faf86d3d2f61361bc52ff3abc8b2 (commit)
       via  b662b7e971423934b897f925ccc3061fc640e996 (commit)
      from  4d497b629b73afda35ba409c3dcbfb665fe41dde (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 a3ded46520b35a8dbda22097b74792b8282d12ce
Merge: 4d497b6 33672b0
Author: Andy Wingo <address@hidden>
Date:   Tue May 8 22:43:04 2012 +0200

    Merge remote-tracking branch 'origin/stable-2.0'
    
    Conflicts:
        libguile/ports.c
        libguile/ports.h
        libguile/read.c
        libguile/vm-i-system.c

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

Summary of changes:
 benchmark-suite/benchmarks/read.bm |   15 +++-
 configure.ac                       |    4 +-
 libguile/fports.c                  |   25 +++++-
 libguile/ports.c                   |   14 ++--
 libguile/ports.h                   |    4 +-
 libguile/read.c                    |  142 +++++++++++++++---------------------
 libguile/vm-i-system.c             |    1 +
 module/texinfo.scm                 |   62 ++++++++++++++--
 module/texinfo/docbook.scm         |   12 ++-
 module/texinfo/serialize.scm       |   17 ++++-
 test-suite/tests/ports.test        |   25 ++++++-
 test-suite/tests/texinfo.test      |   20 ++++-
 12 files changed, 225 insertions(+), 116 deletions(-)

diff --git a/benchmark-suite/benchmarks/read.bm 
b/benchmark-suite/benchmarks/read.bm
index e5cf7de..f0b25f5 100644
--- a/benchmark-suite/benchmarks/read.bm
+++ b/benchmark-suite/benchmarks/read.bm
@@ -1,6 +1,6 @@
 ;;; read.bm --- Exercise the reader.               -*- Scheme -*-
 ;;;
-;;; Copyright (C) 2008, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2008, 2010, 2012 Free Software Foundation, Inc.
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public License
@@ -43,6 +43,11 @@
                      (load-file-with-reader file read buffering))
             %files-to-load))
 
+(define small "\"hello, world!\"")
+(define large (string-append "\"" (make-string 1234 #\A) "\""))
+
+(fluid-set! %default-port-encoding "UTF-8")       ; for string ports
+
 
 (with-benchmark-prefix "read"
 
@@ -59,4 +64,10 @@
     (exercise-read (list _IOFBF 8192)))
 
   (benchmark "_IOFBF 16384" 10
-    (exercise-read (list _IOFBF 16384))))
+    (exercise-read (list _IOFBF 16384)))
+
+  (benchmark "small strings" 100000
+    (call-with-input-string small read))
+
+  (benchmark "large strings" 100000
+    (call-with-input-string large read)))
diff --git a/configure.ac b/configure.ac
index e2ccb8c..60d0164 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1495,8 +1495,6 @@ case "$GCC" in
     ## We had -Wstrict-prototypes in here for a bit, but Guile does too
     ## much stuff with generic function pointers for that to really be
     ## less than exasperating.
-    ## -Wpointer-arith was here too, but something changed in gcc/glibc
-    ## and it became equally exasperating (gcc 2.95 and/or glibc 2.1.2).
     ## -Wundef was removed because Gnulib prevented it (see
     ## <http://thread.gmane.org/gmane.lisp.guile.bugs/5329>.)
 
@@ -1505,7 +1503,7 @@ case "$GCC" in
     ## <http://lists.gnu.org/archive/html/guile-devel/2012-01/msg00487.html>.
 
     POTENTIAL_GCC_CFLAGS="-Wall -Wmissing-prototypes \
-      -Wdeclaration-after-statement \
+      -Wdeclaration-after-statement -Wpointer-arith \
       -Wswitch-enum -fno-strict-aliasing"
     # Do this here so we don't screw up any of the tests above that might
     # not be "warning free"
diff --git a/libguile/fports.c b/libguile/fports.c
index 2dc2375..94ce434 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -174,7 +174,8 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
 {
   int cmode;
   long csize;
-  SCM drained;
+  size_t ndrained;
+  char *drained;
   scm_t_port *pt;
 
   port = SCM_COERCE_OUTPORT (port);
@@ -211,9 +212,21 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
   pt = SCM_PTAB_ENTRY (port);
 
   if (SCM_INPUT_PORT_P (port))
-    drained = scm_drain_input (port);
+    {
+      /* Drain pending input from PORT.  Don't use `scm_drain_input' since
+        it returns a string, whereas we want binary input here.  */
+      ndrained = pt->read_end - pt->read_pos;
+      if (pt->read_buf == pt->putback_buf)
+       ndrained += pt->saved_read_end - pt->saved_read_pos;
+
+      if (ndrained > 0)
+       {
+         drained = scm_gc_malloc_pointerless (ndrained, "file port");
+         scm_take_from_input_buffers (port, drained, ndrained);
+       }
+    }
   else
-    drained = scm_nullstr;
+    ndrained = 0;
 
   if (SCM_OUTPUT_PORT_P (port))
     scm_flush_unlocked (port);
@@ -232,8 +245,10 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
 
   scm_fport_buffer_add (port, csize, csize);
 
-  if (scm_is_true (drained) && scm_c_string_length (drained))
-    scm_unread_string (drained, port);
+  if (ndrained > 0)
+    /* Put DRAINED back to PORT.  */
+    while (ndrained-- > 0)
+      scm_unget_byte (drained[ndrained], port);
 
   return SCM_UNSPECIFIED;
 }
diff --git a/libguile/ports.c b/libguile/ports.c
index f5ab24e..b453785 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -2101,20 +2101,21 @@ scm_fill_input (SCM port)
   return ret;
 }
 
-/* move up to read_len chars from port's putback and/or read buffers
-   into memory starting at dest.  returns the number of chars moved.  */
+/* Move up to READ_LEN bytes from PORT's putback and/or read buffers
+   into memory starting at DEST.  Return the number of bytes moved.
+   PORT's line/column numbers are left unchanged.  */
 size_t
 scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
 {
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
-  size_t chars_read = 0;
+  size_t bytes_read = 0;
   size_t from_buf = min (pt->read_end - pt->read_pos, read_len);
 
   if (from_buf > 0)
     {
       memcpy (dest, pt->read_pos, from_buf);
       pt->read_pos += from_buf;
-      chars_read += from_buf;
+      bytes_read += from_buf;
       read_len -= from_buf;
       dest += from_buf;
     }
@@ -2127,10 +2128,11 @@ scm_take_from_input_buffers (SCM port, char *dest, 
size_t read_len)
        {
          memcpy (dest, pt->saved_read_pos, from_buf);
          pt->saved_read_pos += from_buf;
-         chars_read += from_buf;
+         bytes_read += from_buf;
        }
     }
-  return chars_read;
+
+  return bytes_read;
 }
 
 /* Clear a port's read buffers, returning the contents.  */
diff --git a/libguile/ports.h b/libguile/ports.h
index 2d277e0..f33f792 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -324,8 +324,8 @@ SCM_API scm_t_wchar scm_getc_unlocked (SCM port);
 SCM_API SCM scm_read_char (SCM port);
 
 /* Pushback.  */
-SCM_INTERNAL void scm_unget_byte (int c, SCM port); 
-SCM_INTERNAL void scm_unget_byte_unlocked (int c, SCM port); 
+SCM_API void scm_unget_byte (int c, SCM port);
+SCM_API void scm_unget_byte_unlocked (int c, SCM port);
 SCM_API void scm_ungetc (scm_t_wchar c, SCM port);
 SCM_API void scm_ungetc_unlocked (scm_t_wchar c, SCM port);
 SCM_API void scm_ungets (const char *s, int n, SCM port);
diff --git a/libguile/read.c b/libguile/read.c
index dff9d85..5738e2e 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -161,8 +161,8 @@ scm_i_read_hash_procedures_set_x (SCM value)
 /* Size of the C buffer used to read symbols and numbers.  */
 #define READER_BUFFER_SIZE            128
 
-/* Size of the C buffer used to read strings.  */
-#define READER_STRING_BUFFER_SIZE     512
+/* Number of 32-bit codepoints in the buffer used to read strings.  */
+#define READER_STRING_BUFFER_SIZE     128
 
 /* The maximum size of Scheme character names.  */
 #define READER_CHAR_NAME_MAX_SIZE      50
@@ -208,8 +208,8 @@ static SCM scm_get_hash_procedure (int);
    fewer than BUF_SIZE bytes, non-zero otherwise. READ will be set the number 
of
    bytes actually read.  */
 static int
-read_token (SCM port, char *buf, const size_t buf_size, size_t *read)
- {
+read_token (SCM port, char *buf, size_t buf_size, size_t *read)
+{
    *read = 0;
 
    while (*read < buf_size)
@@ -235,20 +235,15 @@ read_token (SCM port, char *buf, const size_t buf_size, 
size_t *read)
    return 1;
  }
 
-/* Read from PORT until a delimiter (e.g., a whitespace) is read.  Put the
-   result in the pre-allocated buffer BUFFER, if the whole token has fewer than
-   BUFFER_SIZE bytes, or into OVERFLOW_BUFFER, allocated here to be freed by 
the
-   caller.  Return zero if the token fits in BUFFER, non-zero otherwise. READ
-   will be set the number of bytes actually read.  */
-static int
-read_complete_token (SCM port, char *buffer, const size_t buffer_size,
-                           char **overflow_buffer, size_t *read)
+/* Like `read_token', but return either BUFFER, or a GC-allocated buffer
+   if the token doesn't fit in BUFFER_SIZE bytes.  */
+static char *
+read_complete_token (SCM port, char *buffer, size_t buffer_size,
+                    size_t *read)
 {
   int overflow = 0;
-  size_t bytes_read, overflow_size;
-
-  *overflow_buffer = NULL;
-  overflow_size = 0;
+  size_t bytes_read, overflow_size = 0;
+  char *overflow_buffer = NULL;
 
   do
     {
@@ -259,14 +254,19 @@ read_complete_token (SCM port, char *buffer, const size_t 
buffer_size,
         {
           if (overflow_size == 0)
             {
-              *overflow_buffer = scm_malloc (bytes_read);
-              memcpy (*overflow_buffer, buffer, bytes_read);
+              overflow_buffer = scm_gc_malloc_pointerless (bytes_read, "read");
+              memcpy (overflow_buffer, buffer, bytes_read);
               overflow_size = bytes_read;
             }
           else
             {
-              *overflow_buffer = scm_realloc (*overflow_buffer, overflow_size 
+ bytes_read);
-              memcpy (*overflow_buffer + overflow_size, buffer, bytes_read);
+             char *new_buf =
+               scm_gc_malloc_pointerless (overflow_size + bytes_read, "read");
+
+             memcpy (new_buf, overflow_buffer, overflow_size);
+              memcpy (new_buf + overflow_size, buffer, bytes_read);
+
+             overflow_buffer = new_buf;
               overflow_size += bytes_read;
             }
         }
@@ -278,7 +278,7 @@ read_complete_token (SCM port, char *buffer, const size_t 
buffer_size,
   else
     *read = bytes_read;
 
-  return (overflow_size != 0);
+  return (overflow_size > 0 ? overflow_buffer : buffer);
 }
 
 /* Skip whitespace from PORT and return the first non-whitespace character
@@ -493,15 +493,14 @@ scm_read_string (int chr, SCM port)
   /* For strings smaller than C_STR, this function creates only one Scheme
      object (the string returned).  */
 
-  SCM str = SCM_BOOL_F;
-  unsigned c_str_len = 0;
-  scm_t_wchar c;
+  SCM str = SCM_EOL;
+  size_t c_str_len = 0;
+  scm_t_wchar c, c_str[READER_STRING_BUFFER_SIZE];
 
   /* Need to capture line and column numbers here. */
   long line = SCM_LINUM (port);
   int column = SCM_COL (port) - 1;
 
-  str = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL, 0);
   while ('"' != (c = scm_getc_unlocked (port)))
     {
       if (c == EOF)
@@ -511,12 +510,11 @@ scm_read_string (int chr, SCM port)
                              "end of file in string constant", SCM_EOL);
         }
 
-      if (c_str_len + 1 >= scm_i_string_length (str))
-        {
-          SCM addy = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL, 0);
-
-          str = scm_string_append (scm_list_2 (str, addy));
-        }
+      if (c_str_len + 1 >= READER_STRING_BUFFER_SIZE)
+       {
+         str = scm_cons (scm_from_utf32_stringn (c_str, c_str_len), str);
+         c_str_len = 0;
+       }
 
       if (c == '\\')
         {
@@ -580,12 +578,22 @@ scm_read_string (int chr, SCM port)
                                  scm_list_1 (SCM_MAKE_CHAR (c)));
             }
         }
-      str = scm_i_string_start_writing (str);
-      scm_i_string_set_x (str, c_str_len++, c);
-      scm_i_string_stop_writing ();
+
+      c_str[c_str_len++] = c;
     }
-  return maybe_annotate_source (scm_i_substring_copy (str, 0, c_str_len),
-                                port, line, column);
+
+  if (scm_is_null (str))
+    /* Fast path: we got a string that fits in C_STR.  */
+    str = scm_from_utf32_stringn (c_str, c_str_len);
+  else
+    {
+      if (c_str_len > 0)
+       str = scm_cons (scm_from_utf32_stringn (c_str, c_str_len), str);
+
+      str = scm_string_concatenate_reverse (str, SCM_UNDEFINED, SCM_UNDEFINED);
+    }
+
+  return maybe_annotate_source (str, port, line, column);
 }
 #undef FUNC_NAME
 
@@ -594,10 +602,8 @@ static SCM
 scm_read_number (scm_t_wchar chr, SCM port)
 {
   SCM result, str = SCM_EOL;
-  char buffer[READER_BUFFER_SIZE];
-  char *overflow_buffer = NULL;
+  char local_buffer[READER_BUFFER_SIZE], *buffer;
   size_t bytes_read;
-  int overflow;
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
   /* Need to capture line and column numbers here. */
@@ -605,14 +611,10 @@ scm_read_number (scm_t_wchar chr, SCM port)
   int column = SCM_COL (port) - 1;
 
   scm_ungetc_unlocked (chr, port);
-  overflow = read_complete_token (port, buffer, sizeof (buffer),
-                                  &overflow_buffer, &bytes_read);
+  buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
+                               &bytes_read);
 
-  if (!overflow)
-    str = scm_from_stringn (buffer, bytes_read, pt->encoding, 
pt->ilseq_handler);
-  else
-    str = scm_from_stringn (overflow_buffer, bytes_read, pt->encoding,
-                            pt->ilseq_handler);
+  str = scm_from_stringn (buffer, bytes_read, pt->encoding, pt->ilseq_handler);
 
   result = scm_string_to_number (str, SCM_UNDEFINED);
   if (scm_is_false (result))
@@ -625,8 +627,6 @@ scm_read_number (scm_t_wchar chr, SCM port)
   else if (SCM_NIMP (result))
     result = maybe_annotate_source (result, port, line, column);
 
-  if (overflow)
-    free (overflow_buffer);
   SCM_COL (port) += scm_i_string_length (str);
   return result;
 }
@@ -638,29 +638,20 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port)
   int ends_with_colon = 0;
   size_t bytes_read;
   int postfix = scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_postfix);
-  int overflow;
-  char buffer[READER_BUFFER_SIZE], *overflow_buffer;
+  char local_buffer[READER_BUFFER_SIZE], *buffer;
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
   SCM str;
 
   scm_ungetc_unlocked (chr, port);
-  overflow = read_complete_token (port, buffer, READER_BUFFER_SIZE,
-                                  &overflow_buffer, &bytes_read);
+  buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
+                               &bytes_read);
   if (bytes_read > 0)
-    {
-      if (!overflow)
-        ends_with_colon = buffer[bytes_read - 1] == ':';
-      else
-        ends_with_colon = overflow_buffer[bytes_read - 1] == ':';
-    }
+    ends_with_colon = buffer[bytes_read - 1] == ':';
 
   if (postfix && ends_with_colon && (bytes_read > 1))
     {
-      if (!overflow)
-        str = scm_from_stringn (buffer, bytes_read - 1, pt->encoding, 
pt->ilseq_handler);
-      else
-        str = scm_from_stringn (overflow_buffer, bytes_read - 1, pt->encoding,
-                                pt->ilseq_handler);
+      str = scm_from_stringn (buffer, bytes_read - 1,
+                             pt->encoding, pt->ilseq_handler);
 
       if (SCM_CASE_INSENSITIVE_P)
         str = scm_string_downcase_x (str);
@@ -668,19 +659,14 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port)
     }
   else
     {
-      if (!overflow)
-        str = scm_from_stringn (buffer, bytes_read, pt->encoding, 
pt->ilseq_handler);
-      else
-        str = scm_from_stringn (overflow_buffer, bytes_read, pt->encoding,
-                                pt->ilseq_handler);
+      str = scm_from_stringn (buffer, bytes_read,
+                             pt->encoding, pt->ilseq_handler);
 
       if (SCM_CASE_INSENSITIVE_P)
         str = scm_string_downcase_x (str);
       result = scm_string_to_symbol (str);
     }
 
-  if (overflow)
-    free (overflow_buffer);
   SCM_COL (port) += scm_i_string_length (str);
   return result;
 }
@@ -691,8 +677,7 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port)
 {
   SCM result;
   size_t read;
-  char buffer[READER_BUFFER_SIZE], *overflow_buffer;
-  int overflow;
+  char local_buffer[READER_BUFFER_SIZE], *buffer;
   unsigned int radix;
   SCM str;
   scm_t_port *pt;
@@ -725,21 +710,14 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port)
       radix = 10;
     }
 
-  overflow = read_complete_token (port, buffer, sizeof (buffer),
-                                  &overflow_buffer, &read);
+  buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
+                               &read);
 
   pt = SCM_PTAB_ENTRY (port);
-  if (!overflow)
-    str = scm_from_stringn (buffer, read, pt->encoding, pt->ilseq_handler);
-  else
-    str = scm_from_stringn (overflow_buffer, read, pt->encoding,
-                            pt->ilseq_handler);
+  str = scm_from_stringn (buffer, read, pt->encoding, pt->ilseq_handler);
 
   result = scm_string_to_number (str, scm_from_uint (radix));
 
-  if (overflow)
-    free (overflow_buffer);
-
   SCM_COL (port) += scm_i_string_length (str);
 
   if (scm_is_true (result))
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index b6c15d2..ef559ae 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -310,6 +310,7 @@ VM_DEFINE_INSTRUCTION (25, variable_ref, "variable-ref", 0, 
1, 1)
     {
       SCM var_name;
 
+      SYNC_ALL ();
       /* Attempt to provide the variable name in the error message.  */
       var_name = scm_module_reverse_lookup (scm_current_module (), x);
       vm_error_unbound (program, scm_is_true (var_name) ? var_name : x);
diff --git a/module/texinfo.scm b/module/texinfo.scm
index 8798eb3..2ffd853 100644
--- a/module/texinfo.scm
+++ b/module/texinfo.scm
@@ -1,6 +1,6 @@
 ;;;; (texinfo) -- parsing of texinfo into SXML
 ;;;;
-;;;;   Copyright (C) 2009, 2010, 2011  Free Software Foundation, Inc.
+;;;;   Copyright (C) 2009, 2010, 2011, 2012  Free Software Foundation, Inc.
 ;;;;    Copyright (C) 2004, 2009 Andy Wingo <wingo at pobox dot com>
 ;;;;    Copyright (C) 2001,2002 Oleg Kiselyov <oleg at pobox dot com>
 ;;;;
@@ -128,6 +128,8 @@ Parsed arguments until end of line
 Unparsed arguments ending with @address@hidden
 @item INLINE-TEXT
 Parsed arguments ending with @address@hidden
address@hidden INLINE-TEXT-ARGS
+Parsed arguments ending with @address@hidden
 @item ENVIRON
 The tag is an environment tag, expect @code{@@end foo}.
 @item TABLE-ENVIRON
@@ -169,7 +171,7 @@ entry.
 @item args
 Named arguments to the command, in the same format as the formals for a
 lambda. Only present for @code{INLINE-ARGS}, @code{EOL-ARGS},
address@hidden, @code{TABLE-ENVIRON} commands.
address@hidden, @code{ENVIRON}, @code{TABLE-ENVIRON} commands.
 @end table"
   '(;; Special commands
     (include            #f) ;; this is a low-level token
@@ -224,6 +226,9 @@ lambda. Only present for @code{INLINE-ARGS}, 
@code{EOL-ARGS},
     (tie                INLINE-ARGS . ())
     (image              INLINE-ARGS . (file #:opt width height alt-text 
extension))
 
+    ;; Inline parsed args commands
+    (acronym            INLINE-TEXT-ARGS . (acronym #:opt meaning))
+
     ;; EOL args elements
     (node               EOL-ARGS . (name #:opt next previous up))
     (c                  EOL-ARGS . all)
@@ -383,7 +388,9 @@ Examples:
       (parser-error #f "Unknown command" command)))
 
 (define (inline-content? content)
-  (or (eq? content 'INLINE-TEXT) (eq? content 'INLINE-ARGS)))
+  (case content
+    ((INLINE-TEXT INLINE-ARGS INLINE-TEXT-ARGS) #t)
+    (else #f)))
 
 
 ;;========================================================================
@@ -572,6 +579,7 @@ Examples:
 ;; Content model     Port position
 ;; =============     =============
 ;; INLINE-TEXT       One character after the #\{.
+;; INLINE-TEXT-ARGS  One character after the #\{.
 ;; INLINE-ARGS       The first character after the #\}.
 ;; EOL-TEXT          The first non-whitespace character after the command.
 ;; ENVIRON, TABLE-ENVIRON, EOL-ARGS, EOL-TEXT
@@ -599,7 +607,9 @@ Examples:
                         (car names))))
      (else
       (loop (cdr in) (cdr names) opt?
-            (cons (list (car names) (car in)) out))))))
+            (acons (car names)
+                   (if (list? (car in)) (car in) (list (car in)))
+                   out))))))
 
 (define (parse-table-args command port)
   (let* ((line (string-trim-both (read-text-line port)))
@@ -648,6 +658,9 @@ Examples:
       ((INLINE-ARGS)
        (assert-curr-char '(#\{) "Inline element lacks {" port)
        (values command (get-arguments type arg-names #\}) type))
+      ((INLINE-TEXT-ARGS)
+       (assert-curr-char '(#\{) "Inline element lacks {" port)
+       (values command '() type))
       ((EOL-ARGS)
        (values command (get-arguments type arg-names #\newline) type))
       ((ENVIRON ENTRY INDEX)
@@ -998,15 +1011,48 @@ Examples:
                  (cons (apply string-append strs) result))))
               '() #t)))))))
 
+(define (parse-inline-text-args port spec text)
+  (let lp ((in text) (cur '()) (out '()))
+    (cond
+     ((null? in)
+      (if (and (pair? cur)
+               (string? (car cur))
+               (string-whitespace? (car cur)))
+          (lp in (cdr cur) out)
+          (let ((args (reverse (if (null? cur)
+                                   out
+                                   (cons (reverse cur) out)))))
+            (arguments->attlist port args (cddr spec)))))
+     ((pair? (car in))
+      (lp (cdr in) (cons (car in) cur) out))
+     ((string-index (car in) #\,)
+      (let* ((parts (string-split (car in) #\,))
+             (head (string-trim-right (car parts)))
+             (rev-tail (reverse (cdr parts)))
+             (last (string-trim (car rev-tail))))
+        (lp (cdr in)
+            (if (string-null? last) cur (cons last cur))
+            (append (cdr rev-tail)
+                    (cons (reverse (if (string-null? head) cur (cons head 
cur)))
+                          out)))))
+     (else
+      (lp (cdr in)
+          (cons (if (null? cur) (string-trim (car in)) (car in)) cur)
+          out)))))
+
 (define (make-dom-parser)
   (make-command-parser
    (lambda (command args content seed)      ; fdown
      '())
    (lambda (command args parent-seed seed)  ; fup
-     (let ((seed (reverse-collect-str-drop-ws seed)))
-       (acons command
-              (if (null? args) seed (acons '% args seed))
-              parent-seed)))
+     (let ((seed (reverse-collect-str-drop-ws seed))
+           (spec (command-spec command)))
+       (if (eq? (cadr spec) 'INLINE-TEXT-ARGS)
+           (cons (list command (cons '% (parse-inline-text-args #f spec seed)))
+                 parent-seed)
+           (acons command
+                  (if (null? args) seed (acons '% args seed))
+                  parent-seed))))
    (lambda (string1 string2 seed)           ; str-handler
      (if (string-null? string2)
          (cons string1 seed)
diff --git a/module/texinfo/docbook.scm b/module/texinfo/docbook.scm
index 7277926..c5a8d65 100644
--- a/module/texinfo/docbook.scm
+++ b/module/texinfo/docbook.scm
@@ -1,6 +1,6 @@
 ;;;; (texinfo docbook) -- translating sdocbook into stexinfo
 ;;;;
-;;;;   Copyright (C) 2009, 2010  Free Software Foundation, Inc.
+;;;;   Copyright (C) 2009, 2010, 2012  Free Software Foundation, Inc.
 ;;;;    Copyright (C) 2007, 2009 Andy Wingo <wingo at pobox dot com>
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
@@ -89,14 +89,20 @@ a number of generic rules for transforming docbook into 
texinfo."
                          `(item ,@body))))
                   . ,(lambda (tag . body)
                        `(itemize ,@body)))
+    (acronym . ,(lambda (tag . body)
+                  `(acronym (% (acronym . ,body)))))
     (term . ,detag-one)
     (informalexample . ,detag-one)
     (section . ,identity)
     (subsection . ,identity)
     (subsubsection . ,identity)
     (ulink . ,(lambda (tag attrs . body)
-                `(uref (% ,(assq 'url (cdr attrs))
-                          (title ,@body)))))
+                (cond
+                 ((assq 'url (cdr attrs))
+                  => (lambda (url)
+                       `(uref (% ,url (title ,@body)))))
+                 (else
+                  (car body)))))
     (*text* . ,detag-one)
     (*default* . ,(lambda (tag . body)
                     (let ((subst (assq tag tag-replacements)))
diff --git a/module/texinfo/serialize.scm b/module/texinfo/serialize.scm
index 6a32d23..1436ad5 100644
--- a/module/texinfo/serialize.scm
+++ b/module/texinfo/serialize.scm
@@ -1,6 +1,6 @@
 ;;;; (texinfo serialize) -- rendering stexinfo as texinfo
 ;;;;
-;;;;   Copyright (C) 2009  Free Software Foundation, Inc.
+;;;;   Copyright (C) 2009, 2012  Free Software Foundation, Inc.
 ;;;;    Copyright (C) 2003,2004,2009  Andy Wingo <wingo at pobox dot com>
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
@@ -98,6 +98,20 @@
               ","))
          "{" command "@" accum))
 
+(define (inline-text-args exp lp command type formals args accum)
+  (list* "}"
+         (if (not args) ""
+             (apply
+              append
+              (list-intersperse
+               (map
+                (lambda (x) (append-map (lambda (x) (lp x '())) (reverse x)))
+                (drop-while not
+                            (map (lambda (x) (assq-ref args x))
+                                 (reverse formals))))
+               '(","))))
+         "{" command "@" accum))
+
 (define (serialize-text-args lp formals args)
   (apply
    append
@@ -202,6 +216,7 @@
   `((EMPTY-COMMAND . ,empty-command)
     (INLINE-TEXT . ,inline-text)
     (INLINE-ARGS . ,inline-args)
+    (INLINE-TEXT-ARGS . ,inline-text-args)
     (EOL-TEXT . ,eol-text)
     (EOL-TEXT-ARGS . ,eol-text-args)
     (INDEX . ,eol-text-args)
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index d4a333f..5ca416d 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 Free Software Foundation, Inc.
+;;;;      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
@@ -1064,6 +1064,29 @@
            (list read read-char read-line)
            '("read" "read-char" "read-line")))
 
+
+
+(with-test-prefix "setvbuf"
+
+  (pass-if "line/column number preserved"
+    ;; In Guile 2.0.5, `setvbuf' would erroneously decrease the port's
+    ;; line and/or column number.
+    (call-with-output-file (test-file)
+      (lambda (p)
+        (display "This is GNU Guile.\nWelcome." p)))
+    (call-with-input-file (test-file)
+      (lambda (p)
+        (and (eq? #\T (read-char p))
+             (let ((line (port-line p))
+                   (col  (port-column p)))
+               (and (= line 0) (= col 1)
+                    (begin
+                      (setvbuf p _IOFBF 777)
+                      (let ((line* (port-line p))
+                            (col*  (port-column p)))
+                        (and (= line line*)
+                             (= col col*)))))))))))
+
 (delete-file (test-file))
 
 ;;; Local Variables:
diff --git a/test-suite/tests/texinfo.test b/test-suite/tests/texinfo.test
index 49d1086..98c44b9 100644
--- a/test-suite/tests/texinfo.test
+++ b/test-suite/tests/texinfo.test
@@ -1,6 +1,6 @@
 ;;;; texinfo.test                 -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2010, 2011  Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2011, 2012  Free Software Foundation, Inc.
 ;;;; Copyright (C) 2001,2002 Oleg Kiselyov <oleg at pobox dot com>
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -177,8 +177,9 @@
     (test (string-append "foo bar address@hidden " title "\n" str)
           expected-res))
   (define (test-body str expected-res)
-    (pass-if (equal? expected-res
-                     (cddr (try-with-title "zog" str)))))
+    (pass-if str
+      (equal? expected-res
+              (cddr (try-with-title "zog" str)))))
 
   (define (list-intersperse src-l elem)
     (if (null? src-l) src-l
@@ -218,6 +219,19 @@
              '((para (code "abc " (code)))))
   (test-body "@code{ arg               }"
              '((para (code "arg"))))
+
+  (test-body "@acronym{GNU}"
+             '((para (acronym (% (acronym "GNU"))))))
+
+  (test-body "@acronym{GNU, not unix}"
+             '((para (acronym (% (acronym "GNU")
+                                 (meaning "not unix"))))))
+
+  (test-body "@acronym{GNU, @acronym{GNU}'s Not Unix}"
+             '((para (acronym (% (acronym "GNU")
+                                 (meaning (acronym (% (acronym "GNU")))
+                                          "'s Not Unix"))))))
+
   (test-body "@example\n foo asdf  asd  sadf asd  address@hidden example\n"
              '((example " foo asdf  asd  sadf asd  ")))
   (test-body (join-lines


hooks/post-receive
-- 
GNU Guile



reply via email to

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