This repository has been archived by the owner on Oct 26, 2023. It is now read-only.
forked from greghendershott/pdb
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathexample.rkt
404 lines (372 loc) · 19.2 KB
/
example.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
#lang racket/base
(require (for-syntax racket/base
racket/syntax)
racket/match
racket/runtime-path
rackunit
sql ;for ad hoc queries in REPL
syntax/parse/define
(only-in version/utils version<?)
"create.rkt"
"db.rkt")
(define (tests)
(general-tests)
(re-provide-tests)
(all-defined-out-tests)
(phase-tests)
(space-tests)
(meta-lang-tests))
(define-syntax-parser define-example
[(_ id:id)
#:with str-var (format-id #'id "~a/str" #'id)
#`(begin
(define-runtime-path id #,(format "example/~a" (syntax->datum #'id)))
(define str-var (path->string id)))])
(define-example define.rkt)
(define-example require.rkt)
(define (general-tests)
(analyze-path (build-path require.rkt) #:always? #t)
(analyze-path (build-path define.rkt) #:always? #t)
;;; uses <=> definitions
(check-equal? (use-pos->def/proximate require.rkt 42)
(vector define.rkt/str 88 93)
"use-pos->def/proximate: plain")
(check-equal? (use-pos->def/proximate require.rkt 42)
(use-pos->def/transitive require.rkt 42)
"transitive def of non-contract-wrapped is the same")
(check-equal? (use-pos->def/proximate require.rkt 48)
(vector define.rkt/str 88 93)
"use-pos->def/proximate: renamed")
(check-equal? (use-pos->def/proximate require.rkt 56)
(vector define.rkt/str 207 218)
"use-pos->def/proximate: contracted1")
(check-equal? (use-pos->def/transitive require.rkt 56)
(vector define.rkt/str 165 176)
"use-pos->def/transitive: contracted1")
(check-equal? (use-pos->def/proximate require.rkt 68)
(vector define.rkt/str 283 294)
"use-pos->def/proximate: contracted2")
(check-equal? (use-pos->def/transitive require.rkt 68)
(vector define.rkt/str 246 257)
"use-pos->def/transitive: contracted2")
(check-equal? (use-pos->def/proximate require.rkt 80)
(vector define.rkt/str 363 366)
"use-pos->def/proximate: contracted/renamed => c/r")
(check-equal? (use-pos->def/transitive require.rkt 80)
(vector define.rkt/str 322 325)
"use-pos->def/transitive: contracted/renamed => c/r")
(check-equal? (use-pos->def/proximate require.rkt 99)
(vector define.rkt/str 515 529)
"use-pos->def/proximate: plain-by-macro")
(check-equal? (use-pos->def/proximate require.rkt 114)
(vector define.rkt/str 684 703)
"use-pos->def/proximate: contracted-by-macro")
(check-equal? (use-pos->def/proximate require.rkt 134)
(vector define.rkt/str 958 961)
"use-pos->def/proximate: sub")
(check-equal? (use-pos->def/proximate require.rkt 138)
(vector define.rkt/str 958 961)
"use-pos->def/proximate: sub/renamed")
(check-equal? (use-pos->def/proximate require.rkt 150)
(vector define.rkt/str 1179 1182)
"use-pos->def/proximate: foo")
(check-equal? (use-pos->def/proximate require.rkt 154)
(vector define.rkt/str 1225 1233)
"use-pos->def/proximate: a-number")
(check-equal? (use-pos->def/proximate require.rkt 163)
(vector define.rkt/str 1265 1276)
"use-pos->def/proximate: a-parameter")
(check-equal? (use-pos->def/proximate require.rkt 175)
(vector define.rkt/str 1421 1427)
"use-pos->def/proximate: from-m")
(check-equal? (use-pos->def/proximate require.rkt 182)
(vector define.rkt/str 1456 1459)
"use-pos->def/proximate: d/c")
(check-equal? (use-pos->def/proximate require.rkt 186)
(vector define.rkt/str 1456 1459)
"use-pos->def/proximate: renamed-d/c")
(check-equal? (use-pos->def/proximate require.rkt 405)
(vector require.rkt/str 397 404)
"use-pos->def/proximate: arrow for only-in rename; needs PR in Racket 8.1.0.3")
(check-equal? (use-pos->def/proximate require.rkt 452)
(vector require.rkt/str 433 451)
"use-pos->def/proximate: arrow for only-in rename; needs PR to Racket 8.1.0.3")
(check-equal? (use-pos->def/proximate require.rkt 529)
(vector define.rkt/str 1545 1553)
"use-pos->def/proximate: a-struct")
(check-equal? (use-pos->def/proximate require.rkt 538)
(vector define.rkt/str 1545 1553)
"use-pos->def/proximate: a-struct?")
(check-equal? (use-pos->def/proximate require.rkt 548)
(vector define.rkt/str 1545 1553)
"use-pos->def/proximate: sub-range `a-struct` of imported `a-struct-a`")
(check-equal? (use-pos->def/proximate require.rkt 557)
(vector define.rkt/str 1555 1556)
"use-pos->def/proximate: sub-range `a` of imported `a-struct-a`")
(check-equal? (use-pos->def/proximate require.rkt 559)
(vector define.rkt/str 1545 1553)
"use-pos->def/proximate: imported a-struct-b")
(check-equal? (use-pos->def/proximate define.rkt 1593)
(vector define.rkt/str 1545 1553)
"use-pos->def/proximate: local a-struct portion of a-struct-a")
(check-equal? (use-pos->def/proximate define.rkt 1602)
(vector define.rkt/str 1555 1556)
"use-pos->def/proximate: local 'a' field portion of a-struct-a")
(check-equal? (def-pos->uses/transitive define.rkt 88)
(list
(vector require.rkt/str "plain" "plain" "plain" 42 47)
(vector require.rkt/str "plain" "renamed" "renamed" 48 55)
(vector require.rkt/str "plain" "PRE:" "PRE:plain" 264 268)
(vector require.rkt/str "plain" "plain" "PRE:plain" 268 273)
(vector require.rkt/str "plain" "PRE:" "PRE:renamed" 276 280)
(vector require.rkt/str "plain" "renamed" "PRE:renamed" 280 287)
(vector require.rkt/str "plain" "renamed" "renamed" 397 404)
(vector require.rkt/str "renamed" "plain" "plain" 405 410)
(vector require.rkt/str "plain" "plain" "plain" 461 466)
(vector require.rkt/str "plain" "plain" "plain" 509 514)
(vector require.rkt/str "plain" "XXX" "XXX" 515 518)
(vector require.rkt/str "plain" "XXX" "XXX" 524 527)
;; (vector require.rkt/str "plain" "plain" "plain" 644 649)
;; (vector require.rkt/str "plain" "for-syntax-plain" "for-syntax-plain" 650 666)
(vector define.rkt/str "plain" "plain" "plain" 109 114)
(vector define.rkt/str "plain" "plain" "plain" 138 143)
(vector define.rkt/str "plain" "renamed" "renamed" 144 151))
"def-pos->uses/transitive: plain")
(check-equal? (def-pos->uses/proximate define.rkt 322)
(list
(vector define.rkt/str "c/r" "c/r" "c/r" 363 366))
"def-pos->uses/proximate: c/r")
;;; uses <=> name-introductions
(check-equal? (use-pos->name/proximate require.rkt 42)
(vector define.rkt/str 109 114)
"use-pos->name/proximate plain")
(check-equal? (use-pos->name/transitive require.rkt 42)
(vector define.rkt/str 88 93)
"use-pos->name/transitive: plain")
(check-equal? (use-pos->name/proximate require.rkt 48)
(vector define.rkt/str 144 151)
"use-pos->name/proximate: renamed")
(check-equal? (use-pos->name/proximate require.rkt 264)
(vector require.rkt/str 242 246)
"use->pos->name: prefix-in `PRE:` part of `PRE:plain`")
(check-equal? (use-pos->name/proximate require.rkt 268)
(vector define.rkt/str 109 114)
"use->pos->name: prefix-in `plain` part of `PRE:plain`")
(check-equal? (use-pos->name/transitive require.rkt 268)
(vector define.rkt/str 88 93)
"use->pos->name/transitive: prefix-in `plain` part of `PRE:plain`")
(check-equal? (use-pos->name/proximate require.rkt 461)
(vector require.rkt/str 405 410)
"use->pos->name: `plain` is from rename-in not from define.rkt")
(check-equal? (use-pos->name/proximate require.rkt 134)
(vector define.rkt/str 979 982)
"use-pos->name/proximate: sub")
(check-equal? (use-pos->name/transitive require.rkt 134)
(vector define.rkt/str 958 961)
"use-pos->name/transitive: sub")
(check-equal? (use-pos->name/proximate require.rkt 138)
(vector define.rkt/str 1011 1022)
"use-pos->name/proximate: sub/renamed")
(check-equal? (use-pos->name/transitive require.rkt 138)
(vector define.rkt/str 1011 1022)
"use-pos->name/transitive: sub/renamed")
(check-equal? (use-pos->name/proximate require.rkt 175)
(vector define.rkt/str 1375 1381)
"use-pos->name/proximate: from-m")
(check-equal? (use-pos->name/transitive require.rkt 175)
(vector define.rkt/str 1353 1359)
"use-pos->name/transitive: from-m")
(check-equal? (use-pos->name/proximate require.rkt 529)
(vector define.rkt/str 1545 1553)
"use-pos->name/proximate: a-struct")
(check-equal? (use-pos->name/proximate require.rkt 538)
(vector define.rkt/str 1545 1553)
"use-pos->name/proximate: a-struct?")
(check-equal? (use-pos->name/proximate require.rkt 548)
(vector define.rkt/str 1545 1553)
"use-pos->name/proximate: imported a-struct-a")
(check-equal? (use-pos->name/proximate require.rkt 557)
(vector define.rkt/str 1555 1556)
"use-pos->name/proximate: imported 'a' field portion of a-struct-a")
(check-equal? (use-pos->name/proximate require.rkt 559)
(vector define.rkt/str 1545 1553)
"use-pos->name/proximate: imported a-struct-b")
(check-equal? (use-pos->name/proximate define.rkt 1593)
(vector define.rkt/str 1545 1553)
"use-pos->name/proximate: local a-struct portion of a-struct-a")
(check-equal? (use-pos->def/proximate define.rkt 1602)
(vector define.rkt/str 1555 1556)
"use-pos->name/proximate: local 'a' field portion of a-struct-a")
(check-equal? (name-pos->uses/transitive define.rkt 88)
(list
;; def_text use_text use_stx beg end
(vector require.rkt/str "plain" "plain" "plain" 42 47)
(vector require.rkt/str "plain" "plain" "PRE:plain" 268 273)
(vector define.rkt/str "plain" "plain" "plain" 109 114)
(vector define.rkt/str "plain" "plain" "plain" 138 143))
"name-pos->uses/transitive: `plain`")
(check-equal? (name-pos->uses/transitive define.rkt 207)
(list
(vector require.rkt/str "contracted1" "contracted1" "contracted1" 56 67))
"name-pos->uses/transitive: contracted1")
(check-equal? (name-pos->uses/transitive define.rkt 367)
(list
(vector require.rkt/str "contracted/renamed" "contracted/renamed" "contracted/renamed" 80 98)
(vector require.rkt/str "contracted/renamed" "contracted/renamed" "PRE:contracted/renamed" 294 312)
(vector require.rkt/str "contracted/renamed" "contracted/renamed" "contracted/renamed" 433 451))
"name-pos->uses/transitive: contracted/renamed")
(check-equal? (name-pos->uses/transitive require.rkt 405)
(list
;; def_text use_text use_stx beg end
(vector require.rkt/str "plain" "plain" "plain" 461 466))
"name-pos->uses/transitive: `plain` from only-in rename")
(check-equal? (name-pos->uses/transitive require.rkt 452)
(list
;; def_text use_text use_stx beg end
(vector require.rkt/str "c/r" "c/r" "c/r" 469 472))
"name-pos->uses/transitive: `c/r` from only-in rename")
(check-equal? (name-pos->uses/transitive require.rkt 515)
(list
;; def_text use_text use_stx beg end
(vector require.rkt/str "XXX" "XXX" "XXX" 524 527))
"name-pos->uses/transitive: `XXX` from rename-in")
(check-equal? (name-pos->uses/transitive require.rkt 242)
(list
;; def_text use_text use_stx
(vector require.rkt/str "PRE:" "PRE:" "PRE:plain"
264 268)
(vector require.rkt/str "PRE:" "PRE:" "PRE:renamed"
276 280)
(vector require.rkt/str "PRE:" "PRE:" "PRE:contracted/renamed"
290 294))
"name-pos->uses/transitive: `PRE:` from prefix-in"))
(define-example define-foo.rkt)
(define-example define-bar.rkt)
(define-example re-provide.rkt)
(define-example require-re-provide.rkt)
(define (re-provide-tests)
(analyze-path (build-path define-foo.rkt) #:always? #t)
(analyze-path (build-path define-bar.rkt) #:always? #t)
(analyze-path (build-path re-provide.rkt) #:always? #t)
(analyze-path (build-path require-re-provide.rkt) #:always? #t)
(check-equal? (use-pos->def/proximate require-re-provide.rkt 41)
(vector define-foo.rkt/str 36 39)
"use-pos->def/proximate: foo")
(let ()
(match-define (vector path beg end) (use-pos->name/proximate require-re-provide.rkt 41))
(check-equal? path re-provide.rkt/str "use-pos->name/proximate: foo [all-from-out]")
(check-true (negative? beg) "use-pos->name/proximate: foo [all-from-out]")
(check-true (negative? end) "use-pos->name/proximate: foo [all-from-out]"))
(check-equal? (use-pos->name/transitive require-re-provide.rkt 41)
(vector define-foo.rkt/str 36 39)
"use-pos->name/transitive: foo")
(check-equal? (name-pos->uses/transitive define-foo.rkt 36)
(list
(vector define-foo.rkt/str "foo" "foo" "foo" 23 26)
(vector require-re-provide.rkt/str "foo" "foo" "foo" 41 44))
"name-pos->uses/transitive: foo")
(check-equal? (use-pos->def/proximate require-re-provide.rkt 45)
(vector define-bar.rkt/str 36 39)
"use-pos->def/proximate: bar")
(check-equal? (use-pos->name/proximate require-re-provide.rkt 45)
(vector re-provide.rkt/str 119 122)
"use-pos->name/proximate: bar")
(check-equal? (use-pos->name/transitive require-re-provide.rkt 45)
(vector define-bar.rkt/str 36 39)
"use-pos->name/proximate: bar")
(check-equal? (name-pos->uses/transitive define-bar.rkt 36)
(list
(vector define-bar.rkt/str "bar" "bar" "bar" 23 26)
(vector re-provide.rkt/str "bar" "bar" "bar" 119 122)
(vector require-re-provide.rkt/str "bar" "bar" "bar" 45 48))
"name-pos->uses/transitive: bar"))
(define-example ado-define.rkt)
(define-example ado-require.rkt)
(define (all-defined-out-tests)
(analyze-path (build-path ado-define.rkt) #:always? #t)
(analyze-path (build-path ado-require.rkt) #:always? #t)
(check-equal? (use-pos->def/proximate ado-require.rkt 46)
(vector ado-define.rkt/str 27 28)))
(define-example phase/single.rkt)
(define-example phase/define.rkt)
(define-example phase/require.rkt)
(define (phase-tests)
(analyze-path (build-path phase/single.rkt) #:always? #t)
(check-equal? (use-pos->def/proximate phase/single.rkt 233)
(vector phase/single.rkt/str 125 126)
"phase 0 use-pos->def")
(check-equal? (use-pos->def/proximate phase/single.rkt 276)
(vector phase/single.rkt/str 177 178)
"phase 1 use-pos->def")
(analyze-path (build-path phase/define.rkt) #:always? #t)
(analyze-path (build-path phase/require.rkt) #:always? #t)
(check-equal? (use-pos->def/proximate phase/require.rkt 97)
(vector phase/define.rkt/str 64 65)
"phase 0 use-pos->def")
(check-equal? (use-pos->def/proximate phase/require.rkt 140)
(vector phase/define.rkt/str 110 111)
"phase 1 use-pos->def")
(check-equal? (use-pos->name/proximate phase/require.rkt 97)
(vector phase/define.rkt/str 78 79)
"phase 0 use-pos->name/proximate")
(check-equal? (use-pos->name/transitive phase/require.rkt 97)
(vector phase/define.rkt/str 64 65)
"phase 0 use-pos->name/transitive")
(check-equal? (use-pos->name/proximate phase/require.rkt 140)
(vector phase/define.rkt/str 126 127)
"phase 1 use-pos->name/proximate")
(check-equal? (use-pos->name/transitive phase/require.rkt 140)
(vector phase/define.rkt/str 110 111)
"phase 1 use-pos->name/transitive")
(check-equal? (use-pos->name/proximate phase/require.rkt 164)
(vector phase/define.rkt/str 154 167)
"phase 1 use-pos->name/proximate rename-out"))
(define-example space/define.rkt)
(define-example space/require.rkt)
(define (space-tests)
(when (with-handlers ([exn:fail? (λ _ #f)])
(dynamic-require 'racket/phase+space #f)
#t)
(analyze-path (build-path space/define.rkt) #:always? #t)
(analyze-path (build-path space/require.rkt) #:always? #t)
(check-equal? (use-pos->def/proximate space/require.rkt 141)
(vector space/define.rkt/str 312 318))
;; TODO: More tests involving spaces
))
(define-example meta-lang.rkt)
(define (meta-lang-tests)
(analyze-path (build-path meta-lang.rkt) #:always? #t)
;; The following test will pass only if
;;
;; <https://github.com/racket/racket/pull/3902>
;;
;; is merged to change `make-meta-reader` to address
;;
;; <https://github.com/racket/drracket/issues/486>
;;
;; Here we assume it will be merged sometime after the now-current
;; version 8.2.0.1 of Racket as built from source.
(when (version<? "8.2.0.1" (version))
(check-equal? (query-row
(select def_beg def_text
#:from def_arrows_view
#:where (and (= use_path ,meta-lang.rkt/str)
(= use_beg 27))))
(vector 14 "racket/base"))))
(module+ test
(open 'memory)
(create-tables)
(tests))
(module+ on-disk-example
(define-runtime-path db-path "locs.sqlite")
(create-database db-path)
(open db-path)
;; Re-analyze another file (and watch the `pdb` logger topic)
(define-runtime-path db.rkt "db.rkt")
(analyze-path (build-path db.rkt) #:always? #t)
;; Do this to analyze all files discovered.
(time (analyze-all-known-paths #:always? #f))
;; Do this to refresh everything from scratch. (But if you change
;; the schema, just delete the .sqlite file.)
#;(time (analyze-all-known-paths #:always? #t))
(tests))