Merge remote-tracking branch 'origin/stable-2.0'

Conflicts:
	libguile/ports.c
	libguile/ports.h
	libguile/read.c
	libguile/vm-i-system.c

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)))

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"

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))
+  if (ndrained > 0)
-    scm_unread_string (drained, port);
+    /* Put DRAINED back to PORT.  */
+    while (ndrained-- > 0)
+      scm_unget_byte (drained[ndrained], port);
 
   return SCM_UNSPECIFIED;
 }

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
+/* Move up to READ_LEN bytes from PORT's putback and/or read buffers
-   into memory starting at dest.  returns the number of chars moved.  */
+   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.  */

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_API 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_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);

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.  */
+/* Number of 32-bit codepoints in the buffer used to read strings.  */
-#define READER_STRING_BUFFER_SIZE     512
+#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
+/* Like `read_token', but return either BUFFER, or a GC-allocated buffer
-   result in the pre-allocated buffer BUFFER, if the whole token has fewer than
+   if the token doesn't fit in BUFFER_SIZE bytes.  */
-   BUFFER_SIZE bytes, or into OVERFLOW_BUFFER, allocated here to be freed by the
+static char *
-   caller.  Return zero if the token fits in BUFFER, non-zero otherwise. READ
+read_complete_token (SCM port, char *buffer, size_t buffer_size,
-   will be set the number of bytes actually read.  */
+		     size_t *read)
-static int
-read_complete_token (SCM port, char *buffer, const size_t buffer_size,
-                           char **overflow_buffer, size_t *read)
 {
   int overflow = 0;
-  size_t bytes_read, overflow_size;
+  size_t bytes_read, overflow_size = 0;
-
+  char *overflow_buffer = NULL;
-  *overflow_buffer = NULL;
-  overflow_size = 0;
 
   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);
+              overflow_buffer = scm_gc_malloc_pointerless (bytes_read, "read");
-              memcpy (*overflow_buffer, buffer, bytes_read);
+              memcpy (overflow_buffer, buffer, bytes_read);
               overflow_size = bytes_read;
             }
           else
             {
-              *overflow_buffer = scm_realloc (*overflow_buffer, overflow_size + bytes_read);
+	      char *new_buf =
-              memcpy (*overflow_buffer + overflow_size, buffer, bytes_read);
+		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;
+  SCM str = SCM_EOL;
-  unsigned c_str_len = 0;
+  size_t c_str_len = 0;
-  scm_t_wchar c;
+  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,11 +510,10 @@ 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))
+      if (c_str_len + 1 >= READER_STRING_BUFFER_SIZE)
 	{
-          SCM addy = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL, 0);
+	  str = scm_cons (scm_from_utf32_stringn (c_str, c_str_len), str);
-
+	  c_str_len = 0;
-          str = scm_string_append (scm_list_2 (str, addy));
 	}
 
       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);
+      c_str[c_str_len++] = c;
-      scm_i_string_stop_writing ();
     }
-  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 local_buffer[READER_BUFFER_SIZE], *buffer;
-  char *overflow_buffer = NULL;
   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),
+  buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
-                                  &overflow_buffer, &bytes_read);
+				&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);
 
   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 local_buffer[READER_BUFFER_SIZE], *buffer;
-  char buffer[READER_BUFFER_SIZE], *overflow_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,
+  buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
-                                  &overflow_buffer, &bytes_read);
+				&bytes_read);
   if (bytes_read > 0)
-    {
-      if (!overflow)
     ends_with_colon = buffer[bytes_read - 1] == ':';
-      else
-        ends_with_colon = overflow_buffer[bytes_read - 1] == ':';
-    }
 
   if (postfix && ends_with_colon && (bytes_read > 1))
     {
-      if (!overflow)
+      str = scm_from_stringn (buffer, bytes_read - 1,
-        str = scm_from_stringn (buffer, bytes_read - 1, pt->encoding, pt->ilseq_handler);
+			      pt->encoding, pt->ilseq_handler);
-      else
-        str = scm_from_stringn (overflow_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,
-        str = scm_from_stringn (buffer, bytes_read, pt->encoding, pt->ilseq_handler);
+			      pt->encoding, pt->ilseq_handler);
-      else
-        str = scm_from_stringn (overflow_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;
+  char local_buffer[READER_BUFFER_SIZE], *buffer;
-  int overflow;
   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),
+  buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
-                                  &overflow_buffer, &read);
+				&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);
 
   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))

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);

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 @code{#\\@}}
 @item INLINE-TEXT
 Parsed arguments ending with @code{#\\@}}
+@item INLINE-TEXT-ARGS
+Parsed arguments ending with @code{#\\@}}
 @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},
-@code{ENVIRON}, @code{TABLE-ENVIRON} commands.
+@code{INLINE-TEXT-ARGS}, @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)))
+     (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)))
+                  parent-seed))))
    (lambda (string1 string2 seed)           ; str-handler
      (if (string-null? string2)
          (cons string1 seed)

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))
+                (cond
-                          (title ,@body)))))
+                 ((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)))

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)

test-suite/tests/ports.test

@@ -2,7 +2,7 @@
 ;;;; Jim Blandy <jimb@red-bean.com> --- 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:

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,7 +177,8 @@
     (test (string-append "foo bar baz\n@settitle " title "\n" str)
           expected-res))
   (define (test-body str expected-res)
-    (pass-if (equal? expected-res
+    (pass-if str
+      (equal? expected-res
               (cddr (try-with-title "zog" str)))))
 
   (define (list-intersperse src-l elem)
@@ -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  \n@end example\n"
              '((example " foo asdf  asd  sadf asd  ")))
   (test-body (join-lines