[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-190-gf5e77
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-190-gf5e772b |
|
Date: |
Wed, 25 Jan 2012 23:37:37 +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=f5e772b2bac149c854b9b003e7a96632af7f8760
The branch, stable-2.0 has been updated
via f5e772b2bac149c854b9b003e7a96632af7f8760 (commit)
via 3a822fff1565d1b0f5802925e3c169355143ba3b (commit)
via 60273407f92fdfe36c3ec09decfd92746bbb4f5e (commit)
from 40fb4e317b2a03a2b6ee0c7b7d0f1c37bed25d05 (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 f5e772b2bac149c854b9b003e7a96632af7f8760
Author: Ludovic Courtès <address@hidden>
Date: Thu Jan 26 00:37:23 2012 +0100
Fix a couple of warnings.
* module/scripts/list.scm: Use SRFI-1.
* module/system/repl/error-handling.scm: Use (ice-9 format).
commit 3a822fff1565d1b0f5802925e3c169355143ba3b
Author: Ludovic Courtès <address@hidden>
Date: Thu Jan 26 00:36:39 2012 +0100
Fix typo in `-Wformat'.
* module/language/tree-il/analyze.scm (format-analysis): Call `warning',
not `warn'.
commit 60273407f92fdfe36c3ec09decfd92746bbb4f5e
Author: Ludovic Courtès <address@hidden>
Date: Thu Jan 26 00:35:46 2012 +0100
Add warnings for unsupported `simple-format' options.
* module/language/tree-il/analyze.scm
(format-analysis)[check-simple-format-args]: New procedure. Use it.
Add support for applications of <module-ref>.
* module/system/base/message.scm (%warning-types): Handle the `format
simple-format' warning.
* module/language/scheme/spec.scm (scheme)[make-default-environment]:
Use `simple-format' as the default `format'.
* test-suite/tests/tree-il.test ("warnings")["format"]: Explicitly use
(@ (ice-9 format) format) where needed.
("simple-format"): New test prefix.
-----------------------------------------------------------------------
Summary of changes:
module/language/scheme/spec.scm | 9 +++-
module/language/tree-il/analyze.scm | 49 ++++++++++++++++++--
module/scripts/list.scm | 3 +-
module/system/base/message.scm | 6 ++-
module/system/repl/error-handling.scm | 3 +-
test-suite/tests/tree-il.test | 81 ++++++++++++++++++++++-----------
6 files changed, 117 insertions(+), 34 deletions(-)
diff --git a/module/language/scheme/spec.scm b/module/language/scheme/spec.scm
index 0df4171..e4cf55c 100644
--- a/module/language/scheme/spec.scm
+++ b/module/language/scheme/spec.scm
@@ -1,6 +1,6 @@
;;; Guile Scheme specification
-;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 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
@@ -53,4 +53,11 @@
;; compile-time changes to `current-reader' are
;; limited to the current compilation unit.
(module-define! m 'current-reader (make-fluid))
+
+ ;; Default to `simple-format', as is the case until
+ ;; (ice-9 format) is loaded. This allows
+ ;; compile-time warnings to be emitted when using
+ ;; unsupported options.
+ (module-set! m 'format simple-format)
+
m)))
diff --git a/module/language/tree-il/analyze.scm
b/module/language/tree-il/analyze.scm
index 0470190..777507c 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -22,6 +22,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:use-module (system base syntax)
@@ -1386,7 +1387,7 @@ accurate information is missing from a given `tree-il'
element."
((,port ,fmt . ,rest)
(if (and (const? port)
(not (boolean? (const-exp port))))
- (warn 'format loc 'wrong-port (const-exp port)))
+ (warning 'format loc 'wrong-port (const-exp port)))
;; Warn on non-literal format strings, unless they refer to a
;; lexical variable named "fmt".
(if (record-case fmt
@@ -1397,6 +1398,36 @@ accurate information is missing from a given `tree-il'
element."
(else
(warning 'format loc 'wrong-num-args (length args)))))
+ (define (check-simple-format-args args loc)
+ ;; Check the arguments to the `simple-format' procedure, which is
+ ;; less capable than that of (ice-9 format).
+
+ (define allowed-chars
+ '(#\A #\S #\a #\s #\~ #\%))
+
+ (define (format-chars fmt)
+ (let loop ((chars (string->list fmt))
+ (result '()))
+ (match chars
+ (()
+ (reverse result))
+ ((#\~ opt rest ...)
+ (loop rest (cons opt result)))
+ ((_ rest ...)
+ (loop rest result)))))
+
+ (match args
+ ((port ($ <const> _ (? string? fmt)) _ ...)
+ (let ((opts (format-chars fmt)))
+ (or (every (cut memq <> allowed-chars) opts)
+ (begin
+ (warning 'format loc 'simple-format fmt
+ (find (negate (cut memq <> allowed-chars)) opts))
+ #f))))
+ ((port (($ <const> _ '_) fmt) args ...)
+ (check-simple-format-args `(,port ,fmt ,args) loc))
+ (_ #t)))
+
(define (resolve-toplevel name)
(and (module? env)
(false-if-exception (module-ref env name))))
@@ -1404,9 +1435,19 @@ accurate information is missing from a given `tree-il'
element."
(match x
(($ <application> src ($ <toplevel-ref> _ name) args)
(let ((proc (resolve-toplevel name)))
- (and (or (eq? proc format)
- (eq? proc (@ (ice-9 format) format)))
- (check-format-args args (or src (find pair? locs))))))
+ (if (or (and (eq? proc (@ (guile) simple-format))
+ (check-simple-format-args args
+ (or src (find pair? locs))))
+ (eq? proc (@ (ice-9 format) format)))
+ (check-format-args args (or src (find pair? locs))))))
+ (($ <application> src ($ <module-ref> _ '(ice-9 format) 'format) args)
+ (check-format-args args (or src (find pair? locs))))
+ (($ <application> src ($ <module-ref> _ '(guile)
+ (or 'format 'simple-format))
+ args)
+ (and (check-simple-format-args args
+ (or src (find pair? locs)))
+ (check-format-args args (or src (find pair? locs)))))
(_ #t))
#t)
diff --git a/module/scripts/list.scm b/module/scripts/list.scm
index 0f1d715..66116ce 100644
--- a/module/scripts/list.scm
+++ b/module/scripts/list.scm
@@ -1,6 +1,6 @@
;;; List --- List scripts that can be invoked by guild -*- coding: iso-8859-1
-*-
-;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 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
@@ -26,6 +26,7 @@
;;; Code:
(define-module (scripts list)
+ #:use-module (srfi srfi-1)
#:export (list-scripts))
(define %include-in-guild-list #f)
diff --git a/module/system/base/message.scm b/module/system/base/message.scm
index 75e14ea..8cf285a 100644
--- a/module/system/base/message.scm
+++ b/module/system/base/message.scm
@@ -1,6 +1,6 @@
;;; User interface messages
-;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 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
@@ -150,6 +150,10 @@
(emit #f "~a to ~a" min max))))
(match rest
+ (('simple-format fmt opt)
+ (emit port
+ "~A: warning: ~S: unsupported format option ~~~A, use
(ice-9 format) instead~%"
+ loc (escape-newlines fmt) opt))
(('wrong-format-arg-count fmt min max actual)
(emit port
"~A: warning: ~S: wrong number of `format' arguments:
expected ~A, got ~A~%"
diff --git a/module/system/repl/error-handling.scm
b/module/system/repl/error-handling.scm
index 2a585aa..0e31eb9 100644
--- a/module/system/repl/error-handling.scm
+++ b/module/system/repl/error-handling.scm
@@ -1,6 +1,6 @@
;;; Error handling in the REPL
-;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 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
@@ -23,6 +23,7 @@
#:use-module (system base pmatch)
#:use-module (system vm trap-state)
#:use-module (system repl debug)
+ #:use-module (ice-9 format)
#:export (call-with-error-handling
with-error-handling))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index bb56c23..37cd386 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -2187,7 +2187,8 @@
(pass-if "~%, ~~, ~&, ~t, ~_, and ~\\n"
(null? (call-with-warnings
(lambda ()
- (compile '(format some-port "~&~3_~~ ~\n~12they~%")
+ (compile '((@ (ice-9 format) format) some-port
+ "~&~3_~~ ~\n~12they~%")
#:opts %opts-w-format
#:to 'assembly)))))
@@ -2214,7 +2215,8 @@
(pass-if "two missing arguments"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "foo ~10,2f and bar ~S~%")
+ (compile '((@ (ice-9 format) format) #f
+ "foo ~10,2f and bar ~S~%")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@@ -2245,7 +2247,7 @@
(pass-if "literals"
(null? (call-with-warnings
(lambda ()
- (compile '(format #f "~A ~[foo~;bar~;baz~;~] ~10,2f"
+ (compile '((@ (ice-9 format) format) #f "~A
~[foo~;bar~;baz~;~] ~10,2f"
'a 1 3.14)
#:opts %opts-w-format
#:to 'assembly)))))
@@ -2253,7 +2255,7 @@
(pass-if "literals with selector"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "~2[foo~;bar~;baz~;~] ~A"
+ (compile '((@ (ice-9 format) format) #f
"~2[foo~;bar~;baz~;~] ~A"
1 'dont-ignore-me)
#:opts %opts-w-format
#:to 'assembly)))))
@@ -2264,7 +2266,7 @@
(pass-if "escapes (exact count)"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "~[~a~;~a~]")
+ (compile '((@ (ice-9 format) format) #f "~[~a~;~a~]")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@@ -2274,7 +2276,7 @@
(pass-if "escapes with selector"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "~1[chbouib~;~a~]")
+ (compile '((@ (ice-9 format) format) #f
"~1[chbouib~;~a~]")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@@ -2284,7 +2286,7 @@
(pass-if "escapes, range"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "~[chbouib~;~a~;~2*~a~]")
+ (compile '((@ (ice-9 format) format) #f
"~[chbouib~;~a~;~2*~a~]")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@@ -2294,7 +2296,7 @@
(pass-if "@"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "address@hidden")
+ (compile '((@ (ice-9 format) format) #f "address@hidden")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@@ -2304,7 +2306,7 @@
(pass-if "nested"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "~:[~[hey~;~a~;~va~]~;~3*~]")
+ (compile '((@ (ice-9 format) format) #f
"~:[~[hey~;~a~;~va~]~;~3*~]")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@@ -2314,7 +2316,7 @@
(pass-if "unterminated"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "~[unterminated")
+ (compile '((@ (ice-9 format) format) #f "~[unterminated")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@@ -2324,7 +2326,7 @@
(pass-if "unexpected ~;"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "foo~;bar")
+ (compile '((@ (ice-9 format) format) #f "foo~;bar")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@@ -2334,7 +2336,7 @@
(pass-if "unexpected ~]"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "foo~]")
+ (compile '((@ (ice-9 format) format) #f "foo~]")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@@ -2344,7 +2346,7 @@
(pass-if "~{...~}"
(null? (call-with-warnings
(lambda ()
- (compile '(format #f "~A ~{~S~} ~A"
+ (compile '((@ (ice-9 format) format) #f "~A ~{~S~} ~A"
'hello '("ladies" "and")
'gentlemen)
#:opts %opts-w-format
@@ -2353,7 +2355,7 @@
(pass-if "~{...~}, too many args"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "~{~S~}" 1 2 3)
+ (compile '((@ (ice-9 format) format) #f "~{~S~}" 1 2 3)
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@@ -2363,14 +2365,14 @@
(pass-if "address@hidden"
(null? (call-with-warnings
(lambda ()
- (compile '(format #f "address@hidden" 1 2 3)
+ (compile '((@ (ice-9 format) format) #f "address@hidden" 1 2
3)
#:opts %opts-w-format
#:to 'assembly)))))
(pass-if "address@hidden, too few args"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "~A address@hidden")
+ (compile '((@ (ice-9 format) format) #f "~A address@hidden")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@@ -2380,7 +2382,7 @@
(pass-if "unterminated ~{...~}"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "~{")
+ (compile '((@ (ice-9 format) format) #f "~{")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@@ -2390,14 +2392,14 @@
(pass-if "~(...~)"
(null? (call-with-warnings
(lambda ()
- (compile '(format #f "~:@(~A ~A~)" 'foo 'bar)
+ (compile '((@ (ice-9 format) format) #f "~:@(~A ~A~)" 'foo
'bar)
#:opts %opts-w-format
#:to 'assembly)))))
(pass-if "~v"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "~v_foo")
+ (compile '((@ (ice-9 format) format) #f "~v_foo")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@@ -2406,7 +2408,7 @@
(pass-if "~v:@y"
(null? (call-with-warnings
(lambda ()
- (compile '(format #f "~v:@y" 1 123)
+ (compile '((@ (ice-9 format) format) #f "~v:@y" 1 123)
#:opts %opts-w-format
#:to 'assembly)))))
@@ -2414,7 +2416,7 @@
(pass-if "~*"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "~2*~a" 'a 'b)
+ (compile '((@ (ice-9 format) format) #f "~2*~a" 'a 'b)
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@@ -2424,14 +2426,14 @@
(pass-if "~?"
(null? (call-with-warnings
(lambda ()
- (compile '(format #f "~?" "~d ~d" '(1 2))
+ (compile '((@ (ice-9 format) format) #f "~?" "~d ~d" '(1 2))
#:opts %opts-w-format
#:to 'assembly)))))
(pass-if "complex 1"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f
+ (compile '((@ (ice-9 format) format) #f
"address@hidden address@hidden;;
address@hidden@[~61t at ~a~]\n"
1 2 3 4 5 6)
#:opts %opts-w-format
@@ -2443,7 +2445,7 @@
(pass-if "complex 2"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f
+ (compile '((@ (ice-9 format) format) #f
"~:(~A~) Commands~:[~; [abbrev]~]:~2%"
1 2 3 4)
#:opts %opts-w-format
@@ -2455,7 +2457,7 @@
(pass-if "complex 3"
(let ((w (call-with-warnings
(lambda ()
- (compile '(format #f "address@hidden:[~*~3_~;~3d~] ~v:@y~%")
+ (compile '((@ (ice-9 format) format) #f
"address@hidden:[~*~3_~;~3d~] ~v:@y~%")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
@@ -2482,4 +2484,31 @@
(compile '(let ((format chbouib))
(format #t "not ~A a format string"))
#:opts %opts-w-format
- #:to 'assembly)))))))
+ #:to 'assembly)))))
+
+ (with-test-prefix "simple-format"
+
+ (pass-if "good"
+ (null? (call-with-warnings
+ (lambda ()
+ (compile '(simple-format #t "foo ~a bar ~s ~%~~" 1 2)
+ #:opts %opts-w-format
+ #:to 'assembly)))))
+
+ (pass-if "wrong number of args"
+ (let ((w (call-with-warnings
+ (lambda ()
+ (compile '(simple-format #t "foo ~a ~s~%" 'one-missing)
+ #:opts %opts-w-format
+ #:to 'assembly)))))
+ (and (= (length w) 1)
+ (number? (string-contains (car w) "wrong number")))))
+
+ (pass-if "unsupported"
+ (let ((w (call-with-warnings
+ (lambda ()
+ (compile '(simple-format #t "foo ~x~%" 16)
+ #:opts %opts-w-format
+ #:to 'assembly)))))
+ (and (= (length w) 1)
+ (number? (string-contains (car w) "unsupported format
option"))))))))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-190-gf5e772b,
Ludovic Courtès <=