diff --git a/default-recommendations/match-shortcuts-test.rkt b/default-recommendations/match-shortcuts-test.rkt index 487e4a58..b0c50b4d 100644 --- a/default-recommendations/match-shortcuts-test.rkt +++ b/default-recommendations/match-shortcuts-test.rkt @@ -440,10 +440,10 @@ no-change-test: "list element variable definitions not refactorable when referen no-change-test: "list element variable definitions not refactorable when referencing list expressions" ------------------------------ -(define (f pt-list) - (define x (list-ref (first pt-list) 0)) - (define y (list-ref (first pt-list) 1)) - (define z (list-ref (first pt-list) 2)) +(define (f pt-func) + (define x (list-ref (pt-func) 0)) + (define y (list-ref (pt-func) 1)) + (define z (list-ref (pt-func) 2)) (+ x y z)) ------------------------------ diff --git a/private/source.rkt b/private/source.rkt index d86c3501..b4f26ba3 100644 --- a/private/source.rkt +++ b/private/source.rkt @@ -15,6 +15,7 @@ [source-original (-> source? unmodified-source?)] [source-read-syntax (-> source? syntax?)] [source-read-language (-> source? (or/c module-path? #false))] + [source-expand (-> source? syntax?)] [source-text-of (-> source? syntax? immutable-string?)] [file-source? (-> any/c boolean?)] [file-source (-> path-string? file-source?)] @@ -127,6 +128,10 @@ (check-equal? (source-read-language (string-source "(void)")) #false))) +(define (source-expand code) + (expand (source-read-syntax code))) + + (define/guard (source-path code) (guard-match (or (file-source path) (modified-source (file-source path) _)) code #:else #false) path) diff --git a/test/private/rackunit.rkt b/test/private/rackunit.rkt index ceeacd86..b82a5060 100644 --- a/test/private/rackunit.rkt +++ b/test/private/rackunit.rkt @@ -22,6 +22,7 @@ rackunit rebellion/base/comparator rebellion/base/range + rebellion/base/result rebellion/collection/entry rebellion/collection/hash rebellion/collection/list @@ -206,8 +207,8 @@ (define-check (check-suite-does-not-refactor original-program) (define suite (current-suite-under-test)) (set! original-program (code-block-append (current-header) original-program)) + (fail-unless-program-compiles original-program) (define-values (call-with-logs-captured build-logs-info) (make-log-capture-utilities)) - (define result-set (call-with-logs-captured (λ () @@ -227,6 +228,19 @@ (fail-check "the program was not changed, but no-op fixes were suggested")))))) +(define (fail-unless-program-compiles program) + (define src (string-source (code-block-raw-string program))) + (define expansion-result + (parameterize ([current-namespace (make-base-namespace)]) + (result (source-expand src)))) + (match expansion-result + [(? success?) (void)] + [(failure e) + (with-check-info (['actual (string-block-info (code-block-raw-string program))] + ['exception e]) + (fail-check "the program raised an error when compiled and couldn't be analyzed"))])) + + (define-check (check-suite-analysis program context-list target property-key expected-value) (define suite (current-suite-under-test)) (set! program (code-block-append (current-header) program))