From 4437dec23c69b42de37f825d637f1cd61fb34b6c Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sun, 24 Jul 2016 15:37:11 +0200 Subject: [PATCH] Do not warn for out of range indices into possibly smashed list types. When a list is smashed, usually ends up as (or pair null). If then we cons something onto it, it's seen as a list of length 1 or possibly 2. We should *not* give a warning on (list-ref 3 that-list), because it may originally have been a list of a greater length. We don't know that, so we should avoid warning for anything that's not absolutely sure to be a proper list. Luckily, if it's typed as a proper list, that's presumably safe. That's because a list with smashed components should end in just "pair", due to possible mutation by set-cdr!, which means its type is not that of a proper list. We still always warn when list-ref takes a negative index, because that's never ever valid, regardless of the argument list type. We still always preserve types when using list-ref, even on a list with smashed components, as long as the list is known to contain the index. Conflicts: scrutinizer.scm --- NEWS | 2 +- scrutinizer.scm | 40 ++++++++++++++++++++++--------- tests/scrutiny-tests.scm | 61 ++++++++++++++++++++++++++++++++++++++++-------- tests/scrutiny.expected | 32 +++++++++++++++++-------- 4 files changed, 103 insertions(+), 32 deletions(-) diff --git a/NEWS b/NEWS index de54596..d4eb49d 100644 --- a/NEWS +++ b/NEWS @@ -57,7 +57,7 @@ - define-constant now correctly keeps symbol values quoted. - Warnings are now emitted when using vector-{ref,set!} or one of take, drop, list-ref or list-tail with an out of range index - for vectors and lists of a definitely known length. + for vectors and proper lists of a definitely known length. - The scrutinizer will no longer drop knowledge of the length of a vector. It still drops types of its contents (which may be mutated). diff --git a/scrutinizer.scm b/scrutinizer.scm index 9eb0052..b143b0c 100644 --- a/scrutinizer.scm +++ b/scrutinizer.scm @@ -2232,6 +2232,7 @@ ;; Split a list or pair type form at index i, calling k with the two ;; sections of the type or returning #f if it doesn't match that far. + ;; Note that "list-of" is handled by "forall" entries in types.db (define (split-list-type l i k) (cond ((not (pair? l)) (and (fx= i 0) (eq? l 'null) (k l l))) @@ -2252,6 +2253,13 @@ (else #f)))) (else #f))) + ;; canonicalize-list-type will have taken care of converting (pair + ;; (pair ...)) to (list ...) or (list-of ...) for proper lists. + (define (proper-list-type-length t) + (cond ((eq? t 'null) 0) + ((and (pair? t) (eq? (car t) 'list)) (length (cdr t))) + (else #f))) + (define (list+index-call-result-type-special-case k) (lambda (node args loc rtypes) (or (and-let* ((subs (node-subexpressions node)) @@ -2261,17 +2269,27 @@ ((eq? 'quote (node-class index))) (val (first (node-parameters index))) ((fixnum? val))) ; Standard type warning otherwise - (or (and (>= val 0) (split-list-type arg1 val k)) - (begin - (report - loc "~ain procedure call to `~a', index ~a out of \ - range for list of type ~a" - (node-source-prefix node) - ;; TODO: It might make more sense to use - ;; "pname" here - (first (node-parameters (first subs))) - val arg1) - #f))) + ;; TODO: It might make sense to use "pname" when reporting + (cond ((negative? val) + ;; Negative indices should always generate a warning + (report + loc "~ain procedure call to `~a', index ~a is \ + negative, which is never valid" + (node-source-prefix node) + (first (node-parameters (first subs))) val) + #f) + ((split-list-type arg1 val k)) + ;; Warn only if it's a known proper list. This avoids + ;; false warnings due to component smashing. + ((proper-list-type-length arg1) => + (lambda (length) + (report + loc "~ain procedure call to `~a', index ~a out of \ + range for proper list of length ~a" + (node-source-prefix node) + (first (node-parameters (first subs))) val length) + #f)) + (else #f))) rtypes))) (define-special-case list-ref diff --git a/tests/scrutiny-tests.scm b/tests/scrutiny-tests.scm index dadf2c6..a9f1942 100644 --- a/tests/scrutiny-tests.scm +++ b/tests/scrutiny-tests.scm @@ -230,27 +230,68 @@ ;; otherwise we won't get the warnings for subsequent references. (let ((l1 (list 'a 'b 'c))) (define (list-ref-warn1) (list-ref l1 -1))) +;; This warns regardless of not knowing the length of the list (let ((l2 (cons 'a (cons 'b (cons 'c (eval '(list))))))) (define (list-ref-warn2) (list-ref l2 -1))) +;; Not knowing the length of a "list-of" is not an issue here +(let ((l3 (the (list-of symbol) '(x y z)))) + (define (list-ref-warn3) (list-ref l3 -1))) (let ((l1 (list 'a 'b 'c))) - (define (list-ref-warn3) (list-ref l1 3))) -(let ((l2 (cons 'a (cons 'b (cons 'c (eval '(list))))))) - (define (list-ref-warn4) (list-ref l2 3))) + (define (list-ref-warn4) (list-ref l1 3))) +;; This can't warn: it strictly doesn't know the length of the list. +;; The eval could return a list of length >= 1! +#;(let ((l2 (cons 'a (cons 'b (cons 'c (eval '(list))))))) + (define (list-ref-warn5) (list-ref l2 3))) (let ((l1 (list 'a 'b 'c))) (define (list-ref-warn5) (list-ref l1 4))) -(let ((l2 (cons 'a (cons 'b (cons 'c (eval '(list))))))) +;; Same as above +#;(let ((l2 (cons 'a (cons 'b (cons 'c (eval '(list))))))) (define (list-ref-warn6) (list-ref l2 4))) +;; We add the second check to ensure that we don't give false warnings +;; for smashed types, because we don't know the original size. +(let ((l1 (list 'a 'b 'c))) + (define (list-ref-nowarn1) (list-ref l1 0)) + (define (list-ref-nowarn2) (list-ref l1 0))) +(let ((l2 (cons 'a (cons 'b (cons 'c (eval '(list))))))) + (define (list-ref-nowarn3) (list-ref l2 0)) + (define (list-ref-nowarn4) (list-ref l2 0))) (let ((l1 (list 'a 'b 'c))) - (define (list-ref-nowarn1) (list-ref l1 0))) + (define (list-ref-nowarn5) (list-ref l1 2)) + (define (list-ref-nowarn6) (list-ref l1 2))) +(let ((l2 (cons 'a (cons 'b (cons 'c (eval '(list))))))) + (define (list-ref-nowarn7) (list-ref l2 2)) + (define (list-ref-nowarn8) (list-ref l2 2))) +;; Verify that we don't give bogus warnings, like mentioned above. (let ((l2 (cons 'a (cons 'b (cons 'c (eval '(list))))))) - (define (list-ref-nowarn2) (list-ref l2 0))) + (define (list-ref-nowarn9) (list-ref l2 5))) +;; We don't know the length of a "list-of", so we can't warn +(let ((l3 (the (list-of symbol) '(x y z)))) + (define (list-ref-nowarn10) (list-ref l3 100))) + +;; The second check here should still give a warning, this has +;; nothing to do with component smashing. (let ((l1 (list 'a 'b 'c))) - (define (list-ref-nowarn3) (list-ref l1 2))) + (define (list-ref-standard-warn1) (list-ref l1 'bad)) + (define (list-ref-standard-warn2) (list-ref l1 'bad))) (let ((l2 (cons 'a (cons 'b (cons 'c (eval '(list))))))) - (define (list-ref-nowarn4) (list-ref l2 2))) + (define (list-ref-standard-warn3) (list-ref l2 'bad)) + (define (list-ref-standard-warn4) (list-ref l2 'bad))) +;; Test type preservation of list-ref (let ((l1 (list 'a 'b 'c))) - (define (list-ref-standard-warn1) (list-ref l1 'bad))) + (define (list-ref-type-warn1) (add1 (list-ref l1 1)))) (let ((l2 (cons 'a (cons 'b (cons 'c (eval '(list))))))) - (define (list-ref-standard-warn2) (list-ref l2 'bad))) + (define (list-ref-type-warn2) (add1 (list-ref l2 1)))) +;; This is handled by the list-ref entry in types.db, *not* the +;; special-cased code. +(let ((l3 (the (list-of symbol) '(a b c)))) + (define (list-ref-type-warn3) (add1 (list-ref l3 1)))) + +;; Sanity check +(let ((l1 (list 1 2 3))) + (define (list-ref-type-nowarn1) (add1 (list-ref l1 1)))) +(let ((l2 (cons 1 (cons 2 (cons 3 (eval '(list))))))) + (define (list-ref-type-nowarn2) (add1 (list-ref l2 1)))) +(let ((l3 (the (list-of fixnum) '(1 2 3)))) + (define (list-ref-type-nowarn3) (add1 (list-ref l3 1)))) diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected index 8446362..7d02af3 100644 --- a/tests/scrutiny.expected +++ b/tests/scrutiny.expected @@ -171,27 +171,39 @@ Warning: in toplevel procedure `vector-set!-standard-warn1': (scrutiny-tests.scm:226) in procedure call to `vector-set!', expected argument #2 of type `fixnum' but was given an argument of type `symbol' Warning: in toplevel procedure `list-ref-warn1': - (scrutiny-tests.scm:232) in procedure call to `list-ref', index -1 out of range for list of type (list symbol symbol symbol) + (scrutiny-tests.scm:232) in procedure call to `list-ref', index -1 is negative, which is never valid Warning: in toplevel procedure `list-ref-warn2': - (scrutiny-tests.scm:234) in procedure call to `list-ref', index -1 out of range for list of type (pair symbol (pair symbol (pair symbol *))) + (scrutiny-tests.scm:235) in procedure call to `list-ref', index -1 is negative, which is never valid Warning: in toplevel procedure `list-ref-warn3': - (scrutiny-tests.scm:236) in procedure call to `list-ref', index 3 out of range for list of type (list symbol symbol symbol) + (scrutiny-tests.scm:238) in procedure call to `list-ref', index -1 is negative, which is never valid Warning: in toplevel procedure `list-ref-warn4': - (scrutiny-tests.scm:238) in procedure call to `list-ref', index 3 out of range for list of type (pair symbol (pair symbol (pair symbol *))) + (scrutiny-tests.scm:240) in procedure call to `list-ref', index 3 out of range for proper list of length 3 Warning: in toplevel procedure `list-ref-warn5': - (scrutiny-tests.scm:240) in procedure call to `list-ref', index 4 out of range for list of type (list symbol symbol symbol) - -Warning: in toplevel procedure `list-ref-warn6': - (scrutiny-tests.scm:242) in procedure call to `list-ref', index 4 out of range for list of type (pair symbol (pair symbol (pair symbol *))) + (scrutiny-tests.scm:246) in procedure call to `list-ref', index 4 out of range for proper list of length 3 Warning: in toplevel procedure `list-ref-standard-warn1': - (scrutiny-tests.scm:254) in procedure call to `list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' + (scrutiny-tests.scm:275) in procedure call to `list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' Warning: in toplevel procedure `list-ref-standard-warn2': - (scrutiny-tests.scm:256) in procedure call to `list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' + (scrutiny-tests.scm:276) in procedure call to `list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' + +Warning: in toplevel procedure `list-ref-standard-warn3': + (scrutiny-tests.scm:278) in procedure call to `list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' + +Warning: in toplevel procedure `list-ref-standard-warn4': + (scrutiny-tests.scm:279) in procedure call to `list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' + +Warning: in toplevel procedure `list-ref-type-warn1': + (scrutiny-tests.scm:283) in procedure call to `add1', expected argument #1 of type `number' but was given an argument of type `symbol' + +Warning: in toplevel procedure `list-ref-type-warn2': + (scrutiny-tests.scm:285) in procedure call to `add1', expected argument #1 of type `number' but was given an argument of type `symbol' + +Warning: in toplevel procedure `list-ref-type-warn3': + (scrutiny-tests.scm:289) in procedure call to `add1', expected argument #1 of type `number' but was given an argument of type `symbol' Warning: redefinition of standard binding: car -- 2.1.4