Megatest

Check-in [6b8e58d2d1]
Login
Overview
Comment:Added -preclean to all automatic run calls. Might need to be able to switch that off in future. runtrans=auto uses automatically generated run name, runtrans with spec in *runname-mappers* will use it, otherwise the runtrans is used as the actual runnanme. This is needed for run-in-place reruns
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64
Files: files | file ages | folders
SHA1: 6b8e58d2d102c2caba15065a4b7a61a1fcbf30c6
User & Date: matt on 2017-03-26 21:58:49
Other Links: branch diff | manifest | tags
Context
2017-03-27
00:42
First attempt at the exclusive mode. Not working yet but leaving the code on the v1.64 branch in anticipation of fixing it. check-in: 3269b1925d user: matt tags: v1.64
2017-03-26
21:58
Added -preclean to all automatic run calls. Might need to be able to switch that off in future. runtrans=auto uses automatically generated run name, runtrans with spec in *runname-mappers* will use it, otherwise the runtrans is used as the actual runnanme. This is needed for run-in-place reruns check-in: 6b8e58d2d1 user: matt tags: v1.64
17:47
Added browsing of logs to RH Button for tests from runs view buttons. Added (speculative) fix for unstable sort on steps. check-in: 89dd44cd11 user: matt tags: v1.64
Changes

Modified mtut.scm from [003fb104de] to [67afd037cc].

142
143
144
145
146
147
148

149
150
151
152
153
154
155
    ("-help"       . #f)
    ("--help"      . #f)
    ("-manual"     . #f)
    ("-version"    . #f)
    ;; misc
    ("-repl"       . #f)
    ("-immediate"  . I)

    ))

;; alist to map actions to old megatest commands
(define *action-keys*
  '((run         . "-run")
    (sync        . "")
    (archive     . "-archive")







>







142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
    ("-help"       . #f)
    ("--help"      . #f)
    ("-manual"     . #f)
    ("-version"    . #f)
    ;; misc
    ("-repl"       . #f)
    ("-immediate"  . I)
    ("-preclean"   . r)
    ))

;; alist to map actions to old megatest commands
(define *action-keys*
  '((run         . "-run")
    (sync        . "")
    (archive     . "-archive")
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
(define (command-line->pkt action args-alist sched-in)
  (let* ((sched     (cond
		     ((vector? sched-in)(local-time->seconds sched-in)) ;; we recieved a time
		     ((number? sched-in) sched-in)
		     (else     (current-seconds))))
	 (args-data (if args-alist
			args-alist
			(hash-table->alist args:arg-hash)))
	 (alldat    (apply append (list 'T "cmd"
					'a action
					'U (current-user-name)
					'D sched)
			   (map (lambda (x)
				  (let* ((param (car x))
					 (value (cdr x))
					 (pmeta (assoc param *arg-keys*))
					 (smeta (assoc param *switch-keys*))
					 (meta  (if (or pmeta smeta)
						    (cdr (or pmeta smeta))
						    #f)))
				    (if (or pmeta smeta)
					(list meta value)
					'())))
				(filter cdr args-data)))))
;; (print  "Alldat: " alldat
;;         " args-data: " args-data)
    (add-z-card
     (apply construct-sdat alldat))))







|







|
|

|

|







391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
(define (command-line->pkt action args-alist sched-in)
  (let* ((sched     (cond
		     ((vector? sched-in)(local-time->seconds sched-in)) ;; we recieved a time
		     ((number? sched-in) sched-in)
		     (else     (current-seconds))))
	 (args-data (if args-alist
			args-alist
			(hash-table->alist args:arg-hash))) ;; if no args-alist then we assume this is a call driven directly by commandline
	 (alldat    (apply append (list 'T "cmd"
					'a action
					'U (current-user-name)
					'D sched)
			   (map (lambda (x)
				  (let* ((param (car x))
					 (value (cdr x))
					 (pmeta (assoc param *arg-keys*))    ;; translate the card key to a megatest switch or parameter
					 (smeta (assoc param *switch-keys*)) ;; first lookup the key in arg-keys or switch-keys
					 (meta  (if (or pmeta smeta)
						    (cdr (or pmeta smeta))   ;; found it?
						    #f)))
				    (if (or pmeta smeta)                     ;; construct the switch/param pair.
					(list meta value)
					'())))
				(filter cdr args-data)))))
;; (print  "Alldat: " alldat
;;         " args-data: " args-data)
    (add-z-card
     (apply construct-sdat alldat))))
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469

470

471
472
473
474
475
476
477
(define (create-run-pkt mtconf action area runkey runname mode-patt tag-expr pktsdir reason contour sched dbdest append-conf runtrans)
  (let* ((good-val   (lambda (inval)(and inval (string? inval)(not (string-null? inval)))))
	 (area-dat   (val->alist (or (configf:lookup mtconf "areas" area) "")))
	 (area-path  (alist-ref 'path      area-dat))
	 (area-xlatr (alist-ref 'targtrans area-dat))
	 (new-runname (let* ((callname (if (string? runtrans)(string->symbol runtrans) #f))
			     (mapper   (if callname (hash-table-ref/default *runname-mappers* callname #f) #f)))
			(print "callname=" callname " runtrans=" runtrans " mapper=" mapper)
			(if (and callname
				 (not (equal? callname "auto"))
				 (not mapper))
			    (print "Failed to find runname mapper " callname " for area " area))
			(if mapper
			    (handle-exceptions
				exn
				(begin
				  (print-call-chain)
				  (print "FAILED TO RUN RUNNAME MAPPER " callname " FOR AREA " area)
				  (print " message: " ((condition-property-accessor 'exn 'message) exn))
				  runname)
			      (print "(mapper " (string-intersperse (list runkey runname area area-path reason contour mode-patt) ", ") ")")
			      (mapper runkey runname area area-path reason contour mode-patt))

			    runname)))

	 (new-target (if area-xlatr 
			 (let ((xlatr-key (string->symbol area-xlatr)))
			   (if (hash-table-exists? *target-mappers* xlatr-key)
			       (begin
				 (print "Using target mapper: " area-xlatr)
				 (handle-exceptions
				     exn







|



|










>
|
>







449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
(define (create-run-pkt mtconf action area runkey runname mode-patt tag-expr pktsdir reason contour sched dbdest append-conf runtrans)
  (let* ((good-val   (lambda (inval)(and inval (string? inval)(not (string-null? inval)))))
	 (area-dat   (val->alist (or (configf:lookup mtconf "areas" area) "")))
	 (area-path  (alist-ref 'path      area-dat))
	 (area-xlatr (alist-ref 'targtrans area-dat))
	 (new-runname (let* ((callname (if (string? runtrans)(string->symbol runtrans) #f))
			     (mapper   (if callname (hash-table-ref/default *runname-mappers* callname #f) #f)))
			;; (print "callname=" callname " runtrans=" runtrans " mapper=" mapper)
			(if (and callname
				 (not (equal? callname "auto"))
				 (not mapper))
			    (print "No mapper " callname " for area " area " using " callname " as the runname"))
			(if mapper
			    (handle-exceptions
				exn
				(begin
				  (print-call-chain)
				  (print "FAILED TO RUN RUNNAME MAPPER " callname " FOR AREA " area)
				  (print " message: " ((condition-property-accessor 'exn 'message) exn))
				  runname)
			      (print "(mapper " (string-intersperse (list runkey runname area area-path reason contour mode-patt) ", ") ")")
			      (mapper runkey runname area area-path reason contour mode-patt))
			    (case callname
			      ((auto) runname)
			      (else   runtrans)))))
	 (new-target (if area-xlatr 
			 (let ((xlatr-key (string->symbol area-xlatr)))
			   (if (hash-table-exists? *target-mappers* xlatr-key)
			       (begin
				 (print "Using target mapper: " area-xlatr)
				 (handle-exceptions
				     exn
504
505
506
507
508
509
510




511
512
513
514
515
516
517
		    (if (good-val mode-patt)   `(("-mode-patt"     . ,mode-patt))   '())
		    (if (good-val tag-expr)    `(("-tag-expr"      . ,tag-expr))    '())
		    (if (good-val dbdest)      `(("-sync-to"       . ,dbdest))      '())
		    (if (good-val append-conf) `(("-append-config" . ,append-conf)) '())
		    (if (not (or mode-patt tag-expr))
			`(("-testpatt"  . "%"))
			'())




		    )
		   sched)))
      (with-output-to-file
	  (conc pktsdir "/" uuid ".pkt")
	(lambda ()
	  (print pkt))))))








>
>
>
>







507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
		    (if (good-val mode-patt)   `(("-mode-patt"     . ,mode-patt))   '())
		    (if (good-val tag-expr)    `(("-tag-expr"      . ,tag-expr))    '())
		    (if (good-val dbdest)      `(("-sync-to"       . ,dbdest))      '())
		    (if (good-val append-conf) `(("-append-config" . ,append-conf)) '())
		    (if (not (or mode-patt tag-expr))
			`(("-testpatt"  . "%"))
			'())
		    (if (or (not action)
			    (equal? action "run"))
			`(("-preclean"  . " "))      ;; if run we *always* want preclean set, use single space as placeholder
			'())
		    )
		   sched)))
      (with-output-to-file
	  (conc pktsdir "/" uuid ".pkt")
	(lambda ()
	  (print pkt))))))

790
791
792
793
794
795
796

797
798
799
800
801
802
803
804
	  (hash-table-keys torun)))))))

(define (pkt->cmdline pkta)
  (let ((action (or (lookup-action-by-key (alist-ref 'a pkta)) "noaction")))
    (fold (lambda (a res)
	    (let* ((key (car a)) ;; get the key name
		   (val (cdr a))

		   (par (lookup-param-by-key key)))
	      ;; (print "key: " key " val: " val " par: " par)
	      (if par
		  (conc res " " (param-translate par) " " val)
		  (if (member key '(a Z U D T)) ;; a is the action
		      res
		      (begin
			(print "ERROR: Unknown key in packet \"" key "\" with value \"" val "\"")







>
|







797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
	  (hash-table-keys torun)))))))

(define (pkt->cmdline pkta)
  (let ((action (or (lookup-action-by-key (alist-ref 'a pkta)) "noaction")))
    (fold (lambda (a res)
	    (let* ((key (car a)) ;; get the key name
		   (val (cdr a))
		   (par (or (lookup-param-by-key key)  ;; need to check also if it is a switch
			    (lookup-param-by-key key inlst: *switch-keys*))))
	      ;; (print "key: " key " val: " val " par: " par)
	      (if par
		  (conc res " " (param-translate par) " " val)
		  (if (member key '(a Z U D T)) ;; a is the action
		      res
		      (begin
			(print "ERROR: Unknown key in packet \"" key "\" with value \"" val "\"")

Modified runconfigs.config from [cdc2f61ef5] to [3ca33a1f93].

14
15
16
17
18
19
20
21
22

23
24
25
26
27
28
29

# tip will be replaced with hashkey?
[v1.63/tip/dev]
# file:   files changes since last run trigger new run
# script: script is called with unix seconds as last parameter (other parameters are preserved)
#
# contour:sensetype:action params            data
quick:file:run             runtrans=auto;glob=/home/matt/data/megatest/*.scm
snazy:file:run             runtrans=corporate-ww;glob=/home/matt/data/megatest/*.scm


# script returns change-time (unix epoch), new-target-name, run-name
#
# quick:script:run           checkfossil = http://www.kiatoa.com/fossils/megatest v1.63;\
#                            checkfossil = http://www.kiatoa.com/fossils/megatest_qa trunk

# fossil based trigger







|
|
>







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

# tip will be replaced with hashkey?
[v1.63/tip/dev]
# file:   files changes since last run trigger new run
# script: script is called with unix seconds as last parameter (other parameters are preserved)
#
# contour:sensetype:action params            data
quick:file:run             runtrans=auto;         glob=/home/matt/data/megatest/*.scm
snazy:file:run             runtrans=corporate-ww; glob=/home/matt/data/megatest/*.scm
short:file:run             runtrans=short;        glob=/home/matt/data/megatest/*.scm

# script returns change-time (unix epoch), new-target-name, run-name
#
# quick:script:run           checkfossil = http://www.kiatoa.com/fossils/megatest v1.63;\
#                            checkfossil = http://www.kiatoa.com/fossils/megatest_qa trunk

# fossil based trigger

tests/fullrun/tests/exit_0/main.sh became executable with contents [0536bc3eb1].

tests/fullrun/tests/exit_1/main.sh became executable with contents [c5651ffc6c].

tests/fullrun/tests/lineitem_fail/main.sh became executable with contents [b8aaccbe35].

tests/fullrun/tests/lineitem_pass/main.sh became executable with contents [c43fd19ef0].

tests/fullrun/tests/priority_1/main.sh became executable with contents [0536bc3eb1].

tests/fullrun/tests/priority_10/main.sh became executable with contents [0536bc3eb1].

tests/fullrun/tests/priority_2/main.sh became executable with contents [8c8c341150].

tests/fullrun/tests/priority_3/main.sh became executable with contents [416f9ddbf9].

tests/fullrun/tests/priority_4/main.sh became executable with contents [0536bc3eb1].

tests/fullrun/tests/priority_5/main.sh became executable with contents [0536bc3eb1].

tests/fullrun/tests/priority_6/main.sh became executable with contents [0536bc3eb1].

tests/fullrun/tests/priority_7/main.sh became executable with contents [0536bc3eb1].

tests/fullrun/tests/priority_8/main.sh became executable with contents [12267f0508].

tests/fullrun/tests/priority_9/main.sh became executable with contents [0536bc3eb1].

tests/fullrun/tests/singletest/main.sh became executable with contents [d41b458021].