>From 1296b60861ffa567a4d497864a066d05d5312e09 Mon Sep 17 00:00:00 2001 From: Evan Hanson Date: Mon, 27 Jan 2014 21:48:12 +1300 Subject: [PATCH] Fix validation for multiple-return procedure types Validation for procedure types like (a -> . b) relied on the pre-0a52536 behavior of memq, where a failed search on an improper list would return false rather than raise an error. After that change, such types are rejected as invalid, so this adds a local memq variant to the scrutinizer that reproduces the old behavior, as a workaround to re-support this type syntax. --- scrutinizer.scm | 9 +++++++-- tests/scrutiny-tests.scm | 3 +++ 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/scrutinizer.scm b/scrutinizer.scm index e29e847..695a757 100644 --- a/scrutinizer.scm +++ b/scrutinizer.scm @@ -1948,6 +1948,11 @@ (let loop ((lst lst)) (cond ((eq? lst p) '()) (else (cons (car lst) (loop (cdr lst))))))) + (define (memq* x lst) ; memq, but allow improper list + (let loop ((lst lst)) + (cond ((not (pair? lst)) #f) + ((eq? (car lst) x) lst) + (else (loop (cdr lst)))))) (define (validate-llist llist) (cond ((null? llist) '()) ((symbol? llist) '(#!rest *)) @@ -2029,12 +2034,12 @@ t)) ((eq? 'deprecated (car t)) (and (= 2 (length t)) (symbol? (second t)) t)) - ((and (list? t) (or (memq '--> t) (memq '-> t))) => + ((or (memq* '--> t) (memq* '-> t)) => (lambda (p) (let* ((cleanf (eq? '--> (car p))) (ok (or (not rec) (not cleanf)))) (unless rec (set! clean cleanf)) - (let ((cp (memq ': (cdr p)))) + (let ((cp (memq* ': p))) (cond ((not cp) (and ok (validate diff --git a/tests/scrutiny-tests.scm b/tests/scrutiny-tests.scm index 67ce5a5..3ac754f 100644 --- a/tests/scrutiny-tests.scm +++ b/tests/scrutiny-tests.scm @@ -158,3 +158,6 @@ (apply1 + (list 'a 2 3)) ; <- no type warning (#948) (apply1 + (cons 'a (cons 2 (cons 3 '())))) ; <- same here (#952) +;; multiple-value return syntax +(: mv (-> . *)) +(: mv (procedure () . *)) -- 1.7.10.4