#177

Committed 04 Nov 2025 01:14AM UTC coverage: 92.881% (-0.03%) from 92.914%

Build # #177

Build Type

Pull #712

cover

Committed by

Copilot

Commit Message

Document how to extend expander property preservation

Add a comment explaining how to add new expander properties to the
preservation list when needed.

Co-authored-by: jackfirth <8175575+jackfirth@users.noreply.github.com>

Pull Request Pull Request #712: Store visited paths instead of syntaxes in source-code-analysis

Run Details

30 of 31 new or added lines in 1 file covered. (96.77%)

10 existing lines in 1 file now uncovered.

14664 of 15788 relevant lines covered (92.88%)

0.93 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

94.55

/private/analysis.rkt

#lang racket/base


(require racket/contract/base)


(provide
 (contract-out
  [source-analyze (->* (source? #:analyzers (sequence/c expansion-analyzer?))
                       (#:lines range-set?)
                       source-code-analysis?)]
  [source-code-analysis? (-> any/c boolean?)]
  [source-code-analysis-code (-> source-code-analysis? source?)]
  [source-code-analysis-enriched-syntax (-> source-code-analysis? syntax?)]
  [source-code-analysis-visited-paths (-> source-code-analysis? (listof syntax-path?))]
  [source-code-analysis-visited-forms (-> source-code-analysis? (listof syntax?))]
  [source-code-analysis-expansion-time-output (-> source-code-analysis? immutable-string?)]
  [source-code-analysis-namespace (-> source-code-analysis? namespace?)]
  [source-code-analysis-added-syntax-properties (-> source-code-analysis? syntax-property-bundle?)]))


(require guard
         racket/match
         racket/port
         racket/pretty
         racket/sequence
         racket/stream
         rebellion/base/comparator
         rebellion/base/immutable-string
         rebellion/base/option
         rebellion/base/range
         rebellion/collection/entry
         rebellion/collection/list
         rebellion/collection/range-set
         rebellion/collection/sorted-map
         rebellion/collection/sorted-set
         rebellion/collection/vector/builder
         rebellion/streaming/transducer
         rebellion/type/record
         resyntax/default-recommendations/analyzers/identifier-usage
         resyntax/default-recommendations/analyzers/ignored-result-values
         resyntax/default-recommendations/analyzers/variable-mutability
         resyntax/private/analyzer
         resyntax/private/linemap
         resyntax/private/logger
         resyntax/private/source
         resyntax/private/string-indent
         resyntax/private/syntax-movement
         resyntax/private/syntax-neighbors
         resyntax/private/syntax-path
         resyntax/private/syntax-property-bundle
         resyntax/private/syntax-traversal
         syntax/parse)


;@----------------------------------------------------------------------------------------------------


(define-record-type source-code-analysis
  (code enriched-syntax visited-paths expansion-time-output namespace added-syntax-properties))


;; Backward-compatible accessor that computes visited forms from paths
(define (source-code-analysis-visited-forms analysis)
  (define stx (source-code-analysis-enriched-syntax analysis))
  (define paths (source-code-analysis-visited-paths analysis))
  (for/list ([path (in-list paths)])
    (syntax-ref stx path)))


(define (source-analyze code
                        #:lines [lines (range-set (unbounded-range #:comparator natural<=>))]
                        #:analyzers analyzers)
  (define ns (make-base-namespace))
  (parameterize ([current-directory (or (source-directory code) (current-directory))]
                 [current-namespace ns])
    (define code-linemap (string-linemap (source->string code)))
    (define program-stx (source-read-syntax code))
    (define program-source-name (syntax-source program-stx))
    (unless program-source-name
      (raise-arguments-error
       'source-analyze
       "cannot refactor given source code, the reader returned a syntax object without a source name"
       "source" code
       "reader-produced syntax object" program-stx))
    (log-resyntax-debug "original source name: ~a" program-source-name)
    (log-resyntax-debug "original syntax:\n  ~a" program-stx)
    (define current-expand-observe (dynamic-require ''#%expobs 'current-expand-observe))
    (define original-visits (make-vector-builder))
    (define most-recent-visits-by-original-path (make-hash))

    (define/guard (resyntax-should-analyze-syntax? stx #:as-visit? [as-visit? #true])
      (guard (syntax-original-and-from-source? stx program-source-name) #:else #false)
      (guard as-visit? #:else #true)
      (define stx-lines (syntax-line-range stx #:linemap code-linemap))
      (define overlaps? (range-set-overlaps? lines stx-lines))
      (unless overlaps?
        (log-resyntax-debug
         (string-append "ignoring visited syntax object because it's outside analyzed lines\n"
                        "  analyzed lines: ~a\n"
                        "  syntax lines: ~a\n"
                        "  syntax: ~a")
         lines
         stx-lines
         stx))
      overlaps?)
    
    (define/match (observe-event! sig val)
      [('visit (? syntax? visited))
       (when (resyntax-should-analyze-syntax? visited)
         (vector-builder-add original-visits visited))
       (for ([visit-subform (in-stream (syntax-search-everything visited))]
             #:when (and (resyntax-should-analyze-syntax? visit-subform #:as-visit? #false)
                         (syntax-has-original-path? visit-subform)))
         (define path (syntax-original-path visit-subform))
         (hash-set! most-recent-visits-by-original-path path visit-subform))]
      [(_ _) (void)])

    (define output-port (open-output-string))
    (define expanded
      (parameterize ([current-expand-observe observe-event!]
                     [current-output-port output-port])
        (expand program-stx)))

    ;; We evaluate the module in order to ensure it's declared in the namespace, then we attach it at
    ;; expansion time to ensure the module is visited (but not instantiated). This allows refactoring
    ;; rules to access expansion-time values reflectively via the analysis namespace.
    (eval expanded)
    (namespace-require/expansion-time (extract-module-require-spec expanded))

    (define output (get-output-string output-port))
    (define movement-table (syntax-movement-table expanded))

    (define property-selection-table
      (transduce movement-table
                 (filtering
                  (λ (e)
                    (match-define (entry orig-path exp-paths) e)
                    (match (sorted-set-size exp-paths)
                      [1 #true]
                      [0 #false]
                      [_
                       (log-resyntax-debug
                        (string-append
                         "ignoring expansion analyzer properties for original path ~a because"
                         " multiple expanded forms claim to originate from that path")
                        orig-path)
                       #false])))
                 (mapping-values (λ (exp-paths) (present-value (sorted-set-least-element exp-paths))))
                 #:into (into-sorted-map syntax-path<=>)))

    (define expansion-analyzer-props
      (transduce analyzers
                 (append-mapping
                  (λ (analyzer)
                    (syntax-property-bundle-entries
                     (expansion-analyze analyzer expanded))))
                 (filtering
                  (λ (prop-entry)
                    (match-define (syntax-property-entry path key _value) prop-entry)
                    (define valid? (syntax-contains-path? expanded path))
                    (unless valid?
                      (log-resyntax-warning
                       "ignoring property with out-of-syntax path returned by analyzer~n  path: ~a~n  property key: ~a"
                       path
                       key))
                    valid?))
                 #:into into-syntax-property-bundle))

    (define expansion-analyzer-props-adjusted-for-visits
      (transduce property-selection-table
                 (mapping-values
                  (λ (exp-path)
                    (syntax-property-bundle-get-immediate-properties expansion-analyzer-props
                                                                     exp-path)))
                 #:into property-hashes-into-syntax-property-bundle))

    (when (log-level? resyntax-logger 'debug)
      (define props-str
        (string-indent (pretty-format expansion-analyzer-props-adjusted-for-visits) #:amount 2))
      (log-resyntax-debug "syntax properties from expansion analyzers:\n~a" props-str))

    (define (enrich stx #:skip-root? [skip-root? #false])
      (syntax-traverse stx
        #:skip-root? skip-root?
        [child
         #:do [(define child-stx (attribute child))
               (define orig-path (syntax-original-path child-stx))]
         #:when (and orig-path (sorted-map-contains-key? movement-table orig-path))
         #:do [(define expansions
                 (transduce (sorted-map-get movement-table orig-path)
                            (mapping (λ (p) (syntax-ref expanded p)))
                            (filtering syntax-original?)
                            #:into into-list))]
         #:when (equal? (length expansions) 1)
         (match-define (list expanded-child) expansions)
         (log-resyntax-debug "enriching ~a with scopes from expansion" child-stx)
         (enrich (datum->syntax expanded-child (syntax-e child-stx) child-stx child-stx)
                 #:skip-root? #true)]
        [child
         #:do [(define child-stx (attribute child))
               (define orig-path (syntax-original-path child-stx))]
         #:when (and orig-path (hash-has-key? most-recent-visits-by-original-path orig-path))
         #:do [(define visit (hash-ref most-recent-visits-by-original-path orig-path))]
         (log-resyntax-debug "enriching ~a with scopes from visit" child-stx)
         (enrich (datum->syntax visit (syntax-e child-stx) child-stx child-stx) #:skip-root? #true)]
        #:parent-context-modifier values
        #:parent-srcloc-modifier values
        #:parent-props-modifier values))
    
    (define visited-paths
      (transduce (build-vector original-visits)
                 (peeking
                  (λ (visit)
                    (unless (syntax-original-path visit)
                      (raise-arguments-error
                       'source-analyze "visit is missing original path"
                       "visited syntax" visit))))
                 (mapping syntax-original-path)
                 (deduplicating)
                 (sorting syntax-path<=>)
                 #:into into-list))
    
    ;; Extract expander-added properties from visits
    ;; We need to preserve certain properties that the expander adds during visits,
    ;; such as 'class-body which marks syntax inside a class body and affects
    ;; which refactoring rules can be applied. These properties are not captured
    ;; by expansion analyzers and must be manually extracted from visited syntax.
    ;; If new expander properties need to be preserved, add them to this list.
    (define expander-property-keys '(class-body))
    (define expander-property-entries
      (for*/list ([(path visit) (in-hash most-recent-visits-by-original-path)]
                  [key (in-list expander-property-keys)]
                  [val (in-value (syntax-property visit key))]
                  #:when val)
        (syntax-property-entry path key val)))
    
    ;; Combine expander and analyzer properties
    (define all-property-entries
      (append (sequence->list (syntax-property-bundle-entries expansion-analyzer-props-adjusted-for-visits))
              expander-property-entries))
    (define all-properties (sequence->syntax-property-bundle all-property-entries))
    
    ;; Label the original program syntax with paths, then add all properties and enrich
    (define program-stx-with-paths (syntax-label-original-paths program-stx))
    (define program-stx-with-props 
      (syntax-add-all-properties program-stx-with-paths all-properties))
    (define enriched-program-stx (enrich program-stx-with-props))

    (log-resyntax-debug "visited ~a forms" (length visited-paths))
    (source-code-analysis #:code code
                          #:enriched-syntax enriched-program-stx
                          #:visited-paths visited-paths
                          #:expansion-time-output output
                          #:namespace ns
                          #:added-syntax-properties expansion-analyzer-props-adjusted-for-visits)))


(define (syntax-original-and-from-source? stx source-name)
  (and (syntax-original? stx)
       ;; Some macros are able to bend hygiene and syntax properties in such a way that they
       ;; introduce syntax objects into the program that are syntax-original?, but from a
       ;; different file than the one being expanded. So in addition to checking for
       ;; originality, we also check that they come from the same source as the main program
       ;; syntax object. The (open ...) clause of the define-signature macro bends hygiene
       ;; in this way, and is what originally motivated the addition of this check.
       (equal? (syntax-source stx) source-name)))


(define (extract-module-require-spec mod-stx)
  (syntax-parse mod-stx
    [(_ name _ . _) `',(syntax-e #'name)]))


(module+ test
  (require rackunit)

  (test-case "source-analyze with custom analyzers list"
    ;; Test that source-analyze accepts an analyzers parameter
    (define test-source (string-source "#lang racket/base (define x 1)"))
    
    ;; Test with empty analyzers list
    (define analysis-empty (source-analyze test-source #:analyzers '()))
    (check-true (source-code-analysis? analysis-empty))
    
    ;; Test with single analyzer
    (define analysis-single 
      (source-analyze test-source #:analyzers (list identifier-usage-analyzer)))
    (check-true (source-code-analysis? analysis-single))
    
    ;; Test with default analyzers (should match default behavior)
    (define analysis-default
      (source-analyze test-source
                      #:analyzers (list identifier-usage-analyzer
                                        ignored-result-values-analyzer
                                        variable-mutability-analyzer)))
    (check-true (source-code-analysis? analysis-default)))

  (test-case "source-analyze filters out properties with invalid paths"
    ;; Create a test analyzer that returns properties with both valid and invalid paths
    (define test-source (string-source "#lang racket/base (define x 1)"))
    
    (define bad-analyzer
      (make-expansion-analyzer
       #:name 'bad-analyzer
       (λ (expanded)
         (syntax-property-bundle
          ;; Valid path - the root
          (syntax-property-entry empty-syntax-path 'valid-prop #true)
          ;; Invalid path - way out of bounds
          (syntax-property-entry (syntax-path (list 999)) 'invalid-prop #true)
          ;; Another invalid path
          (syntax-property-entry (syntax-path (list 0 999)) 'another-invalid-prop #true)))))
    
    ;; Run analysis with the bad analyzer - should not crash
    (define analysis (source-analyze test-source #:analyzers (list bad-analyzer)))
    
    ;; Check that the analysis completed successfully
    (check-true (source-code-analysis? analysis))
    
    ;; Check that the valid property is present in the result
    (define props (source-code-analysis-added-syntax-properties analysis))
    (check-true (syntax-property-bundle? props))
    
    ;; The valid property at the root should be present
    (define root-props (syntax-property-bundle-get-immediate-properties props empty-syntax-path))
    (check-equal? (hash-ref root-props 'valid-prop #false) #true)
    
    ;; The invalid properties should NOT be present
    ;; Check that path /999 is not in the bundle
    (define path-999-props
      (syntax-property-bundle-get-immediate-properties props (syntax-path (list 999))))
    (check-true (hash-empty? path-999-props))))

1	#lang racket/base	1✔
2
3
4	(require racket/contract/base)	1✔
5
6
7	(provide	1✔
8	(contract-out	1✔
9	[source-analyze (->* (source? #:analyzers (sequence/c expansion-analyzer?))	1✔
10	(#:lines range-set?)	1✔
11	source-code-analysis?)]	1✔
12	[source-code-analysis? (-> any/c boolean?)]	1✔
13	[source-code-analysis-code (-> source-code-analysis? source?)]	1✔
14	[source-code-analysis-enriched-syntax (-> source-code-analysis? syntax?)]	1✔
15	[source-code-analysis-visited-paths (-> source-code-analysis? (listof syntax-path?))]	1✔
16	[source-code-analysis-visited-forms (-> source-code-analysis? (listof syntax?))]	1✔
17	[source-code-analysis-expansion-time-output (-> source-code-analysis? immutable-string?)]	1✔
18	[source-code-analysis-namespace (-> source-code-analysis? namespace?)]	1✔
19	[source-code-analysis-added-syntax-properties (-> source-code-analysis? syntax-property-bundle?)]))	1✔
20
21
22	(require guard	1✔
23	racket/match	1✔
24	racket/port	1✔
25	racket/pretty	1✔
26	racket/sequence	1✔
27	racket/stream	1✔
28	rebellion/base/comparator	1✔
29	rebellion/base/immutable-string	1✔
30	rebellion/base/option	1✔
31	rebellion/base/range	1✔
32	rebellion/collection/entry	1✔
33	rebellion/collection/list	1✔
34	rebellion/collection/range-set	1✔
35	rebellion/collection/sorted-map	1✔
36	rebellion/collection/sorted-set	1✔
37	rebellion/collection/vector/builder	1✔
38	rebellion/streaming/transducer	1✔
39	rebellion/type/record	1✔
40	resyntax/default-recommendations/analyzers/identifier-usage	1✔
41	resyntax/default-recommendations/analyzers/ignored-result-values	1✔
42	resyntax/default-recommendations/analyzers/variable-mutability	1✔
43	resyntax/private/analyzer	1✔
44	resyntax/private/linemap	1✔
45	resyntax/private/logger	1✔
46	resyntax/private/source	1✔
47	resyntax/private/string-indent	1✔
48	resyntax/private/syntax-movement	1✔
49	resyntax/private/syntax-neighbors	1✔
50	resyntax/private/syntax-path	1✔
51	resyntax/private/syntax-property-bundle	1✔
52	resyntax/private/syntax-traversal	1✔
53	syntax/parse)	1✔
54
55
56	;@----------------------------------------------------------------------------------------------------
57
58
59	(define-record-type source-code-analysis	1✔
60	(code enriched-syntax visited-paths expansion-time-output namespace added-syntax-properties))	1✔
61
62
63	;; Backward-compatible accessor that computes visited forms from paths
64	(define (source-code-analysis-visited-forms analysis)	1✔
65	(define stx (source-code-analysis-enriched-syntax analysis))	1✔
66	(define paths (source-code-analysis-visited-paths analysis))	1✔
67	(for/list ([path (in-list paths)])	1✔
68	(syntax-ref stx path)))	1✔
69
70
71	(define (source-analyze code	1✔
72	#:lines [lines (range-set (unbounded-range #:comparator natural<=>))]	1✔
73	#:analyzers analyzers)	1✔
74	(define ns (make-base-namespace))	1✔
75	(parameterize ([current-directory (or (source-directory code) (current-directory))]	1✔
76	[current-namespace ns])	1✔
77	(define code-linemap (string-linemap (source->string code)))	1✔
78	(define program-stx (source-read-syntax code))	1✔
79	(define program-source-name (syntax-source program-stx))	1✔
80	(unless program-source-name	1✔
81	(raise-arguments-error	×
82	'source-analyze	×
83	"cannot refactor given source code, the reader returned a syntax object without a source name"	×
84	"source" code	×
85	"reader-produced syntax object" program-stx))	×
86	(log-resyntax-debug "original source name: ~a" program-source-name)	1✔
87	(log-resyntax-debug "original syntax:\n ~a" program-stx)	1✔
88	(define current-expand-observe (dynamic-require ''#%expobs 'current-expand-observe))	1✔
89	(define original-visits (make-vector-builder))	1✔
90	(define most-recent-visits-by-original-path (make-hash))	1✔
91
92	(define/guard (resyntax-should-analyze-syntax? stx #:as-visit? [as-visit? #true])	1✔
93	(guard (syntax-original-and-from-source? stx program-source-name) #:else #false)	1✔
94	(guard as-visit? #:else #true)	1✔
95	(define stx-lines (syntax-line-range stx #:linemap code-linemap))	1✔
96	(define overlaps? (range-set-overlaps? lines stx-lines))	1✔
97	(unless overlaps?	1✔
98	(log-resyntax-debug	1✔
99	(string-append "ignoring visited syntax object because it's outside analyzed lines\n"	1✔
100	" analyzed lines: ~a\n"	1✔
101	" syntax lines: ~a\n"	1✔
102	" syntax: ~a")	1✔
103	lines	1✔
104	stx-lines	1✔
105	stx))	1✔
106	overlaps?)	1✔
107
108	(define/match (observe-event! sig val)	1✔
109	[('visit (? syntax? visited))	1✔
110	(when (resyntax-should-analyze-syntax? visited)	1✔
111	(vector-builder-add original-visits visited))	1✔
112	(for ([visit-subform (in-stream (syntax-search-everything visited))]	1✔
113	#:when (and (resyntax-should-analyze-syntax? visit-subform #:as-visit? #false)	1✔
114	(syntax-has-original-path? visit-subform)))	1✔
115	(define path (syntax-original-path visit-subform))	1✔
116	(hash-set! most-recent-visits-by-original-path path visit-subform))]	1✔
117	[(_ _) (void)])	1✔
118
119	(define output-port (open-output-string))	1✔
120	(define expanded	1✔
121	(parameterize ([current-expand-observe observe-event!]	1✔
122	[current-output-port output-port])	1✔
123	(expand program-stx)))	1✔
124
125	;; We evaluate the module in order to ensure it's declared in the namespace, then we attach it at
126	;; expansion time to ensure the module is visited (but not instantiated). This allows refactoring
127	;; rules to access expansion-time values reflectively via the analysis namespace.
128	(eval expanded)	1✔
129	(namespace-require/expansion-time (extract-module-require-spec expanded))	1✔
130
131	(define output (get-output-string output-port))	1✔
132	(define movement-table (syntax-movement-table expanded))	1✔
133
134	(define property-selection-table	1✔
135	(transduce movement-table	1✔
136	(filtering	1✔
137	(λ (e)	1✔
138	(match-define (entry orig-path exp-paths) e)	1✔
139	(match (sorted-set-size exp-paths)	1✔
140	[1 #true]	1✔
141	[0 #false]	×
142	[_	1✔
143	(log-resyntax-debug	1✔
144	(string-append	1✔
145	"ignoring expansion analyzer properties for original path ~a because"	1✔
146	" multiple expanded forms claim to originate from that path")	1✔
147	orig-path)	1✔
148	#false])))	1✔
149	(mapping-values (λ (exp-paths) (present-value (sorted-set-least-element exp-paths))))	1✔
150	#:into (into-sorted-map syntax-path<=>)))	1✔
151
152	(define expansion-analyzer-props	1✔
153	(transduce analyzers	1✔
154	(append-mapping	1✔
155	(λ (analyzer)	1✔
156	(syntax-property-bundle-entries	1✔
157	(expansion-analyze analyzer expanded))))	1✔
158	(filtering	1✔
159	(λ (prop-entry)	1✔
160	(match-define (syntax-property-entry path key _value) prop-entry)	1✔
161	(define valid? (syntax-contains-path? expanded path))	1✔
162	(unless valid?	1✔
163	(log-resyntax-warning	1✔
164	"ignoring property with out-of-syntax path returned by analyzer~n path: ~a~n property key: ~a"	×
165	path	×
166	key))	×
167	valid?))	1✔
168	#:into into-syntax-property-bundle))	1✔
169
170	(define expansion-analyzer-props-adjusted-for-visits	1✔
171	(transduce property-selection-table	1✔
172	(mapping-values	1✔
173	(λ (exp-path)	1✔
174	(syntax-property-bundle-get-immediate-properties expansion-analyzer-props	1✔
175	exp-path)))	1✔
176	#:into property-hashes-into-syntax-property-bundle))	1✔
177
178	(when (log-level? resyntax-logger 'debug)	1✔
179	(define props-str	1✔
180	(string-indent (pretty-format expansion-analyzer-props-adjusted-for-visits) #:amount 2))	1✔
181	(log-resyntax-debug "syntax properties from expansion analyzers:\n~a" props-str))	1✔
182
183	(define (enrich stx #:skip-root? [skip-root? #false])	1✔
184	(syntax-traverse stx	1✔
185	#:skip-root? skip-root?	1✔
186	[child	1✔
187	#:do [(define child-stx (attribute child))	1✔
188	(define orig-path (syntax-original-path child-stx))]	1✔
189	#:when (and orig-path (sorted-map-contains-key? movement-table orig-path))	1✔
190	#:do [(define expansions	1✔
191	(transduce (sorted-map-get movement-table orig-path)	1✔
192	(mapping (λ (p) (syntax-ref expanded p)))	1✔
193	(filtering syntax-original?)	1✔
194	#:into into-list))]	1✔
195	#:when (equal? (length expansions) 1)	1✔
196	(match-define (list expanded-child) expansions)	1✔
197	(log-resyntax-debug "enriching ~a with scopes from expansion" child-stx)	1✔
198	(enrich (datum->syntax expanded-child (syntax-e child-stx) child-stx child-stx)	1✔
199	#:skip-root? #true)]	1✔
200	[child	1✔
201	#:do [(define child-stx (attribute child))	1✔
202	(define orig-path (syntax-original-path child-stx))]	1✔
203	#:when (and orig-path (hash-has-key? most-recent-visits-by-original-path orig-path))	1✔
204	#:do [(define visit (hash-ref most-recent-visits-by-original-path orig-path))]	1✔
205	(log-resyntax-debug "enriching ~a with scopes from visit" child-stx)	1✔
206	(enrich (datum->syntax visit (syntax-e child-stx) child-stx child-stx) #:skip-root? #true)]	1✔
207	#:parent-context-modifier values	1✔
208	#:parent-srcloc-modifier values	1✔
209	#:parent-props-modifier values))	1✔
210
211	(define visited-paths	1✔
212	(transduce (build-vector original-visits)	1✔
213	(peeking	1✔
214	(λ (visit)	1✔
215	(unless (syntax-original-path visit)	1✔
216	(raise-arguments-error	×
NEW 217	'source-analyze "visit is missing original path"	×
218	"visited syntax" visit))))	×
219	(mapping syntax-original-path)	1✔
220	(deduplicating)	1✔
221	(sorting syntax-path<=>)	1✔
222	#:into into-list))	1✔
223
224	;; Extract expander-added properties from visits
225	;; We need to preserve certain properties that the expander adds during visits,
226	;; such as 'class-body which marks syntax inside a class body and affects
227	;; which refactoring rules can be applied. These properties are not captured
228	;; by expansion analyzers and must be manually extracted from visited syntax.
229	;; If new expander properties need to be preserved, add them to this list.
230	(define expander-property-keys '(class-body))	1✔
231	(define expander-property-entries	1✔
232	(for*/list ([(path visit) (in-hash most-recent-visits-by-original-path)]	1✔
233	[key (in-list expander-property-keys)]	1✔
234	[val (in-value (syntax-property visit key))]	1✔
235	#:when val)	1✔
236	(syntax-property-entry path key val)))	1✔
237
238	;; Combine expander and analyzer properties
239	(define all-property-entries	1✔
240	(append (sequence->list (syntax-property-bundle-entries expansion-analyzer-props-adjusted-for-visits))	1✔
241	expander-property-entries))	1✔
242	(define all-properties (sequence->syntax-property-bundle all-property-entries))	1✔
243
244	;; Label the original program syntax with paths, then add all properties and enrich
245	(define program-stx-with-paths (syntax-label-original-paths program-stx))	1✔
246	(define program-stx-with-props	1✔
247	(syntax-add-all-properties program-stx-with-paths all-properties))	1✔
248	(define enriched-program-stx (enrich program-stx-with-props))	1✔
249
250	(log-resyntax-debug "visited ~a forms" (length visited-paths))	1✔
251	(source-code-analysis #:code code	1✔
252	#:enriched-syntax enriched-program-stx	1✔
253	#:visited-paths visited-paths	1✔
254	#:expansion-time-output output	1✔
255	#:namespace ns	1✔
256	#:added-syntax-properties expansion-analyzer-props-adjusted-for-visits)))	1✔
257
258
259	(define (syntax-original-and-from-source? stx source-name)	1✔
260	(and (syntax-original? stx)	1✔
261	;; Some macros are able to bend hygiene and syntax properties in such a way that they
262	;; introduce syntax objects into the program that are syntax-original?, but from a
263	;; different file than the one being expanded. So in addition to checking for
264	;; originality, we also check that they come from the same source as the main program
265	;; syntax object. The (open ...) clause of the define-signature macro bends hygiene
266	;; in this way, and is what originally motivated the addition of this check.
267	(equal? (syntax-source stx) source-name)))	1✔
268
269
270	(define (extract-module-require-spec mod-stx)	1✔
271	(syntax-parse mod-stx	1✔
272	[(_ name _ . _) `',(syntax-e #'name)]))	1✔
273
274
275	(module+ test
276	(require rackunit)
277
278	(test-case "source-analyze with custom analyzers list"
279	;; Test that source-analyze accepts an analyzers parameter
280	(define test-source (string-source "#lang racket/base (define x 1)"))
281
282	;; Test with empty analyzers list
283	(define analysis-empty (source-analyze test-source #:analyzers '()))
284	(check-true (source-code-analysis? analysis-empty))
285
286	;; Test with single analyzer
287	(define analysis-single
288	(source-analyze test-source #:analyzers (list identifier-usage-analyzer)))
289	(check-true (source-code-analysis? analysis-single))
290
291	;; Test with default analyzers (should match default behavior)
292	(define analysis-default
293	(source-analyze test-source
294	#:analyzers (list identifier-usage-analyzer
295	ignored-result-values-analyzer
296	variable-mutability-analyzer)))
297	(check-true (source-code-analysis? analysis-default)))
298
299	(test-case "source-analyze filters out properties with invalid paths"
300	;; Create a test analyzer that returns properties with both valid and invalid paths
301	(define test-source (string-source "#lang racket/base (define x 1)"))
302
303	(define bad-analyzer
304	(make-expansion-analyzer
305	#:name 'bad-analyzer
306	(λ (expanded)
307	(syntax-property-bundle
308	;; Valid path - the root
309	(syntax-property-entry empty-syntax-path 'valid-prop #true)
310	;; Invalid path - way out of bounds
311	(syntax-property-entry (syntax-path (list 999)) 'invalid-prop #true)
312	;; Another invalid path
313	(syntax-property-entry (syntax-path (list 0 999)) 'another-invalid-prop #true)))))
314
315	;; Run analysis with the bad analyzer - should not crash
316	(define analysis (source-analyze test-source #:analyzers (list bad-analyzer)))
317
318	;; Check that the analysis completed successfully
319	(check-true (source-code-analysis? analysis))
320
321	;; Check that the valid property is present in the result
322	(define props (source-code-analysis-added-syntax-properties analysis))
323	(check-true (syntax-property-bundle? props))
324
325	;; The valid property at the root should be present
326	(define root-props (syntax-property-bundle-get-immediate-properties props empty-syntax-path))
327	(check-equal? (hash-ref root-props 'valid-prop #false) #true)
328
329	;; The invalid properties should NOT be present
330	;; Check that path /999 is not in the bundle
331	(define path-999-props
332	(syntax-property-bundle-get-immediate-properties props (syntax-path (list 999))))
333	(check-true (hash-empty? path-999-props))))

jackfirth / resyntax / #177

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous