mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 14:21:10 +02:00
Code Activity

don't warn about non-literal fmt strings for e.g. (_ "foo")

Browse source 
* module/language/tree-il/analyze.scm (const-fmt, format-analysis):
  Allow format strings to be gettexted, using the conventional _ name.
This commit is contained in:
Andy Wingo 2011-04-14 16:04:18 +02:00
parent 7c81eba25b
commit 56e313894b
1 changed files with 26 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

28
module/language/tree-il/analyze.scm
View file

@ -1343,6 +1343,27 @@ accurate information is missing from a given `tree-il' element."
min-count max-count)))) min-count max-count))))
(else (error "computer bought the farm" state)))))) (else (error "computer bought the farm" state))))))
;; Return the literal format pattern for X, or #f.
(define (const-fmt x)
(record-case x
((<const> exp)
;; String literals.
(and (string? exp) exp))
((<application> proc args)
;; Gettexted string literals, like `(_ "foo")'.
(and (record-case proc
((<toplevel-ref> name) (eq? name '_))
((<module-ref> name) (eq? name '_))
(else #f))
(pmatch args
((,fmt)
(record-case fmt
((<const> exp)
(and (string? exp) exp))
(else #f)))
(else #f))))
(else #f)))
(define format-analysis (define format-analysis
;; Report arity mismatches in the given tree. ;; Report arity mismatches in the given tree.
(make-tree-analysis (make-tree-analysis
@ -1355,11 +1376,11 @@ accurate information is missing from a given `tree-il' element."
(define (check-format-args args loc) (define (check-format-args args loc)
(pmatch args (pmatch args
((,port ,fmt . ,rest) ((,port ,fmt . ,rest)
(guard (const? fmt)) (guard (const-fmt fmt))
(if (and (const? port) (if (and (const? port)
(not (boolean? (const-exp port)))) (not (boolean? (const-exp port))))
(warning 'format loc 'wrong-port (const-exp port))) (warning 'format loc 'wrong-port (const-exp port)))
(let ((fmt (const-exp fmt)) (let ((fmt (const-fmt fmt))
(count (length rest))) (count (length rest)))
(if (string? fmt) (if (string? fmt)
(catch &syntax-error (catch &syntax-error
@ -1375,6 +1396,9 @@ accurate information is missing from a given `tree-il' element."
(warning 'format loc 'syntax-error key fmt))) (warning 'format loc 'syntax-error key fmt)))
(warning 'format loc 'wrong-format-string fmt)))) (warning 'format loc 'wrong-format-string fmt))))
((,port ,fmt . ,rest) ((,port ,fmt . ,rest)
(if (and (const? port)
(not (boolean? (const-exp port))))
(warn 'format loc 'wrong-port (const-exp port)))
;; Warn on non-literal format strings, unless they refer to a ;; Warn on non-literal format strings, unless they refer to a
;; lexical variable named "fmt". ;; lexical variable named "fmt".
(if (record-case fmt (if (record-case fmt