Megatest

Diff
Login

Differences From Artifact [a1cea3fd33]:

To Artifact [be96ddd230]:


159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
	  tasksmod
	  testsmod
	  
	  )
	
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)

(define *db* #f) ;; this is only for the repl, do not use in general!!!!

;; (include "common_records.scm")
;; (include "key_records.scm")
;; (include "db_records.scm")
(include "run_records.scm")
;; (include "test_records.scm")







|







159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
	  tasksmod
	  testsmod
	  
	  )
	
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(define *didsomething* #f)  
(define *db* #f) ;; this is only for the repl, do not use in general!!!!

;; (include "common_records.scm")
;; (include "key_records.scm")
;; (include "db_records.scm")
(include "run_records.scm")
;; (include "test_records.scm")
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
     			 newlogf)
     		       logpath-in)))
     (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-in)
	(define *didsomething* #t)  
	(exit 1))))

;; Disabled help items
;;  -rollup                 : (currently disabled) fill run (set by :runname)  with latest test(s)
;;                            from prior runs with same keys
;;  -daemonize              : fork into background and disconnect from stdin/out








|







317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
     			 newlogf)
     		       logpath-in)))
     (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-in)
	(set! *didsomething* #t)
	(exit 1))))

;; Disabled help items
;;  -rollup                 : (currently disabled) fill run (set by :runname)  with latest test(s)
;;                            from prior runs with same keys
;;  -daemonize              : fork into background and disconnect from stdin/out

501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522

Called as " (string-intersperse (argv) " ") "
Version " megatest-version ", built from " megatest-fossil-hash ))
     
(define (main)
  (make-and-init-bigdata)

  
  ;; set up the functions in http transport
;;   (hash-table-set! *http-functions* 'api:process-request          api:process-request)
;;   (hash-table-set! *http-functions* 'http-transport:main-page     http-transport:main-page)
;;   (hash-table-set! *http-functions* 'http-transport:show-jquery   http-transport:show-jquery)
;;   (hash-table-set! *http-functions* 'http-transport:html-test-log http-transport:html-test-log)
;;   (hash-table-set! *http-functions* 'http-transport:html-dboard   http-transport:html-dboard)
  
;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
;;
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
  (if (common:file-exists? debugcontrolf)
      (load debugcontrolf)))

;; usage logging, careful with this, it is not designed to deal with all real world challenges!







<
<
<
<
<
<
<
<







501
502
503
504
505
506
507








508
509
510
511
512
513
514

Called as " (string-intersperse (argv) " ") "
Version " megatest-version ", built from " megatest-fossil-hash ))
     
(define (main)
  (make-and-init-bigdata)









;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
;;
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
  (if (common:file-exists? debugcontrolf)
      (load debugcontrolf)))

;; usage logging, careful with this, it is not designed to deal with all real world challenges!
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
           (exit)))
     
     (if (args:get-arg "-version")
         (begin
           (print (common:version-signature)) ;; (print megatest-version)
           (exit)))
     
     (define *didsomething* #f)
     
     ;; Overall exit handling setup immediately
     ;;
     (if (or (args:get-arg "-process-reap"))
             ;; (args:get-arg "-runtests")
     	;; (args:get-arg "-execute")
     	;; (args:get-arg "-remove-runs")
     	;; (args:get-arg "-runstep"))







<
<







818
819
820
821
822
823
824


825
826
827
828
829
830
831
           (exit)))
     
     (if (args:get-arg "-version")
         (begin
           (print (common:version-signature)) ;; (print megatest-version)
           (exit)))
     


     ;; Overall exit handling setup immediately
     ;;
     (if (or (args:get-arg "-process-reap"))
             ;; (args:get-arg "-runtests")
     	;; (args:get-arg "-execute")
     	;; (args:get-arg "-remove-runs")
     	;; (args:get-arg "-runstep"))
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
         (bdat-time-to-exit-set! *bdat* #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
     (let* ((watchdog (bdat-watchdog *bdat*)))
       (if (thread? watchdog)
	   (case (thread-state watchdog)
	     ((ready running blocked sleeping terminated dead)
	      (thread-join! watchdog)))))
     
     (bdat-time-to-exit-set! *bdat* #t)
     







|







2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
         (bdat-time-to-exit-set! *bdat* #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
     #;(let* ((watchdog (bdat-watchdog *bdat*)))
       (if (thread? watchdog)
	   (case (thread-state watchdog)
	     ((ready running blocked sleeping terminated dead)
	      (thread-join! watchdog)))))
     
     (bdat-time-to-exit-set! *bdat* #t)