[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Chicken-hackers] [PATCH] Use vertical space more liberally in some
|
From: |
megane |
|
Subject: |
Re: [Chicken-hackers] [PATCH] Use vertical space more liberally in some scrutinizer messages |
|
Date: |
Thu, 10 Jan 2019 18:12:36 +0200 |
|
User-agent: |
mu4e 1.0; emacs 25.1.1 |
Evan Hanson <address@hidden> writes:
> Here's a signed-off version of the first patch in this set. I've also
> updated the Windows test script and added the new files to the
> distribution manifest.
>
> Please feel free to review and apply this one without waiting for the
> others in megane's message. Doing it gradually is the only way we'll get
> through all these.
>
Here's the updated patch set.
I squashed a commit or two, reordered the patches and worked on the
commit messages. Also, I removed the fix for 1563 as it has been merged.
You'll have to redo your changes to the first patch, sorry about that.
It should be about the same changes, however. I don't have a Windows
system handy so I won't try to make the changes myself. (I should update
Ubuntu so I can have a working Vagrant again..)
Do you agree with approach I took about gensym'd variables in the second
patch? If not, I think I'll have to come up with something else.
Cheers
>From 6900fc93c588a44d780bd604a0dadfc5d2fa129e Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Mon, 19 Nov 2018 10:01:33 +0200
Subject: [PATCH 01/17] Add new test test-scrutinizer-message-format.scm
This makes it easy to see how scrutinizer changes affect the user
facing output messages.
* tests/runtests.sh: Move scrutiny-tests-2.scm up so all output is
generated before diffing anything. This way you can update all
.expected messages at the same time.
---
tests/runtests.sh | 6 +-
tests/scrutinizer-message-format.expected | 261 ++++++++++++++++++++++++++++++
tests/test-scrutinizer-message-format.scm | 87 ++++++++++
3 files changed, 352 insertions(+), 2 deletions(-)
create mode 100644 tests/scrutinizer-message-format.expected
create mode 100644 tests/test-scrutinizer-message-format.scm
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 6da7630..c6f9252 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -123,11 +123,13 @@ if test \! -f specialization.expected; then
cp specialization.expected specialization.out
fi
+$compile scrutiny-tests-2.scm -A -verbose 2>scrutiny-2.out
+$compile test-scrutinizer-message-format.scm -A -verbose
2>scrutinizer-message-format.out || true
+
+diff $DIFF_OPTS scrutinizer-message-format.expected
scrutinizer-message-format.out
diff $DIFF_OPTS scrutiny.expected scrutiny.out
diff $DIFF_OPTS specialization.expected specialization.out
-$compile scrutiny-tests-2.scm -A 2>scrutiny-2.out -verbose
-
# this is sensitive to gensym-names, so make it optional
if test \! -f scrutiny-2.expected; then
cp scrutiny-2.expected scrutiny-2.out
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
new file mode 100644
index 0000000..f41fb89
--- /dev/null
+++ b/tests/scrutinizer-message-format.expected
@@ -0,0 +1,261 @@
+
+Warning: literal in operator position: (1 2)
+
+Warning: literal in operator position: (1 2)
+
+Warning: in toplevel procedure `r-proc-call-argument-count-mismatch':
+ (test-scrutinizer-message-format.scm:9) in procedure call to `scheme#cons',
expected 2 arguments but was given 1 argument
+
+Warning: in toplevel procedure `r-proc-call-argument-type-mismatch':
+ (test-scrutinizer-message-format.scm:10) in procedure call to
`scheme#length', expected argument #1 of type `list' but was given an argument
of type `symbol'
+
+Warning: in toplevel procedure `r-proc-call-argument-value-count':
+ (test-scrutinizer-message-format.scm:11) expected a single result in
argument #1 of procedure call `(scheme#list (chicken.time#cpu-time))', but
received 2 results
+
+Warning: in toplevel procedure `r-proc-call-argument-value-count':
+ (test-scrutinizer-message-format.scm:11) expected a single result in
argument #1 of procedure call `(scheme#vector (scheme#values))', but received
zero results
+
+Warning: in toplevel procedure `r-cond-branch-value-count-mismatch':
+ branches in conditional expression differ in the number of results:
+
+(if (the * 1) 1 (chicken.time#cpu-time))
+
+Warning: in toplevel procedure `r-invalid-called-procedure-type':
+ in procedure call to `1', expected a value of type `(procedure (*) *)' but
was given a value of type `fixnum'
+
+Note: in toplevel procedure `r-pred-call-always-true':
+ (test-scrutinizer-message-format.scm:14) in procedure call to
`scheme#list?', the predicate is called with an argument of type `null' and
will always return true
+
+Note: in toplevel procedure `r-pred-call-always-false':
+ (test-scrutinizer-message-format.scm:15) in procedure call to
`scheme#symbol?', the predicate is called with an argument of type `fixnum' and
will always return false
+
+Note: in toplevel procedure `r-cond-test-always-true':
+ expected a value of type boolean in conditional, but was given a value of
type `symbol' which is always true:
+
+(if 'symbol 1 (##core#undefined))
+
+Note: in toplevel procedure `r-cond-test-always-false':
+ in conditional, test expression will always return false:
+
+(if #f 1 (##core#undefined))
+
+Note: in toplevel procedure `r-type-mismatch-in-the':
+ expression returns a result of type `fixnum' but is declared to return
`symbol', which is not compatible
+
+Warning: in toplevel procedure `r-zero-values-for-the':
+ expression returns zero values but is declared to have a single result of
type `symbol'
+
+Warning: in toplevel procedure `r-too-many-values-for-the':
+ expression returns 2 values but is declared to have a single result
+
+Note: in toplevel procedure `r-too-many-values-for-the':
+ expression returns a result of type `fixnum' but is declared to return
`symbol', which is not compatible
+
+Warning: in toplevel procedure `r-toplevel-var-assignment-type-mismatch':
+ assignment of value of type `fixnum' to toplevel variable `foo' does not
match declared type `boolean'
+
+Warning: in toplevel procedure `r-deprecated-identifier':
+ use of deprecated `deprecated-foo'
+
+Warning: in toplevel procedure `r-deprecated-identifier':
+ use of deprecated `deprecated-foo2' - consider `foo'
+
+Warning: at toplevel:
+ assignment of value of type `fixnum' to toplevel variable `foo' does not
match declared type `boolean'
+
+Warning: in toplevel procedure `append-invalid-arg':
+ (test-scrutinizer-message-format.scm:26) in procedure call to
`scheme#append', argument #1 is of type fixnum but expected a proper list
+
+Warning: in local procedure `r-proc-call-argument-count-mismatch',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ (test-scrutinizer-message-format.scm:45) in procedure call to `scheme#cons',
expected 2 arguments but was given 1 argument
+
+Warning: in local procedure `r-proc-call-argument-type-mismatch',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ (test-scrutinizer-message-format.scm:46) in procedure call to
`scheme#string-length', expected argument #1 of type `string' but was given an
argument of type `(procedure chicken.base#add1 (number) number)'
+
+Warning: in local procedure `r-proc-call-argument-value-count',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ (test-scrutinizer-message-format.scm:47) expected a single result in
argument #1 of procedure call `(scheme#list (chicken.time#cpu-time))', but
received 2 results
+
+Warning: in local procedure `r-proc-call-argument-value-count',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ (test-scrutinizer-message-format.scm:47) expected a single result in
argument #1 of procedure call `(scheme#vector (scheme#values))', but received
zero results
+
+Warning: in local procedure `r-cond-branch-value-count-mismatch',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ branches in conditional expression differ in the number of results:
+
+(if (the * 1) 1 (chicken.time#cpu-time))
+
+Warning: in local procedure `variable',
+ in local procedure `r-invalid-called-procedure-type',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ (test-scrutinizer-message-format.scm:50) in procedure call to `m#foo2',
expected a value of type `(procedure (*) *)' but was given a value of type
`boolean'
+
+Warning: in local procedure `non-variable',
+ in local procedure `r-invalid-called-procedure-type',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ in procedure call to `1', expected a value of type `(procedure (*) *)' but
was given a value of type `fixnum'
+
+Note: in local procedure `r-pred-call-always-true',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ (test-scrutinizer-message-format.scm:52) in procedure call to
`scheme#list?', the predicate is called with an argument of type `null' and
will always return true
+
+Note: in local procedure `r-pred-call-always-false',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ (test-scrutinizer-message-format.scm:53) in procedure call to
`scheme#symbol?', the predicate is called with an argument of type `fixnum' and
will always return false
+
+Note: in local procedure `r-cond-test-always-true',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ (test-scrutinizer-message-format.scm:54) expected a value of type boolean in
conditional, but was given a value of type `fixnum' which is always true:
+
+(if (scheme#length '()) 1 (##core#undefined))
+
+Note: in local procedure `r-cond-test-always-false',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ in conditional, test expression will always return false:
+
+(if #f 1 (##core#undefined))
+
+Note: in local procedure `r-type-mismatch-in-the',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expression returns a result of type `fixnum' but is declared to return
`symbol', which is not compatible
+
+Warning: in local procedure `r-toplevel-var-assignment-type-mismatch',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ assignment of value of type `fixnum' to toplevel variable `m#foo2' does not
match declared type `boolean'
+
+Warning: in local procedure `r-deprecated-identifier',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ use of deprecated `m#deprecated-foo'
+
+Warning: in local procedure `r-deprecated-identifier',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ use of deprecated `m#deprecated-foo2' - consider `foo'
+
+Warning: in local procedure `r-zero-values-for-the',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expression returns zero values but is declared to have a single result of
type `symbol'
+
+Warning: in local procedure `zero-values-for-assignment',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expected a single result in assignment to `m#foo', but received zero results
+
+Warning: in local procedure `zero-values-for-conditional',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expected a single result in conditional, but received zero results
+
+Warning: in local procedure `zero-values-for-let',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expected a single result in `let' binding of `a', but received zero results
+
+Warning: in local procedure `r-too-many-values-for-the',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expression returns 2 values but is declared to have a single result
+
+Note: in local procedure `r-too-many-values-for-the',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expression returns a result of type `fixnum' but is declared to return
`symbol', which is not compatible
+
+Warning: in local procedure `too-many-values-for-assignment',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expected a single result in assignment to `m#foo', but received 2 results
+
+Warning: in local procedure `too-many-values-for-conditional',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expected a single result in conditional, but received 2 results
+
+Warning: in local procedure `too-many-values-for-let',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expected a single result in `let' binding of `a', but received 2 results
+
+Warning: in local procedure `zero-values-for-let',
+ in local procedure `r-let-value-count-invalid',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expected a single result in `let' binding of `a', but received zero results
+
+Warning: in local procedure `too-many-values-for-let',
+ in local procedure `r-let-value-count-invalid',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expected a single result in `let' binding of `a', but received 2 results
+
+Warning: in local procedure `zero-values-for-conditional',
+ in local procedure `r-conditional-value-count-invalid',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expected a single result in conditional, but received zero results
+
+Warning: in local procedure `too-many-values-for-conditional',
+ in local procedure `r-conditional-value-count-invalid',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expected a single result in conditional, but received 2 results
+
+Warning: in local procedure `zero-values-for-assignment',
+ in local procedure `r-assignment-value-count-invalid',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expected a single result in assignment to `m#foo', but received zero results
+
+Warning: in local procedure `too-many-values-for-assignment',
+ in local procedure `r-assignment-value-count-invalid',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ expected a single result in assignment to `m#foo', but received 2 results
+
+Warning: in local procedure `append-invalid-arg',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ (test-scrutinizer-message-format.scm:80) in procedure call to
`scheme#append', argument #1 is of type fixnum but expected a proper list
+
+Warning: in local procedure `list-ref-negative-index',
+ in local procedure `vector-list-out-of-range',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ (test-scrutinizer-message-format.scm:82) in procedure call to
`scheme#list-ref', index -1 is negative, which is never valid
+
+Warning: in local procedure `list-ref-out-of-range',
+ in local procedure `vector-list-out-of-range',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ (test-scrutinizer-message-format.scm:83) in procedure call to
`scheme#list-ref', index 1 out of range for proper list of length 0
+
+Warning: in local procedure `vector-ref-out-of-range',
+ in local procedure `vector-list-out-of-range',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ (test-scrutinizer-message-format.scm:84) in procedure call to
`scheme#vector-ref', index -1 out of range for vector of length 0
+
+Error: in local procedure `fail-compiler-typecase',
+ in local procedure `local-bar',
+ in toplevel procedure `m#toplevel-foo':
+ (test-scrutinizer-message-format.scm:86) no clause applies in
`compiler-typecase' for expression of type `fixnum':
+ symbol
+ list
diff --git a/tests/test-scrutinizer-message-format.scm
b/tests/test-scrutinizer-message-format.scm
new file mode 100644
index 0000000..37dbcd2
--- /dev/null
+++ b/tests/test-scrutinizer-message-format.scm
@@ -0,0 +1,87 @@
+(import (chicken time))
+(: deprecated-foo deprecated)
+(define deprecated-foo 1)
+(: deprecated-foo2 (deprecated foo))
+(define deprecated-foo2 2)
+(: foo boolean)
+(define foo #t)
+
+(define (r-proc-call-argument-count-mismatch) (cons '()))
+(define (r-proc-call-argument-type-mismatch) (length 'symbol))
+(define (r-proc-call-argument-value-count) (list (cpu-time)) (vector (values)))
+(define (r-cond-branch-value-count-mismatch) (if (the * 1) 1 (cpu-time)))
+(define (r-invalid-called-procedure-type) (1 2))
+(define (r-pred-call-always-true) (list? '()))
+(define (r-pred-call-always-false) (symbol? 1))
+(define (r-cond-test-always-true) (if 'symbol 1))
+(define (r-cond-test-always-false) (if #f 1))
+(define (r-type-mismatch-in-the) (the symbol 1))
+(define (r-zero-values-for-the) (the symbol (values)))
+(define (r-too-many-values-for-the) (the symbol (values 1 2)))
+(define (r-toplevel-var-assignment-type-mismatch) (set! foo 1))
+(define (r-deprecated-identifier) (list deprecated-foo) (vector
deprecated-foo2))
+
+(set! foo 1)
+
+(define (append-invalid-arg) (append 1 (list 1)))
+
+;; (define (fail-compiler-typecase) (compiler-typecase 1 (symbol 1) (list 2)))
+
+(module
+ m
+ ()
+ (import scheme)
+ (import (chicken base) (chicken type) (chicken time))
+
+ (: foo2 boolean)
+ (define foo2 #t)
+ (: deprecated-foo deprecated)
+ (define deprecated-foo 1)
+ (: deprecated-foo2 (deprecated foo))
+ (define deprecated-foo2 2)
+
+ (define (toplevel-foo)
+ (define (local-bar)
+ (define (r-proc-call-argument-count-mismatch) (cons '()))
+ (define (r-proc-call-argument-type-mismatch) (string-length add1))
+ (define (r-proc-call-argument-value-count) (list (cpu-time)) (vector
(values)))
+ (define (r-cond-branch-value-count-mismatch) (if (the * 1) 1 (cpu-time)))
+ (define (r-invalid-called-procedure-type)
+ (define (variable) (foo2 2))
+ (define (non-variable) (1 2)))
+ (define (r-pred-call-always-true) (list? '()))
+ (define (r-pred-call-always-false) (symbol? 1))
+ (define (r-cond-test-always-true) (if (length '()) 1))
+ (define (r-cond-test-always-false) (if #f 1))
+ (define (r-type-mismatch-in-the) (the symbol 1))
+ (define (r-toplevel-var-assignment-type-mismatch) (set! foo2 1))
+ (define (r-deprecated-identifier) (list deprecated-foo) (vector
deprecated-foo2))
+
+ (define (r-zero-values-for-the) (the symbol (values)))
+ (define (zero-values-for-assignment) (set! foo (values)))
+ (define (zero-values-for-conditional) (if (values) 1))
+ (define (zero-values-for-let) (let ((a (values))) a))
+
+ (define (r-too-many-values-for-the) (the symbol (values 1 2)))
+ (define (too-many-values-for-assignment) (set! foo (values #t 2)))
+ (define (too-many-values-for-conditional) (if (values (the * 1) 2) 1))
+ (define (too-many-values-for-let) (let ((a (values 1 2))) a))
+
+ (define (r-let-value-count-invalid)
+ (define (zero-values-for-let) (let ((a (values))) a))
+ (define (too-many-values-for-let) (let ((a (values 1 2))) a)))
+ (define (r-conditional-value-count-invalid)
+ (define (zero-values-for-conditional) (if (values) 1))
+ (define (too-many-values-for-conditional) (if (values (the * 1) 2) 1)))
+ (define (r-assignment-value-count-invalid)
+ (define (zero-values-for-assignment) (set! foo (values)))
+ (define (too-many-values-for-assignment) (set! foo (values #t 2))))
+
+ (define (append-invalid-arg) (append 1 (list 1)))
+ (define (vector-list-out-of-range)
+ (define (list-ref-negative-index) (list-ref '() -1))
+ (define (list-ref-out-of-range) (list-ref '() 1))
+ (define (vector-ref-out-of-range) (vector-ref (vector) -1)))
+
+ (define (fail-compiler-typecase) (compiler-typecase 1 (symbol 1) (list
2)))
+ )))
--
2.7.4
>From 68bde90a1dd83d07434631268f048bc24e719b38 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Wed, 28 Nov 2018 17:28:03 +0200
Subject: [PATCH 02/17] tests/runtests.sh: Sanitize gensyms from scrutinizer
outputs
Instead of skipping tests that are sensitive to gensyms altogether try
to sanitize the output.
For scrutinizer-message-format.scm, sanitize a and b because they are
used in typevars. This sanitation for "b" and "a" is removed once the
scrutinizer sanitizes typevars in messages internally again (fix for
issue 1563 broke this).
Also sanitize ":" so that adding/removing stuff doesn't cause million
diff conflicts because of changed line numbers.
* tests/redact-gensyms.scm: New small program to replace numbers from
common gensym prefixes
* [tests] runtests.sh: compile, use redact-gensyms
---
tests/redact-gensyms.scm | 25 ++++++++++++++++++
tests/runtests.sh | 29 ++++++++-------------
tests/scrutinizer-message-format.expected | 42 ++++++++++++++++---------------
tests/scrutiny-2.expected | 2 ++
tests/scrutiny.expected | 6 +++--
tests/specialization.expected | 2 ++
6 files changed, 66 insertions(+), 40 deletions(-)
create mode 100644 tests/redact-gensyms.scm
diff --git a/tests/redact-gensyms.scm b/tests/redact-gensyms.scm
new file mode 100644
index 0000000..c6abb7b
--- /dev/null
+++ b/tests/redact-gensyms.scm
@@ -0,0 +1,25 @@
+(module
+ redact-gensyms
+ ()
+ (import scheme)
+ (import (chicken base))
+ (import (chicken irregex))
+ (import (chicken type))
+ (import (only (chicken io) read-line)
+ (only (chicken process-context) command-line-arguments)
+ (only (chicken string) string-split))
+
+ (define prefixes (if (null? (command-line-arguments))
+ '("tmp" "g")
+ (string-split (car (command-line-arguments)) ",")))
+
+ (let ((rege (irregex `(: ($ (or ,@prefixes)) (+ numeric)))))
+ (print ";; numbers replaced with XXX by redact-gensyms.scm")
+ (print ";; prefixes: " prefixes)
+ (let lp ()
+ (let ((l (read-line)))
+ (if (not (eof-object? l))
+ (begin
+ (print (irregex-replace/all rege l 1 "XXX"))
+ (lp))))))
+ )
diff --git a/tests/runtests.sh b/tests/runtests.sh
index c6f9252..6c23a78 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -114,28 +114,21 @@ $compile typematch-tests.scm -specialize -no-warnings
$compile scrutiny-tests.scm -analyze-only -verbose 2>scrutiny.out
$compile specialization-tests.scm -analyze-only -verbose -specialize
2>specialization.out
-
-# these are sensitive to gensym-names, so make them optional
-if test \! -f scrutiny.expected; then
- cp scrutiny.expected scrutiny.out
-fi
-if test \! -f specialization.expected; then
- cp specialization.expected specialization.out
-fi
-
$compile scrutiny-tests-2.scm -A -verbose 2>scrutiny-2.out
$compile test-scrutinizer-message-format.scm -A -verbose
2>scrutinizer-message-format.out || true
-diff $DIFF_OPTS scrutinizer-message-format.expected
scrutinizer-message-format.out
-diff $DIFF_OPTS scrutiny.expected scrutiny.out
-diff $DIFF_OPTS specialization.expected specialization.out
+# Replace foo123 -> fooXX so gensyms don't trigger failures
+$compile redact-gensyms.scm
+mv a.out redact-gensyms
+./redact-gensyms "tmp,g,a,b,:" < scrutinizer-message-format.out >
scrutinizer-message-format.redacted
+./redact-gensyms < scrutiny-2.out > scrutiny-2.redacted
+./redact-gensyms < scrutiny.out > scrutiny.redacted
+./redact-gensyms < specialization.out > specialization.redacted
-# this is sensitive to gensym-names, so make it optional
-if test \! -f scrutiny-2.expected; then
- cp scrutiny-2.expected scrutiny-2.out
-fi
-
-diff $DIFF_OPTS scrutiny-2.expected scrutiny-2.out
+diff $DIFF_OPTS scrutinizer-message-format.expected
scrutinizer-message-format.redacted
+diff $DIFF_OPTS scrutiny-2.expected scrutiny-2.redacted
+diff $DIFF_OPTS scrutiny.expected scrutiny.redacted
+diff $DIFF_OPTS specialization.expected specialization.redacted
$compile scrutiny-tests-3.scm -specialize -block
./a.out
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
index f41fb89..74617d0 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -1,19 +1,21 @@
+;; numbers replaced with XXX by redact-gensyms.scm
+;; prefixes: (tmp g a b :)
Warning: literal in operator position: (1 2)
Warning: literal in operator position: (1 2)
Warning: in toplevel procedure `r-proc-call-argument-count-mismatch':
- (test-scrutinizer-message-format.scm:9) in procedure call to `scheme#cons',
expected 2 arguments but was given 1 argument
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#cons', expected 2 arguments but was given 1 argument
Warning: in toplevel procedure `r-proc-call-argument-type-mismatch':
- (test-scrutinizer-message-format.scm:10) in procedure call to
`scheme#length', expected argument #1 of type `list' but was given an argument
of type `symbol'
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#length', expected argument #1 of type `list' but was given an argument
of type `symbol'
Warning: in toplevel procedure `r-proc-call-argument-value-count':
- (test-scrutinizer-message-format.scm:11) expected a single result in
argument #1 of procedure call `(scheme#list (chicken.time#cpu-time))', but
received 2 results
+ (test-scrutinizer-message-format.scm:XXX) expected a single result in
argument #1 of procedure call `(scheme#list (chicken.time#cpu-time))', but
received 2 results
Warning: in toplevel procedure `r-proc-call-argument-value-count':
- (test-scrutinizer-message-format.scm:11) expected a single result in
argument #1 of procedure call `(scheme#vector (scheme#values))', but received
zero results
+ (test-scrutinizer-message-format.scm:XXX) expected a single result in
argument #1 of procedure call `(scheme#vector (scheme#values))', but received
zero results
Warning: in toplevel procedure `r-cond-branch-value-count-mismatch':
branches in conditional expression differ in the number of results:
@@ -24,10 +26,10 @@ Warning: in toplevel procedure
`r-invalid-called-procedure-type':
in procedure call to `1', expected a value of type `(procedure (*) *)' but
was given a value of type `fixnum'
Note: in toplevel procedure `r-pred-call-always-true':
- (test-scrutinizer-message-format.scm:14) in procedure call to
`scheme#list?', the predicate is called with an argument of type `null' and
will always return true
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#list?', the predicate is called with an argument of type `null' and
will always return true
Note: in toplevel procedure `r-pred-call-always-false':
- (test-scrutinizer-message-format.scm:15) in procedure call to
`scheme#symbol?', the predicate is called with an argument of type `fixnum' and
will always return false
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#symbol?', the predicate is called with an argument of type `fixnum' and
will always return false
Note: in toplevel procedure `r-cond-test-always-true':
expected a value of type boolean in conditional, but was given a value of
type `symbol' which is always true:
@@ -64,27 +66,27 @@ Warning: at toplevel:
assignment of value of type `fixnum' to toplevel variable `foo' does not
match declared type `boolean'
Warning: in toplevel procedure `append-invalid-arg':
- (test-scrutinizer-message-format.scm:26) in procedure call to
`scheme#append', argument #1 is of type fixnum but expected a proper list
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#append', argument #1 is of type fixnum but expected a proper list
Warning: in local procedure `r-proc-call-argument-count-mismatch',
in local procedure `local-bar',
in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:45) in procedure call to `scheme#cons',
expected 2 arguments but was given 1 argument
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#cons', expected 2 arguments but was given 1 argument
Warning: in local procedure `r-proc-call-argument-type-mismatch',
in local procedure `local-bar',
in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:46) in procedure call to
`scheme#string-length', expected argument #1 of type `string' but was given an
argument of type `(procedure chicken.base#add1 (number) number)'
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#string-length', expected argument #1 of type `string' but was given an
argument of type `(procedure chicken.base#add1 (number) number)'
Warning: in local procedure `r-proc-call-argument-value-count',
in local procedure `local-bar',
in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:47) expected a single result in
argument #1 of procedure call `(scheme#list (chicken.time#cpu-time))', but
received 2 results
+ (test-scrutinizer-message-format.scm:XXX) expected a single result in
argument #1 of procedure call `(scheme#list (chicken.time#cpu-time))', but
received 2 results
Warning: in local procedure `r-proc-call-argument-value-count',
in local procedure `local-bar',
in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:47) expected a single result in
argument #1 of procedure call `(scheme#vector (scheme#values))', but received
zero results
+ (test-scrutinizer-message-format.scm:XXX) expected a single result in
argument #1 of procedure call `(scheme#vector (scheme#values))', but received
zero results
Warning: in local procedure `r-cond-branch-value-count-mismatch',
in local procedure `local-bar',
@@ -97,7 +99,7 @@ Warning: in local procedure `variable',
in local procedure `r-invalid-called-procedure-type',
in local procedure `local-bar',
in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:50) in procedure call to `m#foo2',
expected a value of type `(procedure (*) *)' but was given a value of type
`boolean'
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to `m#foo2',
expected a value of type `(procedure (*) *)' but was given a value of type
`boolean'
Warning: in local procedure `non-variable',
in local procedure `r-invalid-called-procedure-type',
@@ -108,17 +110,17 @@ Warning: in local procedure `non-variable',
Note: in local procedure `r-pred-call-always-true',
in local procedure `local-bar',
in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:52) in procedure call to
`scheme#list?', the predicate is called with an argument of type `null' and
will always return true
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#list?', the predicate is called with an argument of type `null' and
will always return true
Note: in local procedure `r-pred-call-always-false',
in local procedure `local-bar',
in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:53) in procedure call to
`scheme#symbol?', the predicate is called with an argument of type `fixnum' and
will always return false
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#symbol?', the predicate is called with an argument of type `fixnum' and
will always return false
Note: in local procedure `r-cond-test-always-true',
in local procedure `local-bar',
in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:54) expected a value of type boolean in
conditional, but was given a value of type `fixnum' which is always true:
+ (test-scrutinizer-message-format.scm:XXX) expected a value of type boolean
in conditional, but was given a value of type `fixnum' which is always true:
(if (scheme#length '()) 1 (##core#undefined))
@@ -233,29 +235,29 @@ Warning: in local procedure
`too-many-values-for-assignment',
Warning: in local procedure `append-invalid-arg',
in local procedure `local-bar',
in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:80) in procedure call to
`scheme#append', argument #1 is of type fixnum but expected a proper list
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#append', argument #1 is of type fixnum but expected a proper list
Warning: in local procedure `list-ref-negative-index',
in local procedure `vector-list-out-of-range',
in local procedure `local-bar',
in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:82) in procedure call to
`scheme#list-ref', index -1 is negative, which is never valid
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#list-ref', index -1 is negative, which is never valid
Warning: in local procedure `list-ref-out-of-range',
in local procedure `vector-list-out-of-range',
in local procedure `local-bar',
in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:83) in procedure call to
`scheme#list-ref', index 1 out of range for proper list of length 0
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#list-ref', index 1 out of range for proper list of length 0
Warning: in local procedure `vector-ref-out-of-range',
in local procedure `vector-list-out-of-range',
in local procedure `local-bar',
in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:84) in procedure call to
`scheme#vector-ref', index -1 out of range for vector of length 0
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#vector-ref', index -1 out of range for vector of length 0
Error: in local procedure `fail-compiler-typecase',
in local procedure `local-bar',
in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:86) no clause applies in
`compiler-typecase' for expression of type `fixnum':
+ (test-scrutinizer-message-format.scm:XXX) no clause applies in
`compiler-typecase' for expression of type `fixnum':
symbol
list
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index 9058276..5059f30 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -1,3 +1,5 @@
+;; numbers replaced with XXX by redact-gensyms.scm
+;; prefixes: (tmp g)
Note: at toplevel:
(scrutiny-tests-2.scm:20) in procedure call to `scheme#pair?', the predicate
is called with an argument of type `pair' and will always return true
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index e445ebb..777aeb4 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -1,3 +1,5 @@
+;; numbers replaced with XXX by redact-gensyms.scm
+;; prefixes: (tmp g)
Warning: (scrutiny-tests.scm:31) - assignment to imported value binding `car'
@@ -43,10 +45,10 @@ Warning: at toplevel:
assignment of value of type `fixnum' to toplevel variable `scheme#car' does
not match declared type `(forall (a335) (procedure scheme#car ((pair a335 *))
a335))'
Warning: at toplevel:
- expected a single result in `let' binding of `g19', but received 2 results
+ expected a single result in `let' binding of `gXXX', but received 2 results
Warning: at toplevel:
- in procedure call to `g19', expected a value of type `(procedure () *)' but
was given a value of type `fixnum'
+ in procedure call to `gXXX', expected a value of type `(procedure () *)' but
was given a value of type `fixnum'
Note: in toplevel procedure `foo':
expected a value of type boolean in conditional, but was given a value of
type `(procedure bar () *)' which is always true:
diff --git a/tests/specialization.expected b/tests/specialization.expected
index fed76b6..b3a395a 100644
--- a/tests/specialization.expected
+++ b/tests/specialization.expected
@@ -1,3 +1,5 @@
+;; numbers replaced with XXX by redact-gensyms.scm
+;; prefixes: (tmp g)
Note: at toplevel:
(specialization-tests.scm:3) in procedure call to `scheme#string?', the
predicate is called with an argument of type `string' and will always return
true
--
2.7.4
>From f0bde385b00a2540dae9e0e7587c2771a32c9d9e Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Fri, 16 Nov 2018 18:07:23 +0200
Subject: [PATCH 03/17] Extract most scrutinizer messages into separate
functions
Two main benefits from doing this:
- The message formatting logic doesn't muddy the actual scrutinizer
logic.
- Giving a name has a documentation benefit. If you refer to that name
in tests you can grep for an examples of what might cause that error
message.
* scrutinizer.scm (scrutinize): Copy report, report-notice to toplevel
as report2, report-notice2
* scrutinizer.scm: Add global *complain?*, needed by report2,
report-notice2
* scrutinizer.scm (scrutinize): Remove report-error so 'errors'
variable doesn't need to be made global
- As a side effect (the symbol 1) now always gives a warning, which
I think is for the best; If you annotate a * return value to have
some type with 'the, there will be no warning without -verbose if
the return value changes to some explicit, and possibly
incompatible, type.
A trivial example:
You want to write this:
(+ 1 (foo))
You also know foo returns a fixnum, but foo does not have a type
annotation. So you might annotate the return value yourself:
(+ 1 (the fixnum (foo)))
Now the + is likely specialized to fx+, which is fine.
Now the api for foo changes: foo returns a string and is given a
type annotation (-> string).
Now your code that annotates the return type is wrong. You are
calling fx+ with a string value. That will lead to undefined
behaviour. Before this commit you'll only see a warning when you use
the -verbose flag.
* scrutinizer.scm: Move multiples, node-source-prefix, location-name,
fragment, pp-fragment under comment "Report helpers"
---
scrutinizer.scm | 296 ++++++++++++++++++------------
tests/scrutinizer-message-format.expected | 8 +-
tests/scrutiny.expected | 2 +-
3 files changed, 180 insertions(+), 126 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index a8c8b3d..094c733 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -53,6 +53,7 @@
(define d-depth 0)
(define scrutiny-debug #t)
+(define *complain?* #f)
(define (d fstr . args)
(when (and scrutiny-debug (##sys#debug-mode?))
@@ -162,9 +163,6 @@
(define specialization-statistics '())
(define trail '())
-(define (multiples n)
- (if (= n 1) "" "s"))
-
(define (walked-result n)
(first (node-parameters n))) ; assumes ##core#the/result node
@@ -177,25 +175,20 @@
((memq t '(eof null fixnum char boolean undefined)) #t)
(else #f)))
-(define (node-source-prefix n)
- (let ((line (node-line-number n)))
- (if (not line) "" (sprintf "(~a) " line))))
-
-(define (location-name loc)
- (define (lname loc1)
- (if loc1
- (sprintf "procedure `~a'" (real-name loc1))
- "unknown procedure"))
- (cond ((null? loc) "at toplevel:\n ")
- ((null? (cdr loc))
- (sprintf "in toplevel ~a:\n " (lname (car loc))))
- (else
- (let rec ((loc loc))
- (if (null? (cdr loc))
- (location-name loc)
- (sprintf "in local ~a,\n ~a" (lname (car loc)) (rec (cdr
loc))))))))
-
(define (scrutinize node db complain specialize strict block-compilation)
+ (set! *complain?* complain)
+ (define (report-notice loc msg . args)
+ (when complain
+ (##sys#notice
+ (conc (location-name loc)
+ (sprintf "~?" msg (map type-name args))))))
+
+ (define (report loc msg . args)
+ (when complain
+ (warning
+ (conc (location-name loc)
+ (sprintf "~?" msg (map type-name args))))))
+
(let ((blist '()) ; (((VAR . FLOW) TYPE) ...)
(aliased '())
(noreturn #f)
@@ -284,17 +277,12 @@
(define (always-true if-node test-node t loc)
(and-let* ((_ (always-true1 t)))
- (report-notice
- loc "~aexpected a value of type boolean in conditional, but \
- was given a value of type `~a' which is always true:~%~%~a"
- (node-source-prefix test-node) t (pp-fragment if-node))
+ (r-cond-test-always-true loc test-node t if-node)
#t))
(define (always-false if-node test-node t loc)
(and-let* ((_ (eq? t 'false)))
- (report-notice
- loc "~ain conditional, test expression will always return false:~%~%~a"
- (node-source-prefix test-node) (pp-fragment if-node))
+ (r-cond-test-always-false loc test-node if-node)
#t))
(define (always-immediate var t loc)
@@ -320,43 +308,8 @@
(node-source-prefix node) what n (multiples n))
(first tv))))))
- (define (report-notice loc msg . args)
- (when complain
- (##sys#notice
- (conc (location-name loc)
- (sprintf "~?" msg (map type-name args))))))
-
- (define (report loc msg . args)
- (when complain
- (warning
- (conc (location-name loc)
- (sprintf "~?" msg (map type-name args))))))
-
- (define (report-error loc msg . args)
- (set! errors #t)
- (apply report loc msg args))
-
(define add-loc cons)
- (define (fragment x)
- (let ((x (build-expression-tree (source-node-tree x))))
- (let walk ((x x) (d 0))
- (cond ((atom? x) (strip-syntax x))
- ((>= d +fragment-max-depth+) '...)
- ((list? x)
- (let* ((len (length x))
- (xs (if (< +fragment-max-length+ len)
- (append (take x +fragment-max-length+) '(...))
- x)))
- (map (cute walk <> (add1 d)) xs)))
- (else (strip-syntax x))))))
-
- (define (pp-fragment x)
- (string-chomp
- (with-output-to-string
- (lambda ()
- (pp (fragment x))))))
-
(define (get-specializations name)
(let* ((a (variable-mark name '##compiler#local-specializations))
(b (variable-mark name '##compiler#specializations))
@@ -377,23 +330,14 @@
(op #f))
(d " call: ~a, te: ~a" actualtypes typeenv)
(cond ((and (not pptype?) (not (match-types xptype ptype typeenv)))
- (report
- loc
- "~aexpected a value of type `~a' but was given a value of type
`~a'"
- (pname)
- (resolve xptype typeenv)
- (resolve ptype typeenv))
+ (r-invalid-called-procedure-type
+ loc (pname) (resolve xptype typeenv) (resolve ptype typeenv))
(values '* #f))
(else
(let-values (((atypes values-rest ok alen)
(procedure-argument-types ptype nargs typeenv)))
(unless ok
- (report
- loc
- "~aexpected ~a argument~a but was given ~a argument~a"
- (pname)
- alen (multiples alen)
- nargs (multiples nargs)))
+ (r-proc-call-argument-count-mismatch loc (pname) alen nargs))
(do ((actualtypes (cdr actualtypes) (cdr actualtypes))
(atypes atypes (cdr atypes))
(i 1 (add1 i)))
@@ -402,11 +346,8 @@
(car atypes)
(car actualtypes)
typeenv)
- (report
- loc
- "~aexpected argument #~a of type `~a' but was given an
argument of type `~a'"
- (pname)
- i
+ (r-proc-call-argument-type-mismatch
+ loc (pname) i
(resolve (car atypes) typeenv)
(resolve (car actualtypes) typeenv))))
(when (noreturn-procedure-type? ptype)
@@ -419,11 +360,7 @@
(variable-mark pn '##compiler#predicate)) =>
(lambda (pt)
(cond ((match-argument-types (list pt)
(cdr actualtypes) typeenv)
- (report-notice
- loc
- "~athe predicate is called with an
argument of type `~a' \
- and will always return true"
- (pname) (cadr actualtypes))
+ (r-pred-call-always-true loc
(pname) (cadr actualtypes))
(when specialize
(specialize-node!
node (cdr args)
@@ -433,11 +370,7 @@
((begin
(trail-restore trail0 typeenv)
(match-argument-types (list `(not
,pt)) (cdr actualtypes) typeenv))
- (report-notice
- loc
- "~athe predicate is called with an
argument of type `~a' \
- and will always return false"
- (pname) (cadr actualtypes))
+ (r-pred-call-always-false loc
(pname) (cadr actualtypes))
(when specialize
(specialize-node!
node (cdr args)
@@ -568,10 +501,7 @@
;;(dd " branches: ~s:~s / ~s:~s" nor1 r1
nor2 r2)
(cond ((and (not nor1) (not nor2)
(not (= (length r1) (length
r2))))
- (report
- loc
- "branches in conditional expression
differ in the number of results:~%~%~a"
- (pp-fragment n))
+ (r-cond-branch-value-count-mismatch
loc n)
'*)
(nor1 r2)
(nor2 r1)
@@ -670,11 +600,8 @@
(and (pair? type)
(eq? (car type) 'deprecated))))
(not (match-types type rt typeenv)))
- ((if strict report-error report)
- loc
- "assignment of value of type `~a' to toplevel variable
`~a' \
- does not match declared type `~a'"
- rt var type))
+ (when strict (set! errors #t))
+ (r-toplevel-var-assignment-type-mismatch loc rt var type))
(when (and (not type) ;XXX global declaration could allow
this
(not b)
(not (eq? '* rt))
@@ -837,24 +764,14 @@
(let ((t (first params))
(rt (walk (first subs) e loc dest tail flow ctags)))
(cond ((eq? rt '*))
- ((null? rt)
- (report
- loc
- "expression returns zero values but is declared to
have \
- a single result of type `~a'" t))
+ ((null? rt) (r-zero-values-for-the loc t))
(else
(when (> (length rt) 1)
- (report
- loc
- "expression returns ~a values but is declared to
have \
- a single result" (length rt)))
+ (r-too-many-values-for-the loc rt))
(when (and (second params)
(not (compatible-types? t (first rt))))
- ((if strict report-error report-notice)
- loc
- "expression returns a result of type `~a' but is \
- declared to return `~a', which is not compatible"
- (first rt) t))))
+ (when strict (set! errors #t))
+ (r-type-mismatch-in-the loc (first rt) t))))
(list t)))
((##core#typecase)
(let* ((ts (walk (first subs) e loc #f #f flow ctags))
@@ -863,14 +780,7 @@
;; first exp is always a variable so ts must be of length 1
(let loop ((types (cdr params)) (subs (cdr subs)))
(if (null? types)
- (quit-compiling
- "~a~ano clause applies in `compiler-typecase' for
expression of type `~a':~a"
- (location-name loc)
- (node-source-prefix n)
- (type-name (car ts))
- (string-intersperse
- (map (lambda (t) (sprintf "\n ~a" (type-name t)))
- (cdr params)) ""))
+ (fail-compiler-typecase loc n (car ts) (cdr params))
(let ((typeenv (append (type-typeenv (car types))
typeenv0)))
(if (match-types (car types) (car ts) typeenv #t)
(begin ; drops exp
@@ -2484,4 +2394,148 @@
(else
(restore)
(loop (cdr ts) ok))))))
+
+;;; Report helpers
+(define (multiples n)
+ (if (= n 1) "" "s"))
+
+(define (fragment x)
+ (let ((x (build-expression-tree (source-node-tree x))))
+ (let walk ((x x) (d 0))
+ (cond ((atom? x) (strip-syntax x))
+ ((>= d +fragment-max-depth+) '...)
+ ((list? x)
+ (let* ((len (length x))
+ (xs (if (< +fragment-max-length+ len)
+ (append (take x +fragment-max-length+) '(...))
+ x)))
+ (map (cute walk <> (add1 d)) xs)))
+ (else (strip-syntax x))))))
+
+(define (pp-fragment x)
+ (string-chomp
+ (with-output-to-string
+ (lambda ()
+ (pp (fragment x))))))
+
+(define (node-source-prefix n)
+ (let ((line (node-line-number n)))
+ (if (not line) "" (sprintf "(~a) " line))))
+
+(define (location-name loc)
+ (define (lname loc1)
+ (if loc1
+ (sprintf "procedure `~a'" (real-name loc1))
+ "unknown procedure"))
+ (cond ((null? loc) "at toplevel:\n ")
+ ((null? (cdr loc))
+ (sprintf "in toplevel ~a:\n " (lname (car loc))))
+ (else
+ (let rec ((loc loc))
+ (if (null? (cdr loc))
+ (location-name loc)
+ (sprintf "in local ~a,\n ~a" (lname (car loc)) (rec (cdr
loc))))))))
+
+(define (report2 loc msg . args)
+ (when *complain?*
+ (warning
+ (conc (location-name loc)
+ (sprintf "~?" msg (map type-name args))))))
+
+(define (report-notice2 loc msg . args)
+ (when *complain?*
+ (##sys#notice
+ (conc (location-name loc)
+ (sprintf "~?" msg (map type-name args))))))
+
+;;; Reports
+
+(define (r-invalid-called-procedure-type loc pname xptype ptype)
+ (report2
+ loc
+ "~aexpected a value of type `~a' but was given a value of type `~a'"
+ pname xptype ptype))
+
+(define (r-proc-call-argument-count-mismatch loc pname exp-count argc)
+ (report2
+ loc
+ "~aexpected ~a argument~a but was given ~a argument~a"
+ pname
+ exp-count (multiples exp-count)
+ argc (multiples argc)))
+
+(define (r-proc-call-argument-type-mismatch loc pname i xptype atype)
+ (report2
+ loc
+ "~aexpected argument #~a of type `~a' but was given an argument of type
`~a'"
+ pname i xptype atype))
+
+(define (r-pred-call-always-true loc pname atype)
+ (report-notice2
+ loc
+ "~athe predicate is called with an argument of type `~a' \
+ and will always return true"
+ pname atype))
+
+(define (r-pred-call-always-false loc pname atype)
+ (report-notice2
+ loc
+ "~athe predicate is called with an argument of type `~a' \
+ and will always return false"
+ pname atype))
+
+(define (r-cond-test-always-true loc test-node t if-node)
+ (report-notice2
+ loc "~aexpected a value of type boolean in conditional, but \
+ was given a value of type `~a' which is always true:~%~%~a"
+ (node-source-prefix test-node) t (pp-fragment if-node)))
+
+(define (r-cond-test-always-false loc test-node if-node)
+ (report-notice2
+ loc "~ain conditional, test expression will always return false:~%~%~a"
+ (node-source-prefix test-node) (pp-fragment if-node)))
+
+(define (r-zero-values-for-the loc the-type)
+ ;; (the t r) expects r returns exactly 1 value
+ (report2
+ loc
+ "expression returns zero values but is declared to have \
+ a single result of type `~a'"
+ the-type))
+
+(define (r-too-many-values-for-the loc rtypes)
+ (report2
+ loc
+ "expression returns ~a values but is declared to have \
+ a single result" (length rtypes)))
+
+(define (r-type-mismatch-in-the loc first-rtype the-type)
+ ;; NOTE: Now always reports
+ (report2
+ loc
+ "expression returns a result of type `~a' but is \
+ declared to return `~a', which is not compatible"
+ first-rtype the-type))
+
+(define (fail-compiler-typecase loc node atype ct-types)
+ (quit-compiling
+ "~a~ano clause applies in `compiler-typecase' for expression of type
`~a':~a"
+ (location-name loc)
+ (node-source-prefix node)
+ (type-name atype)
+ (string-intersperse (map (lambda (t) (sprintf "\n ~a" (type-name t)))
ct-types)
+ "")))
+
+(define (r-cond-branch-value-count-mismatch loc node)
+ (report2
+ loc
+ "branches in conditional expression differ in the number of results:~%~%~a"
+ (pp-fragment node)))
+
+(define (r-toplevel-var-assignment-type-mismatch loc atype var xptype)
+ (report2
+ loc
+ "assignment of value of type `~a' to toplevel variable `~a' \
+ does not match declared type `~a'"
+ atype var xptype))
)
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
index 74617d0..9dcd617 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -41,7 +41,7 @@ Note: in toplevel procedure `r-cond-test-always-false':
(if #f 1 (##core#undefined))
-Note: in toplevel procedure `r-type-mismatch-in-the':
+Warning: in toplevel procedure `r-type-mismatch-in-the':
expression returns a result of type `fixnum' but is declared to return
`symbol', which is not compatible
Warning: in toplevel procedure `r-zero-values-for-the':
@@ -50,7 +50,7 @@ Warning: in toplevel procedure `r-zero-values-for-the':
Warning: in toplevel procedure `r-too-many-values-for-the':
expression returns 2 values but is declared to have a single result
-Note: in toplevel procedure `r-too-many-values-for-the':
+Warning: in toplevel procedure `r-too-many-values-for-the':
expression returns a result of type `fixnum' but is declared to return
`symbol', which is not compatible
Warning: in toplevel procedure `r-toplevel-var-assignment-type-mismatch':
@@ -131,7 +131,7 @@ Note: in local procedure `r-cond-test-always-false',
(if #f 1 (##core#undefined))
-Note: in local procedure `r-type-mismatch-in-the',
+Warning: in local procedure `r-type-mismatch-in-the',
in local procedure `local-bar',
in toplevel procedure `m#toplevel-foo':
expression returns a result of type `fixnum' but is declared to return
`symbol', which is not compatible
@@ -176,7 +176,7 @@ Warning: in local procedure `r-too-many-values-for-the',
in toplevel procedure `m#toplevel-foo':
expression returns 2 values but is declared to have a single result
-Note: in local procedure `r-too-many-values-for-the',
+Warning: in local procedure `r-too-many-values-for-the',
in local procedure `local-bar',
in toplevel procedure `m#toplevel-foo':
expression returns a result of type `fixnum' but is declared to return
`symbol', which is not compatible
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 777aeb4..da6c472 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -79,7 +79,7 @@ Warning: in toplevel procedure `foo10':
Warning: in toplevel procedure `foo10':
(scrutiny-tests.scm:105) in procedure call to `scheme#+', expected argument
#1 of type `number' but was given an argument of type `string'
-Note: in toplevel procedure `foo10':
+Warning: in toplevel procedure `foo10':
expression returns a result of type `string' but is declared to return
`pair', which is not compatible
Warning: in toplevel procedure `foo10':
--
2.7.4
>From 7320f159d06fa3204ec17956759bd239fd00923a Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Mon, 19 Nov 2018 11:18:51 +0200
Subject: [PATCH 04/17] Print types in scrutinizer messages with pp
Using pp to print types starts to shine when you're getting bigger
list, vector or procedure types.
Also, try to always print a relevant code fragment. This helps to find
the actual code the warning is originating from, or help debug the
issue when the actual code is just a macro call.
* scrutinizer.scm: Remove type-name. Its functionality is moved to
type->pp-string
* scrutinizer.scm (string-add-indent) : New function
* scrutinizer.scm (type->pp-string) : New function
* scrutinizer.scm (pp-fragment): do indenting
* scrutinizer.scm (location-name): Print locations from toplevel to
most local level order
---
scrutinizer.scm | 445 ++++++++++----
tests/scrutinizer-message-format.expected | 704 +++++++++++++++------
tests/scrutiny-2.expected | 396 ++++++++++--
tests/scrutiny.expected | 977 ++++++++++++++++++++++++++----
tests/specialization.expected | 118 +++-
5 files changed, 2158 insertions(+), 482 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 094c733..54eec7d 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -154,12 +154,6 @@
(define-inline (value-type? t)
(or (struct-type? t) (memq t value-types)))
-(define (type-name x)
- (let ((t (strip-syntax x)))
- (if (refinement-type? t)
- (sprintf "~a-~a" (string-intersperse (map conc (second t)) "/") (third
t))
- (sprintf "~a" t))))
-
(define specialization-statistics '())
(define trail '())
@@ -176,18 +170,19 @@
(else #f)))
(define (scrutinize node db complain specialize strict block-compilation)
+ (d "################################## SCRUTINIZE
##################################")
(set! *complain?* complain)
(define (report-notice loc msg . args)
(when complain
(##sys#notice
(conc (location-name loc)
- (sprintf "~?" msg (map type-name args))))))
+ (sprintf "~?" msg args)))))
(define (report loc msg . args)
(when complain
(warning
(conc (location-name loc)
- (sprintf "~?" msg (map type-name args))))))
+ (sprintf "~?" msg args)))))
(let ((blist '()) ; (((VAR . FLOW) TYPE) ...)
(aliased '())
@@ -277,12 +272,12 @@
(define (always-true if-node test-node t loc)
(and-let* ((_ (always-true1 t)))
- (r-cond-test-always-true loc test-node t if-node)
+ (r-cond-test-always-true loc if-node test-node t)
#t))
(define (always-false if-node test-node t loc)
(and-let* ((_ (eq? t 'false)))
- (r-cond-test-always-false loc test-node if-node)
+ (r-cond-test-always-false loc if-node test-node)
#t))
(define (always-immediate var t loc)
@@ -318,9 +313,7 @@
(define (call-result node args e loc params typeenv)
(define (pname)
- (sprintf "~ain procedure call to `~s', "
- (node-source-prefix node)
- (fragment (first (node-subexpressions node)))))
+ (fragment (first (node-subexpressions node))))
(let* ((actualtypes (map walked-result args))
(ptype (car actualtypes))
(pptype? (procedure-type? ptype))
@@ -331,13 +324,13 @@
(d " call: ~a, te: ~a" actualtypes typeenv)
(cond ((and (not pptype?) (not (match-types xptype ptype typeenv)))
(r-invalid-called-procedure-type
- loc (pname) (resolve xptype typeenv) (resolve ptype typeenv))
+ loc node (resolve xptype typeenv) (resolve ptype typeenv))
(values '* #f))
(else
(let-values (((atypes values-rest ok alen)
(procedure-argument-types ptype nargs typeenv)))
(unless ok
- (r-proc-call-argument-count-mismatch loc (pname) alen nargs))
+ (r-proc-call-argument-count-mismatch loc node (pname) alen
nargs ptype))
(do ((actualtypes (cdr actualtypes) (cdr actualtypes))
(atypes atypes (cdr atypes))
(i 1 (add1 i)))
@@ -347,9 +340,10 @@
(car actualtypes)
typeenv)
(r-proc-call-argument-type-mismatch
- loc (pname) i
+ loc node (pname) i
(resolve (car atypes) typeenv)
- (resolve (car actualtypes) typeenv))))
+ (resolve (car actualtypes) typeenv)
+ ptype)))
(when (noreturn-procedure-type? ptype)
(set! noreturn #t))
(let ((r (procedure-result-types ptype values-rest (cdr
actualtypes) typeenv)))
@@ -360,7 +354,8 @@
(variable-mark pn '##compiler#predicate)) =>
(lambda (pt)
(cond ((match-argument-types (list pt)
(cdr actualtypes) typeenv)
- (r-pred-call-always-true loc
(pname) (cadr actualtypes))
+ (r-pred-call-always-true
+ loc node (pname) pt (cadr
actualtypes))
(when specialize
(specialize-node!
node (cdr args)
@@ -370,7 +365,8 @@
((begin
(trail-restore trail0 typeenv)
(match-argument-types (list `(not
,pt)) (cdr actualtypes) typeenv))
- (r-pred-call-always-false loc
(pname) (cadr actualtypes))
+ (r-pred-call-always-false
+ loc node (pname) pt (cadr
actualtypes))
(when specialize
(specialize-node!
node (cdr args)
@@ -501,7 +497,7 @@
;;(dd " branches: ~s:~s / ~s:~s" nor1 r1
nor2 r2)
(cond ((and (not nor1) (not nor2)
(not (= (length r1) (length
r2))))
- (r-cond-branch-value-count-mismatch
loc n)
+ (r-cond-branch-value-count-mismatch
loc n c a r1 r2)
'*)
(nor1 r2)
(nor2 r1)
@@ -601,7 +597,7 @@
(eq? (car type) 'deprecated))))
(not (match-types type rt typeenv)))
(when strict (set! errors #t))
- (r-toplevel-var-assignment-type-mismatch loc rt var type))
+ (r-toplevel-var-assignment-type-mismatch loc n rt var
type (first subs)))
(when (and (not type) ;XXX global declaration could allow
this
(not b)
(not (eq? '* rt))
@@ -764,14 +760,14 @@
(let ((t (first params))
(rt (walk (first subs) e loc dest tail flow ctags)))
(cond ((eq? rt '*))
- ((null? rt) (r-zero-values-for-the loc t))
+ ((null? rt) (r-zero-values-for-the loc (first subs)
t))
(else
(when (> (length rt) 1)
- (r-too-many-values-for-the loc rt))
+ (r-too-many-values-for-the loc (first subs) t rt))
(when (and (second params)
(not (compatible-types? t (first rt))))
(when strict (set! errors #t))
- (r-type-mismatch-in-the loc (first rt) t))))
+ (r-type-mismatch-in-the loc (first subs) (first
rt) t))))
(list t)))
((##core#typecase)
(let* ((ts (walk (first subs) e loc #f #f flow ctags))
@@ -1645,17 +1641,20 @@
(let-values (((t pred pure) (validate-type new name)))
(unless t
(warning
- (sprintf "invalid type specification for `~a': ~a"
+ (sprintf "Invalid type specification for `~a':~%~%~a"
name
- (type-name new))))
+ (type->pp-string new))))
(when (and old (not (compatible-types? old t)))
(warning
(sprintf
- "type definition for toplevel binding `~a' \
- conflicts with previously loaded type:\
- ~n New type: ~a\
- ~n Original type: ~a"
- name (type-name old) (type-name new))))
+ (string-append
+ "Declared type for toplevel binding `~a'"
+ "~%~%~a~%~%"
+ " conflicts with previously loaded type:"
+ "~%~%~a")
+ name
+ (type->pp-string new)
+ (type->pp-string old))))
(mark-variable name '##compiler#type t)
(mark-variable name '##compiler#type-source 'db)
(when specs
@@ -2079,7 +2078,7 @@
(define (report loc msg . args)
(warning
(conc (location-name loc)
- (sprintf "~?" msg (map type-name args)))))
+ (sprintf "~?" msg args))))
(define (known-length-vector-index node args loc expected-argcount)
(and-let* ((subs (node-subexpressions node))
@@ -2144,7 +2143,7 @@
(define (report loc msg . args)
(warning
(conc (location-name loc)
- (sprintf "~?" msg (map type-name args)))))
+ (sprintf "~?" msg args))))
(define (list-or-null a)
(if (null? a) 'null `(list ,@a)))
@@ -2256,7 +2255,7 @@
(define (report loc msg . args)
(warning
(conc (location-name loc)
- (sprintf "~?" msg (map type-name args)))))
+ (sprintf "~?" msg args))))
(define (append-special-case node args loc rtypes)
(define (potentially-proper-list? l) (match-types l 'list '()))
@@ -2290,12 +2289,16 @@
(unless (or (null? (cdr arg-types))
(potentially-proper-list? arg1))
(report
- loc "~ain procedure call to `~a', argument #~a is \
- of type ~a but expected a proper list"
+ loc
+ (string-append
+ "~ain procedure call to `~a', argument #~a is of type"
+ "~%~%~a~%~%"
+ " but expected a proper list.")
(node-source-prefix node)
(first (node-parameters
(first (node-subexpressions node))))
- index arg1))
+ index
+ (type->pp-string arg1)))
#f))))))
(cond ((derive-result-type) => list)
(else rtypes)))
@@ -2399,6 +2402,28 @@
(define (multiples n)
(if (= n 1) "" "s"))
+(define (string-add-indent str #!optional (ind " "))
+ (let* ((ls (string-split str "\n" #t))
+ (s (string-intersperse
+ (map (lambda (l) (if (string=? "" l) l
+ (string-append ind l)))
+ ls)
+ "\n")))
+ (if (eq? #\newline (string-ref str (sub1 (string-length str))))
+ (string-append s "\n")
+ s)))
+
+(define (type->pp-string t)
+ (string-add-indent
+ (string-chomp
+ (with-output-to-string
+ (lambda ()
+ (let ((t (strip-syntax t)))
+ (if (refinement-type? t)
+ (printf "~a-~a" (string-intersperse (map conc (second t)) "/")
(third t))
+ (pp t))))))
+ " "))
+
(define (fragment x)
(let ((x (build-expression-tree (source-node-tree x))))
(let walk ((x x) (d 0))
@@ -2412,130 +2437,332 @@
(map (cute walk <> (add1 d)) xs)))
(else (strip-syntax x))))))
-(define (pp-fragment x)
- (string-chomp
- (with-output-to-string
- (lambda ()
- (pp (fragment x))))))
+(define (pp-fragment x #!optional (ind " "))
+ (string-add-indent
+ (string-chomp
+ (with-output-to-string
+ (lambda ()
+ (pp (fragment x)))))
+ ind))
(define (node-source-prefix n)
(let ((line (node-line-number n)))
(if (not line) "" (sprintf "(~a) " line))))
-(define (location-name loc)
+(define (location-name loc #!optional (ind " "))
(define (lname loc1)
(if loc1
- (sprintf "procedure `~a'" (real-name loc1))
- "unknown procedure"))
- (cond ((null? loc) "at toplevel:\n ")
- ((null? (cdr loc))
- (sprintf "in toplevel ~a:\n " (lname (car loc))))
+ (real-name loc1)
+ "(unknown procedure)"))
+ (cond ((null? loc) (sprintf "At toplevel:\n~a" ind))
(else
- (let rec ((loc loc))
+ (let rec ((loc loc)
+ (msgs (list "")))
(if (null? (cdr loc))
- (location-name loc)
- (sprintf "in local ~a,\n ~a" (lname (car loc)) (rec (cdr
loc))))))))
+ (string-intersperse
+ (cons (sprintf "In `~a', a toplevel procedure" (lname (car
loc))) msgs)
+ (sprintf "\n~a" ind))
+ (rec (cdr loc)
+ (cons (sprintf "In `~a', a local procedure" (lname (car
loc))) msgs)))))))
-(define (report2 loc msg . args)
+(define (report2 report-f location-node-candidates loc msg . args)
+ (define (file-location)
+ (any (lambda (n) (and (not (string=? "" (node-source-prefix n)))
+ (node-source-prefix n)))
+ location-node-candidates))
(when *complain?*
- (warning
- (conc (location-name loc)
- (sprintf "~?" msg (map type-name args))))))
+ (report-f
+ (conc
+ "Type mismatch.\n "
+ (string-add-indent
+ (conc (let ((l (file-location))) (if l (conc l "\n ") ""))
+ (location-name loc " ")
+ (sprintf "~?" msg args))
+ " ")))))
-(define (report-notice2 loc msg . args)
- (when *complain?*
- (##sys#notice
- (conc (location-name loc)
- (sprintf "~?" msg (map type-name args))))))
+(define (report-notice2 location-node-candidates loc msg . args)
+ (apply report2 ##sys#notice location-node-candidates loc msg args))
;;; Reports
-(define (r-invalid-called-procedure-type loc pname xptype ptype)
+(define (r-invalid-called-procedure-type loc node xptype ptype)
(report2
+ warning
+ (list node)
loc
- "~aexpected a value of type `~a' but was given a value of type `~a'"
- pname xptype ptype))
+ (string-append
+ "In procedure call"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Procedure in a procedure call has invalid type"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "The expected type is"
+ "~%~%"
+ "~a")
+ (pp-fragment node " ")
+ (type->pp-string ptype)
+ (type->pp-string xptype)))
-(define (r-proc-call-argument-count-mismatch loc pname exp-count argc)
+(define (r-proc-call-argument-count-mismatch loc node pname exp-count argc
ptype)
(report2
+ warning
+ (list node)
loc
- "~aexpected ~a argument~a but was given ~a argument~a"
+ (string-append
+ "In procedure call"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Procedure `~a' is called with ~a argument~a but ~a argument~a is
expected."
+ "~%~%"
+ "The procedure's type is"
+ "~%~%"
+ "~a")
+ (pp-fragment node " ")
pname
+ argc (multiples argc)
exp-count (multiples exp-count)
- argc (multiples argc)))
+ (type->pp-string ptype)))
-(define (r-proc-call-argument-type-mismatch loc pname i xptype atype)
+(define (r-proc-call-argument-type-mismatch loc node pname i xptype atype
ptype)
(report2
+ warning
+ (list node)
loc
- "~aexpected argument #~a of type `~a' but was given an argument of type
`~a'"
- pname i xptype atype))
+ (string-append
+ "In procedure call"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Argument #~a to procedure `~a' has invalid type"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "The expected type is"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "The procedure's type is"
+ "~%~%"
+ "~a")
+ (pp-fragment node " ")
+ i
+ pname
+ (type->pp-string atype)
+ (type->pp-string xptype)
+ (type->pp-string ptype)))
-(define (r-pred-call-always-true loc pname atype)
+(define (r-pred-call-always-true loc node pname pred-type atype)
+ ;; pname is "... proc call to predicate `foo' "
(report-notice2
+ (list node)
loc
- "~athe predicate is called with an argument of type `~a' \
- and will always return true"
- pname atype))
+ (string-append
+ "In predicate call"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Predicate call will always return true."
+ "~%~%"
+ "Procedure `~a' is a predicate for"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "The given argument has type"
+ "~%~%"
+ "~a")
+ (pp-fragment node " ")
+ pname
+ (type->pp-string pred-type)
+ (type->pp-string atype)))
-(define (r-pred-call-always-false loc pname atype)
+(define (r-pred-call-always-false loc node pname pred-type atype)
(report-notice2
+ (list node)
loc
- "~athe predicate is called with an argument of type `~a' \
- and will always return false"
- pname atype))
+ (string-append
+ "In predicate call"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Predicate call will always return false."
+ "~%~%"
+ "Procedure `~a' is a predicate for"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "The given argument has type"
+ "~%~%"
+ "~a")
+ (pp-fragment node " ")
+ pname
+ (type->pp-string pred-type)
+ (type->pp-string atype)))
-(define (r-cond-test-always-true loc test-node t if-node)
+(define (r-cond-test-always-true loc if-node test-node t)
(report-notice2
- loc "~aexpected a value of type boolean in conditional, but \
- was given a value of type `~a' which is always true:~%~%~a"
- (node-source-prefix test-node) t (pp-fragment if-node)))
+ (list test-node if-node)
+ loc
+ (string-append
+ "In conditional expression"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Test condition has always true value of type"
+ "~%~%"
+ "~a")
+ (pp-fragment if-node " ")
+ (type->pp-string t)))
-(define (r-cond-test-always-false loc test-node if-node)
+(define (r-cond-test-always-false loc if-node test-node)
(report-notice2
- loc "~ain conditional, test expression will always return false:~%~%~a"
- (node-source-prefix test-node) (pp-fragment if-node)))
+ (list test-node if-node)
+ loc
+ (string-append
+ "In conditional expression"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Test condition is always false.")
+ (pp-fragment if-node " ")))
-(define (r-zero-values-for-the loc the-type)
+(define (r-zero-values-for-the loc node the-type)
;; (the t r) expects r returns exactly 1 value
(report2
+ warning
+ (list node)
loc
- "expression returns zero values but is declared to have \
- a single result of type `~a'"
- the-type))
+ (string-append
+ "In expression"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Expression returns 0 values but is declared to return"
+ "~%~%"
+ "~a")
+ (pp-fragment node " ")
+ (type->pp-string the-type)))
-(define (r-too-many-values-for-the loc rtypes)
+(define (r-too-many-values-for-the loc node the-type rtypes)
(report2
+ warning
+ (list node)
loc
- "expression returns ~a values but is declared to have \
- a single result" (length rtypes)))
+ (string-append
+ "In expression"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Expression returns too many values."
+ "~%~%"
+ "The expression returns ~a values but is declared to return"
+ "~%~%"
+ "~a")
+ (pp-fragment node " ")
+ (length rtypes)
+ (type->pp-string the-type)))
-(define (r-type-mismatch-in-the loc first-rtype the-type)
- ;; NOTE: Now always reports
+(define (r-type-mismatch-in-the loc node first-rtype the-type)
(report2
+ warning
+ (list node)
loc
- "expression returns a result of type `~a' but is \
- declared to return `~a', which is not compatible"
- first-rtype the-type))
+ (string-append
+ "In expression"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Expression's declared and actual types do not match."
+ "~%~%"
+ "The actual type is"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "The expression's declared type is"
+ "~%~%"
+ "~a")
+ (pp-fragment node " ")
+ (type->pp-string first-rtype)
+ (type->pp-string the-type)))
(define (fail-compiler-typecase loc node atype ct-types)
+ (define (ppt t) (string-add-indent (type->pp-string t) " "))
(quit-compiling
- "~a~ano clause applies in `compiler-typecase' for expression of type
`~a':~a"
- (location-name loc)
- (node-source-prefix node)
- (type-name atype)
- (string-intersperse (map (lambda (t) (sprintf "\n ~a" (type-name t)))
ct-types)
- "")))
+ (string-append
+ "Type mismatch.~%"
+ "~a"
+ " ~a"
+ "In `compiler-typecase' expression"
+ "~%~%"
+ "~a"
+ "~%~%"
+ " Tested expression in `compiler-typecase' does not match any case."
+ "~%~%"
+ " The expression has this type"
+ "~%~%"
+ "~a"
+ "~%~%"
+ " The specified type cases are these"
+ "~%~%"
+ "~a")
+ (if (string=? "" (node-source-prefix node))
+ ""
+ (conc " " (node-source-prefix node) "\n"))
+ (location-name loc " ")
+ (pp-fragment node " ")
+ (ppt atype)
+ (string-intersperse (map ppt ct-types) "\n\n")))
-(define (r-cond-branch-value-count-mismatch loc node)
+(define (r-cond-branch-value-count-mismatch loc node c-node a-node c-types
a-types)
(report2
+ warning
+ (list a-node node)
loc
- "branches in conditional expression differ in the number of results:~%~%~a"
- (pp-fragment node)))
+ (string-append
+ "In conditional expression"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "The branches have different number of returned values."
+ "~%~%"
+ "The true branch returns ~a value~a"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "The false branch returns ~a value~a"
+ "~%~%"
+ "~a")
+ (pp-fragment node " ")
+ (length c-types) (multiples (length c-types))
+ (pp-fragment c-node " ")
+ (length a-types) (multiples (length a-types))
+ (pp-fragment a-node " ")))
-(define (r-toplevel-var-assignment-type-mismatch loc atype var xptype)
+(define (r-toplevel-var-assignment-type-mismatch loc node atype var xptype
value-node)
(report2
+ warning
+ (list node value-node)
loc
- "assignment of value of type `~a' to toplevel variable `~a' \
- does not match declared type `~a'"
- atype var xptype))
+ (string-append
+ "In assignment"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Variable `~a' is assigned invalid value."
+ "~%~%"
+ "The assigned value has type"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "The declared type of `~a' is"
+ "~%~%"
+ "~a")
+ (pp-fragment node " ")
+ var
+ (type->pp-string atype)
+ var
+ (type->pp-string xptype)))
)
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
index 9dcd617..6a24662 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -5,259 +5,593 @@ Warning: literal in operator position: (1 2)
Warning: literal in operator position: (1 2)
-Warning: in toplevel procedure `r-proc-call-argument-count-mismatch':
- (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#cons', expected 2 arguments but was given 1 argument
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `r-proc-call-argument-count-mismatch', a toplevel procedure
+ In procedure call
-Warning: in toplevel procedure `r-proc-call-argument-type-mismatch':
- (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#length', expected argument #1 of type `list' but was given an argument
of type `symbol'
+ (scheme#cons '())
-Warning: in toplevel procedure `r-proc-call-argument-value-count':
+ Procedure `scheme#cons' is called with 1 argument but 2 arguments is
expected.
+
+ The procedure's type is
+
+ (forall (aXXX bXXX) (procedure scheme#cons (aXXX bXXX) (pair aXXX bXXX)))
+
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `r-proc-call-argument-type-mismatch', a toplevel procedure
+ In procedure call
+
+ (scheme#length 'symbol)
+
+ Argument #1 to procedure `scheme#length' has invalid type
+
+ symbol
+
+ The expected type is
+
+ list
+
+ The procedure's type is
+
+ (procedure scheme#length (list) fixnum)
+
+Warning: In `r-proc-call-argument-value-count', a toplevel procedure
(test-scrutinizer-message-format.scm:XXX) expected a single result in
argument #1 of procedure call `(scheme#list (chicken.time#cpu-time))', but
received 2 results
-Warning: in toplevel procedure `r-proc-call-argument-value-count':
+Warning: In `r-proc-call-argument-value-count', a toplevel procedure
(test-scrutinizer-message-format.scm:XXX) expected a single result in
argument #1 of procedure call `(scheme#vector (scheme#values))', but received
zero results
-Warning: in toplevel procedure `r-cond-branch-value-count-mismatch':
- branches in conditional expression differ in the number of results:
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `r-cond-branch-value-count-mismatch', a toplevel procedure
+ In conditional expression
-(if (the * 1) 1 (chicken.time#cpu-time))
+ (if (the * 1) 1 (chicken.time#cpu-time))
-Warning: in toplevel procedure `r-invalid-called-procedure-type':
- in procedure call to `1', expected a value of type `(procedure (*) *)' but
was given a value of type `fixnum'
+ The branches have different number of returned values.
-Note: in toplevel procedure `r-pred-call-always-true':
- (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#list?', the predicate is called with an argument of type `null' and
will always return true
+ The true branch returns 1 value
-Note: in toplevel procedure `r-pred-call-always-false':
- (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#symbol?', the predicate is called with an argument of type `fixnum' and
will always return false
+ 1
-Note: in toplevel procedure `r-cond-test-always-true':
- expected a value of type boolean in conditional, but was given a value of
type `symbol' which is always true:
+ The false branch returns 2 values
-(if 'symbol 1 (##core#undefined))
+ (chicken.time#cpu-time)
-Note: in toplevel procedure `r-cond-test-always-false':
- in conditional, test expression will always return false:
+Warning: Type mismatch.
+ In `r-invalid-called-procedure-type', a toplevel procedure
+ In procedure call
-(if #f 1 (##core#undefined))
+ (1 2)
-Warning: in toplevel procedure `r-type-mismatch-in-the':
- expression returns a result of type `fixnum' but is declared to return
`symbol', which is not compatible
+ Procedure in a procedure call has invalid type
-Warning: in toplevel procedure `r-zero-values-for-the':
- expression returns zero values but is declared to have a single result of
type `symbol'
+ fixnum
-Warning: in toplevel procedure `r-too-many-values-for-the':
- expression returns 2 values but is declared to have a single result
+ The expected type is
-Warning: in toplevel procedure `r-too-many-values-for-the':
- expression returns a result of type `fixnum' but is declared to return
`symbol', which is not compatible
+ (procedure (*) *)
-Warning: in toplevel procedure `r-toplevel-var-assignment-type-mismatch':
- assignment of value of type `fixnum' to toplevel variable `foo' does not
match declared type `boolean'
+Note: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `r-pred-call-always-true', a toplevel procedure
+ In predicate call
-Warning: in toplevel procedure `r-deprecated-identifier':
+ (scheme#list? '())
+
+ Predicate call will always return true.
+
+ Procedure `scheme#list?' is a predicate for
+
+ list
+
+ The given argument has type
+
+ null
+
+Note: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `r-pred-call-always-false', a toplevel procedure
+ In predicate call
+
+ (scheme#symbol? 1)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#symbol?' is a predicate for
+
+ symbol
+
+ The given argument has type
+
+ fixnum
+
+Note: Type mismatch.
+ In `r-cond-test-always-true', a toplevel procedure
+ In conditional expression
+
+ (if 'symbol 1 (##core#undefined))
+
+ Test condition has always true value of type
+
+ symbol
+
+Note: Type mismatch.
+ In `r-cond-test-always-false', a toplevel procedure
+ In conditional expression
+
+ (if #f 1 (##core#undefined))
+
+ Test condition is always false.
+
+Warning: Type mismatch.
+ In `r-type-mismatch-in-the', a toplevel procedure
+ In expression
+
+ 1
+
+ Expression's declared and actual types do not match.
+
+ The actual type is
+
+ fixnum
+
+ The expression's declared type is
+
+ symbol
+
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `r-zero-values-for-the', a toplevel procedure
+ In expression
+
+ (scheme#values)
+
+ Expression returns 0 values but is declared to return
+
+ symbol
+
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `r-too-many-values-for-the', a toplevel procedure
+ In expression
+
+ (scheme#values 1 2)
+
+ Expression returns too many values.
+
+ The expression returns 2 values but is declared to return
+
+ symbol
+
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `r-too-many-values-for-the', a toplevel procedure
+ In expression
+
+ (scheme#values 1 2)
+
+ Expression's declared and actual types do not match.
+
+ The actual type is
+
+ fixnum
+
+ The expression's declared type is
+
+ symbol
+
+Warning: Type mismatch.
+ In `r-toplevel-var-assignment-type-mismatch', a toplevel procedure
+ In assignment
+
+ (set! foo 1)
+
+ Variable `foo' is assigned invalid value.
+
+ The assigned value has type
+
+ fixnum
+
+ The declared type of `foo' is
+
+ boolean
+
+Warning: In `r-deprecated-identifier', a toplevel procedure
use of deprecated `deprecated-foo'
-Warning: in toplevel procedure `r-deprecated-identifier':
+Warning: In `r-deprecated-identifier', a toplevel procedure
use of deprecated `deprecated-foo2' - consider `foo'
-Warning: at toplevel:
- assignment of value of type `fixnum' to toplevel variable `foo' does not
match declared type `boolean'
+Warning: Type mismatch.
+ At toplevel:
+ In assignment
-Warning: in toplevel procedure `append-invalid-arg':
- (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#append', argument #1 is of type fixnum but expected a proper list
+ (set! foo 1)
-Warning: in local procedure `r-proc-call-argument-count-mismatch',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#cons', expected 2 arguments but was given 1 argument
+ Variable `foo' is assigned invalid value.
-Warning: in local procedure `r-proc-call-argument-type-mismatch',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#string-length', expected argument #1 of type `string' but was given an
argument of type `(procedure chicken.base#add1 (number) number)'
+ The assigned value has type
-Warning: in local procedure `r-proc-call-argument-value-count',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+ fixnum
+
+ The declared type of `foo' is
+
+ boolean
+
+Warning: In `append-invalid-arg', a toplevel procedure
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#append', argument #1 is of type
+
+ fixnum
+
+ but expected a proper list.
+
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-proc-call-argument-count-mismatch', a local procedure
+ In procedure call
+
+ (scheme#cons '())
+
+ Procedure `scheme#cons' is called with 1 argument but 2 arguments is
expected.
+
+ The procedure's type is
+
+ (forall (aXXX bXXX) (procedure scheme#cons (aXXX bXXX) (pair aXXX bXXX)))
+
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-proc-call-argument-type-mismatch', a local procedure
+ In procedure call
+
+ (scheme#string-length chicken.base#add1)
+
+ Argument #1 to procedure `scheme#string-length' has invalid type
+
+ (procedure chicken.base#add1 (number) number)
+
+ The expected type is
+
+ string
+
+ The procedure's type is
+
+ (procedure scheme#string-length (string) fixnum)
+
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-proc-call-argument-value-count', a local procedure
(test-scrutinizer-message-format.scm:XXX) expected a single result in
argument #1 of procedure call `(scheme#list (chicken.time#cpu-time))', but
received 2 results
-Warning: in local procedure `r-proc-call-argument-value-count',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-proc-call-argument-value-count', a local procedure
(test-scrutinizer-message-format.scm:XXX) expected a single result in
argument #1 of procedure call `(scheme#vector (scheme#values))', but received
zero results
-Warning: in local procedure `r-cond-branch-value-count-mismatch',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- branches in conditional expression differ in the number of results:
-
-(if (the * 1) 1 (chicken.time#cpu-time))
-
-Warning: in local procedure `variable',
- in local procedure `r-invalid-called-procedure-type',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:XXX) in procedure call to `m#foo2',
expected a value of type `(procedure (*) *)' but was given a value of type
`boolean'
-
-Warning: in local procedure `non-variable',
- in local procedure `r-invalid-called-procedure-type',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- in procedure call to `1', expected a value of type `(procedure (*) *)' but
was given a value of type `fixnum'
-
-Note: in local procedure `r-pred-call-always-true',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#list?', the predicate is called with an argument of type `null' and
will always return true
-
-Note: in local procedure `r-pred-call-always-false',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#symbol?', the predicate is called with an argument of type `fixnum' and
will always return false
-
-Note: in local procedure `r-cond-test-always-true',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:XXX) expected a value of type boolean
in conditional, but was given a value of type `fixnum' which is always true:
-
-(if (scheme#length '()) 1 (##core#undefined))
-
-Note: in local procedure `r-cond-test-always-false',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- in conditional, test expression will always return false:
-
-(if #f 1 (##core#undefined))
-
-Warning: in local procedure `r-type-mismatch-in-the',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- expression returns a result of type `fixnum' but is declared to return
`symbol', which is not compatible
-
-Warning: in local procedure `r-toplevel-var-assignment-type-mismatch',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- assignment of value of type `fixnum' to toplevel variable `m#foo2' does not
match declared type `boolean'
-
-Warning: in local procedure `r-deprecated-identifier',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-cond-branch-value-count-mismatch', a local procedure
+ In conditional expression
+
+ (if (the * 1) 1 (chicken.time#cpu-time))
+
+ The branches have different number of returned values.
+
+ The true branch returns 1 value
+
+ 1
+
+ The false branch returns 2 values
+
+ (chicken.time#cpu-time)
+
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-invalid-called-procedure-type', a local procedure
+ In `variable', a local procedure
+ In procedure call
+
+ (m#foo2 2)
+
+ Procedure in a procedure call has invalid type
+
+ boolean
+
+ The expected type is
+
+ (procedure (*) *)
+
+Warning: Type mismatch.
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-invalid-called-procedure-type', a local procedure
+ In `non-variable', a local procedure
+ In procedure call
+
+ (1 2)
+
+ Procedure in a procedure call has invalid type
+
+ fixnum
+
+ The expected type is
+
+ (procedure (*) *)
+
+Note: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-pred-call-always-true', a local procedure
+ In predicate call
+
+ (scheme#list? '())
+
+ Predicate call will always return true.
+
+ Procedure `scheme#list?' is a predicate for
+
+ list
+
+ The given argument has type
+
+ null
+
+Note: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-pred-call-always-false', a local procedure
+ In predicate call
+
+ (scheme#symbol? 1)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#symbol?' is a predicate for
+
+ symbol
+
+ The given argument has type
+
+ fixnum
+
+Note: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-cond-test-always-true', a local procedure
+ In conditional expression
+
+ (if (scheme#length '()) 1 (##core#undefined))
+
+ Test condition has always true value of type
+
+ fixnum
+
+Note: Type mismatch.
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-cond-test-always-false', a local procedure
+ In conditional expression
+
+ (if #f 1 (##core#undefined))
+
+ Test condition is always false.
+
+Warning: Type mismatch.
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-type-mismatch-in-the', a local procedure
+ In expression
+
+ 1
+
+ Expression's declared and actual types do not match.
+
+ The actual type is
+
+ fixnum
+
+ The expression's declared type is
+
+ symbol
+
+Warning: Type mismatch.
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-toplevel-var-assignment-type-mismatch', a local procedure
+ In assignment
+
+ (set! m#foo2 1)
+
+ Variable `m#foo2' is assigned invalid value.
+
+ The assigned value has type
+
+ fixnum
+
+ The declared type of `m#foo2' is
+
+ boolean
+
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-deprecated-identifier', a local procedure
use of deprecated `m#deprecated-foo'
-Warning: in local procedure `r-deprecated-identifier',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-deprecated-identifier', a local procedure
use of deprecated `m#deprecated-foo2' - consider `foo'
-Warning: in local procedure `r-zero-values-for-the',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- expression returns zero values but is declared to have a single result of
type `symbol'
-
-Warning: in local procedure `zero-values-for-assignment',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-zero-values-for-the', a local procedure
+ In expression
+
+ (scheme#values)
+
+ Expression returns 0 values but is declared to return
+
+ symbol
+
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `zero-values-for-assignment', a local procedure
expected a single result in assignment to `m#foo', but received zero results
-Warning: in local procedure `zero-values-for-conditional',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `zero-values-for-conditional', a local procedure
expected a single result in conditional, but received zero results
-Warning: in local procedure `zero-values-for-let',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `zero-values-for-let', a local procedure
expected a single result in `let' binding of `a', but received zero results
-Warning: in local procedure `r-too-many-values-for-the',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- expression returns 2 values but is declared to have a single result
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-too-many-values-for-the', a local procedure
+ In expression
+
+ (scheme#values 1 2)
+
+ Expression returns too many values.
+
+ The expression returns 2 values but is declared to return
+
+ symbol
-Warning: in local procedure `r-too-many-values-for-the',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- expression returns a result of type `fixnum' but is declared to return
`symbol', which is not compatible
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-too-many-values-for-the', a local procedure
+ In expression
-Warning: in local procedure `too-many-values-for-assignment',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+ (scheme#values 1 2)
+
+ Expression's declared and actual types do not match.
+
+ The actual type is
+
+ fixnum
+
+ The expression's declared type is
+
+ symbol
+
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `too-many-values-for-assignment', a local procedure
expected a single result in assignment to `m#foo', but received 2 results
-Warning: in local procedure `too-many-values-for-conditional',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `too-many-values-for-conditional', a local procedure
expected a single result in conditional, but received 2 results
-Warning: in local procedure `too-many-values-for-let',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `too-many-values-for-let', a local procedure
expected a single result in `let' binding of `a', but received 2 results
-Warning: in local procedure `zero-values-for-let',
- in local procedure `r-let-value-count-invalid',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-let-value-count-invalid', a local procedure
+ In `zero-values-for-let', a local procedure
expected a single result in `let' binding of `a', but received zero results
-Warning: in local procedure `too-many-values-for-let',
- in local procedure `r-let-value-count-invalid',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-let-value-count-invalid', a local procedure
+ In `too-many-values-for-let', a local procedure
expected a single result in `let' binding of `a', but received 2 results
-Warning: in local procedure `zero-values-for-conditional',
- in local procedure `r-conditional-value-count-invalid',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-conditional-value-count-invalid', a local procedure
+ In `zero-values-for-conditional', a local procedure
expected a single result in conditional, but received zero results
-Warning: in local procedure `too-many-values-for-conditional',
- in local procedure `r-conditional-value-count-invalid',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-conditional-value-count-invalid', a local procedure
+ In `too-many-values-for-conditional', a local procedure
expected a single result in conditional, but received 2 results
-Warning: in local procedure `zero-values-for-assignment',
- in local procedure `r-assignment-value-count-invalid',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-assignment-value-count-invalid', a local procedure
+ In `zero-values-for-assignment', a local procedure
expected a single result in assignment to `m#foo', but received zero results
-Warning: in local procedure `too-many-values-for-assignment',
- in local procedure `r-assignment-value-count-invalid',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-assignment-value-count-invalid', a local procedure
+ In `too-many-values-for-assignment', a local procedure
expected a single result in assignment to `m#foo', but received 2 results
-Warning: in local procedure `append-invalid-arg',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#append', argument #1 is of type fixnum but expected a proper list
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `append-invalid-arg', a local procedure
+ (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#append', argument #1 is of type
+
+ fixnum
+
+ but expected a proper list.
-Warning: in local procedure `list-ref-negative-index',
- in local procedure `vector-list-out-of-range',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `vector-list-out-of-range', a local procedure
+ In `list-ref-negative-index', a local procedure
(test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#list-ref', index -1 is negative, which is never valid
-Warning: in local procedure `list-ref-out-of-range',
- in local procedure `vector-list-out-of-range',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `vector-list-out-of-range', a local procedure
+ In `list-ref-out-of-range', a local procedure
(test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#list-ref', index 1 out of range for proper list of length 0
-Warning: in local procedure `vector-ref-out-of-range',
- in local procedure `vector-list-out-of-range',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
+Warning: In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `vector-list-out-of-range', a local procedure
+ In `vector-ref-out-of-range', a local procedure
(test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#vector-ref', index -1 out of range for vector of length 0
-Error: in local procedure `fail-compiler-typecase',
- in local procedure `local-bar',
- in toplevel procedure `m#toplevel-foo':
- (test-scrutinizer-message-format.scm:XXX) no clause applies in
`compiler-typecase' for expression of type `fixnum':
+Error: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `fail-compiler-typecase', a local procedure
+ In `compiler-typecase' expression
+
+ (compiler-typecase gXXX (symbol 1) (list 2) (else (##core#undefined)))
+
+ Tested expression in `compiler-typecase' does not match any case.
+
+ The expression has this type
+
+ fixnum
+
+ The specified type cases are these
+
symbol
+
list
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index 5059f30..5149f7a 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -1,68 +1,376 @@
;; numbers replaced with XXX by redact-gensyms.scm
;; prefixes: (tmp g)
-Note: at toplevel:
- (scrutiny-tests-2.scm:20) in procedure call to `scheme#pair?', the predicate
is called with an argument of type `pair' and will always return true
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:20)
+ At toplevel:
+ In predicate call
-Note: at toplevel:
- (scrutiny-tests-2.scm:20) in procedure call to `scheme#pair?', the predicate
is called with an argument of type `null' and will always return false
+ (scheme#pair? p)
-Note: at toplevel:
- (scrutiny-tests-2.scm:20) in procedure call to `scheme#pair?', the predicate
is called with an argument of type `null' and will always return false
+ Predicate call will always return true.
-Note: at toplevel:
- (scrutiny-tests-2.scm:20) in procedure call to `scheme#pair?', the predicate
is called with an argument of type `fixnum' and will always return false
+ Procedure `scheme#pair?' is a predicate for
-Note: at toplevel:
- (scrutiny-tests-2.scm:20) in procedure call to `scheme#pair?', the predicate
is called with an argument of type `float' and will always return false
+ pair
-Note: at toplevel:
- (scrutiny-tests-2.scm:21) in procedure call to `scheme#list?', the predicate
is called with an argument of type `null' and will always return true
+ The given argument has type
-Note: at toplevel:
- (scrutiny-tests-2.scm:21) in procedure call to `scheme#list?', the predicate
is called with an argument of type `null' and will always return true
+ pair
-Note: at toplevel:
- (scrutiny-tests-2.scm:21) in procedure call to `scheme#list?', the predicate
is called with an argument of type `fixnum' and will always return false
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:20)
+ At toplevel:
+ In predicate call
-Note: at toplevel:
- (scrutiny-tests-2.scm:21) in procedure call to `scheme#list?', the predicate
is called with an argument of type `float' and will always return false
+ (scheme#pair? l)
-Note: at toplevel:
- (scrutiny-tests-2.scm:22) in procedure call to `scheme#null?', the predicate
is called with an argument of type `null' and will always return true
+ Predicate call will always return false.
-Note: at toplevel:
- (scrutiny-tests-2.scm:22) in procedure call to `scheme#null?', the predicate
is called with an argument of type `null' and will always return true
+ Procedure `scheme#pair?' is a predicate for
-Note: at toplevel:
- (scrutiny-tests-2.scm:22) in procedure call to `scheme#null?', the predicate
is called with an argument of type `pair' and will always return false
+ pair
-Note: at toplevel:
- (scrutiny-tests-2.scm:22) in procedure call to `scheme#null?', the predicate
is called with an argument of type `fixnum' and will always return false
+ The given argument has type
-Note: at toplevel:
- (scrutiny-tests-2.scm:22) in procedure call to `scheme#null?', the predicate
is called with an argument of type `float' and will always return false
+ null
-Note: at toplevel:
- (scrutiny-tests-2.scm:23) in procedure call to `chicken.base#fixnum?', the
predicate is called with an argument of type `fixnum' and will always return
true
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:20)
+ At toplevel:
+ In predicate call
-Note: at toplevel:
- (scrutiny-tests-2.scm:23) in procedure call to `chicken.base#fixnum?', the
predicate is called with an argument of type `float' and will always return
false
+ (scheme#pair? n)
-Note: at toplevel:
- (scrutiny-tests-2.scm:25) in procedure call to `chicken.base#flonum?', the
predicate is called with an argument of type `float' and will always return true
+ Predicate call will always return false.
-Note: at toplevel:
- (scrutiny-tests-2.scm:25) in procedure call to `chicken.base#flonum?', the
predicate is called with an argument of type `fixnum' and will always return
false
+ Procedure `scheme#pair?' is a predicate for
-Note: at toplevel:
- (scrutiny-tests-2.scm:27) in procedure call to `scheme#number?', the
predicate is called with an argument of type `fixnum' and will always return
true
+ pair
-Note: at toplevel:
- (scrutiny-tests-2.scm:27) in procedure call to `scheme#number?', the
predicate is called with an argument of type `float' and will always return true
+ The given argument has type
-Note: at toplevel:
- (scrutiny-tests-2.scm:27) in procedure call to `scheme#number?', the
predicate is called with an argument of type `number' and will always return
true
+ null
-Note: at toplevel:
- (scrutiny-tests-2.scm:27) in procedure call to `scheme#number?', the
predicate is called with an argument of type `null' and will always return false
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:20)
+ At toplevel:
+ In predicate call
+
+ (scheme#pair? i)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#pair?' is a predicate for
+
+ pair
+
+ The given argument has type
+
+ fixnum
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:20)
+ At toplevel:
+ In predicate call
+
+ (scheme#pair? f)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#pair?' is a predicate for
+
+ pair
+
+ The given argument has type
+
+ float
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:21)
+ At toplevel:
+ In predicate call
+
+ (scheme#list? l)
+
+ Predicate call will always return true.
+
+ Procedure `scheme#list?' is a predicate for
+
+ list
+
+ The given argument has type
+
+ null
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:21)
+ At toplevel:
+ In predicate call
+
+ (scheme#list? n)
+
+ Predicate call will always return true.
+
+ Procedure `scheme#list?' is a predicate for
+
+ list
+
+ The given argument has type
+
+ null
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:21)
+ At toplevel:
+ In predicate call
+
+ (scheme#list? i)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#list?' is a predicate for
+
+ list
+
+ The given argument has type
+
+ fixnum
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:21)
+ At toplevel:
+ In predicate call
+
+ (scheme#list? f)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#list?' is a predicate for
+
+ list
+
+ The given argument has type
+
+ float
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:22)
+ At toplevel:
+ In predicate call
+
+ (scheme#null? n)
+
+ Predicate call will always return true.
+
+ Procedure `scheme#null?' is a predicate for
+
+ null
+
+ The given argument has type
+
+ null
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:22)
+ At toplevel:
+ In predicate call
+
+ (scheme#null? l)
+
+ Predicate call will always return true.
+
+ Procedure `scheme#null?' is a predicate for
+
+ null
+
+ The given argument has type
+
+ null
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:22)
+ At toplevel:
+ In predicate call
+
+ (scheme#null? p)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#null?' is a predicate for
+
+ null
+
+ The given argument has type
+
+ pair
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:22)
+ At toplevel:
+ In predicate call
+
+ (scheme#null? i)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#null?' is a predicate for
+
+ null
+
+ The given argument has type
+
+ fixnum
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:22)
+ At toplevel:
+ In predicate call
+
+ (scheme#null? f)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#null?' is a predicate for
+
+ null
+
+ The given argument has type
+
+ float
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:23)
+ At toplevel:
+ In predicate call
+
+ (chicken.base#fixnum? i)
+
+ Predicate call will always return true.
+
+ Procedure `chicken.base#fixnum?' is a predicate for
+
+ fixnum
+
+ The given argument has type
+
+ fixnum
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:23)
+ At toplevel:
+ In predicate call
+
+ (chicken.base#fixnum? f)
+
+ Predicate call will always return false.
+
+ Procedure `chicken.base#fixnum?' is a predicate for
+
+ fixnum
+
+ The given argument has type
+
+ float
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:25)
+ At toplevel:
+ In predicate call
+
+ (chicken.base#flonum? f)
+
+ Predicate call will always return true.
+
+ Procedure `chicken.base#flonum?' is a predicate for
+
+ float
+
+ The given argument has type
+
+ float
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:25)
+ At toplevel:
+ In predicate call
+
+ (chicken.base#flonum? i)
+
+ Predicate call will always return false.
+
+ Procedure `chicken.base#flonum?' is a predicate for
+
+ float
+
+ The given argument has type
+
+ fixnum
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:27)
+ At toplevel:
+ In predicate call
+
+ (scheme#number? i)
+
+ Predicate call will always return true.
+
+ Procedure `scheme#number?' is a predicate for
+
+ number
+
+ The given argument has type
+
+ fixnum
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:27)
+ At toplevel:
+ In predicate call
+
+ (scheme#number? f)
+
+ Predicate call will always return true.
+
+ Procedure `scheme#number?' is a predicate for
+
+ number
+
+ The given argument has type
+
+ float
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:27)
+ At toplevel:
+ In predicate call
+
+ (scheme#number? u)
+
+ Predicate call will always return true.
+
+ Procedure `scheme#number?' is a predicate for
+
+ number
+
+ The given argument has type
+
+ number
+
+Note: Type mismatch.
+ (scrutiny-tests-2.scm:27)
+ At toplevel:
+ In predicate call
+
+ (scheme#number? n)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#number?' is a predicate for
+
+ number
+
+ The given argument has type
+
+ null
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index da6c472..c6b2fcf 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -3,215 +3,944 @@
Warning: (scrutiny-tests.scm:31) - assignment to imported value binding `car'
-Note: in local procedure `c',
- in local procedure `b',
- in toplevel procedure `a':
- expected a value of type boolean in conditional, but was given a value of
type `number' which is always true:
+Note: Type mismatch.
+ In `a', a toplevel procedure
+ In `b', a local procedure
+ In `c', a local procedure
+ In conditional expression
-(if x 1 2)
+ (if x 1 2)
-Note: in toplevel procedure `b':
- expected a value of type boolean in conditional, but was given a value of
type `true' which is always true:
+ Test condition has always true value of type
-(if x 1 2)
+ number
-Warning: in toplevel procedure `foo':
- branches in conditional expression differ in the number of results:
+Note: Type mismatch.
+ In `b', a toplevel procedure
+ In conditional expression
-(if x (scheme#values 1 2) (scheme#values 1 2 (scheme#+ (scheme#+ ...))))
+ (if x 1 2)
-Warning: at toplevel:
- (scrutiny-tests.scm:19) in procedure call to `bar', expected argument #2 of
type `number' but was given an argument of type `symbol'
+ Test condition has always true value of type
-Warning: at toplevel:
- (scrutiny-tests.scm:21) in procedure call to `scheme#string?', expected 1
argument but was given 0 arguments
+ true
-Warning: at toplevel:
+Warning: Type mismatch.
+ (scrutiny-tests.scm:16)
+ In `foo', a toplevel procedure
+ In conditional expression
+
+ (if x (scheme#values 1 2) (scheme#values 1 2 (scheme#+ (scheme#+ ...))))
+
+ The branches have different number of returned values.
+
+ The true branch returns 2 values
+
+ (scheme#values 1 2)
+
+ The false branch returns 3 values
+
+ (scheme#values 1 2 (scheme#+ (scheme#+ (scheme#+ ...))))
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:19)
+ At toplevel:
+ In procedure call
+
+ (bar 3 'a)
+
+ Argument #2 to procedure `bar' has invalid type
+
+ symbol
+
+ The expected type is
+
+ number
+
+ The procedure's type is
+
+ (procedure scheme#+ (#!rest number) number)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:21)
+ At toplevel:
+ In procedure call
+
+ (scheme#string?)
+
+ Procedure `scheme#string?' is called with 0 arguments but 1 argument is
expected.
+
+ The procedure's type is
+
+ (procedure scheme#string? (*) boolean)
+
+Warning: At toplevel:
(scrutiny-tests.scm:23) expected a single result in argument #1 of procedure
call `(chicken.base#print (scheme#values 1 2))', but received 2 results
-Warning: at toplevel:
+Warning: At toplevel:
(scrutiny-tests.scm:24) expected a single result in argument #1 of procedure
call `(chicken.base#print (scheme#values))', but received zero results
-Warning: at toplevel:
- (scrutiny-tests.scm:27) in procedure call to `x', expected a value of type
`(procedure () *)' but was given a value of type `fixnum'
+Warning: Type mismatch.
+ (scrutiny-tests.scm:27)
+ At toplevel:
+ In procedure call
-Warning: at toplevel:
- (scrutiny-tests.scm:29) in procedure call to `scheme#+', expected argument
#1 of type `number' but was given an argument of type `symbol'
+ (x)
-Warning: at toplevel:
- (scrutiny-tests.scm:29) in procedure call to `scheme#+', expected argument
#2 of type `number' but was given an argument of type `symbol'
+ Procedure in a procedure call has invalid type
-Warning: at toplevel:
- assignment of value of type `fixnum' to toplevel variable `scheme#car' does
not match declared type `(forall (a335) (procedure scheme#car ((pair a335 *))
a335))'
+ fixnum
-Warning: at toplevel:
+ The expected type is
+
+ (procedure () *)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:29)
+ At toplevel:
+ In procedure call
+
+ (scheme#+ 'a 'b)
+
+ Argument #1 to procedure `scheme#+' has invalid type
+
+ symbol
+
+ The expected type is
+
+ number
+
+ The procedure's type is
+
+ (procedure scheme#+ (#!rest number) number)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:29)
+ At toplevel:
+ In procedure call
+
+ (scheme#+ 'a 'b)
+
+ Argument #2 to procedure `scheme#+' has invalid type
+
+ symbol
+
+ The expected type is
+
+ number
+
+ The procedure's type is
+
+ (procedure scheme#+ (#!rest number) number)
+
+Warning: Type mismatch.
+ At toplevel:
+ In assignment
+
+ (set! scheme#car 33)
+
+ Variable `scheme#car' is assigned invalid value.
+
+ The assigned value has type
+
+ fixnum
+
+ The declared type of `scheme#car' is
+
+ (forall (a335) (procedure scheme#car ((pair a335 *)) a335))
+
+Warning: At toplevel:
expected a single result in `let' binding of `gXXX', but received 2 results
-Warning: at toplevel:
- in procedure call to `gXXX', expected a value of type `(procedure () *)' but
was given a value of type `fixnum'
+Warning: Type mismatch.
+ At toplevel:
+ In procedure call
-Note: in toplevel procedure `foo':
- expected a value of type boolean in conditional, but was given a value of
type `(procedure bar () *)' which is always true:
+ (gXXX)
-(if bar 3 (##core#undefined))
+ Procedure in a procedure call has invalid type
-Warning: in toplevel procedure `foo2':
- (scrutiny-tests.scm:58) in procedure call to `scheme#string-append',
expected argument #1 of type `string' but was given an argument of type `number'
+ fixnum
-Warning: at toplevel:
- (scrutiny-tests.scm:66) in procedure call to `foo3', expected argument #1 of
type `string' but was given an argument of type `fixnum'
+ The expected type is
-Warning: in toplevel procedure `foo4':
- (scrutiny-tests.scm:71) in procedure call to `scheme#+', expected argument
#1 of type `number' but was given an argument of type `string'
+ (procedure () *)
-Warning: in toplevel procedure `foo5':
- (scrutiny-tests.scm:77) in procedure call to `scheme#+', expected argument
#1 of type `number' but was given an argument of type `string'
+Note: Type mismatch.
+ In `foo', a toplevel procedure
+ In conditional expression
-Warning: in toplevel procedure `foo6':
- (scrutiny-tests.scm:83) in procedure call to `scheme#+', expected argument
#1 of type `number' but was given an argument of type `string'
+ (if bar 3 (##core#undefined))
-Warning: at toplevel:
- (scrutiny-tests.scm:90) in procedure call to `scheme#+', expected argument
#1 of type `number' but was given an argument of type `string'
+ Test condition has always true value of type
-Warning: in toplevel procedure `foo10':
- (scrutiny-tests.scm:104) in procedure call to `foo9', expected argument #1
of type `string' but was given an argument of type `number'
+ (procedure bar () *)
-Warning: in toplevel procedure `foo10':
- (scrutiny-tests.scm:105) in procedure call to `scheme#+', expected argument
#1 of type `number' but was given an argument of type `string'
+Warning: Type mismatch.
+ (scrutiny-tests.scm:58)
+ In `foo2', a toplevel procedure
+ In procedure call
-Warning: in toplevel procedure `foo10':
- expression returns a result of type `string' but is declared to return
`pair', which is not compatible
+ (scheme#string-append x "abc")
-Warning: in toplevel procedure `foo10':
- (scrutiny-tests.scm:109) in procedure call to `scheme#string-append',
expected argument #1 of type `string' but was given an argument of type `pair'
+ Argument #1 to procedure `scheme#string-append' has invalid type
-Warning: in toplevel procedure `foo10':
- expression returns 2 values but is declared to have a single result
+ number
-Warning: in toplevel procedure `foo10':
- expression returns zero values but is declared to have a single result of
type `*'
+ The expected type is
-Warning: in toplevel procedure `foo10':
- (scrutiny-tests.scm:112) in procedure call to `scheme#*', expected argument
#1 of type `number' but was given an argument of type `string'
+ string
-Warning: in toplevel procedure `foo#blabla':
- (scrutiny-tests.scm:137) in procedure call to `scheme#+', expected argument
#2 of type `number' but was given an argument of type `symbol'
+ The procedure's type is
-Warning: at toplevel:
+ (procedure scheme#string-append (#!rest string) string)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:66)
+ At toplevel:
+ In procedure call
+
+ (foo3 99)
+
+ Argument #1 to procedure `foo3' has invalid type
+
+ fixnum
+
+ The expected type is
+
+ string
+
+ The procedure's type is
+
+ (procedure foo3 (string) string)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:71)
+ In `foo4', a toplevel procedure
+ In procedure call
+
+ (scheme#+ x 1)
+
+ Argument #1 to procedure `scheme#+' has invalid type
+
+ string
+
+ The expected type is
+
+ number
+
+ The procedure's type is
+
+ (procedure scheme#+ (#!rest number) number)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:77)
+ In `foo5', a toplevel procedure
+ In procedure call
+
+ (scheme#+ x 3)
+
+ Argument #1 to procedure `scheme#+' has invalid type
+
+ string
+
+ The expected type is
+
+ number
+
+ The procedure's type is
+
+ (procedure scheme#+ (#!rest number) number)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:83)
+ In `foo6', a toplevel procedure
+ In procedure call
+
+ (scheme#+ x 3)
+
+ Argument #1 to procedure `scheme#+' has invalid type
+
+ string
+
+ The expected type is
+
+ number
+
+ The procedure's type is
+
+ (procedure scheme#+ (#!rest number) number)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:90)
+ At toplevel:
+ In procedure call
+
+ (scheme#+ x 1)
+
+ Argument #1 to procedure `scheme#+' has invalid type
+
+ string
+
+ The expected type is
+
+ number
+
+ The procedure's type is
+
+ (procedure scheme#+ (#!rest number) number)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:104)
+ In `foo10', a toplevel procedure
+ In procedure call
+
+ (foo9 x)
+
+ Argument #1 to procedure `foo9' has invalid type
+
+ number
+
+ The expected type is
+
+ string
+
+ The procedure's type is
+
+ (procedure foo9 (string) symbol)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:105)
+ In `foo10', a toplevel procedure
+ In procedure call
+
+ (scheme#+ x 1)
+
+ Argument #1 to procedure `scheme#+' has invalid type
+
+ string
+
+ The expected type is
+
+ number
+
+ The procedure's type is
+
+ (procedure scheme#+ (#!rest number) number)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:109)
+ In `foo10', a toplevel procedure
+ In expression
+
+ (scheme#substring x 0 10)
+
+ Expression's declared and actual types do not match.
+
+ The actual type is
+
+ string
+
+ The expression's declared type is
+
+ pair
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:109)
+ In `foo10', a toplevel procedure
+ In procedure call
+
+ (scheme#string-append (the pair (scheme#substring x 0 10)))
+
+ Argument #1 to procedure `scheme#string-append' has invalid type
+
+ pair
+
+ The expected type is
+
+ string
+
+ The procedure's type is
+
+ (procedure scheme#string-append (#!rest string) string)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:110)
+ In `foo10', a toplevel procedure
+ In expression
+
+ (scheme#values 1 2)
+
+ Expression returns too many values.
+
+ The expression returns 2 values but is declared to return
+
+ *
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:111)
+ In `foo10', a toplevel procedure
+ In expression
+
+ (scheme#values)
+
+ Expression returns 0 values but is declared to return
+
+ *
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:112)
+ In `foo10', a toplevel procedure
+ In procedure call
+
+ (scheme#* x y)
+
+ Argument #1 to procedure `scheme#*' has invalid type
+
+ string
+
+ The expected type is
+
+ number
+
+ The procedure's type is
+
+ (procedure scheme#* (#!rest number) number)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:137)
+ In `foo#blabla', a toplevel procedure
+ In procedure call
+
+ (scheme#+ 1 'x)
+
+ Argument #2 to procedure `scheme#+' has invalid type
+
+ symbol
+
+ The expected type is
+
+ number
+
+ The procedure's type is
+
+ (procedure scheme#+ (#!rest number) number)
+
+Warning: At toplevel:
use of deprecated `deprecated-procedure'
-Warning: at toplevel:
+Warning: At toplevel:
use of deprecated `another-deprecated-procedure' - consider
`replacement-procedure'
-Warning: at toplevel:
- (scrutiny-tests.scm:168) in procedure call to `apply1', expected argument #2
of type `(list-of number)' but was given an argument of type `(list symbol
fixnum fixnum)'
+Warning: Type mismatch.
+ (scrutiny-tests.scm:168)
+ At toplevel:
+ In procedure call
-Warning: at toplevel:
- (scrutiny-tests.scm:169) in procedure call to `apply1', expected argument #2
of type `(list-of number)' but was given an argument of type `(list symbol
fixnum fixnum)'
+ (apply1 scheme#+ (scheme#list 'a 2 3))
-Note: at toplevel:
- (scrutiny-tests.scm:182) in procedure call to `chicken.base#fixnum?', the
predicate is called with an argument of type `fixnum' and will always return
true
+ Argument #2 to procedure `apply1' has invalid type
-Note: at toplevel:
- (scrutiny-tests.scm:190) in procedure call to `scheme#symbol?', the
predicate is called with an argument of type `(or char string)' and will always
return false
+ (list symbol fixnum fixnum)
-Note: at toplevel:
- (scrutiny-tests.scm:191) in procedure call to `scheme#string?', the
predicate is called with an argument of type `(not (or char string))' and will
always return false
+ The expected type is
-Note: at toplevel:
- (scrutiny-tests.scm:194) in procedure call to `char-or-string?', the
predicate is called with an argument of type `fixnum' and will always return
false
+ (list-of number)
-Note: at toplevel:
- (scrutiny-tests.scm:195) in procedure call to `scheme#symbol?', the
predicate is called with an argument of type `(or char string)' and will always
return false
+ The procedure's type is
-Note: at toplevel:
- (scrutiny-tests.scm:196) in procedure call to `scheme#string?', the
predicate is called with an argument of type `fixnum' and will always return
false
+ (forall
+ (a143 b144)
+ (procedure apply1 ((procedure (#!rest a143) b144) (list-of a143)) b144))
-Note: at toplevel:
- (scrutiny-tests.scm:200) in procedure call to `scheme#symbol?', the
predicate is called with an argument of type `char' and will always return false
+Warning: Type mismatch.
+ (scrutiny-tests.scm:169)
+ At toplevel:
+ In procedure call
-Note: at toplevel:
- (scrutiny-tests.scm:201) in procedure call to `scheme#string?', the
predicate is called with an argument of type `symbol' and will always return
false
+ (apply1 scheme#+ (scheme#cons 'a (scheme#cons 2 (scheme#cons 3 ...))))
-Note: at toplevel:
- (scrutiny-tests.scm:205) in procedure call to `scheme#symbol?', the
predicate is called with an argument of type `(or char string)' and will always
return false
+ Argument #2 to procedure `apply1' has invalid type
-Note: at toplevel:
- (scrutiny-tests.scm:206) in procedure call to `scheme#string?', the
predicate is called with an argument of type `symbol' and will always return
false
+ (list symbol fixnum fixnum)
-Warning: at toplevel:
- (scrutiny-tests.scm:210) in procedure call to `f', expected argument #1 of
type `pair' but was given an argument of type `null'
+ The expected type is
-Warning: at toplevel:
- (scrutiny-tests.scm:212) in procedure call to `f', expected argument #1 of
type `null' but was given an argument of type `(list fixnum)'
+ (list-of number)
-Warning: at toplevel:
- (scrutiny-tests.scm:214) in procedure call to `f', expected argument #1 of
type `list' but was given an argument of type `(pair fixnum fixnum)'
+ The procedure's type is
-Warning: in toplevel procedure `vector-ref-warn1':
+ (forall
+ (a143 b144)
+ (procedure apply1 ((procedure (#!rest a143) b144) (list-of a143)) b144))
+
+Note: Type mismatch.
+ (scrutiny-tests.scm:182)
+ At toplevel:
+ In predicate call
+
+ (chicken.base#fixnum? x)
+
+ Predicate call will always return true.
+
+ Procedure `chicken.base#fixnum?' is a predicate for
+
+ fixnum
+
+ The given argument has type
+
+ fixnum
+
+Note: Type mismatch.
+ (scrutiny-tests.scm:190)
+ At toplevel:
+ In predicate call
+
+ (scheme#symbol? x)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#symbol?' is a predicate for
+
+ symbol
+
+ The given argument has type
+
+ (or char string)
+
+Note: Type mismatch.
+ (scrutiny-tests.scm:191)
+ At toplevel:
+ In predicate call
+
+ (scheme#string? x)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#string?' is a predicate for
+
+ string
+
+ The given argument has type
+
+ (not (or char string))
+
+Note: Type mismatch.
+ (scrutiny-tests.scm:194)
+ At toplevel:
+ In predicate call
+
+ (char-or-string? x)
+
+ Predicate call will always return false.
+
+ Procedure `char-or-string?' is a predicate for
+
+ (or char string)
+
+ The given argument has type
+
+ fixnum
+
+Note: Type mismatch.
+ (scrutiny-tests.scm:195)
+ At toplevel:
+ In predicate call
+
+ (scheme#symbol? x)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#symbol?' is a predicate for
+
+ symbol
+
+ The given argument has type
+
+ (or char string)
+
+Note: Type mismatch.
+ (scrutiny-tests.scm:196)
+ At toplevel:
+ In predicate call
+
+ (scheme#string? x)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#string?' is a predicate for
+
+ string
+
+ The given argument has type
+
+ fixnum
+
+Note: Type mismatch.
+ (scrutiny-tests.scm:200)
+ At toplevel:
+ In predicate call
+
+ (scheme#symbol? x)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#symbol?' is a predicate for
+
+ symbol
+
+ The given argument has type
+
+ char
+
+Note: Type mismatch.
+ (scrutiny-tests.scm:201)
+ At toplevel:
+ In predicate call
+
+ (scheme#string? x)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#string?' is a predicate for
+
+ string
+
+ The given argument has type
+
+ symbol
+
+Note: Type mismatch.
+ (scrutiny-tests.scm:205)
+ At toplevel:
+ In predicate call
+
+ (scheme#symbol? x)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#symbol?' is a predicate for
+
+ symbol
+
+ The given argument has type
+
+ (or char string)
+
+Note: Type mismatch.
+ (scrutiny-tests.scm:206)
+ At toplevel:
+ In predicate call
+
+ (scheme#string? x)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#string?' is a predicate for
+
+ string
+
+ The given argument has type
+
+ symbol
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:210)
+ At toplevel:
+ In procedure call
+
+ (f (scheme#list))
+
+ Argument #1 to procedure `f' has invalid type
+
+ null
+
+ The expected type is
+
+ pair
+
+ The procedure's type is
+
+ (procedure (pair) *)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:212)
+ At toplevel:
+ In procedure call
+
+ (f (scheme#list 1))
+
+ Argument #1 to procedure `f' has invalid type
+
+ (list fixnum)
+
+ The expected type is
+
+ null
+
+ The procedure's type is
+
+ (procedure (null) *)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:214)
+ At toplevel:
+ In procedure call
+
+ (f (scheme#cons 1 2))
+
+ Argument #1 to procedure `f' has invalid type
+
+ (pair fixnum fixnum)
+
+ The expected type is
+
+ list
+
+ The procedure's type is
+
+ (procedure (list) *)
+
+Warning: In `vector-ref-warn1', a toplevel procedure
(scrutiny-tests.scm:220) in procedure call to `scheme#vector-ref', index -1
out of range for vector of length 3
-Warning: in toplevel procedure `vector-ref-warn2':
+Warning: In `vector-ref-warn2', a toplevel procedure
(scrutiny-tests.scm:222) in procedure call to `scheme#vector-ref', index 3
out of range for vector of length 3
-Warning: in toplevel procedure `vector-ref-warn3':
+Warning: In `vector-ref-warn3', a toplevel procedure
(scrutiny-tests.scm:223) in procedure call to `scheme#vector-ref', index 4
out of range for vector of length 3
-Warning: in toplevel procedure `vector-ref-standard-warn1':
- (scrutiny-tests.scm:226) in procedure call to `scheme#vector-ref', expected
argument #2 of type `fixnum' but was given an argument of type `symbol'
+Warning: Type mismatch.
+ (scrutiny-tests.scm:226)
+ In `vector-ref-standard-warn1', a toplevel procedure
+ In procedure call
-Warning: in toplevel procedure `vector-set!-warn1':
+ (scheme#vector-ref v1 'bad)
+
+ Argument #2 to procedure `scheme#vector-ref' has invalid type
+
+ symbol
+
+ The expected type is
+
+ fixnum
+
+ The procedure's type is
+
+ (forall (a384) (procedure scheme#vector-ref ((vector-of a384) fixnum)
a384))
+
+Warning: In `vector-set!-warn1', a toplevel procedure
(scrutiny-tests.scm:227) in procedure call to `scheme#vector-set!', index -1
out of range for vector of length 3
-Warning: in toplevel procedure `vector-set!-warn2':
+Warning: In `vector-set!-warn2', a toplevel procedure
(scrutiny-tests.scm:228) in procedure call to `scheme#vector-set!', index 3
out of range for vector of length 3
-Warning: in toplevel procedure `vector-set!-warn3':
+Warning: In `vector-set!-warn3', a toplevel procedure
(scrutiny-tests.scm:229) in procedure call to `scheme#vector-set!', index 4
out of range for vector of length 3
-Warning: in toplevel procedure `vector-set!-standard-warn1':
- (scrutiny-tests.scm:232) in procedure call to `scheme#vector-set!', expected
argument #2 of type `fixnum' but was given an argument of type `symbol'
+Warning: Type mismatch.
+ (scrutiny-tests.scm:232)
+ In `vector-set!-standard-warn1', a toplevel procedure
+ In procedure call
-Warning: in toplevel procedure `list-ref-warn1':
+ (scheme#vector-set! v1 'bad 'whatever)
+
+ Argument #2 to procedure `scheme#vector-set!' has invalid type
+
+ symbol
+
+ The expected type is
+
+ fixnum
+
+ The procedure's type is
+
+ (procedure scheme#vector-set! (vector fixnum *) undefined)
+
+Warning: In `list-ref-warn1', a toplevel procedure
(scrutiny-tests.scm:238) in procedure call to `scheme#list-ref', index -1 is
negative, which is never valid
-Warning: in toplevel procedure `list-ref-warn2':
+Warning: In `list-ref-warn2', a toplevel procedure
(scrutiny-tests.scm:241) in procedure call to `scheme#list-ref', index -1 is
negative, which is never valid
-Warning: in toplevel procedure `list-ref-warn3':
+Warning: In `list-ref-warn3', a toplevel procedure
(scrutiny-tests.scm:244) in procedure call to `scheme#list-ref', index -1 is
negative, which is never valid
-Warning: in toplevel procedure `list-ref-warn4':
+Warning: In `list-ref-warn4', a toplevel procedure
(scrutiny-tests.scm:246) in procedure call to `scheme#list-ref', index 3 out
of range for proper list of length 3
-Warning: in toplevel procedure `list-ref-warn5':
+Warning: In `list-ref-warn5', a toplevel procedure
(scrutiny-tests.scm:252) in procedure call to `scheme#list-ref', index 4 out
of range for proper list of length 3
-Warning: in toplevel procedure `list-ref-standard-warn1':
- (scrutiny-tests.scm:281) in procedure call to `scheme#list-ref', expected
argument #2 of type `fixnum' but was given an argument of type `symbol'
+Warning: Type mismatch.
+ (scrutiny-tests.scm:281)
+ In `list-ref-standard-warn1', a toplevel procedure
+ In procedure call
-Warning: in toplevel procedure `list-ref-standard-warn2':
- (scrutiny-tests.scm:282) in procedure call to `scheme#list-ref', expected
argument #2 of type `fixnum' but was given an argument of type `symbol'
+ (scheme#list-ref l1 'bad)
-Warning: in toplevel procedure `list-ref-standard-warn3':
- (scrutiny-tests.scm:284) in procedure call to `scheme#list-ref', expected
argument #2 of type `fixnum' but was given an argument of type `symbol'
+ Argument #2 to procedure `scheme#list-ref' has invalid type
-Warning: in toplevel procedure `list-ref-standard-warn4':
- (scrutiny-tests.scm:285) in procedure call to `scheme#list-ref', expected
argument #2 of type `fixnum' but was given an argument of type `symbol'
+ symbol
-Warning: in toplevel procedure `list-ref-type-warn1':
- (scrutiny-tests.scm:289) in procedure call to `chicken.base#add1', expected
argument #1 of type `number' but was given an argument of type `symbol'
+ The expected type is
-Warning: in toplevel procedure `list-ref-type-warn2':
- (scrutiny-tests.scm:291) in procedure call to `chicken.base#add1', expected
argument #1 of type `number' but was given an argument of type `symbol'
+ fixnum
-Warning: in toplevel procedure `list-ref-type-warn3':
- (scrutiny-tests.scm:295) in procedure call to `chicken.base#add1', expected
argument #1 of type `number' but was given an argument of type `symbol'
+ The procedure's type is
-Warning: in toplevel procedure `append-result-type-warn1':
- (scrutiny-tests.scm:307) in procedure call to `chicken.base#add1', expected
argument #1 of type `number' but was given an argument of type `symbol'
+ (forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
-Warning: in toplevel procedure `append-result-type-warn2':
- (scrutiny-tests.scm:312) in procedure call to `chicken.base#add1', expected
argument #1 of type `number' but was given an argument of type `symbol'
+Warning: Type mismatch.
+ (scrutiny-tests.scm:282)
+ In `list-ref-standard-warn2', a toplevel procedure
+ In procedure call
+
+ (scheme#list-ref l1 'bad)
+
+ Argument #2 to procedure `scheme#list-ref' has invalid type
+
+ symbol
+
+ The expected type is
+
+ fixnum
+
+ The procedure's type is
+
+ (forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:284)
+ In `list-ref-standard-warn3', a toplevel procedure
+ In procedure call
+
+ (scheme#list-ref l2 'bad)
+
+ Argument #2 to procedure `scheme#list-ref' has invalid type
+
+ symbol
+
+ The expected type is
+
+ fixnum
+
+ The procedure's type is
+
+ (forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:285)
+ In `list-ref-standard-warn4', a toplevel procedure
+ In procedure call
+
+ (scheme#list-ref l2 'bad)
+
+ Argument #2 to procedure `scheme#list-ref' has invalid type
+
+ symbol
+
+ The expected type is
+
+ fixnum
+
+ The procedure's type is
+
+ (forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:289)
+ In `list-ref-type-warn1', a toplevel procedure
+ In procedure call
+
+ (chicken.base#add1 (scheme#list-ref l1 1))
+
+ Argument #1 to procedure `chicken.base#add1' has invalid type
+
+ symbol
+
+ The expected type is
+
+ number
+
+ The procedure's type is
+
+ (procedure chicken.base#add1 (number) number)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:291)
+ In `list-ref-type-warn2', a toplevel procedure
+ In procedure call
+
+ (chicken.base#add1 (scheme#list-ref l2 1))
+
+ Argument #1 to procedure `chicken.base#add1' has invalid type
+
+ symbol
+
+ The expected type is
+
+ number
+
+ The procedure's type is
+
+ (procedure chicken.base#add1 (number) number)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:295)
+ In `list-ref-type-warn3', a toplevel procedure
+ In procedure call
+
+ (chicken.base#add1 (scheme#list-ref l3 1))
+
+ Argument #1 to procedure `chicken.base#add1' has invalid type
+
+ symbol
+
+ The expected type is
+
+ number
+
+ The procedure's type is
+
+ (procedure chicken.base#add1 (number) number)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:307)
+ In `append-result-type-warn1', a toplevel procedure
+ In procedure call
+
+ (chicken.base#add1 (scheme#list-ref l1 1))
+
+ Argument #1 to procedure `chicken.base#add1' has invalid type
+
+ symbol
+
+ The expected type is
+
+ number
+
+ The procedure's type is
+
+ (procedure chicken.base#add1 (number) number)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:312)
+ In `append-result-type-warn2', a toplevel procedure
+ In procedure call
+
+ (chicken.base#add1 (scheme#list-ref l3 3))
+
+ Argument #1 to procedure `chicken.base#add1' has invalid type
+
+ symbol
+
+ The expected type is
+
+ number
+
+ The procedure's type is
+
+ (procedure chicken.base#add1 (number) number)
Warning: redefinition of standard binding: scheme#car
diff --git a/tests/specialization.expected b/tests/specialization.expected
index b3a395a..3861be4 100644
--- a/tests/specialization.expected
+++ b/tests/specialization.expected
@@ -1,34 +1,112 @@
;; numbers replaced with XXX by redact-gensyms.scm
;; prefixes: (tmp g)
-Note: at toplevel:
- (specialization-tests.scm:3) in procedure call to `scheme#string?', the
predicate is called with an argument of type `string' and will always return
true
+Note: Type mismatch.
+ (specialization-tests.scm:3)
+ At toplevel:
+ In predicate call
-Note: at toplevel:
- (specialization-tests.scm:3) expected a value of type boolean in
conditional, but was given a value of type `true' which is always true:
+ (scheme#string? a)
-(if (scheme#string? a) 'ok 'no)
+ Predicate call will always return true.
-Note: at toplevel:
- (specialization-tests.scm:4) in procedure call to `scheme#string?', the
predicate is called with an argument of type `symbol' and will always return
false
+ Procedure `scheme#string?' is a predicate for
-Note: at toplevel:
- (specialization-tests.scm:4) in conditional, test expression will always
return false:
+ string
-(if (scheme#string? a) 'ok 'no)
+ The given argument has type
-Note: at toplevel:
- (specialization-tests.scm:10) in procedure call to `scheme#input-port?', the
predicate is called with an argument of type `input/output-port' and will
always return true
+ string
-Note: at toplevel:
- (specialization-tests.scm:10) expected a value of type boolean in
conditional, but was given a value of type `true' which is always true:
+Note: Type mismatch.
+ (specialization-tests.scm:3)
+ At toplevel:
+ In conditional expression
-(if (scheme#input-port? p) 'ok 'no)
+ (if (scheme#string? a) 'ok 'no)
-Note: at toplevel:
- (specialization-tests.scm:11) in procedure call to `scheme#output-port?',
the predicate is called with an argument of type `input/output-port' and will
always return true
+ Test condition has always true value of type
-Note: at toplevel:
- (specialization-tests.scm:11) expected a value of type boolean in
conditional, but was given a value of type `true' which is always true:
+ true
-(if (scheme#output-port? p) 'ok 'no)
+Note: Type mismatch.
+ (specialization-tests.scm:4)
+ At toplevel:
+ In predicate call
+
+ (scheme#string? a)
+
+ Predicate call will always return false.
+
+ Procedure `scheme#string?' is a predicate for
+
+ string
+
+ The given argument has type
+
+ symbol
+
+Note: Type mismatch.
+ (specialization-tests.scm:4)
+ At toplevel:
+ In conditional expression
+
+ (if (scheme#string? a) 'ok 'no)
+
+ Test condition is always false.
+
+Note: Type mismatch.
+ (specialization-tests.scm:10)
+ At toplevel:
+ In predicate call
+
+ (scheme#input-port? p)
+
+ Predicate call will always return true.
+
+ Procedure `scheme#input-port?' is a predicate for
+
+ input-port
+
+ The given argument has type
+
+ input/output-port
+
+Note: Type mismatch.
+ (specialization-tests.scm:10)
+ At toplevel:
+ In conditional expression
+
+ (if (scheme#input-port? p) 'ok 'no)
+
+ Test condition has always true value of type
+
+ true
+
+Note: Type mismatch.
+ (specialization-tests.scm:11)
+ At toplevel:
+ In predicate call
+
+ (scheme#output-port? p)
+
+ Predicate call will always return true.
+
+ Procedure `scheme#output-port?' is a predicate for
+
+ output-port
+
+ The given argument has type
+
+ input/output-port
+
+Note: Type mismatch.
+ (specialization-tests.scm:11)
+ At toplevel:
+ In conditional expression
+
+ (if (scheme#output-port? p) 'ok 'no)
+
+ Test condition has always true value of type
+
+ true
--
2.7.4
>From 506913e8ab0bd4e7aabd6dc00023d27ef534e333 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Mon, 19 Nov 2018 11:55:01 +0200
Subject: [PATCH 05/17] Print variable name and its module separately in
scrutinizer messages
It's faster to visually parse `foo' from `bar' than `bar#foo'.
* scrutinizer.scm (variable-from-module) : New function
---
scrutinizer.scm | 30 +++---
tests/scrutinizer-message-format.expected | 41 +++++----
tests/scrutiny-2.expected | 88 +++++++++---------
tests/scrutiny.expected | 148 +++++++++++++++---------------
tests/specialization.expected | 16 ++--
tests/test-scrutinizer-message-format.scm | 2 +-
6 files changed, 168 insertions(+), 157 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 54eec7d..21583c8 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -2465,6 +2465,12 @@
(rec (cdr loc)
(cons (sprintf "In `~a', a local procedure" (lname (car
loc))) msgs)))))))
+(define (variable-from-module sym)
+ (let ((r (string-split (symbol->string sym) "#" #t)))
+ (if (= (length r) 2)
+ (sprintf "`~a', imported from `~a'," (second r) (first r))
+ (sprintf "`~a'" sym))))
+
(define (report2 report-f location-node-candidates loc msg . args)
(define (file-location)
(any (lambda (n) (and (not (string=? "" (node-source-prefix n)))
@@ -2518,13 +2524,14 @@
"~%~%"
"Procedure `~a' is called with ~a argument~a but ~a argument~a is
expected."
"~%~%"
- "The procedure's type is"
+ "Procedure ~a has this type"
"~%~%"
"~a")
(pp-fragment node " ")
- pname
+ (strip-namespace pname)
argc (multiples argc)
exp-count (multiples exp-count)
+ (variable-from-module pname)
(type->pp-string ptype)))
(define (r-proc-call-argument-type-mismatch loc node pname i xptype atype
ptype)
@@ -2545,14 +2552,15 @@
"~%~%"
"~a"
"~%~%"
- "The procedure's type is"
+ "Procedure ~a has this type"
"~%~%"
"~a")
(pp-fragment node " ")
i
- pname
+ (strip-namespace pname)
(type->pp-string atype)
(type->pp-string xptype)
+ (variable-from-module pname)
(type->pp-string ptype)))
(define (r-pred-call-always-true loc node pname pred-type atype)
@@ -2567,15 +2575,15 @@
"~%~%"
"Predicate call will always return true."
"~%~%"
- "Procedure `~a' is a predicate for"
+ "Procedure ~a is a predicate for"
"~%~%"
"~a"
"~%~%"
- "The given argument has type"
+ "The given argument has this type"
"~%~%"
"~a")
(pp-fragment node " ")
- pname
+ (variable-from-module pname)
(type->pp-string pred-type)
(type->pp-string atype)))
@@ -2590,15 +2598,15 @@
"~%~%"
"Predicate call will always return false."
"~%~%"
- "Procedure `~a' is a predicate for"
+ "Procedure ~a is a predicate for"
"~%~%"
"~a"
"~%~%"
- "The given argument has type"
+ "The given argument has this type"
"~%~%"
"~a")
(pp-fragment node " ")
- pname
+ (variable-from-module pname)
(type->pp-string pred-type)
(type->pp-string atype)))
@@ -2753,7 +2761,7 @@
"~%~%"
"Variable `~a' is assigned invalid value."
"~%~%"
- "The assigned value has type"
+ "The assigned value has this type"
"~%~%"
"~a"
"~%~%"
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
index 6a24662..bd95d47 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -12,9 +12,9 @@ Warning: Type mismatch.
(scheme#cons '())
- Procedure `scheme#cons' is called with 1 argument but 2 arguments is
expected.
+ Procedure `cons' is called with 1 argument but 2 arguments is expected.
- The procedure's type is
+ Procedure `cons', imported from `scheme', has this type
(forall (aXXX bXXX) (procedure scheme#cons (aXXX bXXX) (pair aXXX bXXX)))
@@ -25,7 +25,7 @@ Warning: Type mismatch.
(scheme#length 'symbol)
- Argument #1 to procedure `scheme#length' has invalid type
+ Argument #1 to procedure `length' has invalid type
symbol
@@ -33,7 +33,7 @@ Warning: Type mismatch.
list
- The procedure's type is
+ Procedure `length', imported from `scheme', has this type
(procedure scheme#length (list) fixnum)
@@ -43,6 +43,9 @@ Warning: In `r-proc-call-argument-value-count', a toplevel
procedure
Warning: In `r-proc-call-argument-value-count', a toplevel procedure
(test-scrutinizer-message-format.scm:XXX) expected a single result in
argument #1 of procedure call `(scheme#vector (scheme#values))', but received
zero results
+Warning: In `r-proc-call-argument-value-count', a toplevel procedure
+ expected a single result in `let' binding of `gXXX', but received zero
results
+
Warning: Type mismatch.
(test-scrutinizer-message-format.scm:XXX)
In `r-cond-branch-value-count-mismatch', a toplevel procedure
@@ -83,11 +86,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `scheme#list?' is a predicate for
+ Procedure `list?', imported from `scheme', is a predicate for
list
- The given argument has type
+ The given argument has this type
null
@@ -100,11 +103,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#symbol?' is a predicate for
+ Procedure `symbol?', imported from `scheme', is a predicate for
symbol
- The given argument has type
+ The given argument has this type
fixnum
@@ -191,7 +194,7 @@ Warning: Type mismatch.
Variable `foo' is assigned invalid value.
- The assigned value has type
+ The assigned value has this type
fixnum
@@ -213,7 +216,7 @@ Warning: Type mismatch.
Variable `foo' is assigned invalid value.
- The assigned value has type
+ The assigned value has this type
fixnum
@@ -237,9 +240,9 @@ Warning: Type mismatch.
(scheme#cons '())
- Procedure `scheme#cons' is called with 1 argument but 2 arguments is
expected.
+ Procedure `cons' is called with 1 argument but 2 arguments is expected.
- The procedure's type is
+ Procedure `cons', imported from `scheme', has this type
(forall (aXXX bXXX) (procedure scheme#cons (aXXX bXXX) (pair aXXX bXXX)))
@@ -252,7 +255,7 @@ Warning: Type mismatch.
(scheme#string-length chicken.base#add1)
- Argument #1 to procedure `scheme#string-length' has invalid type
+ Argument #1 to procedure `string-length' has invalid type
(procedure chicken.base#add1 (number) number)
@@ -260,7 +263,7 @@ Warning: Type mismatch.
string
- The procedure's type is
+ Procedure `string-length', imported from `scheme', has this type
(procedure scheme#string-length (string) fixnum)
@@ -339,11 +342,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `scheme#list?' is a predicate for
+ Procedure `list?', imported from `scheme', is a predicate for
list
- The given argument has type
+ The given argument has this type
null
@@ -358,11 +361,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#symbol?' is a predicate for
+ Procedure `symbol?', imported from `scheme', is a predicate for
symbol
- The given argument has type
+ The given argument has this type
fixnum
@@ -417,7 +420,7 @@ Warning: Type mismatch.
Variable `m#foo2' is assigned invalid value.
- The assigned value has type
+ The assigned value has this type
fixnum
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index 5149f7a..d46c149 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -10,11 +10,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `scheme#pair?' is a predicate for
+ Procedure `pair?', imported from `scheme', is a predicate for
pair
- The given argument has type
+ The given argument has this type
pair
@@ -27,11 +27,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#pair?' is a predicate for
+ Procedure `pair?', imported from `scheme', is a predicate for
pair
- The given argument has type
+ The given argument has this type
null
@@ -44,11 +44,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#pair?' is a predicate for
+ Procedure `pair?', imported from `scheme', is a predicate for
pair
- The given argument has type
+ The given argument has this type
null
@@ -61,11 +61,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#pair?' is a predicate for
+ Procedure `pair?', imported from `scheme', is a predicate for
pair
- The given argument has type
+ The given argument has this type
fixnum
@@ -78,11 +78,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#pair?' is a predicate for
+ Procedure `pair?', imported from `scheme', is a predicate for
pair
- The given argument has type
+ The given argument has this type
float
@@ -95,11 +95,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `scheme#list?' is a predicate for
+ Procedure `list?', imported from `scheme', is a predicate for
list
- The given argument has type
+ The given argument has this type
null
@@ -112,11 +112,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `scheme#list?' is a predicate for
+ Procedure `list?', imported from `scheme', is a predicate for
list
- The given argument has type
+ The given argument has this type
null
@@ -129,11 +129,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#list?' is a predicate for
+ Procedure `list?', imported from `scheme', is a predicate for
list
- The given argument has type
+ The given argument has this type
fixnum
@@ -146,11 +146,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#list?' is a predicate for
+ Procedure `list?', imported from `scheme', is a predicate for
list
- The given argument has type
+ The given argument has this type
float
@@ -163,11 +163,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `scheme#null?' is a predicate for
+ Procedure `null?', imported from `scheme', is a predicate for
null
- The given argument has type
+ The given argument has this type
null
@@ -180,11 +180,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `scheme#null?' is a predicate for
+ Procedure `null?', imported from `scheme', is a predicate for
null
- The given argument has type
+ The given argument has this type
null
@@ -197,11 +197,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#null?' is a predicate for
+ Procedure `null?', imported from `scheme', is a predicate for
null
- The given argument has type
+ The given argument has this type
pair
@@ -214,11 +214,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#null?' is a predicate for
+ Procedure `null?', imported from `scheme', is a predicate for
null
- The given argument has type
+ The given argument has this type
fixnum
@@ -231,11 +231,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#null?' is a predicate for
+ Procedure `null?', imported from `scheme', is a predicate for
null
- The given argument has type
+ The given argument has this type
float
@@ -248,11 +248,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `chicken.base#fixnum?' is a predicate for
+ Procedure `fixnum?', imported from `chicken.base', is a predicate for
fixnum
- The given argument has type
+ The given argument has this type
fixnum
@@ -265,11 +265,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `chicken.base#fixnum?' is a predicate for
+ Procedure `fixnum?', imported from `chicken.base', is a predicate for
fixnum
- The given argument has type
+ The given argument has this type
float
@@ -282,11 +282,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `chicken.base#flonum?' is a predicate for
+ Procedure `flonum?', imported from `chicken.base', is a predicate for
float
- The given argument has type
+ The given argument has this type
float
@@ -299,11 +299,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `chicken.base#flonum?' is a predicate for
+ Procedure `flonum?', imported from `chicken.base', is a predicate for
float
- The given argument has type
+ The given argument has this type
fixnum
@@ -316,11 +316,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `scheme#number?' is a predicate for
+ Procedure `number?', imported from `scheme', is a predicate for
number
- The given argument has type
+ The given argument has this type
fixnum
@@ -333,11 +333,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `scheme#number?' is a predicate for
+ Procedure `number?', imported from `scheme', is a predicate for
number
- The given argument has type
+ The given argument has this type
float
@@ -350,11 +350,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `scheme#number?' is a predicate for
+ Procedure `number?', imported from `scheme', is a predicate for
number
- The given argument has type
+ The given argument has this type
number
@@ -367,10 +367,10 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#number?' is a predicate for
+ Procedure `number?', imported from `scheme', is a predicate for
number
- The given argument has type
+ The given argument has this type
null
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index c6b2fcf..9c820a5 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -57,7 +57,7 @@ Warning: Type mismatch.
number
- The procedure's type is
+ Procedure `bar' has this type
(procedure scheme#+ (#!rest number) number)
@@ -68,9 +68,9 @@ Warning: Type mismatch.
(scheme#string?)
- Procedure `scheme#string?' is called with 0 arguments but 1 argument is
expected.
+ Procedure `string?' is called with 0 arguments but 1 argument is expected.
- The procedure's type is
+ Procedure `string?', imported from `scheme', has this type
(procedure scheme#string? (*) boolean)
@@ -102,7 +102,7 @@ Warning: Type mismatch.
(scheme#+ 'a 'b)
- Argument #1 to procedure `scheme#+' has invalid type
+ Argument #1 to procedure `+' has invalid type
symbol
@@ -110,7 +110,7 @@ Warning: Type mismatch.
number
- The procedure's type is
+ Procedure `+', imported from `scheme', has this type
(procedure scheme#+ (#!rest number) number)
@@ -121,7 +121,7 @@ Warning: Type mismatch.
(scheme#+ 'a 'b)
- Argument #2 to procedure `scheme#+' has invalid type
+ Argument #2 to procedure `+' has invalid type
symbol
@@ -129,7 +129,7 @@ Warning: Type mismatch.
number
- The procedure's type is
+ Procedure `+', imported from `scheme', has this type
(procedure scheme#+ (#!rest number) number)
@@ -141,7 +141,7 @@ Warning: Type mismatch.
Variable `scheme#car' is assigned invalid value.
- The assigned value has type
+ The assigned value has this type
fixnum
@@ -183,7 +183,7 @@ Warning: Type mismatch.
(scheme#string-append x "abc")
- Argument #1 to procedure `scheme#string-append' has invalid type
+ Argument #1 to procedure `string-append' has invalid type
number
@@ -191,7 +191,7 @@ Warning: Type mismatch.
string
- The procedure's type is
+ Procedure `string-append', imported from `scheme', has this type
(procedure scheme#string-append (#!rest string) string)
@@ -210,7 +210,7 @@ Warning: Type mismatch.
string
- The procedure's type is
+ Procedure `foo3' has this type
(procedure foo3 (string) string)
@@ -221,7 +221,7 @@ Warning: Type mismatch.
(scheme#+ x 1)
- Argument #1 to procedure `scheme#+' has invalid type
+ Argument #1 to procedure `+' has invalid type
string
@@ -229,7 +229,7 @@ Warning: Type mismatch.
number
- The procedure's type is
+ Procedure `+', imported from `scheme', has this type
(procedure scheme#+ (#!rest number) number)
@@ -240,7 +240,7 @@ Warning: Type mismatch.
(scheme#+ x 3)
- Argument #1 to procedure `scheme#+' has invalid type
+ Argument #1 to procedure `+' has invalid type
string
@@ -248,7 +248,7 @@ Warning: Type mismatch.
number
- The procedure's type is
+ Procedure `+', imported from `scheme', has this type
(procedure scheme#+ (#!rest number) number)
@@ -259,7 +259,7 @@ Warning: Type mismatch.
(scheme#+ x 3)
- Argument #1 to procedure `scheme#+' has invalid type
+ Argument #1 to procedure `+' has invalid type
string
@@ -267,7 +267,7 @@ Warning: Type mismatch.
number
- The procedure's type is
+ Procedure `+', imported from `scheme', has this type
(procedure scheme#+ (#!rest number) number)
@@ -278,7 +278,7 @@ Warning: Type mismatch.
(scheme#+ x 1)
- Argument #1 to procedure `scheme#+' has invalid type
+ Argument #1 to procedure `+' has invalid type
string
@@ -286,7 +286,7 @@ Warning: Type mismatch.
number
- The procedure's type is
+ Procedure `+', imported from `scheme', has this type
(procedure scheme#+ (#!rest number) number)
@@ -305,7 +305,7 @@ Warning: Type mismatch.
string
- The procedure's type is
+ Procedure `foo9' has this type
(procedure foo9 (string) symbol)
@@ -316,7 +316,7 @@ Warning: Type mismatch.
(scheme#+ x 1)
- Argument #1 to procedure `scheme#+' has invalid type
+ Argument #1 to procedure `+' has invalid type
string
@@ -324,7 +324,7 @@ Warning: Type mismatch.
number
- The procedure's type is
+ Procedure `+', imported from `scheme', has this type
(procedure scheme#+ (#!rest number) number)
@@ -352,7 +352,7 @@ Warning: Type mismatch.
(scheme#string-append (the pair (scheme#substring x 0 10)))
- Argument #1 to procedure `scheme#string-append' has invalid type
+ Argument #1 to procedure `string-append' has invalid type
pair
@@ -360,7 +360,7 @@ Warning: Type mismatch.
string
- The procedure's type is
+ Procedure `string-append', imported from `scheme', has this type
(procedure scheme#string-append (#!rest string) string)
@@ -395,7 +395,7 @@ Warning: Type mismatch.
(scheme#* x y)
- Argument #1 to procedure `scheme#*' has invalid type
+ Argument #1 to procedure `*' has invalid type
string
@@ -403,7 +403,7 @@ Warning: Type mismatch.
number
- The procedure's type is
+ Procedure `*', imported from `scheme', has this type
(procedure scheme#* (#!rest number) number)
@@ -414,7 +414,7 @@ Warning: Type mismatch.
(scheme#+ 1 'x)
- Argument #2 to procedure `scheme#+' has invalid type
+ Argument #2 to procedure `+' has invalid type
symbol
@@ -422,7 +422,7 @@ Warning: Type mismatch.
number
- The procedure's type is
+ Procedure `+', imported from `scheme', has this type
(procedure scheme#+ (#!rest number) number)
@@ -447,7 +447,7 @@ Warning: Type mismatch.
(list-of number)
- The procedure's type is
+ Procedure `apply1' has this type
(forall
(a143 b144)
@@ -468,7 +468,7 @@ Warning: Type mismatch.
(list-of number)
- The procedure's type is
+ Procedure `apply1' has this type
(forall
(a143 b144)
@@ -483,11 +483,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `chicken.base#fixnum?' is a predicate for
+ Procedure `fixnum?', imported from `chicken.base', is a predicate for
fixnum
- The given argument has type
+ The given argument has this type
fixnum
@@ -500,11 +500,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#symbol?' is a predicate for
+ Procedure `symbol?', imported from `scheme', is a predicate for
symbol
- The given argument has type
+ The given argument has this type
(or char string)
@@ -517,11 +517,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#string?' is a predicate for
+ Procedure `string?', imported from `scheme', is a predicate for
string
- The given argument has type
+ The given argument has this type
(not (or char string))
@@ -538,7 +538,7 @@ Note: Type mismatch.
(or char string)
- The given argument has type
+ The given argument has this type
fixnum
@@ -551,11 +551,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#symbol?' is a predicate for
+ Procedure `symbol?', imported from `scheme', is a predicate for
symbol
- The given argument has type
+ The given argument has this type
(or char string)
@@ -568,11 +568,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#string?' is a predicate for
+ Procedure `string?', imported from `scheme', is a predicate for
string
- The given argument has type
+ The given argument has this type
fixnum
@@ -585,11 +585,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#symbol?' is a predicate for
+ Procedure `symbol?', imported from `scheme', is a predicate for
symbol
- The given argument has type
+ The given argument has this type
char
@@ -602,11 +602,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#string?' is a predicate for
+ Procedure `string?', imported from `scheme', is a predicate for
string
- The given argument has type
+ The given argument has this type
symbol
@@ -619,11 +619,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#symbol?' is a predicate for
+ Procedure `symbol?', imported from `scheme', is a predicate for
symbol
- The given argument has type
+ The given argument has this type
(or char string)
@@ -636,11 +636,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#string?' is a predicate for
+ Procedure `string?', imported from `scheme', is a predicate for
string
- The given argument has type
+ The given argument has this type
symbol
@@ -659,7 +659,7 @@ Warning: Type mismatch.
pair
- The procedure's type is
+ Procedure `f' has this type
(procedure (pair) *)
@@ -678,7 +678,7 @@ Warning: Type mismatch.
null
- The procedure's type is
+ Procedure `f' has this type
(procedure (null) *)
@@ -697,7 +697,7 @@ Warning: Type mismatch.
list
- The procedure's type is
+ Procedure `f' has this type
(procedure (list) *)
@@ -717,7 +717,7 @@ Warning: Type mismatch.
(scheme#vector-ref v1 'bad)
- Argument #2 to procedure `scheme#vector-ref' has invalid type
+ Argument #2 to procedure `vector-ref' has invalid type
symbol
@@ -725,7 +725,7 @@ Warning: Type mismatch.
fixnum
- The procedure's type is
+ Procedure `vector-ref', imported from `scheme', has this type
(forall (a384) (procedure scheme#vector-ref ((vector-of a384) fixnum)
a384))
@@ -745,7 +745,7 @@ Warning: Type mismatch.
(scheme#vector-set! v1 'bad 'whatever)
- Argument #2 to procedure `scheme#vector-set!' has invalid type
+ Argument #2 to procedure `vector-set!' has invalid type
symbol
@@ -753,7 +753,7 @@ Warning: Type mismatch.
fixnum
- The procedure's type is
+ Procedure `vector-set!', imported from `scheme', has this type
(procedure scheme#vector-set! (vector fixnum *) undefined)
@@ -779,7 +779,7 @@ Warning: Type mismatch.
(scheme#list-ref l1 'bad)
- Argument #2 to procedure `scheme#list-ref' has invalid type
+ Argument #2 to procedure `list-ref' has invalid type
symbol
@@ -787,7 +787,7 @@ Warning: Type mismatch.
fixnum
- The procedure's type is
+ Procedure `list-ref', imported from `scheme', has this type
(forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
@@ -798,7 +798,7 @@ Warning: Type mismatch.
(scheme#list-ref l1 'bad)
- Argument #2 to procedure `scheme#list-ref' has invalid type
+ Argument #2 to procedure `list-ref' has invalid type
symbol
@@ -806,7 +806,7 @@ Warning: Type mismatch.
fixnum
- The procedure's type is
+ Procedure `list-ref', imported from `scheme', has this type
(forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
@@ -817,7 +817,7 @@ Warning: Type mismatch.
(scheme#list-ref l2 'bad)
- Argument #2 to procedure `scheme#list-ref' has invalid type
+ Argument #2 to procedure `list-ref' has invalid type
symbol
@@ -825,7 +825,7 @@ Warning: Type mismatch.
fixnum
- The procedure's type is
+ Procedure `list-ref', imported from `scheme', has this type
(forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
@@ -836,7 +836,7 @@ Warning: Type mismatch.
(scheme#list-ref l2 'bad)
- Argument #2 to procedure `scheme#list-ref' has invalid type
+ Argument #2 to procedure `list-ref' has invalid type
symbol
@@ -844,7 +844,7 @@ Warning: Type mismatch.
fixnum
- The procedure's type is
+ Procedure `list-ref', imported from `scheme', has this type
(forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
@@ -855,7 +855,7 @@ Warning: Type mismatch.
(chicken.base#add1 (scheme#list-ref l1 1))
- Argument #1 to procedure `chicken.base#add1' has invalid type
+ Argument #1 to procedure `add1' has invalid type
symbol
@@ -863,7 +863,7 @@ Warning: Type mismatch.
number
- The procedure's type is
+ Procedure `add1', imported from `chicken.base', has this type
(procedure chicken.base#add1 (number) number)
@@ -874,7 +874,7 @@ Warning: Type mismatch.
(chicken.base#add1 (scheme#list-ref l2 1))
- Argument #1 to procedure `chicken.base#add1' has invalid type
+ Argument #1 to procedure `add1' has invalid type
symbol
@@ -882,7 +882,7 @@ Warning: Type mismatch.
number
- The procedure's type is
+ Procedure `add1', imported from `chicken.base', has this type
(procedure chicken.base#add1 (number) number)
@@ -893,7 +893,7 @@ Warning: Type mismatch.
(chicken.base#add1 (scheme#list-ref l3 1))
- Argument #1 to procedure `chicken.base#add1' has invalid type
+ Argument #1 to procedure `add1' has invalid type
symbol
@@ -901,7 +901,7 @@ Warning: Type mismatch.
number
- The procedure's type is
+ Procedure `add1', imported from `chicken.base', has this type
(procedure chicken.base#add1 (number) number)
@@ -912,7 +912,7 @@ Warning: Type mismatch.
(chicken.base#add1 (scheme#list-ref l1 1))
- Argument #1 to procedure `chicken.base#add1' has invalid type
+ Argument #1 to procedure `add1' has invalid type
symbol
@@ -920,7 +920,7 @@ Warning: Type mismatch.
number
- The procedure's type is
+ Procedure `add1', imported from `chicken.base', has this type
(procedure chicken.base#add1 (number) number)
@@ -931,7 +931,7 @@ Warning: Type mismatch.
(chicken.base#add1 (scheme#list-ref l3 3))
- Argument #1 to procedure `chicken.base#add1' has invalid type
+ Argument #1 to procedure `add1' has invalid type
symbol
@@ -939,7 +939,7 @@ Warning: Type mismatch.
number
- The procedure's type is
+ Procedure `add1', imported from `chicken.base', has this type
(procedure chicken.base#add1 (number) number)
diff --git a/tests/specialization.expected b/tests/specialization.expected
index 3861be4..3301db9 100644
--- a/tests/specialization.expected
+++ b/tests/specialization.expected
@@ -10,11 +10,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `scheme#string?' is a predicate for
+ Procedure `string?', imported from `scheme', is a predicate for
string
- The given argument has type
+ The given argument has this type
string
@@ -38,11 +38,11 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `scheme#string?' is a predicate for
+ Procedure `string?', imported from `scheme', is a predicate for
string
- The given argument has type
+ The given argument has this type
symbol
@@ -64,11 +64,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `scheme#input-port?' is a predicate for
+ Procedure `input-port?', imported from `scheme', is a predicate for
input-port
- The given argument has type
+ The given argument has this type
input/output-port
@@ -92,11 +92,11 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `scheme#output-port?' is a predicate for
+ Procedure `output-port?', imported from `scheme', is a predicate for
output-port
- The given argument has type
+ The given argument has this type
input/output-port
diff --git a/tests/test-scrutinizer-message-format.scm
b/tests/test-scrutinizer-message-format.scm
index 37dbcd2..0496657 100644
--- a/tests/test-scrutinizer-message-format.scm
+++ b/tests/test-scrutinizer-message-format.scm
@@ -8,7 +8,7 @@
(define (r-proc-call-argument-count-mismatch) (cons '()))
(define (r-proc-call-argument-type-mismatch) (length 'symbol))
-(define (r-proc-call-argument-value-count) (list (cpu-time)) (vector (values)))
+(define (r-proc-call-argument-value-count) (list (cpu-time)) (vector (values))
((values)))
(define (r-cond-branch-value-count-mismatch) (if (the * 1) 1 (cpu-time)))
(define (r-invalid-called-procedure-type) (1 2))
(define (r-pred-call-always-true) (list? '()))
--
2.7.4
>From fca1e4987883d6a90168d0b656abbc9838cea837 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Mon, 19 Nov 2018 13:11:09 +0200
Subject: [PATCH 06/17] Pretty print procedure types with "->"s and "'"s
This is faster to read: ('a -> 'b)
than this: (forall (a b) (procedure (a) b))
* tests/runtests.sh: Use -specialize so we get the pure annotation for
'cons'.
---
scrutinizer.scm | 62 ++++++++++++++++++++------
tests/runtests.sh | 2 +-
tests/scrutinizer-message-format.expected | 14 +++---
tests/scrutiny.expected | 72 +++++++++++++++----------------
4 files changed, 92 insertions(+), 58 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 21583c8..6bcfe88 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -2413,16 +2413,54 @@
(string-append s "\n")
s)))
-(define (type->pp-string t)
- (string-add-indent
- (string-chomp
- (with-output-to-string
- (lambda ()
- (let ((t (strip-syntax t)))
- (if (refinement-type? t)
- (printf "~a-~a" (string-intersperse (map conc (second t)) "/")
(third t))
- (pp t))))))
- " "))
+(define (type->pp-string t #!optional (proc-name? #t) (bomb? #t))
+ (define (pr t)
+ (string-add-indent
+ (string-chomp
+ (with-output-to-string
+ (lambda ()
+ (pp t))))
+ " "))
+
+ (define (conv t #!optional (tv-replacements '()))
+ (define (R t) (conv t tv-replacements))
+ (cond
+ ((not (pair? t))
+ (or (alist-ref t tv-replacements eq?)
+ (alist-ref t '((#!rest . &rest) (#!key . &key) (#!optional .
&optional)) eq?)
+ t))
+ ((refinement-type? t)
+ (string->symbol
+ (sprintf "~a-~a" (string-intersperse (map conc (second t)) "/") (third
t))))
+ (else
+ (let ((tcar (and (pair? t) (car t))))
+ (cond
+ ((and (eq? 'forall tcar) (every symbol? (second t))) ;; no constraints
+ (let ((tvs (map (lambda (tv) (cons tv (list 'quote tv))) (second t))))
+ (conv (third t) tvs)))
+ ((eq? 'forall tcar) t) ; forall with constraints, do nothing
+ ((memq tcar '(or not list vector pair list-of vector-of))
+ `(,tcar ,@(map R (cdr t))))
+ ((eq? 'struct tcar) t)
+ ((eq? 'procedure tcar)
+ (let ((args (map R (procedure-arguments t)))
+ (res (let ((res (procedure-results t)))
+ (if (eq? '* res)
+ #f
+ (map R res)))))
+ (if (or (and proc-name? (procedure-name t))
+ ;; '. *' return type not supported by ->
+ (not res))
+ `(procedure ,@(if (procedure-name t) (list (procedure-name t))
'())
+ ,args
+ ,@(or res '*))
+ `(,@args ,(if (and-let* ((pn (procedure-name t))
+ ((variable-mark pn '##compiler#pure))))
+ '--> '->)
+ ,@res))))
+ (bomb? (bomb "type->pp-string: unhandled type" t))
+ (else t))))))
+ (pr (conv (strip-syntax t))))
(define (fragment x)
(let ((x (build-expression-tree (source-node-tree x))))
@@ -2532,7 +2570,7 @@
argc (multiples argc)
exp-count (multiples exp-count)
(variable-from-module pname)
- (type->pp-string ptype)))
+ (type->pp-string ptype #f)))
(define (r-proc-call-argument-type-mismatch loc node pname i xptype atype
ptype)
(report2
@@ -2561,7 +2599,7 @@
(type->pp-string atype)
(type->pp-string xptype)
(variable-from-module pname)
- (type->pp-string ptype)))
+ (type->pp-string ptype #f)))
(define (r-pred-call-always-true loc node pname pred-type atype)
;; pname is "... proc call to predicate `foo' "
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 6c23a78..c1d5fb8 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -115,7 +115,7 @@ $compile typematch-tests.scm -specialize -no-warnings
$compile scrutiny-tests.scm -analyze-only -verbose 2>scrutiny.out
$compile specialization-tests.scm -analyze-only -verbose -specialize
2>specialization.out
$compile scrutiny-tests-2.scm -A -verbose 2>scrutiny-2.out
-$compile test-scrutinizer-message-format.scm -A -verbose
2>scrutinizer-message-format.out || true
+$compile test-scrutinizer-message-format.scm -A -specialize -verbose
2>scrutinizer-message-format.out || true
# Replace foo123 -> fooXX so gensyms don't trigger failures
$compile redact-gensyms.scm
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
index bd95d47..1aa12bb 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -16,7 +16,7 @@ Warning: Type mismatch.
Procedure `cons', imported from `scheme', has this type
- (forall (aXXX bXXX) (procedure scheme#cons (aXXX bXXX) (pair aXXX bXXX)))
+ ('aXXX 'bXXX --> (pair 'aXXX 'bXXX))
Warning: Type mismatch.
(test-scrutinizer-message-format.scm:XXX)
@@ -35,7 +35,7 @@ Warning: Type mismatch.
Procedure `length', imported from `scheme', has this type
- (procedure scheme#length (list) fixnum)
+ (list -> fixnum)
Warning: In `r-proc-call-argument-value-count', a toplevel procedure
(test-scrutinizer-message-format.scm:XXX) expected a single result in
argument #1 of procedure call `(scheme#list (chicken.time#cpu-time))', but
received 2 results
@@ -75,7 +75,7 @@ Warning: Type mismatch.
The expected type is
- (procedure (*) *)
+ (* -> *)
Note: Type mismatch.
(test-scrutinizer-message-format.scm:XXX)
@@ -244,7 +244,7 @@ Warning: Type mismatch.
Procedure `cons', imported from `scheme', has this type
- (forall (aXXX bXXX) (procedure scheme#cons (aXXX bXXX) (pair aXXX bXXX)))
+ ('aXXX 'bXXX --> (pair 'aXXX 'bXXX))
Warning: Type mismatch.
(test-scrutinizer-message-format.scm:XXX)
@@ -265,7 +265,7 @@ Warning: Type mismatch.
Procedure `string-length', imported from `scheme', has this type
- (procedure scheme#string-length (string) fixnum)
+ (string -> fixnum)
Warning: In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
@@ -312,7 +312,7 @@ Warning: Type mismatch.
The expected type is
- (procedure (*) *)
+ (* -> *)
Warning: Type mismatch.
In `m#toplevel-foo', a toplevel procedure
@@ -329,7 +329,7 @@ Warning: Type mismatch.
The expected type is
- (procedure (*) *)
+ (* -> *)
Note: Type mismatch.
(test-scrutinizer-message-format.scm:XXX)
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 9c820a5..02bb7ae 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -59,7 +59,7 @@ Warning: Type mismatch.
Procedure `bar' has this type
- (procedure scheme#+ (#!rest number) number)
+ (&rest number -> number)
Warning: Type mismatch.
(scrutiny-tests.scm:21)
@@ -72,7 +72,7 @@ Warning: Type mismatch.
Procedure `string?', imported from `scheme', has this type
- (procedure scheme#string? (*) boolean)
+ (* -> boolean)
Warning: At toplevel:
(scrutiny-tests.scm:23) expected a single result in argument #1 of procedure
call `(chicken.base#print (scheme#values 1 2))', but received 2 results
@@ -93,7 +93,7 @@ Warning: Type mismatch.
The expected type is
- (procedure () *)
+ (-> *)
Warning: Type mismatch.
(scrutiny-tests.scm:29)
@@ -112,7 +112,7 @@ Warning: Type mismatch.
Procedure `+', imported from `scheme', has this type
- (procedure scheme#+ (#!rest number) number)
+ (&rest number -> number)
Warning: Type mismatch.
(scrutiny-tests.scm:29)
@@ -131,7 +131,7 @@ Warning: Type mismatch.
Procedure `+', imported from `scheme', has this type
- (procedure scheme#+ (#!rest number) number)
+ (&rest number -> number)
Warning: Type mismatch.
At toplevel:
@@ -147,7 +147,7 @@ Warning: Type mismatch.
The declared type of `scheme#car' is
- (forall (a335) (procedure scheme#car ((pair a335 *)) a335))
+ (procedure scheme#car ((pair 'a335 *)) 'a335)
Warning: At toplevel:
expected a single result in `let' binding of `gXXX', but received 2 results
@@ -164,7 +164,7 @@ Warning: Type mismatch.
The expected type is
- (procedure () *)
+ (-> *)
Note: Type mismatch.
In `foo', a toplevel procedure
@@ -193,7 +193,7 @@ Warning: Type mismatch.
Procedure `string-append', imported from `scheme', has this type
- (procedure scheme#string-append (#!rest string) string)
+ (&rest string -> string)
Warning: Type mismatch.
(scrutiny-tests.scm:66)
@@ -212,7 +212,7 @@ Warning: Type mismatch.
Procedure `foo3' has this type
- (procedure foo3 (string) string)
+ (string -> string)
Warning: Type mismatch.
(scrutiny-tests.scm:71)
@@ -231,7 +231,7 @@ Warning: Type mismatch.
Procedure `+', imported from `scheme', has this type
- (procedure scheme#+ (#!rest number) number)
+ (&rest number -> number)
Warning: Type mismatch.
(scrutiny-tests.scm:77)
@@ -250,7 +250,7 @@ Warning: Type mismatch.
Procedure `+', imported from `scheme', has this type
- (procedure scheme#+ (#!rest number) number)
+ (&rest number -> number)
Warning: Type mismatch.
(scrutiny-tests.scm:83)
@@ -269,7 +269,7 @@ Warning: Type mismatch.
Procedure `+', imported from `scheme', has this type
- (procedure scheme#+ (#!rest number) number)
+ (&rest number -> number)
Warning: Type mismatch.
(scrutiny-tests.scm:90)
@@ -288,7 +288,7 @@ Warning: Type mismatch.
Procedure `+', imported from `scheme', has this type
- (procedure scheme#+ (#!rest number) number)
+ (&rest number -> number)
Warning: Type mismatch.
(scrutiny-tests.scm:104)
@@ -307,7 +307,7 @@ Warning: Type mismatch.
Procedure `foo9' has this type
- (procedure foo9 (string) symbol)
+ (string -> symbol)
Warning: Type mismatch.
(scrutiny-tests.scm:105)
@@ -326,7 +326,7 @@ Warning: Type mismatch.
Procedure `+', imported from `scheme', has this type
- (procedure scheme#+ (#!rest number) number)
+ (&rest number -> number)
Warning: Type mismatch.
(scrutiny-tests.scm:109)
@@ -362,7 +362,7 @@ Warning: Type mismatch.
Procedure `string-append', imported from `scheme', has this type
- (procedure scheme#string-append (#!rest string) string)
+ (&rest string -> string)
Warning: Type mismatch.
(scrutiny-tests.scm:110)
@@ -405,7 +405,7 @@ Warning: Type mismatch.
Procedure `*', imported from `scheme', has this type
- (procedure scheme#* (#!rest number) number)
+ (&rest number -> number)
Warning: Type mismatch.
(scrutiny-tests.scm:137)
@@ -424,7 +424,7 @@ Warning: Type mismatch.
Procedure `+', imported from `scheme', has this type
- (procedure scheme#+ (#!rest number) number)
+ (&rest number -> number)
Warning: At toplevel:
use of deprecated `deprecated-procedure'
@@ -449,9 +449,7 @@ Warning: Type mismatch.
Procedure `apply1' has this type
- (forall
- (a143 b144)
- (procedure apply1 ((procedure (#!rest a143) b144) (list-of a143)) b144))
+ ((&rest 'a143 -> 'b144) (list-of 'a143) -> 'b144)
Warning: Type mismatch.
(scrutiny-tests.scm:169)
@@ -470,9 +468,7 @@ Warning: Type mismatch.
Procedure `apply1' has this type
- (forall
- (a143 b144)
- (procedure apply1 ((procedure (#!rest a143) b144) (list-of a143)) b144))
+ ((&rest 'a143 -> 'b144) (list-of 'a143) -> 'b144)
Note: Type mismatch.
(scrutiny-tests.scm:182)
@@ -661,7 +657,7 @@ Warning: Type mismatch.
Procedure `f' has this type
- (procedure (pair) *)
+ (pair -> *)
Warning: Type mismatch.
(scrutiny-tests.scm:212)
@@ -680,7 +676,7 @@ Warning: Type mismatch.
Procedure `f' has this type
- (procedure (null) *)
+ (null -> *)
Warning: Type mismatch.
(scrutiny-tests.scm:214)
@@ -699,7 +695,7 @@ Warning: Type mismatch.
Procedure `f' has this type
- (procedure (list) *)
+ (list -> *)
Warning: In `vector-ref-warn1', a toplevel procedure
(scrutiny-tests.scm:220) in procedure call to `scheme#vector-ref', index -1
out of range for vector of length 3
@@ -727,7 +723,7 @@ Warning: Type mismatch.
Procedure `vector-ref', imported from `scheme', has this type
- (forall (a384) (procedure scheme#vector-ref ((vector-of a384) fixnum)
a384))
+ ((vector-of 'a384) fixnum -> 'a384)
Warning: In `vector-set!-warn1', a toplevel procedure
(scrutiny-tests.scm:227) in procedure call to `scheme#vector-set!', index -1
out of range for vector of length 3
@@ -755,7 +751,7 @@ Warning: Type mismatch.
Procedure `vector-set!', imported from `scheme', has this type
- (procedure scheme#vector-set! (vector fixnum *) undefined)
+ (vector fixnum * -> undefined)
Warning: In `list-ref-warn1', a toplevel procedure
(scrutiny-tests.scm:238) in procedure call to `scheme#list-ref', index -1 is
negative, which is never valid
@@ -789,7 +785,7 @@ Warning: Type mismatch.
Procedure `list-ref', imported from `scheme', has this type
- (forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
+ ((list-of 'a366) fixnum -> 'a366)
Warning: Type mismatch.
(scrutiny-tests.scm:282)
@@ -808,7 +804,7 @@ Warning: Type mismatch.
Procedure `list-ref', imported from `scheme', has this type
- (forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
+ ((list-of 'a366) fixnum -> 'a366)
Warning: Type mismatch.
(scrutiny-tests.scm:284)
@@ -827,7 +823,7 @@ Warning: Type mismatch.
Procedure `list-ref', imported from `scheme', has this type
- (forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
+ ((list-of 'a366) fixnum -> 'a366)
Warning: Type mismatch.
(scrutiny-tests.scm:285)
@@ -846,7 +842,7 @@ Warning: Type mismatch.
Procedure `list-ref', imported from `scheme', has this type
- (forall (a366) (procedure scheme#list-ref ((list-of a366) fixnum) a366))
+ ((list-of 'a366) fixnum -> 'a366)
Warning: Type mismatch.
(scrutiny-tests.scm:289)
@@ -865,7 +861,7 @@ Warning: Type mismatch.
Procedure `add1', imported from `chicken.base', has this type
- (procedure chicken.base#add1 (number) number)
+ (number -> number)
Warning: Type mismatch.
(scrutiny-tests.scm:291)
@@ -884,7 +880,7 @@ Warning: Type mismatch.
Procedure `add1', imported from `chicken.base', has this type
- (procedure chicken.base#add1 (number) number)
+ (number -> number)
Warning: Type mismatch.
(scrutiny-tests.scm:295)
@@ -903,7 +899,7 @@ Warning: Type mismatch.
Procedure `add1', imported from `chicken.base', has this type
- (procedure chicken.base#add1 (number) number)
+ (number -> number)
Warning: Type mismatch.
(scrutiny-tests.scm:307)
@@ -922,7 +918,7 @@ Warning: Type mismatch.
Procedure `add1', imported from `chicken.base', has this type
- (procedure chicken.base#add1 (number) number)
+ (number -> number)
Warning: Type mismatch.
(scrutiny-tests.scm:312)
@@ -941,6 +937,6 @@ Warning: Type mismatch.
Procedure `add1', imported from `chicken.base', has this type
- (procedure chicken.base#add1 (number) number)
+ (number -> number)
Warning: redefinition of standard binding: scheme#car
--
2.7.4
>From ed5f030bc2c6bde3b179e3e0c9a6c1e245fb4a0b Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Mon, 19 Nov 2018 13:45:43 +0200
Subject: [PATCH 07/17] Pretty print deprecation messages
* scrutinizer.scm (r-deprecated-identifier) : New function
---
scrutinizer.scm | 36 +++++++++----
tests/scrutinizer-message-format.expected | 66 ++++++++++++++++--------
tests/scrutiny-2.expected | 44 ++++++++--------
tests/scrutiny.expected | 84 ++++++++++++++++++-------------
tests/specialization.expected | 8 +--
5 files changed, 145 insertions(+), 93 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 6bcfe88..efdf1d6 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -219,18 +219,15 @@
((char? lit) 'char)
(else '*)))
- (define (global-result id loc)
+ (define (global-result id loc node)
(cond ((variable-mark id '##compiler#type) =>
(lambda (a)
(cond
((eq? a 'deprecated)
- (report loc "use of deprecated `~a'" id)
+ (r-deprecated-identifier loc node id)
'(*))
((and (pair? a) (eq? (car a) 'deprecated))
- (report
- loc
- "use of deprecated `~a' - consider `~a'"
- id (cadr a))
+ (r-deprecated-identifier loc node id (cadr a))
'(*))
(else (list a)))))
(else '(*))))
@@ -243,7 +240,7 @@
=> cdr)
(else #f)))
- (define (variable-result id e loc flow)
+ (define (variable-result id e loc node flow)
(cond ((blist-type id flow) => list)
((and (not strict)
(db-get db id 'assigned)
@@ -258,7 +255,7 @@
(real-name id db))
'(*))
(else (list (cdr a))))))
- (else (global-result id loc))))
+ (else (global-result id loc node))))
(define (always-true1 t)
(cond ((pair? t)
@@ -451,7 +448,7 @@
((quote) (list (constant-result (first params))))
((##core#undefined) '(*))
((##core#proc) '(procedure))
- ((##core#variable) (variable-result (first params) e loc flow))
+ ((##core#variable) (variable-result (first params) e loc n
flow))
((##core#inline_ref)
(list (foreign-type->scrutiny-type (second params) 'result)))
((##core#inline_loc_ref)
@@ -2506,7 +2503,7 @@
(define (variable-from-module sym)
(let ((r (string-split (symbol->string sym) "#" #t)))
(if (= (length r) 2)
- (sprintf "`~a', imported from `~a'," (second r) (first r))
+ (sprintf "`~a' from module `~a'" (second r) (first r))
(sprintf "`~a'" sym))))
(define (report2 report-f location-node-candidates loc msg . args)
@@ -2811,4 +2808,23 @@
(type->pp-string atype)
var
(type->pp-string xptype)))
+
+(define (r-deprecated-identifier loc node id #!optional suggestion)
+ (report2
+ warning
+ (list node)
+ loc
+ (string-append
+ "In expression"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Use of deprecated ~a."
+ "~a")
+ (pp-fragment node " ") ;; TODO: parent node would be nice here
+ (variable-from-module id)
+ (if suggestion
+ (sprintf "~%~%The suggested replacement is ~a."
+ (variable-from-module suggestion))
+ "")))
)
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
index 1aa12bb..3175e24 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -14,7 +14,7 @@ Warning: Type mismatch.
Procedure `cons' is called with 1 argument but 2 arguments is expected.
- Procedure `cons', imported from `scheme', has this type
+ Procedure `cons' from module `scheme' has this type
('aXXX 'bXXX --> (pair 'aXXX 'bXXX))
@@ -33,7 +33,7 @@ Warning: Type mismatch.
list
- Procedure `length', imported from `scheme', has this type
+ Procedure `length' from module `scheme' has this type
(list -> fixnum)
@@ -86,7 +86,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `list?', imported from `scheme', is a predicate for
+ Procedure `list?' from module `scheme' is a predicate for
list
@@ -103,7 +103,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `symbol?', imported from `scheme', is a predicate for
+ Procedure `symbol?' from module `scheme' is a predicate for
symbol
@@ -202,11 +202,23 @@ Warning: Type mismatch.
boolean
-Warning: In `r-deprecated-identifier', a toplevel procedure
- use of deprecated `deprecated-foo'
+Warning: Type mismatch.
+ In `r-deprecated-identifier', a toplevel procedure
+ In expression
-Warning: In `r-deprecated-identifier', a toplevel procedure
- use of deprecated `deprecated-foo2' - consider `foo'
+ deprecated-foo
+
+ Use of deprecated `deprecated-foo'.
+
+Warning: Type mismatch.
+ In `r-deprecated-identifier', a toplevel procedure
+ In expression
+
+ deprecated-foo2
+
+ Use of deprecated `deprecated-foo2'.
+
+ The suggested replacement is `foo'.
Warning: Type mismatch.
At toplevel:
@@ -242,7 +254,7 @@ Warning: Type mismatch.
Procedure `cons' is called with 1 argument but 2 arguments is expected.
- Procedure `cons', imported from `scheme', has this type
+ Procedure `cons' from module `scheme' has this type
('aXXX 'bXXX --> (pair 'aXXX 'bXXX))
@@ -263,7 +275,7 @@ Warning: Type mismatch.
string
- Procedure `string-length', imported from `scheme', has this type
+ Procedure `string-length' from module `scheme' has this type
(string -> fixnum)
@@ -342,7 +354,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `list?', imported from `scheme', is a predicate for
+ Procedure `list?' from module `scheme' is a predicate for
list
@@ -361,7 +373,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `symbol?', imported from `scheme', is a predicate for
+ Procedure `symbol?' from module `scheme' is a predicate for
symbol
@@ -428,15 +440,27 @@ Warning: Type mismatch.
boolean
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-deprecated-identifier', a local procedure
- use of deprecated `m#deprecated-foo'
-
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-deprecated-identifier', a local procedure
- use of deprecated `m#deprecated-foo2' - consider `foo'
+Warning: Type mismatch.
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-deprecated-identifier', a local procedure
+ In expression
+
+ m#deprecated-foo
+
+ Use of deprecated `deprecated-foo' from module `m'.
+
+Warning: Type mismatch.
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-deprecated-identifier', a local procedure
+ In expression
+
+ m#deprecated-foo2
+
+ Use of deprecated `deprecated-foo2' from module `m'.
+
+ The suggested replacement is `foo'.
Warning: Type mismatch.
(test-scrutinizer-message-format.scm:XXX)
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index d46c149..bdf7050 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -10,7 +10,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `pair?', imported from `scheme', is a predicate for
+ Procedure `pair?' from module `scheme' is a predicate for
pair
@@ -27,7 +27,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `pair?', imported from `scheme', is a predicate for
+ Procedure `pair?' from module `scheme' is a predicate for
pair
@@ -44,7 +44,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `pair?', imported from `scheme', is a predicate for
+ Procedure `pair?' from module `scheme' is a predicate for
pair
@@ -61,7 +61,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `pair?', imported from `scheme', is a predicate for
+ Procedure `pair?' from module `scheme' is a predicate for
pair
@@ -78,7 +78,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `pair?', imported from `scheme', is a predicate for
+ Procedure `pair?' from module `scheme' is a predicate for
pair
@@ -95,7 +95,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `list?', imported from `scheme', is a predicate for
+ Procedure `list?' from module `scheme' is a predicate for
list
@@ -112,7 +112,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `list?', imported from `scheme', is a predicate for
+ Procedure `list?' from module `scheme' is a predicate for
list
@@ -129,7 +129,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `list?', imported from `scheme', is a predicate for
+ Procedure `list?' from module `scheme' is a predicate for
list
@@ -146,7 +146,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `list?', imported from `scheme', is a predicate for
+ Procedure `list?' from module `scheme' is a predicate for
list
@@ -163,7 +163,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `null?', imported from `scheme', is a predicate for
+ Procedure `null?' from module `scheme' is a predicate for
null
@@ -180,7 +180,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `null?', imported from `scheme', is a predicate for
+ Procedure `null?' from module `scheme' is a predicate for
null
@@ -197,7 +197,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `null?', imported from `scheme', is a predicate for
+ Procedure `null?' from module `scheme' is a predicate for
null
@@ -214,7 +214,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `null?', imported from `scheme', is a predicate for
+ Procedure `null?' from module `scheme' is a predicate for
null
@@ -231,7 +231,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `null?', imported from `scheme', is a predicate for
+ Procedure `null?' from module `scheme' is a predicate for
null
@@ -248,7 +248,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `fixnum?', imported from `chicken.base', is a predicate for
+ Procedure `fixnum?' from module `chicken.base' is a predicate for
fixnum
@@ -265,7 +265,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `fixnum?', imported from `chicken.base', is a predicate for
+ Procedure `fixnum?' from module `chicken.base' is a predicate for
fixnum
@@ -282,7 +282,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `flonum?', imported from `chicken.base', is a predicate for
+ Procedure `flonum?' from module `chicken.base' is a predicate for
float
@@ -299,7 +299,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `flonum?', imported from `chicken.base', is a predicate for
+ Procedure `flonum?' from module `chicken.base' is a predicate for
float
@@ -316,7 +316,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `number?', imported from `scheme', is a predicate for
+ Procedure `number?' from module `scheme' is a predicate for
number
@@ -333,7 +333,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `number?', imported from `scheme', is a predicate for
+ Procedure `number?' from module `scheme' is a predicate for
number
@@ -350,7 +350,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `number?', imported from `scheme', is a predicate for
+ Procedure `number?' from module `scheme' is a predicate for
number
@@ -367,7 +367,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `number?', imported from `scheme', is a predicate for
+ Procedure `number?' from module `scheme' is a predicate for
number
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 02bb7ae..e5c5ddd 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -70,7 +70,7 @@ Warning: Type mismatch.
Procedure `string?' is called with 0 arguments but 1 argument is expected.
- Procedure `string?', imported from `scheme', has this type
+ Procedure `string?' from module `scheme' has this type
(* -> boolean)
@@ -110,7 +110,7 @@ Warning: Type mismatch.
number
- Procedure `+', imported from `scheme', has this type
+ Procedure `+' from module `scheme' has this type
(&rest number -> number)
@@ -129,7 +129,7 @@ Warning: Type mismatch.
number
- Procedure `+', imported from `scheme', has this type
+ Procedure `+' from module `scheme' has this type
(&rest number -> number)
@@ -191,7 +191,7 @@ Warning: Type mismatch.
string
- Procedure `string-append', imported from `scheme', has this type
+ Procedure `string-append' from module `scheme' has this type
(&rest string -> string)
@@ -229,7 +229,7 @@ Warning: Type mismatch.
number
- Procedure `+', imported from `scheme', has this type
+ Procedure `+' from module `scheme' has this type
(&rest number -> number)
@@ -248,7 +248,7 @@ Warning: Type mismatch.
number
- Procedure `+', imported from `scheme', has this type
+ Procedure `+' from module `scheme' has this type
(&rest number -> number)
@@ -267,7 +267,7 @@ Warning: Type mismatch.
number
- Procedure `+', imported from `scheme', has this type
+ Procedure `+' from module `scheme' has this type
(&rest number -> number)
@@ -286,7 +286,7 @@ Warning: Type mismatch.
number
- Procedure `+', imported from `scheme', has this type
+ Procedure `+' from module `scheme' has this type
(&rest number -> number)
@@ -324,7 +324,7 @@ Warning: Type mismatch.
number
- Procedure `+', imported from `scheme', has this type
+ Procedure `+' from module `scheme' has this type
(&rest number -> number)
@@ -360,7 +360,7 @@ Warning: Type mismatch.
string
- Procedure `string-append', imported from `scheme', has this type
+ Procedure `string-append' from module `scheme' has this type
(&rest string -> string)
@@ -403,7 +403,7 @@ Warning: Type mismatch.
number
- Procedure `*', imported from `scheme', has this type
+ Procedure `*' from module `scheme' has this type
(&rest number -> number)
@@ -422,15 +422,27 @@ Warning: Type mismatch.
number
- Procedure `+', imported from `scheme', has this type
+ Procedure `+' from module `scheme' has this type
(&rest number -> number)
-Warning: At toplevel:
- use of deprecated `deprecated-procedure'
+Warning: Type mismatch.
+ At toplevel:
+ In expression
-Warning: At toplevel:
- use of deprecated `another-deprecated-procedure' - consider
`replacement-procedure'
+ deprecated-procedure
+
+ Use of deprecated `deprecated-procedure'.
+
+Warning: Type mismatch.
+ At toplevel:
+ In expression
+
+ another-deprecated-procedure
+
+ Use of deprecated `another-deprecated-procedure'.
+
+ The suggested replacement is `replacement-procedure'.
Warning: Type mismatch.
(scrutiny-tests.scm:168)
@@ -479,7 +491,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `fixnum?', imported from `chicken.base', is a predicate for
+ Procedure `fixnum?' from module `chicken.base' is a predicate for
fixnum
@@ -496,7 +508,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `symbol?', imported from `scheme', is a predicate for
+ Procedure `symbol?' from module `scheme' is a predicate for
symbol
@@ -513,7 +525,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `string?', imported from `scheme', is a predicate for
+ Procedure `string?' from module `scheme' is a predicate for
string
@@ -547,7 +559,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `symbol?', imported from `scheme', is a predicate for
+ Procedure `symbol?' from module `scheme' is a predicate for
symbol
@@ -564,7 +576,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `string?', imported from `scheme', is a predicate for
+ Procedure `string?' from module `scheme' is a predicate for
string
@@ -581,7 +593,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `symbol?', imported from `scheme', is a predicate for
+ Procedure `symbol?' from module `scheme' is a predicate for
symbol
@@ -598,7 +610,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `string?', imported from `scheme', is a predicate for
+ Procedure `string?' from module `scheme' is a predicate for
string
@@ -615,7 +627,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `symbol?', imported from `scheme', is a predicate for
+ Procedure `symbol?' from module `scheme' is a predicate for
symbol
@@ -632,7 +644,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `string?', imported from `scheme', is a predicate for
+ Procedure `string?' from module `scheme' is a predicate for
string
@@ -721,7 +733,7 @@ Warning: Type mismatch.
fixnum
- Procedure `vector-ref', imported from `scheme', has this type
+ Procedure `vector-ref' from module `scheme' has this type
((vector-of 'a384) fixnum -> 'a384)
@@ -749,7 +761,7 @@ Warning: Type mismatch.
fixnum
- Procedure `vector-set!', imported from `scheme', has this type
+ Procedure `vector-set!' from module `scheme' has this type
(vector fixnum * -> undefined)
@@ -783,7 +795,7 @@ Warning: Type mismatch.
fixnum
- Procedure `list-ref', imported from `scheme', has this type
+ Procedure `list-ref' from module `scheme' has this type
((list-of 'a366) fixnum -> 'a366)
@@ -802,7 +814,7 @@ Warning: Type mismatch.
fixnum
- Procedure `list-ref', imported from `scheme', has this type
+ Procedure `list-ref' from module `scheme' has this type
((list-of 'a366) fixnum -> 'a366)
@@ -821,7 +833,7 @@ Warning: Type mismatch.
fixnum
- Procedure `list-ref', imported from `scheme', has this type
+ Procedure `list-ref' from module `scheme' has this type
((list-of 'a366) fixnum -> 'a366)
@@ -840,7 +852,7 @@ Warning: Type mismatch.
fixnum
- Procedure `list-ref', imported from `scheme', has this type
+ Procedure `list-ref' from module `scheme' has this type
((list-of 'a366) fixnum -> 'a366)
@@ -859,7 +871,7 @@ Warning: Type mismatch.
number
- Procedure `add1', imported from `chicken.base', has this type
+ Procedure `add1' from module `chicken.base' has this type
(number -> number)
@@ -878,7 +890,7 @@ Warning: Type mismatch.
number
- Procedure `add1', imported from `chicken.base', has this type
+ Procedure `add1' from module `chicken.base' has this type
(number -> number)
@@ -897,7 +909,7 @@ Warning: Type mismatch.
number
- Procedure `add1', imported from `chicken.base', has this type
+ Procedure `add1' from module `chicken.base' has this type
(number -> number)
@@ -916,7 +928,7 @@ Warning: Type mismatch.
number
- Procedure `add1', imported from `chicken.base', has this type
+ Procedure `add1' from module `chicken.base' has this type
(number -> number)
@@ -935,7 +947,7 @@ Warning: Type mismatch.
number
- Procedure `add1', imported from `chicken.base', has this type
+ Procedure `add1' from module `chicken.base' has this type
(number -> number)
diff --git a/tests/specialization.expected b/tests/specialization.expected
index 3301db9..11ed6f5 100644
--- a/tests/specialization.expected
+++ b/tests/specialization.expected
@@ -10,7 +10,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `string?', imported from `scheme', is a predicate for
+ Procedure `string?' from module `scheme' is a predicate for
string
@@ -38,7 +38,7 @@ Note: Type mismatch.
Predicate call will always return false.
- Procedure `string?', imported from `scheme', is a predicate for
+ Procedure `string?' from module `scheme' is a predicate for
string
@@ -64,7 +64,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `input-port?', imported from `scheme', is a predicate for
+ Procedure `input-port?' from module `scheme' is a predicate for
input-port
@@ -92,7 +92,7 @@ Note: Type mismatch.
Predicate call will always return true.
- Procedure `output-port?', imported from `scheme', is a predicate for
+ Procedure `output-port?' from module `scheme' is a predicate for
output-port
--
2.7.4
>From d327cf5213f8dc3f2fb059609b5f64f8456fd040 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Mon, 19 Nov 2018 15:52:22 +0200
Subject: [PATCH 08/17] Pretty print "wrong number of values for procedure
argument" errors
* scrutinizer.scm: Remove report-notice (unused)
* scrutinizer.scm: Rename report-notice2 -> report-notice
* scrutinizer.scm (scrutinize -> single2): New function. This is a
copy of single, but doesn't do the actual printing. The plan is to
replace all uses of single with this.
* scrutinizer.scm (r-proc-call-argument-value-count) : New function
Maybe could be called "r-proc-call-argument-invalid-value-count",
but that's perhaps too long
The p-arg-expr prints additional info if the expression is function
call.
---
scrutinizer.scm | 109 +++++++++++++++++++++++-------
tests/scrutinizer-message-format.expected | 82 ++++++++++++++++++----
tests/scrutiny.expected | 36 ++++++++--
3 files changed, 187 insertions(+), 40 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index efdf1d6..69684d3 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -172,11 +172,6 @@
(define (scrutinize node db complain specialize strict block-compilation)
(d "################################## SCRUTINIZE
##################################")
(set! *complain?* complain)
- (define (report-notice loc msg . args)
- (when complain
- (##sys#notice
- (conc (location-name loc)
- (sprintf "~?" msg args)))))
(define (report loc msg . args)
(when complain
@@ -300,6 +295,18 @@
(node-source-prefix node) what n (multiples n))
(first tv))))))
+ (define (single2 tv r-value-count-mismatch)
+ (if (eq? '* tv)
+ '*
+ (let ((n (length tv)))
+ (cond ((= 1 n) (car tv))
+ ((zero? n)
+ (r-value-count-mismatch tv)
+ 'undefined)
+ (else
+ (r-value-count-mismatch tv)
+ (first tv))))))
+
(define add-loc cons)
(define (get-specializations name)
@@ -652,22 +659,15 @@
((##core#call)
(let* ((f (fragment n))
(len (length subs))
- (args (map (lambda (n i)
+ (args (map (lambda (n2 i)
(make-node
'##core#the/result
(list
- (single
- n
- (sprintf
- "in ~a of procedure call `~s'"
- (if (zero? i)
- "operator position"
- (sprintf "argument #~a" i))
- f)
- (walk n e loc #f #f flow #f)
- loc))
- (list n)))
- subs
+ (single2
+ (walk n2 e loc #f #f flow #f)
+ (cut r-proc-call-argument-value-count
loc n i n2 <>)))
+ (list n2)))
+ subs
(iota len)))
(fn (walked-result (car args)))
(pn (procedure-name fn))
@@ -2521,7 +2521,7 @@
(sprintf "~?" msg args))
" ")))))
-(define (report-notice2 location-node-candidates loc msg . args)
+(define (report-notice location-node-candidates loc msg . args)
(apply report2 ##sys#notice location-node-candidates loc msg args))
;;; Reports
@@ -2598,9 +2598,72 @@
(variable-from-module pname)
(type->pp-string ptype #f)))
+(define (r-proc-call-argument-value-count loc call-node i arg-node atype)
+ (define pn
+ (if (zero? i) ""
+ (sprintf " `~a'"
+ (strip-namespace (fragment (first (node-subexpressions
call-node)))))))
+ (define (p-arg-expr)
+ (define (p-expr)
+ (sprintf (string-append
+ "This is the expression"
+ "~%~%"
+ "~a")
+ (pp-fragment arg-node)))
+ (or (and (eq? '##core#call (node-class arg-node))
+ (let ((pnode (first (node-subexpressions arg-node))))
+ (and-let* (((eq? '##core#variable (node-class pnode)))
+ (pname (car (node-parameters pnode)))
+ (ptype (variable-mark pname '##compiler#type)))
+ (sprintf (string-append
+ "It is a call to ~a which has this type"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "~a")
+ (variable-from-module pname)
+ (type->pp-string ptype #f)
+ (p-expr)))))
+ (p-expr)))
+
+ (if (zero? (length atype))
+ (report2
+ warning
+ (list arg-node call-node)
+ loc
+ (string-append
+ "In procedure call"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Argument expression #~a to procedure~a does not return any values."
+ "~%~%"
+ "~a")
+ (pp-fragment call-node " ")
+ i
+ pn
+ (p-arg-expr))
+ (report2
+ warning
+ (list arg-node call-node)
+ loc
+ (string-append
+ "In procedure call"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Argument #~a to procedure~a returns ~a values but 1 is expected."
+ "~%~%"
+ "~a")
+ (pp-fragment call-node " ")
+ i
+ pn
+ (length atype)
+ (p-arg-expr))))
+
(define (r-pred-call-always-true loc node pname pred-type atype)
;; pname is "... proc call to predicate `foo' "
- (report-notice2
+ (report-notice
(list node)
loc
(string-append
@@ -2623,7 +2686,7 @@
(type->pp-string atype)))
(define (r-pred-call-always-false loc node pname pred-type atype)
- (report-notice2
+ (report-notice
(list node)
loc
(string-append
@@ -2646,7 +2709,7 @@
(type->pp-string atype)))
(define (r-cond-test-always-true loc if-node test-node t)
- (report-notice2
+ (report-notice
(list test-node if-node)
loc
(string-append
@@ -2661,7 +2724,7 @@
(type->pp-string t)))
(define (r-cond-test-always-false loc if-node test-node)
- (report-notice2
+ (report-notice
(list test-node if-node)
loc
(string-append
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
index 3175e24..b43628b 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -37,11 +37,39 @@ Warning: Type mismatch.
(list -> fixnum)
-Warning: In `r-proc-call-argument-value-count', a toplevel procedure
- (test-scrutinizer-message-format.scm:XXX) expected a single result in
argument #1 of procedure call `(scheme#list (chicken.time#cpu-time))', but
received 2 results
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `r-proc-call-argument-value-count', a toplevel procedure
+ In procedure call
-Warning: In `r-proc-call-argument-value-count', a toplevel procedure
- (test-scrutinizer-message-format.scm:XXX) expected a single result in
argument #1 of procedure call `(scheme#vector (scheme#values))', but received
zero results
+ (scheme#list (chicken.time#cpu-time))
+
+ Argument #1 to procedure `list' returns 2 values but 1 is expected.
+
+ It is a call to `cpu-time' from module `chicken.time' which has this type
+
+ (-> fixnum fixnum)
+
+ This is the expression
+
+ (chicken.time#cpu-time)
+
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `r-proc-call-argument-value-count', a toplevel procedure
+ In procedure call
+
+ (scheme#vector (scheme#values))
+
+ Argument expression #1 to procedure `vector' does not return any values.
+
+ It is a call to `values' from module `scheme' which has this type
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression
+
+ (scheme#values)
Warning: In `r-proc-call-argument-value-count', a toplevel procedure
expected a single result in `let' binding of `gXXX', but received zero
results
@@ -279,15 +307,43 @@ Warning: Type mismatch.
(string -> fixnum)
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-proc-call-argument-value-count', a local procedure
- (test-scrutinizer-message-format.scm:XXX) expected a single result in
argument #1 of procedure call `(scheme#list (chicken.time#cpu-time))', but
received 2 results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-proc-call-argument-value-count', a local procedure
- (test-scrutinizer-message-format.scm:XXX) expected a single result in
argument #1 of procedure call `(scheme#vector (scheme#values))', but received
zero results
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-proc-call-argument-value-count', a local procedure
+ In procedure call
+
+ (scheme#list (chicken.time#cpu-time))
+
+ Argument #1 to procedure `list' returns 2 values but 1 is expected.
+
+ It is a call to `cpu-time' from module `chicken.time' which has this type
+
+ (-> fixnum fixnum)
+
+ This is the expression
+
+ (chicken.time#cpu-time)
+
+Warning: Type mismatch.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-proc-call-argument-value-count', a local procedure
+ In procedure call
+
+ (scheme#vector (scheme#values))
+
+ Argument expression #1 to procedure `vector' does not return any values.
+
+ It is a call to `values' from module `scheme' which has this type
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression
+
+ (scheme#values)
Warning: Type mismatch.
(test-scrutinizer-message-format.scm:XXX)
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index e5c5ddd..30c51d0 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -74,11 +74,39 @@ Warning: Type mismatch.
(* -> boolean)
-Warning: At toplevel:
- (scrutiny-tests.scm:23) expected a single result in argument #1 of procedure
call `(chicken.base#print (scheme#values 1 2))', but received 2 results
+Warning: Type mismatch.
+ (scrutiny-tests.scm:23)
+ At toplevel:
+ In procedure call
-Warning: At toplevel:
- (scrutiny-tests.scm:24) expected a single result in argument #1 of procedure
call `(chicken.base#print (scheme#values))', but received zero results
+ (chicken.base#print (scheme#values 1 2))
+
+ Argument #1 to procedure `print' returns 2 values but 1 is expected.
+
+ It is a call to `values' from module `scheme' which has this type
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression
+
+ (scheme#values 1 2)
+
+Warning: Type mismatch.
+ (scrutiny-tests.scm:24)
+ At toplevel:
+ In procedure call
+
+ (chicken.base#print (scheme#values))
+
+ Argument expression #1 to procedure `print' does not return any values.
+
+ It is a call to `values' from module `scheme' which has this type
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression
+
+ (scheme#values)
Warning: Type mismatch.
(scrutiny-tests.scm:27)
--
2.7.4
>From bac6b4480f47fb4a39d7fedfefea4a74b72be63a Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Tue, 27 Nov 2018 15:28:58 +0200
Subject: [PATCH 09/17] Add more useful first line for scrutinizer messages
* scrutinizer.scm (report2): New argument 'short' for first line of message
* scrutinizer.scm (r-proc-call-argument-value-count): Bit of
refactoring. The printed 'expression' will be come back in later commit.
---
scrutinizer.scm | 81 +++++++++++-----------
tests/scrutinizer-message-format.expected | 70 +++++++++----------
tests/scrutiny-2.expected | 44 ++++++------
tests/scrutiny.expected | 110 +++++++++++++++---------------
tests/specialization.expected | 16 ++---
5 files changed, 163 insertions(+), 158 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 69684d3..a982d9c 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -2506,7 +2506,7 @@
(sprintf "`~a' from module `~a'" (second r) (first r))
(sprintf "`~a'" sym))))
-(define (report2 report-f location-node-candidates loc msg . args)
+(define (report2 short report-f location-node-candidates loc msg . args)
(define (file-location)
(any (lambda (n) (and (not (string=? "" (node-source-prefix n)))
(node-source-prefix n)))
@@ -2514,20 +2514,21 @@
(when *complain?*
(report-f
(conc
- "Type mismatch.\n "
+ (sprintf "~a.\n " short)
(string-add-indent
(conc (let ((l (file-location))) (if l (conc l "\n ") ""))
(location-name loc " ")
(sprintf "~?" msg args))
" ")))))
-(define (report-notice location-node-candidates loc msg . args)
- (apply report2 ##sys#notice location-node-candidates loc msg args))
+(define (report-notice reason location-node-candidates loc msg . args)
+ (apply report2 reason ##sys#notice location-node-candidates loc msg args))
;;; Reports
(define (r-invalid-called-procedure-type loc node xptype ptype)
(report2
+ "Invalid procedure"
warning
(list node)
loc
@@ -2549,6 +2550,7 @@
(define (r-proc-call-argument-count-mismatch loc node pname exp-count argc
ptype)
(report2
+ "Wrong number of arguments"
warning
(list node)
loc
@@ -2571,6 +2573,7 @@
(define (r-proc-call-argument-type-mismatch loc node pname i xptype atype
ptype)
(report2
+ "Invalid argument type"
warning
(list node)
loc
@@ -2626,44 +2629,37 @@
(p-expr)))))
(p-expr)))
+ (define (p short long)
+ (report2
+ short
+ warning
+ (list arg-node call-node)
+ loc
+ (string-append
+ "In procedure call"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Argument #~a to procedure~a ~a"
+ "~%~%"
+ "~a")
+ (pp-fragment call-node " ")
+ i
+ pn
+ long
+ (p-arg-expr)))
+
(if (zero? (length atype))
- (report2
- warning
- (list arg-node call-node)
- loc
- (string-append
- "In procedure call"
- "~%~%"
- "~a"
- "~%~%"
- "Argument expression #~a to procedure~a does not return any values."
- "~%~%"
- "~a")
- (pp-fragment call-node " ")
- i
- pn
- (p-arg-expr))
- (report2
- warning
- (list arg-node call-node)
- loc
- (string-append
- "In procedure call"
- "~%~%"
- "~a"
- "~%~%"
- "Argument #~a to procedure~a returns ~a values but 1 is expected."
- "~%~%"
- "~a")
- (pp-fragment call-node " ")
- i
- pn
- (length atype)
- (p-arg-expr))))
+ (p "No values returned for argument"
+ "does not return any values.")
+ (p "Too many argument values"
+ (sprintf "returns ~a values but 1 is expected."
+ (length atype)))))
(define (r-pred-call-always-true loc node pname pred-type atype)
;; pname is "... proc call to predicate `foo' "
(report-notice
+ "Predicate always true"
(list node)
loc
(string-append
@@ -2687,6 +2683,7 @@
(define (r-pred-call-always-false loc node pname pred-type atype)
(report-notice
+ "Predicate always false"
(list node)
loc
(string-append
@@ -2710,6 +2707,7 @@
(define (r-cond-test-always-true loc if-node test-node t)
(report-notice
+ "Test always true"
(list test-node if-node)
loc
(string-append
@@ -2725,6 +2723,7 @@
(define (r-cond-test-always-false loc if-node test-node)
(report-notice
+ "Test always false"
(list test-node if-node)
loc
(string-append
@@ -2738,6 +2737,7 @@
(define (r-zero-values-for-the loc node the-type)
;; (the t r) expects r returns exactly 1 value
(report2
+ "Zero values returned"
warning
(list node)
loc
@@ -2754,6 +2754,7 @@
(define (r-too-many-values-for-the loc node the-type rtypes)
(report2
+ "Too many values returned"
warning
(list node)
loc
@@ -2773,6 +2774,7 @@
(define (r-type-mismatch-in-the loc node first-rtype the-type)
(report2
+ "Type mismatch"
warning
(list node)
loc
@@ -2798,7 +2800,7 @@
(define (ppt t) (string-add-indent (type->pp-string t) " "))
(quit-compiling
(string-append
- "Type mismatch.~%"
+ "No typecase matches.~%"
"~a"
" ~a"
"In `compiler-typecase' expression"
@@ -2824,6 +2826,7 @@
(define (r-cond-branch-value-count-mismatch loc node c-node a-node c-types
a-types)
(report2
+ "Branch value count mismatch"
warning
(list a-node node)
loc
@@ -2849,6 +2852,7 @@
(define (r-toplevel-var-assignment-type-mismatch loc node atype var xptype
value-node)
(report2
+ "Invalid assigned value type"
warning
(list node value-node)
loc
@@ -2874,6 +2878,7 @@
(define (r-deprecated-identifier loc node id #!optional suggestion)
(report2
+ (sprintf "Deprecated identifier `~a'" (strip-namespace id))
warning
(list node)
loc
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
index b43628b..056a68c 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -5,7 +5,7 @@ Warning: literal in operator position: (1 2)
Warning: literal in operator position: (1 2)
-Warning: Type mismatch.
+Warning: Wrong number of arguments.
(test-scrutinizer-message-format.scm:XXX)
In `r-proc-call-argument-count-mismatch', a toplevel procedure
In procedure call
@@ -18,7 +18,7 @@ Warning: Type mismatch.
('aXXX 'bXXX --> (pair 'aXXX 'bXXX))
-Warning: Type mismatch.
+Warning: Invalid argument type.
(test-scrutinizer-message-format.scm:XXX)
In `r-proc-call-argument-type-mismatch', a toplevel procedure
In procedure call
@@ -37,7 +37,7 @@ Warning: Type mismatch.
(list -> fixnum)
-Warning: Type mismatch.
+Warning: Too many argument values.
(test-scrutinizer-message-format.scm:XXX)
In `r-proc-call-argument-value-count', a toplevel procedure
In procedure call
@@ -54,14 +54,14 @@ Warning: Type mismatch.
(chicken.time#cpu-time)
-Warning: Type mismatch.
+Warning: No values returned for argument.
(test-scrutinizer-message-format.scm:XXX)
In `r-proc-call-argument-value-count', a toplevel procedure
In procedure call
(scheme#vector (scheme#values))
- Argument expression #1 to procedure `vector' does not return any values.
+ Argument #1 to procedure `vector' does not return any values.
It is a call to `values' from module `scheme' which has this type
@@ -74,7 +74,7 @@ Warning: Type mismatch.
Warning: In `r-proc-call-argument-value-count', a toplevel procedure
expected a single result in `let' binding of `gXXX', but received zero
results
-Warning: Type mismatch.
+Warning: Branch value count mismatch.
(test-scrutinizer-message-format.scm:XXX)
In `r-cond-branch-value-count-mismatch', a toplevel procedure
In conditional expression
@@ -91,7 +91,7 @@ Warning: Type mismatch.
(chicken.time#cpu-time)
-Warning: Type mismatch.
+Warning: Invalid procedure.
In `r-invalid-called-procedure-type', a toplevel procedure
In procedure call
@@ -105,7 +105,7 @@ Warning: Type mismatch.
(* -> *)
-Note: Type mismatch.
+Note: Predicate always true.
(test-scrutinizer-message-format.scm:XXX)
In `r-pred-call-always-true', a toplevel procedure
In predicate call
@@ -122,7 +122,7 @@ Note: Type mismatch.
null
-Note: Type mismatch.
+Note: Predicate always false.
(test-scrutinizer-message-format.scm:XXX)
In `r-pred-call-always-false', a toplevel procedure
In predicate call
@@ -139,7 +139,7 @@ Note: Type mismatch.
fixnum
-Note: Type mismatch.
+Note: Test always true.
In `r-cond-test-always-true', a toplevel procedure
In conditional expression
@@ -149,7 +149,7 @@ Note: Type mismatch.
symbol
-Note: Type mismatch.
+Note: Test always false.
In `r-cond-test-always-false', a toplevel procedure
In conditional expression
@@ -173,7 +173,7 @@ Warning: Type mismatch.
symbol
-Warning: Type mismatch.
+Warning: Zero values returned.
(test-scrutinizer-message-format.scm:XXX)
In `r-zero-values-for-the', a toplevel procedure
In expression
@@ -184,7 +184,7 @@ Warning: Type mismatch.
symbol
-Warning: Type mismatch.
+Warning: Too many values returned.
(test-scrutinizer-message-format.scm:XXX)
In `r-too-many-values-for-the', a toplevel procedure
In expression
@@ -214,7 +214,7 @@ Warning: Type mismatch.
symbol
-Warning: Type mismatch.
+Warning: Invalid assigned value type.
In `r-toplevel-var-assignment-type-mismatch', a toplevel procedure
In assignment
@@ -230,7 +230,7 @@ Warning: Type mismatch.
boolean
-Warning: Type mismatch.
+Warning: Deprecated identifier `deprecated-foo'.
In `r-deprecated-identifier', a toplevel procedure
In expression
@@ -238,7 +238,7 @@ Warning: Type mismatch.
Use of deprecated `deprecated-foo'.
-Warning: Type mismatch.
+Warning: Deprecated identifier `deprecated-foo2'.
In `r-deprecated-identifier', a toplevel procedure
In expression
@@ -248,7 +248,7 @@ Warning: Type mismatch.
The suggested replacement is `foo'.
-Warning: Type mismatch.
+Warning: Invalid assigned value type.
At toplevel:
In assignment
@@ -271,7 +271,7 @@ Warning: In `append-invalid-arg', a toplevel procedure
but expected a proper list.
-Warning: Type mismatch.
+Warning: Wrong number of arguments.
(test-scrutinizer-message-format.scm:XXX)
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
@@ -286,7 +286,7 @@ Warning: Type mismatch.
('aXXX 'bXXX --> (pair 'aXXX 'bXXX))
-Warning: Type mismatch.
+Warning: Invalid argument type.
(test-scrutinizer-message-format.scm:XXX)
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
@@ -307,7 +307,7 @@ Warning: Type mismatch.
(string -> fixnum)
-Warning: Type mismatch.
+Warning: Too many argument values.
(test-scrutinizer-message-format.scm:XXX)
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
@@ -326,7 +326,7 @@ Warning: Type mismatch.
(chicken.time#cpu-time)
-Warning: Type mismatch.
+Warning: No values returned for argument.
(test-scrutinizer-message-format.scm:XXX)
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
@@ -335,7 +335,7 @@ Warning: Type mismatch.
(scheme#vector (scheme#values))
- Argument expression #1 to procedure `vector' does not return any values.
+ Argument #1 to procedure `vector' does not return any values.
It is a call to `values' from module `scheme' which has this type
@@ -345,7 +345,7 @@ Warning: Type mismatch.
(scheme#values)
-Warning: Type mismatch.
+Warning: Branch value count mismatch.
(test-scrutinizer-message-format.scm:XXX)
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
@@ -364,7 +364,7 @@ Warning: Type mismatch.
(chicken.time#cpu-time)
-Warning: Type mismatch.
+Warning: Invalid procedure.
(test-scrutinizer-message-format.scm:XXX)
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
@@ -382,7 +382,7 @@ Warning: Type mismatch.
(* -> *)
-Warning: Type mismatch.
+Warning: Invalid procedure.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-invalid-called-procedure-type', a local procedure
@@ -399,7 +399,7 @@ Warning: Type mismatch.
(* -> *)
-Note: Type mismatch.
+Note: Predicate always true.
(test-scrutinizer-message-format.scm:XXX)
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
@@ -418,7 +418,7 @@ Note: Type mismatch.
null
-Note: Type mismatch.
+Note: Predicate always false.
(test-scrutinizer-message-format.scm:XXX)
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
@@ -437,7 +437,7 @@ Note: Type mismatch.
fixnum
-Note: Type mismatch.
+Note: Test always true.
(test-scrutinizer-message-format.scm:XXX)
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
@@ -450,7 +450,7 @@ Note: Type mismatch.
fixnum
-Note: Type mismatch.
+Note: Test always false.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-cond-test-always-false', a local procedure
@@ -478,7 +478,7 @@ Warning: Type mismatch.
symbol
-Warning: Type mismatch.
+Warning: Invalid assigned value type.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-toplevel-var-assignment-type-mismatch', a local procedure
@@ -496,7 +496,7 @@ Warning: Type mismatch.
boolean
-Warning: Type mismatch.
+Warning: Deprecated identifier `deprecated-foo'.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-deprecated-identifier', a local procedure
@@ -506,7 +506,7 @@ Warning: Type mismatch.
Use of deprecated `deprecated-foo' from module `m'.
-Warning: Type mismatch.
+Warning: Deprecated identifier `deprecated-foo2'.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-deprecated-identifier', a local procedure
@@ -518,7 +518,7 @@ Warning: Type mismatch.
The suggested replacement is `foo'.
-Warning: Type mismatch.
+Warning: Zero values returned.
(test-scrutinizer-message-format.scm:XXX)
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
@@ -546,7 +546,7 @@ Warning: In `m#toplevel-foo', a toplevel procedure
In `zero-values-for-let', a local procedure
expected a single result in `let' binding of `a', but received zero results
-Warning: Type mismatch.
+Warning: Too many values returned.
(test-scrutinizer-message-format.scm:XXX)
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
@@ -658,7 +658,7 @@ Warning: In `m#toplevel-foo', a toplevel procedure
In `vector-ref-out-of-range', a local procedure
(test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#vector-ref', index -1 out of range for vector of length 0
-Error: Type mismatch.
+Error: No typecase matches.
(test-scrutinizer-message-format.scm:XXX)
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index bdf7050..11cc34a 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -1,7 +1,7 @@
;; numbers replaced with XXX by redact-gensyms.scm
;; prefixes: (tmp g)
-Note: Type mismatch.
+Note: Predicate always true.
(scrutiny-tests-2.scm:20)
At toplevel:
In predicate call
@@ -18,7 +18,7 @@ Note: Type mismatch.
pair
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests-2.scm:20)
At toplevel:
In predicate call
@@ -35,7 +35,7 @@ Note: Type mismatch.
null
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests-2.scm:20)
At toplevel:
In predicate call
@@ -52,7 +52,7 @@ Note: Type mismatch.
null
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests-2.scm:20)
At toplevel:
In predicate call
@@ -69,7 +69,7 @@ Note: Type mismatch.
fixnum
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests-2.scm:20)
At toplevel:
In predicate call
@@ -86,7 +86,7 @@ Note: Type mismatch.
float
-Note: Type mismatch.
+Note: Predicate always true.
(scrutiny-tests-2.scm:21)
At toplevel:
In predicate call
@@ -103,7 +103,7 @@ Note: Type mismatch.
null
-Note: Type mismatch.
+Note: Predicate always true.
(scrutiny-tests-2.scm:21)
At toplevel:
In predicate call
@@ -120,7 +120,7 @@ Note: Type mismatch.
null
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests-2.scm:21)
At toplevel:
In predicate call
@@ -137,7 +137,7 @@ Note: Type mismatch.
fixnum
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests-2.scm:21)
At toplevel:
In predicate call
@@ -154,7 +154,7 @@ Note: Type mismatch.
float
-Note: Type mismatch.
+Note: Predicate always true.
(scrutiny-tests-2.scm:22)
At toplevel:
In predicate call
@@ -171,7 +171,7 @@ Note: Type mismatch.
null
-Note: Type mismatch.
+Note: Predicate always true.
(scrutiny-tests-2.scm:22)
At toplevel:
In predicate call
@@ -188,7 +188,7 @@ Note: Type mismatch.
null
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests-2.scm:22)
At toplevel:
In predicate call
@@ -205,7 +205,7 @@ Note: Type mismatch.
pair
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests-2.scm:22)
At toplevel:
In predicate call
@@ -222,7 +222,7 @@ Note: Type mismatch.
fixnum
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests-2.scm:22)
At toplevel:
In predicate call
@@ -239,7 +239,7 @@ Note: Type mismatch.
float
-Note: Type mismatch.
+Note: Predicate always true.
(scrutiny-tests-2.scm:23)
At toplevel:
In predicate call
@@ -256,7 +256,7 @@ Note: Type mismatch.
fixnum
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests-2.scm:23)
At toplevel:
In predicate call
@@ -273,7 +273,7 @@ Note: Type mismatch.
float
-Note: Type mismatch.
+Note: Predicate always true.
(scrutiny-tests-2.scm:25)
At toplevel:
In predicate call
@@ -290,7 +290,7 @@ Note: Type mismatch.
float
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests-2.scm:25)
At toplevel:
In predicate call
@@ -307,7 +307,7 @@ Note: Type mismatch.
fixnum
-Note: Type mismatch.
+Note: Predicate always true.
(scrutiny-tests-2.scm:27)
At toplevel:
In predicate call
@@ -324,7 +324,7 @@ Note: Type mismatch.
fixnum
-Note: Type mismatch.
+Note: Predicate always true.
(scrutiny-tests-2.scm:27)
At toplevel:
In predicate call
@@ -341,7 +341,7 @@ Note: Type mismatch.
float
-Note: Type mismatch.
+Note: Predicate always true.
(scrutiny-tests-2.scm:27)
At toplevel:
In predicate call
@@ -358,7 +358,7 @@ Note: Type mismatch.
number
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests-2.scm:27)
At toplevel:
In predicate call
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 30c51d0..dd5f97b 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -3,7 +3,7 @@
Warning: (scrutiny-tests.scm:31) - assignment to imported value binding `car'
-Note: Type mismatch.
+Note: Test always true.
In `a', a toplevel procedure
In `b', a local procedure
In `c', a local procedure
@@ -15,7 +15,7 @@ Note: Type mismatch.
number
-Note: Type mismatch.
+Note: Test always true.
In `b', a toplevel procedure
In conditional expression
@@ -25,7 +25,7 @@ Note: Type mismatch.
true
-Warning: Type mismatch.
+Warning: Branch value count mismatch.
(scrutiny-tests.scm:16)
In `foo', a toplevel procedure
In conditional expression
@@ -42,7 +42,7 @@ Warning: Type mismatch.
(scheme#values 1 2 (scheme#+ (scheme#+ (scheme#+ ...))))
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:19)
At toplevel:
In procedure call
@@ -61,7 +61,7 @@ Warning: Type mismatch.
(&rest number -> number)
-Warning: Type mismatch.
+Warning: Wrong number of arguments.
(scrutiny-tests.scm:21)
At toplevel:
In procedure call
@@ -74,7 +74,7 @@ Warning: Type mismatch.
(* -> boolean)
-Warning: Type mismatch.
+Warning: Too many argument values.
(scrutiny-tests.scm:23)
At toplevel:
In procedure call
@@ -91,14 +91,14 @@ Warning: Type mismatch.
(scheme#values 1 2)
-Warning: Type mismatch.
+Warning: No values returned for argument.
(scrutiny-tests.scm:24)
At toplevel:
In procedure call
(chicken.base#print (scheme#values))
- Argument expression #1 to procedure `print' does not return any values.
+ Argument #1 to procedure `print' does not return any values.
It is a call to `values' from module `scheme' which has this type
@@ -108,7 +108,7 @@ Warning: Type mismatch.
(scheme#values)
-Warning: Type mismatch.
+Warning: Invalid procedure.
(scrutiny-tests.scm:27)
At toplevel:
In procedure call
@@ -123,7 +123,7 @@ Warning: Type mismatch.
(-> *)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:29)
At toplevel:
In procedure call
@@ -142,7 +142,7 @@ Warning: Type mismatch.
(&rest number -> number)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:29)
At toplevel:
In procedure call
@@ -161,7 +161,7 @@ Warning: Type mismatch.
(&rest number -> number)
-Warning: Type mismatch.
+Warning: Invalid assigned value type.
At toplevel:
In assignment
@@ -180,7 +180,7 @@ Warning: Type mismatch.
Warning: At toplevel:
expected a single result in `let' binding of `gXXX', but received 2 results
-Warning: Type mismatch.
+Warning: Invalid procedure.
At toplevel:
In procedure call
@@ -194,7 +194,7 @@ Warning: Type mismatch.
(-> *)
-Note: Type mismatch.
+Note: Test always true.
In `foo', a toplevel procedure
In conditional expression
@@ -204,7 +204,7 @@ Note: Type mismatch.
(procedure bar () *)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:58)
In `foo2', a toplevel procedure
In procedure call
@@ -223,7 +223,7 @@ Warning: Type mismatch.
(&rest string -> string)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:66)
At toplevel:
In procedure call
@@ -242,7 +242,7 @@ Warning: Type mismatch.
(string -> string)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:71)
In `foo4', a toplevel procedure
In procedure call
@@ -261,7 +261,7 @@ Warning: Type mismatch.
(&rest number -> number)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:77)
In `foo5', a toplevel procedure
In procedure call
@@ -280,7 +280,7 @@ Warning: Type mismatch.
(&rest number -> number)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:83)
In `foo6', a toplevel procedure
In procedure call
@@ -299,7 +299,7 @@ Warning: Type mismatch.
(&rest number -> number)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:90)
At toplevel:
In procedure call
@@ -318,7 +318,7 @@ Warning: Type mismatch.
(&rest number -> number)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:104)
In `foo10', a toplevel procedure
In procedure call
@@ -337,7 +337,7 @@ Warning: Type mismatch.
(string -> symbol)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:105)
In `foo10', a toplevel procedure
In procedure call
@@ -373,7 +373,7 @@ Warning: Type mismatch.
pair
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:109)
In `foo10', a toplevel procedure
In procedure call
@@ -392,7 +392,7 @@ Warning: Type mismatch.
(&rest string -> string)
-Warning: Type mismatch.
+Warning: Too many values returned.
(scrutiny-tests.scm:110)
In `foo10', a toplevel procedure
In expression
@@ -405,7 +405,7 @@ Warning: Type mismatch.
*
-Warning: Type mismatch.
+Warning: Zero values returned.
(scrutiny-tests.scm:111)
In `foo10', a toplevel procedure
In expression
@@ -416,7 +416,7 @@ Warning: Type mismatch.
*
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:112)
In `foo10', a toplevel procedure
In procedure call
@@ -435,7 +435,7 @@ Warning: Type mismatch.
(&rest number -> number)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:137)
In `foo#blabla', a toplevel procedure
In procedure call
@@ -454,7 +454,7 @@ Warning: Type mismatch.
(&rest number -> number)
-Warning: Type mismatch.
+Warning: Deprecated identifier `deprecated-procedure'.
At toplevel:
In expression
@@ -462,7 +462,7 @@ Warning: Type mismatch.
Use of deprecated `deprecated-procedure'.
-Warning: Type mismatch.
+Warning: Deprecated identifier `another-deprecated-procedure'.
At toplevel:
In expression
@@ -472,7 +472,7 @@ Warning: Type mismatch.
The suggested replacement is `replacement-procedure'.
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:168)
At toplevel:
In procedure call
@@ -491,7 +491,7 @@ Warning: Type mismatch.
((&rest 'a143 -> 'b144) (list-of 'a143) -> 'b144)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:169)
At toplevel:
In procedure call
@@ -510,7 +510,7 @@ Warning: Type mismatch.
((&rest 'a143 -> 'b144) (list-of 'a143) -> 'b144)
-Note: Type mismatch.
+Note: Predicate always true.
(scrutiny-tests.scm:182)
At toplevel:
In predicate call
@@ -527,7 +527,7 @@ Note: Type mismatch.
fixnum
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests.scm:190)
At toplevel:
In predicate call
@@ -544,7 +544,7 @@ Note: Type mismatch.
(or char string)
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests.scm:191)
At toplevel:
In predicate call
@@ -561,7 +561,7 @@ Note: Type mismatch.
(not (or char string))
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests.scm:194)
At toplevel:
In predicate call
@@ -578,7 +578,7 @@ Note: Type mismatch.
fixnum
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests.scm:195)
At toplevel:
In predicate call
@@ -595,7 +595,7 @@ Note: Type mismatch.
(or char string)
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests.scm:196)
At toplevel:
In predicate call
@@ -612,7 +612,7 @@ Note: Type mismatch.
fixnum
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests.scm:200)
At toplevel:
In predicate call
@@ -629,7 +629,7 @@ Note: Type mismatch.
char
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests.scm:201)
At toplevel:
In predicate call
@@ -646,7 +646,7 @@ Note: Type mismatch.
symbol
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests.scm:205)
At toplevel:
In predicate call
@@ -663,7 +663,7 @@ Note: Type mismatch.
(or char string)
-Note: Type mismatch.
+Note: Predicate always false.
(scrutiny-tests.scm:206)
At toplevel:
In predicate call
@@ -680,7 +680,7 @@ Note: Type mismatch.
symbol
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:210)
At toplevel:
In procedure call
@@ -699,7 +699,7 @@ Warning: Type mismatch.
(pair -> *)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:212)
At toplevel:
In procedure call
@@ -718,7 +718,7 @@ Warning: Type mismatch.
(null -> *)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:214)
At toplevel:
In procedure call
@@ -746,7 +746,7 @@ Warning: In `vector-ref-warn2', a toplevel procedure
Warning: In `vector-ref-warn3', a toplevel procedure
(scrutiny-tests.scm:223) in procedure call to `scheme#vector-ref', index 4
out of range for vector of length 3
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:226)
In `vector-ref-standard-warn1', a toplevel procedure
In procedure call
@@ -774,7 +774,7 @@ Warning: In `vector-set!-warn2', a toplevel procedure
Warning: In `vector-set!-warn3', a toplevel procedure
(scrutiny-tests.scm:229) in procedure call to `scheme#vector-set!', index 4
out of range for vector of length 3
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:232)
In `vector-set!-standard-warn1', a toplevel procedure
In procedure call
@@ -808,7 +808,7 @@ Warning: In `list-ref-warn4', a toplevel procedure
Warning: In `list-ref-warn5', a toplevel procedure
(scrutiny-tests.scm:252) in procedure call to `scheme#list-ref', index 4 out
of range for proper list of length 3
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:281)
In `list-ref-standard-warn1', a toplevel procedure
In procedure call
@@ -827,7 +827,7 @@ Warning: Type mismatch.
((list-of 'a366) fixnum -> 'a366)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:282)
In `list-ref-standard-warn2', a toplevel procedure
In procedure call
@@ -846,7 +846,7 @@ Warning: Type mismatch.
((list-of 'a366) fixnum -> 'a366)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:284)
In `list-ref-standard-warn3', a toplevel procedure
In procedure call
@@ -865,7 +865,7 @@ Warning: Type mismatch.
((list-of 'a366) fixnum -> 'a366)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:285)
In `list-ref-standard-warn4', a toplevel procedure
In procedure call
@@ -884,7 +884,7 @@ Warning: Type mismatch.
((list-of 'a366) fixnum -> 'a366)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:289)
In `list-ref-type-warn1', a toplevel procedure
In procedure call
@@ -903,7 +903,7 @@ Warning: Type mismatch.
(number -> number)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:291)
In `list-ref-type-warn2', a toplevel procedure
In procedure call
@@ -922,7 +922,7 @@ Warning: Type mismatch.
(number -> number)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:295)
In `list-ref-type-warn3', a toplevel procedure
In procedure call
@@ -941,7 +941,7 @@ Warning: Type mismatch.
(number -> number)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:307)
In `append-result-type-warn1', a toplevel procedure
In procedure call
@@ -960,7 +960,7 @@ Warning: Type mismatch.
(number -> number)
-Warning: Type mismatch.
+Warning: Invalid argument type.
(scrutiny-tests.scm:312)
In `append-result-type-warn2', a toplevel procedure
In procedure call
diff --git a/tests/specialization.expected b/tests/specialization.expected
index 11ed6f5..9ceaaf3 100644
--- a/tests/specialization.expected
+++ b/tests/specialization.expected
@@ -1,7 +1,7 @@
;; numbers replaced with XXX by redact-gensyms.scm
;; prefixes: (tmp g)
-Note: Type mismatch.
+Note: Predicate always true.
(specialization-tests.scm:3)
At toplevel:
In predicate call
@@ -18,7 +18,7 @@ Note: Type mismatch.
string
-Note: Type mismatch.
+Note: Test always true.
(specialization-tests.scm:3)
At toplevel:
In conditional expression
@@ -29,7 +29,7 @@ Note: Type mismatch.
true
-Note: Type mismatch.
+Note: Predicate always false.
(specialization-tests.scm:4)
At toplevel:
In predicate call
@@ -46,7 +46,7 @@ Note: Type mismatch.
symbol
-Note: Type mismatch.
+Note: Test always false.
(specialization-tests.scm:4)
At toplevel:
In conditional expression
@@ -55,7 +55,7 @@ Note: Type mismatch.
Test condition is always false.
-Note: Type mismatch.
+Note: Predicate always true.
(specialization-tests.scm:10)
At toplevel:
In predicate call
@@ -72,7 +72,7 @@ Note: Type mismatch.
input/output-port
-Note: Type mismatch.
+Note: Test always true.
(specialization-tests.scm:10)
At toplevel:
In conditional expression
@@ -83,7 +83,7 @@ Note: Type mismatch.
true
-Note: Type mismatch.
+Note: Predicate always true.
(specialization-tests.scm:11)
At toplevel:
In predicate call
@@ -100,7 +100,7 @@ Note: Type mismatch.
input/output-port
-Note: Type mismatch.
+Note: Test always true.
(specialization-tests.scm:11)
At toplevel:
In conditional expression
--
2.7.4
>From 3b6007f7b8c3716d573f9731418601d51bbb9510 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Tue, 27 Nov 2018 15:40:17 +0200
Subject: [PATCH 10/17] scrutinizer.scm (scrutinize): Refactor 'pname' to
toplevel as call-node-pname
The 'pname' is used purely for printing messages, so move it out of
scrutinize.
* scrutinizer.scm (scrutinize): Remove all references to 'pname' from
the arguments of the report functions.
---
scrutinizer.scm | 26 +++++++++++++++-----------
1 file changed, 15 insertions(+), 11 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index a982d9c..2e1a20e 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -316,8 +316,6 @@
(and (pair? c) c)))
(define (call-result node args e loc params typeenv)
- (define (pname)
- (fragment (first (node-subexpressions node))))
(let* ((actualtypes (map walked-result args))
(ptype (car actualtypes))
(pptype? (procedure-type? ptype))
@@ -334,7 +332,7 @@
(let-values (((atypes values-rest ok alen)
(procedure-argument-types ptype nargs typeenv)))
(unless ok
- (r-proc-call-argument-count-mismatch loc node (pname) alen
nargs ptype))
+ (r-proc-call-argument-count-mismatch loc node alen nargs
ptype))
(do ((actualtypes (cdr actualtypes) (cdr actualtypes))
(atypes atypes (cdr atypes))
(i 1 (add1 i)))
@@ -344,7 +342,7 @@
(car actualtypes)
typeenv)
(r-proc-call-argument-type-mismatch
- loc node (pname) i
+ loc node i
(resolve (car atypes) typeenv)
(resolve (car actualtypes) typeenv)
ptype)))
@@ -359,7 +357,7 @@
(lambda (pt)
(cond ((match-argument-types (list pt)
(cdr actualtypes) typeenv)
(r-pred-call-always-true
- loc node (pname) pt (cadr
actualtypes))
+ loc node pt (cadr actualtypes))
(when specialize
(specialize-node!
node (cdr args)
@@ -370,7 +368,7 @@
(trail-restore trail0 typeenv)
(match-argument-types (list `(not
,pt)) (cdr actualtypes) typeenv))
(r-pred-call-always-false
- loc node (pname) pt (cadr
actualtypes))
+ loc node pt (cadr actualtypes))
(when specialize
(specialize-node!
node (cdr args)
@@ -2506,6 +2504,9 @@
(sprintf "`~a' from module `~a'" (second r) (first r))
(sprintf "`~a'" sym))))
+(define (call-node-pname node)
+ (fragment (first (node-subexpressions node))))
+
(define (report2 short report-f location-node-candidates loc msg . args)
(define (file-location)
(any (lambda (n) (and (not (string=? "" (node-source-prefix n)))
@@ -2548,7 +2549,8 @@
(type->pp-string ptype)
(type->pp-string xptype)))
-(define (r-proc-call-argument-count-mismatch loc node pname exp-count argc
ptype)
+(define (r-proc-call-argument-count-mismatch loc node exp-count argc ptype)
+ (define pname (call-node-pname node))
(report2
"Wrong number of arguments"
warning
@@ -2571,7 +2573,8 @@
(variable-from-module pname)
(type->pp-string ptype #f)))
-(define (r-proc-call-argument-type-mismatch loc node pname i xptype atype
ptype)
+(define (r-proc-call-argument-type-mismatch loc node i xptype atype ptype)
+ (define pname (call-node-pname node))
(report2
"Invalid argument type"
warning
@@ -2656,8 +2659,8 @@
(sprintf "returns ~a values but 1 is expected."
(length atype)))))
-(define (r-pred-call-always-true loc node pname pred-type atype)
- ;; pname is "... proc call to predicate `foo' "
+(define (r-pred-call-always-true loc node pred-type atype)
+ (define pname (call-node-pname node))
(report-notice
"Predicate always true"
(list node)
@@ -2681,7 +2684,8 @@
(type->pp-string pred-type)
(type->pp-string atype)))
-(define (r-pred-call-always-false loc node pname pred-type atype)
+(define (r-pred-call-always-false loc node pred-type atype)
+ (define pname (call-node-pname node))
(report-notice
"Predicate always false"
(list node)
--
2.7.4
>From 79d7a4f7012413fa5792933330bfda7fb23d93a0 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Tue, 27 Nov 2018 15:59:49 +0200
Subject: [PATCH 11/17] scrutinizer.scm (r-proc-call-argument-value-count):
Refactor out describe-expression
---
scrutinizer.scm | 52 +++++++++++++++++++++++++++++-----------------------
1 file changed, 29 insertions(+), 23 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 2e1a20e..e33716d 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -2504,6 +2504,34 @@
(sprintf "`~a' from module `~a'" (second r) (first r))
(sprintf "`~a'" sym))))
+(define (describe-expression node)
+ (define (p-expr n)
+ (sprintf (string-append
+ "This is the expression"
+ "~%~%"
+ "~a")
+ (pp-fragment n)))
+
+ (define (p-node n)
+ (cond
+ ((and (eq? '##core#call (node-class n))
+ (let ((pnode (first (node-subexpressions n))))
+ (and-let* (((eq? '##core#variable (node-class pnode)))
+ (pname (car (node-parameters pnode)))
+ (ptype (variable-mark pname '##compiler#type)))
+ (sprintf (string-append
+ "It is a call to ~a which has this type"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "~a")
+ (variable-from-module pname)
+ (type->pp-string ptype #f)
+ (p-expr n))))))
+ (else (p-expr n))))
+
+ (p-node node))
+
(define (call-node-pname node)
(fragment (first (node-subexpressions node))))
@@ -2609,28 +2637,6 @@
(if (zero? i) ""
(sprintf " `~a'"
(strip-namespace (fragment (first (node-subexpressions
call-node)))))))
- (define (p-arg-expr)
- (define (p-expr)
- (sprintf (string-append
- "This is the expression"
- "~%~%"
- "~a")
- (pp-fragment arg-node)))
- (or (and (eq? '##core#call (node-class arg-node))
- (let ((pnode (first (node-subexpressions arg-node))))
- (and-let* (((eq? '##core#variable (node-class pnode)))
- (pname (car (node-parameters pnode)))
- (ptype (variable-mark pname '##compiler#type)))
- (sprintf (string-append
- "It is a call to ~a which has this type"
- "~%~%"
- "~a"
- "~%~%"
- "~a")
- (variable-from-module pname)
- (type->pp-string ptype #f)
- (p-expr)))))
- (p-expr)))
(define (p short long)
(report2
@@ -2650,7 +2656,7 @@
i
pn
long
- (p-arg-expr)))
+ (describe-expression arg-node)))
(if (zero? (length atype))
(p "No values returned for argument"
--
2.7.4
>From d550b7cf25c5920e936c31f9e059ccd0ee24311f Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Tue, 27 Nov 2018 16:32:26 +0200
Subject: [PATCH 12/17] Add more information to scrutinizer messages
Notably for "incorrect argument to function" print the argument
expression. This is convenient when it's the 5th argument to 9
argument function, or something similiar requiring complicated mental
arithmetic.
* scrutinizer.scm (describe-expression): Use source-node-tree to get
the non-mutated AST.
- Skip the/result node so we can see the call node, if there is one
* scrutinizer.scm (scrutinize): Pass argument node to
r-invalid-called-procedure-type, r-proc-call-argument-type-mismatch
* scrutinizer.scm (r-invalid-called-procedure-type): Describe the
invalid procedure expression
* scrutinizer.scm (r-proc-call-argument-type-mismatch): Describe the
invalid argument expression
* scrutinizer.scm (report2): Flush output so the last printed warning
gets printed fully right away, and not once the compilation
finishes, which can take a while on bigger files.
---
scrutinizer.scm | 171 ++++++----
tests/scrutinizer-message-format.expected | 252 +++++++-------
tests/scrutiny-2.expected | 132 +++----
tests/scrutiny.expected | 550 +++++++++++++++++++-----------
tests/specialization.expected | 38 +--
5 files changed, 678 insertions(+), 465 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index e33716d..d8231e3 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -326,7 +326,7 @@
(d " call: ~a, te: ~a" actualtypes typeenv)
(cond ((and (not pptype?) (not (match-types xptype ptype typeenv)))
(r-invalid-called-procedure-type
- loc node (resolve xptype typeenv) (resolve ptype typeenv))
+ loc node (resolve xptype typeenv) (car args) (resolve ptype
typeenv))
(values '* #f))
(else
(let-values (((atypes values-rest ok alen)
@@ -335,6 +335,7 @@
(r-proc-call-argument-count-mismatch loc node alen nargs
ptype))
(do ((actualtypes (cdr actualtypes) (cdr actualtypes))
(atypes atypes (cdr atypes))
+ (anodes (cdr args) (cdr anodes))
(i 1 (add1 i)))
((or (null? actualtypes) (null? atypes)))
(unless (match-types
@@ -344,6 +345,7 @@
(r-proc-call-argument-type-mismatch
loc node i
(resolve (car atypes) typeenv)
+ (car anodes)
(resolve (car actualtypes) typeenv)
ptype)))
(when (noreturn-procedure-type? ptype)
@@ -2507,7 +2509,7 @@
(define (describe-expression node)
(define (p-expr n)
(sprintf (string-append
- "This is the expression"
+ "This is the expression:"
"~%~%"
"~a")
(pp-fragment n)))
@@ -2520,7 +2522,7 @@
(pname (car (node-parameters pnode)))
(ptype (variable-mark pname '##compiler#type)))
(sprintf (string-append
- "It is a call to ~a which has this type"
+ "The expression is a call to ~a which has this type:"
"~%~%"
"~a"
"~%~%"
@@ -2528,9 +2530,11 @@
(variable-from-module pname)
(type->pp-string ptype #f)
(p-expr n))))))
+ ((eq? '##core#the/result (node-class n)) ; walk through
+ (p-node (first (node-subexpressions n))))
(else (p-expr n))))
- (p-node node))
+ (p-node (source-node-tree node)))
(define (call-node-pname node)
(fragment (first (node-subexpressions node))))
@@ -2548,34 +2552,65 @@
(conc (let ((l (file-location))) (if l (conc l "\n ") ""))
(location-name loc " ")
(sprintf "~?" msg args))
- " ")))))
+ " ")))
+ ;; Avoid cliffhangers
+ (flush-output)))
(define (report-notice reason location-node-candidates loc msg . args)
(apply report2 reason ##sys#notice location-node-candidates loc msg args))
;;; Reports
-(define (r-invalid-called-procedure-type loc node xptype ptype)
- (report2
- "Invalid procedure"
- warning
- (list node)
- loc
- (string-append
- "In procedure call"
- "~%~%"
- "~a"
- "~%~%"
- "Procedure in a procedure call has invalid type"
- "~%~%"
- "~a"
- "~%~%"
- "The expected type is"
- "~%~%"
- "~a")
- (pp-fragment node " ")
- (type->pp-string ptype)
- (type->pp-string xptype)))
+(define (r-invalid-called-procedure-type loc call-node xptype p-node ptype)
+ (define (variable-node-name n)
+ (cond ((eq? '##core#the/result (node-class n))
+ (variable-node-name (first (node-subexpressions n))))
+ ((eq? '##core#variable (node-class n)) (car (node-parameters n)))
+ (else #f)))
+ (if (variable-node-name p-node)
+ (report2
+ "Invalid procedure"
+ warning
+ (list p-node call-node)
+ loc
+ (string-append
+ "In procedure call:"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Variable ~a is not a procedure."
+ "~%~%"
+ "It has this type:"
+ "~%~%"
+ "~a")
+ (pp-fragment call-node " ")
+ (variable-from-module (variable-node-name p-node))
+ (type->pp-string ptype))
+ (report2
+ "Invalid procedure"
+ warning
+ (list p-node call-node)
+ loc
+ (string-append
+ "In procedure call:"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "The procedure expression does not appear to be a callable."
+ "~%~%"
+ "The expected type is:"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "The actual type is:"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "~a")
+ (pp-fragment call-node " ")
+ (type->pp-string xptype)
+ (type->pp-string ptype)
+ (describe-expression p-node))))
(define (r-proc-call-argument-count-mismatch loc node exp-count argc ptype)
(define pname (call-node-pname node))
@@ -2585,13 +2620,13 @@
(list node)
loc
(string-append
- "In procedure call"
+ "In procedure call:"
"~%~%"
"~a"
"~%~%"
"Procedure `~a' is called with ~a argument~a but ~a argument~a is
expected."
"~%~%"
- "Procedure ~a has this type"
+ "Procedure ~a has this type:"
"~%~%"
"~a")
(pp-fragment node " ")
@@ -2601,7 +2636,7 @@
(variable-from-module pname)
(type->pp-string ptype #f)))
-(define (r-proc-call-argument-type-mismatch loc node i xptype atype ptype)
+(define (r-proc-call-argument-type-mismatch loc node i xptype arg-node atype
ptype)
(define pname (call-node-pname node))
(report2
"Invalid argument type"
@@ -2609,19 +2644,21 @@
(list node)
loc
(string-append
- "In procedure call"
+ "In procedure call:"
"~%~%"
"~a"
"~%~%"
- "Argument #~a to procedure `~a' has invalid type"
+ "Argument #~a to procedure `~a' has invalid type:"
"~%~%"
"~a"
"~%~%"
- "The expected type is"
+ "The expected type is:"
"~%~%"
"~a"
"~%~%"
- "Procedure ~a has this type"
+ "~a"
+ "~%~%"
+ "Procedure ~a has this type:"
"~%~%"
"~a")
(pp-fragment node " ")
@@ -2629,6 +2666,7 @@
(strip-namespace pname)
(type->pp-string atype)
(type->pp-string xptype)
+ (describe-expression arg-node)
(variable-from-module pname)
(type->pp-string ptype #f)))
@@ -2645,11 +2683,11 @@
(list arg-node call-node)
loc
(string-append
- "In procedure call"
+ "In procedure call:"
"~%~%"
"~a"
"~%~%"
- "Argument #~a to procedure~a ~a"
+ "Argument expression #~a to procedure~a ~a"
"~%~%"
"~a")
(pp-fragment call-node " ")
@@ -2672,17 +2710,17 @@
(list node)
loc
(string-append
- "In predicate call"
+ "In predicate call:"
"~%~%"
"~a"
"~%~%"
"Predicate call will always return true."
"~%~%"
- "Procedure ~a is a predicate for"
+ "Procedure ~a is a predicate for:"
"~%~%"
"~a"
"~%~%"
- "The given argument has this type"
+ "The given argument has this type:"
"~%~%"
"~a")
(pp-fragment node " ")
@@ -2697,17 +2735,17 @@
(list node)
loc
(string-append
- "In predicate call"
+ "In predicate call:"
"~%~%"
"~a"
"~%~%"
"Predicate call will always return false."
"~%~%"
- "Procedure ~a is a predicate for"
+ "Procedure ~a is a predicate for:"
"~%~%"
"~a"
"~%~%"
- "The given argument has this type"
+ "The given argument has this type:"
"~%~%"
"~a")
(pp-fragment node " ")
@@ -2721,11 +2759,11 @@
(list test-node if-node)
loc
(string-append
- "In conditional expression"
+ "In conditional expression:"
"~%~%"
"~a"
"~%~%"
- "Test condition has always true value of type"
+ "Test condition has always true value of type:"
"~%~%"
"~a")
(pp-fragment if-node " ")
@@ -2737,7 +2775,7 @@
(list test-node if-node)
loc
(string-append
- "In conditional expression"
+ "In conditional expression:"
"~%~%"
"~a"
"~%~%"
@@ -2752,11 +2790,11 @@
(list node)
loc
(string-append
- "In expression"
+ "In expression:"
"~%~%"
"~a"
"~%~%"
- "Expression returns 0 values but is declared to return"
+ "Expression returns 0 values but is declared to return:"
"~%~%"
"~a")
(pp-fragment node " ")
@@ -2769,42 +2807,42 @@
(list node)
loc
(string-append
- "In expression"
+ "In expression:"
"~%~%"
"~a"
"~%~%"
"Expression returns too many values."
"~%~%"
- "The expression returns ~a values but is declared to return"
+ "The expression returns ~a values but is declared to return:"
"~%~%"
"~a")
(pp-fragment node " ")
(length rtypes)
(type->pp-string the-type)))
-(define (r-type-mismatch-in-the loc node first-rtype the-type)
+(define (r-type-mismatch-in-the loc node atype the-type)
(report2
"Type mismatch"
warning
(list node)
loc
(string-append
- "In expression"
+ "In expression:"
"~%~%"
"~a"
"~%~%"
"Expression's declared and actual types do not match."
"~%~%"
- "The actual type is"
+ "The declared type is:"
"~%~%"
"~a"
"~%~%"
- "The expression's declared type is"
+ "The actual type is:"
"~%~%"
"~a")
(pp-fragment node " ")
- (type->pp-string first-rtype)
- (type->pp-string the-type)))
+ (type->pp-string the-type)
+ (type->pp-string atype)))
(define (fail-compiler-typecase loc node atype ct-types)
(define (ppt t) (string-add-indent (type->pp-string t) " "))
@@ -2813,17 +2851,17 @@
"No typecase matches.~%"
"~a"
" ~a"
- "In `compiler-typecase' expression"
+ "In `compiler-typecase' expression:"
"~%~%"
"~a"
"~%~%"
" Tested expression in `compiler-typecase' does not match any case."
"~%~%"
- " The expression has this type"
+ " The expression has this type:"
"~%~%"
"~a"
"~%~%"
- " The specified type cases are these"
+ " The specified type cases are these:"
"~%~%"
"~a")
(if (string=? "" (node-source-prefix node))
@@ -2841,17 +2879,17 @@
(list a-node node)
loc
(string-append
- "In conditional expression"
+ "In conditional expression:"
"~%~%"
"~a"
"~%~%"
"The branches have different number of returned values."
"~%~%"
- "The true branch returns ~a value~a"
+ "This true branch returns ~a value~a:"
"~%~%"
"~a"
"~%~%"
- "The false branch returns ~a value~a"
+ "This false branch returns ~a value~a:"
"~%~%"
"~a")
(pp-fragment node " ")
@@ -2867,23 +2905,24 @@
(list node value-node)
loc
(string-append
- "In assignment"
+ "In assignment:"
"~%~%"
"~a"
"~%~%"
"Variable `~a' is assigned invalid value."
"~%~%"
- "The assigned value has this type"
+ "The assigned value has this type:"
"~%~%"
"~a"
"~%~%"
- "The declared type of `~a' is"
+ "The declared type of ~a is:"
"~%~%"
"~a")
(pp-fragment node " ")
- var
+ (strip-namespace var)
(type->pp-string atype)
- var
+ (variable-from-module (let ((n (real-name var)))
+ (if (symbol? n) n (string->symbol n))))
(type->pp-string xptype)))
(define (r-deprecated-identifier loc node id #!optional suggestion)
@@ -2893,7 +2932,7 @@
(list node)
loc
(string-append
- "In expression"
+ "In expression:"
"~%~%"
"~a"
"~%~%"
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
index 056a68c..6c34b00 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -8,66 +8,70 @@ Warning: literal in operator position: (1 2)
Warning: Wrong number of arguments.
(test-scrutinizer-message-format.scm:XXX)
In `r-proc-call-argument-count-mismatch', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#cons '())
Procedure `cons' is called with 1 argument but 2 arguments is expected.
- Procedure `cons' from module `scheme' has this type
+ Procedure `cons' from module `scheme' has this type:
('aXXX 'bXXX --> (pair 'aXXX 'bXXX))
Warning: Invalid argument type.
(test-scrutinizer-message-format.scm:XXX)
In `r-proc-call-argument-type-mismatch', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#length 'symbol)
- Argument #1 to procedure `length' has invalid type
+ Argument #1 to procedure `length' has invalid type:
symbol
- The expected type is
+ The expected type is:
list
- Procedure `length' from module `scheme' has this type
+ This is the expression:
+
+ 'symbol
+
+ Procedure `length' from module `scheme' has this type:
(list -> fixnum)
Warning: Too many argument values.
(test-scrutinizer-message-format.scm:XXX)
In `r-proc-call-argument-value-count', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#list (chicken.time#cpu-time))
- Argument #1 to procedure `list' returns 2 values but 1 is expected.
+ Argument expression #1 to procedure `list' returns 2 values but 1 is
expected.
- It is a call to `cpu-time' from module `chicken.time' which has this type
+ The expression is a call to `cpu-time' from module `chicken.time' which has
this type:
(-> fixnum fixnum)
- This is the expression
+ This is the expression:
(chicken.time#cpu-time)
Warning: No values returned for argument.
(test-scrutinizer-message-format.scm:XXX)
In `r-proc-call-argument-value-count', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#vector (scheme#values))
- Argument #1 to procedure `vector' does not return any values.
+ Argument expression #1 to procedure `vector' does not return any values.
- It is a call to `values' from module `scheme' which has this type
+ The expression is a call to `values' from module `scheme' which has this
type:
(procedure scheme#values (&rest values) . *)
- This is the expression
+ This is the expression:
(scheme#values)
@@ -77,81 +81,87 @@ Warning: In `r-proc-call-argument-value-count', a toplevel
procedure
Warning: Branch value count mismatch.
(test-scrutinizer-message-format.scm:XXX)
In `r-cond-branch-value-count-mismatch', a toplevel procedure
- In conditional expression
+ In conditional expression:
(if (the * 1) 1 (chicken.time#cpu-time))
The branches have different number of returned values.
- The true branch returns 1 value
+ This true branch returns 1 value:
1
- The false branch returns 2 values
+ This false branch returns 2 values:
(chicken.time#cpu-time)
Warning: Invalid procedure.
In `r-invalid-called-procedure-type', a toplevel procedure
- In procedure call
+ In procedure call:
(1 2)
- Procedure in a procedure call has invalid type
+ The procedure expression does not appear to be a callable.
- fixnum
-
- The expected type is
+ The expected type is:
(* -> *)
+ The actual type is:
+
+ fixnum
+
+ This is the expression:
+
+ 1
+
Note: Predicate always true.
(test-scrutinizer-message-format.scm:XXX)
In `r-pred-call-always-true', a toplevel procedure
- In predicate call
+ In predicate call:
(scheme#list? '())
Predicate call will always return true.
- Procedure `list?' from module `scheme' is a predicate for
+ Procedure `list?' from module `scheme' is a predicate for:
list
- The given argument has this type
+ The given argument has this type:
null
Note: Predicate always false.
(test-scrutinizer-message-format.scm:XXX)
In `r-pred-call-always-false', a toplevel procedure
- In predicate call
+ In predicate call:
(scheme#symbol? 1)
Predicate call will always return false.
- Procedure `symbol?' from module `scheme' is a predicate for
+ Procedure `symbol?' from module `scheme' is a predicate for:
symbol
- The given argument has this type
+ The given argument has this type:
fixnum
Note: Test always true.
In `r-cond-test-always-true', a toplevel procedure
- In conditional expression
+ In conditional expression:
(if 'symbol 1 (##core#undefined))
- Test condition has always true value of type
+ Test condition has always true value of type:
symbol
Note: Test always false.
In `r-cond-test-always-false', a toplevel procedure
- In conditional expression
+ In conditional expression:
(if #f 1 (##core#undefined))
@@ -159,80 +169,80 @@ Note: Test always false.
Warning: Type mismatch.
In `r-type-mismatch-in-the', a toplevel procedure
- In expression
+ In expression:
1
Expression's declared and actual types do not match.
- The actual type is
-
- fixnum
-
- The expression's declared type is
+ The declared type is:
symbol
+ The actual type is:
+
+ fixnum
+
Warning: Zero values returned.
(test-scrutinizer-message-format.scm:XXX)
In `r-zero-values-for-the', a toplevel procedure
- In expression
+ In expression:
(scheme#values)
- Expression returns 0 values but is declared to return
+ Expression returns 0 values but is declared to return:
symbol
Warning: Too many values returned.
(test-scrutinizer-message-format.scm:XXX)
In `r-too-many-values-for-the', a toplevel procedure
- In expression
+ In expression:
(scheme#values 1 2)
Expression returns too many values.
- The expression returns 2 values but is declared to return
+ The expression returns 2 values but is declared to return:
symbol
Warning: Type mismatch.
(test-scrutinizer-message-format.scm:XXX)
In `r-too-many-values-for-the', a toplevel procedure
- In expression
+ In expression:
(scheme#values 1 2)
Expression's declared and actual types do not match.
- The actual type is
+ The declared type is:
+
+ symbol
+
+ The actual type is:
fixnum
- The expression's declared type is
-
- symbol
-
Warning: Invalid assigned value type.
In `r-toplevel-var-assignment-type-mismatch', a toplevel procedure
- In assignment
+ In assignment:
(set! foo 1)
Variable `foo' is assigned invalid value.
- The assigned value has this type
+ The assigned value has this type:
fixnum
- The declared type of `foo' is
+ The declared type of `foo' is:
boolean
Warning: Deprecated identifier `deprecated-foo'.
In `r-deprecated-identifier', a toplevel procedure
- In expression
+ In expression:
deprecated-foo
@@ -240,7 +250,7 @@ Warning: Deprecated identifier `deprecated-foo'.
Warning: Deprecated identifier `deprecated-foo2'.
In `r-deprecated-identifier', a toplevel procedure
- In expression
+ In expression:
deprecated-foo2
@@ -250,17 +260,17 @@ Warning: Deprecated identifier `deprecated-foo2'.
Warning: Invalid assigned value type.
At toplevel:
- In assignment
+ In assignment:
(set! foo 1)
Variable `foo' is assigned invalid value.
- The assigned value has this type
+ The assigned value has this type:
fixnum
- The declared type of `foo' is
+ The declared type of `foo' is:
boolean
@@ -276,13 +286,13 @@ Warning: Wrong number of arguments.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-proc-call-argument-count-mismatch', a local procedure
- In procedure call
+ In procedure call:
(scheme#cons '())
Procedure `cons' is called with 1 argument but 2 arguments is expected.
- Procedure `cons' from module `scheme' has this type
+ Procedure `cons' from module `scheme' has this type:
('aXXX 'bXXX --> (pair 'aXXX 'bXXX))
@@ -291,19 +301,23 @@ Warning: Invalid argument type.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-proc-call-argument-type-mismatch', a local procedure
- In procedure call
+ In procedure call:
(scheme#string-length chicken.base#add1)
- Argument #1 to procedure `string-length' has invalid type
+ Argument #1 to procedure `string-length' has invalid type:
(procedure chicken.base#add1 (number) number)
- The expected type is
+ The expected type is:
string
- Procedure `string-length' from module `scheme' has this type
+ This is the expression:
+
+ chicken.base#add1
+
+ Procedure `string-length' from module `scheme' has this type:
(string -> fixnum)
@@ -312,17 +326,17 @@ Warning: Too many argument values.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-proc-call-argument-value-count', a local procedure
- In procedure call
+ In procedure call:
(scheme#list (chicken.time#cpu-time))
- Argument #1 to procedure `list' returns 2 values but 1 is expected.
+ Argument expression #1 to procedure `list' returns 2 values but 1 is
expected.
- It is a call to `cpu-time' from module `chicken.time' which has this type
+ The expression is a call to `cpu-time' from module `chicken.time' which has
this type:
(-> fixnum fixnum)
- This is the expression
+ This is the expression:
(chicken.time#cpu-time)
@@ -331,17 +345,17 @@ Warning: No values returned for argument.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-proc-call-argument-value-count', a local procedure
- In procedure call
+ In procedure call:
(scheme#vector (scheme#values))
- Argument #1 to procedure `vector' does not return any values.
+ Argument expression #1 to procedure `vector' does not return any values.
- It is a call to `values' from module `scheme' which has this type
+ The expression is a call to `values' from module `scheme' which has this
type:
(procedure scheme#values (&rest values) . *)
- This is the expression
+ This is the expression:
(scheme#values)
@@ -350,17 +364,17 @@ Warning: Branch value count mismatch.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-cond-branch-value-count-mismatch', a local procedure
- In conditional expression
+ In conditional expression:
(if (the * 1) 1 (chicken.time#cpu-time))
The branches have different number of returned values.
- The true branch returns 1 value
+ This true branch returns 1 value:
1
- The false branch returns 2 values
+ This false branch returns 2 values:
(chicken.time#cpu-time)
@@ -370,51 +384,55 @@ Warning: Invalid procedure.
In `local-bar', a local procedure
In `r-invalid-called-procedure-type', a local procedure
In `variable', a local procedure
- In procedure call
+ In procedure call:
(m#foo2 2)
- Procedure in a procedure call has invalid type
+ Variable `foo2' from module `m' is not a procedure.
+
+ It has this type:
boolean
- The expected type is
-
- (* -> *)
-
Warning: Invalid procedure.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-invalid-called-procedure-type', a local procedure
In `non-variable', a local procedure
- In procedure call
+ In procedure call:
(1 2)
- Procedure in a procedure call has invalid type
+ The procedure expression does not appear to be a callable.
- fixnum
-
- The expected type is
+ The expected type is:
(* -> *)
+ The actual type is:
+
+ fixnum
+
+ This is the expression:
+
+ 1
+
Note: Predicate always true.
(test-scrutinizer-message-format.scm:XXX)
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-pred-call-always-true', a local procedure
- In predicate call
+ In predicate call:
(scheme#list? '())
Predicate call will always return true.
- Procedure `list?' from module `scheme' is a predicate for
+ Procedure `list?' from module `scheme' is a predicate for:
list
- The given argument has this type
+ The given argument has this type:
null
@@ -423,17 +441,17 @@ Note: Predicate always false.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-pred-call-always-false', a local procedure
- In predicate call
+ In predicate call:
(scheme#symbol? 1)
Predicate call will always return false.
- Procedure `symbol?' from module `scheme' is a predicate for
+ Procedure `symbol?' from module `scheme' is a predicate for:
symbol
- The given argument has this type
+ The given argument has this type:
fixnum
@@ -442,11 +460,11 @@ Note: Test always true.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-cond-test-always-true', a local procedure
- In conditional expression
+ In conditional expression:
(if (scheme#length '()) 1 (##core#undefined))
- Test condition has always true value of type
+ Test condition has always true value of type:
fixnum
@@ -454,7 +472,7 @@ Note: Test always false.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-cond-test-always-false', a local procedure
- In conditional expression
+ In conditional expression:
(if #f 1 (##core#undefined))
@@ -464,35 +482,35 @@ Warning: Type mismatch.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-type-mismatch-in-the', a local procedure
- In expression
+ In expression:
1
Expression's declared and actual types do not match.
- The actual type is
-
- fixnum
-
- The expression's declared type is
+ The declared type is:
symbol
+ The actual type is:
+
+ fixnum
+
Warning: Invalid assigned value type.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-toplevel-var-assignment-type-mismatch', a local procedure
- In assignment
+ In assignment:
(set! m#foo2 1)
- Variable `m#foo2' is assigned invalid value.
+ Variable `foo2' is assigned invalid value.
- The assigned value has this type
+ The assigned value has this type:
fixnum
- The declared type of `m#foo2' is
+ The declared type of `foo2' from module `m' is:
boolean
@@ -500,7 +518,7 @@ Warning: Deprecated identifier `deprecated-foo'.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-deprecated-identifier', a local procedure
- In expression
+ In expression:
m#deprecated-foo
@@ -510,7 +528,7 @@ Warning: Deprecated identifier `deprecated-foo2'.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-deprecated-identifier', a local procedure
- In expression
+ In expression:
m#deprecated-foo2
@@ -523,11 +541,11 @@ Warning: Zero values returned.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-zero-values-for-the', a local procedure
- In expression
+ In expression:
(scheme#values)
- Expression returns 0 values but is declared to return
+ Expression returns 0 values but is declared to return:
symbol
@@ -551,13 +569,13 @@ Warning: Too many values returned.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-too-many-values-for-the', a local procedure
- In expression
+ In expression:
(scheme#values 1 2)
Expression returns too many values.
- The expression returns 2 values but is declared to return
+ The expression returns 2 values but is declared to return:
symbol
@@ -566,20 +584,20 @@ Warning: Type mismatch.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `r-too-many-values-for-the', a local procedure
- In expression
+ In expression:
(scheme#values 1 2)
Expression's declared and actual types do not match.
- The actual type is
+ The declared type is:
+
+ symbol
+
+ The actual type is:
fixnum
- The expression's declared type is
-
- symbol
-
Warning: In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `too-many-values-for-assignment', a local procedure
@@ -663,17 +681,17 @@ Error: No typecase matches.
In `m#toplevel-foo', a toplevel procedure
In `local-bar', a local procedure
In `fail-compiler-typecase', a local procedure
- In `compiler-typecase' expression
+ In `compiler-typecase' expression:
(compiler-typecase gXXX (symbol 1) (list 2) (else (##core#undefined)))
Tested expression in `compiler-typecase' does not match any case.
- The expression has this type
+ The expression has this type:
fixnum
- The specified type cases are these
+ The specified type cases are these:
symbol
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index 11cc34a..b56f1d6 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -4,373 +4,373 @@
Note: Predicate always true.
(scrutiny-tests-2.scm:20)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#pair? p)
Predicate call will always return true.
- Procedure `pair?' from module `scheme' is a predicate for
+ Procedure `pair?' from module `scheme' is a predicate for:
pair
- The given argument has this type
+ The given argument has this type:
pair
Note: Predicate always false.
(scrutiny-tests-2.scm:20)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#pair? l)
Predicate call will always return false.
- Procedure `pair?' from module `scheme' is a predicate for
+ Procedure `pair?' from module `scheme' is a predicate for:
pair
- The given argument has this type
+ The given argument has this type:
null
Note: Predicate always false.
(scrutiny-tests-2.scm:20)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#pair? n)
Predicate call will always return false.
- Procedure `pair?' from module `scheme' is a predicate for
+ Procedure `pair?' from module `scheme' is a predicate for:
pair
- The given argument has this type
+ The given argument has this type:
null
Note: Predicate always false.
(scrutiny-tests-2.scm:20)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#pair? i)
Predicate call will always return false.
- Procedure `pair?' from module `scheme' is a predicate for
+ Procedure `pair?' from module `scheme' is a predicate for:
pair
- The given argument has this type
+ The given argument has this type:
fixnum
Note: Predicate always false.
(scrutiny-tests-2.scm:20)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#pair? f)
Predicate call will always return false.
- Procedure `pair?' from module `scheme' is a predicate for
+ Procedure `pair?' from module `scheme' is a predicate for:
pair
- The given argument has this type
+ The given argument has this type:
float
Note: Predicate always true.
(scrutiny-tests-2.scm:21)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#list? l)
Predicate call will always return true.
- Procedure `list?' from module `scheme' is a predicate for
+ Procedure `list?' from module `scheme' is a predicate for:
list
- The given argument has this type
+ The given argument has this type:
null
Note: Predicate always true.
(scrutiny-tests-2.scm:21)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#list? n)
Predicate call will always return true.
- Procedure `list?' from module `scheme' is a predicate for
+ Procedure `list?' from module `scheme' is a predicate for:
list
- The given argument has this type
+ The given argument has this type:
null
Note: Predicate always false.
(scrutiny-tests-2.scm:21)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#list? i)
Predicate call will always return false.
- Procedure `list?' from module `scheme' is a predicate for
+ Procedure `list?' from module `scheme' is a predicate for:
list
- The given argument has this type
+ The given argument has this type:
fixnum
Note: Predicate always false.
(scrutiny-tests-2.scm:21)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#list? f)
Predicate call will always return false.
- Procedure `list?' from module `scheme' is a predicate for
+ Procedure `list?' from module `scheme' is a predicate for:
list
- The given argument has this type
+ The given argument has this type:
float
Note: Predicate always true.
(scrutiny-tests-2.scm:22)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#null? n)
Predicate call will always return true.
- Procedure `null?' from module `scheme' is a predicate for
+ Procedure `null?' from module `scheme' is a predicate for:
null
- The given argument has this type
+ The given argument has this type:
null
Note: Predicate always true.
(scrutiny-tests-2.scm:22)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#null? l)
Predicate call will always return true.
- Procedure `null?' from module `scheme' is a predicate for
+ Procedure `null?' from module `scheme' is a predicate for:
null
- The given argument has this type
+ The given argument has this type:
null
Note: Predicate always false.
(scrutiny-tests-2.scm:22)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#null? p)
Predicate call will always return false.
- Procedure `null?' from module `scheme' is a predicate for
+ Procedure `null?' from module `scheme' is a predicate for:
null
- The given argument has this type
+ The given argument has this type:
pair
Note: Predicate always false.
(scrutiny-tests-2.scm:22)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#null? i)
Predicate call will always return false.
- Procedure `null?' from module `scheme' is a predicate for
+ Procedure `null?' from module `scheme' is a predicate for:
null
- The given argument has this type
+ The given argument has this type:
fixnum
Note: Predicate always false.
(scrutiny-tests-2.scm:22)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#null? f)
Predicate call will always return false.
- Procedure `null?' from module `scheme' is a predicate for
+ Procedure `null?' from module `scheme' is a predicate for:
null
- The given argument has this type
+ The given argument has this type:
float
Note: Predicate always true.
(scrutiny-tests-2.scm:23)
At toplevel:
- In predicate call
+ In predicate call:
(chicken.base#fixnum? i)
Predicate call will always return true.
- Procedure `fixnum?' from module `chicken.base' is a predicate for
+ Procedure `fixnum?' from module `chicken.base' is a predicate for:
fixnum
- The given argument has this type
+ The given argument has this type:
fixnum
Note: Predicate always false.
(scrutiny-tests-2.scm:23)
At toplevel:
- In predicate call
+ In predicate call:
(chicken.base#fixnum? f)
Predicate call will always return false.
- Procedure `fixnum?' from module `chicken.base' is a predicate for
+ Procedure `fixnum?' from module `chicken.base' is a predicate for:
fixnum
- The given argument has this type
+ The given argument has this type:
float
Note: Predicate always true.
(scrutiny-tests-2.scm:25)
At toplevel:
- In predicate call
+ In predicate call:
(chicken.base#flonum? f)
Predicate call will always return true.
- Procedure `flonum?' from module `chicken.base' is a predicate for
+ Procedure `flonum?' from module `chicken.base' is a predicate for:
float
- The given argument has this type
+ The given argument has this type:
float
Note: Predicate always false.
(scrutiny-tests-2.scm:25)
At toplevel:
- In predicate call
+ In predicate call:
(chicken.base#flonum? i)
Predicate call will always return false.
- Procedure `flonum?' from module `chicken.base' is a predicate for
+ Procedure `flonum?' from module `chicken.base' is a predicate for:
float
- The given argument has this type
+ The given argument has this type:
fixnum
Note: Predicate always true.
(scrutiny-tests-2.scm:27)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#number? i)
Predicate call will always return true.
- Procedure `number?' from module `scheme' is a predicate for
+ Procedure `number?' from module `scheme' is a predicate for:
number
- The given argument has this type
+ The given argument has this type:
fixnum
Note: Predicate always true.
(scrutiny-tests-2.scm:27)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#number? f)
Predicate call will always return true.
- Procedure `number?' from module `scheme' is a predicate for
+ Procedure `number?' from module `scheme' is a predicate for:
number
- The given argument has this type
+ The given argument has this type:
float
Note: Predicate always true.
(scrutiny-tests-2.scm:27)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#number? u)
Predicate call will always return true.
- Procedure `number?' from module `scheme' is a predicate for
+ Procedure `number?' from module `scheme' is a predicate for:
number
- The given argument has this type
+ The given argument has this type:
number
Note: Predicate always false.
(scrutiny-tests-2.scm:27)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#number? n)
Predicate call will always return false.
- Procedure `number?' from module `scheme' is a predicate for
+ Procedure `number?' from module `scheme' is a predicate for:
number
- The given argument has this type
+ The given argument has this type:
null
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index dd5f97b..701abbc 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -7,173 +7,183 @@ Note: Test always true.
In `a', a toplevel procedure
In `b', a local procedure
In `c', a local procedure
- In conditional expression
+ In conditional expression:
(if x 1 2)
- Test condition has always true value of type
+ Test condition has always true value of type:
number
Note: Test always true.
In `b', a toplevel procedure
- In conditional expression
+ In conditional expression:
(if x 1 2)
- Test condition has always true value of type
+ Test condition has always true value of type:
true
Warning: Branch value count mismatch.
(scrutiny-tests.scm:16)
In `foo', a toplevel procedure
- In conditional expression
+ In conditional expression:
(if x (scheme#values 1 2) (scheme#values 1 2 (scheme#+ (scheme#+ ...))))
The branches have different number of returned values.
- The true branch returns 2 values
+ This true branch returns 2 values:
(scheme#values 1 2)
- The false branch returns 3 values
+ This false branch returns 3 values:
(scheme#values 1 2 (scheme#+ (scheme#+ (scheme#+ ...))))
Warning: Invalid argument type.
(scrutiny-tests.scm:19)
At toplevel:
- In procedure call
+ In procedure call:
(bar 3 'a)
- Argument #2 to procedure `bar' has invalid type
+ Argument #2 to procedure `bar' has invalid type:
symbol
- The expected type is
+ The expected type is:
number
- Procedure `bar' has this type
+ This is the expression:
+
+ 'a
+
+ Procedure `bar' has this type:
(&rest number -> number)
Warning: Wrong number of arguments.
(scrutiny-tests.scm:21)
At toplevel:
- In procedure call
+ In procedure call:
(scheme#string?)
Procedure `string?' is called with 0 arguments but 1 argument is expected.
- Procedure `string?' from module `scheme' has this type
+ Procedure `string?' from module `scheme' has this type:
(* -> boolean)
Warning: Too many argument values.
(scrutiny-tests.scm:23)
At toplevel:
- In procedure call
+ In procedure call:
(chicken.base#print (scheme#values 1 2))
- Argument #1 to procedure `print' returns 2 values but 1 is expected.
+ Argument expression #1 to procedure `print' returns 2 values but 1 is
expected.
- It is a call to `values' from module `scheme' which has this type
+ The expression is a call to `values' from module `scheme' which has this
type:
(procedure scheme#values (&rest values) . *)
- This is the expression
+ This is the expression:
(scheme#values 1 2)
Warning: No values returned for argument.
(scrutiny-tests.scm:24)
At toplevel:
- In procedure call
+ In procedure call:
(chicken.base#print (scheme#values))
- Argument #1 to procedure `print' does not return any values.
+ Argument expression #1 to procedure `print' does not return any values.
- It is a call to `values' from module `scheme' which has this type
+ The expression is a call to `values' from module `scheme' which has this
type:
(procedure scheme#values (&rest values) . *)
- This is the expression
+ This is the expression:
(scheme#values)
Warning: Invalid procedure.
(scrutiny-tests.scm:27)
At toplevel:
- In procedure call
+ In procedure call:
(x)
- Procedure in a procedure call has invalid type
+ Variable `x18' is not a procedure.
+
+ It has this type:
fixnum
- The expected type is
-
- (-> *)
-
Warning: Invalid argument type.
(scrutiny-tests.scm:29)
At toplevel:
- In procedure call
+ In procedure call:
(scheme#+ 'a 'b)
- Argument #1 to procedure `+' has invalid type
+ Argument #1 to procedure `+' has invalid type:
symbol
- The expected type is
+ The expected type is:
number
- Procedure `+' from module `scheme' has this type
+ This is the expression:
+
+ 'a
+
+ Procedure `+' from module `scheme' has this type:
(&rest number -> number)
Warning: Invalid argument type.
(scrutiny-tests.scm:29)
At toplevel:
- In procedure call
+ In procedure call:
(scheme#+ 'a 'b)
- Argument #2 to procedure `+' has invalid type
+ Argument #2 to procedure `+' has invalid type:
symbol
- The expected type is
+ The expected type is:
number
- Procedure `+' from module `scheme' has this type
+ This is the expression:
+
+ 'b
+
+ Procedure `+' from module `scheme' has this type:
(&rest number -> number)
Warning: Invalid assigned value type.
At toplevel:
- In assignment
+ In assignment:
(set! scheme#car 33)
- Variable `scheme#car' is assigned invalid value.
+ Variable `car' is assigned invalid value.
- The assigned value has this type
+ The assigned value has this type:
fixnum
- The declared type of `scheme#car' is
+ The declared type of `car' from module `scheme' is:
(procedure scheme#car ((pair 'a335 *)) 'a335)
@@ -182,281 +192,323 @@ Warning: At toplevel:
Warning: Invalid procedure.
At toplevel:
- In procedure call
+ In procedure call:
(gXXX)
- Procedure in a procedure call has invalid type
+ Variable `gXXX' is not a procedure.
+
+ It has this type:
fixnum
- The expected type is
-
- (-> *)
-
Note: Test always true.
In `foo', a toplevel procedure
- In conditional expression
+ In conditional expression:
(if bar 3 (##core#undefined))
- Test condition has always true value of type
+ Test condition has always true value of type:
(procedure bar () *)
Warning: Invalid argument type.
(scrutiny-tests.scm:58)
In `foo2', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#string-append x "abc")
- Argument #1 to procedure `string-append' has invalid type
+ Argument #1 to procedure `string-append' has invalid type:
number
- The expected type is
+ The expected type is:
string
- Procedure `string-append' from module `scheme' has this type
+ This is the expression:
+
+ x
+
+ Procedure `string-append' from module `scheme' has this type:
(&rest string -> string)
Warning: Invalid argument type.
(scrutiny-tests.scm:66)
At toplevel:
- In procedure call
+ In procedure call:
(foo3 99)
- Argument #1 to procedure `foo3' has invalid type
+ Argument #1 to procedure `foo3' has invalid type:
fixnum
- The expected type is
+ The expected type is:
string
- Procedure `foo3' has this type
+ This is the expression:
+
+ 99
+
+ Procedure `foo3' has this type:
(string -> string)
Warning: Invalid argument type.
(scrutiny-tests.scm:71)
In `foo4', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#+ x 1)
- Argument #1 to procedure `+' has invalid type
+ Argument #1 to procedure `+' has invalid type:
string
- The expected type is
+ The expected type is:
number
- Procedure `+' from module `scheme' has this type
+ This is the expression:
+
+ x
+
+ Procedure `+' from module `scheme' has this type:
(&rest number -> number)
Warning: Invalid argument type.
(scrutiny-tests.scm:77)
In `foo5', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#+ x 3)
- Argument #1 to procedure `+' has invalid type
+ Argument #1 to procedure `+' has invalid type:
string
- The expected type is
+ The expected type is:
number
- Procedure `+' from module `scheme' has this type
+ This is the expression:
+
+ x
+
+ Procedure `+' from module `scheme' has this type:
(&rest number -> number)
Warning: Invalid argument type.
(scrutiny-tests.scm:83)
In `foo6', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#+ x 3)
- Argument #1 to procedure `+' has invalid type
+ Argument #1 to procedure `+' has invalid type:
string
- The expected type is
+ The expected type is:
number
- Procedure `+' from module `scheme' has this type
+ This is the expression:
+
+ x
+
+ Procedure `+' from module `scheme' has this type:
(&rest number -> number)
Warning: Invalid argument type.
(scrutiny-tests.scm:90)
At toplevel:
- In procedure call
+ In procedure call:
(scheme#+ x 1)
- Argument #1 to procedure `+' has invalid type
+ Argument #1 to procedure `+' has invalid type:
string
- The expected type is
+ The expected type is:
number
- Procedure `+' from module `scheme' has this type
+ This is the expression:
+
+ x
+
+ Procedure `+' from module `scheme' has this type:
(&rest number -> number)
Warning: Invalid argument type.
(scrutiny-tests.scm:104)
In `foo10', a toplevel procedure
- In procedure call
+ In procedure call:
(foo9 x)
- Argument #1 to procedure `foo9' has invalid type
+ Argument #1 to procedure `foo9' has invalid type:
number
- The expected type is
+ The expected type is:
string
- Procedure `foo9' has this type
+ This is the expression:
+
+ x
+
+ Procedure `foo9' has this type:
(string -> symbol)
Warning: Invalid argument type.
(scrutiny-tests.scm:105)
In `foo10', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#+ x 1)
- Argument #1 to procedure `+' has invalid type
+ Argument #1 to procedure `+' has invalid type:
string
- The expected type is
+ The expected type is:
number
- Procedure `+' from module `scheme' has this type
+ This is the expression:
+
+ x
+
+ Procedure `+' from module `scheme' has this type:
(&rest number -> number)
Warning: Type mismatch.
(scrutiny-tests.scm:109)
In `foo10', a toplevel procedure
- In expression
+ In expression:
(scheme#substring x 0 10)
Expression's declared and actual types do not match.
- The actual type is
-
- string
-
- The expression's declared type is
+ The declared type is:
pair
+ The actual type is:
+
+ string
+
Warning: Invalid argument type.
(scrutiny-tests.scm:109)
In `foo10', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#string-append (the pair (scheme#substring x 0 10)))
- Argument #1 to procedure `string-append' has invalid type
+ Argument #1 to procedure `string-append' has invalid type:
pair
- The expected type is
+ The expected type is:
string
- Procedure `string-append' from module `scheme' has this type
+ This is the expression:
+
+ (the pair (scheme#substring x 0 10))
+
+ Procedure `string-append' from module `scheme' has this type:
(&rest string -> string)
Warning: Too many values returned.
(scrutiny-tests.scm:110)
In `foo10', a toplevel procedure
- In expression
+ In expression:
(scheme#values 1 2)
Expression returns too many values.
- The expression returns 2 values but is declared to return
+ The expression returns 2 values but is declared to return:
*
Warning: Zero values returned.
(scrutiny-tests.scm:111)
In `foo10', a toplevel procedure
- In expression
+ In expression:
(scheme#values)
- Expression returns 0 values but is declared to return
+ Expression returns 0 values but is declared to return:
*
Warning: Invalid argument type.
(scrutiny-tests.scm:112)
In `foo10', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#* x y)
- Argument #1 to procedure `*' has invalid type
+ Argument #1 to procedure `*' has invalid type:
string
- The expected type is
+ The expected type is:
number
- Procedure `*' from module `scheme' has this type
+ This is the expression:
+
+ x
+
+ Procedure `*' from module `scheme' has this type:
(&rest number -> number)
Warning: Invalid argument type.
(scrutiny-tests.scm:137)
In `foo#blabla', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#+ 1 'x)
- Argument #2 to procedure `+' has invalid type
+ Argument #2 to procedure `+' has invalid type:
symbol
- The expected type is
+ The expected type is:
number
- Procedure `+' from module `scheme' has this type
+ This is the expression:
+
+ 'x
+
+ Procedure `+' from module `scheme' has this type:
(&rest number -> number)
Warning: Deprecated identifier `deprecated-procedure'.
At toplevel:
- In expression
+ In expression:
deprecated-procedure
@@ -464,7 +516,7 @@ Warning: Deprecated identifier `deprecated-procedure'.
Warning: Deprecated identifier `another-deprecated-procedure'.
At toplevel:
- In expression
+ In expression:
another-deprecated-procedure
@@ -475,265 +527,305 @@ Warning: Deprecated identifier
`another-deprecated-procedure'.
Warning: Invalid argument type.
(scrutiny-tests.scm:168)
At toplevel:
- In procedure call
+ In procedure call:
(apply1 scheme#+ (scheme#list 'a 2 3))
- Argument #2 to procedure `apply1' has invalid type
+ Argument #2 to procedure `apply1' has invalid type:
(list symbol fixnum fixnum)
- The expected type is
+ The expected type is:
(list-of number)
- Procedure `apply1' has this type
+ The expression is a call to `list' from module `scheme' which has this type:
+
+ (&rest * -> list)
+
+ This is the expression:
+
+ (scheme#list 'a 2 3)
+
+ Procedure `apply1' has this type:
((&rest 'a143 -> 'b144) (list-of 'a143) -> 'b144)
Warning: Invalid argument type.
(scrutiny-tests.scm:169)
At toplevel:
- In procedure call
+ In procedure call:
(apply1 scheme#+ (scheme#cons 'a (scheme#cons 2 (scheme#cons 3 ...))))
- Argument #2 to procedure `apply1' has invalid type
+ Argument #2 to procedure `apply1' has invalid type:
(list symbol fixnum fixnum)
- The expected type is
+ The expected type is:
(list-of number)
- Procedure `apply1' has this type
+ The expression is a call to `cons' from module `scheme' which has this type:
+
+ ('a331 'b332 -> (pair 'a331 'b332))
+
+ This is the expression:
+
+ (scheme#cons 'a (scheme#cons 2 (scheme#cons 3 '())))
+
+ Procedure `apply1' has this type:
((&rest 'a143 -> 'b144) (list-of 'a143) -> 'b144)
Note: Predicate always true.
(scrutiny-tests.scm:182)
At toplevel:
- In predicate call
+ In predicate call:
(chicken.base#fixnum? x)
Predicate call will always return true.
- Procedure `fixnum?' from module `chicken.base' is a predicate for
+ Procedure `fixnum?' from module `chicken.base' is a predicate for:
fixnum
- The given argument has this type
+ The given argument has this type:
fixnum
Note: Predicate always false.
(scrutiny-tests.scm:190)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#symbol? x)
Predicate call will always return false.
- Procedure `symbol?' from module `scheme' is a predicate for
+ Procedure `symbol?' from module `scheme' is a predicate for:
symbol
- The given argument has this type
+ The given argument has this type:
(or char string)
Note: Predicate always false.
(scrutiny-tests.scm:191)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#string? x)
Predicate call will always return false.
- Procedure `string?' from module `scheme' is a predicate for
+ Procedure `string?' from module `scheme' is a predicate for:
string
- The given argument has this type
+ The given argument has this type:
(not (or char string))
Note: Predicate always false.
(scrutiny-tests.scm:194)
At toplevel:
- In predicate call
+ In predicate call:
(char-or-string? x)
Predicate call will always return false.
- Procedure `char-or-string?' is a predicate for
+ Procedure `char-or-string?' is a predicate for:
(or char string)
- The given argument has this type
+ The given argument has this type:
fixnum
Note: Predicate always false.
(scrutiny-tests.scm:195)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#symbol? x)
Predicate call will always return false.
- Procedure `symbol?' from module `scheme' is a predicate for
+ Procedure `symbol?' from module `scheme' is a predicate for:
symbol
- The given argument has this type
+ The given argument has this type:
(or char string)
Note: Predicate always false.
(scrutiny-tests.scm:196)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#string? x)
Predicate call will always return false.
- Procedure `string?' from module `scheme' is a predicate for
+ Procedure `string?' from module `scheme' is a predicate for:
string
- The given argument has this type
+ The given argument has this type:
fixnum
Note: Predicate always false.
(scrutiny-tests.scm:200)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#symbol? x)
Predicate call will always return false.
- Procedure `symbol?' from module `scheme' is a predicate for
+ Procedure `symbol?' from module `scheme' is a predicate for:
symbol
- The given argument has this type
+ The given argument has this type:
char
Note: Predicate always false.
(scrutiny-tests.scm:201)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#string? x)
Predicate call will always return false.
- Procedure `string?' from module `scheme' is a predicate for
+ Procedure `string?' from module `scheme' is a predicate for:
string
- The given argument has this type
+ The given argument has this type:
symbol
Note: Predicate always false.
(scrutiny-tests.scm:205)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#symbol? x)
Predicate call will always return false.
- Procedure `symbol?' from module `scheme' is a predicate for
+ Procedure `symbol?' from module `scheme' is a predicate for:
symbol
- The given argument has this type
+ The given argument has this type:
(or char string)
Note: Predicate always false.
(scrutiny-tests.scm:206)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#string? x)
Predicate call will always return false.
- Procedure `string?' from module `scheme' is a predicate for
+ Procedure `string?' from module `scheme' is a predicate for:
string
- The given argument has this type
+ The given argument has this type:
symbol
Warning: Invalid argument type.
(scrutiny-tests.scm:210)
At toplevel:
- In procedure call
+ In procedure call:
(f (scheme#list))
- Argument #1 to procedure `f' has invalid type
+ Argument #1 to procedure `f' has invalid type:
null
- The expected type is
+ The expected type is:
pair
- Procedure `f' has this type
+ The expression is a call to `list' from module `scheme' which has this type:
+
+ (&rest * -> list)
+
+ This is the expression:
+
+ (scheme#list)
+
+ Procedure `f' has this type:
(pair -> *)
Warning: Invalid argument type.
(scrutiny-tests.scm:212)
At toplevel:
- In procedure call
+ In procedure call:
(f (scheme#list 1))
- Argument #1 to procedure `f' has invalid type
+ Argument #1 to procedure `f' has invalid type:
(list fixnum)
- The expected type is
+ The expected type is:
null
- Procedure `f' has this type
+ The expression is a call to `list' from module `scheme' which has this type:
+
+ (&rest * -> list)
+
+ This is the expression:
+
+ (scheme#list 1)
+
+ Procedure `f' has this type:
(null -> *)
Warning: Invalid argument type.
(scrutiny-tests.scm:214)
At toplevel:
- In procedure call
+ In procedure call:
(f (scheme#cons 1 2))
- Argument #1 to procedure `f' has invalid type
+ Argument #1 to procedure `f' has invalid type:
(pair fixnum fixnum)
- The expected type is
+ The expected type is:
list
- Procedure `f' has this type
+ The expression is a call to `cons' from module `scheme' which has this type:
+
+ ('a331 'b332 -> (pair 'a331 'b332))
+
+ This is the expression:
+
+ (scheme#cons 1 2)
+
+ Procedure `f' has this type:
(list -> *)
@@ -749,19 +841,23 @@ Warning: In `vector-ref-warn3', a toplevel procedure
Warning: Invalid argument type.
(scrutiny-tests.scm:226)
In `vector-ref-standard-warn1', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#vector-ref v1 'bad)
- Argument #2 to procedure `vector-ref' has invalid type
+ Argument #2 to procedure `vector-ref' has invalid type:
symbol
- The expected type is
+ The expected type is:
fixnum
- Procedure `vector-ref' from module `scheme' has this type
+ This is the expression:
+
+ 'bad
+
+ Procedure `vector-ref' from module `scheme' has this type:
((vector-of 'a384) fixnum -> 'a384)
@@ -777,19 +873,23 @@ Warning: In `vector-set!-warn3', a toplevel procedure
Warning: Invalid argument type.
(scrutiny-tests.scm:232)
In `vector-set!-standard-warn1', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#vector-set! v1 'bad 'whatever)
- Argument #2 to procedure `vector-set!' has invalid type
+ Argument #2 to procedure `vector-set!' has invalid type:
symbol
- The expected type is
+ The expected type is:
fixnum
- Procedure `vector-set!' from module `scheme' has this type
+ This is the expression:
+
+ 'bad
+
+ Procedure `vector-set!' from module `scheme' has this type:
(vector fixnum * -> undefined)
@@ -811,171 +911,227 @@ Warning: In `list-ref-warn5', a toplevel procedure
Warning: Invalid argument type.
(scrutiny-tests.scm:281)
In `list-ref-standard-warn1', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#list-ref l1 'bad)
- Argument #2 to procedure `list-ref' has invalid type
+ Argument #2 to procedure `list-ref' has invalid type:
symbol
- The expected type is
+ The expected type is:
fixnum
- Procedure `list-ref' from module `scheme' has this type
+ This is the expression:
+
+ 'bad
+
+ Procedure `list-ref' from module `scheme' has this type:
((list-of 'a366) fixnum -> 'a366)
Warning: Invalid argument type.
(scrutiny-tests.scm:282)
In `list-ref-standard-warn2', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#list-ref l1 'bad)
- Argument #2 to procedure `list-ref' has invalid type
+ Argument #2 to procedure `list-ref' has invalid type:
symbol
- The expected type is
+ The expected type is:
fixnum
- Procedure `list-ref' from module `scheme' has this type
+ This is the expression:
+
+ 'bad
+
+ Procedure `list-ref' from module `scheme' has this type:
((list-of 'a366) fixnum -> 'a366)
Warning: Invalid argument type.
(scrutiny-tests.scm:284)
In `list-ref-standard-warn3', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#list-ref l2 'bad)
- Argument #2 to procedure `list-ref' has invalid type
+ Argument #2 to procedure `list-ref' has invalid type:
symbol
- The expected type is
+ The expected type is:
fixnum
- Procedure `list-ref' from module `scheme' has this type
+ This is the expression:
+
+ 'bad
+
+ Procedure `list-ref' from module `scheme' has this type:
((list-of 'a366) fixnum -> 'a366)
Warning: Invalid argument type.
(scrutiny-tests.scm:285)
In `list-ref-standard-warn4', a toplevel procedure
- In procedure call
+ In procedure call:
(scheme#list-ref l2 'bad)
- Argument #2 to procedure `list-ref' has invalid type
+ Argument #2 to procedure `list-ref' has invalid type:
symbol
- The expected type is
+ The expected type is:
fixnum
- Procedure `list-ref' from module `scheme' has this type
+ This is the expression:
+
+ 'bad
+
+ Procedure `list-ref' from module `scheme' has this type:
((list-of 'a366) fixnum -> 'a366)
Warning: Invalid argument type.
(scrutiny-tests.scm:289)
In `list-ref-type-warn1', a toplevel procedure
- In procedure call
+ In procedure call:
(chicken.base#add1 (scheme#list-ref l1 1))
- Argument #1 to procedure `add1' has invalid type
+ Argument #1 to procedure `add1' has invalid type:
symbol
- The expected type is
+ The expected type is:
number
- Procedure `add1' from module `chicken.base' has this type
+ The expression is a call to `list-ref' from module `scheme' which has this
type:
+
+ ((list-of 'a366) fixnum -> 'a366)
+
+ This is the expression:
+
+ (scheme#list-ref l1 1)
+
+ Procedure `add1' from module `chicken.base' has this type:
(number -> number)
Warning: Invalid argument type.
(scrutiny-tests.scm:291)
In `list-ref-type-warn2', a toplevel procedure
- In procedure call
+ In procedure call:
(chicken.base#add1 (scheme#list-ref l2 1))
- Argument #1 to procedure `add1' has invalid type
+ Argument #1 to procedure `add1' has invalid type:
symbol
- The expected type is
+ The expected type is:
number
- Procedure `add1' from module `chicken.base' has this type
+ The expression is a call to `list-ref' from module `scheme' which has this
type:
+
+ ((list-of 'a366) fixnum -> 'a366)
+
+ This is the expression:
+
+ (scheme#list-ref l2 1)
+
+ Procedure `add1' from module `chicken.base' has this type:
(number -> number)
Warning: Invalid argument type.
(scrutiny-tests.scm:295)
In `list-ref-type-warn3', a toplevel procedure
- In procedure call
+ In procedure call:
(chicken.base#add1 (scheme#list-ref l3 1))
- Argument #1 to procedure `add1' has invalid type
+ Argument #1 to procedure `add1' has invalid type:
symbol
- The expected type is
+ The expected type is:
number
- Procedure `add1' from module `chicken.base' has this type
+ The expression is a call to `list-ref' from module `scheme' which has this
type:
+
+ ((list-of 'a366) fixnum -> 'a366)
+
+ This is the expression:
+
+ (scheme#list-ref l3 1)
+
+ Procedure `add1' from module `chicken.base' has this type:
(number -> number)
Warning: Invalid argument type.
(scrutiny-tests.scm:307)
In `append-result-type-warn1', a toplevel procedure
- In procedure call
+ In procedure call:
(chicken.base#add1 (scheme#list-ref l1 1))
- Argument #1 to procedure `add1' has invalid type
+ Argument #1 to procedure `add1' has invalid type:
symbol
- The expected type is
+ The expected type is:
number
- Procedure `add1' from module `chicken.base' has this type
+ The expression is a call to `list-ref' from module `scheme' which has this
type:
+
+ ((list-of 'a366) fixnum -> 'a366)
+
+ This is the expression:
+
+ (scheme#list-ref l1 1)
+
+ Procedure `add1' from module `chicken.base' has this type:
(number -> number)
Warning: Invalid argument type.
(scrutiny-tests.scm:312)
In `append-result-type-warn2', a toplevel procedure
- In procedure call
+ In procedure call:
(chicken.base#add1 (scheme#list-ref l3 3))
- Argument #1 to procedure `add1' has invalid type
+ Argument #1 to procedure `add1' has invalid type:
symbol
- The expected type is
+ The expected type is:
number
- Procedure `add1' from module `chicken.base' has this type
+ The expression is a call to `list-ref' from module `scheme' which has this
type:
+
+ ((list-of 'a366) fixnum -> 'a366)
+
+ This is the expression:
+
+ (scheme#list-ref l3 3)
+
+ Procedure `add1' from module `chicken.base' has this type:
(number -> number)
diff --git a/tests/specialization.expected b/tests/specialization.expected
index 9ceaaf3..6d3eabd 100644
--- a/tests/specialization.expected
+++ b/tests/specialization.expected
@@ -4,52 +4,52 @@
Note: Predicate always true.
(specialization-tests.scm:3)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#string? a)
Predicate call will always return true.
- Procedure `string?' from module `scheme' is a predicate for
+ Procedure `string?' from module `scheme' is a predicate for:
string
- The given argument has this type
+ The given argument has this type:
string
Note: Test always true.
(specialization-tests.scm:3)
At toplevel:
- In conditional expression
+ In conditional expression:
(if (scheme#string? a) 'ok 'no)
- Test condition has always true value of type
+ Test condition has always true value of type:
true
Note: Predicate always false.
(specialization-tests.scm:4)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#string? a)
Predicate call will always return false.
- Procedure `string?' from module `scheme' is a predicate for
+ Procedure `string?' from module `scheme' is a predicate for:
string
- The given argument has this type
+ The given argument has this type:
symbol
Note: Test always false.
(specialization-tests.scm:4)
At toplevel:
- In conditional expression
+ In conditional expression:
(if (scheme#string? a) 'ok 'no)
@@ -58,55 +58,55 @@ Note: Test always false.
Note: Predicate always true.
(specialization-tests.scm:10)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#input-port? p)
Predicate call will always return true.
- Procedure `input-port?' from module `scheme' is a predicate for
+ Procedure `input-port?' from module `scheme' is a predicate for:
input-port
- The given argument has this type
+ The given argument has this type:
input/output-port
Note: Test always true.
(specialization-tests.scm:10)
At toplevel:
- In conditional expression
+ In conditional expression:
(if (scheme#input-port? p) 'ok 'no)
- Test condition has always true value of type
+ Test condition has always true value of type:
true
Note: Predicate always true.
(specialization-tests.scm:11)
At toplevel:
- In predicate call
+ In predicate call:
(scheme#output-port? p)
Predicate call will always return true.
- Procedure `output-port?' from module `scheme' is a predicate for
+ Procedure `output-port?' from module `scheme' is a predicate for:
output-port
- The given argument has this type
+ The given argument has this type:
input/output-port
Note: Test always true.
(specialization-tests.scm:11)
At toplevel:
- In conditional expression
+ In conditional expression:
(if (scheme#output-port? p) 'ok 'no)
- Test condition has always true value of type
+ Test condition has always true value of type:
true
--
2.7.4
>From d03e6ea26a0a2855c3ba7e9f4764f993bcd9138c Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Tue, 27 Nov 2018 16:52:56 +0200
Subject: [PATCH 13/17] scrutinizer.scm: Update messages from special cases to
the new pretty print format
* scrutinizer.scm (r-index-out-of-range) : New function
---
scrutinizer.scm | 79 ++++++++-------------
tests/scrutinizer-message-format.expected | 110 ++++++++++++++++++++++--------
tests/scrutiny.expected | 110 ++++++++++++++++++++++++------
3 files changed, 196 insertions(+), 103 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index d8231e3..d40ef33 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -2067,16 +2067,6 @@
rtypes)))
(let ()
- ;; TODO: Complain argument not available here, so we can't use the
- ;; standard "report" defined above. However, ##sys#enable-warnings
- ;; and "complain" (do-scrutinize) are always true together, except
- ;; that "complain" will be false while ##sys#enable-warnings is true
- ;; on "no-usual-integrations", so perhaps get rid of "complain"?
- (define (report loc msg . args)
- (warning
- (conc (location-name loc)
- (sprintf "~?" msg args))))
-
(define (known-length-vector-index node args loc expected-argcount)
(and-let* ((subs (node-subexpressions node))
((= (length subs) (add1 expected-argcount)))
@@ -2091,12 +2081,7 @@
(if (and (>= val 0) (< val vector-length))
val
(begin
- (report
- loc "~ain procedure call to `~a', index ~a out of range \
- for vector of length ~a"
- (node-source-prefix node)
- ;; TODO: It might make more sense to use "pname" here
- (first (node-parameters (first subs))) val vector-length)
+ (r-index-out-of-range loc node val vector-length "vector")
#f))))
;; These are a bit hacky, since they mutate the node. These special
@@ -2136,12 +2121,6 @@
; list-ref, list-tail
(let ()
- ;; See comment in vector (let) just above this
- (define (report loc msg . args)
- (warning
- (conc (location-name loc)
- (sprintf "~?" msg args))))
-
(define (list-or-null a)
(if (null? a) 'null `(list ,@a)))
@@ -2184,25 +2163,15 @@
((eq? 'quote (node-class index)))
(val (first (node-parameters index)))
((fixnum? val))) ; Standard type warning otherwise
- ;; TODO: It might make sense to use "pname" when reporting
(cond ((negative? val)
- ;; Negative indices should always generate a warning
- (report
- loc "~ain procedure call to `~a', index ~a is \
- negative, which is never valid"
- (node-source-prefix node)
- (first (node-parameters (first subs))) val)
+ (r-index-out-of-range loc node val 'not-used "list")
#f)
((split-list-type arg1 val k))
;; Warn only if it's a known proper list. This avoids
;; false warnings due to component smashing.
((proper-list-type-length arg1) =>
(lambda (length)
- (report
- loc "~ain procedure call to `~a', index ~a out of \
- range for proper list of length ~a"
- (node-source-prefix node)
- (first (node-parameters (first subs))) val length)
+ (r-index-out-of-range loc node val length "list")
#f))
(else #f)))
rtypes)))
@@ -2248,12 +2217,6 @@
rtypes)))
(let ()
- ;; See comment in vector (let)
- (define (report loc msg . args)
- (warning
- (conc (location-name loc)
- (sprintf "~?" msg args))))
-
(define (append-special-case node args loc rtypes)
(define (potentially-proper-list? l) (match-types l 'list '()))
@@ -2285,17 +2248,9 @@
;; The final argument may be an atom or improper list
(unless (or (null? (cdr arg-types))
(potentially-proper-list? arg1))
- (report
- loc
- (string-append
- "~ain procedure call to `~a', argument #~a is of type"
- "~%~%~a~%~%"
- " but expected a proper list.")
- (node-source-prefix node)
- (first (node-parameters
- (first (node-subexpressions node))))
- index
- (type->pp-string arg1)))
+ (r-proc-call-argument-type-mismatch
+ loc node index 'list
+ (car arg-types) arg1 (variable-mark 'scheme#append
'##compiler#type)))
#f))))))
(cond ((derive-result-type) => list)
(else rtypes)))
@@ -2753,6 +2708,28 @@
(type->pp-string pred-type)
(type->pp-string atype)))
+(define (r-index-out-of-range loc node idx obj-length obj-name)
+ ;; Negative indices should always generate a warning
+ (define pname (call-node-pname node))
+ (report2
+ (sprintf "~a~a index ~a"
+ (char-upcase (string-ref obj-name 0)) (substring obj-name 1)
+ (if (negative? idx) "negative" "out of range"))
+ warning
+ (list node)
+ loc
+ (string-append
+ "In procedure call:"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Calling ~a with ~a")
+ (pp-fragment node " ")
+ (variable-from-module pname)
+ (if (negative? idx)
+ (sprintf "a negative index ~a." idx)
+ (sprintf "index `~a' for a ~a of length `~a'." idx obj-name
obj-length))))
+
(define (r-cond-test-always-true loc if-node test-node t)
(report-notice
"Test always true"
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
index 6c34b00..35272ba 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -274,12 +274,28 @@ Warning: Invalid assigned value type.
boolean
-Warning: In `append-invalid-arg', a toplevel procedure
- (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#append', argument #1 is of type
+Warning: Invalid argument type.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `append-invalid-arg', a toplevel procedure
+ In procedure call:
- fixnum
+ (scheme#append 1 (scheme#list 1))
- but expected a proper list.
+ Argument #1 to procedure `append' has invalid type:
+
+ fixnum
+
+ The expected type is:
+
+ list
+
+ This is the expression:
+
+ 1
+
+ Procedure `append' from module `scheme' has this type:
+
+ (&rest * -> *)
Warning: Wrong number of arguments.
(test-scrutinizer-message-format.scm:XXX)
@@ -649,32 +665,66 @@ Warning: In `m#toplevel-foo', a toplevel procedure
In `too-many-values-for-assignment', a local procedure
expected a single result in assignment to `m#foo', but received 2 results
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `append-invalid-arg', a local procedure
- (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#append', argument #1 is of type
-
- fixnum
-
- but expected a proper list.
-
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `vector-list-out-of-range', a local procedure
- In `list-ref-negative-index', a local procedure
- (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#list-ref', index -1 is negative, which is never valid
-
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `vector-list-out-of-range', a local procedure
- In `list-ref-out-of-range', a local procedure
- (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#list-ref', index 1 out of range for proper list of length 0
-
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `vector-list-out-of-range', a local procedure
- In `vector-ref-out-of-range', a local procedure
- (test-scrutinizer-message-format.scm:XXX) in procedure call to
`scheme#vector-ref', index -1 out of range for vector of length 0
+Warning: Invalid argument type.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `append-invalid-arg', a local procedure
+ In procedure call:
+
+ (scheme#append 1 (scheme#list 1))
+
+ Argument #1 to procedure `append' has invalid type:
+
+ fixnum
+
+ The expected type is:
+
+ list
+
+ This is the expression:
+
+ 1
+
+ Procedure `append' from module `scheme' has this type:
+
+ (&rest * -> *)
+
+Warning: List index negative.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `vector-list-out-of-range', a local procedure
+ In `list-ref-negative-index', a local procedure
+ In procedure call:
+
+ (scheme#list-ref '() -1)
+
+ Calling `list-ref' from module `scheme' with a negative index -1.
+
+Warning: List index out of range.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `vector-list-out-of-range', a local procedure
+ In `list-ref-out-of-range', a local procedure
+ In procedure call:
+
+ (scheme#list-ref '() 1)
+
+ Calling `list-ref' from module `scheme' with index `1' for a list of length
`0'.
+
+Warning: Vector index negative.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `vector-list-out-of-range', a local procedure
+ In `vector-ref-out-of-range', a local procedure
+ In procedure call:
+
+ (scheme#vector-ref (scheme#vector) -1)
+
+ Calling `vector-ref' from module `scheme' with a negative index -1.
Error: No typecase matches.
(test-scrutinizer-message-format.scm:XXX)
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 701abbc..0d1c9b4 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -829,14 +829,32 @@ Warning: Invalid argument type.
(list -> *)
-Warning: In `vector-ref-warn1', a toplevel procedure
- (scrutiny-tests.scm:220) in procedure call to `scheme#vector-ref', index -1
out of range for vector of length 3
+Warning: Vector index negative.
+ (scrutiny-tests.scm:220)
+ In `vector-ref-warn1', a toplevel procedure
+ In procedure call:
-Warning: In `vector-ref-warn2', a toplevel procedure
- (scrutiny-tests.scm:222) in procedure call to `scheme#vector-ref', index 3
out of range for vector of length 3
+ (scheme#vector-ref v1 -1)
-Warning: In `vector-ref-warn3', a toplevel procedure
- (scrutiny-tests.scm:223) in procedure call to `scheme#vector-ref', index 4
out of range for vector of length 3
+ Calling `vector-ref' from module `scheme' with a negative index -1.
+
+Warning: Vector index out of range.
+ (scrutiny-tests.scm:222)
+ In `vector-ref-warn2', a toplevel procedure
+ In procedure call:
+
+ (scheme#vector-ref v1 3)
+
+ Calling `vector-ref' from module `scheme' with index `3' for a vector of
length `3'.
+
+Warning: Vector index out of range.
+ (scrutiny-tests.scm:223)
+ In `vector-ref-warn3', a toplevel procedure
+ In procedure call:
+
+ (scheme#vector-ref v1 4)
+
+ Calling `vector-ref' from module `scheme' with index `4' for a vector of
length `3'.
Warning: Invalid argument type.
(scrutiny-tests.scm:226)
@@ -861,14 +879,32 @@ Warning: Invalid argument type.
((vector-of 'a384) fixnum -> 'a384)
-Warning: In `vector-set!-warn1', a toplevel procedure
- (scrutiny-tests.scm:227) in procedure call to `scheme#vector-set!', index -1
out of range for vector of length 3
+Warning: Vector index negative.
+ (scrutiny-tests.scm:227)
+ In `vector-set!-warn1', a toplevel procedure
+ In procedure call:
-Warning: In `vector-set!-warn2', a toplevel procedure
- (scrutiny-tests.scm:228) in procedure call to `scheme#vector-set!', index 3
out of range for vector of length 3
+ (scheme#vector-set! v1 -1 'whatever)
-Warning: In `vector-set!-warn3', a toplevel procedure
- (scrutiny-tests.scm:229) in procedure call to `scheme#vector-set!', index 4
out of range for vector of length 3
+ Calling `vector-set!' from module `scheme' with a negative index -1.
+
+Warning: Vector index out of range.
+ (scrutiny-tests.scm:228)
+ In `vector-set!-warn2', a toplevel procedure
+ In procedure call:
+
+ (scheme#vector-set! v1 3 'whatever)
+
+ Calling `vector-set!' from module `scheme' with index `3' for a vector of
length `3'.
+
+Warning: Vector index out of range.
+ (scrutiny-tests.scm:229)
+ In `vector-set!-warn3', a toplevel procedure
+ In procedure call:
+
+ (scheme#vector-set! v1 4 'whatever)
+
+ Calling `vector-set!' from module `scheme' with index `4' for a vector of
length `3'.
Warning: Invalid argument type.
(scrutiny-tests.scm:232)
@@ -893,20 +929,50 @@ Warning: Invalid argument type.
(vector fixnum * -> undefined)
-Warning: In `list-ref-warn1', a toplevel procedure
- (scrutiny-tests.scm:238) in procedure call to `scheme#list-ref', index -1 is
negative, which is never valid
+Warning: List index negative.
+ (scrutiny-tests.scm:238)
+ In `list-ref-warn1', a toplevel procedure
+ In procedure call:
-Warning: In `list-ref-warn2', a toplevel procedure
- (scrutiny-tests.scm:241) in procedure call to `scheme#list-ref', index -1 is
negative, which is never valid
+ (scheme#list-ref l1 -1)
-Warning: In `list-ref-warn3', a toplevel procedure
- (scrutiny-tests.scm:244) in procedure call to `scheme#list-ref', index -1 is
negative, which is never valid
+ Calling `list-ref' from module `scheme' with a negative index -1.
-Warning: In `list-ref-warn4', a toplevel procedure
- (scrutiny-tests.scm:246) in procedure call to `scheme#list-ref', index 3 out
of range for proper list of length 3
+Warning: List index negative.
+ (scrutiny-tests.scm:241)
+ In `list-ref-warn2', a toplevel procedure
+ In procedure call:
-Warning: In `list-ref-warn5', a toplevel procedure
- (scrutiny-tests.scm:252) in procedure call to `scheme#list-ref', index 4 out
of range for proper list of length 3
+ (scheme#list-ref l2 -1)
+
+ Calling `list-ref' from module `scheme' with a negative index -1.
+
+Warning: List index negative.
+ (scrutiny-tests.scm:244)
+ In `list-ref-warn3', a toplevel procedure
+ In procedure call:
+
+ (scheme#list-ref l3 -1)
+
+ Calling `list-ref' from module `scheme' with a negative index -1.
+
+Warning: List index out of range.
+ (scrutiny-tests.scm:246)
+ In `list-ref-warn4', a toplevel procedure
+ In procedure call:
+
+ (scheme#list-ref l1 3)
+
+ Calling `list-ref' from module `scheme' with index `3' for a list of length
`3'.
+
+Warning: List index out of range.
+ (scrutiny-tests.scm:252)
+ In `list-ref-warn5', a toplevel procedure
+ In procedure call:
+
+ (scheme#list-ref l1 4)
+
+ Calling `list-ref' from module `scheme' with index `4' for a list of length
`3'.
Warning: Invalid argument type.
(scrutiny-tests.scm:281)
--
2.7.4
>From 9e28d59a1681a7784e3b6e8fc666407953108a22 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Wed, 28 Nov 2018 10:48:43 +0200
Subject: [PATCH 14/17] scrutinizer.scm: Pretty print value count mismatches
for let,set!,if
* scrutinizer.scm (scrutinize): Replace old single with single2 and
call the new functions
* scrutinizer.scm (r-conditional-value-count-invalid) : New function
* scrutinizer.scm (r-let-value-count-invalid) : New function
* scrutinizer.scm (r-assignment-value-count-invalid) : New function
---
scrutinizer.scm | 105 +++++++---
tests/scrutinizer-message-format.expected | 314 +++++++++++++++++++++++-------
tests/scrutiny.expected | 18 +-
3 files changed, 338 insertions(+), 99 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index d40ef33..70348b1 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -277,25 +277,7 @@
(d "assignment to var ~a in ~a is always immediate" var loc)
#t))
- (define (single node what tv loc)
- (if (eq? '* tv)
- '*
- (let ((n (length tv)))
- (cond ((= 1 n) (car tv))
- ((zero? n)
- (report
- loc
- "~aexpected a single result ~a, but received zero results"
- (node-source-prefix node) what)
- 'undefined)
- (else
- (report
- loc
- "~aexpected a single result ~a, but received ~a result~a"
- (node-source-prefix node) what n (multiples n))
- (first tv))))))
-
- (define (single2 tv r-value-count-mismatch)
+ (define (single tv r-value-count-mismatch)
(if (eq? '* tv)
'*
(let ((n (length tv)))
@@ -465,7 +447,8 @@
(tst (first subs))
(nor-1 noreturn))
(set! noreturn #f)
- (let* ((rt (single n "in conditional" (walk tst e loc #f #f
flow tags) loc))
+ (let* ((rt (single (walk tst e loc #f #f flow tags)
+ (cut r-conditional-value-count-invalid
loc n tst <>)))
(c (second subs))
(a (third subs))
(nor0 noreturn))
@@ -518,11 +501,8 @@
(walk (car body) (append e2 e) loc dest tail flow ctags)
(let* ((var (car vars))
(val (car body))
- (t (single
- n
- (sprintf "in `let' binding of `~a'"
(real-name var))
- (walk val e loc var #f flow #f)
- loc)))
+ (t (single (walk val e loc var #f flow #f)
+ (cut r-let-value-count-invalid loc
var n val <>))))
(when (and (eq? (node-class val) '##core#variable)
(not (db-get db var 'assigned)))
(let ((var2 (first (node-parameters val))))
@@ -586,11 +566,9 @@
((set! ##core#set!)
(let* ((var (first params))
(type (variable-mark var '##compiler#type))
- (rt (single
- n
- (sprintf "in assignment to `~a'" var)
- (walk (first subs) e loc var #f flow #f)
- loc))
+ (rt (single (walk (first subs) e loc var #f flow #f)
+ (cut r-assignment-value-count-invalid
+ loc var n (first subs) <>)))
(typeenv (append
(if type (type-typeenv type) '())
(type-typeenv rt)))
@@ -663,7 +641,7 @@
(make-node
'##core#the/result
(list
- (single2
+ (single
(walk n2 e loc #f #f flow #f)
(cut r-proc-call-argument-value-count
loc n i n2 <>)))
(list n2)))
@@ -2658,6 +2636,71 @@
(sprintf "returns ~a values but 1 is expected."
(length atype)))))
+(define (r-conditional-value-count-invalid loc if-node test-node atype)
+ (define (p short long)
+ (report2 short warning (list test-node if-node)
+ loc
+ (string-append
+ "In conditional:"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "The test expression ~a"
+ "~%~%"
+ "~a")
+ (pp-fragment if-node " ")
+ long
+ (describe-expression test-node)))
+ (if (zero? (length atype))
+ (p "Zero values for conditional"
+ "returns 0 values.")
+ (p "Too many values for conditional"
+ (sprintf "returns ~a values." (length atype)))))
+
+(define (r-let-value-count-invalid loc var let-node val-node atype)
+ (define (p short long)
+ (report2 short warning (list val-node let-node)
+ loc
+ (string-append
+ "In let expression:"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Variable `~a' is bound value from expression that ~a"
+ "~%~%"
+ "~a")
+ (pp-fragment let-node " ")
+ (real-name var)
+ long
+ (describe-expression val-node)))
+ (if (zero? (length atype))
+ (p (sprintf "Let bind to `~a' with zero values" (real-name var))
+ "returns 0 values.")
+ (p (sprintf "Let bind to `~a' with ~a values" (real-name var) (length
atype))
+ (sprintf "returns ~a values." (length atype)))))
+
+(define (r-assignment-value-count-invalid loc var set-node val-node atype)
+ (define (p short long)
+ (report2 short warning (list val-node set-node)
+ loc
+ (string-append
+ "In assignment:"
+ "~%~%"
+ "~a"
+ "~%~%"
+ "Variable `~a' is assigned value from expression that ~a"
+ "~%~%"
+ "~a")
+ (pp-fragment set-node " ")
+ (strip-namespace var)
+ long
+ (describe-expression val-node)))
+ (if (zero? (length atype))
+ (p (sprintf "Assigning to `~a' with zero values" (strip-namespace var))
+ "returns 0 values.")
+ (p (sprintf "Assigning to `~a' with ~a values" (strip-namespace var)
(length atype))
+ (sprintf "returns ~a values." (length atype)))))
+
(define (r-pred-call-always-true loc node pred-type atype)
(define pname (call-node-pname node))
(report-notice
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
index 35272ba..de688f7 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -75,8 +75,22 @@ Warning: No values returned for argument.
(scheme#values)
-Warning: In `r-proc-call-argument-value-count', a toplevel procedure
- expected a single result in `let' binding of `gXXX', but received zero
results
+Warning: Let bind to `gXXX' with zero values.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `r-proc-call-argument-value-count', a toplevel procedure
+ In let expression:
+
+ (let ((gXXX (scheme#values))) (gXXX))
+
+ Variable `gXXX' is bound value from expression that returns 0 values.
+
+ The expression is a call to `values' from module `scheme' which has this
type:
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression:
+
+ (scheme#values)
Warning: Branch value count mismatch.
(test-scrutinizer-message-format.scm:XXX)
@@ -565,20 +579,62 @@ Warning: Zero values returned.
symbol
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `zero-values-for-assignment', a local procedure
- expected a single result in assignment to `m#foo', but received zero results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `zero-values-for-conditional', a local procedure
- expected a single result in conditional, but received zero results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `zero-values-for-let', a local procedure
- expected a single result in `let' binding of `a', but received zero results
+Warning: Assigning to `foo' with zero values.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `zero-values-for-assignment', a local procedure
+ In assignment:
+
+ (set! m#foo (scheme#values))
+
+ Variable `foo' is assigned value from expression that returns 0 values.
+
+ The expression is a call to `values' from module `scheme' which has this
type:
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression:
+
+ (scheme#values)
+
+Warning: Zero values for conditional.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `zero-values-for-conditional', a local procedure
+ In conditional:
+
+ (if (scheme#values) 1 (##core#undefined))
+
+ The test expression returns 0 values.
+
+ The expression is a call to `values' from module `scheme' which has this
type:
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression:
+
+ (scheme#values)
+
+Warning: Let bind to `a' with zero values.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `zero-values-for-let', a local procedure
+ In let expression:
+
+ (let ((a (scheme#values))) a)
+
+ Variable `a' is bound value from expression that returns 0 values.
+
+ The expression is a call to `values' from module `scheme' which has this
type:
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression:
+
+ (scheme#values)
Warning: Too many values returned.
(test-scrutinizer-message-format.scm:XXX)
@@ -614,56 +670,182 @@ Warning: Type mismatch.
fixnum
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `too-many-values-for-assignment', a local procedure
- expected a single result in assignment to `m#foo', but received 2 results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `too-many-values-for-conditional', a local procedure
- expected a single result in conditional, but received 2 results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `too-many-values-for-let', a local procedure
- expected a single result in `let' binding of `a', but received 2 results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-let-value-count-invalid', a local procedure
- In `zero-values-for-let', a local procedure
- expected a single result in `let' binding of `a', but received zero results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-let-value-count-invalid', a local procedure
- In `too-many-values-for-let', a local procedure
- expected a single result in `let' binding of `a', but received 2 results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-conditional-value-count-invalid', a local procedure
- In `zero-values-for-conditional', a local procedure
- expected a single result in conditional, but received zero results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-conditional-value-count-invalid', a local procedure
- In `too-many-values-for-conditional', a local procedure
- expected a single result in conditional, but received 2 results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-assignment-value-count-invalid', a local procedure
- In `zero-values-for-assignment', a local procedure
- expected a single result in assignment to `m#foo', but received zero results
-
-Warning: In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-assignment-value-count-invalid', a local procedure
- In `too-many-values-for-assignment', a local procedure
- expected a single result in assignment to `m#foo', but received 2 results
+Warning: Assigning to `foo' with 2 values.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `too-many-values-for-assignment', a local procedure
+ In assignment:
+
+ (set! m#foo (scheme#values #t 2))
+
+ Variable `foo' is assigned value from expression that returns 2 values.
+
+ The expression is a call to `values' from module `scheme' which has this
type:
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression:
+
+ (scheme#values #t 2)
+
+Warning: Too many values for conditional.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `too-many-values-for-conditional', a local procedure
+ In conditional:
+
+ (if (scheme#values (the * 1) 2) 1 (##core#undefined))
+
+ The test expression returns 2 values.
+
+ The expression is a call to `values' from module `scheme' which has this
type:
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression:
+
+ (scheme#values (the * 1) 2)
+
+Warning: Let bind to `a' with 2 values.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `too-many-values-for-let', a local procedure
+ In let expression:
+
+ (let ((a (scheme#values 1 2))) a)
+
+ Variable `a' is bound value from expression that returns 2 values.
+
+ The expression is a call to `values' from module `scheme' which has this
type:
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression:
+
+ (scheme#values 1 2)
+
+Warning: Let bind to `a' with zero values.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-let-value-count-invalid', a local procedure
+ In `zero-values-for-let', a local procedure
+ In let expression:
+
+ (let ((a (scheme#values))) a)
+
+ Variable `a' is bound value from expression that returns 0 values.
+
+ The expression is a call to `values' from module `scheme' which has this
type:
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression:
+
+ (scheme#values)
+
+Warning: Let bind to `a' with 2 values.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-let-value-count-invalid', a local procedure
+ In `too-many-values-for-let', a local procedure
+ In let expression:
+
+ (let ((a (scheme#values 1 2))) a)
+
+ Variable `a' is bound value from expression that returns 2 values.
+
+ The expression is a call to `values' from module `scheme' which has this
type:
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression:
+
+ (scheme#values 1 2)
+
+Warning: Zero values for conditional.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-conditional-value-count-invalid', a local procedure
+ In `zero-values-for-conditional', a local procedure
+ In conditional:
+
+ (if (scheme#values) 1 (##core#undefined))
+
+ The test expression returns 0 values.
+
+ The expression is a call to `values' from module `scheme' which has this
type:
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression:
+
+ (scheme#values)
+
+Warning: Too many values for conditional.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-conditional-value-count-invalid', a local procedure
+ In `too-many-values-for-conditional', a local procedure
+ In conditional:
+
+ (if (scheme#values (the * 1) 2) 1 (##core#undefined))
+
+ The test expression returns 2 values.
+
+ The expression is a call to `values' from module `scheme' which has this
type:
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression:
+
+ (scheme#values (the * 1) 2)
+
+Warning: Assigning to `foo' with zero values.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-assignment-value-count-invalid', a local procedure
+ In `zero-values-for-assignment', a local procedure
+ In assignment:
+
+ (set! m#foo (scheme#values))
+
+ Variable `foo' is assigned value from expression that returns 0 values.
+
+ The expression is a call to `values' from module `scheme' which has this
type:
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression:
+
+ (scheme#values)
+
+Warning: Assigning to `foo' with 2 values.
+ (test-scrutinizer-message-format.scm:XXX)
+ In `m#toplevel-foo', a toplevel procedure
+ In `local-bar', a local procedure
+ In `r-assignment-value-count-invalid', a local procedure
+ In `too-many-values-for-assignment', a local procedure
+ In assignment:
+
+ (set! m#foo (scheme#values #t 2))
+
+ Variable `foo' is assigned value from expression that returns 2 values.
+
+ The expression is a call to `values' from module `scheme' which has this
type:
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression:
+
+ (scheme#values #t 2)
Warning: Invalid argument type.
(test-scrutinizer-message-format.scm:XXX)
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 0d1c9b4..94eb5ae 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -187,8 +187,22 @@ Warning: Invalid assigned value type.
(procedure scheme#car ((pair 'a335 *)) 'a335)
-Warning: At toplevel:
- expected a single result in `let' binding of `gXXX', but received 2 results
+Warning: Let bind to `gXXX' with 2 values.
+ (scrutiny-tests.scm:33)
+ At toplevel:
+ In let expression:
+
+ (let ((gXXX (scheme#values 1 2))) (gXXX))
+
+ Variable `gXXX' is bound value from expression that returns 2 values.
+
+ The expression is a call to `values' from module `scheme' which has this
type:
+
+ (procedure scheme#values (&rest values) . *)
+
+ This is the expression:
+
+ (scheme#values 1 2)
Warning: Invalid procedure.
At toplevel:
--
2.7.4
>From 6cccf847b5e2cacc51073f4b992bd1aadf16bc6c Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Wed, 28 Nov 2018 10:59:46 +0200
Subject: [PATCH 15/17] scrutinizer.scm (type->pp-string): Print '(Name: foo)'
for procedures
Motivation:
We want to print procedures with the -> style as it's easier to read
than the (procedure ...) style.
This cannot directly printed with the -> style, as -> doesn't have a
place for name:
(procedure foo (a) b)
Solution: we print the name "foo" separately:
(a -> b)
(Name: foo)
Perhaps we could skip printing the name altogether as it's probably
printed somewhere else in an error message and thus only adds clutter.
---
scrutinizer.scm | 25 +++++++++++++++----------
tests/scrutinizer-message-format.expected | 4 +++-
tests/scrutiny.expected | 8 ++++++--
3 files changed, 24 insertions(+), 13 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 70348b1..70b858f 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -2344,14 +2344,7 @@
s)))
(define (type->pp-string t #!optional (proc-name? #t) (bomb? #t))
- (define (pr t)
- (string-add-indent
- (string-chomp
- (with-output-to-string
- (lambda ()
- (pp t))))
- " "))
-
+ (define pname? proc-name?)
(define (conv t #!optional (tv-replacements '()))
(define (R t) (conv t tv-replacements))
(cond
@@ -2378,7 +2371,7 @@
(if (eq? '* res)
#f
(map R res)))))
- (if (or (and proc-name? (procedure-name t))
+ (if (or (and pname? (procedure-name t))
;; '. *' return type not supported by ->
(not res))
`(procedure ,@(if (procedure-name t) (list (procedure-name t))
'())
@@ -2390,7 +2383,19 @@
,@res))))
(bomb? (bomb "type->pp-string: unhandled type" t))
(else t))))))
- (pr (conv (strip-syntax t))))
+
+ (let ((pname (procedure-name t)))
+ ;; Sign with pname? that the name has already been printed
+ (when pname (set! pname? #f))
+
+ (let ((t* (conv (strip-syntax t))))
+ (string-add-indent
+ (string-chomp
+ (with-output-to-string
+ (lambda ()
+ (pp t*)
+ (when (and proc-name? pname) (printf "~%(Name: ~a)" (real-name
pname))))))
+ " "))))
(define (fragment x)
(let ((x (build-expression-tree (source-node-tree x))))
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
index de688f7..b25cfc6 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -337,7 +337,9 @@ Warning: Invalid argument type.
Argument #1 to procedure `string-length' has invalid type:
- (procedure chicken.base#add1 (number) number)
+ (number -> number)
+
+ (Name: chicken.base#add1)
The expected type is:
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 94eb5ae..357768e 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -185,7 +185,9 @@ Warning: Invalid assigned value type.
The declared type of `car' from module `scheme' is:
- (procedure scheme#car ((pair 'a335 *)) 'a335)
+ ((pair 'a335 *) -> 'a335)
+
+ (Name: scheme#car)
Warning: Let bind to `gXXX' with 2 values.
(scrutiny-tests.scm:33)
@@ -224,7 +226,9 @@ Note: Test always true.
Test condition has always true value of type:
- (procedure bar () *)
+ (-> *)
+
+ (Name: bar)
Warning: Invalid argument type.
(scrutiny-tests.scm:58)
--
2.7.4
>From 7033af19c91f8c7c590e1edd5ae512998d7d4688 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Wed, 28 Nov 2018 13:24:50 +0200
Subject: [PATCH 16/17] scrutinizer.scm: Add "In file ...", "In module ..." to
messages
Print 'a.module.name#foo-bar-baz' as:
In file `...',
In module `a.module.name',
In procedure `foo-bar-baz' (toplevel),
* scrutinizer.scm (node-source-prefix): "In file ..."
* scrutinizer.scm (location-name): Of course bar#foo doesn't
necessarily mean function 'foo' from module 'bar, but the behaviour
should be easy to explain to a newcomer.
- Also, tweak the procedure stack output a bit
* scrutinizer.scm (variable-and-module) : extract from variable-from-module
* scrutinizer.scm (variable-from-module): use variable-and-module
---
scrutinizer.scm | 31 ++-
tests/scrutinizer-message-format.expected | 389 ++++++++++++++++--------------
tests/scrutiny-2.expected | 88 +++----
tests/scrutiny.expected | 259 ++++++++++----------
tests/specialization.expected | 32 +--
5 files changed, 425 insertions(+), 374 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index 70b858f..d22dcca 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -2420,29 +2420,44 @@
(define (node-source-prefix n)
(let ((line (node-line-number n)))
- (if (not line) "" (sprintf "(~a) " line))))
+ (if (not line) "" (sprintf "In file `~a'," line))))
(define (location-name loc #!optional (ind " "))
(define (lname loc1)
(if loc1
(real-name loc1)
"(unknown procedure)"))
- (cond ((null? loc) (sprintf "At toplevel:\n~a" ind))
+ (cond ((null? loc) (sprintf "At toplevel,\n~a" ind))
(else
(let rec ((loc loc)
(msgs (list "")))
(if (null? (cdr loc))
(string-intersperse
- (cons (sprintf "In `~a', a toplevel procedure" (lname (car
loc))) msgs)
+ (cons (if (car loc)
+ ;; If the first location is of format
+ ;; bar#foo interpret it as being procedure
+ ;; 'foo' in module 'bar'.
+ (receive (var mod) (variable-and-module (real-name
(car loc)))
+ (sprintf "~aIn procedure `~a' (toplevel),"
+ (if mod (sprintf "In module `~a',~%~a" mod
ind) "")
+ var))
+ "In unknown toplevel procedure") msgs)
(sprintf "\n~a" ind))
(rec (cdr loc)
- (cons (sprintf "In `~a', a local procedure" (lname (car
loc))) msgs)))))))
+ (cons (sprintf "In procedure `~a'," (lname (car loc)))
msgs)))))))
-(define (variable-from-module sym)
- (let ((r (string-split (symbol->string sym) "#" #t)))
+(define (variable-and-module name) ; -> (values var module-or-false)
+ (let* ((str-name (if (symbol? name) (symbol->string name) name))
+ (r (string-split str-name "#" #t)))
(if (= (length r) 2)
- (sprintf "`~a' from module `~a'" (second r) (first r))
- (sprintf "`~a'" sym))))
+ (values (string->symbol (second r)) (string->symbol (first r)))
+ (values (string->symbol str-name) #f))))
+
+(define (variable-from-module sym)
+ (receive (var mod) (variable-and-module sym)
+ (if mod
+ (sprintf "`~a' from module `~a'" var mod)
+ (sprintf "`~a'" var))))
(define (describe-expression node)
(define (p-expr n)
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
index b25cfc6..9416db8 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -6,8 +6,8 @@ Warning: literal in operator position: (1 2)
Warning: literal in operator position: (1 2)
Warning: Wrong number of arguments.
- (test-scrutinizer-message-format.scm:XXX)
- In `r-proc-call-argument-count-mismatch', a toplevel procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In procedure `r-proc-call-argument-count-mismatch' (toplevel),
In procedure call:
(scheme#cons '())
@@ -19,8 +19,8 @@ Warning: Wrong number of arguments.
('aXXX 'bXXX --> (pair 'aXXX 'bXXX))
Warning: Invalid argument type.
- (test-scrutinizer-message-format.scm:XXX)
- In `r-proc-call-argument-type-mismatch', a toplevel procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In procedure `r-proc-call-argument-type-mismatch' (toplevel),
In procedure call:
(scheme#length 'symbol)
@@ -42,8 +42,8 @@ Warning: Invalid argument type.
(list -> fixnum)
Warning: Too many argument values.
- (test-scrutinizer-message-format.scm:XXX)
- In `r-proc-call-argument-value-count', a toplevel procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In procedure `r-proc-call-argument-value-count' (toplevel),
In procedure call:
(scheme#list (chicken.time#cpu-time))
@@ -59,8 +59,8 @@ Warning: Too many argument values.
(chicken.time#cpu-time)
Warning: No values returned for argument.
- (test-scrutinizer-message-format.scm:XXX)
- In `r-proc-call-argument-value-count', a toplevel procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In procedure `r-proc-call-argument-value-count' (toplevel),
In procedure call:
(scheme#vector (scheme#values))
@@ -76,8 +76,8 @@ Warning: No values returned for argument.
(scheme#values)
Warning: Let bind to `gXXX' with zero values.
- (test-scrutinizer-message-format.scm:XXX)
- In `r-proc-call-argument-value-count', a toplevel procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In procedure `r-proc-call-argument-value-count' (toplevel),
In let expression:
(let ((gXXX (scheme#values))) (gXXX))
@@ -93,8 +93,8 @@ Warning: Let bind to `gXXX' with zero values.
(scheme#values)
Warning: Branch value count mismatch.
- (test-scrutinizer-message-format.scm:XXX)
- In `r-cond-branch-value-count-mismatch', a toplevel procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In procedure `r-cond-branch-value-count-mismatch' (toplevel),
In conditional expression:
(if (the * 1) 1 (chicken.time#cpu-time))
@@ -110,7 +110,7 @@ Warning: Branch value count mismatch.
(chicken.time#cpu-time)
Warning: Invalid procedure.
- In `r-invalid-called-procedure-type', a toplevel procedure
+ In procedure `r-invalid-called-procedure-type' (toplevel),
In procedure call:
(1 2)
@@ -130,8 +130,8 @@ Warning: Invalid procedure.
1
Note: Predicate always true.
- (test-scrutinizer-message-format.scm:XXX)
- In `r-pred-call-always-true', a toplevel procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In procedure `r-pred-call-always-true' (toplevel),
In predicate call:
(scheme#list? '())
@@ -147,8 +147,8 @@ Note: Predicate always true.
null
Note: Predicate always false.
- (test-scrutinizer-message-format.scm:XXX)
- In `r-pred-call-always-false', a toplevel procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In procedure `r-pred-call-always-false' (toplevel),
In predicate call:
(scheme#symbol? 1)
@@ -164,7 +164,7 @@ Note: Predicate always false.
fixnum
Note: Test always true.
- In `r-cond-test-always-true', a toplevel procedure
+ In procedure `r-cond-test-always-true' (toplevel),
In conditional expression:
(if 'symbol 1 (##core#undefined))
@@ -174,7 +174,7 @@ Note: Test always true.
symbol
Note: Test always false.
- In `r-cond-test-always-false', a toplevel procedure
+ In procedure `r-cond-test-always-false' (toplevel),
In conditional expression:
(if #f 1 (##core#undefined))
@@ -182,7 +182,7 @@ Note: Test always false.
Test condition is always false.
Warning: Type mismatch.
- In `r-type-mismatch-in-the', a toplevel procedure
+ In procedure `r-type-mismatch-in-the' (toplevel),
In expression:
1
@@ -198,8 +198,8 @@ Warning: Type mismatch.
fixnum
Warning: Zero values returned.
- (test-scrutinizer-message-format.scm:XXX)
- In `r-zero-values-for-the', a toplevel procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In procedure `r-zero-values-for-the' (toplevel),
In expression:
(scheme#values)
@@ -209,8 +209,8 @@ Warning: Zero values returned.
symbol
Warning: Too many values returned.
- (test-scrutinizer-message-format.scm:XXX)
- In `r-too-many-values-for-the', a toplevel procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In procedure `r-too-many-values-for-the' (toplevel),
In expression:
(scheme#values 1 2)
@@ -222,8 +222,8 @@ Warning: Too many values returned.
symbol
Warning: Type mismatch.
- (test-scrutinizer-message-format.scm:XXX)
- In `r-too-many-values-for-the', a toplevel procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In procedure `r-too-many-values-for-the' (toplevel),
In expression:
(scheme#values 1 2)
@@ -239,7 +239,7 @@ Warning: Type mismatch.
fixnum
Warning: Invalid assigned value type.
- In `r-toplevel-var-assignment-type-mismatch', a toplevel procedure
+ In procedure `r-toplevel-var-assignment-type-mismatch' (toplevel),
In assignment:
(set! foo 1)
@@ -255,7 +255,7 @@ Warning: Invalid assigned value type.
boolean
Warning: Deprecated identifier `deprecated-foo'.
- In `r-deprecated-identifier', a toplevel procedure
+ In procedure `r-deprecated-identifier' (toplevel),
In expression:
deprecated-foo
@@ -263,7 +263,7 @@ Warning: Deprecated identifier `deprecated-foo'.
Use of deprecated `deprecated-foo'.
Warning: Deprecated identifier `deprecated-foo2'.
- In `r-deprecated-identifier', a toplevel procedure
+ In procedure `r-deprecated-identifier' (toplevel),
In expression:
deprecated-foo2
@@ -273,7 +273,7 @@ Warning: Deprecated identifier `deprecated-foo2'.
The suggested replacement is `foo'.
Warning: Invalid assigned value type.
- At toplevel:
+ At toplevel,
In assignment:
(set! foo 1)
@@ -289,8 +289,8 @@ Warning: Invalid assigned value type.
boolean
Warning: Invalid argument type.
- (test-scrutinizer-message-format.scm:XXX)
- In `append-invalid-arg', a toplevel procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In procedure `append-invalid-arg' (toplevel),
In procedure call:
(scheme#append 1 (scheme#list 1))
@@ -312,10 +312,11 @@ Warning: Invalid argument type.
(&rest * -> *)
Warning: Wrong number of arguments.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-proc-call-argument-count-mismatch', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-proc-call-argument-count-mismatch',
In procedure call:
(scheme#cons '())
@@ -327,10 +328,11 @@ Warning: Wrong number of arguments.
('aXXX 'bXXX --> (pair 'aXXX 'bXXX))
Warning: Invalid argument type.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-proc-call-argument-type-mismatch', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-proc-call-argument-type-mismatch',
In procedure call:
(scheme#string-length chicken.base#add1)
@@ -354,10 +356,11 @@ Warning: Invalid argument type.
(string -> fixnum)
Warning: Too many argument values.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-proc-call-argument-value-count', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-proc-call-argument-value-count',
In procedure call:
(scheme#list (chicken.time#cpu-time))
@@ -373,10 +376,11 @@ Warning: Too many argument values.
(chicken.time#cpu-time)
Warning: No values returned for argument.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-proc-call-argument-value-count', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-proc-call-argument-value-count',
In procedure call:
(scheme#vector (scheme#values))
@@ -392,10 +396,11 @@ Warning: No values returned for argument.
(scheme#values)
Warning: Branch value count mismatch.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-cond-branch-value-count-mismatch', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-cond-branch-value-count-mismatch',
In conditional expression:
(if (the * 1) 1 (chicken.time#cpu-time))
@@ -411,11 +416,12 @@ Warning: Branch value count mismatch.
(chicken.time#cpu-time)
Warning: Invalid procedure.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-invalid-called-procedure-type', a local procedure
- In `variable', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-invalid-called-procedure-type',
+ In procedure `variable',
In procedure call:
(m#foo2 2)
@@ -427,10 +433,11 @@ Warning: Invalid procedure.
boolean
Warning: Invalid procedure.
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-invalid-called-procedure-type', a local procedure
- In `non-variable', a local procedure
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-invalid-called-procedure-type',
+ In procedure `non-variable',
In procedure call:
(1 2)
@@ -450,10 +457,11 @@ Warning: Invalid procedure.
1
Note: Predicate always true.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-pred-call-always-true', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-pred-call-always-true',
In predicate call:
(scheme#list? '())
@@ -469,10 +477,11 @@ Note: Predicate always true.
null
Note: Predicate always false.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-pred-call-always-false', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-pred-call-always-false',
In predicate call:
(scheme#symbol? 1)
@@ -488,10 +497,11 @@ Note: Predicate always false.
fixnum
Note: Test always true.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-cond-test-always-true', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-cond-test-always-true',
In conditional expression:
(if (scheme#length '()) 1 (##core#undefined))
@@ -501,9 +511,10 @@ Note: Test always true.
fixnum
Note: Test always false.
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-cond-test-always-false', a local procedure
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-cond-test-always-false',
In conditional expression:
(if #f 1 (##core#undefined))
@@ -511,9 +522,10 @@ Note: Test always false.
Test condition is always false.
Warning: Type mismatch.
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-type-mismatch-in-the', a local procedure
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-type-mismatch-in-the',
In expression:
1
@@ -529,9 +541,10 @@ Warning: Type mismatch.
fixnum
Warning: Invalid assigned value type.
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-toplevel-var-assignment-type-mismatch', a local procedure
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-toplevel-var-assignment-type-mismatch',
In assignment:
(set! m#foo2 1)
@@ -547,9 +560,10 @@ Warning: Invalid assigned value type.
boolean
Warning: Deprecated identifier `deprecated-foo'.
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-deprecated-identifier', a local procedure
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-deprecated-identifier',
In expression:
m#deprecated-foo
@@ -557,9 +571,10 @@ Warning: Deprecated identifier `deprecated-foo'.
Use of deprecated `deprecated-foo' from module `m'.
Warning: Deprecated identifier `deprecated-foo2'.
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-deprecated-identifier', a local procedure
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-deprecated-identifier',
In expression:
m#deprecated-foo2
@@ -569,10 +584,11 @@ Warning: Deprecated identifier `deprecated-foo2'.
The suggested replacement is `foo'.
Warning: Zero values returned.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-zero-values-for-the', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-zero-values-for-the',
In expression:
(scheme#values)
@@ -582,10 +598,11 @@ Warning: Zero values returned.
symbol
Warning: Assigning to `foo' with zero values.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `zero-values-for-assignment', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `zero-values-for-assignment',
In assignment:
(set! m#foo (scheme#values))
@@ -601,10 +618,11 @@ Warning: Assigning to `foo' with zero values.
(scheme#values)
Warning: Zero values for conditional.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `zero-values-for-conditional', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `zero-values-for-conditional',
In conditional:
(if (scheme#values) 1 (##core#undefined))
@@ -620,10 +638,11 @@ Warning: Zero values for conditional.
(scheme#values)
Warning: Let bind to `a' with zero values.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `zero-values-for-let', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `zero-values-for-let',
In let expression:
(let ((a (scheme#values))) a)
@@ -639,10 +658,11 @@ Warning: Let bind to `a' with zero values.
(scheme#values)
Warning: Too many values returned.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-too-many-values-for-the', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-too-many-values-for-the',
In expression:
(scheme#values 1 2)
@@ -654,10 +674,11 @@ Warning: Too many values returned.
symbol
Warning: Type mismatch.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-too-many-values-for-the', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-too-many-values-for-the',
In expression:
(scheme#values 1 2)
@@ -673,10 +694,11 @@ Warning: Type mismatch.
fixnum
Warning: Assigning to `foo' with 2 values.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `too-many-values-for-assignment', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `too-many-values-for-assignment',
In assignment:
(set! m#foo (scheme#values #t 2))
@@ -692,10 +714,11 @@ Warning: Assigning to `foo' with 2 values.
(scheme#values #t 2)
Warning: Too many values for conditional.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `too-many-values-for-conditional', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `too-many-values-for-conditional',
In conditional:
(if (scheme#values (the * 1) 2) 1 (##core#undefined))
@@ -711,10 +734,11 @@ Warning: Too many values for conditional.
(scheme#values (the * 1) 2)
Warning: Let bind to `a' with 2 values.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `too-many-values-for-let', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `too-many-values-for-let',
In let expression:
(let ((a (scheme#values 1 2))) a)
@@ -730,11 +754,12 @@ Warning: Let bind to `a' with 2 values.
(scheme#values 1 2)
Warning: Let bind to `a' with zero values.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-let-value-count-invalid', a local procedure
- In `zero-values-for-let', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-let-value-count-invalid',
+ In procedure `zero-values-for-let',
In let expression:
(let ((a (scheme#values))) a)
@@ -750,11 +775,12 @@ Warning: Let bind to `a' with zero values.
(scheme#values)
Warning: Let bind to `a' with 2 values.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-let-value-count-invalid', a local procedure
- In `too-many-values-for-let', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-let-value-count-invalid',
+ In procedure `too-many-values-for-let',
In let expression:
(let ((a (scheme#values 1 2))) a)
@@ -770,11 +796,12 @@ Warning: Let bind to `a' with 2 values.
(scheme#values 1 2)
Warning: Zero values for conditional.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-conditional-value-count-invalid', a local procedure
- In `zero-values-for-conditional', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-conditional-value-count-invalid',
+ In procedure `zero-values-for-conditional',
In conditional:
(if (scheme#values) 1 (##core#undefined))
@@ -790,11 +817,12 @@ Warning: Zero values for conditional.
(scheme#values)
Warning: Too many values for conditional.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-conditional-value-count-invalid', a local procedure
- In `too-many-values-for-conditional', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-conditional-value-count-invalid',
+ In procedure `too-many-values-for-conditional',
In conditional:
(if (scheme#values (the * 1) 2) 1 (##core#undefined))
@@ -810,11 +838,12 @@ Warning: Too many values for conditional.
(scheme#values (the * 1) 2)
Warning: Assigning to `foo' with zero values.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-assignment-value-count-invalid', a local procedure
- In `zero-values-for-assignment', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-assignment-value-count-invalid',
+ In procedure `zero-values-for-assignment',
In assignment:
(set! m#foo (scheme#values))
@@ -830,11 +859,12 @@ Warning: Assigning to `foo' with zero values.
(scheme#values)
Warning: Assigning to `foo' with 2 values.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `r-assignment-value-count-invalid', a local procedure
- In `too-many-values-for-assignment', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `r-assignment-value-count-invalid',
+ In procedure `too-many-values-for-assignment',
In assignment:
(set! m#foo (scheme#values #t 2))
@@ -850,10 +880,11 @@ Warning: Assigning to `foo' with 2 values.
(scheme#values #t 2)
Warning: Invalid argument type.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `append-invalid-arg', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `append-invalid-arg',
In procedure call:
(scheme#append 1 (scheme#list 1))
@@ -875,11 +906,12 @@ Warning: Invalid argument type.
(&rest * -> *)
Warning: List index negative.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `vector-list-out-of-range', a local procedure
- In `list-ref-negative-index', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `vector-list-out-of-range',
+ In procedure `list-ref-negative-index',
In procedure call:
(scheme#list-ref '() -1)
@@ -887,11 +919,12 @@ Warning: List index negative.
Calling `list-ref' from module `scheme' with a negative index -1.
Warning: List index out of range.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `vector-list-out-of-range', a local procedure
- In `list-ref-out-of-range', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `vector-list-out-of-range',
+ In procedure `list-ref-out-of-range',
In procedure call:
(scheme#list-ref '() 1)
@@ -899,11 +932,12 @@ Warning: List index out of range.
Calling `list-ref' from module `scheme' with index `1' for a list of length
`0'.
Warning: Vector index negative.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `vector-list-out-of-range', a local procedure
- In `vector-ref-out-of-range', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `vector-list-out-of-range',
+ In procedure `vector-ref-out-of-range',
In procedure call:
(scheme#vector-ref (scheme#vector) -1)
@@ -911,10 +945,11 @@ Warning: Vector index negative.
Calling `vector-ref' from module `scheme' with a negative index -1.
Error: No typecase matches.
- (test-scrutinizer-message-format.scm:XXX)
- In `m#toplevel-foo', a toplevel procedure
- In `local-bar', a local procedure
- In `fail-compiler-typecase', a local procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo' (toplevel),
+ In procedure `local-bar',
+ In procedure `fail-compiler-typecase',
In `compiler-typecase' expression:
(compiler-typecase gXXX (symbol 1) (list 2) (else (##core#undefined)))
diff --git a/tests/scrutiny-2.expected b/tests/scrutiny-2.expected
index b56f1d6..bbd3b6e 100644
--- a/tests/scrutiny-2.expected
+++ b/tests/scrutiny-2.expected
@@ -2,8 +2,8 @@
;; prefixes: (tmp g)
Note: Predicate always true.
- (scrutiny-tests-2.scm:20)
- At toplevel:
+ In file `scrutiny-tests-2.scm:20',
+ At toplevel,
In predicate call:
(scheme#pair? p)
@@ -19,8 +19,8 @@ Note: Predicate always true.
pair
Note: Predicate always false.
- (scrutiny-tests-2.scm:20)
- At toplevel:
+ In file `scrutiny-tests-2.scm:20',
+ At toplevel,
In predicate call:
(scheme#pair? l)
@@ -36,8 +36,8 @@ Note: Predicate always false.
null
Note: Predicate always false.
- (scrutiny-tests-2.scm:20)
- At toplevel:
+ In file `scrutiny-tests-2.scm:20',
+ At toplevel,
In predicate call:
(scheme#pair? n)
@@ -53,8 +53,8 @@ Note: Predicate always false.
null
Note: Predicate always false.
- (scrutiny-tests-2.scm:20)
- At toplevel:
+ In file `scrutiny-tests-2.scm:20',
+ At toplevel,
In predicate call:
(scheme#pair? i)
@@ -70,8 +70,8 @@ Note: Predicate always false.
fixnum
Note: Predicate always false.
- (scrutiny-tests-2.scm:20)
- At toplevel:
+ In file `scrutiny-tests-2.scm:20',
+ At toplevel,
In predicate call:
(scheme#pair? f)
@@ -87,8 +87,8 @@ Note: Predicate always false.
float
Note: Predicate always true.
- (scrutiny-tests-2.scm:21)
- At toplevel:
+ In file `scrutiny-tests-2.scm:21',
+ At toplevel,
In predicate call:
(scheme#list? l)
@@ -104,8 +104,8 @@ Note: Predicate always true.
null
Note: Predicate always true.
- (scrutiny-tests-2.scm:21)
- At toplevel:
+ In file `scrutiny-tests-2.scm:21',
+ At toplevel,
In predicate call:
(scheme#list? n)
@@ -121,8 +121,8 @@ Note: Predicate always true.
null
Note: Predicate always false.
- (scrutiny-tests-2.scm:21)
- At toplevel:
+ In file `scrutiny-tests-2.scm:21',
+ At toplevel,
In predicate call:
(scheme#list? i)
@@ -138,8 +138,8 @@ Note: Predicate always false.
fixnum
Note: Predicate always false.
- (scrutiny-tests-2.scm:21)
- At toplevel:
+ In file `scrutiny-tests-2.scm:21',
+ At toplevel,
In predicate call:
(scheme#list? f)
@@ -155,8 +155,8 @@ Note: Predicate always false.
float
Note: Predicate always true.
- (scrutiny-tests-2.scm:22)
- At toplevel:
+ In file `scrutiny-tests-2.scm:22',
+ At toplevel,
In predicate call:
(scheme#null? n)
@@ -172,8 +172,8 @@ Note: Predicate always true.
null
Note: Predicate always true.
- (scrutiny-tests-2.scm:22)
- At toplevel:
+ In file `scrutiny-tests-2.scm:22',
+ At toplevel,
In predicate call:
(scheme#null? l)
@@ -189,8 +189,8 @@ Note: Predicate always true.
null
Note: Predicate always false.
- (scrutiny-tests-2.scm:22)
- At toplevel:
+ In file `scrutiny-tests-2.scm:22',
+ At toplevel,
In predicate call:
(scheme#null? p)
@@ -206,8 +206,8 @@ Note: Predicate always false.
pair
Note: Predicate always false.
- (scrutiny-tests-2.scm:22)
- At toplevel:
+ In file `scrutiny-tests-2.scm:22',
+ At toplevel,
In predicate call:
(scheme#null? i)
@@ -223,8 +223,8 @@ Note: Predicate always false.
fixnum
Note: Predicate always false.
- (scrutiny-tests-2.scm:22)
- At toplevel:
+ In file `scrutiny-tests-2.scm:22',
+ At toplevel,
In predicate call:
(scheme#null? f)
@@ -240,8 +240,8 @@ Note: Predicate always false.
float
Note: Predicate always true.
- (scrutiny-tests-2.scm:23)
- At toplevel:
+ In file `scrutiny-tests-2.scm:23',
+ At toplevel,
In predicate call:
(chicken.base#fixnum? i)
@@ -257,8 +257,8 @@ Note: Predicate always true.
fixnum
Note: Predicate always false.
- (scrutiny-tests-2.scm:23)
- At toplevel:
+ In file `scrutiny-tests-2.scm:23',
+ At toplevel,
In predicate call:
(chicken.base#fixnum? f)
@@ -274,8 +274,8 @@ Note: Predicate always false.
float
Note: Predicate always true.
- (scrutiny-tests-2.scm:25)
- At toplevel:
+ In file `scrutiny-tests-2.scm:25',
+ At toplevel,
In predicate call:
(chicken.base#flonum? f)
@@ -291,8 +291,8 @@ Note: Predicate always true.
float
Note: Predicate always false.
- (scrutiny-tests-2.scm:25)
- At toplevel:
+ In file `scrutiny-tests-2.scm:25',
+ At toplevel,
In predicate call:
(chicken.base#flonum? i)
@@ -308,8 +308,8 @@ Note: Predicate always false.
fixnum
Note: Predicate always true.
- (scrutiny-tests-2.scm:27)
- At toplevel:
+ In file `scrutiny-tests-2.scm:27',
+ At toplevel,
In predicate call:
(scheme#number? i)
@@ -325,8 +325,8 @@ Note: Predicate always true.
fixnum
Note: Predicate always true.
- (scrutiny-tests-2.scm:27)
- At toplevel:
+ In file `scrutiny-tests-2.scm:27',
+ At toplevel,
In predicate call:
(scheme#number? f)
@@ -342,8 +342,8 @@ Note: Predicate always true.
float
Note: Predicate always true.
- (scrutiny-tests-2.scm:27)
- At toplevel:
+ In file `scrutiny-tests-2.scm:27',
+ At toplevel,
In predicate call:
(scheme#number? u)
@@ -359,8 +359,8 @@ Note: Predicate always true.
number
Note: Predicate always false.
- (scrutiny-tests-2.scm:27)
- At toplevel:
+ In file `scrutiny-tests-2.scm:27',
+ At toplevel,
In predicate call:
(scheme#number? n)
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 357768e..20559b7 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -4,9 +4,9 @@
Warning: (scrutiny-tests.scm:31) - assignment to imported value binding `car'
Note: Test always true.
- In `a', a toplevel procedure
- In `b', a local procedure
- In `c', a local procedure
+ In procedure `a' (toplevel),
+ In procedure `b',
+ In procedure `c',
In conditional expression:
(if x 1 2)
@@ -16,7 +16,7 @@ Note: Test always true.
number
Note: Test always true.
- In `b', a toplevel procedure
+ In procedure `b' (toplevel),
In conditional expression:
(if x 1 2)
@@ -26,8 +26,8 @@ Note: Test always true.
true
Warning: Branch value count mismatch.
- (scrutiny-tests.scm:16)
- In `foo', a toplevel procedure
+ In file `scrutiny-tests.scm:16',
+ In procedure `foo' (toplevel),
In conditional expression:
(if x (scheme#values 1 2) (scheme#values 1 2 (scheme#+ (scheme#+ ...))))
@@ -43,8 +43,8 @@ Warning: Branch value count mismatch.
(scheme#values 1 2 (scheme#+ (scheme#+ (scheme#+ ...))))
Warning: Invalid argument type.
- (scrutiny-tests.scm:19)
- At toplevel:
+ In file `scrutiny-tests.scm:19',
+ At toplevel,
In procedure call:
(bar 3 'a)
@@ -66,8 +66,8 @@ Warning: Invalid argument type.
(&rest number -> number)
Warning: Wrong number of arguments.
- (scrutiny-tests.scm:21)
- At toplevel:
+ In file `scrutiny-tests.scm:21',
+ At toplevel,
In procedure call:
(scheme#string?)
@@ -79,8 +79,8 @@ Warning: Wrong number of arguments.
(* -> boolean)
Warning: Too many argument values.
- (scrutiny-tests.scm:23)
- At toplevel:
+ In file `scrutiny-tests.scm:23',
+ At toplevel,
In procedure call:
(chicken.base#print (scheme#values 1 2))
@@ -96,8 +96,8 @@ Warning: Too many argument values.
(scheme#values 1 2)
Warning: No values returned for argument.
- (scrutiny-tests.scm:24)
- At toplevel:
+ In file `scrutiny-tests.scm:24',
+ At toplevel,
In procedure call:
(chicken.base#print (scheme#values))
@@ -113,8 +113,8 @@ Warning: No values returned for argument.
(scheme#values)
Warning: Invalid procedure.
- (scrutiny-tests.scm:27)
- At toplevel:
+ In file `scrutiny-tests.scm:27',
+ At toplevel,
In procedure call:
(x)
@@ -126,8 +126,8 @@ Warning: Invalid procedure.
fixnum
Warning: Invalid argument type.
- (scrutiny-tests.scm:29)
- At toplevel:
+ In file `scrutiny-tests.scm:29',
+ At toplevel,
In procedure call:
(scheme#+ 'a 'b)
@@ -149,8 +149,8 @@ Warning: Invalid argument type.
(&rest number -> number)
Warning: Invalid argument type.
- (scrutiny-tests.scm:29)
- At toplevel:
+ In file `scrutiny-tests.scm:29',
+ At toplevel,
In procedure call:
(scheme#+ 'a 'b)
@@ -172,7 +172,7 @@ Warning: Invalid argument type.
(&rest number -> number)
Warning: Invalid assigned value type.
- At toplevel:
+ At toplevel,
In assignment:
(set! scheme#car 33)
@@ -190,8 +190,8 @@ Warning: Invalid assigned value type.
(Name: scheme#car)
Warning: Let bind to `gXXX' with 2 values.
- (scrutiny-tests.scm:33)
- At toplevel:
+ In file `scrutiny-tests.scm:33',
+ At toplevel,
In let expression:
(let ((gXXX (scheme#values 1 2))) (gXXX))
@@ -207,7 +207,7 @@ Warning: Let bind to `gXXX' with 2 values.
(scheme#values 1 2)
Warning: Invalid procedure.
- At toplevel:
+ At toplevel,
In procedure call:
(gXXX)
@@ -219,7 +219,7 @@ Warning: Invalid procedure.
fixnum
Note: Test always true.
- In `foo', a toplevel procedure
+ In procedure `foo' (toplevel),
In conditional expression:
(if bar 3 (##core#undefined))
@@ -231,8 +231,8 @@ Note: Test always true.
(Name: bar)
Warning: Invalid argument type.
- (scrutiny-tests.scm:58)
- In `foo2', a toplevel procedure
+ In file `scrutiny-tests.scm:58',
+ In procedure `foo2' (toplevel),
In procedure call:
(scheme#string-append x "abc")
@@ -254,8 +254,8 @@ Warning: Invalid argument type.
(&rest string -> string)
Warning: Invalid argument type.
- (scrutiny-tests.scm:66)
- At toplevel:
+ In file `scrutiny-tests.scm:66',
+ At toplevel,
In procedure call:
(foo3 99)
@@ -277,8 +277,8 @@ Warning: Invalid argument type.
(string -> string)
Warning: Invalid argument type.
- (scrutiny-tests.scm:71)
- In `foo4', a toplevel procedure
+ In file `scrutiny-tests.scm:71',
+ In procedure `foo4' (toplevel),
In procedure call:
(scheme#+ x 1)
@@ -300,8 +300,8 @@ Warning: Invalid argument type.
(&rest number -> number)
Warning: Invalid argument type.
- (scrutiny-tests.scm:77)
- In `foo5', a toplevel procedure
+ In file `scrutiny-tests.scm:77',
+ In procedure `foo5' (toplevel),
In procedure call:
(scheme#+ x 3)
@@ -323,8 +323,8 @@ Warning: Invalid argument type.
(&rest number -> number)
Warning: Invalid argument type.
- (scrutiny-tests.scm:83)
- In `foo6', a toplevel procedure
+ In file `scrutiny-tests.scm:83',
+ In procedure `foo6' (toplevel),
In procedure call:
(scheme#+ x 3)
@@ -346,8 +346,8 @@ Warning: Invalid argument type.
(&rest number -> number)
Warning: Invalid argument type.
- (scrutiny-tests.scm:90)
- At toplevel:
+ In file `scrutiny-tests.scm:90',
+ At toplevel,
In procedure call:
(scheme#+ x 1)
@@ -369,8 +369,8 @@ Warning: Invalid argument type.
(&rest number -> number)
Warning: Invalid argument type.
- (scrutiny-tests.scm:104)
- In `foo10', a toplevel procedure
+ In file `scrutiny-tests.scm:104',
+ In procedure `foo10' (toplevel),
In procedure call:
(foo9 x)
@@ -392,8 +392,8 @@ Warning: Invalid argument type.
(string -> symbol)
Warning: Invalid argument type.
- (scrutiny-tests.scm:105)
- In `foo10', a toplevel procedure
+ In file `scrutiny-tests.scm:105',
+ In procedure `foo10' (toplevel),
In procedure call:
(scheme#+ x 1)
@@ -415,8 +415,8 @@ Warning: Invalid argument type.
(&rest number -> number)
Warning: Type mismatch.
- (scrutiny-tests.scm:109)
- In `foo10', a toplevel procedure
+ In file `scrutiny-tests.scm:109',
+ In procedure `foo10' (toplevel),
In expression:
(scheme#substring x 0 10)
@@ -432,8 +432,8 @@ Warning: Type mismatch.
string
Warning: Invalid argument type.
- (scrutiny-tests.scm:109)
- In `foo10', a toplevel procedure
+ In file `scrutiny-tests.scm:109',
+ In procedure `foo10' (toplevel),
In procedure call:
(scheme#string-append (the pair (scheme#substring x 0 10)))
@@ -455,8 +455,8 @@ Warning: Invalid argument type.
(&rest string -> string)
Warning: Too many values returned.
- (scrutiny-tests.scm:110)
- In `foo10', a toplevel procedure
+ In file `scrutiny-tests.scm:110',
+ In procedure `foo10' (toplevel),
In expression:
(scheme#values 1 2)
@@ -468,8 +468,8 @@ Warning: Too many values returned.
*
Warning: Zero values returned.
- (scrutiny-tests.scm:111)
- In `foo10', a toplevel procedure
+ In file `scrutiny-tests.scm:111',
+ In procedure `foo10' (toplevel),
In expression:
(scheme#values)
@@ -479,8 +479,8 @@ Warning: Zero values returned.
*
Warning: Invalid argument type.
- (scrutiny-tests.scm:112)
- In `foo10', a toplevel procedure
+ In file `scrutiny-tests.scm:112',
+ In procedure `foo10' (toplevel),
In procedure call:
(scheme#* x y)
@@ -502,8 +502,9 @@ Warning: Invalid argument type.
(&rest number -> number)
Warning: Invalid argument type.
- (scrutiny-tests.scm:137)
- In `foo#blabla', a toplevel procedure
+ In file `scrutiny-tests.scm:137',
+ In module `foo',
+ In procedure `blabla' (toplevel),
In procedure call:
(scheme#+ 1 'x)
@@ -525,7 +526,7 @@ Warning: Invalid argument type.
(&rest number -> number)
Warning: Deprecated identifier `deprecated-procedure'.
- At toplevel:
+ At toplevel,
In expression:
deprecated-procedure
@@ -533,7 +534,7 @@ Warning: Deprecated identifier `deprecated-procedure'.
Use of deprecated `deprecated-procedure'.
Warning: Deprecated identifier `another-deprecated-procedure'.
- At toplevel:
+ At toplevel,
In expression:
another-deprecated-procedure
@@ -543,8 +544,8 @@ Warning: Deprecated identifier
`another-deprecated-procedure'.
The suggested replacement is `replacement-procedure'.
Warning: Invalid argument type.
- (scrutiny-tests.scm:168)
- At toplevel:
+ In file `scrutiny-tests.scm:168',
+ At toplevel,
In procedure call:
(apply1 scheme#+ (scheme#list 'a 2 3))
@@ -570,8 +571,8 @@ Warning: Invalid argument type.
((&rest 'a143 -> 'b144) (list-of 'a143) -> 'b144)
Warning: Invalid argument type.
- (scrutiny-tests.scm:169)
- At toplevel:
+ In file `scrutiny-tests.scm:169',
+ At toplevel,
In procedure call:
(apply1 scheme#+ (scheme#cons 'a (scheme#cons 2 (scheme#cons 3 ...))))
@@ -597,8 +598,8 @@ Warning: Invalid argument type.
((&rest 'a143 -> 'b144) (list-of 'a143) -> 'b144)
Note: Predicate always true.
- (scrutiny-tests.scm:182)
- At toplevel:
+ In file `scrutiny-tests.scm:182',
+ At toplevel,
In predicate call:
(chicken.base#fixnum? x)
@@ -614,8 +615,8 @@ Note: Predicate always true.
fixnum
Note: Predicate always false.
- (scrutiny-tests.scm:190)
- At toplevel:
+ In file `scrutiny-tests.scm:190',
+ At toplevel,
In predicate call:
(scheme#symbol? x)
@@ -631,8 +632,8 @@ Note: Predicate always false.
(or char string)
Note: Predicate always false.
- (scrutiny-tests.scm:191)
- At toplevel:
+ In file `scrutiny-tests.scm:191',
+ At toplevel,
In predicate call:
(scheme#string? x)
@@ -648,8 +649,8 @@ Note: Predicate always false.
(not (or char string))
Note: Predicate always false.
- (scrutiny-tests.scm:194)
- At toplevel:
+ In file `scrutiny-tests.scm:194',
+ At toplevel,
In predicate call:
(char-or-string? x)
@@ -665,8 +666,8 @@ Note: Predicate always false.
fixnum
Note: Predicate always false.
- (scrutiny-tests.scm:195)
- At toplevel:
+ In file `scrutiny-tests.scm:195',
+ At toplevel,
In predicate call:
(scheme#symbol? x)
@@ -682,8 +683,8 @@ Note: Predicate always false.
(or char string)
Note: Predicate always false.
- (scrutiny-tests.scm:196)
- At toplevel:
+ In file `scrutiny-tests.scm:196',
+ At toplevel,
In predicate call:
(scheme#string? x)
@@ -699,8 +700,8 @@ Note: Predicate always false.
fixnum
Note: Predicate always false.
- (scrutiny-tests.scm:200)
- At toplevel:
+ In file `scrutiny-tests.scm:200',
+ At toplevel,
In predicate call:
(scheme#symbol? x)
@@ -716,8 +717,8 @@ Note: Predicate always false.
char
Note: Predicate always false.
- (scrutiny-tests.scm:201)
- At toplevel:
+ In file `scrutiny-tests.scm:201',
+ At toplevel,
In predicate call:
(scheme#string? x)
@@ -733,8 +734,8 @@ Note: Predicate always false.
symbol
Note: Predicate always false.
- (scrutiny-tests.scm:205)
- At toplevel:
+ In file `scrutiny-tests.scm:205',
+ At toplevel,
In predicate call:
(scheme#symbol? x)
@@ -750,8 +751,8 @@ Note: Predicate always false.
(or char string)
Note: Predicate always false.
- (scrutiny-tests.scm:206)
- At toplevel:
+ In file `scrutiny-tests.scm:206',
+ At toplevel,
In predicate call:
(scheme#string? x)
@@ -767,8 +768,8 @@ Note: Predicate always false.
symbol
Warning: Invalid argument type.
- (scrutiny-tests.scm:210)
- At toplevel:
+ In file `scrutiny-tests.scm:210',
+ At toplevel,
In procedure call:
(f (scheme#list))
@@ -794,8 +795,8 @@ Warning: Invalid argument type.
(pair -> *)
Warning: Invalid argument type.
- (scrutiny-tests.scm:212)
- At toplevel:
+ In file `scrutiny-tests.scm:212',
+ At toplevel,
In procedure call:
(f (scheme#list 1))
@@ -821,8 +822,8 @@ Warning: Invalid argument type.
(null -> *)
Warning: Invalid argument type.
- (scrutiny-tests.scm:214)
- At toplevel:
+ In file `scrutiny-tests.scm:214',
+ At toplevel,
In procedure call:
(f (scheme#cons 1 2))
@@ -848,8 +849,8 @@ Warning: Invalid argument type.
(list -> *)
Warning: Vector index negative.
- (scrutiny-tests.scm:220)
- In `vector-ref-warn1', a toplevel procedure
+ In file `scrutiny-tests.scm:220',
+ In procedure `vector-ref-warn1' (toplevel),
In procedure call:
(scheme#vector-ref v1 -1)
@@ -857,8 +858,8 @@ Warning: Vector index negative.
Calling `vector-ref' from module `scheme' with a negative index -1.
Warning: Vector index out of range.
- (scrutiny-tests.scm:222)
- In `vector-ref-warn2', a toplevel procedure
+ In file `scrutiny-tests.scm:222',
+ In procedure `vector-ref-warn2' (toplevel),
In procedure call:
(scheme#vector-ref v1 3)
@@ -866,8 +867,8 @@ Warning: Vector index out of range.
Calling `vector-ref' from module `scheme' with index `3' for a vector of
length `3'.
Warning: Vector index out of range.
- (scrutiny-tests.scm:223)
- In `vector-ref-warn3', a toplevel procedure
+ In file `scrutiny-tests.scm:223',
+ In procedure `vector-ref-warn3' (toplevel),
In procedure call:
(scheme#vector-ref v1 4)
@@ -875,8 +876,8 @@ Warning: Vector index out of range.
Calling `vector-ref' from module `scheme' with index `4' for a vector of
length `3'.
Warning: Invalid argument type.
- (scrutiny-tests.scm:226)
- In `vector-ref-standard-warn1', a toplevel procedure
+ In file `scrutiny-tests.scm:226',
+ In procedure `vector-ref-standard-warn1' (toplevel),
In procedure call:
(scheme#vector-ref v1 'bad)
@@ -898,8 +899,8 @@ Warning: Invalid argument type.
((vector-of 'a384) fixnum -> 'a384)
Warning: Vector index negative.
- (scrutiny-tests.scm:227)
- In `vector-set!-warn1', a toplevel procedure
+ In file `scrutiny-tests.scm:227',
+ In procedure `vector-set!-warn1' (toplevel),
In procedure call:
(scheme#vector-set! v1 -1 'whatever)
@@ -907,8 +908,8 @@ Warning: Vector index negative.
Calling `vector-set!' from module `scheme' with a negative index -1.
Warning: Vector index out of range.
- (scrutiny-tests.scm:228)
- In `vector-set!-warn2', a toplevel procedure
+ In file `scrutiny-tests.scm:228',
+ In procedure `vector-set!-warn2' (toplevel),
In procedure call:
(scheme#vector-set! v1 3 'whatever)
@@ -916,8 +917,8 @@ Warning: Vector index out of range.
Calling `vector-set!' from module `scheme' with index `3' for a vector of
length `3'.
Warning: Vector index out of range.
- (scrutiny-tests.scm:229)
- In `vector-set!-warn3', a toplevel procedure
+ In file `scrutiny-tests.scm:229',
+ In procedure `vector-set!-warn3' (toplevel),
In procedure call:
(scheme#vector-set! v1 4 'whatever)
@@ -925,8 +926,8 @@ Warning: Vector index out of range.
Calling `vector-set!' from module `scheme' with index `4' for a vector of
length `3'.
Warning: Invalid argument type.
- (scrutiny-tests.scm:232)
- In `vector-set!-standard-warn1', a toplevel procedure
+ In file `scrutiny-tests.scm:232',
+ In procedure `vector-set!-standard-warn1' (toplevel),
In procedure call:
(scheme#vector-set! v1 'bad 'whatever)
@@ -948,8 +949,8 @@ Warning: Invalid argument type.
(vector fixnum * -> undefined)
Warning: List index negative.
- (scrutiny-tests.scm:238)
- In `list-ref-warn1', a toplevel procedure
+ In file `scrutiny-tests.scm:238',
+ In procedure `list-ref-warn1' (toplevel),
In procedure call:
(scheme#list-ref l1 -1)
@@ -957,8 +958,8 @@ Warning: List index negative.
Calling `list-ref' from module `scheme' with a negative index -1.
Warning: List index negative.
- (scrutiny-tests.scm:241)
- In `list-ref-warn2', a toplevel procedure
+ In file `scrutiny-tests.scm:241',
+ In procedure `list-ref-warn2' (toplevel),
In procedure call:
(scheme#list-ref l2 -1)
@@ -966,8 +967,8 @@ Warning: List index negative.
Calling `list-ref' from module `scheme' with a negative index -1.
Warning: List index negative.
- (scrutiny-tests.scm:244)
- In `list-ref-warn3', a toplevel procedure
+ In file `scrutiny-tests.scm:244',
+ In procedure `list-ref-warn3' (toplevel),
In procedure call:
(scheme#list-ref l3 -1)
@@ -975,8 +976,8 @@ Warning: List index negative.
Calling `list-ref' from module `scheme' with a negative index -1.
Warning: List index out of range.
- (scrutiny-tests.scm:246)
- In `list-ref-warn4', a toplevel procedure
+ In file `scrutiny-tests.scm:246',
+ In procedure `list-ref-warn4' (toplevel),
In procedure call:
(scheme#list-ref l1 3)
@@ -984,8 +985,8 @@ Warning: List index out of range.
Calling `list-ref' from module `scheme' with index `3' for a list of length
`3'.
Warning: List index out of range.
- (scrutiny-tests.scm:252)
- In `list-ref-warn5', a toplevel procedure
+ In file `scrutiny-tests.scm:252',
+ In procedure `list-ref-warn5' (toplevel),
In procedure call:
(scheme#list-ref l1 4)
@@ -993,8 +994,8 @@ Warning: List index out of range.
Calling `list-ref' from module `scheme' with index `4' for a list of length
`3'.
Warning: Invalid argument type.
- (scrutiny-tests.scm:281)
- In `list-ref-standard-warn1', a toplevel procedure
+ In file `scrutiny-tests.scm:281',
+ In procedure `list-ref-standard-warn1' (toplevel),
In procedure call:
(scheme#list-ref l1 'bad)
@@ -1016,8 +1017,8 @@ Warning: Invalid argument type.
((list-of 'a366) fixnum -> 'a366)
Warning: Invalid argument type.
- (scrutiny-tests.scm:282)
- In `list-ref-standard-warn2', a toplevel procedure
+ In file `scrutiny-tests.scm:282',
+ In procedure `list-ref-standard-warn2' (toplevel),
In procedure call:
(scheme#list-ref l1 'bad)
@@ -1039,8 +1040,8 @@ Warning: Invalid argument type.
((list-of 'a366) fixnum -> 'a366)
Warning: Invalid argument type.
- (scrutiny-tests.scm:284)
- In `list-ref-standard-warn3', a toplevel procedure
+ In file `scrutiny-tests.scm:284',
+ In procedure `list-ref-standard-warn3' (toplevel),
In procedure call:
(scheme#list-ref l2 'bad)
@@ -1062,8 +1063,8 @@ Warning: Invalid argument type.
((list-of 'a366) fixnum -> 'a366)
Warning: Invalid argument type.
- (scrutiny-tests.scm:285)
- In `list-ref-standard-warn4', a toplevel procedure
+ In file `scrutiny-tests.scm:285',
+ In procedure `list-ref-standard-warn4' (toplevel),
In procedure call:
(scheme#list-ref l2 'bad)
@@ -1085,8 +1086,8 @@ Warning: Invalid argument type.
((list-of 'a366) fixnum -> 'a366)
Warning: Invalid argument type.
- (scrutiny-tests.scm:289)
- In `list-ref-type-warn1', a toplevel procedure
+ In file `scrutiny-tests.scm:289',
+ In procedure `list-ref-type-warn1' (toplevel),
In procedure call:
(chicken.base#add1 (scheme#list-ref l1 1))
@@ -1112,8 +1113,8 @@ Warning: Invalid argument type.
(number -> number)
Warning: Invalid argument type.
- (scrutiny-tests.scm:291)
- In `list-ref-type-warn2', a toplevel procedure
+ In file `scrutiny-tests.scm:291',
+ In procedure `list-ref-type-warn2' (toplevel),
In procedure call:
(chicken.base#add1 (scheme#list-ref l2 1))
@@ -1139,8 +1140,8 @@ Warning: Invalid argument type.
(number -> number)
Warning: Invalid argument type.
- (scrutiny-tests.scm:295)
- In `list-ref-type-warn3', a toplevel procedure
+ In file `scrutiny-tests.scm:295',
+ In procedure `list-ref-type-warn3' (toplevel),
In procedure call:
(chicken.base#add1 (scheme#list-ref l3 1))
@@ -1166,8 +1167,8 @@ Warning: Invalid argument type.
(number -> number)
Warning: Invalid argument type.
- (scrutiny-tests.scm:307)
- In `append-result-type-warn1', a toplevel procedure
+ In file `scrutiny-tests.scm:307',
+ In procedure `append-result-type-warn1' (toplevel),
In procedure call:
(chicken.base#add1 (scheme#list-ref l1 1))
@@ -1193,8 +1194,8 @@ Warning: Invalid argument type.
(number -> number)
Warning: Invalid argument type.
- (scrutiny-tests.scm:312)
- In `append-result-type-warn2', a toplevel procedure
+ In file `scrutiny-tests.scm:312',
+ In procedure `append-result-type-warn2' (toplevel),
In procedure call:
(chicken.base#add1 (scheme#list-ref l3 3))
diff --git a/tests/specialization.expected b/tests/specialization.expected
index 6d3eabd..aff2d52 100644
--- a/tests/specialization.expected
+++ b/tests/specialization.expected
@@ -2,8 +2,8 @@
;; prefixes: (tmp g)
Note: Predicate always true.
- (specialization-tests.scm:3)
- At toplevel:
+ In file `specialization-tests.scm:3',
+ At toplevel,
In predicate call:
(scheme#string? a)
@@ -19,8 +19,8 @@ Note: Predicate always true.
string
Note: Test always true.
- (specialization-tests.scm:3)
- At toplevel:
+ In file `specialization-tests.scm:3',
+ At toplevel,
In conditional expression:
(if (scheme#string? a) 'ok 'no)
@@ -30,8 +30,8 @@ Note: Test always true.
true
Note: Predicate always false.
- (specialization-tests.scm:4)
- At toplevel:
+ In file `specialization-tests.scm:4',
+ At toplevel,
In predicate call:
(scheme#string? a)
@@ -47,8 +47,8 @@ Note: Predicate always false.
symbol
Note: Test always false.
- (specialization-tests.scm:4)
- At toplevel:
+ In file `specialization-tests.scm:4',
+ At toplevel,
In conditional expression:
(if (scheme#string? a) 'ok 'no)
@@ -56,8 +56,8 @@ Note: Test always false.
Test condition is always false.
Note: Predicate always true.
- (specialization-tests.scm:10)
- At toplevel:
+ In file `specialization-tests.scm:10',
+ At toplevel,
In predicate call:
(scheme#input-port? p)
@@ -73,8 +73,8 @@ Note: Predicate always true.
input/output-port
Note: Test always true.
- (specialization-tests.scm:10)
- At toplevel:
+ In file `specialization-tests.scm:10',
+ At toplevel,
In conditional expression:
(if (scheme#input-port? p) 'ok 'no)
@@ -84,8 +84,8 @@ Note: Test always true.
true
Note: Predicate always true.
- (specialization-tests.scm:11)
- At toplevel:
+ In file `specialization-tests.scm:11',
+ At toplevel,
In predicate call:
(scheme#output-port? p)
@@ -101,8 +101,8 @@ Note: Predicate always true.
input/output-port
Note: Test always true.
- (specialization-tests.scm:11)
- At toplevel:
+ In file `specialization-tests.scm:11',
+ At toplevel,
In conditional expression:
(if (scheme#output-port? p) 'ok 'no)
--
2.7.4
>From 50aff909eb5414c6a77fdeaa48c5ba564f7d7998 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Mon, 10 Dec 2018 13:31:32 +0200
Subject: [PATCH 17/17] Strip renaming detail from type variables when printing
In type (a123 -> a123), the numbers have no meaning to the normal
user, and only add clutter. So strip the numbers. When debugging the
scrutinizer the actual identifiers can be obtained from the debug
messages.
If there's multiple identical non-number prefixes then there will be
numbers: a12, a23, a34 -> a, a1, a2.
---
scrutinizer.scm | 23 +++++++++++++++++++++--
tests/runtests.sh | 2 +-
tests/scrutinizer-message-format.expected | 6 +++---
tests/scrutiny.expected | 30 +++++++++++++++---------------
4 files changed, 40 insertions(+), 21 deletions(-)
diff --git a/scrutinizer.scm b/scrutinizer.scm
index d22dcca..4cd8de9 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -46,7 +46,8 @@
chicken.port
chicken.pretty-print
chicken.string
- chicken.syntax)
+ chicken.syntax
+ chicken.irregex)
(include "tweaks")
(include "mini-srfi-1.scm")
@@ -2345,6 +2346,24 @@
(define (type->pp-string t #!optional (proc-name? #t) (bomb? #t))
(define pname? proc-name?)
+ (define gen-tv-name ;; Generate cleaner names for type variables
+ ;; (forall (a123) a123) -> (forall (a) a)
+ ;; (forall (a123 a456) (pair a123 a456)) -> (forall (a a1) (pair a a1))
+ (let ((seen '()))
+ (define (count p l) (length (filter p l)))
+ (lambda (tv)
+ (let ((mat (irregex-match
+ '(: ($ (+ alpha)) (+ numeric))
+ (symbol->string tv))))
+ ;; We expect T to be a validated type => simplify-type
+ ;; should have gensymed tvs
+ (when (not mat) (bomb "tv not renamed" tv t))
+
+ (let* ((var (irregex-match-substring mat 1))
+ (c (count (cut eq? <> var) seen)))
+ (set! seen (cons tv seen))
+ (string->symbol (format "~a~a" var (if (zero? c) "" c))))))))
+
(define (conv t #!optional (tv-replacements '()))
(define (R t) (conv t tv-replacements))
(cond
@@ -2359,7 +2378,7 @@
(let ((tcar (and (pair? t) (car t))))
(cond
((and (eq? 'forall tcar) (every symbol? (second t))) ;; no constraints
- (let ((tvs (map (lambda (tv) (cons tv (list 'quote tv))) (second t))))
+ (let ((tvs (map (lambda (tv) (cons tv (list 'quote (gen-tv-name
tv)))) (second t))))
(conv (third t) tvs)))
((eq? 'forall tcar) t) ; forall with constraints, do nothing
((memq tcar '(or not list vector pair list-of vector-of))
diff --git a/tests/runtests.sh b/tests/runtests.sh
index c1d5fb8..2e2b221 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -120,7 +120,7 @@ $compile test-scrutinizer-message-format.scm -A -specialize
-verbose 2>scrutiniz
# Replace foo123 -> fooXX so gensyms don't trigger failures
$compile redact-gensyms.scm
mv a.out redact-gensyms
-./redact-gensyms "tmp,g,a,b,:" < scrutinizer-message-format.out >
scrutinizer-message-format.redacted
+./redact-gensyms "tmp,g,:" < scrutinizer-message-format.out >
scrutinizer-message-format.redacted
./redact-gensyms < scrutiny-2.out > scrutiny-2.redacted
./redact-gensyms < scrutiny.out > scrutiny.redacted
./redact-gensyms < specialization.out > specialization.redacted
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
index 9416db8..34a83f8 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -1,5 +1,5 @@
;; numbers replaced with XXX by redact-gensyms.scm
-;; prefixes: (tmp g a b :)
+;; prefixes: (tmp g :)
Warning: literal in operator position: (1 2)
@@ -16,7 +16,7 @@ Warning: Wrong number of arguments.
Procedure `cons' from module `scheme' has this type:
- ('aXXX 'bXXX --> (pair 'aXXX 'bXXX))
+ ('a 'b --> (pair 'a 'b))
Warning: Invalid argument type.
In file `test-scrutinizer-message-format.scm:XXX',
@@ -325,7 +325,7 @@ Warning: Wrong number of arguments.
Procedure `cons' from module `scheme' has this type:
- ('aXXX 'bXXX --> (pair 'aXXX 'bXXX))
+ ('a 'b --> (pair 'a 'b))
Warning: Invalid argument type.
In file `test-scrutinizer-message-format.scm:XXX',
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 20559b7..808000b 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -185,7 +185,7 @@ Warning: Invalid assigned value type.
The declared type of `car' from module `scheme' is:
- ((pair 'a335 *) -> 'a335)
+ ((pair 'a *) -> 'a)
(Name: scheme#car)
@@ -568,7 +568,7 @@ Warning: Invalid argument type.
Procedure `apply1' has this type:
- ((&rest 'a143 -> 'b144) (list-of 'a143) -> 'b144)
+ ((&rest 'a -> 'b) (list-of 'a) -> 'b)
Warning: Invalid argument type.
In file `scrutiny-tests.scm:169',
@@ -587,7 +587,7 @@ Warning: Invalid argument type.
The expression is a call to `cons' from module `scheme' which has this type:
- ('a331 'b332 -> (pair 'a331 'b332))
+ ('a 'b -> (pair 'a 'b))
This is the expression:
@@ -595,7 +595,7 @@ Warning: Invalid argument type.
Procedure `apply1' has this type:
- ((&rest 'a143 -> 'b144) (list-of 'a143) -> 'b144)
+ ((&rest 'a -> 'b) (list-of 'a) -> 'b)
Note: Predicate always true.
In file `scrutiny-tests.scm:182',
@@ -838,7 +838,7 @@ Warning: Invalid argument type.
The expression is a call to `cons' from module `scheme' which has this type:
- ('a331 'b332 -> (pair 'a331 'b332))
+ ('a 'b -> (pair 'a 'b))
This is the expression:
@@ -896,7 +896,7 @@ Warning: Invalid argument type.
Procedure `vector-ref' from module `scheme' has this type:
- ((vector-of 'a384) fixnum -> 'a384)
+ ((vector-of 'a) fixnum -> 'a)
Warning: Vector index negative.
In file `scrutiny-tests.scm:227',
@@ -1014,7 +1014,7 @@ Warning: Invalid argument type.
Procedure `list-ref' from module `scheme' has this type:
- ((list-of 'a366) fixnum -> 'a366)
+ ((list-of 'a) fixnum -> 'a)
Warning: Invalid argument type.
In file `scrutiny-tests.scm:282',
@@ -1037,7 +1037,7 @@ Warning: Invalid argument type.
Procedure `list-ref' from module `scheme' has this type:
- ((list-of 'a366) fixnum -> 'a366)
+ ((list-of 'a) fixnum -> 'a)
Warning: Invalid argument type.
In file `scrutiny-tests.scm:284',
@@ -1060,7 +1060,7 @@ Warning: Invalid argument type.
Procedure `list-ref' from module `scheme' has this type:
- ((list-of 'a366) fixnum -> 'a366)
+ ((list-of 'a) fixnum -> 'a)
Warning: Invalid argument type.
In file `scrutiny-tests.scm:285',
@@ -1083,7 +1083,7 @@ Warning: Invalid argument type.
Procedure `list-ref' from module `scheme' has this type:
- ((list-of 'a366) fixnum -> 'a366)
+ ((list-of 'a) fixnum -> 'a)
Warning: Invalid argument type.
In file `scrutiny-tests.scm:289',
@@ -1102,7 +1102,7 @@ Warning: Invalid argument type.
The expression is a call to `list-ref' from module `scheme' which has this
type:
- ((list-of 'a366) fixnum -> 'a366)
+ ((list-of 'a) fixnum -> 'a)
This is the expression:
@@ -1129,7 +1129,7 @@ Warning: Invalid argument type.
The expression is a call to `list-ref' from module `scheme' which has this
type:
- ((list-of 'a366) fixnum -> 'a366)
+ ((list-of 'a) fixnum -> 'a)
This is the expression:
@@ -1156,7 +1156,7 @@ Warning: Invalid argument type.
The expression is a call to `list-ref' from module `scheme' which has this
type:
- ((list-of 'a366) fixnum -> 'a366)
+ ((list-of 'a) fixnum -> 'a)
This is the expression:
@@ -1183,7 +1183,7 @@ Warning: Invalid argument type.
The expression is a call to `list-ref' from module `scheme' which has this
type:
- ((list-of 'a366) fixnum -> 'a366)
+ ((list-of 'a) fixnum -> 'a)
This is the expression:
@@ -1210,7 +1210,7 @@ Warning: Invalid argument type.
The expression is a call to `list-ref' from module `scheme' which has this
type:
- ((list-of 'a366) fixnum -> 'a366)
+ ((list-of 'a) fixnum -> 'a)
This is the expression:
--
2.7.4