planetarium/mit-check.sh: Move tests here from mit-make.scm.
authorMatt Birkholz <puck@birchwood-abbey.net>
Sat, 2 Apr 2016 08:46:50 +0000 (01:46 -0700)
committerMatt Birkholz <puck@birchwood-abbey.net>
Sat, 2 Apr 2016 08:46:50 +0000 (01:46 -0700)
src/planetarium/mit-check.sh
src/planetarium/mit-make.scm

index ba701329ca79f3cb2378bd6e454bef7c8543d222..22afb68f7227959f7257facbc609bc30873d80ae 100755 (executable)
 
 # 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 ()
index ad2d5c338137126bf076a619b2a62c3f1ec2a9d3..3836b293661dfaffbce3058e2e35dea1f49e0e8a 100644 (file)
@@ -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