Megatest

Diff
Login

Differences From Artifact [fd40d13cfe]:

To Artifact [c7ae0fc5df]:


505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520









521
522
523
524
525
526
527
505
506
507
508
509
510
511









512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527







-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+







(let ((targ (or (args:get-arg "-reqtarg")(args:get-arg "-target"))))
  (if targ (setenv "MT_TARGET" targ)))

;; The watchdog is to keep an eye on things like db sync etc.
;;

;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage
(define *watchdog* (make-thread
		    (lambda ()
		      (handle-exceptions
			  exn
			  (begin
			    (print-call-chain)
			    (print " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn))
			(common:watchdog)))
		    "Watchdog thread"))
;;(define *watchdog* (make-thread
;;		    (lambda ()
;;		      (handle-exceptions
;;			  exn
;;			  (begin
;;			    (print-call-chain)
;;			    (print " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn))
;;			(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
(let* ((no-watchdog-args
       '("-list-runs"
         "-testdata-csv"
         "-list-servers"
545
546
547
548
549
550
551
552
553




554
555
556
557
558
559
560
545
546
547
548
549
550
551


552
553
554
555
556
557
558
559
560
561
562







-
-
+
+
+
+







                                               (if (null? tail)
                                                 #t
                                                 (loop (car tail) (cdr tail))))))      
       (no-watchdog-args-vals (filter (lambda (x) x)
                                      (map args:get-arg no-watchdog-args)))
       (start-watchdog (and (null? no-watchdog-args-vals) start-watchdog-specail-arg-val)))
       ;(print  "no-watchdog-args="no-watchdog-args "no-watchdog-args-vals="no-watchdog-args-vals " start-watchdog-specail-arg-val:" start-watchdog-specail-arg-val " start-watchdog:" start-watchdog) 
  (if start-watchdog
      (thread-start! *watchdog*)))
;;  (if start-watchdog
;;      (thread-start! *watchdog*))
    #t
)


;; bracket open-output-file with code to make leading directory if it does not exist and handle exceptions
(define (open-logfile logpath-in)
  (condition-case
   (let* ((log-dir (or (pathname-directory logpath-in) "."))
	  (fname   (pathname-strip-directory logpath-in))
2477
2478
2479
2480
2481
2482
2483
2484
2485


2486
2487
2488
2489
2490
2491
2492
2479
2480
2481
2482
2483
2484
2485


2486
2487
2488
2489
2490
2491
2492
2493
2494







-
-
+
+







(when (args:get-arg "-sync-brute-force")
  (launch:setup)
  ((server:get-bruteforce-syncer (db:setup #t) persist-until-sync: #t))
  (set! *didsomething* #t))

(if (args:get-arg "-sync-to-megatest.db")
    (let* ((duh      (launch:setup))
	   (dbstruct (db:setup #f))
	   (tmpdbpth (cdr (dbr:dbstruct-tmpdb dbstruct)))
	   (dbstruct (db:setup #t))
	   (tmpdbpth (dbr:dbstruct-tmppath dbstruct))
	   (lockfile (conc tmpdbpth ".lock"))
	   (locked   (common:simple-file-lock lockfile)) 
	   (res      (if locked
			 (db:multi-db-sync 
			  dbstruct
			  'new2old)
			 #f)))
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558




2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2550
2551
2552
2553
2554
2555
2556




2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573







-
-
-
-
+
+
+
+













    (set! *time-to-exit* #t)
    )
;;(debug:print-info 13 *default-log-port* "thread-join! watchdog")

;; join the watchdog thread if it has been thread-start!ed  (it may not have been started in the case of a server that never enters running state)
;;   (symbols returned by thread-state: created ready running blocked suspended sleeping terminated dead)
;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage
(if (thread? *watchdog*)
    (case (thread-state *watchdog*)
      ((ready running blocked sleeping terminated dead)
       (thread-join! *watchdog*))))
;;(if (thread? *watchdog*)
;;    (case (thread-state *watchdog*)
;;      ((ready running blocked sleeping terminated dead)
;;       (thread-join! *watchdog*))))

(set! *time-to-exit* #t)

(if (not (eq? *globalexitstatus* 0))
    (if (or (args:get-arg "-run")(args:get-arg "-runtests")(args:get-arg "-runall"))
        (begin
           (debug:print 0 *default-log-port* "NOTE: Subprocesses with non-zero exit code detected: " *globalexitstatus*)
           (exit 0))
        (case *globalexitstatus*
         ((0)(exit 0))
         ((1)(exit 1))
         ((2)(exit 2))
         (else (exit 3)))))