chicken-hackers
[Top][All Lists]
Advanced

[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


reply via email to

[Prev in Thread] Current Thread [Next in Thread]