Megatest

Check-in [acc15ed887]
Login
Overview
Comment:Fixed rollup
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: acc15ed8870efc5306fa6d645bcfdeca8b55c216
User & Date: matt on 2015-06-29 23:15:49
Other Links: branch diff | manifest | tags
Context
2015-06-29
23:46
More improvements to rollup but still not quite right check-in: 967851ca40 user: matt tags: v1.60
23:15
Fixed rollup check-in: acc15ed887 user: matt tags: v1.60
17:44
Partial re-work of test status rollup for itemized tests. Initial implementation of per test summary generation check-in: e9a41f7443 user: mrwellan tags: v1.60
Changes

Modified db.scm from [7acd23bc23] to [d2635d6053].

1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
     (lambda (toptest)
       (let ((test-name (list-ref toptest 3)))
;;	     (run-id    (list-ref toptest 5)))
	 (db:top-test-set-per-pf-counts db run-id test-name)))
     toplevels)))

(define (db:top-test-set-per-pf-counts db run-id test-name)
  (db:general-call db 'top-test-set-per-pf-counts (list test-name test-name run-id test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name))) 
 
		     
;; Clean out old junk and vacuum the database
;;
;; Ultimately do something like this:
;;
;; 1. Look at test records either deleted or part of deleted run:







|







1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
     (lambda (toptest)
       (let ((test-name (list-ref toptest 3)))
;;	     (run-id    (list-ref toptest 5)))
	 (db:top-test-set-per-pf-counts db run-id test-name)))
     toplevels)))

(define (db:top-test-set-per-pf-counts db run-id test-name)
  (db:general-call db 'top-test-set-per-pf-counts (list test-name test-name run-id test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name))) 
 
		     
;; Clean out old junk and vacuum the database
;;
;; Ultimately do something like this:
;;
;; 1. Look at test records either deleted or part of deleted run:
2832
2833
2834
2835
2836
2837
2838

2839
2840
2841
2842
2843
2844
2845

2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
    (if msg
	(db:general-call dbdat 'state-status-msg (list state status msg test-id))
	(db:general-call dbdat 'state-status     (list state status test-id)))))

;; call with state = #f to roll up with out accounting for state/status of this item
;;
(define (db:roll-up-pass-fail-counts dbstruct run-id test-name item-path state status)

  (if (or (not state)
	  (not (equal? item-path "")))
      ;; just do a rollup
      (begin
	(db:general-call dbdat 'update-pass-fail-counts (list test-name test-name test-name))
	(db:top-test-set-per-pf-counts db run-id test-name)
	#f)

      ;; (not (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP" "LAUNCHED")))
      (let ((dbdat (db:get-db dbstruct run-id)))
	(db:general-call dbdat 'update-pass-fail-counts (list test-name test-name test-name))
	;; NOTE: No else clause needed for this case
	(case (string->symbol status)
	 ((RUNNING)  (db:general-call dbdat 'top-test-set-running (list test-name)))
	 ((LAUNCHED) (db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name)))
	 ((ABORT INCOMPLETE) (db:general-call dbdat 'top-test-set (list status test-name))))
	(let ((db (db:dbdat-get-db dbdat)))
	  (db:top-test-set-per-pf-counts db run-id test-name))
	#f)
      ))

(define (db:test-get-logfile-info dbstruct run-id test-name)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)







>
|
|
|
|
|
|
|
>
|
<
|
|
|
|
|
|
|
|
|
|







2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848

2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
    (if msg
	(db:general-call dbdat 'state-status-msg (list state status msg test-id))
	(db:general-call dbdat 'state-status     (list state status test-id)))))

;; call with state = #f to roll up with out accounting for state/status of this item
;;
(define (db:roll-up-pass-fail-counts dbstruct run-id test-name item-path state status)
  (let ((dbdat (db:get-db dbstruct run-id)))
    (if (or (not state)
	    (not (equal? item-path "")))
	;; just do a rollup
	(begin
	  (db:general-call dbdat 'update-pass-fail-counts (list test-name test-name test-name))
	  (db:top-test-set-per-pf-counts dbdat run-id test-name)
	  #f)
	(begin
	  ;; (not (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP" "LAUNCHED")))

	  (db:general-call dbdat 'update-pass-fail-counts (list test-name test-name test-name))
	  ;; NOTE: No else clause needed for this case
	  (case (string->symbol status)
	    ((RUNNING)  (db:general-call dbdat 'top-test-set-running (list test-name)))
	    ((LAUNCHED) (db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name)))
	    ((ABORT INCOMPLETE) (db:general-call dbdat 'top-test-set (list status test-name))))
	  (let ((db (db:dbdat-get-db dbdat)))
	    (db:top-test-set-per-pf-counts dbdat run-id test-name))
	  #f)
	)))

(define (db:test-get-logfile-info dbstruct run-id test-name)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)