improved create-executable test suite, fix for Mac OS X MrEd executable with given collection path
svn: r3391
This commit is contained in:
parent
c4592f7ab5
commit
cb7c823206
|
@ -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])))))
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user