Megatest

Check-in [4f62547bf4]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Partial and not-yet-working changes to accomodate the decoupled tests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60-decoupled-tests
Files: files | file ages | folders
SHA1: 4f62547bf446c3d4d7a81ce54d509f77003b8042
User & Date: mrwellan on 2015-08-13 15:03:53
Other Links: branch diff | manifest | tags
Context
2015-08-14
09:08
Added tests dir back check-in: ad3e213115 user: matt tags: v1.60-decoupled-tests
2015-08-13
15:03
Partial and not-yet-working changes to accomodate the decoupled tests check-in: 4f62547bf4 user: mrwellan tags: v1.60-decoupled-tests
2015-08-10
00:47
Added fossil check out of megatest_qa and few basic fixes related to that. check-in: 429aa8aab7 user: matt tags: v1.60-decoupled-tests
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified dashboard.scm from [f416e75668] to [59d78b5b19].

︙
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492






1493
1494
1495
1496
1497
1498
1499

1483
1484
1485
1486
1487
1488
1489



1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502








-
-
-
+
+
+
+
+
+









(define (dashboard:get-youngest-run-db-mod-time)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
     (current-seconds)) ;; something went wrong - just print an error and return current-seconds
   (apply max (map (lambda (filen)
		     (file-modification-time filen))
		   (glob (conc *dbdir* "/*.db"))))))
   (let ((dbfiles (map (lambda (filen)
			 (file-modification-time filen))
		       (glob (conc *dbdir* "/*.db")))))
     (if (not (null? dbfiles))
	 (apply max dbfiles)
	 9e99))))

(define (dashboard:run-update x)
  (let* ((modtime         (dashboard:get-youngest-run-db-mod-time)) ;; (file-modification-time *db-file-path*))
	 (monitor-modtime (if (file-exists? *monitor-db-path*)
			      (file-modification-time *monitor-db-path*)
			      -1))
	 (run-update-time (current-seconds))
︙

Modified launch.scm from [70124debcf] to [e076be1779].

︙
9
10
11
12
13
14
15
16
17


18
19
20
21
22
23
24

9
10
11
12
13
14
15


16
17
18
19
20
21
22
23
24








-
-
+
+








;;  PURPOSE.

;;======================================================================
;; launch a task - this runs on the originating host, tests themselves
;;
;;======================================================================

(use regex regex-case base64 sqlite3 srfi-18 directory-utils posix-extras z3 call-with-environment-variables
     pathname-expand)
(use regex regex-case base64 sqlite3 srfi-18 directory-utils posix-extras z3 call-with-environment-variables)
;;     pathname-expand)

(import (prefix base64 base64:))
(import (prefix sqlite3 sqlite3:))

(declare (unit launch))
(declare (uses common))
(declare (uses configf))
︙
721
722
723
724
725
726
727
728

729
730
731
732
733
734
735

721
722
723
724
725
726
727

728
729
730
731
732
733
734
735








-
+








				   ;; (rmt:sdb-qry 'getstr 
				   (db:test-get-rundir testinfo) ;; ) ;; )
				   #f)))
	  (hash-table-set! *toptest-paths* testname curr-test-path)
	  ;; NB// Was this for the test or for the parent in an iterated test?
	  (rmt:general-call 'test-set-rundir-shortdir run-id lnkpath 
			    (if (file-exists? lnkpath)
				(resolve-pathname (pathname-expand lnkpath))
				(resolve-pathname lnkpath)
				lnkpath)
			    testname "")
	  ;; (rmt:general-call 'test-set-rundir run-id lnkpath testname "") ;; toptest-path)
	  (if (or (not curr-test-path)
		  (not (directory-exists? toptest-path)))
	      (begin
		(debug:print-info 2 "Creating " toptest-path " and link " lnkpath)
︙
899
900
901
902
903
904
905
906

907
908
909

910
911
912
913

914
915
916
917
918
919
920

899
900
901
902
903
904
905

906
907
908

909
910
911
912

913
914
915
916
917
918
919
920








-
+


-
+



-
+








				      (list 'mt-bindir-path mt-bindir-path))))))))

    ;; clean out step records from previous run if they exist
    ;; (rmt:delete-test-step-records run-id test-id)
    (change-directory work-area) ;; so that log files from the launch process don't clutter the test dir
    (cond
     ((and launcher hosts) ;; must be using ssh hostname
      (set! fullcmd (append launcher (car hosts)(list remote-megatest test-sig "-execute" cmdparms) debug-param)))
      (set! fullcmd (append launcher (car hosts)(list remote-megatest "-m" test-sig "-execute" cmdparms) debug-param)))
     ;; (set! fullcmd (append launcher (car hosts)(list remote-megatest test-sig "-execute" cmdparms))))
     (launcher
      (set! fullcmd (append launcher (list remote-megatest test-sig "-execute" cmdparms) debug-param)))
      (set! fullcmd (append launcher (list remote-megatest "-m" test-sig "-execute" cmdparms) debug-param)))
     ;; (set! fullcmd (append launcher (list remote-megatest test-sig "-execute" cmdparms))))
     (else
      (if (not useshell)(debug:print 0 "WARNING: internal launching will not work well without \"useshell yes\" in your [jobtools] section"))
      (set! fullcmd (append (list remote-megatest test-sig "-execute" cmdparms) debug-param (list (if useshell "&" ""))))))
      (set! fullcmd (append (list remote-megatest "-m" test-sig "-execute" cmdparms) debug-param (list (if useshell "&" ""))))))
    ;; (set! fullcmd (list remote-megatest test-sig "-execute" cmdparms (if useshell "&" "")))))
    (if (args:get-arg "-xterm")(set! fullcmd (append fullcmd (list "-xterm"))))
    (debug:print 1 "Launching " work-area)
    ;; set pre-launch-env-vars before launching, keep the vars in prevvals and put the envionment back when done
    (debug:print 4 "fullcmd: " fullcmd)
    (let* ((commonprevvals (alist->env-vars
			    (hash-table-ref/default *configdat* "env-override" '())))
︙

Modified megatest-version.scm from [1b379765b4] to [84dff703f2]. 

1
2
3
4
5
6

7

1
2
3
4
5

6
7






-
+


;; Always use two or four digit decimal
;; 1.01, 1.02...1.10,1.11,1,1101 ... 1.99,2.00..

(declare (unit megatest-version))

(define megatest-version 1.6022)
(define megatest-version 1.6023)

Modified megatest.scm from [d15cff51eb] to [d76645c251].

︙
14
15
16
17
18
19
20
21

22
23
24
25
26
27
28

14
15
16
17
18
19
20

21
22
23
24
25
26
27
28








-
+









(define (toplevel-command . a) #f)

;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)

(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 readline apropos json http-client directory-utils rpc ;; (srfi 18) extras)
     http-client srfi-18 extras format pathname-expand posix-utils) ;;  zmq extras)
     http-client srfi-18 extras format posix-utils) ;;  pathname-expand zmq extras)

;; Added for csv stuff - will be removed
;;
(use sparse-vectors)

(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
︙

Modified runs.scm from [7c25a30cc6] to [d4c7e3371b]. 

1
2
3
4
5
6
7
8
9
10
11
12
13
14


15
16
17
18
19
20
21

1
2
3
4
5
6
7
8
9
10
11
12


13
14
15
16
17
18
19
20
21













-
-
+
+









;; Copyright 2006-2013, 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.

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking (srfi 18) posix-extras directory-utils
     pathname-expand)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking (srfi 18) posix-extras directory-utils)
;;     pathname-expand) ;; pathname-expand will be needed in switch to chicken 4.10

(import (prefix sqlite3 sqlite3:))

(declare (unit runs))
(declare (uses db))
(declare (uses common))
(declare (uses items))
︙
1710
1711
1712
1713
1714
1715
1716
1717

1718
1719
1720
1721
1722
1723
1724

1710
1711
1712
1713
1714
1715
1716

1717
1718
1719
1720
1721
1722
1723
1724








-
+








    ;; (sqlite3:finalize! (db:delay-if-busy tdbdat))
    )
  #t)

(define (runs:remove-test-directory test mode) ;; remove-data-only)
  (let* ((run-dir       (db:test-get-rundir test))    ;; run dir is from the link tree
	 (real-dir      (if (file-exists? run-dir)
			    (resolve-pathname (pathname-expand run-dir))
			    (resolve-pathname run-dir)
			    #f)))
    (case mode
      ((remove-data-only)(mt:test-set-state-status-by-id (db:test-get-run_id test)(db:test-get-id test) "CLEANING" "LOCKED" #f))
      ((remove-all)      (mt:test-set-state-status-by-id (db:test-get-run_id test)(db:test-get-id test) "REMOVING" "LOCKED" #f))
      ((archive-remove)  (mt:test-set-state-status-by-id (db:test-get-run_id test)(db:test-get-id test) "ARCHIVE_REMOVING" #f #f)))
    (debug:print-info 1 "Attempting to remove " (if real-dir (conc " dir " real-dir " and ") "") " link " run-dir)
    (if (and real-dir
︙

Added setup.sh version [c6aa571faa]. 



1

+

export PATH=$PWD/bin:$PATH

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