From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Sat, 2 Apr 2016 08:46:50 +0000 (-0700)
Subject: planetarium/mit-check.sh: Move tests here from mit-make.scm.
X-Git-Tag: mit-scheme-pucked-9.2.12~344
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b68631153ff387bf81ca1d77532c44000e04a3d2;p=mit-scheme.git

planetarium/mit-check.sh: Move tests here from mit-make.scm.
---

diff --git a/src/planetarium/mit-check.sh b/src/planetarium/mit-check.sh
index ba701329c..22afb68f7 100755
--- a/src/planetarium/mit-check.sh
+++ b/src/planetarium/mit-check.sh
@@ -23,33 +23,38 @@
 
 # Test the PLANETARIUM option.
 
-set -e
+set -ex
 : ${MIT_SCHEME_EXE=mit-scheme}
 ${MIT_SCHEME_EXE} --prepend-library . <<\EOF
 (begin
-
   (set! *initial-options-file* (merge-pathnames "mit-optiondb.scm"))
 
   (load-option 'PLANETARIUM)
 
   (if (not (gtk-initialized?))
-      (warn "Could not test the planetarium without a DISPLAY.")
+      (warn "Could not test the planetarium.")
       (begin
 	(make-tellurion)
 
-	(let ((pkg (name->package '(planetarium terrain))))
-	  (if (not pkg)
+	(let ((env (->environment '(planetarium))))
+	  ((access test-julian-day env))
+	  ((access test-greenwich-mean-sidereal-time env))
+	  ((access test-solar-latitude/longitude env))
+	  ((access test-angular-separation env)))
+
+	(let ((env (->environment '(planetarium terrain))))
+	  (if (not env)
 	      (warn "Could not test terrain viewer.")
-	      (let ((env (package/environment pkg)))
+	      (begin
+		((access test-normals env))
 		(if (not (file-exists? "sample-terrain.txt"))
 		    ((access write-sample-terrain env)
 		     "sample-terrain.txt" 20 20))
-		((access test-normals env))
 		(let ((view (make-terrain "sample-terrain.txt"
-					  20 20 0. 0. .01)))
-		  (view 'position 0. 0. 20000.)
-		  (view 'heading 50.)
-		  (view 'tilt -50.)))))
+					  20 20 0. 0. .001)))
+		  (view 'position -.01 0. 2000.)
+		  (view 'heading 25.)
+		  (view 'tilt -45.)))))
 
 	(let ((env (->environment '(gtk gtk-widget))))
 	  (let loop ()
diff --git a/src/planetarium/mit-make.scm b/src/planetarium/mit-make.scm
index ad2d5c338..3836b2936 100644
--- a/src/planetarium/mit-make.scm
+++ b/src/planetarium/mit-make.scm
@@ -33,13 +33,6 @@ USA.
   (lambda ()
     (parameterize ((param:suppress-loading-message? #t))
       (load-package-set "mit")
-      (let ((env (->environment '(planetarium))))
-	((access test-julian-day env))
-	((access test-greenwich-mean-sidereal-time env))
-	((access test-solar-latitude/longitude env))
-	((access test-angular-separation env)))
       (load "mit-link")
       (if (not (warn-errors? (lambda () (load-option 'GL))))
-	  (begin
-	    (load-package-set "mit-3d")
-	    ((access test-normals (->environment '(planetarium terrain)))))))))
\ No newline at end of file
+	  (load-package-set "mit-3d")))))
\ No newline at end of file