[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-241-ged4aa
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-241-ged4aa26 |
|
Date: |
Wed, 27 Mar 2013 17:10:07 +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=ed4aa26489d33c22bcdbce2bb037a87df41bef16
The branch, stable-2.0 has been updated
via ed4aa26489d33c22bcdbce2bb037a87df41bef16 (commit)
via 8a177d316c0062afe74f9a761ef460e297435e59 (commit)
via 8cd109bf0a10e37c26bf476fed81a0d4282d13c6 (commit)
via ffc8eca636a8e9311d35c9adba2fc80476ab11ca (commit)
via c548da6949fef565dd1267afa5bbf2c21edda366 (commit)
from 41502bd00f12a6bce97484d33f5519e97a04cf2a (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 ed4aa26489d33c22bcdbce2bb037a87df41bef16
Author: Ludovic Courtès <address@hidden>
Date: Wed Mar 27 18:05:45 2013 +0100
Update `NEWS'.
commit 8a177d316c0062afe74f9a761ef460e297435e59
Author: Ludovic Courtès <address@hidden>
Date: Wed Mar 27 18:03:47 2013 +0100
futures: Limit the number of nested futures on the same stack.
Fixes <http://bugs.gnu.org/13188>.
Reported by Nala Ginrut <address@hidden>.
* module/ice-9/futures.scm (%nesting-level): Rename to...
(%nesting-level): ... this. Default to 0 instead of #f. Update
users.
(%max-nesting-level): New variable.
(touch): When FUTURE is queued and (%nesting-level) is above
%MAX-NESTING-LEVEL, abort to %FUTURE-PROMPT.
* test-suite/tests/future.test ("nested futures")["loop"]: Remove
`compile' call.
* test-suite/tests/threads.test ("par-map")["long list"]: New test.
* doc/ref/api-scheduling.texi (Futures): Add a paragraph about stack
consumption.
commit 8cd109bf0a10e37c26bf476fed81a0d4282d13c6
Author: Ludovic Courtès <address@hidden>
Date: Wed Mar 27 16:45:54 2013 +0100
Document `and=>'.
* module/ice-9/boot-9.scm (and=>): Add docstring.
* doc/ref/api-procedures.texi (Higher-Order Functions): Add `and=>'.
commit ffc8eca636a8e9311d35c9adba2fc80476ab11ca
Author: Daniel Hartwig <address@hidden>
Date: Fri Mar 15 22:25:10 2013 +0800
web http: parse numeric time zones in headers
* module/web/http.scm (parse-zone-offset, normalize-date): New
procedures.
(parse-rfc-822-date, parse-rfc-850-date, parse-date): Update.
* test-suite/tests/web-http.test ("general headers"): Add test.
Signed-off-by: Ludovic Courtès <address@hidden>
commit c548da6949fef565dd1267afa5bbf2c21edda366
Author: Ludovic Courtès <address@hidden>
Date: Tue Mar 26 22:11:30 2013 +0100
doc: Use a preferred naming convention in SRFI-9 examples.
* doc/ref/api-compound.texi (SRFI-9 Records): Use "Scheme Syntax"
instead of "library syntax". Remove `get-' from getter names, and add
an exclamation mark in setter names. Change `employee-type' to
`<employee>'.
-----------------------------------------------------------------------
Summary of changes:
NEWS | 14 ++++++++-
doc/ref/api-compound.texi | 20 ++++++------
doc/ref/api-procedures.texi | 5 +++
doc/ref/api-scheduling.texi | 7 ++++
module/ice-9/boot-9.scm | 5 ++-
module/ice-9/futures.scm | 23 ++++++++++----
module/web/http.scm | 61 ++++++++++++++++++++++++++++++----------
test-suite/tests/future.test | 18 ++++-------
test-suite/tests/threads.test | 9 ++++-
test-suite/tests/web-http.test | 3 ++
10 files changed, 117 insertions(+), 48 deletions(-)
diff --git a/NEWS b/NEWS
index fe6bad1..80b06fd 100644
--- a/NEWS
+++ b/NEWS
@@ -144,8 +144,8 @@ have been deprecated.
** Deprecate `http-get*'.
The new `#:streaming?' argument to `http-get' subsumes the functionality
-of `http-get*'. Also, the `#:extra-headers' argument is deprecated in
-favor of `#:headers'.
+of `http-get*' (introduced in 2.0.7). Also, the `#:extra-headers'
+argument is deprecated in favor of `#:headers'.
** Deprecate (ice-9 mapping).
@@ -163,6 +163,10 @@ See "Bitwise Operations".
See "Environment Variables".
+** New procedure `sendfile'.
+
+See "File System".
+
** New procedures for dealing with file names.
See XXX for documentation on `system-file-name-convention',
@@ -248,6 +252,12 @@ refer to this variable to describe where users should
install their
* Bug fixes
+** SRFI-37: Fix infinite loop when parsing optional-argument short options
+ (http://bugs.gnu.org/13176)
+** web: Support non-GMT date headers in the HTTP client
+ (http://bugs.gnu.org/13544)
+** Avoid stack overflows with `par-map' and nested futures in general
+ (http://bugs.gnu.org/13188)
** A fork when multiple threads are running will now print a warning.
** Allow for spurious wakeups from pthread_cond_wait.
(http://bugs.gnu.org/10641)
diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 83de807..641245a 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -2248,7 +2248,7 @@ Overview}). It can be used with:
(use-modules (srfi srfi-9))
@end example
address@hidden {library syntax} define-record-type type @* (constructor
fieldname @dots{}) @* predicate @* (fieldname accessor [modifier]) @dots{}
address@hidden {Scheme Syntax} define-record-type type @* (constructor
fieldname @dots{}) @* predicate @* (fieldname accessor [modifier]) @dots{}
@sp 1
Create a new record type, and make various @code{define}s for using
it. This syntax can only occur at the top-level, not nested within
@@ -2283,12 +2283,12 @@ field in a @var{record}.
An example will illustrate typical usage,
@example
-(define-record-type employee-type
+(define-record-type <employee>
(make-employee name age salary)
employee?
- (name get-employee-name)
- (age get-employee-age set-employee-age)
- (salary get-employee-salary set-employee-salary))
+ (name employee-name)
+ (age employee-age set-employee-age!)
+ (salary employee-salary set-employee-salary!))
@end example
This creates a new employee data type, with name, age and salary
@@ -2298,13 +2298,13 @@ that it's established only when an employee object is
created). These
can all then be used as for example,
@example
-employee-type @result{} #<record-type employee-type>
+<employee> @result{} #<record-type <employee>>
(define fred (make-employee "Fred" 45 20000.00))
(employee? fred) @result{} #t
-(get-employee-age fred) @result{} 45
-(set-employee-salary fred 25000.00) ;; pay rise
+(employee-age fred) @result{} 45
+(set-employee-salary! fred 25000.00) ;; pay rise
@end example
The functions created by @code{define-record-type} are ordinary
@@ -2334,10 +2334,10 @@ an output port.
This example prints the employee's name in brackets, for instance
@code{[Fred]}.
@example
-(set-record-type-printer! employee-type
+(set-record-type-printer! <employee>
(lambda (record port)
(write-char #\[ port)
- (display (get-employee-name record) port)
+ (display (employee-name record) port)
(write-char #\] port)))
@end example
diff --git a/doc/ref/api-procedures.texi b/doc/ref/api-procedures.texi
index e0158fd..8ff240a 100644
--- a/doc/ref/api-procedures.texi
+++ b/doc/ref/api-procedures.texi
@@ -717,6 +717,11 @@ compatible arity.
Return X.
@end deffn
address@hidden {Scheme Procedure} and=> value proc
+When @var{value} is @code{#f}, return @code{#f}. Otherwise, return
address@hidden(@var{proc} @var{value})}.
address@hidden deffn
+
@node Procedure Properties
@subsection Procedure Properties and Meta-information
diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi
index e040904..b230821 100644
--- a/doc/ref/api-scheduling.texi
+++ b/doc/ref/api-scheduling.texi
@@ -1037,6 +1037,13 @@ future has completed. This suspend/resume is achieved
by capturing the
calling future's continuation, and later reinstating it (@pxref{Prompts,
delimited continuations}).
+Note that @code{par-map} above is not tail-recursive. This could lead
+to stack overflows when @var{lst} is large compared to
address@hidden(current-processor-count)}. To address that, @code{touch} uses
+the suspend mechanism described above to limit the number of nested
+futures executing on the same stack. Thus, the above code should never
+run into stack overflows.
+
@deffn {Scheme Syntax} future exp
Return a future for expression @var{exp}. This is equivalent to:
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index ced3a28..8461ee8 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -944,7 +944,10 @@ VALUE."
(lambda _
value))
-(define (and=> value procedure) (and value (procedure value)))
+(define (and=> value procedure)
+ "When VALUE is #f, return #f. Otherwise, return (PROC VALUE)."
+ (and value (procedure value)))
+
(define call/cc call-with-current-continuation)
(define-syntax false-if-exception
diff --git a/module/ice-9/futures.scm b/module/ice-9/futures.scm
index 6ff104d..35a36ca 100644
--- a/module/ice-9/futures.scm
+++ b/module/ice-9/futures.scm
@@ -1,6 +1,6 @@
;;; -*- mode: scheme; coding: utf-8; -*-
;;;
-;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
+;;; Copyright (C) 2010, 2011, 2012, 2013 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
@@ -88,8 +88,14 @@ touched."
;; A mapping of nested futures to futures waiting for them to complete.
(define %futures-waiting '())
-;; Whether currently running within a future.
-(define %within-future? (make-parameter #f))
+;; Nesting level of futures. Incremented each time a future is touched
+;; from within a future.
+(define %nesting-level (make-parameter 0))
+
+;; Maximum nesting level. The point is to avoid stack overflows when
+;; nested futures are executed on the same stack. See
+;; <http://bugs.gnu.org/13188>.
+(define %max-nesting-level 200)
(define-syntax-rule (with-mutex m e0 e1 ...)
;; Copied from (ice-9 threads) to avoid circular dependency.
@@ -155,7 +161,8 @@ adding it to the waiter queue."
(thunk (lambda ()
(call-with-prompt %future-prompt
(lambda ()
- (parameterize ((%within-future? #t))
+ (parameterize ((%nesting-level
+ (1+ (%nesting-level))))
((future-thunk future))))
suspend))))
(set-future-result! future
@@ -254,14 +261,16 @@ adding it to the waiter queue."
(unlock-mutex (future-mutex future)))
((started)
(unlock-mutex (future-mutex future))
- (if (%within-future?)
+ (if (> (%nesting-level) 0)
(abort-to-prompt %future-prompt future)
(begin
(work)
(loop))))
- (else
+ (else ; queued
(unlock-mutex (future-mutex future))
- (work)
+ (if (> (%nesting-level) %max-nesting-level)
+ (abort-to-prompt %future-prompt future)
+ (work))
(loop))))
((future-result future)))
diff --git a/module/web/http.scm b/module/web/http.scm
index b5202b6..35169ef 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -702,29 +702,50 @@ as an ordered alist."
(else (bad))))
(else (bad))))))
+;; "GMT" | "+" 4DIGIT | "-" 4DIGIT
+;;
+;; RFC 2616 requires date values to use "GMT", but recommends accepting
+;; the others as they are commonly generated by e.g. RFC 822 sources.
+(define (parse-zone-offset str start)
+ (let ((s (substring str start)))
+ (define (bad)
+ (bad-header-component 'zone-offset s))
+ (cond
+ ((string=? s "GMT")
+ 0)
+ ((string-match? s ".dddd")
+ (let ((sign (case (string-ref s 0)
+ ((#\+) +1)
+ ((#\-) -1)
+ (else (bad))))
+ (hours (parse-non-negative-integer s 1 3))
+ (minutes (parse-non-negative-integer s 3 5)))
+ (* sign 60 (+ (* 60 hours) minutes)))) ; seconds east of Greenwich
+ (else (bad)))))
+
;; RFC 822, updated by RFC 1123
;;
;; Sun, 06 Nov 1994 08:49:37 GMT
;; 01234567890123456789012345678
;; 0 1 2
-(define (parse-rfc-822-date str)
+(define (parse-rfc-822-date str space zone-offset)
;; We could verify the day of the week but we don't.
- (cond ((string-match? str "aaa, dd aaa dddd dd:dd:dd GMT")
+ (cond ((string-match? (substring str 0 space) "aaa, dd aaa dddd dd:dd:dd")
(let ((date (parse-non-negative-integer str 5 7))
(month (parse-month str 8 11))
(year (parse-non-negative-integer str 12 16))
(hour (parse-non-negative-integer str 17 19))
(minute (parse-non-negative-integer str 20 22))
(second (parse-non-negative-integer str 23 25)))
- (make-date 0 second minute hour date month year 0)))
- ((string-match? str "aaa, d aaa dddd dd:dd:dd GMT")
+ (make-date 0 second minute hour date month year zone-offset)))
+ ((string-match? (substring str 0 space) "aaa, d aaa dddd dd:dd:dd")
(let ((date (parse-non-negative-integer str 5 6))
(month (parse-month str 7 10))
(year (parse-non-negative-integer str 11 15))
(hour (parse-non-negative-integer str 16 18))
(minute (parse-non-negative-integer str 19 21))
(second (parse-non-negative-integer str 22 24)))
- (make-date 0 second minute hour date month year 0)))
+ (make-date 0 second minute hour date month year zone-offset)))
(else
(bad-header 'date str) ; prevent tail call
#f)))
@@ -733,10 +754,10 @@ as an ordered alist."
;; Sunday, 06-Nov-94 08:49:37 GMT
;; 0123456789012345678901
;; 0 1 2
-(define (parse-rfc-850-date str comma)
+(define (parse-rfc-850-date str comma space zone-offset)
;; We could verify the day of the week but we don't.
- (let ((tail (substring str (1+ comma))))
- (if (not (string-match? tail " dd-aaa-dd dd:dd:dd GMT"))
+ (let ((tail (substring str (1+ comma) space)))
+ (if (not (string-match? tail " dd-aaa-dd dd:dd:dd"))
(bad-header 'date str))
(let ((date (parse-non-negative-integer tail 1 3))
(month (parse-month tail 4 7))
@@ -750,7 +771,7 @@ as an ordered alist."
(cond ((< (+ then 50) now) (+ then 100))
((< (+ now 50) then) (- then 100))
(else then)))
- 0))))
+ zone-offset))))
;; ANSI C's asctime() format
;; Sun Nov 6 08:49:37 1994
@@ -770,13 +791,23 @@ as an ordered alist."
(second (parse-non-negative-integer str 17 19)))
(make-date 0 second minute hour date month year 0)))
+;; Convert all date values to GMT time zone, as per RFC 2616 appendix C.
+(define (normalize-date date)
+ (if (zero? (date-zone-offset date))
+ date
+ (time-utc->date (date->time-utc date) 0)))
+
(define (parse-date str)
- (if (string-suffix? " GMT" str)
- (let ((comma (string-index str #\,)))
- (cond ((not comma) (bad-header 'date str))
- ((= comma 3) (parse-rfc-822-date str))
- (else (parse-rfc-850-date str comma))))
- (parse-asctime-date str)))
+ (let* ((space (string-rindex str #\space))
+ (zone-offset (and space (false-if-exception
+ (parse-zone-offset str (1+ space))))))
+ (normalize-date
+ (if zone-offset
+ (let ((comma (string-index str #\,)))
+ (cond ((not comma) (bad-header 'date str))
+ ((= comma 3) (parse-rfc-822-date str space zone-offset))
+ (else (parse-rfc-850-date str comma space zone-offset))))
+ (parse-asctime-date str)))))
(define (write-date date port)
(define (display-digits n digits port)
diff --git a/test-suite/tests/future.test b/test-suite/tests/future.test
index b8bacb2..a398aff 100644
--- a/test-suite/tests/future.test
+++ b/test-suite/tests/future.test
@@ -2,7 +2,7 @@
;;;;
;;;; Ludovic Courtès <address@hidden>
;;;;
-;;;; Copyright (C) 2010, 2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2012, 2013 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
@@ -22,8 +22,7 @@
#:use-module (test-suite lib)
#:use-module (ice-9 futures)
#:use-module (srfi srfi-1)
- #:use-module (srfi srfi-26)
- #:use-module (system base compile))
+ #:use-module (srfi srfi-26))
(define specific-exception-key (gensym))
@@ -98,11 +97,8 @@
(touch (future (1+ (touch (future (1+ (touch (future 0)))))))))
(pass-if-equal "loop" (map - (iota 1000))
- ;; Compile to avoid stack overflows.
- (compile '(let loop ((list (iota 1000)))
- (if (null? list)
- '()
- (cons (- (car list))
- (touch (future (loop (cdr list)))))))
- #:to 'value
- #:env (current-module))))
+ (let loop ((list (iota 1000)))
+ (if (null? list)
+ '()
+ (cons (- (car list))
+ (touch (future (loop (cdr list)))))))))
diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test
index be722fc..8178120 100644
--- a/test-suite/tests/threads.test
+++ b/test-suite/tests/threads.test
@@ -1,6 +1,6 @@
;;;; threads.test --- Tests for Guile threading. -*- scheme -*-
;;;;
-;;;; Copyright 2003, 2006, 2007, 2009, 2010, 2011, 2012 Free Software
Foundation, Inc.
+;;;; Copyright 2003, 2006, 2007, 2009, 2010, 2011, 2012, 2013 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
@@ -86,7 +86,12 @@
(equal? (par-map fibo (iota 13))
(map fibo (iota 13))))
#:to 'value
- #:env (current-module))))
+ #:env (current-module)))
+
+ (pass-if-equal "long list" (map 1+ (iota 10000))
+ ;; In Guile 2.0.7, this would trigger a stack overflow.
+ ;; See <http://bugs.gnu.org/13188>.
+ (par-map 1+ (iota 10000))))
;;
;; par-for-each
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index 2913724..b2c5c2c 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -216,6 +216,9 @@
(pass-if-parse date "Tue, 15 Nov 1994 08:12:31 GMT"
(string->date "Tue, 15 Nov 1994 08:12:31 +0000"
"~a, ~d ~b ~Y ~H:~M:~S ~z"))
+ (pass-if-parse date "Tue, 15 Nov 1994 16:12:31 +0800"
+ (string->date "Tue, 15 Nov 1994 08:12:31 +0000"
+ "~a, ~d ~b ~Y ~H:~M:~S ~z"))
(pass-if-parse date "Wed, 7 Sep 2011 11:25:00 GMT"
(string->date "Wed, 7 Sep 2011 11:25:00 +0000"
"~a,~e ~b ~Y ~H:~M:~S ~z"))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-241-ged4aa26,
Ludovic Courtès <=