improved create-executable test suite, fix for Mac OS X MrEd executable with given collection path

svn: r3391
This commit is contained in:
Matthew Flatt 2006-06-18 01:58:29 +00:00
parent c4592f7ab5
commit cb7c823206
2 changed files with 82 additions and 2 deletions

View File

@ -585,7 +585,12 @@
unix-starter?)) unix-starter?))
(define relative? (let ([m (assq 'relative? aux)]) (define relative? (let ([m (assq 'relative? aux)])
(and m (cdr m)))) (and m (cdr m))))
(define collects-path-bytes (collects-path->bytes collects-path)) (define collects-path-bytes (collects-path->bytes
((if (and mred?
(eq? 'macosx (system-type)))
mac-mred-collects-path-adjust
values)
collects-path)))
(unless (or long-cmdline? (unless (or long-cmdline?
((apply + (length cmdline) (map (lambda (s) ((apply + (length cmdline) (map (lambda (s)
(bytes-length (string->bytes/utf-8 s))) (bytes-length (string->bytes/utf-8 s)))
@ -806,4 +811,14 @@
(let ([m (and (eq? 'windows (system-type)) (let ([m (and (eq? 'windows (system-type))
(assq 'subsystem aux))]) (assq 'subsystem aux))])
(when m (when m
(set-subsystem dest-exe (cdr m)))))])))))))))))) (set-subsystem dest-exe (cdr m)))))])))))))))
;; For Mac OS X MrEd, the actual executable is deep inside the
;; nominal executable bundle
(define (mac-mred-collects-path-adjust p)
(cond
[(not p) #f]
[(list? p) (map mac-mred-collects-path-adjust p)]
[(relative-path? p) (build-path 'up 'up 'up p)]
[else p])))))

View File

@ -170,4 +170,69 @@
`("-ZmvqL" "embed-me5.ss" "tests/mzscheme")) `("-ZmvqL" "embed-me5.ss" "tests/mzscheme"))
(try-exe mr-dest "This is 5: #<struct:class:button%>\n" #t) (try-exe mr-dest "This is 5: #<struct:class:button%>\n" #t)
;; Try the mzc interface:
(require (lib "dirs.ss" "setup")
(lib "file.ss"))
(define mzc (build-path (find-console-bin-dir) "mzc"))
(define (mzc-tests mred?)
(parameterize ([current-directory (find-system-path 'temp-dir)])
(system* mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me1.ss")))
(try-exe (mk-dest mred?) "This is 1\n" mred?)
;; Check that etc.ss isn't found if it's not included:
(system* mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me6.ss")))
(try-exe (mk-dest mred?) "This is 6\nno etc.ss\n" mred?)
;; And it is found if it is included:
(system* mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
"++lib" "etc.ss" "mzlib"
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me6.ss")))
(try-exe (mk-dest mred?) "This is 6\n#t\n" mred?)
;; Or, it's found if we set the collection path:
(system* mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
"--collects-path"
(path->string (find-collects-dir))
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me6.ss")))
(try-exe (mk-dest mred?) "This is 6\n#t\n" mred?)
;; Try --collects-dest mode
(system* mzc
(if mred? "--gui-exe" "--exe")
(path->string (mk-dest mred?))
"++lib" "etc.ss" "mzlib"
"--collects-dest" "cts"
"--collects-path" "cts"
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me6.ss")))
(try-exe (mk-dest mred?) "This is 6\n#t\n" mred?)
(delete-directory/files "cts")
(try-exe (mk-dest mred?) "This is 6\nno etc.ss\n" mred?)
(void)))
(mzc-tests #t)
(mzc-tests #f)
;; One MrEd-specific test with mzc:
(parameterize ([current-directory (find-system-path 'temp-dir)])
(system* mzc
"--gui-exe"
(path->string (mk-dest #t))
(path->string (build-path (collection-path "tests" "mzscheme") "embed-me5.ss")))
(try-exe (mk-dest #t) "This is 5: #<struct:class:button%>\n" #t))
(report-errs) (report-errs)