~ chicken-core (chicken-5) 9834b1a6b56419fcc800b80d557791a74f661709
commit 9834b1a6b56419fcc800b80d557791a74f661709
Author: megane <meganeka@gmail.com>
AuthorDate: Sat Mar 30 09:26:59 2019 +0200
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sun Mar 31 11:37:04 2019 +0200
Make scrutinizer message format test suite more comprehensive
Signed-off-by: Evan Hanson <evhan@foldling.org>
Signed-off-by: Peter Bex <peter@more-magic.net>
diff --git a/tests/scrutinizer-message-format.expected b/tests/scrutinizer-message-format.expected
index d8f2aa55..7688ca1f 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -306,110 +306,37 @@ Warning: List index out of range
Procedure `list-ref' from module `scheme' is called with index `1' for a list of length `0'.
-Warning: Negative vector index
+Warning: Invalid argument
In file `test-scrutinizer-message-format.scm:XXX',
- In procedure `vector-ref-out-of-range',
+ In procedure `append-invalid-arg',
In procedure call:
- (scheme#vector-ref (scheme#vector) -1)
-
- Procedure `vector-ref' from module `scheme' is called with a negative index -1.
+ (scheme#append 1 (scheme#list 1))
-Warning: Let binding to `a' has zero values
- In file `test-scrutinizer-message-format.scm:XXX',
- In procedure `zero-values-for-let',
- In let expression:
+ Argument #1 to procedure `append' has an invalid type:
- (let ((a (scheme#values))) a)
-
- Variable `a' is bound to an expression that returns 0 values.
-
- It is a call to `values' from module `scheme' which has this type:
-
- (procedure (#!rest values) . *)
-
- This is the expression:
-
- (scheme#values)
-
-Warning: Let binding to `a' has 2 values
- In file `test-scrutinizer-message-format.scm:XXX',
- In procedure `multiple-values-for-let',
- In let expression:
-
- (let ((a (scheme#values 1 2))) a)
-
- Variable `a' is bound to an expression that returns 2 values.
-
- It is a call to `values' from module `scheme' which has this type:
-
- (procedure (#!rest values) . *)
-
- This is the expression:
-
- (scheme#values 1 2)
-
-Warning: Zero values for conditional
- In file `test-scrutinizer-message-format.scm:XXX',
- In procedure `zero-values-for-conditional',
- In conditional:
-
- (if (scheme#values) 1 (##core#undefined))
-
- The test expression returns 0 values.
-
- It is a call to `values' from module `scheme' which has this type:
-
- (procedure (#!rest values) . *)
-
- This is the expression:
-
- (scheme#values)
-
-Warning: Too many values for conditional
- In file `test-scrutinizer-message-format.scm:XXX',
- In procedure `multiple-values-for-conditional',
- In conditional:
-
- (if (scheme#values 1 2) 1 (##core#undefined))
-
- The test expression returns 2 values.
+ fixnum
- It is a call to `values' from module `scheme' which has this type:
+ The expected type is:
- (procedure (#!rest values) . *)
+ list
This is the expression:
- (scheme#values 1 2)
-
-Note: Test is always true
- In file `test-scrutinizer-message-format.scm:XXX',
- In procedure `multiple-values-for-conditional',
- In conditional expression:
+ 1
- (if (scheme#values 1 2) 1 (##core#undefined))
+ Procedure `append' from module `scheme' has this type:
- Test condition has always true value of type:
+ (#!rest * -> *)
- fixnum
-
-Warning: Let binding to `gXXX' has 2 values
+Warning: Negative vector index
In file `test-scrutinizer-message-format.scm:XXX',
- In procedure `multiple-values-for-conditional',
- In let expression:
-
- (if (scheme#values 1 2) 1 (##core#undefined))
-
- Variable `gXXX' is bound to an expression that returns 2 values.
-
- It is a call to `values' from module `scheme' which has this type:
-
- (procedure (#!rest values) . *)
+ In procedure `vector-ref-out-of-range',
+ In procedure call:
- This is the expression:
+ (scheme#vector-ref (scheme#vector) -1)
- (scheme#values 1 2)
+ Procedure `vector-ref' from module `scheme' is called with a negative index -1.
Warning: Wrong number of arguments
In file `test-scrutinizer-message-format.scm:XXX',
@@ -493,26 +420,6 @@ Warning: Not enough argument values
(scheme#values)
-Warning: Let binding to `gXXX' has zero values
- In file `test-scrutinizer-message-format.scm:XXX',
- In module `m',
- In procedure `toplevel-foo',
- In procedure `local-bar',
- In procedure `r-proc-call-argument-value-count',
- In let expression:
-
- (let ((gXXX (scheme#values))) (gXXX))
-
- Variable `gXXX' is bound to an expression that returns 0 values.
-
- It is a call to `values' from module `scheme' which has this type:
-
- (procedure (#!rest values) . *)
-
- This is the expression:
-
- (scheme#values)
-
Warning: Branch values mismatch
In file `test-scrutinizer-message-format.scm:XXX',
In module `m',
@@ -533,11 +440,29 @@ Warning: Branch values mismatch
(chicken.time#cpu-time)
+Warning: Invalid procedure
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo',
+ In procedure `local-bar',
+ In procedure `r-invalid-called-procedure-type',
+ In procedure `variable',
+ In procedure call:
+
+ (m#foo2 2)
+
+ Variable `foo2' from module `m' is not a procedure.
+
+ It has this type:
+
+ boolean
+
Warning: Invalid procedure
In module `m',
In procedure `toplevel-foo',
In procedure `local-bar',
In procedure `r-invalid-called-procedure-type',
+ In procedure `non-variable',
In procedure call:
(1 2)
@@ -733,47 +658,12 @@ Warning: Deprecated identifier `deprecated-foo2'
The suggested alternative is `foo'.
-Warning: Negative list index
- In file `test-scrutinizer-message-format.scm:XXX',
- In module `m',
- In procedure `toplevel-foo',
- In procedure `local-bar',
- In procedure `list-ref-negative-index',
- In procedure call:
-
- (scheme#list-ref '() -1)
-
- Procedure `list-ref' from module `scheme' is called with a negative index -1.
-
-Warning: List index out of range
- In file `test-scrutinizer-message-format.scm:XXX',
- In module `m',
- In procedure `toplevel-foo',
- In procedure `local-bar',
- In procedure `list-ref-out-of-range',
- In procedure call:
-
- (scheme#list-ref '() 1)
-
- Procedure `list-ref' from module `scheme' is called with index `1' for a list of length `0'.
-
-Warning: Negative vector index
- In file `test-scrutinizer-message-format.scm:XXX',
- In module `m',
- In procedure `toplevel-foo',
- In procedure `local-bar',
- In procedure `vector-ref-out-of-range',
- In procedure call:
-
- (scheme#vector-ref (scheme#vector) -1)
-
- Procedure `vector-ref' from module `scheme' is called with a negative index -1.
-
Warning: Let binding to `a' has zero values
In file `test-scrutinizer-message-format.scm:XXX',
In module `m',
In procedure `toplevel-foo',
In procedure `local-bar',
+ In procedure `r-let-value-count-invalid',
In procedure `zero-values-for-let',
In let expression:
@@ -794,7 +684,8 @@ Warning: Let binding to `a' has 2 values
In module `m',
In procedure `toplevel-foo',
In procedure `local-bar',
- In procedure `multiple-values-for-let',
+ In procedure `r-let-value-count-invalid',
+ In procedure `too-many-values-for-let',
In let expression:
(let ((a (scheme#values 1 2))) a)
@@ -814,6 +705,7 @@ Warning: Zero values for conditional
In module `m',
In procedure `toplevel-foo',
In procedure `local-bar',
+ In procedure `r-conditional-value-count-invalid',
In procedure `zero-values-for-conditional',
In conditional:
@@ -834,10 +726,11 @@ Warning: Too many values for conditional
In module `m',
In procedure `toplevel-foo',
In procedure `local-bar',
- In procedure `multiple-values-for-conditional',
+ In procedure `r-conditional-value-count-invalid',
+ In procedure `too-many-values-for-conditional',
In conditional:
- (if (scheme#values 1 2) 1 (##core#undefined))
+ (if (scheme#values (the * 1) 2) 1 (##core#undefined))
The test expression returns 2 values.
@@ -847,33 +740,41 @@ Warning: Too many values for conditional
This is the expression:
- (scheme#values 1 2)
+ (scheme#values (the * 1) 2)
-Note: Test is always true
+Warning: Assignment to `foo' has zero values
In file `test-scrutinizer-message-format.scm:XXX',
In module `m',
In procedure `toplevel-foo',
In procedure `local-bar',
- In procedure `multiple-values-for-conditional',
- In conditional expression:
+ In procedure `r-assignment-value-count-invalid',
+ In procedure `zero-values-for-assignment',
+ In assignment:
- (if (scheme#values 1 2) 1 (##core#undefined))
+ (set! m#foo (scheme#values))
- Test condition has always true value of type:
+ Variable `foo' is assigned from expression that returns 0 values.
- fixnum
+ It is a call to `values' from module `scheme' which has this type:
-Warning: Let binding to `gXXX' has 2 values
+ (procedure (#!rest values) . *)
+
+ This is the expression:
+
+ (scheme#values)
+
+Warning: Assignment to `foo' has 2 values
In file `test-scrutinizer-message-format.scm:XXX',
In module `m',
In procedure `toplevel-foo',
In procedure `local-bar',
- In procedure `multiple-values-for-conditional',
- In let expression:
+ In procedure `r-assignment-value-count-invalid',
+ In procedure `too-many-values-for-assignment',
+ In assignment:
- (if (scheme#values 1 2) 1 (##core#undefined))
+ (set! m#foo (scheme#values #t 2))
- Variable `gXXX' is bound to an expression that returns 2 values.
+ Variable `foo' is assigned from expression that returns 2 values.
It is a call to `values' from module `scheme' which has this type:
@@ -881,7 +782,135 @@ Warning: Let binding to `gXXX' has 2 values
This is the expression:
- (scheme#values 1 2)
+ (scheme#values #t 2)
+
+Warning: Negative list index
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo',
+ In procedure `local-bar',
+ In procedure `list-ref-negative-index',
+ In procedure call:
+
+ (scheme#list-ref '() -1)
+
+ Procedure `list-ref' from module `scheme' is called with a negative index -1.
+
+Warning: List index out of range
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo',
+ In procedure `local-bar',
+ In procedure `list-ref-out-of-range',
+ In procedure call:
+
+ (scheme#list-ref '() 1)
+
+ Procedure `list-ref' from module `scheme' is called with index `1' for a list of length `0'.
+
+Warning: Invalid argument
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo',
+ In procedure `local-bar',
+ In procedure `append-invalid-arg',
+ In procedure call:
+
+ (scheme#append 1 (scheme#list 1))
+
+ Argument #1 to procedure `append' has an invalid type:
+
+ fixnum
+
+ The expected type is:
+
+ list
+
+ This is the expression:
+
+ 1
+
+ Procedure `append' from module `scheme' has this type:
+
+ (#!rest * -> *)
+
+Warning: Negative vector index
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo',
+ In procedure `local-bar',
+ In procedure `vector-ref-out-of-range',
+ In procedure call:
+
+ (scheme#vector-ref (scheme#vector) -1)
+
+ Procedure `vector-ref' from module `scheme' is called with a negative index -1.
+
+Note: Predicate is always true
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo',
+ In procedure `local-bar',
+ In procedure `r-cond-test-always-true-with-pred',
+ In procedure call:
+
+ (scheme#symbol? 'symbol)
+
+ The predicate will always return true.
+
+ Procedure `symbol?' from module `scheme' is a predicate for:
+
+ symbol
+
+ The given argument has this type:
+
+ symbol
+
+Note: Test is always true
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo',
+ In procedure `local-bar',
+ In procedure `r-cond-test-always-true-with-pred',
+ In conditional expression:
+
+ (if (scheme#symbol? 'symbol) 1 (##core#undefined))
+
+ Test condition has always true value of type:
+
+ true
+
+Note: Predicate is always false
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo',
+ In procedure `local-bar',
+ In procedure `r-cond-test-always-false-with-pred',
+ In procedure call:
+
+ (scheme#symbol? 1)
+
+ The predicate will always return false.
+
+ Procedure `symbol?' from module `scheme' is a predicate for:
+
+ symbol
+
+ The given argument has this type:
+
+ fixnum
+
+Note: Test is always false
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo',
+ In procedure `local-bar',
+ In procedure `r-cond-test-always-false-with-pred',
+ In conditional expression:
+
+ (if (scheme#symbol? 1) 1 (##core#undefined))
+
+ Test condition is always false.
Error: No typecase match
In file `test-scrutinizer-message-format.scm:XXX',
diff --git a/tests/test-scrutinizer-message-format.scm b/tests/test-scrutinizer-message-format.scm
index d792cf34..38f3e7a3 100644
--- a/tests/test-scrutinizer-message-format.scm
+++ b/tests/test-scrutinizer-message-format.scm
@@ -1,4 +1,5 @@
(import (chicken time))
+
(: deprecated-foo deprecated)
(define deprecated-foo 1)
(: deprecated-foo2 (deprecated foo))
@@ -23,15 +24,13 @@
(set! foo 1)
+;; These have special cases
(define (list-ref-negative-index) (list-ref '() -1))
(define (list-ref-out-of-range) (list-ref '() 1))
-(define (append-invalid-last-arg) (scheme#append (list 1) 1)) ;; TODO: doesn't work
+(define (append-invalid-arg) (append 1 (list 1)))
(define (vector-ref-out-of-range) (vector-ref (vector) -1))
-(define (zero-values-for-let) (let ((a (values))) a))
-(define (multiple-values-for-let) (let ((a (values 1 2))) a))
-(define (zero-values-for-conditional) (if (values) 1))
-(define (multiple-values-for-conditional) (if (values 1 2) 1))
+;; This is disabled because fail-compiler-typecase is a fatal warning
;; (define (fail-compiler-typecase) (compiler-typecase 1 (symbol 1) (list 2)))
(module
@@ -51,9 +50,11 @@
(define (local-bar)
(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)) ((values)))
+ (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-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))
@@ -64,14 +65,24 @@
(define (r-toplevel-var-assignment-type-mismatch) (set! foo2 1))
(define (r-deprecated-identifier) (list deprecated-foo) (vector deprecated-foo2))
+ (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))))
+
+ ;; These have special cases
(define (list-ref-negative-index) (list-ref '() -1))
(define (list-ref-out-of-range) (list-ref '() 1))
- (define (append-invalid-last-arg) (scheme#append (list 1) 1)) ;; TODO: doesn't work
+ (define (append-invalid-arg) (append 1 (list 1)))
(define (vector-ref-out-of-range) (vector-ref (vector) -1))
- (define (zero-values-for-let) (let ((a (values))) a))
- (define (multiple-values-for-let) (let ((a (values 1 2))) a))
- (define (zero-values-for-conditional) (if (values) 1))
- (define (multiple-values-for-conditional) (if (values 1 2) 1))
+
+ (define (r-cond-test-always-true-with-pred) (if (symbol? 'symbol) 1))
+ (define (r-cond-test-always-false-with-pred) (if (symbol? 1) 1))
(define (fail-compiler-typecase) (compiler-typecase 1 (symbol 1) (list 2)))
)))
Trap