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

Have `-Warity-mismatch' handle applicable structs.

Browse source 
* module/language/tree-il/analyze.scm (arity-analysis): Honor applicable
  structs.

* test-suite/tests/tree-il.test ("warnings")["arity
  mismatch"]("top-level applicable struct", "top-level applicable struct
  with wrong arguments"): New tests.
This commit is contained in:
Ludovic Courtès 2012-05-12 15:58:23 +02:00
parent 4c98474782
commit 2c5f0bdb0e
2 changed files with 29 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1194,8 +1194,15 @@ accurate information is missing from a given `tree-il' element."
(false-if-exception
(module-ref env name))))
proc)))
(if (or (lambda? proc*) (procedure? proc*))
(validate-arity proc* application (lambda? proc*)))))
(cond ((lambda? proc*)
(validate-arity proc* application #t))
((struct? proc*)
;; An applicable struct.
(let ((p (struct-ref proc* 0)))
(and (procedure? p)
(validate-arity p application #f))))
((procedure? proc*)
(validate-arity proc* application #f)))))
toplevel-calls)))
(make-arity-info vlist-null vlist-null vlist-null)))

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

@ -1103,6 +1103,26 @@
w "wrong number of arguments to"))))
w)))))
(pass-if "top-level applicable struct"
(null? (call-with-warnings
(lambda ()
(compile '(let ((p current-warning-port))
(p (+ (p) 1))
(p))
#:opts %opts-w-arity
#:to 'assembly)))))
(pass-if "top-level applicable struct with wrong arguments"
(let ((w (call-with-warnings
(lambda ()
(compile '(let ((p current-warning-port))
(p 1 2 3))
#:opts %opts-w-arity
#:to 'assembly)))))
(and (= (length w) 1)
(number? (string-contains (car w)
"wrong number of arguments to")))))
(pass-if "local toplevel-defines"
(let ((w (call-with-warnings
(lambda ()