1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 05:30:21 +02:00

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

Conflicts:
	libguile/deprecated.c
	libguile/ports.c
	libguile/ports.h
	libguile/strports.c
	test-suite/tests/cse.test
This commit is contained in:
Andy Wingo 2012-06-22 13:18:02 +02:00
commit 0dd7c54075
26 changed files with 343 additions and 158 deletions

View file

@ -66,7 +66,7 @@ There is NO WARRANTY, to the extent permitted by law."))
(define* (version-etc package version #:key
(port (current-output-port))
;; FIXME: authors
(copyright-year 2011)
(copyright-year 2012)
(copyright-holder "Free Software Foundation, Inc.")
(copyright (format #f "Copyright (C) ~a ~a"
copyright-year copyright-holder))

View file

@ -538,26 +538,29 @@ of file names is sorted according to ENTRY<?, which defaults to
(define (enter? dir stat result)
(and stat (string=? dir name)))
(define (leaf name stat result)
(if (select? name)
(and (pair? result) ; must have a "." entry
(cons (basename name) result))
(define (visit basename result)
(if (select? basename)
(cons basename result)
result))
(define (leaf name stat result)
(and result
(visit (basename name) result)))
(define (down name stat result)
(list "."))
(visit "." '()))
(define (up name stat result)
(cons ".." result))
(visit ".." result))
(define (skip name stat result)
;; All the sub-directories are skipped.
(cons (basename name) result))
(visit (basename name) result))
(define (error name* stat errno result)
(if (string=? name name*) ; top-level NAME is unreadable
result
(cons (basename name*) result)))
(visit (basename name*) result)))
(and=> (file-system-fold enter? leaf down up skip error #f name stat)
(lambda (files)

View file

@ -1,6 +1,6 @@
;;; -*- mode: scheme; coding: utf-8; -*-
;;;
;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
;;; Copyright (C) 2010, 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
@ -52,7 +52,7 @@
;; `match' doesn't support clauses of the form `(pat => exp)'.
;; Unmodified public domain code by Alex Shinn retrieved from
;; the Chibi-Scheme repository, commit 876:528cdab3f818.
;; the Chibi-Scheme repository, commit 1206:acd808700e91.
;;
;; Note: Make sure to update `match.test.upstream' when updating this
;; file.

View file

@ -210,6 +210,7 @@
;; performance can be found at
;; http://synthcode.com/scheme/match-cond-expand.scm
;;
;; 2012/05/23 - fixing combinatorial explosion of code in certain or patterns
;; 2011/09/25 - fixing bug when directly matching an identifier repeated in
;; the pattern (thanks to Stefan Israelsson Tampe)
;; 2011/01/27 - fixing bug when matching tail patterns against improper lists
@ -479,7 +480,8 @@
(match-one v p . x))
((_ v (p . q) g+s sk fk i)
;; match one and try the remaining on failure
(match-one v p g+s sk (match-gen-or-step v q g+s sk fk i) i))
(let ((fk2 (lambda () (match-gen-or-step v q g+s sk fk i))))
(match-one v p g+s sk (fk2) i)))
))
;; We match a pattern (p ...) by matching the pattern p in a loop on

View file

@ -320,9 +320,10 @@ sub-expression, via the @var{breadth-first?} keyword argument."
(let ((e "…"))
(catch 'encoding-error
(lambda ()
(with-output-to-string
(lambda ()
(display e))))
(with-fluids ((%default-port-conversion-strategy 'error))
(with-output-to-string
(lambda ()
(display e)))))
(lambda (key . args)
"..."))))