Megatest

Check-in [f8bf61270c]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Finished off the runs cleanup code and added some limited documentation.
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: f8bf61270c28add4f64ab7d4bc9767a21f18e831
User & Date: matt on 2017-09-20 21:57:40
Other Links: branch diff | manifest | tags
Context
2017-09-20
21:58
Merged run-utils branch to v1.65 check-in: 37803689fe user: matt tags: v1.65
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
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified common.scm from [93c8a7d160] to [b7ccd598a5].

︙
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

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








-
+

-
-
+
+










-
-
+
+
+
+
+








		  
;;======================================================================
;; T I M E   A N D   D A T E
;;======================================================================

;; Convert strings like "5s 2h 3m" => 60x60x2 + 3x60 + 5
(define (common:hms-string->seconds tstr)
  (let ((parts     (string-split tstr))
  (let ((parts     (string-split-fields "\\w+" tstr))
	(time-secs 0)
	;; s=seconds, m=minutes, h=hours, d=days
	(trx       (regexp "(\\d+)([smhd])")))
	;; s=seconds, m=minutes, h=hours, d=days, M=months, y=years, w=weeks
	(trx       (regexp "(\\d+)([smhdMyw])")))
    (for-each (lambda (part)
		(let ((match  (string-match trx part)))
		  (if match
		      (let ((val (string->number (cadr match)))
			    (unt (caddr match)))
			(if val 
			    (set! time-secs (+ time-secs (* val
							    (case (string->symbol unt)
							      ((s) 1)
							      ((m) 60)
							      ((h) (* 60 60))
							      ((d) (* 24 60 60))
							      ((h) 3600)
							      ((d) 86400)
							      ((2) 604800)
							      ((M) 2628000) ;; aproximately one month
							      ((y) 31536000)
							      (else 0))))))))))
	      parts)
    time-secs))
		       
(define (seconds->hr-min-sec secs)
  (let* ((hrs (quotient secs 3600))
	 (min (quotient (- secs (* hrs 3600)) 60))
︙

Modified docs/manual/reference.txt from [69a60a933a] to [9467d2561e].

︙
611
612
613
614
615
616
617














618
619
620
621
622
623
624

611
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








+
+
+
+
+
+
+
+
+
+
+
+
+
+








------------------------------
cat testconfig

[pre-launch-env-vars]
[include modified.config]
------------------------------

Managing Old Runs
-----------------

It is often desired to keep some older runs around but this must be balanced with the costs of disk space.

. Use -remove-keep
. Use -archive (can also be done from the -remove-keep interface)
. use -remove-runs with -keep-records

.For each target, remove all runs but the most recent 3 if they are over 1 week old
---------------------
# use -precmd 'sleep 5;nbfake' to limit overloading the host computer but to allow the removes to run in parallel.
megatest -actions print,remove-runs -remove-keep 3 -target %/%/%/% -runname % -age 1w -precmd 'sleep 5;nbfake'"
---------------------

Programming API
---------------

These routines can be called from the megatest repl. 

.API Keys Related Calls
︙

Modified megatest.scm from [61d758b5ea] to [2354f6f3e4].

︙
113
114
115
116
117
118
119
120





121
122
123
124
125
126
127

113
114
115
116
117
118
119

120
121
122
123
124
125
126
127
128
129
130
131








-
+
+
+
+
+








  -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
  -remove-keep N action   : remove all but N most recent runs per target
                            * Use -actions print,remove-runs,archive to specify action to take
                            * Add param -age 120d,3h,20m to apply only to runs older than the 
                                 specified age
                            * Add -precmd to insert a wrapper command in front of the commands run

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
︙
293
294
295
296
297
298
299





300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320

297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321

322
323
324
325
326
327
328








+
+
+
+
+













-








			"-envdelta"
			"-setvars"
			"-set-state-status"

                        ;; move runs stuff here
                        "-remove-keep"           
			"-set-run-status"
			"-age"
			"-archive"
			"-actions"
			"-precmd"
			
			"-debug" ;; for *verbosity* > 2
			"-create-test"
			"-override-timeout"
			"-test-files"  ;; -test-paths is for listing all
			"-load"        ;; load and exectute a scheme file
			"-section"
			"-var"
			"-dumpmode"
			"-run-id"
			"-ping"
			"-refdb2dat"
			"-o"
			"-log"
			"-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"
︙
1041
1042
1043
1044
1045
1046
1047

1048
1049



1050
1051
1052




1053
1054
1055
1056
1057
1058
1059

1049
1050
1051
1052
1053
1054
1055
1056


1057
1058
1059



1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070








+
-
-
+
+
+
-
-
-
+
+
+
+









(if (args:get-arg "-remove-keep")
    (general-run-call 
     "-remove-keep"
     "remove keep"
     (lambda (target runname keys keyvals)
       (let ((actions (map string->symbol
                           (string-split
                           (if (null? remargs)
                               '("print") ;; default to printing the output
			    (or (args:get-arg "-actions")
				"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)))))))
    
         (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 [d5adcc546c] to [56cdc760d5].

︙
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

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








-
+
+
+
+
+
















+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








    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)))
  (let* ((runs-ht  (runs:get-hash-by-target target-patts runpatt))
	 (age      (if (args:get-arg "-age")(common:hms-string->seconds (args:get-arg "-age")) #f))
	 (age-mark (if age (- (current-seconds) age) (+ (current-seconds) 86400)))
	 (precmd   (or (args:get-arg "-precmd") "")))
    (print "Actions: " actions)
    (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))))))
	      (if (and age (> (simple-run-event_time run) age-mark))
		  (print "Skipping handling of " target "/" (simple-run-runname run) " as it is younger than " (args:get-arg "-age"))
              (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))))
		  (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-runs)
			(if remove (system (conc precmd " megatest -remove-runs -target " target " -runname " (simple-run-runname run) " -testpatt %"))))
		       ((archive)
			(if remove (system (conc precmd " megatest -archive save-remove -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)
︙

This page was generated in about 0.126s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00