Changes On Branch v1.64-elena-issues
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch v1.64-elena-issues Excluding Merge-Ins

This is equivalent to a diff from 621d3c2ef2 to 538dd190e2

2017-11-22
21:55
fixed bug where rollup to REMOVING occurred where unexpected; fixed bug where testpatt having tests ending in % caused deadlock; a regression introduced in 1.64/36 check-in: 9177827d9e user: bjbarcla tags: v1.64, passed-ext-tests
20:07
fixed problem where rerunning one item of a test kicked off all items Leaf check-in: 538dd190e2 user: bjbarcla tags: v1.64-elena-issues
2017-11-21
05:45
Merged in couple fixes from v1.64 check-in: b054d48890 user: matt tags: v1.65
2017-11-18
00:14
Merged most (all?) work from v1.64-areas-dashboard into v1.64-new-areas-dashboard Leaf check-in: b20103fa31 user: mrwellan tags: v1.64-new-areas-dashboard
2017-11-16
22:42
fixed problem with infinite loop during testpatt elaboration with % suffix check-in: c4fa1b9705 user: bjbarcla tags: v1.64-elena-issues
2017-11-15
18:59
fixed issue where on deleting item, toplevel status changed to REMOVING check-in: 126270785d user: bjbarcla tags: v1.64-elena-issues
2017-11-11
00:24
backport fix for item2; the ability to recognize zero items in special cases check-in: 621d3c2ef2 user: bjbarcla tags: v1.64
2017-10-25
23:37
updated dcommon:status-compare3 to use *common:std-statuses* to establish status goodness comparison. original hardcoded list had anomaly of fail better than check. check-in: 7f3eadf698 user: bjbarcla tags: v1.64, v1.6436

Changes to common.scm.

517
518
519
520
521
522
523







524
525
526
527
528
529
530
    (3 "KILLED")
    (4 "NOT_STARTED")
    (5 "COMPLETED")
    (6 "LAUNCHED")
    (7 "REMOTEHOSTSTART")
    (8 "RUNNING")
    ))








;; BBnote: *common:std-statuses* dashboard filter control and test control status buttons defined here; used in set-fields-panel and dboard:make-controls
;; note these statuses are sorted from better to worse.
;; This sort order is important to dcommon:status-compare3 and db:set-state-status-and-roll-up-items
(define *common:std-statuses*
  '(;; (0 "DELETED")  
    (1 "n/a")







>
>
>
>
>
>
>







517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
    (3 "KILLED")
    (4 "NOT_STARTED")
    (5 "COMPLETED")
    (6 "LAUNCHED")
    (7 "REMOTEHOSTSTART")
    (8 "RUNNING")
    ))

(define *common:dont-roll-up-states*
  '("DELETED"
    "REMOVING"
    "CLEANING"
    "ARCHIVE_REMOVING"
    ))

;; BBnote: *common:std-statuses* dashboard filter control and test control status buttons defined here; used in set-fields-panel and dboard:make-controls
;; note these statuses are sorted from better to worse.
;; This sort order is important to dcommon:status-compare3 and db:set-state-status-and-roll-up-items
(define *common:std-statuses*
  '(;; (0 "DELETED")  
    (1 "n/a")
554
555
556
557
558
559
560






561
562
563
564
565
566
567
  '("RUNNING" "REMOTEHOSTSTART" "LAUNCHED" "STARTED"))

(define *common:cant-run-states*    ;; These are stopping conditions that prevent a test from being run
  '("COMPLETED" "KILLED" "UNKNOWN" "INCOMPLETE" "ARCHIVED"))

(define *common:not-started-ok-statuses* ;; if not one of these statuses when in not_started state treat as dead
  '("n/a" "na" "PASS" "FAIL" "WARN" "CHECK" "WAIVED" "DEAD" "SKIP"))







(define (common:special-sort items order comp)
  (let ((items-order (map reverse order))
        (acomp       (or comp >)))
    (sort items
        (lambda (a b)
          (let ((a-num (cadr (or (assoc a items-order) '(0 0))))







>
>
>
>
>
>







561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
  '("RUNNING" "REMOTEHOSTSTART" "LAUNCHED" "STARTED"))

(define *common:cant-run-states*    ;; These are stopping conditions that prevent a test from being run
  '("COMPLETED" "KILLED" "UNKNOWN" "INCOMPLETE" "ARCHIVED"))

(define *common:not-started-ok-statuses* ;; if not one of these statuses when in not_started state treat as dead
  '("n/a" "na" "PASS" "FAIL" "WARN" "CHECK" "WAIVED" "DEAD" "SKIP"))

;; group tests into buckets corresponding to rollup
;;; Running, completed-pass,  completed-non-pass + worst status, not started.
;; filter out 
;(define (common:categorize-items-for-rollup in-tests)
;  (

(define (common:special-sort items order comp)
  (let ((items-order (map reverse order))
        (acomp       (or comp >)))
    (sort items
        (lambda (a b)
          (let ((a-num (cadr (or (assoc a items-order) '(0 0))))

Changes to db.scm.

3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
                                                                                      *common:not-started-ok-statuses*))))
								  state-status-counts)))
                            ;; (non-completes        (filter (lambda (x)
                            ;;                                 (not (equal? (dbr:counts-state x) "COMPLETED")))
                            ;;                               state-status-counts))
                            (all-curr-states      (common:special-sort  ;; worst -> best (sort of)
                                                       (delete-duplicates
                                                        (if (not (equal? state "DELETED"))
                                                            (cons state (map dbr:counts-state state-status-counts))
                                                            (map dbr:counts-state state-status-counts)))
                                                       *common:std-states* >))
                            (all-curr-statuses    (common:special-sort  ;; worst -> best
                                                   (delete-duplicates
                                                    (if (not (equal? state "DELETED"))
                                                        (cons status (map dbr:counts-status state-status-counts))
                                                        (map dbr:counts-status state-status-counts)))
                                                   *common:std-statuses* >))
			    (non-completes     (filter (lambda (x)
							 (not (member x '("DELETED" "COMPLETED"))))
						       all-curr-states))
			    (num-non-completes (length non-completes))
                            
                            (newstate          (cond
						((> running 0)
						 "RUNNING") ;; anything running, call the situation running
						((> bad-not-started 0)  ;; we have an ugly situation, it is completed in the sense we cannot do more.







|





|




|







3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
                                                                                      *common:not-started-ok-statuses*))))
								  state-status-counts)))
                            ;; (non-completes        (filter (lambda (x)
                            ;;                                 (not (equal? (dbr:counts-state x) "COMPLETED")))
                            ;;                               state-status-counts))
                            (all-curr-states      (common:special-sort  ;; worst -> best (sort of)
                                                       (delete-duplicates
                                                        (if (not (member state *common:dont-roll-up-states*))
                                                            (cons state (map dbr:counts-state state-status-counts))
                                                            (map dbr:counts-state state-status-counts)))
                                                       *common:std-states* >))
                            (all-curr-statuses    (common:special-sort  ;; worst -> best
                                                   (delete-duplicates
                                                    (if (not (member state *common:dont-roll-up-states*))
                                                        (cons status (map dbr:counts-status state-status-counts))
                                                        (map dbr:counts-status state-status-counts)))
                                                   *common:std-statuses* >))
			    (non-completes     (filter (lambda (x)
							 (not (member x (cons "COMPLETED" *common:dont-roll-up-states*))))
						       all-curr-states))
			    (num-non-completes (length non-completes))
                            
                            (newstate          (cond
						((> running 0)
						 "RUNNING") ;; anything running, call the situation running
						((> bad-not-started 0)  ;; we have an ugly situation, it is completed in the sense we cannot do more.

Changes to launch.scm.

1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
					    (list "MT_ITEMPATH"  item-path)
					    )
				      itemdat)))
	     (testprevvals   (alist->env-vars
			      (hash-table-ref/default tconfig "pre-launch-env-overrides" '())))
	     ;; Launchwait defaults to true, must override it to turn off wait
	     (launchwait     (if (equal? (configf:lookup *configdat* "setup" "launchwait") "no") #f #t))
	     (launch-results (apply (if launchwait
					process:cmd-run-with-stderr->list
					process-run)
				    (if useshell
					(let ((cmdstr (string-intersperse fullcmd " ")))
					  (if launchwait
					      cmdstr
					      (conc cmdstr " >> mt_launch.log 2>&1 &")))







|







1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
					    (list "MT_ITEMPATH"  item-path)
					    )
				      itemdat)))
	     (testprevvals   (alist->env-vars
			      (hash-table-ref/default tconfig "pre-launch-env-overrides" '())))
	     ;; Launchwait defaults to true, must override it to turn off wait
	     (launchwait     (if (equal? (configf:lookup *configdat* "setup" "launchwait") "no") #f #t))
	     (launch-results (apply (if launchwait ;; BB: TODO: refactor this to examine return code of launcher, if nonzero, set state to launch failed.
					process:cmd-run-with-stderr->list
					process-run)
				    (if useshell
					(let ((cmdstr (string-intersperse fullcmd " ")))
					  (if launchwait
					      cmdstr
					      (conc cmdstr " >> mt_launch.log 2>&1 &")))

Changes to runs.scm.

306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
		  (debug:print 0 *default-log-port* "ERROR: failed to run post-hook " run-post-hook ", check the log " log-file))
	      (debug:print-info 0 *default-log-port* "running run-post-hook: \"" run-post-hook "\", log is " actual-logf)
	      (system (conc run-post-hook " >> " actual-logf " 2>&1"))
	      (debug:print-info 0 *default-log-port* "post-hook \"" run-post-hook "\" took " (- (current-seconds) start-time) " seconds to run."))))))

;; return #t when all items in waitors-upon list are represented in test-patt, #f otherwise.
(define (runs:testpatts-mention-waitors-upon? test-patt waitors-upon)
  (let* ((tests-in-testpatt
          (map
           (lambda (test-patt-item)
             (car (string-split test-patt-item "/")))
           (string-split test-patt ",")))
         (waitors-upon-not-mentioned (lset-difference equal? waitors-upon tests-in-testpatt)))
    (null? waitors-upon-not-mentioned)))

;;  test-names: Comma separated patterns same as test-patts but used in selection 
;;              of tests to run. The item portions are not respected.
;;              FIXME: error out if /patt specified
;;            
(define (runs:run-tests target runname test-patts user flags #!key (run-count 1)) ;; test-names
  (let* ((keys               (keys:config-get-fields *configdat*))







<
<
<
<
<
<
|







306
307
308
309
310
311
312






313
314
315
316
317
318
319
320
		  (debug:print 0 *default-log-port* "ERROR: failed to run post-hook " run-post-hook ", check the log " log-file))
	      (debug:print-info 0 *default-log-port* "running run-post-hook: \"" run-post-hook "\", log is " actual-logf)
	      (system (conc run-post-hook " >> " actual-logf " 2>&1"))
	      (debug:print-info 0 *default-log-port* "post-hook \"" run-post-hook "\" took " (- (current-seconds) start-time) " seconds to run."))))))

;; return #t when all items in waitors-upon list are represented in test-patt, #f otherwise.
(define (runs:testpatts-mention-waitors-upon? test-patt waitors-upon)






  (null? (tests:filter-test-names-not-matched waitors-upon test-patt)))

;;  test-names: Comma separated patterns same as test-patts but used in selection 
;;              of tests to run. The item portions are not respected.
;;              FIXME: error out if /patt specified
;;            
(define (runs:run-tests target runname test-patts user flags #!key (run-count 1)) ;; test-names
  (let* ((keys               (keys:config-get-fields *configdat*))
422
423
424
425
426
427
428


429
430
431
432
433
434
435
436
437

    ;; NEW STRATEGY HERE:
    ;; 1. fill required tests with test-patts
    ;; 2. scan testconfigs and if waitons, itemwait, itempatt calc prior test test-patt
    ;; 3. repeat until all deps propagated
    
    ;; any tests with direct mention in test-patts can be added to required


    ;;
    (set! required-tests     (lset-intersection equal? (string-split test-patts ",") all-test-names))
    ;; (set! required-tests     (lset-intersection equal? test-names all-test-names))
    
    ;; look up all tests matching the comma separated list of globs in
    ;; test-patts (using % as wildcard)

    ;; (set! test-names (delete-duplicates (tests:get-valid-tests *toppath* test-patts)))
    (debug:print-info 0 *default-log-port* "tests search path: " (string-intersperse (tests:get-tests-search-path *configdat*) " "))







>
>

<







416
417
418
419
420
421
422
423
424
425

426
427
428
429
430
431
432

    ;; NEW STRATEGY HERE:
    ;; 1. fill required tests with test-patts
    ;; 2. scan testconfigs and if waitons, itemwait, itempatt calc prior test test-patt
    ;; 3. repeat until all deps propagated
    
    ;; any tests with direct mention in test-patts can be added to required
    ;;(set! required-tests     (lset-intersection equal? (string-split test-patts ",") all-test-names))
    (set! required-tests     (tests:filter-test-names all-test-names test-patts))
    ;;

    ;; (set! required-tests     (lset-intersection equal? test-names all-test-names))
    
    ;; look up all tests matching the comma separated list of globs in
    ;; test-patts (using % as wildcard)

    ;; (set! test-names (delete-duplicates (tests:get-valid-tests *toppath* test-patts)))
    (debug:print-info 0 *default-log-port* "tests search path: " (string-intersperse (tests:get-tests-search-path *configdat*) " "))
1458
1459
1460
1461
1462
1463
1464
1465

1466
1467
1468
1469
1470
1471
1472
					   " ")
					  "\n"))
				  items)))

          (let* ((items-in-testpatt
                  (filter
                   (lambda (my-itemdat)
                     (tests:match test-patts hed (item-list->path my-itemdat) required: required-tests))

                   items) ))
            (if (null? items-in-testpatt)
                (let ((test-id   (rmt:get-test-id run-id test-name "")))
                  (debug:print-info 0 *default-log-port* "Test " (tests:testqueue-get-testname test-record) " is itemized but has no items matching test pattern -- marking status ZERO_ITEMS")
                  (if test-id
                      (mt:test-set-state-status-by-id run-id test-id "NOT_STARTED" "ZERO_ITEMS" "This test has no items which match test pattern.")))
                







|
>







1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
					   " ")
					  "\n"))
				  items)))

          (let* ((items-in-testpatt
                  (filter
                   (lambda (my-itemdat)
                     (tests:match test-patts hed (item-list->path my-itemdat) ))
                   ;; was: (tests:match test-patts hed (item-list->path my-itemdat) required: required-tests))
                   items) ))
            (if (null? items-in-testpatt)
                (let ((test-id   (rmt:get-test-id run-id test-name "")))
                  (debug:print-info 0 *default-log-port* "Test " (tests:testqueue-get-testname test-record) " is itemized but has no items matching test pattern -- marking status ZERO_ITEMS")
                  (if test-id
                      (mt:test-set-state-status-by-id run-id test-id "NOT_STARTED" "ZERO_ITEMS" "This test has no items which match test pattern.")))
                

Changes to tests.scm.

70
71
72
73
74
75
76







77
78
79
80
81
82
83
			  (if (and (not (hash-table-ref/default test-registry tname #f))
				   (common:file-exists? tconfig))
			      (hash-table-set! test-registry tname test-path))))
		      (glob (conc hed "/*"))))
	(if (null? tal)
	    test-registry
	    (loop (car tal)(cdr tal))))))








(define (tests:filter-test-names test-names test-patts)
  (delete-duplicates
   (filter (lambda (testname)
	     (tests:match test-patts testname #f))
	   test-names)))








>
>
>
>
>
>
>







70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
			  (if (and (not (hash-table-ref/default test-registry tname #f))
				   (common:file-exists? tconfig))
			      (hash-table-set! test-registry tname test-path))))
		      (glob (conc hed "/*"))))
	(if (null? tal)
	    test-registry
	    (loop (car tal)(cdr tal))))))

(define (tests:filter-test-names-not-matched test-names test-patts)
  (delete-duplicates
   (filter (lambda (testname)
	     (not (tests:match test-patts testname #f)))
	   test-names)))


(define (tests:filter-test-names test-names test-patts)
  (delete-duplicates
   (filter (lambda (testname)
	     (tests:match test-patts testname #f))
	   test-names)))