From cb7c8232065b7ca82d05cea0aea0bdca2ed91e09 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 18 Jun 2006 01:58:29 +0000
Subject: [PATCH] improved create-executable test suite, fix for Mac OS X MrEd
 executable with given collection path

svn: r3391
---
 collects/compiler/embed-unit.ss  | 19 +++++++++-
 collects/tests/mzscheme/embed.ss | 65 ++++++++++++++++++++++++++++++++
 2 files changed, 82 insertions(+), 2 deletions(-)

diff --git a/collects/compiler/embed-unit.ss b/collects/compiler/embed-unit.ss
index 3d4efc30bd..57f5c5046f 100644
--- a/collects/compiler/embed-unit.ss
+++ b/collects/compiler/embed-unit.ss
@@ -585,7 +585,12 @@
 				    unix-starter?))
 	  (define relative? (let ([m (assq 'relative? aux)])
 			      (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?
 		      ((apply + (length cmdline) (map (lambda (s)
 							(bytes-length (string->bytes/utf-8 s)))
@@ -806,4 +811,14 @@
 			    (let ([m (and (eq? 'windows (system-type))
 					  (assq 'subsystem aux))])
 			      (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])))))
+
diff --git a/collects/tests/mzscheme/embed.ss b/collects/tests/mzscheme/embed.ss
index 2ffa11ba44..2a9685f9f7 100644
--- a/collects/tests/mzscheme/embed.ss
+++ b/collects/tests/mzscheme/embed.ss
@@ -170,4 +170,69 @@
  `("-ZmvqL" "embed-me5.ss" "tests/mzscheme"))
 (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)