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

Have -Wformat' remain quiet for any procedure called _' or `N_'.

Browse source 
* module/language/tree-il/analyze.scm (proc-ref?)[special?]: New
  procedure.
  Return #t for any toplevel-ref of `_'.

* test-suite/tests/tree-il.test ("warnings")["format"]("non-literal
  format string using gettext as top-level _"): New test.
This commit is contained in:
Ludovic Courtès 2012-05-12 16:11:51 +02:00
parent 2c5f0bdb0e
commit 8a74ffe88a
2 changed files with 22 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1357,21 +1357,27 @@ accurate information is missing from a given `tree-il' element."
(define (proc-ref? exp proc special-name env) (define (proc-ref? exp proc special-name env)
"Return #t when EXP designates procedure PROC in ENV. As a last "Return #t when EXP designates procedure PROC in ENV. As a last
resort, return #t when EXP refers to the global variable SPECIAL-NAME." resort, return #t when EXP refers to the global variable SPECIAL-NAME."
(define special?
(cut eq? <> special-name))
(match exp (match exp
(($ <toplevel-ref> _ (? special?))
;; Allow top-levels like: (define _ (cut gettext <> "my-domain")).
#t)
(($ <toplevel-ref> _ name) (($ <toplevel-ref> _ name)
(let ((var (module-variable env name))) (let ((var (module-variable env name)))
(if (and var (variable-bound? var)) (and var (variable-bound? var)
(eq? (variable-ref var) proc) (eq? (variable-ref var) proc))))
(eq? name special-name)))) ; special hack to support local aliases (($ <module-ref> _ _ (? special?))
#t)
(($ <module-ref> _ module name public?) (($ <module-ref> _ module name public?)
(let* ((mod (if public? (let* ((mod (if public?
(false-if-exception (resolve-interface module)) (false-if-exception (resolve-interface module))
(resolve-module module #:ensure #f))) (resolve-module module #:ensure #f)))
(var (and mod (module-variable mod name)))) (var (and mod (module-variable mod name))))
(if var (and var (variable-bound? var) (eq? (variable-ref var) proc))))
(and (variable-bound? var) (eq? (variable-ref var) proc)) (($ <lexical-ref> _ (? special?))
(eq? name special-name))))
(($ <lexical-ref> _ (? (cut eq? <> special-name)))
#t) #t)
(_ #f))) (_ #f)))

9
test-suite/tests/tree-il.test
View file

@ -1262,6 +1262,15 @@
#:opts %opts-w-format #:opts %opts-w-format
#:to 'assembly))))) #:to 'assembly)))))
(pass-if "non-literal format string using gettext as top-level _"
(null? (call-with-warnings
(lambda ()
(compile '(begin
(define (_ s) (gettext s "my-domain"))
(format #t (_ "~A ~A!") "hello" "world"))
#:opts %opts-w-format
#:to 'assembly)))))
(pass-if "non-literal format string using gettext as module-ref _" (pass-if "non-literal format string using gettext as module-ref _"
(null? (call-with-warnings (null? (call-with-warnings
(lambda () (lambda ()