Actually attached this time.
>From a9d1c0efe1ee5315d16233a016f88617b47f9075 Mon Sep 17 00:00:00 2001
From: megane <megan...@gmail.com>
Date: Mon, 25 Mar 2019 14:15:19 +0200
Subject: [PATCH] Make scrutinizer message format test suite more comprehensive
Signed-off-by: Evan Hanson <ev...@foldling.org>
---
tests/runtests.bat | 2 +-
tests/runtests.sh | 2 +-
tests/scrutinizer-message-format.expected | 547 +++++++++++++++++++-----------
tests/test-scrutinizer-message-format.scm | 55 ++-
4 files changed, 389 insertions(+), 217 deletions(-)
diff --git a/tests/runtests.bat b/tests/runtests.bat
index 49fa8348..edbd1bb1 100644
--- a/tests/runtests.bat
+++ b/tests/runtests.bat
@@ -105,7 +105,7 @@ if errorlevel 1 exit /b 1
rem Replace foo123 -> fooXX so gensyms don't trigger failures
%compile% redact-gensyms.scm -o redact-gensyms
if errorlevel 1 exit /b 1
-redact-gensyms "tmp,g,scm:,a,b" < scrutinizer-message-format.out > scrutinizer-message-format.redacted
+redact-gensyms "tmp,g,scm:,a,b,c" < scrutinizer-message-format.out > scrutinizer-message-format.redacted
if errorlevel 1 exit /b 1
redact-gensyms < scrutiny-2.out > scrutiny-2.redacted
if errorlevel 1 exit /b 1
diff --git a/tests/runtests.sh b/tests/runtests.sh
index fc90ebbe..17c83448 100755
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -119,7 +119,7 @@ $compile specialization-tests.scm -A -specialize 2>specialization.out
# Replace foo123 -> fooXX so gensyms don't trigger failures
$compile redact-gensyms.scm -o redact-gensyms
-./redact-gensyms "tmp,g,scm:,a,b" < scrutinizer-message-format.out > scrutinizer-message-format.redacted
+./redact-gensyms "tmp,g,scm:,a,b,c" < 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 f6f3b256..40dae789 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 scm: a b)
+;; prefixes: (tmp g scm: a b c)
Warning: literal in operator position: (1 2)
@@ -75,29 +75,12 @@ Warning: Not enough argument values
(scheme#values)
-Warning: Let binding to `gXXX' has zero values
- In file `test-scrutinizer-message-format.scm:XXX',
- 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 procedure `r-cond-branch-value-count-mismatch',
In conditional expression:
- (if (the * 1) 1 (scheme#values 1 2))
+ (if (the * 1) 1 (chicken.time#cpu-time))
The branches have different numbers of values.
@@ -107,7 +90,7 @@ Warning: Branch values mismatch
The false branch returns 2 values:
- (scheme#values 1 2)
+ (chicken.time#cpu-time)
Warning: Invalid procedure
In procedure `r-invalid-called-procedure-type',
@@ -306,110 +289,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.
-
-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:
-
- (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.
+ (scheme#append 1 (scheme#list 1))
- It is a call to `values' from module `scheme' which has this type:
-
- (procedure (#!rest values) . *)
-
- This is the expression:
-
- (scheme#values)
+ Argument #1 to procedure `append' has an invalid type:
-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',
@@ -435,23 +345,23 @@ Warning: Invalid argument
In procedure `r-proc-call-argument-type-mismatch',
In procedure call:
- (scheme#length 'symbol)
+ (scheme#string-length chicken.base#add1)
- Argument #1 to procedure `length' has an invalid type:
+ Argument #1 to procedure `string-length' has an invalid type:
- symbol
+ (number -> number)
The expected type is:
- list
+ string
This is the expression:
- 'symbol
+ chicken.base#add1
- Procedure `length' from module `scheme' has this type:
+ Procedure `string-length' from module `scheme' has this type:
- (list -> fixnum)
+ (string -> fixnum)
Warning: Too many argument values
In file `test-scrutinizer-message-format.scm:XXX',
@@ -493,26 +403,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 +424,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)
@@ -640,6 +548,49 @@ Warning: Type mismatch
fixnum
+Warning: Invalid assignment
+ In module `m',
+ In procedure `toplevel-foo',
+ In procedure `local-bar',
+ In procedure `r-toplevel-var-assignment-type-mismatch',
+ In assignment:
+
+ (set! m#foo2 1)
+
+ Variable `foo2' is assigned invalid value.
+
+ The assigned value has this type:
+
+ fixnum
+
+ The declared type of `foo2' from module `m' is:
+
+ boolean
+
+Warning: Deprecated identifier `deprecated-foo'
+ In module `m',
+ In procedure `toplevel-foo',
+ In procedure `local-bar',
+ In procedure `r-deprecated-identifier',
+ In expression:
+
+ m#deprecated-foo
+
+ Use of deprecated identifier `deprecated-foo' from module `m'.
+
+Warning: Deprecated identifier `deprecated-foo2'
+ In module `m',
+ In procedure `toplevel-foo',
+ In procedure `local-bar',
+ In procedure `r-deprecated-identifier',
+ In expression:
+
+ m#deprecated-foo2
+
+ Use of deprecated identifier `deprecated-foo2' from module `m'.
+
+ The suggested alternative is `foo'.
+
Warning: Not enough values
In file `test-scrutinizer-message-format.scm:XXX',
In module `m',
@@ -654,6 +605,66 @@ Warning: Not enough values
symbol
+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 `zero-values-for-assignment',
+ In assignment:
+
+ (set! m#foo (scheme#values))
+
+ Variable `foo' is assigned from 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: Zero values for conditional
+ In file `test-scrutinizer-message-format.scm:XXX',
+ In module `m',
+ In procedure `toplevel-foo',
+ In procedure `local-bar',
+ 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: 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 `zero-values-for-let',
+ In let expression:
+
+ (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: Too many values
In file `test-scrutinizer-message-format.scm:XXX',
In module `m',
@@ -690,90 +701,72 @@ Warning: Type mismatch
fixnum
-Warning: Invalid assignment
+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 `r-toplevel-var-assignment-type-mismatch',
+ In procedure `too-many-values-for-assignment',
In assignment:
- (set! m#foo2 1)
+ (set! m#foo (scheme#values #t 2))
- Variable `foo2' is assigned invalid value.
+ Variable `foo' is assigned from expression that returns 2 values.
- The assigned value has this type:
+ It is a call to `values' from module `scheme' which has this type:
- fixnum
+ (procedure (#!rest values) . *)
- The declared type of `foo2' from module `m' is:
+ This is the expression:
- boolean
+ (scheme#values #t 2)
-Warning: Deprecated identifier `deprecated-foo'
+Warning: Too many values for conditional
+ In file `test-scrutinizer-message-format.scm:XXX',
In module `m',
In procedure `toplevel-foo',
In procedure `local-bar',
- In procedure `r-deprecated-identifier',
- In expression:
+ In procedure `too-many-values-for-conditional',
+ In conditional:
- m#deprecated-foo
+ (if (scheme#values (the * 1) 2) 1 (##core#undefined))
- Use of deprecated identifier `deprecated-foo' from module `m'.
+ The test expression returns 2 values.
-Warning: Deprecated identifier `deprecated-foo2'
- In module `m',
- In procedure `toplevel-foo',
- In procedure `local-bar',
- In procedure `r-deprecated-identifier',
- In expression:
+ It is a call to `values' from module `scheme' which has this type:
- m#deprecated-foo2
+ (procedure (#!rest values) . *)
- Use of deprecated identifier `deprecated-foo2' from module `m'.
+ This is the expression:
- The suggested alternative is `foo'.
+ (scheme#values (the * 1) 2)
-Warning: Negative list index
+Warning: Let binding to `a' has 2 values
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.
+ In procedure `too-many-values-for-let',
+ In let expression:
-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:
+ (let ((a (scheme#values 1 2))) a)
- (scheme#list-ref '() 1)
+ Variable `a' is bound to an expression that returns 2 values.
- Procedure `list-ref' from module `scheme' is called with index `1' for a list of length `0'.
+ It is a call to `values' from module `scheme' which has this type:
-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:
+ (procedure (#!rest values) . *)
- (scheme#vector-ref (scheme#vector) -1)
+ This is the expression:
- Procedure `vector-ref' from module `scheme' is called with a negative index -1.
+ (scheme#values 1 2)
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 +787,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 +808,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 +829,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 +843,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:
+
+ (procedure (#!rest values) . *)
+
+ This is the expression:
+
+ (scheme#values)
-Warning: Let binding to `gXXX' has 2 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 +885,154 @@ 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.
+
+Warning: Type mismatch
+ In module `m',
+ In procedure `toplevel-foo',
+ In procedure `local-bar',
+ In procedure `format-clashing-typevars',
+ In expression:
+
+ (the (forall (cXXX aXXX) (list aXXX cXXX symbol)) (scheme#list 1 2 'x))
+
+ Expression's declared and actual types do not match.
+
+ The declared type is:
+
+ (list 'aXXX 'bXXX fixnum)
+
+ The actual type is:
+
+ (list 'aXXX 'cXXX symbol)
+
+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..141aa466 100644
--- a/tests/test-scrutinizer-message-format.scm
+++ b/tests/test-scrutinizer-message-format.scm
@@ -8,16 +8,19 @@
(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-cond-branch-value-count-mismatch) (if (the * 1) 1 (values 1 2)))
+(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))
@@ -25,12 +28,8 @@
(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 (fail-compiler-typecase) (compiler-typecase 1 (symbol 1) (list 2)))
@@ -50,28 +49,50 @@
(define (toplevel-foo)
(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-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) (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))
(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! 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 (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 (format-clashing-typevars)
+ (the (list 'a 'b fixnum) (the (list 'a 'c symbol) (list 1 2 'x))))
+
+ (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
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
