On 2019-01-10 18:12, megane wrote:
> Evan Hanson <ev...@foldling.org> 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.
>
> You'll have to redo your changes to the first patch, sorry about that.

No worries, here's the same again with a sign-off.

> 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.

That's a nice idea, I think it's probably fine. But if we're going to do
that, why not wipe line numbers in all the expected files rather than
just the new one?

> 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 @@
> + (define prefixes (if (null? (command-line-arguments))
> +                         '("tmp" "g")
> +                         (string-split (car (command-line-arguments)) ",")))
> +
> + (let ((rege (irregex `(: ($ (or ,@prefixes)) (+ numeric)))))

This regex could be `(: bow ($ (or ,@prefixes)) (+ numeric)) so you avoid
accidentally replacing numbers in something like a variable called "dog1".

Evan
>From 76d260fab399e4cb6679e923ffdef496201d2fcd Mon Sep 17 00:00:00 2001
From: megane <megan...@gmail.com>
Date: Mon, 19 Nov 2018 10:01:33 +0200
Subject: [PATCH] Add new test for scrutinizer message formatting

This makes it easy to see how scrutinizer changes affect the user facing
output messages.

In the test scripts, move scrutiny-tests-2.scm up so all output is
generated before diffing anything. This way you can update all expected
message files at the same time.

Signed-off-by: Evan Hanson <ev...@foldling.org>
---
 distribution/manifest                     |   2 +
 tests/runtests.bat                        |  10 +-
 tests/runtests.sh                         |   6 +-
 tests/scrutinizer-message-format.expected | 261 ++++++++++++++++++++++++++++++
 tests/test-scrutinizer-message-format.scm |  87 ++++++++++
 5 files changed, 362 insertions(+), 4 deletions(-)
 create mode 100644 tests/scrutinizer-message-format.expected
 create mode 100644 tests/test-scrutinizer-message-format.scm

diff --git a/distribution/manifest b/distribution/manifest
index 9c1dcfdb..c1a615ea 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -176,6 +176,8 @@ tests/scrutiny-tests-2.scm
 tests/scrutiny-tests-3.scm
 tests/scrutiny.expected
 tests/scrutiny-2.expected
+tests/test-scrutinizer-message-format.scm
+tests/scrutinizer-message-format.expected
 tests/syntax-rule-stress-test.scm
 tests/syntax-tests.scm
 tests/syntax-tests-2.scm
diff --git a/tests/runtests.bat b/tests/runtests.bat
index f739a297..47d80c0c 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -92,19 +92,25 @@ echo ======================================== scrutiny tests ...
 if errorlevel 1 exit /b 1
 a.out
 if errorlevel 1 exit /b 1
+
 %compile% scrutiny-tests.scm -A -verbose 2>scrutiny.out
 if errorlevel 1 exit /b 1
 
 rem this is sensitive to gensym-names, so make it optional
 if not exist scrutiny.expected copy /Y scrutiny.out scrutiny.expected
 
-fc /lb%FCBUFSIZE% /w scrutiny.expected scrutiny.out
+%compile% scrutiny-tests-2.scm -A -verbose 2>scrutiny-2.out
 if errorlevel 1 exit /b 1
+%compile% test-scrutinizer-message-format.scm -A -verbose 2>scrutinizer-message-format.out
+rem this is expected to fail, so no errorlevel check
 
-%compile% scrutiny-tests-2.scm -A -verbose 2>scrutiny-2.out
+fc /lb%FCBUFSIZE% /w scrutinizer-message-format.expected scrutinizer-message-format.out
+if errorlevel 1 exit /b 1
+fc /lb%FCBUFSIZE% /w scrutiny.expected scrutiny.out
 if errorlevel 1 exit /b 1
 
 if not exist scrutiny-2.expected copy /Y scrutiny-2.out scrutiny-2.expected
+
 fc /lb%FCBUFSIZE% /w scrutiny-2.expected scrutiny-2.out
 if errorlevel 1 exit /b 1
 
diff --git a/tests/runtests.sh b/tests/runtests.sh
index 6da7630d..c6f9252e 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 00000000..f41fb898
--- /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 00000000..37dbcd2f
--- /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.11.0

_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers

Reply via email to