Megatest

Check-in [e44310678f]
Login
Overview
Comment:merged change restoring legacy 'prefix-target' option and added 'prepend-contour'
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64-envdebug
Files: files | file ages | folders
SHA1: e44310678f8ec423cff3de5b82177e420c4214b8
User & Date: srehman on 2017-04-05 12:51:54
Other Links: branch diff | manifest | tags
Context
2017-04-05
17:51
merged with pjhatwal1.64 check-in: 23abe1e5af user: pjhatwal tags: v1.64-envdebug
12:51
merged change restoring legacy 'prefix-target' option and added 'prepend-contour' check-in: e44310678f user: srehman tags: v1.64-envdebug
11:20
merged with latest v1.64 Closed-Leaf check-in: 30d36cbe76 user: srehman tags: v1.64-prepend-contour, v1.64-envdebug
05:26
Fixed run command for mtutil check-in: 3c313e0476 user: matt tags: v1.64-envdebug
Changes

Modified db.scm from [eb8b9ceb35] to [e09f68a613].

2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
;;       this is inconsistent with get-runs but it makes some sense.
;;
(define (db:get-run-info dbstruct run-id)
  ;;(if (hash-table-ref/default *run-info-cache* run-id #f)
  ;;    (hash-table-ref *run-info-cache* run-id)
  (let* ((res       (vector #f #f #f #f))
	 (keys      (db:get-keys dbstruct))
	 (remfields (list "id" "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count")) ;;  "area_id"))
	 (header    (append keys remfields))
	 (keystr    (conc (keys->keystr keys) ","
			  (string-intersperse remfields ","))))
    (debug:print-info 11 *default-log-port* "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr)
    (db:with-db
     dbstruct #f #f
     (lambda (db)







|







2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
;;       this is inconsistent with get-runs but it makes some sense.
;;
(define (db:get-run-info dbstruct run-id)
  ;;(if (hash-table-ref/default *run-info-cache* run-id #f)
  ;;    (hash-table-ref *run-info-cache* run-id)
  (let* ((res       (vector #f #f #f #f))
	 (keys      (db:get-keys dbstruct))
	 (remfields (list "id" "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count" "contour")) ;;  "area_id"))
	 (header    (append keys remfields))
	 (keystr    (conc (keys->keystr keys) ","
			  (string-intersperse remfields ","))))
    (debug:print-info 11 *default-log-port* "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr)
    (db:with-db
     dbstruct #f #f
     (lambda (db)

Modified megatest.scm from [ca5ad266f7] to [d6dfc96888].

280
281
282
283
284
285
286

287
288
289
290
291
292
293
294
295
296
297
298
299
			"-archive"
			"-since"
			"-fields"
			"-recover-test" ;; run-id,test-id - used internally to recover a test stuck in RUNNING state
			"-sort"
			"-target-db"
			"-source-db"


                        "-src-target"
                        "-src-runname"
                        "-diff-email"
			"-sync-to"
			"-prefix-target"			
			"-pgsync"
                        "-diff-html"
			)
 		 (list  "-h" "-help" "--help"
			"-manual"
			"-version"
		        "-force"







>




|
<







280
281
282
283
284
285
286
287
288
289
290
291
292

293
294
295
296
297
298
299
			"-archive"
			"-since"
			"-fields"
			"-recover-test" ;; run-id,test-id - used internally to recover a test stuck in RUNNING state
			"-sort"
			"-target-db"
			"-source-db"
			"-prefix-target"

                        "-src-target"
                        "-src-runname"
                        "-diff-email"
			"-sync-to"			

			"-pgsync"
                        "-diff-html"
			)
 		 (list  "-h" "-help" "--help"
			"-manual"
			"-version"
		        "-force"
309
310
311
312
313
314
315

316
317
318
319
320
321
322
			"-preclean"
			"-rerun-clean"
			"-rerun-all"
			"-clean-cache"
			"-no-cache"
			"-cache-db"
                        "-use-db-cache"

			;; misc
			"-repl"
			"-lock"
			"-unlock"
			"-list-servers"
			"-kill-servers"
                        "-run-wait"      ;; wait on a run to complete (i.e. no RUNNING)







>







309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
			"-preclean"
			"-rerun-clean"
			"-rerun-all"
			"-clean-cache"
			"-no-cache"
			"-cache-db"
                        "-use-db-cache"
                        "-prepend-contour"
			;; misc
			"-repl"
			"-lock"
			"-unlock"
			"-list-servers"
			"-kill-servers"
                        "-run-wait"      ;; wait on a run to complete (i.e. no RUNNING)

Modified tasks.scm from [e18dae9779] to [3d363ae696].

612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633










634
635
636
637
638
639
640
;; gets mtpg-run-id and syncs the record if different
;;
(define (tasks:run-id->mtpg-run-id dbh cached-info run-id)
  (let* ((runs-ht (hash-table-ref cached-info 'runs))
	 (runinf  (hash-table-ref/default runs-ht run-id #f)))
    (if runinf
	runinf ;; already cached
	(let* ((keytarg    (string-intersperse (rmt:get-keys) "/")) ;; e.g. version/iteration/platform
	       (spec-id    (pgdb:get-ttype dbh keytarg))
	       (target     (if (and (args:get-arg "-sync-to") (args:get-arg "-prefix-target")) (set! target (conc (args:get-arg "-prefix-target") (rmt:get-target run-id))) (rmt:get-target run-id)))                 ;; e.g. v1.63/a3e1/ubuntu
	       (run-dat    (rmt:get-run-info run-id))               ;; NOTE: get-run-info returns a vector < row header >
	       (run-name   (rmt:get-run-name-from-id run-id))
	       (new-run-id (pgdb:get-run-id dbh spec-id target run-name))
	       (row        (db:get-rows run-dat))                   ;; yes, this returns a single row
	       (header     (db:get-header run-dat))
	       (state      (db:get-value-by-header row header "state "))
	       (status     (db:get-value-by-header row header "status"))
	       (owner      (db:get-value-by-header row header "owner"))
	       (event-time (db:get-value-by-header row header "event_time"))
	       (comment    (db:get-value-by-header row header "comment"))
	       (fail-count (db:get-value-by-header row header "fail_count"))
	       (pass-count (db:get-value-by-header row header "pass_count"))










	       ;; (area-id    (db:get-value-by-header row header "area_id)"))
	       )
	  (if new-run-id
	      (begin ;; let ((run-record (pgdb:get-run-info dbh new-run-id))
		(hash-table-set! runs-ht run-id new-run-id)
		;; ensure key fields are up to date
		(pgdb:refresh-run-info







<
<
<
|

<









>
>
>
>
>
>
>
>
>
>







612
613
614
615
616
617
618



619
620

621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
;; gets mtpg-run-id and syncs the record if different
;;
(define (tasks:run-id->mtpg-run-id dbh cached-info run-id)
  (let* ((runs-ht (hash-table-ref cached-info 'runs))
	 (runinf  (hash-table-ref/default runs-ht run-id #f)))
    (if runinf
	runinf ;; already cached



	(let* ((run-dat    (rmt:get-run-info run-id))               ;; NOTE: get-run-info returns a vector < row header >
	       (run-name   (rmt:get-run-name-from-id run-id))

	       (row        (db:get-rows run-dat))                   ;; yes, this returns a single row
	       (header     (db:get-header run-dat))
	       (state      (db:get-value-by-header row header "state "))
	       (status     (db:get-value-by-header row header "status"))
	       (owner      (db:get-value-by-header row header "owner"))
	       (event-time (db:get-value-by-header row header "event_time"))
	       (comment    (db:get-value-by-header row header "comment"))
	       (fail-count (db:get-value-by-header row header "fail_count"))
	       (pass-count (db:get-value-by-header row header "pass_count"))
	       (contour    (if (args:get-arg "-prepend-contour") (db:get-value-by-header row header "contour")))
	       (keytarg    (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target"))
	       			(conc "MT_CONTOUR/MT_AREA/" (string-intersperse (rmt:get-keys) "/")) (string-intersperse (rmt:get-keys) "/"))) ;; e.g. version/iteration/platform
	       (target     (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target")) 
	       			(conc (or (args:get-arg "-prefix-target") (conc contour "/" (common:get-area-name) "/")) (rmt:get-target run-id)) (rmt:get-target run-id)))                 ;; e.g. v1.63/a3e1/ubuntu
	       (spec-id    (pgdb:get-ttype dbh keytarg))
	       (new-run-id (pgdb:get-run-id dbh spec-id target run-name))



	       ;; (area-id    (db:get-value-by-header row header "area_id)"))
	       )
	  (if new-run-id
	      (begin ;; let ((run-record (pgdb:get-run-info dbh new-run-id))
		(hash-table-set! runs-ht run-id new-run-id)
		;; ensure key fields are up to date
		(pgdb:refresh-run-info