Megatest

Check-in [e984e41fb4]
Login
Overview
Comment:enahnced -log so it will create leading directory if specified
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.63-xor-report
Files: files | file ages | folders
SHA1: e984e41fb4a3986da3bf880d1a97abe013ef328b
User & Date: bjbarcla on 2017-02-01 13:49:10
Other Links: branch diff | manifest | tags
Context
2017-02-01
16:01
updated ducttape-lib to fix incompatibilities with megatest check-in: ffa2b8e7af user: bjbarcla tags: v1.63-xor-report
13:49
enahnced -log so it will create leading directory if specified check-in: e984e41fb4 user: bjbarcla tags: v1.63-xor-report
2017-01-31
17:47
completed diff report feature check-in: 118224962b user: bjbarcla tags: v1.63-xor-report
Changes

Modified megatest.scm from [432cf9f86e] to [dd4987e3bd].

367
368
369
370
371
372
373
374












375
376

377
378
379
380
381
382
383
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387

388
389
390
391
392
393
394
395








+
+
+
+
+
+
+
+
+
+
+
+

-
+







;; The watchdog is to keep an eye on things like db sync etc.
;;
(define *watchdog* (make-thread common:watchdog "Watchdog thread"))

(if (not (args:get-arg "-server"))
    (thread-start! *watchdog*)) ;; if starting a server; wait till we get to running state before kicking off watchdog
;;(BB> "thread-start! watchdog")

;; bracket open-output-file with code to make leading directory if it does not exist and handle exceptions
(define (open-logfile logpath)
  (condition-case
   (let* ((log-dir (or (pathname-directory logpath) ".")))
     (if (not (directory-exists? log-dir))
         (system (conc "mkdir -p " log-dir)))
     (open-output-file logpath))
   (exn ()
        (debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath)
        (define *didsomething* #t)  
        (exit 1))))

(if (args:get-arg "-log")
    (let ((oup (open-output-file (args:get-arg "-log"))))
    (let ((oup (open-logfile (args:get-arg "-log"))))
      (debug:print-info 0 *default-log-port* "Sending log output to " (args:get-arg "-log"))
      (set! *default-log-port* oup)))

(if (or (args:get-arg "-h")
	(args:get-arg "-help")
	(args:get-arg "--help"))
    (begin