Megatest

Check-in [f81a147c94]
Login
Overview
Comment:Phase 1 of extract skeleton is working. Need to generate testconfigs next. ==/5.2/0.7/WARN/1201/mars/==
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: f81a147c94b5f93ae266e4e67e6cb1d543f80b06
User & Date: mrwellan on 2020-08-20 13:01:12
Original Comment: Phase 1 of extract skeleton is working. Need to generate testconfigs next.
Other Links: branch diff | manifest | tags
Context
2020-08-20
16:42
Phase 2 of extract skeleton done. Seems to mostly work. ==/8.2/0.98/WARN/1201/mars/== check-in: 31edce5e9c user: mrwellan tags: v1.65
13:01
Phase 1 of extract skeleton is working. Need to generate testconfigs next. ==/5.2/0.7/WARN/1201/mars/== check-in: f81a147c94 user: mrwellan tags: v1.65
11:11
changed version to 1.6564 ==3.39/1.0/PASS/1203/orion== v1.70 START check-in: cd0bb84cf2 user: mmgraham tags: v1.65, v1.6564
Changes

Modified db.scm from [5d8ca5b259] to [35e6d8a640].

1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774

1775
1776
1777
1778
1779




1780
1781
1782
1783
1784


1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1758
1759
1760
1761
1762
1763
1764
1765






1766


1767





1768
1769
1770
1771
1772
1773
1774


1775
1776





1777
1778
1779
1780
1781
1782
1783








-
-
-
-
-
-

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



-
-
+
+
-
-
-
-
-







       
       (debug:print-info 18 *default-log-port* "Found " (length oldlaunched) " old LAUNCHED items, " (length toplevels) " old LAUNCHED toplevel tests and " (length incompleted) " tests marked RUNNING but apparently dead.")
       (if (and (null? incompleted)
                (null? oldlaunched)
                (null? toplevels))
           #f
           #t)))))

;; given a launch delay (minimum time from last launch) return amount of time to wait
;;
;; (define (db:launch-delay-left dbstruct run-id launch-delay)
  


(define (db:get-status-from-final-status-file run-dir)
  (let (
       (infile (conc run-dir "/.final-status")))
  (let ((infile (conc run-dir "/.final-status")))

       ;; first verify we are able to write the output file
       (if (not (file-read-access? infile))
          (begin 
	        (debug:print 0 *default-log-port* "ERROR: cannot read " infile)
    ;; first verify we are able to write the output file
    (if (not (file-read-access? infile))
        (begin 
	  (debug:print 0 *default-log-port* "ERROR: cannot read " infile)
          (debug:print 0 *default-log-port* "ERROR: run-dir is " run-dir)
          #f
          )
          (with-input-from-file infile read-lines)
       )
        (with-input-from-file infile read-lines)
	)))
  )
)




;;  select end_time-now from
;;      (select testname,item_path,event_time+run_duration as
;;                          end_time,strftime('%s','now') as now from tests where state in
;;      ('RUNNING','REMOTEHOSTSTART','LAUNCHED'));

(define (db:find-and-mark-incomplete dbstruct run-id ovr-deadtime)

Modified genexample.scm from [2597a6cc06] to [caeb943e58].

15
16
17
18
19
20
21
22



23
24
25
26
27
28
29
15
16
17
18
19
20
21

22
23
24
25
26
27
28
29
30
31







-
+
+
+







;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit genexample))
(use posix regex)
(use posix regex matchable)

(include "db_records.scm")

(define genexample:example-logpro
#<<EOF
  ;; You should have at least one expect:required. This ensures that your process ran
  ;; comment out the line below and replace "put pattern here" with a pattern that will
  ;; always be seen in your log file if the step runs successfully.
  ;;
336
337
338
339
340
341
342






























































































338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
			(if (string-match ".*\\.sh$" script)
			    (begin
			      (with-output-to-file (conc testdir "/" script)
				(lambda ()
				  (print genexample:example-script)))
			      (system (conc "chmod ug+r,a+x " (conc testdir "/" script)))))))
		    steps))))))

;; easier to work backwards than change the upstream code
;;
(define (hrs-min-sec->seconds str)
  (let* ((parts (string-split str))
	 (res   0))
    (for-each
     (lambda (part)
       (set! res
	     (+ res
		(match (string-match "(\\d+)([a-z])" part)
		  ((_ val units)(* (string->number val)(case (string->symbol units)
							 ((s) 1)
							 ((m) 60)
							 ((h) 3600))))
		  (else 0)))))
     parts)
    res))

;; generate a skeleton Megatest area from a current area with runs
;;
;;    specify target, runname etc to use specific runs for the template
;;
(define (genexample:extract-skeleton-area dest-path)
  (let* ((target  (args:get-arg "-target"))
	 (runname (args:get-arg "-runname"))
	 )
    (if (not (and target runname))
	(debug:print 0 *default-log-port* "WARNING: For best results please specifiy -target and -runname for a good run to use as a template."))
    (if (not (and (file-exists? "megatest.config")
		  (file-exists? "megatest.db")))
	(begin
	  (debug:print 0 *default-log-port* "ERROR: this command must be run at the top level of a megatest area where runs have been completed")
	  (exit)))
	     
    ;; first create the dest path and needed subdirectories
    (if (not (file-exists? dest-path))
	(begin
	  (create-directory dest-path)
	  (create-directory (conc dest-path "/tests")))
	(if (file-exists? (conc dest-path "/megatest.config"))
	    (begin
	      (debug:print 0 *default-log-port* "ERROR: destination path already has megatest.config, stopping now.")
	      (exit))))

    ;; dump the config files from this area to the dest area
    (system (conc "megatest -show-config > " dest-path "/megatest.config"))
    (system (conc "megatest -show-runconfig > " dest-path "/runconfigs.config"))

    ;; create a refdb, some stuff has to be done due to refdb not initing area
    ;;   sheet   row       col      value
    ;;   test    itempath  stepname steptime
    (if (not (file-exists? (conc dest-path "/stepsinfo")))
	(begin
	  (create-directory (conc dest-path "/stepsinfo/sxml") #t)
	  (with-output-to-file (conc dest-path "/stepsinfo/sheet-names.cfg") (lambda ()(print)))))

    ;; rmt:get-tests-for-run
    ;; rmt:get-tests-for-run-mindata run-id testpatt states status not-in
    ;; rmt:simple-get-runs
    ;; (define-record simple-run target id runname state status owner event_time)
    (let* ((runs   (rmt:simple-get-runs (or runname "%") #f #f (or target "%")))
	   (tests  (make-hash-table))
	   (refdb  (conc dest-path "/stepsinfo")))
      (if (> (length runs) 1)
	  (debug:print-info 0 *default-log-port* "More than one run matches, first found data will be used."))
      ;; get all testnames
      (for-each
       (lambda (run-id)
	 (let* ((tests-data (rmt:get-tests-for-run-mindata run-id "%" '() '() #f)))
	   (for-each
	    (lambda (testdat)
	      (let* ((test-id      (db:mintest-get-id testdat))
		     (testname     (db:mintest-get-testname testdat))
		     (item-path    (db:mintest-get-item_path testdat))
		     ;; now get steps info
		     (test-steps   (tests:get-compressed-steps run-id test-id)))
		(if (not (hash-table-exists? tests testname))
		    (begin
		      (print "\n" testname)
		      (for-each
		       (lambda (teststep)
			 (let* ((step-name     (vector-ref teststep 0))
				(step-duration (hrs-min-sec->seconds (vector-ref teststep 4))))
			   (system (conc "refdb set " refdb " " testname " '" (if (equal? item-path "")
										  "no-item-path"
										  item-path)
					 "' " step-name " " step-duration))
			   ))
		       test-steps))
		    (else (debug:print-info 0 *default-log-port* "Skipping already seen test " testname)))))
	    tests-data)))
       (map (lambda (runrec)(simple-run-id runrec)) runs)))
    ))

Modified megatest.scm from [5f03716a04] to [cb14ee8afa].

230
231
232
233
234
235
236
237

238
239

240
241
242
243
244
245
246
247
248
230
231
232
233
234
235
236

237
238

239


240
241
242
243
244
245
246







-
+

-
+
-
-







                            in the [archive-disks] section.
                            cmd: keep-html, restore, save, save-remove, get,replicate-db (use 
                            -dest to set destination), -include path1,path2... to get or save specific files
  -generate-html          : create a simple html dashboard for browsing your runs
  -generate-html-structure  : create a top level html veiw to list targets/runs and a Run view within each run directory.  
  -list-run-time          : list time requered to complete runs. It supports following switches
                            -run-patt <patt> -target-patt <patt> -dumpmode <csv,json,plain-text>
  -list-test-time	   : list time requered to complete each test in a run. It following following arguments
  -list-test-time	  : list time requered to complete each test in a run. It following following arguments
                            -runname <patt> -target <patt> -dumpmode <csv,json,plain-text>

  -extract-skeleton targd : extract a skeleton area based on the current area. Use median step run times.
  		


Diff report
  -diff-rep               : generate diff report (must include -src-target, -src-runname, -target, -runname
                                                  and either -diff-email or -diff-html)
  -src-target <target>
  -src-runname <target>
  -diff-email <emails>    : comma separated list of email addresses to send diff report
369
370
371
372
373
374
375



376
377
378
379
380
381
382
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383







+
+
+







                        "-src-target"
                        "-src-runname"
                        "-diff-email"
			"-sync-to"			
			"-pgsync"
			"-kill-wait"    ;; wait this long before removing test (default is 10 sec)
                        "-diff-html"

			;; wizards, area capture, setup new ...
			"-extract-skeleton"
			)
 		 (list  "-h" "-help" "--help"
			"-manual"
			"-version"
		        "-force"
		        "-xterm"
		        "-showkeys"
2431
2432
2433
2434
2435
2436
2437

2438
2439
2440
2441
2442
2443
2444






2445
2446
2447
2448
2449
2450
2451
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459







+







+
+
+
+
+
+







     
(if (args:get-arg "-generate-html")
    (let* ((toppath (launch:setup)))
      (if (tests:create-html-tree #f)
          (debug:print-info 0 *default-log-port* "HTML output created in " toppath "/lt/page0.html")
          (debug:print 0 *default-log-port* "Failed to create HTML output in " toppath "/lt/runs-index.html"))
      (set! *didsomething* #t)))

(if (args:get-arg "-generate-html-structure")
    (let* ((toppath (launch:setup)))
      ;(if (tests:create-html-tree #f)
 				(if (tests:create-html-summary #f)
          (debug:print-info 0 *default-log-port* "HTML output created in " toppath "/lt/targets.html")
          (debug:print 0 *default-log-port* "Failed to create HTML output in " toppath "/lt/runs-index.html"))
      (set! *didsomething* #t)))

(if (args:get-arg "-extract-skeleton")
    (let* ((toppath (launch:setup)))
      (genexample:extract-skeleton-area (args:get-arg "-extract-skeleton"))
      (set! *didsomething* #t)))

;;======================================================================
;; Exit and clean up
;;======================================================================

(if (not *didsomething*)
    (debug:print 0 *default-log-port* help)
    (set! *time-to-exit* #t)

Modified runs.scm from [fad1b4b96b] to [43134da369].

2041
2042
2043
2044
2045
2046
2047
2048

2049
2050
2051
2052
2053
2054
2055
2041
2042
2043
2044
2045
2046
2047

2048
2049
2050
2051
2052
2053
2054
2055







-
+







		     (begin
		       (mt:test-set-state-status-by-id run-id test-id "COMPLETED" "SKIP" skip-test)
		       (debug:print-info 1 *default-log-port* "SKIPPING Test " full-test-name " due to " skip-test))
		     ;;
		     ;; Here the test is handed off to launch.scm for launch-test to complete the launch process
		     ;;
		     (if (not (launch-test test-id run-id run-info keyvals runname test-conf test-name test-path itemdat flags))
			 (begin
	 		 (begin
			   (print "ERROR: Failed to launch the test. Exiting as soon as possible")
			   (set! *globalexitstatus* 1) ;; 
			   (process-signal (current-process-id) signal/kill))))))))
	((KILLED) 
	 (debug:print 1 *default-log-port* "NOTE: " full-test-name " is already running or was explictly killed, use -force to launch it.")
	 (hash-table-set! test-registry (db:test-make-full-name test-name test-path) 'DONOTRUN)) ;; KILLED))
	((LAUNCHED REMOTEHOSTSTART RUNNING)