mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

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

Browse source 
Conflicts:
	libguile/ports.c
	libguile/ports.h
	libguile/read.c
	libguile/vm-i-system.c
This commit is contained in:
Andy Wingo 2012-05-08 22:43:04 +02:00
commit a3ded46520
12 changed files with 225 additions and 116 deletions
Download patch file Download diff file Expand all files Collapse all files

15
benchmark-suite/benchmarks/read.bm
View file

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

4
configure.ac
View file

@ -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"

25
libguile/fports.c
View file

@ -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;
}

14
libguile/ports.c
View file

@ -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. */

4
libguile/ports.h
View file

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

130
libguile/read.c
View file

@ -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,7 +208,7 @@ 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;
@ -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,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_string_append (scm_list_2 (str, addy));
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);
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] == ':';
}
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);
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))

1
libguile/vm-i-system.c
View file

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

58
module/texinfo.scm
View file

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

12
module/texinfo/docbook.scm
View file

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

17
module/texinfo/serialize.scm
View file

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

25
test-suite/tests/ports.test
View file

@ -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:

18
test-suite/tests/texinfo.test
View file

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