Megatest

Check-in [410e7c9b43]
Login
Overview
Comment:merged v1.63
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.63-xor-report
Files: files | file ages | folders
SHA1: 410e7c9b434fbb0a9841ad239d48cc962ad676f7
User & Date: bjbarcla on 2017-01-23 11:39:48
Other Links: branch diff | manifest | tags
Context
2017-01-23
12:14
captured ducttape-lib files (does not yet install... wip) check-in: b4dc6cb51b user: bjbarcla tags: v1.63-xor-report
11:39
merged v1.63 check-in: 410e7c9b43 user: bjbarcla tags: v1.63-xor-report
2017-01-21
22:57
Merged in db refresh timestamp gate check-in: f24fe39093 user: matt tags: v1.63
2017-01-18
18:15
wip check-in: d2e3ff2da0 user: bjbarcla tags: v1.63-xor-report
Changes

Modified common.scm from [08e30eaf43] to [7eb7ab294e].

1085
1086
1087
1088
1089
1090
1091














1092
1093
1094
1095
1096
1097
1098
;; lazy-safe get file mod time. on any error (file not existing etc.) return 0
;;
(define (common:lazy-modification-time fpath)
  (handle-exceptions
   exn
   0
   (file-modification-time fpath)))















;; return a nice clean pathname made absolute
(define (common:nice-path dir)
  (let ((match (string-match "^(~[^\\/]*)(\\/.*|)$" dir)))
    (if match ;; using ~ for home?
	(common:nice-path (conc (common:read-link-f (cadr match)) "/" (caddr match)))
	(normalize-pathname (if (absolute-pathname? dir)







>
>
>
>
>
>
>
>
>
>
>
>
>
>







1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
;; lazy-safe get file mod time. on any error (file not existing etc.) return 0
;;
(define (common:lazy-modification-time fpath)
  (handle-exceptions
   exn
   0
   (file-modification-time fpath)))

;; find timestamp of newest file associated with a sqlite db file
(define (common:lazy-sqlite-db-modification-time fpath)
  (let* ((glob-list (handle-exceptions
                    exn
                    '("/no/such/file")
                    (glob (conc fpath "*"))))
         (file-list (if (eq? 0 (length glob-list))
                        '("/no/such/file")
                        glob-list)))
  (apply max
   (map
    common:lazy-modification-time 
    file-list))))

;; return a nice clean pathname made absolute
(define (common:nice-path dir)
  (let ((match (string-match "^(~[^\\/]*)(\\/.*|)$" dir)))
    (if match ;; using ~ for home?
	(common:nice-path (conc (common:read-link-f (cadr match)) "/" (caddr match)))
	(normalize-pathname (if (absolute-pathname? dir)

Modified dashboard.scm from [3a1cbbc7df] to [233c496696].

364
365
366
367
368
369
370
371

372
373
374
375
376
377
378
379
380
381
382
  tests-drawn    ;; list of id's already drawn on screen
  tests-notdrawn ;; list of id's NOT already drawn
  rowsused       ;; hash of lists covering what areas used - replace with quadtree
  hierdat        ;; put hierarchial sorted list here
  tests          ;; hash of id => testdat
  ((tests-by-name (make-hash-table)) : hash-table) ;; hash of testfullname => testdat
  key-vals
  ((last-update   0)                 : fixnum) ;; last query to db got records from before last-update

  ((data-changed  #f)                : boolean)
  ((run-data-offset  0)              : number)      ;; get only 100 items per call, set back to zero when received less that 100 items
  (db-path #f)
  )

;; register dboard:rundat with BBpp
;; this is used by BBpp (Brandon's pretty printer) to convert dboard:rundat into a composition of lists that pp will handle
(hash-table-set! *BBpp_custom_expanders_list* RUNDAT:
                 (cons dboard:rundat?
                       (lambda (tabdat-item)
                         (filter







|
>
|
|
|
<







364
365
366
367
368
369
370
371
372
373
374
375

376
377
378
379
380
381
382
  tests-drawn    ;; list of id's already drawn on screen
  tests-notdrawn ;; list of id's NOT already drawn
  rowsused       ;; hash of lists covering what areas used - replace with quadtree
  hierdat        ;; put hierarchial sorted list here
  tests          ;; hash of id => testdat
  ((tests-by-name (make-hash-table)) : hash-table) ;; hash of testfullname => testdat
  key-vals
  ((last-update   0)                 : number)    ;; last query to db got records from before last-update
  ((last-db-time  0)                 : number)    ;; last timestamp on megatest.db
  ((data-changed  #f)                : boolean)   
  ((run-data-offset  0)              : number)      ;; get only 100 items per call, set back to zero when received less than 100 items
  (db-path #f))


;; register dboard:rundat with BBpp
;; this is used by BBpp (Brandon's pretty printer) to convert dboard:rundat into a composition of lists that pp will handle
(hash-table-set! *BBpp_custom_expanders_list* RUNDAT:
                 (cons dboard:rundat?
                       (lambda (tabdat-item)
                         (filter
513
514
515
516
517
518
519

520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550

551
552
553
554
555



556

557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576


577




578
579








580

581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
;; This is roughly the same as dboard:get-tests-dat, should merge them if possible
;;
;; gets all the tests for run-id that match testnamepatt and key-vals, merges them
;;
;;    NOTE: Yes, this is used
;;
(define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals)

  (let* ((access-mode  (dboard:tabdat-access-mode tabdat))
         (num-to-get
          (let ((num-tests-from-config (configf:lookup *configdat* "setup" "num-tests-to-get")))
            (if num-tests-from-config
                (begin
                  (BB> "override num-tests 100 -> "num-tests-from-config)
                  (string->number num-tests-from-config))
                100)))
	 (states      (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)))
	 (statuses    (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)))
         (do-not-use-db-file-timestamps #t) ;; (configf:lookup *configdat* "setup" "do-not-use-db-file-timestamps")) ;; this still hosts runs-summary-tab
         (do-not-use-query-timestamps   #t) ;; (configf:lookup *configdat* "setup" "do-not-use-query-timestamps")) ;; this no longer troubles runs-summary-tab
	 (sort-info   (get-curr-sort))
	 (sort-by     (vector-ref sort-info 1))
	 (sort-order  (vector-ref sort-info 2))
	 (bubble-type (if (member sort-order '(testname))
			  'testname
			  'itempath))
	 ;; note: the rundat is normally created in "update-rundat". 
	 (run-dat    (or (hash-table-ref/default (dboard:tabdat-allruns-by-id tabdat) run-id #f)
			 (let ((rd (dboard:rundat-make-init run: run key-vals: key-vals)))
			   (hash-table-set! (dboard:tabdat-allruns-by-id tabdat) run-id rd)
			   rd)))
	 ;; (prev-tests  (dboard:rundat-tests prev-dat)) ;; (vector-ref prev-dat 1))
         (last-update
          (if do-not-use-query-timestamps
              0
              (dboard:rundat-last-update run-dat)
              ;;(hash-table-ref/default (dboard:tabdat-run-update-times tabdat) run-id 0)
              ))


	 (db-path     (or (dboard:rundat-db-path run-dat)
			  (let* ((db-dir (tasks:get-task-db-path))
				 (db-pth (conc db-dir "/" run-id ".db")))
			    (dboard:rundat-db-path-set! run-dat db-pth)
			    db-pth)))



	 (tmptests    (if (or do-not-use-db-file-timestamps

			      (>=  (common:lazy-modification-time db-path) last-update))
                          (db:dispatch-query access-mode rmt:get-tests-for-run db:get-tests-for-run
                                             run-id testnamepatt states statuses  ;; run-id testpatt states statuses
                                             (dboard:rundat-run-data-offset run-dat)
                                             num-to-get
                                             (dboard:tabdat-hide-not-hide tabdat) ;; no-in
                                             sort-by                              ;; sort-by
                                             sort-order                           ;; sort-order
                                             #f ;; 'shortlist                           ;; qrytype
                                             (if (dboard:tabdat-filters-changed tabdat) 
                                                 0
                                                 last-update) ;; last-update
                                             *dashboard-mode*) ;; use dashboard mode
			  '()))
	 (use-new    (dboard:tabdat-hide-not-hide tabdat))
	 (tests-ht   (if (dboard:tabdat-filters-changed tabdat)
			 (let ((ht (make-hash-table)))
			   (dboard:rundat-tests-set! run-dat ht)
			   ht)
			 (dboard:rundat-tests run-dat))))


	 ;;(start-time (current-seconds)))





    ;; to limit the amount of data transferred each cycle use limit of num-to-get and offset








    (dboard:rundat-run-data-offset-set! 

     run-dat 
     (if (< (length tmptests) num-to-get)
	 0
	 (let ((newval (+ num-to-get (dboard:rundat-run-data-offset run-dat))))
	   ;; (print "Incremental get, offset=" (dboard:rundat-run-data-offset run-dat) " retrieved: " (length tmptests) " newval: " newval)
	   newval)))
     
    (for-each 
     (lambda (tdat)
       (let ((test-id (db:test-get-id tdat))
	     (state   (db:test-get-state tdat)))
	 (dboard:rundat-data-changed-set! run-dat #t)
	 (if (equal? state "DELETED")
	     (hash-table-delete! tests-ht test-id)
	     (hash-table-set! tests-ht test-id tdat))))
     tmptests)
    
    ;; set last-update to 0 if still getting data incrementally

    (if (> (dboard:rundat-run-data-offset run-dat) 0)
	(begin
	  ;; (print "run-data-offset: " (dboard:rundat-run-data-offset run-dat) ", setting last-update to 0")
	  ;; (dboard:rundat-last-update-set! run-dat 0)
          (dboard:rundat-last-update-set! run-dat 0))
        ;; (hash-table-set! (dboard:tabdat-run-update-times tabdat) run-id (- start-time 3))
        
	(dboard:rundat-last-update-set! run-dat (- (current-seconds) 2))) ;; go back two seconds in time to ensure all changes are captured.

    ;; (debug:print-info 0 *default-log-port* "tests-ht: " (hash-table-keys tests-ht))
    tests-ht))

;; tmptests   - new tests data
;; prev-tests - old tests data
;;
;; (define (dashboard:merge-changed-tests tabdat tests tmptests) ;;  use-new prev-tests) 
;;   (let* ((newdat     (filter







>
|
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|

|
|
|
|
|
<
|
>
|
|
|
|
|
>
>
>
|
>
|
|
|
|
|
|
|
|
|
<
<
|
|
|





|
>
>
|
>
>
>
>


>
>
>
>
>
>
>
>
|
>
|
<
<
|
<
<
|










<
<
<
<
<
<
<
<
<
<
<
<







513
514
515
516
517
518
519
520
521

522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548

549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569


570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598


599


600
601
602
603
604
605
606
607
608
609
610












611
612
613
614
615
616
617
;; This is roughly the same as dboard:get-tests-dat, should merge them if possible
;;
;; gets all the tests for run-id that match testnamepatt and key-vals, merges them
;;
;;    NOTE: Yes, this is used
;;
(define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals)
  (let* ((start-time   (current-seconds))
	 (access-mode  (dboard:tabdat-access-mode tabdat))

         (num-to-get   (let ((num-tests-from-config (configf:lookup *configdat* "setup" "num-tests-to-get")))
			 (if num-tests-from-config
			     (begin
			       (BB> "override num-tests 100 -> "num-tests-from-config)
			       (string->number num-tests-from-config))
			     100)))
	 (states       (hash-table-keys (dboard:tabdat-state-ignore-hash tabdat)))
	 (statuses     (hash-table-keys (dboard:tabdat-status-ignore-hash tabdat)))
         (do-not-use-db-file-timestamps #f) ;; (configf:lookup *configdat* "setup" "do-not-use-db-file-timestamps")) ;; this still hosts runs-summary-tab
         (do-not-use-query-timestamps   #f) ;; (configf:lookup *configdat* "setup" "do-not-use-query-timestamps")) ;; this no longer troubles runs-summary-tab
	 (sort-info    (get-curr-sort))
	 (sort-by      (vector-ref sort-info 1))
	 (sort-order   (vector-ref sort-info 2))
	 (bubble-type  (if (member sort-order '(testname))
			   'testname
			   'itempath))
	 ;; note: the rundat is normally created in "update-rundat". 
	 (run-dat      (or (hash-table-ref/default (dboard:tabdat-allruns-by-id tabdat) run-id #f)
			   (let ((rd (dboard:rundat-make-init run: run key-vals: key-vals)))
			     (hash-table-set! (dboard:tabdat-allruns-by-id tabdat) run-id rd)
			     rd)))
	 ;; (prev-tests  (dboard:rundat-tests prev-dat)) ;; (vector-ref prev-dat 1))
         (last-update  (if (or do-not-use-query-timestamps
			       (dboard:tabdat-filters-changed tabdat))
			   0
			   (dboard:rundat-last-update run-dat)))
	 (last-db-time (if do-not-use-db-file-timestamps

			   0
			   (dboard:rundat-last-db-time run-dat)))
	 (db-path      (or (dboard:rundat-db-path run-dat)
			   (let* ((db-dir (common:get-db-tmp-area))
				  (db-pth (conc db-dir "/megatest.db")))
			     (dboard:rundat-db-path-set! run-dat db-pth)
			     db-pth)))
	 (db-mod-time  (common:lazy-sqlite-db-modification-time db-path))
	 (db-modified  (>= db-mod-time last-db-time))
	 (multi-get    (> (dboard:rundat-run-data-offset run-dat) 0))  ;; multi-get in progress
	 (tmptests     (if (or do-not-use-db-file-timestamps
			       (dboard:tabdat-filters-changed tabdat)
			       db-modified)
			   (db:dispatch-query access-mode rmt:get-tests-for-run db:get-tests-for-run
					      run-id testnamepatt states statuses     ;; run-id testpatt states statuses
					      (dboard:rundat-run-data-offset run-dat) ;; query offset
					      num-to-get
					      (dboard:tabdat-hide-not-hide tabdat) ;; no-in
					      sort-by                              ;; sort-by
					      sort-order                           ;; sort-order
					      #f ;; 'shortlist                     ;; qrytype


					      last-update                          ;; last-update
					      *dashboard-mode*)                    ;; use dashboard mode
			   '()))
	 (use-new    (dboard:tabdat-hide-not-hide tabdat))
	 (tests-ht   (if (dboard:tabdat-filters-changed tabdat)
			 (let ((ht (make-hash-table)))
			   (dboard:rundat-tests-set! run-dat ht)
			   ht)
			 (dboard:rundat-tests run-dat)))
	 (got-all      (< (length tmptests) num-to-get))               ;; got all for this round  
	 )

    ;; if we saw the db modified, reset it (the signal has already been used)
    (if (and got-all ;; (not multi-get)
	     db-modified)
	(dboard:rundat-last-db-time-set!    run-dat (- start-time 2)))

    ;; to limit the amount of data transferred each cycle use limit of num-to-get and offset
    ;; DO NOT bump time indexes last-update and last-db-time until all the first pass of the
    ;; data has been read
    ;; set last-update to 0 if still getting data incrementally ;; NO NEED, handled above
    ;;
    (debug:print 0 *default-log-port* "got-all: " got-all " multi-get: " multi-get " num-to-get: " num-to-get " (length tmptests): " (length tmptests) " db-modified: " db-modified " db-mod-time: " db-mod-time " db-path: " db-path)
    (if got-all
	(begin
	  (dboard:rundat-last-update-set!     run-dat (- start-time 2))
	  (dboard:rundat-run-data-offset-set! run-dat 0))
	(begin
	  (dboard:rundat-run-data-offset-set! run-dat


					      (+ num-to-get (dboard:rundat-run-data-offset run-dat)))))



    (for-each 
     (lambda (tdat)
       (let ((test-id (db:test-get-id tdat))
	     (state   (db:test-get-state tdat)))
	 (dboard:rundat-data-changed-set! run-dat #t)
	 (if (equal? state "DELETED")
	     (hash-table-delete! tests-ht test-id)
	     (hash-table-set! tests-ht test-id tdat))))
     tmptests)
    












    tests-ht))

;; tmptests   - new tests data
;; prev-tests - old tests data
;;
;; (define (dashboard:merge-changed-tests tabdat tests tmptests) ;;  use-new prev-tests) 
;;   (let* ((newdat     (filter
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
  (dboard:tabdat-num-tests-set! tabdat (string->number
					(or (args:get-arg "-rows")
					    (get-environment-variable "DASHBOARDROWS")
					    "15"))))
  
(define *tim* (iup:timer))
(define *ord* #f)
(iup:attribute-set! *tim* "TIME" 300)
(iup:attribute-set! *tim* "RUN" "YES")

(define *last-recalc-ended-time* 0)

(define (dashboard:recalc modtime please-update-buttons last-db-update-time)
  (or please-update-buttons
      (and ;; (> (current-milliseconds)(+ *last-recalc-ended-time* 150)) ;; can't use this - it needs to be tab specific







|







2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
  (dboard:tabdat-num-tests-set! tabdat (string->number
					(or (args:get-arg "-rows")
					    (get-environment-variable "DASHBOARDROWS")
					    "15"))))
  
(define *tim* (iup:timer))
(define *ord* #f)
(iup:attribute-set! *tim* "TIME" 300 )
(iup:attribute-set! *tim* "RUN" "YES")

(define *last-recalc-ended-time* 0)

(define (dashboard:recalc modtime please-update-buttons last-db-update-time)
  (or please-update-buttons
      (and ;; (> (current-milliseconds)(+ *last-recalc-ended-time* 150)) ;; can't use this - it needs to be tab specific

Modified utils/homehost_check.sh from [f297bf7c02] to [a5c58a17c8].

1
2
3
4
5
6
7
8
#!/bin/sh

#exits 1 when current host is not homehost.

if [[ ! -e .homehost ]]; then
    exit 0
fi

|







1
2
3
4
5
6
7
8
#! /bin/bash

#exits 1 when current host is not homehost.

if [[ ! -e .homehost ]]; then
    exit 0
fi