>From 499a97da7830d3a9fba998c0e25821492e8c401e Mon Sep 17 00:00:00 2001 From: megane Date: Sat, 30 Mar 2019 09:26:59 +0200 Subject: [PATCH] Make scrutinizer message format test suite more comprehensive Signed-off-by: Evan Hanson --- tests/scrutinizer-message-format.expected | 349 ++++++++++++++++-------------- tests/test-scrutinizer-message-format.scm | 35 ++- 2 files changed, 212 insertions(+), 172 deletions(-) diff --git a/tests/scrutinizer-message-format.expected b/tests/scrutinizer-message-format.expected index f6f3b256..13e0361d 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', @@ -534,10 +441,28 @@ 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))) ))) -- 2.11.0