>From 31fb81476437c09c998c03bd80fd32745c20b51a Mon Sep 17 00:00:00 2001 From: Evan Hanson Date: Thu, 23 Aug 2018 19:07:32 +1200 Subject: [PATCH] Drop module namespace from struct type in `##sys#make-structure' specialisation This addresses issue #1513 for the time being, although we may want to make the compiler more intelligent about struct types from modules in the future. --- scrutinizer.scm | 14 ++++++++- tests/scrutiny-tests.scm | 6 ++++ tests/scrutiny.expected | 74 ++++++++++++++++++++++++------------------------ 3 files changed, 56 insertions(+), 38 deletions(-) diff --git a/scrutinizer.scm b/scrutinizer.scm index ece07ed3..e30d81be 100644 --- a/scrutinizer.scm +++ b/scrutinizer.scm @@ -2132,6 +2132,18 @@ (else t))) +;;; Drop namespace from module-prefixed symbol: + +(define (strip-namespace sym) + (let* ((s (symbol->string sym)) + (n (string-length s))) + (let loop ((i 0)) + (cond ((eq? i n) sym) + ((eq? (##core#inline "C_subchar" s i) #\#) + (##sys#intern-symbol (##sys#substring s (fx+ i 1) n))) + (else (loop (fx+ i 1))))))) + + ;;; hardcoded result types for certain primitives (define-syntax define-special-case @@ -2151,7 +2163,7 @@ ;; "pointer-vector" type. (if (eq? 'pointer-vector val) '(pointer-vector) - `((struct ,val)))) + `((struct ,(strip-namespace val))))) rtypes))) (let () diff --git a/tests/scrutiny-tests.scm b/tests/scrutiny-tests.scm index 96757b7e..b0516716 100644 --- a/tests/scrutiny-tests.scm +++ b/tests/scrutiny-tests.scm @@ -144,6 +144,12 @@ (define-type footype string) (the footype "bar")) +;; Record type tags with module namespaces should not warn (#1513) +(module foo * + (import (scheme) (chicken base) (chicken type)) + (: make-foo (string --> (struct foo))) + (define-record foo bar)) + (: deprecated-procedure deprecated) (define (deprecated-procedure x) (+ x x)) (deprecated-procedure 1) diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected index 44afef85..665d7008 100644 --- a/tests/scrutiny.expected +++ b/tests/scrutiny.expected @@ -102,114 +102,114 @@ Warning: at toplevel: use of deprecated `another-deprecated-procedure' - consider `replacement-procedure' Warning: at toplevel: - (scrutiny-tests.scm:162) in procedure call to `apply1', expected argument #2 of type `(list-of number)' but was given an argument of type `(list symbol fixnum fixnum)' + (scrutiny-tests.scm:168) in procedure call to `apply1', expected argument #2 of type `(list-of number)' but was given an argument of type `(list symbol fixnum fixnum)' Warning: at toplevel: - (scrutiny-tests.scm:163) in procedure call to `apply1', expected argument #2 of type `(list-of number)' but was given an argument of type `(list symbol fixnum fixnum)' + (scrutiny-tests.scm:169) in procedure call to `apply1', expected argument #2 of type `(list-of number)' but was given an argument of type `(list symbol fixnum fixnum)' Note: at toplevel: - (scrutiny-tests.scm:176) in procedure call to `chicken.base#fixnum?', the predicate is called with an argument of type `fixnum' and will always return true + (scrutiny-tests.scm:182) in procedure call to `chicken.base#fixnum?', the predicate is called with an argument of type `fixnum' and will always return true Note: at toplevel: - (scrutiny-tests.scm:184) in procedure call to `scheme#symbol?', the predicate is called with an argument of type `(or char string)' and will always return false + (scrutiny-tests.scm:190) in procedure call to `scheme#symbol?', the predicate is called with an argument of type `(or char string)' and will always return false Note: at toplevel: - (scrutiny-tests.scm:185) in procedure call to `scheme#string?', the predicate is called with an argument of type `(not (or char string))' and will always return false + (scrutiny-tests.scm:191) in procedure call to `scheme#string?', the predicate is called with an argument of type `(not (or char string))' and will always return false Note: at toplevel: - (scrutiny-tests.scm:188) in procedure call to `char-or-string?', the predicate is called with an argument of type `fixnum' and will always return false + (scrutiny-tests.scm:194) in procedure call to `char-or-string?', the predicate is called with an argument of type `fixnum' and will always return false Note: at toplevel: - (scrutiny-tests.scm:189) in procedure call to `scheme#symbol?', the predicate is called with an argument of type `(or char string)' and will always return false + (scrutiny-tests.scm:195) in procedure call to `scheme#symbol?', the predicate is called with an argument of type `(or char string)' and will always return false Note: at toplevel: - (scrutiny-tests.scm:190) in procedure call to `scheme#string?', the predicate is called with an argument of type `fixnum' and will always return false + (scrutiny-tests.scm:196) in procedure call to `scheme#string?', the predicate is called with an argument of type `fixnum' and will always return false Note: at toplevel: - (scrutiny-tests.scm:194) in procedure call to `scheme#symbol?', the predicate is called with an argument of type `char' and will always return false + (scrutiny-tests.scm:200) in procedure call to `scheme#symbol?', the predicate is called with an argument of type `char' and will always return false Note: at toplevel: - (scrutiny-tests.scm:195) in procedure call to `scheme#string?', the predicate is called with an argument of type `symbol' and will always return false + (scrutiny-tests.scm:201) in procedure call to `scheme#string?', the predicate is called with an argument of type `symbol' and will always return false Note: at toplevel: - (scrutiny-tests.scm:199) in procedure call to `scheme#symbol?', the predicate is called with an argument of type `(or char string)' and will always return false + (scrutiny-tests.scm:205) in procedure call to `scheme#symbol?', the predicate is called with an argument of type `(or char string)' and will always return false Note: at toplevel: - (scrutiny-tests.scm:200) in procedure call to `scheme#string?', the predicate is called with an argument of type `symbol' and will always return false + (scrutiny-tests.scm:206) in procedure call to `scheme#string?', the predicate is called with an argument of type `symbol' and will always return false Warning: at toplevel: - (scrutiny-tests.scm:204) in procedure call to `f', expected argument #1 of type `pair' but was given an argument of type `null' + (scrutiny-tests.scm:210) in procedure call to `f', expected argument #1 of type `pair' but was given an argument of type `null' Warning: at toplevel: - (scrutiny-tests.scm:206) in procedure call to `f', expected argument #1 of type `null' but was given an argument of type `(list fixnum)' + (scrutiny-tests.scm:212) in procedure call to `f', expected argument #1 of type `null' but was given an argument of type `(list fixnum)' Warning: at toplevel: - (scrutiny-tests.scm:208) in procedure call to `f', expected argument #1 of type `list' but was given an argument of type `(pair fixnum fixnum)' + (scrutiny-tests.scm:214) in procedure call to `f', expected argument #1 of type `list' but was given an argument of type `(pair fixnum fixnum)' Warning: in toplevel procedure `vector-ref-warn1': - (scrutiny-tests.scm:214) in procedure call to `scheme#vector-ref', index -1 out of range for vector of length 3 + (scrutiny-tests.scm:220) in procedure call to `scheme#vector-ref', index -1 out of range for vector of length 3 Warning: in toplevel procedure `vector-ref-warn2': - (scrutiny-tests.scm:216) in procedure call to `scheme#vector-ref', index 3 out of range for vector of length 3 + (scrutiny-tests.scm:222) in procedure call to `scheme#vector-ref', index 3 out of range for vector of length 3 Warning: in toplevel procedure `vector-ref-warn3': - (scrutiny-tests.scm:217) in procedure call to `scheme#vector-ref', index 4 out of range for vector of length 3 + (scrutiny-tests.scm:223) in procedure call to `scheme#vector-ref', index 4 out of range for vector of length 3 Warning: in toplevel procedure `vector-ref-standard-warn1': - (scrutiny-tests.scm:220) in procedure call to `scheme#vector-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' + (scrutiny-tests.scm:226) in procedure call to `scheme#vector-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' Warning: in toplevel procedure `vector-set!-warn1': - (scrutiny-tests.scm:221) in procedure call to `scheme#vector-set!', index -1 out of range for vector of length 3 + (scrutiny-tests.scm:227) in procedure call to `scheme#vector-set!', index -1 out of range for vector of length 3 Warning: in toplevel procedure `vector-set!-warn2': - (scrutiny-tests.scm:222) in procedure call to `scheme#vector-set!', index 3 out of range for vector of length 3 + (scrutiny-tests.scm:228) in procedure call to `scheme#vector-set!', index 3 out of range for vector of length 3 Warning: in toplevel procedure `vector-set!-warn3': - (scrutiny-tests.scm:223) in procedure call to `scheme#vector-set!', index 4 out of range for vector of length 3 + (scrutiny-tests.scm:229) in procedure call to `scheme#vector-set!', index 4 out of range for vector of length 3 Warning: in toplevel procedure `vector-set!-standard-warn1': - (scrutiny-tests.scm:226) in procedure call to `scheme#vector-set!', expected argument #2 of type `fixnum' but was given an argument of type `symbol' + (scrutiny-tests.scm:232) in procedure call to `scheme#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 `scheme#list-ref', index -1 is negative, which is never valid + (scrutiny-tests.scm:238) in procedure call to `scheme#list-ref', index -1 is negative, which is never valid Warning: in toplevel procedure `list-ref-warn2': - (scrutiny-tests.scm:235) in procedure call to `scheme#list-ref', index -1 is negative, which is never valid + (scrutiny-tests.scm:241) in procedure call to `scheme#list-ref', index -1 is negative, which is never valid Warning: in toplevel procedure `list-ref-warn3': - (scrutiny-tests.scm:238) in procedure call to `scheme#list-ref', index -1 is negative, which is never valid + (scrutiny-tests.scm:244) in procedure call to `scheme#list-ref', index -1 is negative, which is never valid Warning: in toplevel procedure `list-ref-warn4': - (scrutiny-tests.scm:240) in procedure call to `scheme#list-ref', index 3 out of range for proper list of length 3 + (scrutiny-tests.scm:246) in procedure call to `scheme#list-ref', index 3 out of range for proper list of length 3 Warning: in toplevel procedure `list-ref-warn5': - (scrutiny-tests.scm:246) in procedure call to `scheme#list-ref', index 4 out of range for proper list of length 3 + (scrutiny-tests.scm:252) in procedure call to `scheme#list-ref', index 4 out of range for proper list of length 3 Warning: in toplevel procedure `list-ref-standard-warn1': - (scrutiny-tests.scm:275) in procedure call to `scheme#list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' + (scrutiny-tests.scm:281) in procedure call to `scheme#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:276) in procedure call to `scheme#list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' + (scrutiny-tests.scm:282) in procedure call to `scheme#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 `scheme#list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' + (scrutiny-tests.scm:284) in procedure call to `scheme#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 `scheme#list-ref', expected argument #2 of type `fixnum' but was given an argument of type `symbol' + (scrutiny-tests.scm:285) in procedure call to `scheme#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 `chicken.base#add1', expected argument #1 of type `number' but was given an argument of type `symbol' + (scrutiny-tests.scm:289) in procedure call to `chicken.base#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 `chicken.base#add1', expected argument #1 of type `number' but was given an argument of type `symbol' + (scrutiny-tests.scm:291) in procedure call to `chicken.base#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 `chicken.base#add1', expected argument #1 of type `number' but was given an argument of type `symbol' + (scrutiny-tests.scm:295) in procedure call to `chicken.base#add1', expected argument #1 of type `number' but was given an argument of type `symbol' Warning: in toplevel procedure `append-result-type-warn1': - (scrutiny-tests.scm:301) in procedure call to `chicken.base#add1', expected argument #1 of type `number' but was given an argument of type `symbol' + (scrutiny-tests.scm:307) in procedure call to `chicken.base#add1', expected argument #1 of type `number' but was given an argument of type `symbol' Warning: in toplevel procedure `append-result-type-warn2': - (scrutiny-tests.scm:306) in procedure call to `chicken.base#add1', expected argument #1 of type `number' but was given an argument of type `symbol' + (scrutiny-tests.scm:312) in procedure call to `chicken.base#add1', expected argument #1 of type `number' but was given an argument of type `symbol' Warning: redefinition of standard binding: scheme#car -- 2.11.0