mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-03 08:10:31 +02:00
Code Activity

Add warnings for obvious syntax errors in format strings.

Browse source 
* module/language/tree-il/analyze.scm (&syntax-error): New variable.
  (format-string-argument-count): Throw to &SYNTAX-ERROR when a syntax
  error in a format string is encountered.
  (format-analysis): Catch &SYNTAX-ERROR and convert as a warning of the
  appropriate type.

* module/system/base/message.scm (%warning-types)[format]: Handle
  `syntax-error' warnings.

* test-suite/tests/tree-il.test
  ("warnings")["conditionals"]("unterminated", "unexpected ~;",
  "unexpected ~]"): New tests.
  ["unterminated ~{...~}"]: New test.
This commit is contained in:
Ludovic Courtès 2010-10-10 19:08:11 +02:00
parent 60f01304ee
commit 8e6c15a6f0
3 changed files with 76 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1201,6 +1201,10 @@ accurate information is missing from a given `tree-il' element."
;;; `format' argument analysis.
;;;
(define &syntax-error
;; The `throw' key for syntax errors.
(gensym "format-string-syntax-error"))
(define (format-string-argument-count fmt)
;; Return the minimum and maxium number of arguments that should
;; follow format string FMT (or, ahem, a good estimate thereof) or
@ -1212,7 +1216,7 @@ accurate information is missing from a given `tree-il' element."
(let loop ((chars chars)
(tilde? #f))
(if (null? chars)
chars ;; syntax error?
(throw &syntax-error 'unterminated-iteration)
(if tilde?
(if (eq? (car chars) end)
(cdr chars)
@ -1240,7 +1244,7 @@ accurate information is missing from a given `tree-il' element."
(max-count 0))
(if (null? chars)
(if end-group
(values #f #f) ;; syntax error
(throw &syntax-error 'unterminated-conditional)
(values min-count max-count))
(case state
((tilde)
@ -1286,19 +1290,21 @@ accurate information is missing from a given `tree-il' element."
(if (null? maxs)
0
(apply max maxs))))))
(values #f #f)))))
(values 'any 'any))))) ;; XXX: approximation
0 0))
((#\;)
(if end-group
(loop (cdr chars) 'literal '()
(cons (cons min-count max-count) conditions)
end-group
0 0))
0 0)
(throw &syntax-error 'unexpected-semicolon)))
((#\])
(if end-group
(end-group (cdr chars)
(reverse (cons (cons min-count max-count)
conditions)))
(values #f #f))) ;; syntax error
(throw &syntax-error 'unexpected-conditional-termination)))
((#\{) (if (memq #\@ params)
(values min-count 'any)
(loop (drop-group (cdr chars) #\})
@ -1350,13 +1356,17 @@ accurate information is missing from a given `tree-il' element."
(let ((fmt (const-exp fmt))
(count (length rest)))
(if (string? fmt)
(catch &syntax-error
(lambda ()
(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))))
fmt min max count)))))
(lambda (_ key)
(warning 'format loc 'syntax-error key fmt)))
(warning 'format loc 'wrong-format-string fmt))))
((,port ,fmt . ,rest)
(warning 'format loc 'non-literal-format-string))

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

@ -134,6 +134,18 @@
"~A: warning: ~S: wrong number of `format' arguments: expected ~A, got ~A~%"
loc (escape-newlines fmt)
(range min max) actual))
(('syntax-error 'unterminated-iteration fmt)
(format port "~A: warning: ~S: unterminated iteration~%"
loc (escape-newlines fmt)))
(('syntax-error 'unterminated-conditional fmt)
(format port "~A: warning: ~S: unterminated conditional~%"
loc (escape-newlines fmt)))
(('syntax-error 'unexpected-semicolon fmt)
(format port "~A: warning: ~S: unexpected `~~;'~%"
loc (escape-newlines fmt)))
(('syntax-error 'unexpected-conditional-termination fmt)
(format port "~A: warning: ~S: unexpected `~~]'~%"
loc (escape-newlines fmt)))
(('wrong-port wrong-port)
(format port
"~A: warning: ~S: wrong port argument~%"

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

@ -1261,13 +1261,35 @@
(number? (string-contains (car w)
"expected 2 to 4, got 0")))))
(pass-if "invalid syntax"
;; Syntax errors should be gracefully handled.
(null? (call-with-warnings
(pass-if "unterminated"
(let ((w (call-with-warnings
(lambda ()
(compile '(format #f "~[unterminated")
#:opts %opts-w-format
#:to 'assembly))))))
#:to 'assembly)))))
(and (= (length w) 1)
(number? (string-contains (car w)
"unterminated conditional")))))
(pass-if "unexpected ~;"
(let ((w (call-with-warnings
(lambda ()
(compile '(format #f "foo~;bar")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
(number? (string-contains (car w)
"unexpected")))))
(pass-if "unexpected ~]"
(let ((w (call-with-warnings
(lambda ()
(compile '(format #f "foo~]")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
(number? (string-contains (car w)
"unexpected"))))))
(pass-if "~{...~}"
(null? (call-with-warnings
@ -1305,6 +1327,16 @@
(number? (string-contains (car w)
"expected at least 1, got 0")))))
(pass-if "unterminated ~{...~}"
(let ((w (call-with-warnings
(lambda ()
(compile '(format #f "~{")
#:opts %opts-w-format
#:to 'assembly)))))
(and (= (length w) 1)
(number? (string-contains (car w)
"unterminated")))))
(pass-if "~(...~)"
(null? (call-with-warnings
(lambda ()