|
1 | 1 | #lang racket/base
|
2 |
| -(require racket/file |
3 |
| - racket/system |
4 |
| - compiler/find-exe |
5 |
| - pkg/lib) |
| 2 | +(require compiler/find-exe |
| 3 | + pkg/lib |
| 4 | + racket/file |
| 5 | + racket/system) |
6 | 6 |
|
7 | 7 | (module test racket/base) ; disable for DrDr
|
8 | 8 |
|
9 | 9 | (unless (eq? 'user (default-pkg-scope))
|
10 | 10 | (error "Run this test with `user' default package scope"))
|
11 | 11 |
|
12 |
| -(define dir (make-temporary-file "~a" 'directory)) |
| 12 | +(define dir (make-temporary-directory "~a")) |
13 | 13 | (define pkg-dir (build-path dir "popcomp-pkg"))
|
14 | 14 | (define coll-dir (build-path pkg-dir "popcomp"))
|
15 | 15 | (define pkg2-dir (build-path dir "popcomp2-pkg"))
|
|
79 | 79 | ;; ----------------------------------------
|
80 | 80 |
|
81 | 81 | (module go racket/base
|
82 |
| - (require "private/drracket-test-util.rkt" |
83 |
| - racket/gui/base |
| 82 | + (require framework/test |
84 | 83 | racket/class
|
85 |
| - racket/path |
86 | 84 | racket/file
|
87 |
| - framework/test) |
| 85 | + racket/gui/base |
| 86 | + racket/path |
| 87 | + "private/drracket-test-util.rkt") |
88 | 88 |
|
89 | 89 | (define (check-compiled compiled? path)
|
90 | 90 | (unless (equal? compiled? (file-exists? path))
|
|
95 | 95 |
|
96 | 96 | (fire-up-drracket-and-run-tests
|
97 | 97 | (λ ()
|
98 |
| - (let ([drs (wait-for-drracket-frame)]) |
99 |
| - (define x (vector-ref (current-command-line-arguments) 0)) |
100 |
| - (define dir (path-only x)) |
101 |
| - |
102 |
| - (do-execute drs) |
| 98 | + (define drs (wait-for-drracket-frame)) |
| 99 | + (define x (vector-ref (current-command-line-arguments) 0)) |
| 100 | + (define dir (path-only x)) |
| 101 | + |
| 102 | + (do-execute drs) |
| 103 | + |
| 104 | + (define popcomp-main-zo |
| 105 | + (build-path dir "popcomp-pkg" "popcomp" "compiled" "drracket" "errortrace" "main_rkt.zo")) |
| 106 | + (define popcomp2-main-zo |
| 107 | + (build-path dir "popcomp2-pkg" "popcomp2" "compiled" "drracket" "errortrace" "main_rkt.zo")) |
103 | 108 |
|
104 |
| - (define popcomp-main-zo |
105 |
| - (build-path dir "popcomp-pkg" "popcomp" "compiled" "drracket" "errortrace" "main_rkt.zo")) |
106 |
| - (define popcomp2-main-zo |
107 |
| - (build-path dir "popcomp2-pkg" "popcomp2" "compiled" "drracket" "errortrace" "main_rkt.zo")) |
| 109 | + (check-compiled #t (build-path dir "compiled" "drracket" "errortrace" "y_rkt.zo")) |
| 110 | + (check-compiled #f popcomp-main-zo) |
| 111 | + (check-compiled #f popcomp2-main-zo) |
108 | 112 |
|
109 |
| - (check-compiled #t (build-path dir "compiled" "drracket" "errortrace" "y_rkt.zo")) |
110 |
| - (check-compiled #f popcomp-main-zo) |
111 |
| - (check-compiled #f popcomp2-main-zo) |
| 113 | + ;; Create a broken ".zo" file where it should not be used: |
| 114 | + (make-directory* (path-only popcomp-main-zo)) |
| 115 | + (call-with-output-file* popcomp-main-zo (lambda (o) (fprintf o "broken\n"))) |
112 | 116 |
|
113 |
| - ;; Create a broken ".zo" file where it should not be used: |
114 |
| - (make-directory* (path-only popcomp-main-zo)) |
115 |
| - (call-with-output-file* |
116 |
| - popcomp-main-zo |
117 |
| - (lambda (o) |
118 |
| - (fprintf o "broken\n"))) |
| 117 | + (do-execute drs) |
| 118 | + (let* ([got (fetch-output drs)]) |
| 119 | + (unless (string=? "" got) |
| 120 | + (error 'check-output "wrong output: ~s" got))) |
119 | 121 |
|
120 |
| - (do-execute drs) |
121 |
| - (let* ([got (fetch-output drs)]) |
122 |
| - (unless (string=? "" got) |
123 |
| - (error 'check-output "wrong output: ~s" got))) |
| 122 | + (delete-file popcomp-main-zo) |
124 | 123 |
|
125 |
| - (delete-file popcomp-main-zo) |
| 124 | + ;; Open "main.rkt" in "popcomp-pkg", so now it should be compiled |
| 125 | + ;; when we run "x.rkt": |
126 | 126 |
|
127 |
| - ;; Open "main.rkt" in "popcomp-pkg", so now it should be compiled |
128 |
| - ;; when we run "x.rkt": |
| 127 | + (test:menu-select "File" "New Tab") |
| 128 | + (use-get/put-dialog (λ () (test:menu-select "File" "Open…")) |
| 129 | + (build-path dir "popcomp-pkg" "popcomp" "main.rkt")) |
129 | 130 |
|
130 |
| - (test:menu-select "File" "New Tab") |
131 |
| - (use-get/put-dialog (λ () |
132 |
| - (test:menu-select "File" "Open…")) |
133 |
| - (build-path dir "popcomp-pkg" "popcomp" "main.rkt")) |
| 131 | + (queue-callback/res (λ () (send drs change-to-tab (car (send drs get-tabs))))) |
134 | 132 |
|
135 |
| - (queue-callback/res (λ () (send drs change-to-tab (car (send drs get-tabs))))) |
| 133 | + (do-execute drs) |
136 | 134 |
|
137 |
| - (do-execute drs) |
| 135 | + (check-compiled #t popcomp-main-zo) |
| 136 | + (check-compiled #f popcomp2-main-zo) |
138 | 137 |
|
139 |
| - (check-compiled #t popcomp-main-zo) |
140 |
| - (check-compiled #f popcomp2-main-zo) |
| 138 | + ;; But if the "popcomp-pkg" directory is not writable, then |
| 139 | + ;; don't compile after all: |
141 | 140 |
|
142 |
| - ;; But if the "popcomp-pkg" directory is not writable, then |
143 |
| - ;; don't compile after all: |
| 141 | + (delete-file popcomp-main-zo) |
| 142 | + (file-or-directory-permissions (build-path dir "popcomp-pkg") #o555) |
144 | 143 |
|
145 |
| - (delete-file popcomp-main-zo) |
146 |
| - (file-or-directory-permissions (build-path dir "popcomp-pkg") #o555) |
147 |
| - |
148 |
| - (do-execute drs) |
| 144 | + (do-execute drs) |
149 | 145 |
|
150 |
| - (check-compiled #f popcomp-main-zo) |
151 |
| - (check-compiled #f popcomp2-main-zo) |
| 146 | + (check-compiled #f popcomp-main-zo) |
| 147 | + (check-compiled #f popcomp2-main-zo) |
152 | 148 |
|
153 |
| - (file-or-directory-permissions (build-path dir "popcomp-pkg") #o777))))) |
| 149 | + (file-or-directory-permissions (build-path dir "popcomp-pkg") #o777)))) |
0 commit comments