mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-07-02 23:50:47 +02:00
Add warnings for obvious syntax errors in format strings.
* 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:
parent
60f01304ee
commit
8e6c15a6f0
3 changed files with 76 additions and 22 deletions
|
@ -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))
|
||||
((#\;)
|
||||
(loop (cdr chars) 'literal '()
|
||||
(cons (cons min-count max-count) conditions)
|
||||
end-group
|
||||
0 0))
|
||||
(if end-group
|
||||
(loop (cdr chars) 'literal '()
|
||||
(cons (cons min-count max-count) conditions)
|
||||
end-group
|
||||
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)
|
||||
(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))))
|
||||
(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)))))
|
||||
(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))
|
||||
|
|
|
@ -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~%"
|
||||
|
|
|
@ -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
|
||||
(lambda ()
|
||||
(compile '(format #f "~[unterminated")
|
||||
#:opts %opts-w-format
|
||||
#:to 'assembly))))))
|
||||
(pass-if "unterminated"
|
||||
(let ((w (call-with-warnings
|
||||
(lambda ()
|
||||
(compile '(format #f "~[unterminated")
|
||||
#:opts %opts-w-format
|
||||
#: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 ()
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue