diff --git a/benchmark-suite/benchmarks/read.bm b/benchmark-suite/benchmarks/read.bm index e5cf7de93..f0b25f541 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 e2ccb8c67..60d0164eb 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 ## .) @@ -1505,7 +1503,7 @@ case "$GCC" in ## . 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 2dc23758f..94ce434d1 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 f5ab24ed2..b45378592 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 2d277e031..f33f792b9 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 dff9d85d1..5738e2ed8 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 b6c15d28e..ef559ae52 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 8798eb3c1..2ffd85393 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 ;;;; Copyright (C) 2001,2002 Oleg Kiselyov ;;;; @@ -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))) - (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 72779263a..c5a8d659f 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 ;;;; ;;;; 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 6a32d2346..1436ad5f9 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 ;;;; ;;;; 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 d4a333f56..5ca416daf 100644 --- a/test-suite/tests/ports.test +++ b/test-suite/tests/ports.test @@ -2,7 +2,7 @@ ;;;; Jim Blandy --- 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 49d108698..98c44b91b 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 ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -177,8 +177,9 @@ (test (string-append "foo bar baz\n@settitle " 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 \n@end example\n" '((example " foo asdf asd sadf asd "))) (test-body (join-lines