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

Add new `format' warnings.

Browse source 
* module/language/tree-il/analyze.scm (format-analysis): Add new
  sub-warnings: `wrong-port', `wrong-format-string',
  `non-literal-format-string', and `wrong-num-args'.

* module/system/base/message.scm (%warning-types)[format]: Handle
  them.

* test-suite/tests/tree-il.test ("warnings")["wrong port arg",
  "wrong format string", "non-literal format string",
  "wrong number of args"]: New tests.
This commit is contained in:
Ludovic Courtès 2010-10-10 18:10:18 +02:00
parent cb6ff74394
commit 60f01304ee
3 changed files with 84 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1343,16 +1343,25 @@ accurate information is missing from a given `tree-il' element."
(define (check-format-args args loc)
(pmatch args
((,port ,fmt . ,rest)
(guard (and (const? fmt) (string? (const-exp fmt))))
(guard (const? fmt))
(if (and (const? port)
(not (boolean? (const-exp port))))
(warning 'format loc 'wrong-port (const-exp port)))
(let ((fmt (const-exp fmt))
(count (length rest)))
(let-values (((min max)
(format-string-argument-count fmt)))
(and min max
(or (and (or (eq? min 'any) (>= count min))
(or (eq? max 'any) (<= count max)))
(warning 'format loc fmt min max count))))))
(else #t)))
(if (string? fmt)
(let-values (((min max)
(format-string-argument-count fmt)))
(and min max
(or (and (or (eq? min 'any) (>= count min))
(or (eq? max 'any) (<= count max)))
(warning 'format loc 'wrong-format-arg-count
fmt min max count))))
(warning 'format loc 'wrong-format-string fmt))))
((,port ,fmt . ,rest)
(warning 'format loc 'non-literal-format-string))
(else
(warning 'format loc 'wrong-num-args (length args)))))
(define (resolve-toplevel name)
(and (module? env)

32
module/system/base/message.scm
View file

@ -26,6 +26,7 @@
(define-module (system base message)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (ice-9 match)
#:export (*current-warning-port* warning
warning-type? warning-type-name warning-type-description
@ -106,7 +107,7 @@
(format
"report wrong number of arguments to `format'"
,(lambda (port loc fmt min max actual)
,(lambda (port loc . rest)
(define (escape-newlines str)
(list->string
(string-fold-right (lambda (c r)
@ -116,7 +117,7 @@
'()
str)))
(define (range)
(define (range min max)
(cond ((eq? min 'any)
(if (eq? max 'any)
"any number" ;; can't happen
@ -127,9 +128,30 @@
(else
(format #f "~a to ~a" min max))))
(format port
"~A: warning: ~S: wrong number of `format' arguments: expected ~A, got ~A~%"
loc (escape-newlines fmt) (range) actual))))))
(match rest
(('wrong-format-arg-count fmt min max actual)
(format port
"~A: warning: ~S: wrong number of `format' arguments: expected ~A, got ~A~%"
loc (escape-newlines fmt)
(range min max) actual))
(('wrong-port wrong-port)
(format port
"~A: warning: ~S: wrong port argument~%"
loc wrong-port))
(('wrong-format-string fmt)
(format port
"~A: warning: ~S: wrong format string~%"
loc fmt))
(('non-literal-format-string)
(format port
"~A: warning: non-literal format string~%"
loc))
(('wrong-num-args count)
(format port
"~A: warning: wrong number of arguments to `format'~%"
loc))
(else
(format port "~A: `format' warning~%" loc))))))))
(define (lookup-warning-type name)
"Return the warning type NAME or `#f' if not found."

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

@ -1104,6 +1104,46 @@
#:opts %opts-w-format
#:to 'assembly)))))
(pass-if "wrong port arg"
(let ((w (call-with-warnings
(lambda ()
(compile '(format 10 "foo")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
(number? (string-contains (car w)
"wrong port argument")))))
(pass-if "non-literal format string"
(let ((w (call-with-warnings
(lambda ()
(compile '(format #f fmt)
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
(number? (string-contains (car w)
"non-literal format string")))))
(pass-if "wrong format string"
(let ((w (call-with-warnings
(lambda ()
(compile '(format #f 'not-a-string)
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
(number? (string-contains (car w)
"wrong format string")))))
(pass-if "wrong number of args"
(let ((w (call-with-warnings
(lambda ()
(compile '(format "shbweeb")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
(number? (string-contains (car w)
"wrong number of arguments")))))
(pass-if "~%, ~~, ~&, ~t, ~_, and ~\\n"
(null? (call-with-warnings
(lambda ()