suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adjust raco pkg tests to work with Racket CS overlay

Browse Source 
Commands that use `raco` need to be `racocs`, etc.
This commit is contained in:
Matthew Flatt 2019-12-17 08:38:04 -07:00
parent d7f2bd3e15
commit 81d73d9849
5 changed files with 67 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
pkgs/racket-test/tests/pkg/shelly.rkt
View File

@ -3,6 +3,7 @@
racket/port
racket/system
racket/match
compiler/find-exe
(for-syntax racket/base
syntax/parse))
@ -56,8 +57,8 @@
#:attr
code
(quasisyntax/loc
#'command-line
(let ([cmd command-line])
#'command-line
(let ([cmd (rename-racket command-line)])
(check-case
cmd
(define output-port (open-output-string))
@ -144,4 +145,32 @@
(shelly-begin after ...))))]))
;; }}
(define racket-run-suffix
(let ()
(define racket (find-exe))
(cond
[racket
(define-values (base name dir?) (split-path racket))
(define m (regexp-match #rx"^(?i:racket)(.*)$" (path-element->string name)))
(define suffix (and m (cadr m)))
(and (not (equal? suffix ""))
suffix)]
[else #f])))
;; Add a suffix ro "racket" or "raco", if there's one on the current executable
(define rename-racket
(cond
[racket-run-suffix
;; Adjust comands by adding a suffix:
(lambda (cmd)
(cond
[(regexp-match-positions #rx"^(racket|raco) " cmd)
=> (lambda (m)
(string-append (substring cmd 0 (cdadr m))
racket-run-suffix
(substring cmd (cdadr m))))]
[else cmd]))]
[else
(lambda (cmd) cmd)]))
(provide (all-defined-out))

18
pkgs/racket-test/tests/pkg/tests-binary.rkt
View File

@ -143,6 +143,10 @@
(let ([src (path->complete-path (format "test-pkgs/src-pkgs/pkg-~a.zip" name))]
[bin (path->complete-path (format "test-pkgs/pkg-~a.zip" name))]
[blt (path->complete-path (format "test-pkgs/built-pkgs/pkg-~a.zip" name))])
(define compiled-dir (let ([l (use-compiled-file-paths)])
(if (null? l)
(string->path-element "compiled")
(car l))))
(define sd (build-path tmp-dir name "src"))
(define bd (build-path tmp-dir name "bin"))
(define td (build-path tmp-dir name "blt"))
@ -167,7 +171,7 @@
(when (regexp-match? #rx#"[.](rkt|scrbl|ss)$" f)
(let-values ([(base name dir?) (split-path f)])
(unless (file-exists? (build-path (if (eq? base 'relative) 'same base)
"compiled"
compiled-dir
(path-add-suffix name #".zo")))
(unless (regexp-match? #rx#"^(?:info.rkt|x/keep.scrbl)$" f)
(error 'build "compiled file missing for ~s" f)))))))
@ -189,10 +193,14 @@
(and (path? base)
(let-values ([(base name dir?) (split-path base)])
(or (eq? base 'relative)
(and (path? name)
(equal? (path->string name) "compiled")
(let-values ([(base name dir?) (split-path base)])
(eq? base 'relative))))))))))
(let loop ([elems (explode-path compiled-dir)] [name name] [base base])
(and (path? name)
(cond
[(eq? base 'relative) #t]
[(null? elems) #f]
[(equal? (path->string name) (path->string compiled-dir))
(let-values ([(base name dir?) (split-path base)])
(loop (cdr elems) name base))]))))))))))
(for ([f (in-directory)])
(when (file-exists? f)
(unless (file-exists? (build-path td f))

14
pkgs/racket-test/tests/pkg/tests-conflicts.rkt
View File

@ -169,8 +169,12 @@
(with-fake-root
(shelly-case
"non-conflicts on .zo files that will be deletced by `raco setup`"
"non-conflicts on .zo files that will be deleted by `raco setup`"
(define compiled-dir (let ([l (use-compiled-file-paths)])
(if (null? l)
"compiled"
(car l))))
(define (copy+install-not-conflict)
(define t1nc-dir (make-temporary-file "~a-t1nc" 'directory))
(define src-dir "test-pkgs/pkg-test1-not-conflict/")
@ -184,18 +188,18 @@
(case mode
[(src)
(set-file (build-path t1nc-dir "data" "empty-set.rkt") "#lang racket/base 'empty")
(maybe-delete-file (build-path t1nc-dir "data" "compiled" "empty-set_rkt.zo"))
(maybe-delete-file (build-path t1nc-dir "data" compiled-dir "empty-set_rkt.zo"))
(maybe-delete-file (build-path t1nc-dir "data" "info.rkt"))]
[(both)
(set-file (build-path t1nc-dir "data" "empty-set.rkt") "#lang racket/base 'empty")
(set-file (build-path t1nc-dir "data" "compiled" "empty-set_rkt.zo") "not real...")
(set-file (build-path t1nc-dir "data" compiled-dir "empty-set_rkt.zo") "not real...")
(set-file (build-path t1nc-dir "data" "info.rkt") "#lang info\n(define assume-virtual-sources #t)")]
[(zo-stays)
(set-file (build-path t1nc-dir "data" "compiled" "empty-set_rkt.zo") "not real...")
(set-file (build-path t1nc-dir "data" compiled-dir "empty-set_rkt.zo") "not real...")
(maybe-delete-file (build-path t1nc-dir "data" "empty-set.rkt"))
(set-file (build-path t1nc-dir "data" "info.rkt") "#lang info\n(define assume-virtual-sources #t)")]
[(zo-goes)
(set-file (build-path t1nc-dir "data" "compiled" "empty-set_rkt.zo") "not real...")
(set-file (build-path t1nc-dir "data" compiled-dir "empty-set_rkt.zo") "not real...")
(maybe-delete-file (build-path t1nc-dir "data" "empty-set.rkt"))
(maybe-delete-file (build-path t1nc-dir "data" "info.rkt"))]))

5
pkgs/racket-test/tests/pkg/util.rkt
View File

@ -19,8 +19,9 @@
;; Use a consistent directory, so that individual tests can be
;; run after "tests-create.rkt":
(define-runtime-path test-directory (build-path (find-system-path 'temp-dir)
"pkg-test-work"))
(define test-directory (build-path (find-system-path 'temp-dir)
(string-append "pkg-test-work"
(or racket-run-suffix ""))))
(define (sync-test-directory)
(printf "Syncing test directory\n")

13
racket/collects/pkg/strip.rkt
View File

@ -69,6 +69,15 @@
(check-directory-exists 'generate-stripped-directory "source " dir)
(check-directory-exists 'generate-stripped-directory "destination " dest-dir)
(define compiled-dir
(case mode
[(binary binary-lib)
(define l (use-compiled-file-paths))
(if (pair? l)
(car l)
"compiled")]
[else #f]))
(define drop-keep-ns (make-base-namespace))
(define (add-drop+keeps dir base drops keeps)
(define get-info (get-info/full dir #:namespace drop-keep-ns))
@ -115,7 +124,7 @@
#t)))
(values (add drops more-drops)
(add keeps more-keeps)))
(define (drop-by-default? path get-p)
(define bstr (path->bytes path))
(define (immediate-doc/css-or-doc/js?)
@ -139,7 +148,7 @@
(and (regexp-match? #rx"[.](?:ss|rkt)$" bstr)
(not (equal? #"info.rkt" bstr))
(file-exists? (let-values ([(base name dir?) (split-path (get-p))])
(build-path base "compiled" (path-add-suffix name #".zo")))))
(build-path base compiled-dir (path-add-suffix name #".zo")))))
(immediate-doc/css-or-doc/js?)
(case mode
[(binary-lib)