Megatest

Check-in [fad3401167]
Login
Overview
Comment:new rollup working pretty well now
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60 | v1.6018
Files: files | file ages | folders
SHA1: fad340116772043734d3c3db307a957bdd447b00
User & Date: matt on 2015-06-30 22:56:53
Other Links: branch diff | manifest | tags
Context
2015-07-01
10:54
Document the rollup override check-in: ebc67140eb user: mrwellan tags: v1.60
2015-06-30
22:56
new rollup working pretty well now check-in: fad3401167 user: matt tags: v1.60, v1.6018
18:05
Exploratory rollup approach check-in: f6a7495a61 user: mrwellan tags: v1.60
Changes

Modified db.scm from [8bbe6c8dc4] to [1f80fff6ba].

1336
1337
1338
1339
1340
1341
1342
1343

1344
1345
1346
1347


1348
1349
1350
1351
1352
1353
1354
1336
1337
1338
1339
1340
1341
1342

1343
1344
1345


1346
1347
1348
1349
1350
1351
1352
1353
1354







-
+


-
-
+
+







    ;; Now do rollups for the toplevel tests
    ;;
    (db:delay-if-busy dbdat)
    (for-each
     (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)))
	 (db:top-test-set-per-pf-counts dbdat 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 test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name))) 
(define (db:top-test-set-per-pf-counts dbdat run-id test-name)
  (db:general-call dbdat 'top-test-set-per-pf-counts (list test-name test-name test-name test-name test-name test-name 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
2832
2833
2834
2835
2836
2837
2838
2839





2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851







+
-
-
-
-
-
+
+
+
+
+







    (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 (not (equal? item-path ""))
  (let ((dbdat (db:get-db dbstruct run-id))
	(db    (db:dbdat-get-db dbdat)))
    (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)))

      (let ((dbdat (db:get-db dbstruct run-id)))
	;;	(db    (db:dbdat-get-db dbdat)))
	(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))))
  
;;     (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))))
    
;;     (if (or (not state)
;; 	    (not (equal? item-path "")))
3054
3055
3056
3057
3058
3059
3060
3061

3062
3063
3064
3065
3066
3067
3068
3055
3056
3057
3058
3059
3060
3061

3062
3063
3064
3065
3066
3067
3068
3069







-
+







  (let ((query (let ((q (alist-ref (if (string? stmtname)
				       (string->symbol stmtname)
				       stmtname)
				   db:queries)))
 		 (if q (car q) #f))))
    (db:delay-if-busy dbdat)
    (apply sqlite3:execute (db:dbdat-get-db dbdat) query params)
    #t)) ;; BUG or Sillyness, why do I return #t instead of the query result?
    #t))

;; get a summary of state and status counts to calculate a rollup
;;
;; NOTE: takes a db, not a dbstruct
;;
(define (db:get-state-status-summary db run-id testname)
  (let ((res   '()))
3091
3092
3093
3094
3095
3096
3097
3098

3099
3100
3101
3102
3103
3104
3105
3092
3093
3094
3095
3096
3097
3098

3099
3100
3101
3102
3103
3104
3105
3106







-
+







				(loop (car tal)(cdr tal)))))))))


      ;;;     E D I T M E ! !


    (cond
     ((> (find "COMPLETED" ".*") #f)))))
     ((> (find "COMPLETED" ".*") 0) #f))))
		   
    

;; get the previous records for when these tests were run where all keys match but runname
;; NB// Merge this with test:get-previous-test-run-records? This one looks for all matching tests
;; can use wildcards. Also can likely be factored in with get test paths?
;;

Modified rmt.scm from [9384bcca50] to [0f735396a5].

18
19
20
21
22
23
24
25

26
27
28
29
30
31
32
18
19
20
21
22
23
24

25
26
27
28
29
30
31
32







-
+







(declare (uses nmsg-transport))

;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;

;; ;; For debugging add the following to ~/.megatestrc
;;a
;;
;; (require-library trace)
;; (import trace)
;; (trace
;; rmt:send-receive
;; api:execute-requests
;; )