Megatest

Check-in [f29006e4c3]
Login
Overview
Comment:Pulled in few minor changes from v1.64: -envcap help corrections, default run time for server to 1h
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.63
Files: files | file ages | folders
SHA1: f29006e4c388810aa543152ff0839807514258bd
User & Date: mrwellan on 2017-02-23 09:42:25
Other Links: branch diff | manifest | tags
Context
2017-02-23
14:20
cherry picked ritika's fix for filter stickiness check-in: 0c295a5ea3 user: bjbarcla tags: v1.63
09:42
Pulled in few minor changes from v1.64: -envcap help corrections, default run time for server to 1h check-in: f29006e4c3 user: mrwellan tags: v1.63
2017-02-22
19:40
Improved syncback logic to look also at journal and WAL files check-in: 35e0456c34 user: matt tags: v1.63, v1.6308
Changes

Modified db.scm from [e69a6c5870] to [138aed2c2d].

2816
2817
2818
2819
2820
2821
2822
2823


2824
2825
2826
2827

2828
2829
2830
2831
2832
2833
2834
2816
2817
2818
2819
2820
2821
2822

2823
2824
2825
2826
2827

2828
2829
2830
2831
2832
2833
2834
2835







-
+
+



-
+







  (let* ((run-ids (db:get-all-run-ids mtdb)))
    (for-each 
     (lambda (run-id)
       (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id)))
	 (db:prep-megatest.db-adj-test-ids (db:dbdat-get-db mtdb) run-id testrecs)))
     run-ids)))

;; Get test data using test_id
;; Get test data using test_id, run-id is not used
;; 
(define (db:get-test-info-by-id dbstruct run-id test-id)
  (db:with-db
   dbstruct
   run-id
   #f ;; run-id
   #f
   (lambda (db)
     (let ((res #f))
       (sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
	(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived)
	  ;;             0    1       2      3      4        5       6      7        8     9     10      11          12          13           14         15          16
	  (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived)))

Modified megatest.scm from [898706de27] to [c7c22f31b6].

1

2
3
4
5
6
7
8

1
2
3
4
5
6
7
8
-
+







;; Copyright 2006-2012, Matthew Welland.
;; Copyright 2006-2017, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.
163
164
165
166
167
168
169
170
171





172
173
174
175
176
177
178
163
164
165
166
167
168
169


170
171
172
173
174
175
176
177
178
179
180
181







-
-
+
+
+
+
+







  -load file.scm          : load and run file.scm
  -mark-incompletes       : find and mark incomplete tests
  -ping run-id|host:port  : ping server, exit with 0 if found
  -debug N|N,M,O...       : enable debug 0-N or N and M and O ...

Utilities
  -env2file fname         : write the environment to fname.csh and fname.sh
  -envcap fname=context   : save current variables labeled as context in file fname
  -refdb2dat refdb        : convert refdb to sexp or to format specified by -dumpmode
  -envcap a               : save current variables labeled as context 'a' in file envdat.db
  -envdelta a-b           : output enviroment delta from context a to context b to -o fname
                            set the output mode with -dumpmode csh, bash or ini
                            note: ini format will use calls to use curr and minimize path
  -refdb2dat refdb        : convert refdb to sexp or to format specified by s-dumpmode
                            formats: perl, ruby, sqlite3, csv (for csv the -o param
                            will substitute %s for the sheet name in generating 
                            multiple sheets)
  -o                      : output file for refdb2dat (defaults to stdout)
  -archive cmd            : archive runs specified by selectors to one of disks specified
                            in the [archive-disks] section.
                            cmd: keep-html, restore, save, save-remove
799
800
801
802
803
804
805
806

807
808
809
810
811
812
813
802
803
804
805
806
807
808

809
810
811
812
813
814
815
816







-
+







;;======================================================================
;; Weird special calls that need to run *after* the server has started?
;;======================================================================

(if (args:get-arg "-list-targets")
    (if (launch:setup)
        (let ((targets (common:get-runconfig-targets)))
          (debug:print 1 *default-log-port* "Found "(length targets) " targets")
          ;; (debug:print 1 *default-log-port* "Found "(length targets) " targets")
          (case (string->symbol (or (args:get-arg "-dumpmode") "alist"))
            ((alist)
             (for-each (lambda (x)
                         ;; (print "[" x "]"))
                         (print x))
                       targets))
            ((json)

Modified server.scm from [7d7e4242db] to [0d4bee3590].

181
182
183
184
185
186
187
188




189
190
191
192
193
194
195
181
182
183
184
185
186
187

188
189
190
191
192
193
194
195
196
197
198







-
+
+
+
+







	(let* ((server-logs   (glob (conc areapath "/logs/server-*.log")))
	       (num-serv-logs (length server-logs)))
	  (if (null? server-logs)
	      '()
	      (let loop ((hed  (car server-logs))
			 (tal  (cdr server-logs))
			 (res '()))
		(let* ((mod-time  (file-modification-time hed))
		(let* ((mod-time  (handle-exceptions
                                   exn
                                   0
                                   (file-modification-time hed))) ;; default to *very* old so log gets ignored if deleted
		       (down-time (- (current-seconds) mod-time))
		       (serv-dat  (if (or (< num-serv-logs 10)
				  	  (< down-time day-seconds))
				     (server:logf-get-start-info hed)
				     '())) ;; don't waste time processing server files not touched in the past day if there are more than ten servers to look at
		       (serv-rec (cons mod-time serv-dat))
		       (fmatch   (string-match fname-rx hed))
392
393
394
395
396
397
398
399

400
401
402
395
396
397
398
399
400
401

402
403
404
405







-
+




(define (server:get-timeout)
  (let ((tmo (configf:lookup  *configdat* "server" "timeout")))
    (if (and (string? tmo)
	     (string->number tmo))
	(* 60 60 (string->number tmo))
	;; (* 3 24 60 60) ;; default to three days
	(* 60 1)         ;; default to one minute
	(* 60 60 1)         ;; default to one hour
	;; (* 60 60 25)      ;; default to 25 hours
	)))