Filter out refactoring suggestions that produce non-compiling code

main.rkt

@@ -214,7 +214,19 @@
       (refactor-visited-forms
        #:analysis analysis #:suite effective-suite #:comments comments #:lines lines)))
 
-  (refactoring-result-set #:base-source source #:results results))
+  (define result-set (refactoring-result-set #:base-source source #:results results))
+
+  ;; Filter out result sets that produce non-compiling code
+  (cond
+    [(and (not (empty? results))
+          (not (refactoring-result-set-compiles? result-set)))
+     (log-resyntax-warning
+      "dropping ~a refactoring suggestion~a for ~a because the modified code does not compile"
+      (length results)
+      (if (equal? (length results) 1) "" "s")
+      (or (source-path source) "string source"))
+     (refactoring-result-set #:base-source source #:results '())]
+    [else result-set]))
 
 
 (define/guard (reysntax-analyze-for-properties-only source #:suite [suite default-recommendations])
@@ -335,6 +347,18 @@
              (grouping into-list)
              (mapping
               (λ (e) (refactoring-result-set #:base-source (entry-key e) #:results (entry-value e))))
+             (filtering
+              (λ (result-set)
+                (define compiles? (refactoring-result-set-compiles? result-set))
+                (unless compiles?
+                  (define source (refactoring-result-set-base-source result-set))
+                  (define num-results (length (refactoring-result-set-results result-set)))
+                  (log-resyntax-warning
+                   "dropping ~a refactoring suggestion~a for ~a because the modified code does not compile"
+                   num-results
+                   (if (equal? num-results 1) "" "s")
+                   (or (source-path source) "string source")))
+                compiles?))
              (indexing refactoring-result-set-base-source)
              #:into into-hash))
 
@@ -478,4 +502,28 @@
     (check-false (set-empty? (refactoring-suite-analyzers test-suite)))
     ;; Verify that all analyzers in the suite are expansion-analyzer?
     (check-true (for/and ([analyzer (in-set (refactoring-suite-analyzers test-suite))])
-                  (expansion-analyzer? analyzer)))))
+                  (expansion-analyzer? analyzer))))
+
+  (test-case "broken refactoring rules are filtered out"
+    ;; Define a refactoring rule that produces code that doesn't compile
+    (define-refactoring-rule breaking-rule
+      #:description "Breaking refactoring rule"
+      #:datum-literals (foo)
+      #:literals (define)
+      (define foo 42)
+      (if))
+
+    (define breaking-suite (refactoring-suite #:rules (list breaking-rule)))
+    (define test-source (string-source "#lang racket/base\n\n(define foo 42)\n"))
+
+    ;; Test with direct analyze
+    (define result-set (resyntax-analyze test-source #:suite breaking-suite))
+    (check-equal? (length (refactoring-result-set-results result-set)) 0
+                  "Breaking suggestions should be filtered from resyntax-analyze")
+
+    ;; Test with multipass analyze
+    (define analysis
+      (resyntax-analyze-all (hash test-source (range-set (unbounded-range #:comparator natural<=>)))
+                            #:suite breaking-suite))
+    (check-equal? (resyntax-analysis-total-fixes analysis) 0
+                  "Breaking suggestions should be filtered from resyntax-analyze-all")))

private/refactoring-result.rkt

@@ -31,6 +31,7 @@
   [refactoring-result-set-updated-source (-> refactoring-result-set? modified-source?)]
   [refactoring-result-set-results (-> refactoring-result-set? (listof refactoring-result?))]
   [refactoring-result-set-modified-lines (-> refactoring-result-set? immutable-range-set?)]
+  [refactoring-result-set-compiles? (-> refactoring-result-set? boolean?)]
   [refactoring-result-map-commits
    (-> (hash/c source? refactoring-result-set?) (listof resyntax-commit?))]))
 
@@ -129,6 +130,10 @@
              #:into (into-range-set natural<=>)))
 
 
+(define (refactoring-result-set-compiles? result-set)
+  (source-can-expand? (refactoring-result-set-updated-source result-set)))
+
+
 (define string-replacement<=> (comparator-map natural<=> string-replacement-start))
 
 

private/source.rkt

@@ -16,6 +16,7 @@
   [source-read-syntax (-> source? syntax?)]
   [source-read-language (-> source? (or/c module-path? #false))]
   [source-expand (-> source? syntax?)]
+  [source-can-expand? (-> source? boolean?)]
   [source-text-of (-> source? syntax? immutable-string?)]
   [file-source? (-> any/c boolean?)]
   [file-source (-> path-string? file-source?)]
@@ -125,13 +126,36 @@
     (check-equal? (source-read-language (string-source "#lang scribble/manual")) 'scribble/manual)
     (check-equal? (source-read-language (string-source "#lang info")) 'info)
     (check-equal? (source-read-language (string-source "#lang setup/infotab")) 'setup/infotab)
-    (check-equal? (source-read-language (string-source "(void)")) #false)))
+    (check-equal? (source-read-language (string-source "(void)")) #false))
+
+  (test-case "source-can-expand?"
+    ;; Valid racket code should expand successfully
+    (check-true (source-can-expand? (string-source "#lang racket/base\n(define x 42)")))
+    (check-true (source-can-expand? (string-source "#lang racket\n(or 1 2 3)")))
+
+    ;; Invalid racket code should not expand
+    (check-false (source-can-expand? (string-source "#lang racket/base\n(if)")))
+    (check-false (source-can-expand? (string-source "#lang racket/base\n(define)")))
+
+    ;; Modified sources should also be testable
+    (define orig (string-source "#lang racket/base\n(define foo 42)"))
+    (define valid-mod (modified-source orig "#lang racket/base\n(define foo 43)"))
+    (define invalid-mod (modified-source orig "#lang racket/base\n(if)"))
+    (check-true (source-can-expand? valid-mod))
+    (check-false (source-can-expand? invalid-mod))))
 
 
 (define (source-expand code)
   (expand (source-read-syntax code)))
 
 
+(define (source-can-expand? code)
+  (with-handlers ([exn:fail? (λ (_) #false)])
+    (parameterize ([current-namespace (make-base-namespace)])
+      (source-expand code))
+    #true))
+
+
 (define/guard (source-path code)
   (guard-match (or (file-source path) (modified-source (file-source path) _)) code #:else #false)
   path)