Megatest

Check-in [b69f26a9c2]
Login
Overview
Comment:One more missing scenario for using -testpatt
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60 | v1.6019
Files: files | file ages | folders
SHA1: b69f26a9c220fd9c4cfa4a17f1c45c077b30efbf
User & Date: mrwellan on 2015-07-08 17:44:50
Other Links: branch diff | manifest | tags
Context
2015-07-08
21:36
Merged fork check-in: 482223ee14 user: matt tags: v1.60
17:44
One more missing scenario for using -testpatt check-in: b69f26a9c2 user: mrwellan tags: v1.60, v1.6019
17:29
One more missing scenario for using -testpatt check-in: cacd55a2d6 user: mrwellan tags: v1.60, v1.6019
Changes

Modified launch.scm from [3b16d9aefa] to [e8ae5ca55a].

553
554
555
556
557
558
559

560

561
562
563
564
565
566
567
553
554
555
556
557
558
559
560

561
562
563
564
565
566
567
568







+
-
+







	  )))
  *toppath*)

(define (launch:cache-config)
  ;; if we have a linktree and -runtests and -target and the directory exists dump the config
  ;; to megatest-(current-seconds).cfg and symlink it to megatest.cfg
  (if (and *configdat* 
	   (or (args:get-arg "-run")
	   (args:get-arg "-runtests"))
	       (args:get-arg "-runtests")))
      (let* ((linktree (get-environment-variable "MT_LINKTREE"))
	     (target   (common:args-get-target))
	     (runname  (or (args:get-arg "-runname")
			   (args:get-arg ":runname")))
	     (fulldir  (conc linktree "/"
			     target "/"
			     runname)))

Modified megatest.scm from [f455f4760e] to [953f3e2538].

1169
1170
1171
1172
1173
1174
1175
1176

1177
1178
1179
1180
1181
1182
1183
1169
1170
1171
1172
1173
1174
1175

1176
1177
1178
1179
1180
1181
1182
1183







-
+







;;    started and completed
;;    - step started, timestamp
;;    - step completed, exit status, timestamp
;; 6. test phone home
;;    - if test run time > allowed run time then kill job
;;    - if cannot access db > allowed disconnect time then kill job

(if (args:get-arg "-runtests")
(if (or (args:get-arg "-run")(args:get-arg "-runtests"))
  (general-run-call 
   "-runtests" 
   "run a test" 
   (lambda (target runname keys keyvals)
     ;;
     ;; May or may not implement it this way ...
     ;;
1606
1607
1608
1609
1610
1611
1612

1613

1614
1615
1616
1617
1618
1619
1620
1606
1607
1608
1609
1610
1611
1612
1613

1614
1615
1616
1617
1618
1619
1620
1621







+
-
+







      (set! *didsomething* #t)))

;;======================================================================
;; Wait on a run to complete
;;======================================================================

(if (and (args:get-arg "-run-wait")
	 (not (or (args:get-arg "-run")
	 (not (args:get-arg "-runtests"))) ;; run-wait is built into runtests now
		  (args:get-arg "-runtests")))) ;; run-wait is built into runtests now
    (begin
      (if (not (launch:setup-for-run))
	  (begin
	    (debug:print 0 "Failed to setup, exiting") 
	    (exit 1)))
      (operate-on 'run-wait)
      (set! *didsomething* #t)))
1677
1678
1679
1680
1681
1682
1683
1684

1685
1686
1687
1688
1689
1690
1691
1692
1678
1679
1680
1681
1682
1683
1684

1685
1686
1687
1688
1689
1690
1691
1692
1693







-
+








(if (not *didsomething*)
    (debug:print 0 help))

(set! *time-to-exit* #t)
(thread-join! *watchdog*)

(if (not (eq? *globalexitstatus* 0))
    (if (or (args:get-arg "-runtests")(args:get-arg "-runall"))
    (if (or (args:get-arg "-run")(args:get-arg "-runtests")(args:get-arg "-runall"))
        (begin
           (debug:print 0 "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)))))