Megatest

Check-in [429aa8aab7]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Added fossil check out of megatest_qa and few basic fixes related to that.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60-decoupled-tests
Files: files | file ages | folders
SHA1: 429aa8aab72375eb1e7eeea2c71df816bc167e29
User & Date: matt on 2015-08-10 00:47:05
Other Links: branch diff | manifest | tags
Context
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
2015-08-09
21:28
Removed tests dir. Now tests will come from https://www.kiatoa.com/fossils/megatest_qa check-in: 54b2beab6d user: matt tags: v1.60-decoupled-tests
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified Makefile from [1d989205bc] to [859a85db61]. 

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

14
15
16
17
18
19
20

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21














+








# make install CSCOPTS='-accumulate-profile -profile-name $(PWD)/profile-ww$(shell date +%V.%u)'
PREFIX=$(PWD)
CSCOPTS= 
INSTALL=install
SRCFILES = common.scm items.scm launch.scm \
           ods.scm runconfig.scm server.scm configf.scm \
           db.scm keys.scm margs.scm megatest-version.scm \
           process.scm runs.scm tasks.scm tests.scm genexample.scm \
	   http-transport.scm nmsg-transport.scm filedb.scm \
           client.scm gutils.scm synchash.scm daemon.scm mt.scm dcommon.scm \
	   tree.scm ezsteps.scm lock-queue.scm sdb.scm \
	   rmt.scm api.scm tdb.scm rpc-transport.scm \
	   portlogger.scm archive.scm
MTQA_FOSSIL=$(HOME)/fossils/megatest_qa.fossil

# Eggs to install (straightforward ones)
EGGS=matchable readline apropos base64 regex-literals format regex-case test coops trace csv \
     dot-locking posix-utils posix-extras directory-utils hostinfo tcp-server rpc csv-xml fmt \
     json md5 awful http-client spiffy uri-common intarweb spiffy-request-vars \
     spiffy-directory-listing ssax sxml-serializer sxml-modifications iup canvas-draw sqlite3
︙
151
152
153
154
155
156
157
158

159
160







161
162
163
164
165
166
167

152
153
154
155
156
157
158

159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175








-
+


+
+
+
+
+
+
+








          $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \
	  $(PREFIX)/bin/nbfind $(PREFIX)/bin/loadrunner $(PREFIX)/bin/mt_xterm \
          $(PREFIX)/bin/newdashboard $(PREFIX)/bin/mdboard

$(PREFIX)/bin/.$(ARCHSTR) : 
	mkdir -p $(PREFIX)/bin/.$(ARCHSTR)

test: tests/tests.scm
test: tests/tests.scm tests/.fslckout
	cd tests;csi -I .. -b -n tests.scm

tests/.fslckout tests/tests.scm : $(MTQA_FOSSIL)
	mkdir -p tests
	cd tests;fossil open --nested $(MTQA_FOSSIL)

$(MTQA_FOSSIL) :
	fossil clone https://www.kiatoa.com/fossils/megatest_qa $(MTQA_FOSSIL)

clean : 
	rm -f $(OFILES) $(GOFILES) megatest dboard dboard.o megatest.o dashboard.o

# Deploy section (not complete yet)
#
$(DEPLOYHELPERS) : utils/mt_*
	$(INSTALL) $< $@
︙

Modified dashboard-tests.scm from [981b21b733] to [3a23979a77].

︙
460
461
462
463
464
465
466

467


468
469
470
471
472
473
474

460
461
462
463
464
465
466
467

468
469
470
471
472
473
474
475
476








+
-
+
+








						  (conc "-e " (get-environment-variable "SHELL"))
						  "")))
				   (system (conc "cd " rundir 
						 ";mt_xterm -T \"" (string-translate testfullname "()" "  ") "\" " shell "&")))
				 (message-window  (conc "Directory " rundir " not found")))))
	       (widgets    (make-hash-table))
	       (refreshdat (lambda ()
			     (let* ((curr-mod-time (if (file-exists? db-path)
			     (let* ((curr-mod-time (file-modification-time db-path))
						       (file-modification-time db-path)
						       0))
				                   ;;     (max ..... (if (file-exists? testdat-path)
						   ;;      	      (file-modification-time testdat-path)
						   ;;      	      (begin
						   ;;      		(set! testdat-path (conc rundir "/testdat.db"))
						   ;;      		0))))
				    (need-update   (or (and (>= curr-mod-time db-mod-time)
							    (> (current-milliseconds)(+ last-update 250))) ;; every half seconds if db touched
︙

Modified launch.scm from [4c4762ce07] to [70124debcf].

︙
9
10
11
12
13
14
15
16


17
18
19
20
21
22
23

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)
(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))
︙
720
721
722
723
724
725
726
727

728
729
730
731
732
733
734

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 lnkpath)
				(resolve-pathname (pathname-expand 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)
︙

Deleted megatest-fossil-hash.new version [fb4a931212]. 

1



-

(define megatest-fossil-hash "f207341131c2bfc09d36174b5a83e4963e93148a")

Modified megatest.scm from [6d1c1e566e] to [d15cff51eb].

︙
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) ;;  zmq extras)
     http-client srfi-18 extras format pathname-expand posix-utils) ;;  zmq extras)

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

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

Deleted multi-dboard version [cc4c535999].

cannot compute difference between binary files

Deleted ndboard version [c6b247007b].

cannot compute difference between binary files

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

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



14
15
16
17
18
19
20

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

13
14
15
16
17
18
19
20
21
22













-
+
+
+









;; 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)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking (srfi 18) posix-extras directory-utils
     pathname-expand)

(import (prefix sqlite3 sqlite3:))

(declare (unit runs))
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
︙
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466












467
468
469
470
471
472
473

451
452
453
454
455
456
457











458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476








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








    ;; NOTE: these are all parent tests, items are not expanded yet.
    (debug:print-info 4 "test-records=" (hash-table->alist test-records))
    (let ((reglen (configf:lookup *configdat* "setup" "runqueue")))
      (if (> (length (hash-table-keys test-records)) 0)
	  (let* ((keep-going        #t)
		 (run-queue-retries 5)
		 (th1        (make-thread (lambda ()
					    (handle-exceptions
					     exn
					     (begin
					       (print-call-chain (current-error-port))
					       (debug:print 0 "ERROR: failure in runs:run-tests-queue thread, error: " ((condition-property-accessor 'exn 'message) exn))
					       (if (> run-queue-retries 0)
						   (begin
						     (set! run-queue-retries (- run-queue-retries 1))
						     (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests (any->number reglen) all-tests-registry))))
					     (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests (any->number reglen) all-tests-registry)))
					  "runs:run-tests-queue"))
				(handle-exceptions
				 exn
				 (begin
				   (print-call-chain (current-error-port))
				   (debug:print 0 "ERROR: failure in runs:run-tests-queue thread, error: " ((condition-property-accessor 'exn 'message) exn))
				   (debug:print 0 " exn=" (condition->list exn))
				   (if (> run-queue-retries 0)
				       (begin
					 (set! run-queue-retries (- run-queue-retries 1))
					 (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests (any->number reglen) all-tests-registry))))
				 (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests (any->number reglen) all-tests-registry))
				"runs:run-tests-queue")))
		 (th2        (make-thread (lambda ()				    
					    ;; (rmt:find-and-mark-incomplete-all-runs))))) CAN'T INTERRUPT IT ...
					    (let ((run-ids (rmt:get-all-run-ids)))
					      (for-each (lambda (run-id)
							  (if keep-going
							      (handle-exceptions
							       exn
︙
1707
1708
1709
1710
1711
1712
1713
1714

1715
1716
1717
1718
1719
1720
1721

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 run-dir)
			    (resolve-pathname (pathname-expand 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
︙

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