[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Chicken-hackers] [PATCH] Fix arguments to scrutiny reporting proced
From: |
megane |
Subject: |
Re: [Chicken-hackers] [PATCH] Fix arguments to scrutiny reporting procedure for `append' |
Date: |
Mon, 25 Mar 2019 14:23:57 +0200 |
User-agent: |
mu4e 1.0; emacs 25.1.1 |
Evan Hanson <address@hidden> writes:
> Hi folks,
>
> Here's a patch that fixes #1592, which was also discovered by Kooda in
> IRC this morning.
>
> I'm pretty sure I introduced this bug while applying megane's patches,
> or at least made the problem worse. In my defense, the variable names in
> this bit of code didn't help, so this patch also tries to address that.
> The commit message has the details.
>
The last patchset contained a more comprehensive message format test
suite. I guess I just forgot to mention that, sorry :P
Here's a patch that applies on top of this fix.
>From 5cac6464f29b660745bbaef2bbe8cc4a2c43302f Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Mon, 25 Mar 2019 14:15:19 +0200
Subject: [PATCH] Make scrutinizer message format test suite more comprehensive
---
tests/scrutinizer-message-format.expected | 518 ++++++++++++++++++------------
tests/test-scrutinizer-message-format.scm | 55 +++-
2 files changed, 352 insertions(+), 221 deletions(-)
diff --git a/tests/scrutinizer-message-format.expected
b/tests/scrutinizer-message-format.expected
index f6f3b25..3adf131 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -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)
+ (scheme#append 1 (scheme#list 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:
+ Argument #1 to procedure `append' has an invalid type:
- (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',
@@ -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,46 @@ 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: 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 +681,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 +767,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)
@@ -809,17 +783,39 @@ Warning: Let binding to `a' has 2 values
(scheme#values 1 2)
-Warning: Zero values for conditional
+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 `zero-values-for-conditional',
+ In procedure `r-conditional-value-count-invalid',
+ In procedure `too-many-values-for-conditional',
In conditional:
- (if (scheme#values) 1 (##core#undefined))
+ (if (scheme#values (the * 1) 2) 1 (##core#undefined))
+
+ The test expression returns 2 values.
+
+ It is a call to `values' from module `scheme' which has this type:
+
+ (procedure (#!rest values) . *)
+
+ This is the expression:
- The test expression returns 0 values.
+ (scheme#values (the * 1) 2)
+
+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 `r-assignment-value-count-invalid',
+ 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:
@@ -829,17 +825,18 @@ Warning: Zero values for conditional
(scheme#values)
-Warning: Too many values for conditional
+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 conditional:
+ 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))
- The test expression 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:
@@ -847,41 +844,154 @@ Warning: Too many values for conditional
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 (baz106 foo107) (list foo107 baz106 symbol)) (scheme#list 1 2
'a))
+
+ Expression's declared and actual types do not match.
+
+ The declared type is:
+
+ (list 'foo105 'bar104 fixnum)
+
+ The actual type is:
+
+ (list 'foo107 'baz106 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 `multiple-values-for-conditional',
+ In procedure `r-cond-test-always-true-with-pred',
In conditional expression:
- (if (scheme#values 1 2) 1 (##core#undefined))
+ (if (scheme#symbol? 'symbol) 1 (##core#undefined))
Test condition has always true value of type:
- fixnum
+ true
-Warning: Let binding to `gXXX' has 2 values
+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 `multiple-values-for-conditional',
- In let expression:
+ In procedure `r-cond-test-always-false-with-pred',
+ In procedure call:
- (if (scheme#values 1 2) 1 (##core#undefined))
+ (scheme#symbol? 1)
- Variable `gXXX' is bound to an expression that returns 2 values.
+ The predicate will always return false.
- It is a call to `values' from module `scheme' which has this type:
+ Procedure `symbol?' from module `scheme' is a predicate for:
- (procedure (#!rest values) . *)
+ symbol
- This is the expression:
+ The given argument has this type:
- (scheme#values 1 2)
+ 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 d792cf3..ff976b3 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 'foo 'bar fixnum) (the (list 'foo 'baz symbol) (list 1 2
'a))))
+
+ (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.7.4
Re: [Chicken-hackers] [PATCH] Fix arguments to scrutiny reporting procedure for `append', Peter Bex, 2019/03/29