Megatest

Check-in [82da6b65d8]
Login
Overview
Comment:Added db stuff into mtserver
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-multi-db
Files: files | file ages | folders
SHA1: 82da6b65d8f801579b16415c2d2bc937694dbabd
User & Date: matt on 2019-02-03 20:18:20
Other Links: branch diff | manifest | tags
Context
2019-02-03
20:46
Ripped db.scm to shreds, converted to module. check-in: 439caadb72 user: matt tags: v1.65-multi-db
20:18
Added db stuff into mtserver check-in: 82da6b65d8 user: matt tags: v1.65-multi-db
19:47
Tore it all apart. Can Humpty be put back together again? check-in: e660d445be user: matt tags: v1.65-multi-db
Changes

Modified Makefile from [c1d66ee0fa] to [171a28d49f].

31
32
33
34
35
36
37
38

39
40
41
42
43
44
45
31
32
33
34
35
36
37

38
39
40
41
42
43
44
45







-
+







   rmt.scm api.scm subrun.scm \
   archive.scm env.scm diff-report.scm cgisetup/models/pgdb.scm 

# module source files
MSRCFILES = ftail.scm portlogger.scm nmsg-transport.scm

# files needed for mtserve
MTSERVEFILES = common.scm megatest-version.scm margs.scm
MTSERVEFILES = common.scm megatest-version.scm margs.scm server.scm db.scm keys.scm ods.scm

# 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

70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
70
71
72
73
74
75
76

77
78
79
80
81
82
83







-







# BASH_MACHTYPE=$(shell bash -c "echo \$$MACHTYPE")
# ARCHSTR=$(BASH_MACHTYPE)_$(shell lsb_release -sr)
ARCHSTR=$(shell if [[ -e /usr/bin/sw_vers ]]; then /usr/bin/sw_vers -productVersion; else lsb_release -sr; fi)
# ARCHSTR=$(shell bash -c "echo \$$MACHTYPE")

PNGFILES = $(shell cd docs/manual;ls *png)

#all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut ndboard
all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut mtserve

mtest: $(OFILES) readline-fix.scm megatest.o $(MOFILES)
	csc $(CSCOPTS) $(OFILES) $(MOFILES) megatest.o -o mtest

mtserve: $(MTSERVEOFILES) readline-fix.scm mtserve.o $(MOFILES)
	csc $(CSCOPTS) $(MTSERVEOFILES) $(MOFILES) mtserve.o -o mtserve
192
193
194
195
196
197
198




199
200
201
202
203
204
205
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208







+
+
+
+







	chmod a+x $(PREFIX)/bin/megatest

$(PREFIX)/bin/.$(ARCHSTR)/mtserve : mtserve utils/mk_wrapper
	@echo Installing to PREFIX=$(PREFIX)
	$(INSTALL) mtserve $(PREFIX)/bin/.$(ARCHSTR)/mtserve
	utils/mk_wrapper $(PREFIX) mtserve $(PREFIX)/bin/mtserver
	chmod a+x $(PREFIX)/bin/mtserver

$(PREFIX)/bin/mtserver : $(PREFIX)/bin/.$(ARCHSTR)/mtserve utils/mk_wrapper
	utils/mk_wrapper $(PREFIX) mtserve $(PREFIX)/bin/mtserver
	chmod a+x $(PREFIX)/bin/mtserver

$(PREFIX)/bin/.$(ARCHSTR)/ndboard : ndboard
	$(INSTALL) ndboard $(PREFIX)/bin/.$(ARCHSTR)/ndboard

$(PREFIX)/bin/newdashboard : $(PREFIX)/bin/.$(ARCHSTR)/ndboard utils/mk_wrapper
	utils/mk_wrapper $(PREFIX) ndboard $(PREFIX)/bin/newdashboard
	chmod a+x $(PREFIX)/bin/newdashboard
297
298
299
300
301
302
303
304

305
306
307
308
309
310
311
300
301
302
303
304
305
306

307
308
309
310
311
312
313
314







-
+







$(PREFIX)/bin/.$(ARCHSTR)/dboard : dboard $(FILES) utils/mk_wrapper
	utils/mk_wrapper $(PREFIX) dboard $(PREFIX)/bin/dashboard
	chmod a+x $(PREFIX)/bin/dashboard
	$(INSTALL) dboard $(PREFIX)/bin/.$(ARCHSTR)/dboard

install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \
          $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \
          $(PREFIX)/bin/serialize-env \
          $(PREFIX)/bin/serialize-env $(PREFIX)/bin/mtserver \
	  $(PREFIX)/bin/nbfind $(PREFIX)/bin/loadrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \
	  $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun \
	  $(PREFIX)/share/docs/megatest_manual.html $(PREFIX)/bin/remrun $(PREFIX)/bin/mtutil \
	  $(PREFIX)/bin/tcmt $(PREFIX)/share/db/mt-pg.sql \
          $(PREFIX)/share/js/jquery-3.1.0.slim.min.js 
#         $(PREFIX)/bin/.$(ARCHSTR)/ndboard

Modified db.scm from [bf6ebf1f66] to [deea30d44d].

29
30
31
32
33
34
35
36
37


38
39
40
41
42
43
44
29
30
31
32
33
34
35


36
37
38
39
40
41
42
43
44







-
-
+
+







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

(declare (unit db))
(declare (uses common))
(declare (uses keys))
(declare (uses ods))
(declare (uses client))
(declare (uses mt))
;; (declare (uses client))
;; (declare (uses mt))

(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")

(define *rundb-mutex* (make-mutex)) ;; prevent problems opening/closing rundb's
2667
2668
2669
2670
2671
2672
2673
2674

2675
2676

2677
2678
2679
2680
2681
2682
2683
2667
2668
2669
2670
2671
2672
2673

2674
2675

2676
2677
2678
2679
2680
2681
2682
2683







-
+

-
+







  (let* ((keyvals (db:get-key-vals dbstruct run-id))
	 (thekey  (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")))
    thekey))

;; Get run-ids for runs with same target but different runnames and NOT run-id
;;
(define (db:get-prev-run-ids dbstruct run-id)
  (let* ((keyvals (rmt:get-key-val-pairs run-id))
  (let* ((keyvals (db:get-key-val-pairs run-id))
	 (kvalues (map cadr keyvals))
	 (keys    (rmt:get-keys))
	 (keys    (db:get-keys))
	 (qrystr  (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND ")))
    (let ((prev-run-ids '()))
      (if (null? keyvals)
          '()
          (begin
            (db:with-db dbstruct #f #f ;; #f means work with the zeroth db - i.e. the runs db
                        (lambda (db)
2905
2906
2907
2908
2909
2910
2911
2912


2913
2914
2915
2916
2917
2918
2919
2905
2906
2907
2908
2909
2910
2911

2912
2913
2914
2915
2916
2917
2918
2919
2920







-
+
+







	    (sqlite3:execute db qry
			     (or newstate  currstate "NOT_STARTED")
			     (or newstatus currstate "UNKNOWN")
			     run-id testname)))
	 (if test-id
	     (begin
	       (set! test-ids (cons test-id test-ids))
	       (mt:process-triggers dbstruct run-id test-id newstate newstatus)))))
	       #;(mt:process-triggers dbstruct run-id test-id newstate newstatus) ;; WARNING: trigger processing used to happen here!
	       ))))
     testnames)
    test-ids))

;; ;; speed up for common cases with a little logic
;; ;; NB// Ultimately this will be deprecated in deference to mt:test-set-state-status-by-id
;;
;;      NOTE: run-id is not used
2932
2933
2934
2935
2936
2937
2938
2939


2940
2941
2942
2943
2944
2945
2946
2933
2934
2935
2936
2937
2938
2939

2940
2941
2942
2943
2944
2945
2946
2947
2948







-
+
+







      ((and newstate newstatus)
       (sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id))
      (else
       (if newstate   (sqlite3:execute db "UPDATE tests SET state=?   WHERE id=?;" newstate   test-id))
       (if newstatus  (sqlite3:execute db "UPDATE tests SET status=?  WHERE id=?;" newstatus  test-id))
       (if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment ;; (sdb:qry 'getid newcomment)
				       test-id))))))
  (mt:process-triggers dbstruct run-id test-id newstate newstatus))
  #;(mt:process-triggers dbstruct run-id test-id newstate newstatus) ;; WARNING: Trigger processing used to happen here!
  )

;; NEW BEHAVIOR: Count tests running in all runs!
;;
(define (db:get-count-tests-running dbstruct run-id)
  (db:with-db
   dbstruct
   run-id