Megatest

Check-in [921f5f46c6]
Login
Overview
Comment:Got basics working for intelligent removal
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64-run-utils | v1.64-keep-running-fix
Files: files | file ages | folders
SHA1: 921f5f46c6f80ac5dbeb7cb7a91bb54124b41985
User & Date: mrwellan on 2017-09-20 18:07:53
Other Links: branch diff | manifest | tags
Context
2017-09-20
21:57
Finished off the runs cleanup code and added some limited documentation. Closed-Leaf check-in: f8bf61270c user: matt tags: v1.64-run-utils, v1.64-keep-running-fix
18:07
Got basics working for intelligent removal check-in: 921f5f46c6 user: mrwellan tags: v1.64-run-utils, v1.64-keep-running-fix
00:47
Added simple-get-runs and get-all-but-most-recent-n-per-target check-in: 1d0be73485 user: matt tags: v1.64-run-utils, v1.64-keep-running-fix
Changes

Modified megatest.scm from [35786c6bf6] to [61d758b5ea].

113
114
115
116
117
118
119

120
121
122
123
124
125
126
  -set-run-status status  : sets status for run to status, requires -target and -runname
  -get-run-status         : gets status for run specified by target and runname
  -run-wait               : wait on run specified by target and runname
  -preclean               : remove the existing test directory before running the test
  -clean-cache            : remove the cached megatest.config and runconfigs.config files
  -no-cache               : do not use the cached config files. 
  -one-pass               : launch as many tests as you can but do not wait for more to be ready


Selectors (e.g. use for -runtests, -remove-runs, -set-state-status, -list-runs etc.)
  -target key1/key2/...   : run for key1, key2, etc.
  -reqtarg key1/key2/...  : run for key1, key2, etc. but key1/key2 must be in runconfigs
  -testpatt patt1/patt2,patt3/...  : % is wildcard
  -runname                : required, name for this particular test run
  -state                  : Applies to runs, tests or steps depending on context







>







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
  -set-run-status status  : sets status for run to status, requires -target and -runname
  -get-run-status         : gets status for run specified by target and runname
  -run-wait               : wait on run specified by target and runname
  -preclean               : remove the existing test directory before running the test
  -clean-cache            : remove the cached megatest.config and runconfigs.config files
  -no-cache               : do not use the cached config files. 
  -one-pass               : launch as many tests as you can but do not wait for more to be ready
  -remove-keep N action   : remove all but N most recent runs per target, action is; print,remove

Selectors (e.g. use for -runtests, -remove-runs, -set-state-status, -list-runs etc.)
  -target key1/key2/...   : run for key1, key2, etc.
  -reqtarg key1/key2/...  : run for key1, key2, etc. but key1/key2 must be in runconfigs
  -testpatt patt1/patt2,patt3/...  : % is wildcard
  -runname                : required, name for this particular test run
  -state                  : Applies to runs, tests or steps depending on context
288
289
290
291
292
293
294



295
296
297
298
299
300
301
			"-extract-ods"
			"-pathmod"
			"-env2file"
			"-envcap"
			"-envdelta"
			"-setvars"
			"-set-state-status"



			"-set-run-status"
			"-debug" ;; for *verbosity* > 2
			"-create-test"
			"-override-timeout"
			"-test-files"  ;; -test-paths is for listing all
			"-load"        ;; load and exectute a scheme file
			"-section"







>
>
>







289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
			"-extract-ods"
			"-pathmod"
			"-env2file"
			"-envcap"
			"-envdelta"
			"-setvars"
			"-set-state-status"

                        ;; move runs stuff here
                        "-remove-keep"           
			"-set-run-status"
			"-debug" ;; for *verbosity* > 2
			"-create-test"
			"-override-timeout"
			"-test-files"  ;; -test-paths is for listing all
			"-load"        ;; load and exectute a scheme file
			"-section"
1031
1032
1033
1034
1035
1036
1037











1038
1039
1040
1041
1042
1043
1044
     "-remove-runs"
     "remove runs"
     (lambda (target runname keys keyvals)
       (operate-on 'remove-runs mode: (if (args:get-arg "-keep-records")
                                          'remove-data-only
                                          'remove-all)))))












(if (args:get-arg "-set-state-status")
    (general-run-call 
     "-set-state-status"
     "set state and status"
     (lambda (target runname keys keyvals)
       (operate-on 'set-state-status))))








>
>
>
>
>
>
>
>
>
>
>







1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
     "-remove-runs"
     "remove runs"
     (lambda (target runname keys keyvals)
       (operate-on 'remove-runs mode: (if (args:get-arg "-keep-records")
                                          'remove-data-only
                                          'remove-all)))))

(if (args:get-arg "-remove-keep")
    (general-run-call 
     "-remove-keep"
     "remove keep"
     (lambda (target runname keys keyvals)
       (let ((actions (map string->symbol
                           (if (null? remargs)
                               '("print") ;; default to printing the output
                               (string-split (car remargs) ",")))))
         (runs:remove-all-but-last-n-runs-per-target target runname (string->number (args:get-arg "-remove-keep" actions: actions)))))))
    
(if (args:get-arg "-set-state-status")
    (general-run-call 
     "-set-state-status"
     "set state and status"
     (lambda (target runname keys keyvals)
       (operate-on 'set-state-status))))

Modified runs.scm from [48c6863f6a] to [d5adcc546c].

1774
1775
1776
1777
1778
1779
1780




1781
1782
1783
1784
1785
1786

1787

1788
1789
1790

















1791
1792
1793
1794











1795
1796
1797
1798
1799
1800
1801
	  (lambda (run)
	    (let ((target (simple-run-target run)))
	      (hash-table-set! res-ht target (cons run (hash-table-ref/default res-ht target '())))))
	  runs)))
     targets)
    res-ht))





(define (runs:get-all-but-most-recent-n-per-target target-patts runpatt num-to-keep)
  (let ((runs-ht (runs:get-hash-by-target target-patts runpatt)))
    (for-each
     (lambda (target)
       (let* ((runs      (hash-table-ref runs-ht target))
	      (sorted    (sort runs (lambda (a b)(> (simple-run-event_time a)(simple-run-event_time b)))))

	      (to-remove (if (> (length sorted) num-to-keep)

			     (take sorted (- (length sorted) num-to-keep))
			     '())))
	 (hash-table-set! runs-ht target to-remove)

















	 (print "Sorted: " (map simple-run-event_time sorted))
	 (print "Remove: " (map simple-run-event_time to-remove))))
     (hash-table-keys runs-ht))
    runs-ht))












;; Remove runs
;; fields are passing in through 
;; action:
;;    'remove-runs
;;    'set-state-status
;;







>
>
>
>
|





>
|
>
|
|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|


>
>
>
>
>
>
>
>
>
>
>







1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
	  (lambda (run)
	    (let ((target (simple-run-target run)))
	      (hash-table-set! res-ht target (cons run (hash-table-ref/default res-ht target '())))))
	  runs)))
     targets)
    res-ht))

;; delete runs older than X (weeks, days, months years etc.)
;; delete redundant runs within a target - N is the input
;; delete redundant runs within a target IFF older than given date/time AND keep at least N
;; 
(define (runs:remove-all-but-last-n-runs-per-target target-patts runpatt num-to-keep #!key (actions '(print)))
  (let ((runs-ht (runs:get-hash-by-target target-patts runpatt)))
    (for-each
     (lambda (target)
       (let* ((runs      (hash-table-ref runs-ht target))
	      (sorted    (sort runs (lambda (a b)(> (simple-run-event_time a)(simple-run-event_time b)))))
	      (to-remove (let* ((len      (length sorted))
                                (trim-amt (- len num-to-keep)))
                           (if (> trim-amt 0)
                               (take sorted trim-amt)
                               '()))))
	 (hash-table-set! runs-ht target to-remove)
         (print target ":")
         (for-each
          (lambda (run)
            (let ((remove (member run to-remove (lambda (a b)
                                                  (eq? (simple-run-id a)
                                                       (simple-run-id b))))))
              (for-each
               (lambda (action)
                 (case action
                   ((print)
                    (print " " (simple-run-runname run)
                           " " (time->string (seconds->local-time (simple-run-event_time run)) "WW%V.%u %H:%M:%S")
                           " " (if remove "REMOVE" "")))
                   ((remove)
                    (print "megatest -remove-runs -target " target " -runname " (simple-run-runname run) " -testpatt %"))))
               actions)))
          sorted)))
	 ;; (print "Sorted: " (map simple-run-event_time sorted))
	 ;; (print "Remove: " (map simple-run-event_time to-remove))))
     (hash-table-keys runs-ht))
    runs-ht))

;; (define (runs:remove-all-but-last-n-runs-per-target target-patts runpatt num-to-keep)
;;   (let ((data (runs:get-all-but-most-recent-n-per-target target-patts runpatt num-to-keep)))
;;     (for-each
;;      (lambda (target)
;;        (let ((runs-to-remove (hash-table-ref data target )))
;;          (for-each
;;           (lambda (run)
;;             (print "megatest -remove-runs -target " target " -runname " (simple-run-runname run) " -testpatt %"))
;;           runs-to-remove)))
;;      (hash-table-keys data))))

;; Remove runs
;; fields are passing in through 
;; action:
;;    'remove-runs
;;    'set-state-status
;;