mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00
Code Activity

Add tests for warning locations.

Browse source 
These would have caught <https://bugs.gnu.org/56493>.

* test-suite/tests/tree-il.test ("warnings")("location")["unused
variable", "unbound variable (spaces)", "unbound variable (tabs)"]: New
tests.
This commit is contained in:
Andrew Whatson 2022-10-13 13:12:08 +10:00 • committed by Daniel Llorens
parent a1a85581f1
commit 02f69c1d84
1 changed files with 47 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1519,7 +1519,53 @@
#:to 'cps))))) #:to 'cps)))))
(and (= (length w) 1) (and (= (length w) 1)
(number? (string-contains (car w) (number? (string-contains (car w)
"cannot be meaningfully compared"))))))) "cannot be meaningfully compared"))))))
(with-test-prefix "location"
(define (call-with-fake-input-file filename contents thunk)
(call-with-input-string contents
(lambda (port)
(set-port-filename! port filename)
(thunk port))))
(pass-if "unused variable"
(let ((w (call-with-warnings
(lambda ()
(call-with-fake-input-file
"unused-variable.scm"
"\
(lambda (x)
(let ((y (+ x 2)))
x))"
(lambda (port)
(read-and-compile port #:opts %opts-w-unused #:to 'cps)))))))
(and (= (length w) 1)
(number? (string-contains (car w) "unused variable `y'"))
(number? (string-contains (car w) "unused-variable.scm:2:2")))))
(pass-if "unbound variable (spaces)"
(let ((w (call-with-warnings
(lambda ()
(call-with-fake-input-file
"unbound-spaces.scm"
" (foo)"
(lambda (port)
(read-and-compile port #:opts %opts-w-unbound #:to 'cps)))))))
(and (= (length w) 1)
(number? (string-contains (car w) "unbound variable `foo'"))
(number? (string-contains (car w) "unbound-spaces.scm:1:3")))))
(pass-if "unbound variable (tabs)"
(let ((w (call-with-warnings
(lambda ()
(call-with-fake-input-file
"unbound-tabs.scm"
"\t\t(foo)"
(lambda (port)
(read-and-compile port #:opts %opts-w-unbound #:to 'cps)))))))
(and (= (length w) 1)
(number? (string-contains (car w) "unbound variable `foo'"))
(number? (string-contains (car w) "unbound-tabs.scm:1:17")))))))
;; Local Variables: ;; Local Variables:
;; eval: (put 'pass-if-primitives-resolved 'scheme-indent-function 1) ;; eval: (put 'pass-if-primitives-resolved 'scheme-indent-function 1)