example.rkt

; Copyright (c) 2021-2023 by Greg Hendershott.
;; SPDX-License-Identifier: GPL-3.0-or-later

#lang racket/base

;;; Tests to exercise the example files under example/, mostly wrt to
;;; definition, use, and rename site functionality in relations.rkt.

(require (for-syntax racket/base
                     (only-in racket/format ~a)
                     (only-in racket/string string-split))
         pkg/path
         (only-in racket/file file->string)
         racket/format
         racket/logging
         racket/match
         racket/runtime-path
         rackunit
         syntax/modresolve
         syntax/parse/define
         "analyze.rkt"
         "main.rkt"
         "data-types.rkt"
         (submod "relations.rkt" private)
         (submod "store.rkt" stats))

(define (tests)
  (general-tests)
  (re-provide-tests)
  (all-defined-out-tests)
  (prefix-tests)
  (phase-tests)
  (space-tests)
  (meta-lang-tests)
  (typed-tests)
  (error-tests)
  (macro-tests)
  (large-file-tests)
  #;(exhaustive-rename-tests)
  )

(define-runtime-path example/ "example/")

(define example-files null)
(define-syntax-parser define-example-file
  [(_ id:id)
   #`(begin
       (define-runtime-path
         id #,(apply build-path
                     "example"
                     (string-split (~a (syntax->datum #'id)) "/")))
       (set! example-files (cons id example-files)))])

(define-example-file define.rkt)
(define-example-file require.rkt)

(define (general-tests)
  (analyze-path require.rkt #:always? #t)
  (analyze-path define.rkt  #:always? #t)

  ;;; uses -> definitions
  ;;;
  ;;; use->def: Big jumps directly to definition
  ;;; nominal-use->def: Incremental steps

  (check-equal? (use->def require.rkt 42)
                (list define.rkt 88 93)
                "use->def: plain")

  (check-equal? (use->def require.rkt 48)
                (list define.rkt 88 93)
                "use->def: renamed")

  (check-equal? (use->def require.rkt 56)
                (list define.rkt 165 176)
                "use->def: contracted1")
  (check-equal? (nominal-use->def require.rkt 56)
                (list define.rkt 207 218)
                "nominal-use->def: contracted1")

  (check-equal? (use->def require.rkt 68)
                (list define.rkt 246 257)
                "use->def: contracted2")
  (check-equal? (nominal-use->def require.rkt 68)
                (list define.rkt 283 294)
                "nominal-use->def: contracted2")

  (check-equal? (use->def require.rkt 80)
                (list define.rkt 322 325)
                "use->def: contracted/renamed => c/r")
  (check-equal? (nominal-use->def require.rkt 80)
                (list define.rkt 367 385)
                "nominal-use->def: contracted/renamed => contracted/renamed in rename clause")
  (check-equal? (nominal-use->def define.rkt 367)
                (list define.rkt 363 366)
                "nominal-use->def: contracted/renamed => c/r within rename clause")
  (check-equal? (nominal-use->def define.rkt 363)
                (list define.rkt 322 325)
                "nominal-use->def: c/r within rename clause => c/r definition")

  (check-equal? (use->def require.rkt 99)
                (list define.rkt 515 529)
                "use->def: plain-by-macro")
  (check-equal? (use->def require.rkt 114)
                (list define.rkt 684 703)
                "use->def: contracted-by-macro")
  (check-equal? (use->def require.rkt 134)
                (list define.rkt 958 961)
                "use->def: sub")
  (check-equal? (use->def require.rkt 138)
                (list define.rkt 958 961)
                "use->def: sub/renamed")
  (check-equal? (use->def require.rkt 150)
                (list define.rkt 1179 1182)
                "use->def: foo")
  (check-equal? (use->def require.rkt 154)
                (list define.rkt 1225 1233)
                "use->def: a-number")
  (check-equal? (use->def require.rkt 163)
                (list define.rkt 1265 1276)
                "use->def: a-parameter")

  (check-equal? (use->def require.rkt 175)
                (list define.rkt 1353 1359)
                "use->def: from-m")
  (check-equal? (nominal-use->def require.rkt 175)
                (list define.rkt 1421 1427)
                "nominal-use->def: from-m in contract-out provide")
  #;
  (check-equal? (nominal-use->def define.rkt 1421)
                (list define.rkt 1375 1381)
                "nominal-use->def: from-m in contract-out provide to submod plain provide; but check-syntax is drawing this direct to the definition, skipping the submod provide :(")
  (check-equal? (nominal-use->def define.rkt 1375)
                (list define.rkt 1353 1359)
                "nominal-use->def: from-m in contract-out provide to submod plain provide")

  (check-equal? (use->def require.rkt 182)
                (list define.rkt 1456 1459)
                "use->def: d/c")
  (check-equal? (use->def require.rkt 186)
                (list define.rkt 1456 1459)
                "use->def: renamed-d/c")

  (check-equal? (use->def require.rkt 405)
                (list define.rkt 88 93)
                "use->def: arrow for only-in rename")
  (check-equal? (nominal-use->def require.rkt 405)
                (list require.rkt 397 404)
                "nominal-use->def: arrow for only-in rename; needs PR in Racket 8.1.0.3")

  (check-equal? (use->def require.rkt 452)
                (list define.rkt 322 325)
                "use->def: arrow for only-in rename")
  (check-equal? (nominal-use->def require.rkt 452)
                (list require.rkt 433 451)
                "nominal-use->def: arrow for only-in rename; needs PR to Racket 8.1.0.3")

  (check-equal? (use->def require.rkt 529)
                (list define.rkt 1545 1553)
                "use->def: a-struct")
  (check-equal? (use->def require.rkt 538)
                (list define.rkt 1545 1553)
                "use->def: a-struct?")
  (check-equal? (use->def require.rkt 548)
                (list define.rkt 1545 1553)
                "use->def: sub-range `a-struct` of imported `a-struct-a`")
  (check-equal? (use->def require.rkt 557)
                (list define.rkt 1555 1556)
                "use->def: sub-range `a`  of imported `a-struct-a`")
  (check-equal? (use->def require.rkt 559)
                (list define.rkt 1545 1553)
                "use->def: imported a-struct-b")
  (check-equal? (use->def define.rkt 1593)
                (list define.rkt 1545 1553)
                "use->def: local a-struct portion of a-struct-a")
  (check-equal? (use->def define.rkt 1602)
                (list define.rkt 1555 1556)
                "use->def: local 'a' field portion of a-struct-a")

  (check-equal? (nominal-use->def require.rkt 42)
                (list define.rkt 109 114)
                "nominal-use->def plain")
  (check-equal? (use->def require.rkt 42)
                (list define.rkt 88 93)
                "use->def: plain")
  (check-equal? (nominal-use->def require.rkt 48)
                (list define.rkt 144 151)
                "nominal-use->def: renamed")
  (check-equal? (nominal-use->def require.rkt 264)
                (list require.rkt 242 246)
                "nominal-use->def: prefix-in `PRE:` part of `PRE:plain`")
  (check-equal? (nominal-use->def require.rkt 268)
                (list define.rkt 109 114)
                "nominal-use->def: prefix-in `plain` part of `PRE:plain`")
  (check-equal? (use->def require.rkt 268)
                (list define.rkt 88 93)
                "use->def: prefix-in `plain` part of `PRE:plain`")
  (check-equal? (nominal-use->def require.rkt 461)
                (list require.rkt 405 410)
                "nominal-use->def: `plain` is from rename-in not from define.rkt")

  (check-equal? (use->def require.rkt 134)
                (list define.rkt 958 961)
                "use->def: `sub`")
  (check-equal? (nominal-use->def require.rkt 134)
                (list define.rkt 1051 1054)
                "nominal-use->def: outermost provide of `sub`")
  #;
  (check-equal? (nominal-use->def define.rkt 1051)
                (list define.rkt 979 982)
                "nominal-use->def: outermost provide of `sub` => submod provide; check-syntax arrow bug???")
  (check-equal? (nominal-use->def define.rkt 979)
                (list define.rkt 958 961)
                "nominal-use->def: submod provide of `sub` to definition")

  (check-equal? (use->def require.rkt 138)
                (list define.rkt 958 961)
                "use->def: sub/renamed")
  (check-equal? (nominal-use->def require.rkt 138)
                (list define.rkt 1055 1066)
                "nominal-use->def: outermost provide of sub/renamed")

  (check-equal? (nominal-use->def require.rkt 529)
                (list define.rkt 1545 1553)
                "nominal-use->def: a-struct")
  (check-equal? (nominal-use->def require.rkt 538)
                (list define.rkt 1545 1553)
                "nominal-use->def: a-struct?")
  (check-equal? (nominal-use->def require.rkt 548)
                (list define.rkt 1545 1553)
                "nominal-use->def: imported a-struct-a")
  (check-equal? (nominal-use->def require.rkt 557)
                (list define.rkt 1555 1556)
                "nominal-use->def: imported 'a' field portion of a-struct-a")
  (check-equal? (nominal-use->def require.rkt 559)
                (list define.rkt 1545 1553)
                "nominal-use->def: imported a-struct-b")
  (check-equal? (nominal-use->def define.rkt 1593)
                (list define.rkt 1545 1553)
                "nominal-use->def: local a-struct portion of a-struct-a")
  (check-equal? (use->def define.rkt 1602)
                (list define.rkt 1555 1556)
                "nominal-use->def: local 'a' field portion of a-struct-a")

  ;;; rename-sites

  (check-equal? (rename-sites define.rkt 88)
                (hash define.rkt '((88 . 93) (109 . 114) (138 . 143))
                      require.rkt '((42 . 47) (268 . 273) (509 . 514)))
                "rename-sites: plain")

  (check-equal? (rename-sites define.rkt 322)
                (hash define.rkt '((322 . 325) (363 . 366)))
                "rename-sites: c/r")

  (check-equal? (rename-sites define.rkt 207)
                (hash define.rkt '((165 . 176) (207 . 218))
                      require.rkt '((56 . 67)))
                "rename-sites: contracted1")

  (check-equal? (rename-sites define.rkt 367)
                (hash define.rkt '((367 . 385))
                      require.rkt '((80 . 98) (294 . 312) (433 . 451)))
                "rename-sites: contracted/renamed")

  (check-equal? (rename-sites require.rkt 405)
                (hash require.rkt '((405 . 410) (461 . 466)))
                "rename-sites: `plain` from only-in rename")

  (check-equal? (rename-sites require.rkt 452)
                (hash require.rkt '((452 . 455) (469 . 472)))
                "rename-sites: `c/r` from only-in rename")

  (check-equal? (rename-sites require.rkt 515)
                (hash require.rkt '((515 . 518) (524 . 527)))
                "rename-sites: `XXX` from rename-in")

  (check-equal? (rename-sites require.rkt 242)
                (hash require.rkt '((242 . 246) (264 . 268) (276 . 280) (290 . 294)))
                "rename-sites: `PRE:` from prefix-in")

  (check-equal? (rename-sites require.rkt 637)
                (hash require.rkt '((637 . 640) (646 . 649) (674 . 677)))
                "rename-sites: rename-in, use, plus rename-out")

  (check-equal? (use->def/same-name require.rkt 629)
                (list define.rkt 144 151)
                "use->def/same-name: `renamed` as old name in rename-in clause")
  (check-equal? (rename-sites require.rkt 48)
                (hash define.rkt '((144 . 151))
                      require.rkt '((48 . 55) (280 . 287) (397 . 404) (629 . 636)))
                "rename-sites: `renamed`")

  (check-equal? (rename-sites require.rkt 753)
                (hash require.rkt '((134 . 137) (753 . 756))
                      define.rkt '((958 . 961) (979 . 982) (1007 . 1010) (1051 . 1054)))
                "rename-sites: rename-sites handles re-provides from submods"))

(define-example-file define-foo.rkt)
(define-example-file define-bar.rkt)
(define-example-file re-provide.rkt)
(define-example-file require-re-provide.rkt)

(define (re-provide-tests)
  (analyze-path define-foo.rkt #:always? #t)
  (analyze-path define-bar.rkt #:always? #t)
  (analyze-path re-provide.rkt #:always? #t)
  (analyze-path require-re-provide.rkt #:always? #t)
  (check-equal? (use->def require-re-provide.rkt 41)
                (list define-foo.rkt 36 39)
                "use->def: foo")
  (check-equal? (nominal-use->def require-re-provide.rkt 41)
                (list define-foo.rkt 23 26)
                "nominal-use->def: foo [all-from-out]")
  (check-equal? (rename-sites define-foo.rkt 36)
                (hash define-foo.rkt '((23 . 26) (36 . 39))
                      require-re-provide.rkt '((41 . 44)))
                "rename-sites: foo")

  (check-equal? (use->def require-re-provide.rkt 45)
                (list define-bar.rkt 36 39)
                "use->def: bar")
  (check-equal? (nominal-use->def require-re-provide.rkt 45)
                (list re-provide.rkt 119 122)
                "nominal-use->def: bar")
  (check-equal? (use->def require-re-provide.rkt 45)
                (list define-bar.rkt 36 39)
                "nominal-use->def: bar")
  (check-equal? (rename-sites define-bar.rkt 36)
                (hash define-bar.rkt '((23 . 26) (36 . 39))
                      re-provide.rkt '((119 . 122))
                      require-re-provide.rkt '((45 . 48)))
                "rename-sites: bar"))

(define-example-file ado-define.rkt)
(define-example-file ado-require.rkt)

(define (all-defined-out-tests)
  (analyze-path ado-define.rkt #:always? #t)
  (analyze-path ado-require.rkt #:always? #t)
  (check-equal? (use->def ado-require.rkt 46)
                (list ado-define.rkt 35 36))
  (check-equal? (rename-sites ado-require.rkt 46)
                (hash ado-require.rkt '((46 . 47))
                      ado-define.rkt '((35 . 36)))
                "all-defined-out: rename-sites for a"))

(define-example-file multi/1.rkt)
(define-example-file multi/2.rkt)
(define-example-file prefix-all-from-source.rkt)
(define-example-file prefix-define.rkt)
(define-example-file prefix-require.rkt)

(define (prefix-tests)
  (analyze-path prefix-all-from-source.rkt #:always? #t)
  (analyze-path prefix-define.rkt #:always? #t)
  (analyze-path prefix-require.rkt #:always? #t)
  (check-equal? (rename-sites prefix-require.rkt 68) ;(prefix-in IN: "prefix-define.rkt")
                (hash prefix-require.rkt
                      '((68 . 71) ;(prefix-in IN: "prefix-define.rkt")
                        (110 . 113) ;IN:A:a
                        (117 . 120) ;IN:ALL:a
                        (126 . 129))) ;IN:ALL:b
                "rename-sites for the `IN:` in (prefix-in IN: \"prefix-define.rkt\")")
  ;; These next two tests need `prefix-out` to supply a syntax
  ;; property -- which it does not until Racket PR
  ;; <https://github.com/racket/racket/pull/4649> is merged.
  (check-equal? (rename-sites prefix-define.rkt 27) ;(define a 42)
                (hash prefix-define.rkt
                      '((27 . 28) ;(define a 42)
                        (71 . 72)) ;(prefix-out A: a)
                      prefix-require.rkt
                      '((96 . 97) ;A:a
                        (102 . 103) ;ALL:a
                        (115 . 116) ;IN:A:a
                        (124 . 125))) ;IN:ALL:a
                "rename-sites for `a`, which is provided using multiple, non-nested prefix-out forms")
  (check-equal? (rename-sites prefix-define.rkt 68) ;(prefix-out A: a)
                (hash prefix-define.rkt
                      '((68 . 70)) ;(prefix-out A: a)
                      prefix-require.rkt
                      '((94 . 96) ;A:a
                        (113 . 115))) ;IN:A:a
                "rename-sites for the `A:` in (prefix-out A: a)")
  ;; These tests of nested prefix-out need the syntax property to be
  ;; correct; in the PR, prefix-out must combine properties correctly.
  (check-equal? (rename-sites prefix-require.rkt 135)
                (hash prefix-define.rkt '((155 . 162))
                      prefix-require.rkt '((135 . 142)
                                          (251 . 258)))
                "nested prefix-out handled correctly: `NESTED:`")
  (check-equal? (rename-sites prefix-require.rkt 142)
                (hash prefix-define.rkt '((175 . 184))
                      prefix-require.rkt '((142 . 151)
                                           (258 . 267)))
                "nested prefix-out handled correctly: `PREFIXES:`")
  (check-equal? (rename-sites prefix-require.rkt 151)
                (hash prefix-define.rkt '((197 . 201))
                      prefix-require.rkt '((151 . 155)
                                           (267 . 271)))
                "nested prefix-out handled correctly: `FUN:`")
  (check-equal? (rename-sites prefix-require.rkt 155)
                (hash prefix-define.rkt '((128 . 129)
                                          (202 . 203))
                      prefix-require.rkt '((155 . 156)
                                           (271 . 272)))
                "nested prefix-out handled correctly: `c`")
  ;; Likewise these tests need the PR where syntax properties are
  ;; added correctly for nested uses of prefix-in. [Non-nested and
  ;; otherwise sufficiently simple uses of prefix-in expand to a
  ;; primitive (#%require (prefix ___)) that drracket/check-syntax
  ;; already handles by creating two arrows.]
  (check-equal? (rename-sites prefix-require.rkt 225)
                (hash prefix-require.rkt '((177 . 183)
                                           (225 . 231)
                                           (239 . 245)))
                "nested prefix-in handled correctly: `OUTER:`")
  (check-equal? (rename-sites prefix-require.rkt 231)
                (hash prefix-require.rkt '((195 . 201)
                                           (231 . 237)
                                           (245 . 251)))
                "nested prefix-in handled correctly: `INNER:`")
  (check-equal? (rename-sites prefix-require.rkt 237)
                (hash prefix-require.rkt '((237 . 238))
                      prefix-define.rkt '((216 . 217)
                                          (231 . 232)))
                "nested prefix-in handled correctly: `d`")
  (check-equal? (rename-sites prefix-require.rkt 329)
                (hash prefix-require.rkt '((329 . 333))
                      prefix-define.rkt '((295 . 299)))
                "(prefix-out (all-from-out)) handled correctly for prefix `pre:`")
  (check-equal? (rename-sites prefix-require.rkt 333)
                (hash prefix-require.rkt '((333 . 335))
                      prefix-all-from-source.rkt '((27 . 29) (43 . 45)))
                "(prefix-out (all-from-out)) handled correctly for suffix `re`")
  ;; Test mix of prefix-out property and sub-range-binders property
  ;; (latter for a struct).
  (check-equal? (rename-sites prefix-require.rkt 336)
                (hash prefix-require.rkt '((336 . 341))
                      prefix-define.rkt '((392 . 397)))
                "(prefix-out (struct-out)) `zoom-` prefix")
  (check-equal? (rename-sites prefix-require.rkt 341)
                (hash prefix-require.rkt '((341 . 347))
                      prefix-define.rkt '((355 . 361)
                                          (410 . 416)))
                "(prefix-out (struct-out)) `apples`")
  (check-equal? (rename-sites prefix-require.rkt 348)
                (hash prefix-require.rkt '((348 . 353))
                      prefix-define.rkt '((363 . 368)))
                "(prefix-out (struct-out)) `field`")
  ;; multi-in
  (check-equal? (rename-sites prefix-require.rkt 425)
                (hash prefix-require.rkt '((425 . 427)
                                           (436 . 438))
                      multi/1.rkt '((27 . 29)
                                    (43 . 45)
                                    (76 . 78)))
                "m1 via multi-in from multi-in/1.rkt")
  (check-equal? (rename-sites prefix-require.rkt 439)
                (hash prefix-require.rkt '((439 . 441)
                                           (450 . 452))
                      multi/2.rkt '((27 . 29)
                                    (43 . 45)
                                    (76 . 78)))
                "m2 via multi-in from multi-in/2.rkt")
  ;; Nested prefix-out across module boundaries
  (check-equal? (use->def/same-name prefix-require.rkt 453)
                (list prefix-define.rkt 560 566)
                "outer:")
  (check-equal? (rename-sites prefix-require.rkt 453)
                (hash prefix-require.rkt '((453 . 459))
                      prefix-define.rkt '((560 . 566) (591 . 597) (614 . 620)))
                "outer:")
  (check-equal? (use->def/same-name prefix-require.rkt 459)
                (list prefix-define.rkt 510 516)
                "inner:")
  (check-equal? (rename-sites prefix-require.rkt 459)
                (hash prefix-require.rkt '((459 . 465))
                      prefix-define.rkt '((510 . 516) (567 . 573) (597 . 603) (620 . 626)))
                "inner:")
  (check-equal? (use->def/same-name prefix-require.rkt 465)
                (list prefix-define.rkt 479 480)
                "x")
  (check-equal? (rename-sites prefix-require.rkt 465)
                (hash prefix-require.rkt '((465 . 466))
                      prefix-define.rkt '((479 . 480) (517 . 518) (573 . 574) (603 . 604) (626 . 627)))
                "x"))

(define-example-file phase/single.rkt)
(define-example-file phase/define.rkt)
(define-example-file phase/require.rkt)

(define (phase-tests)
  (analyze-path phase/single.rkt #:always? #t)
  (check-equal? (use->def phase/single.rkt 233)
                (list phase/single.rkt 125 126)
                "phase 0 use->def")
  (check-equal? (use->def phase/single.rkt 276)
                (list phase/single.rkt 177 178)
                "phase 1 use->def")

  (analyze-path phase/define.rkt #:always? #t)
  (analyze-path phase/require.rkt #:always? #t)
  (check-equal? (use->def phase/require.rkt 97)
                (list phase/define.rkt 64 65)
                "phase 0 use->def")
  (check-equal? (use->def phase/require.rkt 140)
                (list phase/define.rkt 110 111)
                "phase 1 use->def")

  (check-equal? (nominal-use->def phase/require.rkt 97)
                (list phase/define.rkt 78 79)
                "phase 0 nominal-use->def")
  (check-equal? (use->def phase/require.rkt 97)
                (list phase/define.rkt 64 65)
                "phase 0 use->def")
  (check-equal? (nominal-use->def phase/require.rkt 140)
                (list phase/define.rkt 126 127)
                "phase 1 nominal-use->def")
  (check-equal? (use->def phase/require.rkt 140)
                (list phase/define.rkt 110 111)
                "phase 1 use->def")
  (check-equal? (nominal-use->def phase/require.rkt 164)
                (list phase/define.rkt 154 167)
                "phase 1 nominal-use->def rename-out"))

(define-example-file space/define.rkt)
(define-example-file space/require.rkt)

(define (space-tests)
  (analyze-path space/define.rkt #:always? #t)
  (analyze-path space/require.rkt #:always? #t)
  (test-case "phase 0 space #f things still work"
    (check-equal? (use->def space/require.rkt 70)
                  (list space/define.rkt 312 318)
                  "phase 0 space #f use->def")
    (check-equal? (rename-sites space/define.rkt 312)
                  (hash space/define.rkt '((97 . 103) (312 . 318))
                        space/require.rkt '((70 . 76)))
                  "phase 0 space #f rename-sites"))
  (test-case "non-#f spaces"
    ;; TODO: More tests involving spaces --- but it looks like
    ;; drracket/check-syntax isn't drawing arrows for these, yet, so
    ;; not sure what to test, yet.
    ))

(define-example-file meta-lang.rkt)

(define (meta-lang-tests)
  (analyze-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.
  (define a (span-map-ref (arrow-map-use->def (file-arrows (get-file meta-lang.rkt))) 27))
  (check-true (import-arrow? a))
  (check-equal? (arrow-def-beg a) 14))

(define-example-file typed.rkt)
(define-example-file typed-error.rkt)

(define (typed-tests)
  (analyze-path typed.rkt #:always? #t)
  (check-equal? (span-map->list (file-syncheck-mouse-overs (get-file typed.rkt)))
                '(((7 . 24) "4 bound occurrences")
                  ((26 . 27) "(-> Number Number)")
                  ((27 . 33) "imported from typed/racket/base")
                  ((35 . 36) "no bound occurrences")
                  ((38 . 39) "1 bound occurrence")
                  ((53 . 53) "imported from typed/racket/base")
                  ((53 . 54) "Number")
                  ((54 . 55) "imported from typed/racket/base" "(-> Number * Number)")
                  ((56 . 57) "Number")
                  ((58 . 58) "imported from typed/racket/base")
                  ((58 . 59) "One")
                  ((59 . 60) "Number")
                  ((60 . 61) "(-> Number Number)"))
                "Typed Racket mouse-overs from online-check-syntax logger")

  (analyze-path typed-error.rkt #:always? #t)
  (check-equal? (span-map->list (file-pdb-errors (get-file typed-error.rkt)))
                `(((45 . 46) (#f . ,(~a typed-error.rkt
                                        ":4:5: Type Checker: type mismatch\n  expected: Number\n  given: Any\n  in: x")))
                  ((71 . 72) (#f . ,(~a typed-error.rkt
                                        ":7:5: Type Checker: type mismatch\n  expected: Number\n  given: Any\n  in: x"))))
                "Typed Racket: multiple pre-exn errors gathered")
  (check-equal? (span-map->list (file-syncheck-mouse-overs (get-file typed-error.rkt)))
                '(((26 . 27) "(-> Any Nothing)")
                  ((43 . 44) "(-> Number * Number)")
                  ((45 . 46) "type mismatch\n  expected: Number\n  given: Any")
                  ((47 . 48) "One")
                  ((49 . 50) "(-> Any Nothing)")
                  ((52 . 53) "(-> Any Nothing)")
                  ((69 . 70) "(-> Number * Number)")
                  ((71 . 72) "type mismatch\n  expected: Number\n  given: Any")
                  ((73 . 74) "One")
                  ((75 . 76) "(-> Any Nothing)"))
                "Typed Racket error: mouse-overs from online-check-syntax logger"))

(define-example-file error.rkt)
(define-example-file require-error.rkt)

(define (error-tests)
  (analyze-path require-error.rkt #:always? #t)
  (check-true
   (match (span-map->list (file-pdb-errors (get-file require-error.rkt)))
     [(list (list (cons 28 35)
                  (cons (== error.rkt)
                        ;; This message has many system-dependent
                        ;; paths so not checking it here in detail.
                        (? string?))))
      #t]
     [_ #f])
   "Error in imported file is correctly recorded.")
  (let ()
    (define foo.rkt (build-path (find-system-path 'temp-dir) "foo.rkt"))
    (analyze-path foo.rkt #:code "#lang racket/base\n(" #:always? #t)
    (check-equal? (span-map->list (file-pdb-errors (get-file foo.rkt)))
                  (list
                   (list (cons 19 20)
                         (cons #f (string-append (path->string foo.rkt)
                                                 ":2:0: read-syntax: expected a `)` to close `(`"))))
                  "exn:fail:read in user program is recorded as error")
    (forget-path foo.rkt)

    (analyze-path foo.rkt #:code "#lang racket/base\n41" #:always? #t)
    (analyze-path foo.rkt #:code "#lang racket/base\n41 (")
    (check-false (set-empty? (get-completion-candidates foo.rkt 23))
                 "Analysis with errors supplies completion candidates from a previous analysis still in cache.")
    (analyze-path foo.rkt #:code "#lang racket/base\n41 ()")
    (check-false (set-empty? (get-completion-candidates foo.rkt 23))
                 "Analysis with errors supplies completion candidates from a previous analysis still in cache.")
    (forget-path foo.rkt)))

(define-example-file macro.rkt)

(define (macro-tests)
  (analyze-path macro.rkt #:always? #t)
  (check-equal? (use->def macro.rkt 372)
                (list macro.rkt 299 300)
                "There is a lexical arrow from `c.res` to `c`")
  (check-true (hash-empty? (rename-sites macro.rkt 372))
              "No rename sites despite lexical arrow because `c.res` and `c` are not same name.")
  (check-true (hash-empty? (rename-sites macro.rkt 299))
              "No rename sites despite lexical arrow because `c.res` and `c` are not same name"))

(define class-internal.rkt (with-handlers ([exn:fail? (λ _ #f)])
                             (resolve-module-path 'racket/private/class-internal)))

(define (large-file-tests)
  (when (and class-internal.rkt (file-exists? class-internal.rkt))
    (define (real-time proc . args)
      (define-values (_result _cpu real _gc) (time-apply proc args))
      real)
    ;; Although analyzing this large file might take 10+ seconds :( ...
    (analyze-path class-internal.rkt #:always? #t)
    ;; ... we can retrieve a range of annotations near its end very quickly
    (define rt (real-time get-annotations class-internal.rkt 247000 250000))
    (check-true (< rt 10)
                (format "Fast retrieve annotations near end of large file (actual: ~v)" rt))))

;; Test that, for every file position, the rename-site results set is
;; identical when rename-sites is called for every position in that
;; result set. IOW calling rename-sites for /any/ of them always
;; returns /all/ of them.
;;
;; Note that this test can fail unless /all/ relevant files have been
;; analyzed, so that all uses are known. As one example, two files may
;; use `define` as imported via #lang racket vs. #lang racket/base,
;; and as a result might give different results if the racket/base
;; graph has been discovered but not the racket graph. This is
;; complicated by us analyzing files JIT.
;;
;; Finally, this test is _extremely_ slow when run on a full analysis
;; of hundreds of files, such as the racket/collects tree.
;;
;; TL;DR: Although this isn't a sophisticated test it has helped me
;; find and fix various bugs for edge cases I wouldn't have imagined.
(define (exhaustive-rename-sites-test path)
  (printf "exhaustive-rename-sites-test ~v\n" path)

  (define ht (make-hash))
  (define (rename-sites/memo path pos)
    (hash-ref! ht
               (cons path pos)
               (λ () (rename-sites path pos))))

  (define len (add1 (string-length (file->string path))))
  (let loop ([pos 1]
             [previous-results #f])
    (when (< pos len)
      ;;(printf "~v::~v\n" path pos)
      (define results (rename-sites/memo path pos))
      (unless (equal? results previous-results)
        (for ([(this-path locs) (in-hash results)])
          ;;(printf " checking ~v locs in ~v\n" (set-count locs) this-path)
          (for ([loc (in-set locs)])
            (match-define (cons this-pos _) loc)
            (unless (and (equal? path this-path)
                         (equal? pos this-pos))
              (define this-results (rename-sites/memo this-path this-pos))
              (unless (equal? results this-results)
                (fail)
                (eprintf "Difference for:\n  ~a::~a\n  ~a::~a\n"
                         path pos this-path this-pos)

                (define d1 (use->def/same-name path pos))
                (define d2 (use->def/same-name this-path this-pos))
                (cond [(equal? d1 d2)
                       (eprintf "use->def/same-name equal for both, so the difference might be because more files need to be analyzed to know the full graph\n")]
                      [else
                       (eprintf "use->def/same-name differs:\n  ~v\n  ~v\n"
                                d1 d2)])

                (define ps1 (hash-keys results))
                (define ps2 (hash-keys this-results))
                (unless (equal? ps1 ps2)
                  (eprintf " Paths found only via former:\n  ~v\n"
                           (set-subtract ps1 ps2))
                  (eprintf " Paths found only via latter:\n  ~v\n"
                           (set-subtract ps2 ps1)))

                (define s1 (for*/set ([(p s) (in-hash results)]
                                      [s (in-set s)])
                             (cons p s)))
                (define s2 (for*/set ([(p s) (in-hash this-results)]
                                      [s (in-set s)])
                             (cons p s)))
                (unless (set=? s1 s2)
                  (parameterize ([error-print-width 1024])
                    (eprintf " Sites found only via former:\n  ~e\n"
                             (set-subtract s1 s2))
                    (eprintf " Sites found only via latter:\n  ~e\n"
                             (set-subtract s2 s1)))))))))
      (loop (add1 pos)
            results)))
  (newline))

(define (exhaustive-rename-tests)
  (printf "Running exhaustive-rename-sites-test for ~v files\n"
          (length example-files))
  (with-logging-to-port
    (current-output-port)
    (λ ()
      (displayln "ensuring full depth analysis")
      (add-directory example/ #:import-depth 999)
      (displayln "done"))
    'info 'pdb)
  (for-each exhaustive-rename-sites-test
            (reverse example-files)))

(module+ test
  (tests))

(module+ very-many-files-example
  (require (submod "store.rkt" stats))

  (collect-garbage 'major)
  (define starting-memory-use (current-memory-use))
  (define (print-memory-use)
    (collect-garbage 'major)
    (printf "~v MB memory use\n"
            (/ (- (current-memory-use) starting-memory-use)
               1024.0
               1024.0)))

  ;; Tip: When running these, it's useful to watch the logger topic
  ;; "pdb" at level "debug".

  ;; Use `add-directory' to analyze an entire directory tree,
  ;; and recur 2 deep on imported files.
  (define-runtime-path here ".")
  (time (add-directory here #:import-depth 2))
  (print-memory-use)

  ;; On my system -- with the non-minimal Racket distribution
  ;; installed, and about a dozen other packages -- this results in
  ;; about 8,000 files, which takes about 3 hours to analyze,
  ;; and yields a pdb.sqlite file size about 200 MB.
  (for ([d (in-list (list* (get-pkgs-dir 'installation)
                           (get-pkgs-dir 'user)
                           (current-library-collection-paths)))])
    (when (directory-exists? d)
      (time (add-directory d #:import-depth 32767))))
  (print-memory-use)
  (displayln (db-stats))

  (tests))