Ensure no-change-test programs compile

Author: jackfirth

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))
 ------------------------------
 

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)

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))