root/packages/minpack/run-minpack-tests.lisp @ 1091:fcafbccc7112

Revision 1091:fcafbccc7112, 1.8 KB (checked in by rtoy, 3 years ago)

Pathnames need a :directory component to prevent merging the directory
in from *default-pathname-defaults*.

Line 
1(in-package :minpack)
2
3;; After running the tests, compare the output files (tlmdif.txt,
4;; tlmder.txt) with the reference Fortran results (lmdif-ref.txt,
5;; lmder-ref.txt.)
6(defun run-minpack-tests ()
7  (flet
8      ((run-test (input-file f)
9         (with-open-file (input input-file :direction :input)
10           (with-open-file (output (make-pathname :host "minpack"
11                                                  :directory '(:absolute)
12                                                  :name (string-downcase (string f))
13                                                  :type "txt")
14                                   :direction :output
15                                   :if-exists :supersede)
16             (let ((old-in-lun (gethash 5 f2cl-lib::*lun-hash*))
17                   (old-out-lun (gethash 6 f2cl-lib::*lun-hash*)))
18               (unwind-protect
19                    (progn
20                      (setf (gethash 5 f2cl-lib::*lun-hash*) input)
21                      (setf (gethash 6 f2cl-lib::*lun-hash*)
22                            (make-broadcast-stream output *standard-output*))
23                      (funcall f))
24                 (setf (gethash 5 f2cl-lib::*lun-hash*) old-in-lun)
25                 (setf (gethash 6 f2cl-lib::*lun-hash*) old-out-lun)))))))
26    (dolist (f '(tlmdif tlmder))
27      (run-test "minpack:lmdif-input.dat" f))))
28
29(defun run-minpack-test-hybrd ()
30  (flet
31      ((run-test (input-file f)
32         (with-open-file (input input-file :direction :input)
33           (with-open-file (output (make-pathname :host "minpack"
34                                                  :directory '(:absolute)
35                                                  :name (string-downcase (string f))
36                                                  :type "txt")
37                                   :direction :output
38                                   :if-exists :supersede)
39             (let ((old-in-lun (gethash 5 f2cl-lib::*lun-hash*))
40                   (old-out-lun (gethash 6 f2cl-lib::*lun-hash*)))
41               (unwind-protect
42                    (progn
43                      (setf (gethash 5 f2cl-lib::*lun-hash*) input)
44                      (setf (gethash 6 f2cl-lib::*lun-hash*)
45                            (make-broadcast-stream output *standard-output*))
46                      (funcall f))
47                 (setf (gethash 5 f2cl-lib::*lun-hash*) old-in-lun)
48                 (setf (gethash 6 f2cl-lib::*lun-hash*) old-out-lun)))))))
49    (dolist (f '(thybrd))
50      (run-test "minpack:hybrd-input.dat" f))))
51 
52
53 
Note: See TracBrowser for help on using the browser.