Megatest

Check-in [e9a528680b]
Login
Overview
Comment:Moved some functions into commonmod
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-newview
Files: files | file ages | folders
SHA1: e9a528680b234a33522c1b4f6d1719d95dda5b7e
User & Date: matt on 2020-04-12 23:10:16
Other Links: branch diff | manifest | tags
Context
2020-04-12
23:51
Added auto gen area name check-in: eeb358089d user: matt tags: v1.65-newview
23:10
Moved some functions into commonmod check-in: e9a528680b user: matt tags: v1.65-newview
2020-04-10
17:20
Cleaned up Makefile, streamlined deps and re-enabled commonmod check-in: caed2ecdc2 user: mrwellan tags: v1.65-newview
Changes

Modified Makefile from [2db8c6462b] to [e8873ade8c].

141
142
143
144
145
146
147
148

149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168

169
170
171
172
173
174
175
141
142
143
144
145
146
147

148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176







-
+




















+







	fossil wiki export java-script-lib > $(PREFIX)/share/js/jquery-3.1.0.slim.min.js

$(PREFIX)/share/db/mt-pg.sql : mt-pg.sql
	mkdir -p $(PREFIX)/share/db
	$(INSTALL) mt-pg.sql $(PREFIX)/share/db/mt-pg.sql

# Special dependencies for the includes
common.o : commonmod.o
common.o : mofiles/commonmod.o

tests.o db.o launch.o runs.o dashboard-tests.o				\
dashboard-context-menu.o dashboard-guimonitor.o dashboard-main.o	\
monitor.o dashboard.o archive.o megatest.o : db_records.scm

tests.o runs.o dashboard.o dashboard-tests.o dashboard-context-menu.o dashboard-main.o  : run_records.scm

db.o ezsteps.o keys.o launch.o megatest.o monitor.o runs-for-ref.o runs.o tests.o : key_records.scm

tests.o tasks.o dashboard-tasks.o : task_records.scm

runs.o : test_records.scm

megatest.o : megatest-fossil-hash.scm

rmt.scm client.scm common.scm configf.scm dashboard-guimonitor.scm dashboard-tests.scm dashboard.scm db.scm dcommon.scm ezsteps.scm fs-transport.scm http-transport.scm index-tree.scm items.scm keys.scm launch.scm megatest.scm monitor.scm mt.scm newdashboard.scm runconfig.scm runs.scm server.scm tdb.scm tests.scm tree.scm : common_records.scm

common_records.scm : altdb.scm

mofiles/stml2.o : mofiles/cookie.o
configf.o : mofiles/commonmod.o

vg.o dashboard.o : vg_records.scm

dcommon.o : run_records.scm

mofiles/stml2.o : mofiles/cookie.o

200
201
202
203
204
205
206
207
208





209
210
211
212
213
214
215
201
202
203
204
205
206
207


208
209
210
211
212
213
214
215
216
217
218
219







-
-
+
+
+
+
+







	csc $(CSCOPTS) -c $<

# specific rules for .o files that genuninely depend on mofiles/something
#
megatest.o : megatest.scm stml2.o mutils.o commonmod.o
	csc $(CSCOPTS) -c megatest.scm stml2.o mutils.o commonmod.o

common.o : megatest.scm commonmod.o
	csc $(CSCOPTS) -c common.scm commonmod.o
common.o : megatest.scm mofiles/commonmod.o common.scm
	csc $(CSCOPTS) -c common.scm mofiles/commonmod.o

configf.o : configf.scm mofiles/commonmod.o
	csc $(CSCOPTS) -c configf.scm mofiles/commonmod.o

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

340
341
342
343
344
345
346
347

348
349
350
351
352
353
354
344
345
346
347
348
349
350

351
352
353
354
355
356
357
358







-
+







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

clean : 
	rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS)		\
            $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut	\
            tcmt readline-fix.scm serialize-env dboard dboard.o		\
            megatest.o dashboard.o megatest-fossil-hash.* altdb.scm	\
            mofiles/*.o vg.o commonmod.o cookie.o dashboard-main.o	\
            mofiles/*.o vg.o cookie.o dashboard-main.o	\
            ducttape-lib.o ftail.o mutils.o pkts.o rmtmod.o stml2.o	\
            tcmt.o
	rm -rf share

#======================================================================
# Deploy section (not complete yet)
#======================================================================

Modified common.scm from [79eab84e44] to [2d53221a69].

24
25
26
27
28
29
30
31
32



33
34
35
36
37
38
39
24
25
26
27
28
29
30


31
32
33
34
35
36
37
38
39
40







-
-
+
+
+







     matchable regex posix (srfi 18) extras ;; tcp 
     (prefix nanomsg nmsg:)
     (prefix sqlite3 sqlite3:)
     (prefix dbi dbi:)
     )

(declare (unit common))
;; (declare (uses commonmod))
;; (import commonmod)
(declare (uses commonmod))
(import (prefix commonmod cmod:))

(import pkts)

(include "common_records.scm")


;; (require-library margs)
;; (include "margs.scm")
872
873
874
875
876
877
878
879
880
881
882

883
884
885
886
887
888
889
890
891
873
874
875
876
877
878
879




880


881
882
883
884
885
886
887







-
-
-
-
+
-
-







    (if val val default)))

(define (assoc/default key lst . default)
  (let ((res (assoc key lst)))
    (if res (cadr res)(if (null? default) #f (car default)))))

(define (common:get-testsuite-name)
  (or (configf:lookup *configdat* "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
      (configf:lookup *configdat* "setup" "testsuite" )
      (getenv "MT_TESTSUITE_NAME")
      (if (string? *toppath* )
  (cmod:get-testsuite-name *toppath* *configdat*))
          (pathname-file *toppath*)
          #f))) ;; (pathname-file (current-directory)))))

;; safe getting of toppath
(define (common:get-toppath areapath)
  (or *toppath*
      (if areapath
	  (begin
	    (set! *toppath* areapath)

Modified commonmod.scm from [d04b9ec825] to [79fa17743e].

19
20
21
22
23
24
25
26
27


28
29
30




















31
32
33
34
35
36
37
19
20
21
22
23
24
25


26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57







-
-
+
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







;;======================================================================

(declare (unit commonmod))

(module commonmod
	*
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
(import scheme chicken data-structures extras files)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69)

(define (just-testing)
  (print "JUST TESTING"))

(define (lookup cfgdat section var)
  (if (hash-table? cfgdat)
      (let ((sectdat (hash-table-ref/default cfgdat section '())))
	(if (null? sectdat)
	    #f
	    (let ((match (assoc var sectdat)))
	      (if match ;; (and match (list? match)(> (length match) 1))
		  (cadr match)
		  #f))
	    ))
      #f))

(define (get-testsuite-name toppath configdat)
  (or (lookup configdat "setup" "area-name")
      (lookup configdat "setup" "testsuite")
      (get-environment-variable "MT_TESTSUITE_NAME")
      (if (string? toppath)
          (pathname-file toppath)
          #f)))

;; (define (debug:print . params) #f)
;; (define (debug:print-info . params) #f)
;; 
;; (define (set-functions dbgp dbgpinfo)
;;   (set! debug:print dbgp)
;;   (set! debug:print-info dbgpinfo))

Modified configf.scm from [dfa800e4cf] to [5265dcb17d].

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

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29



30
31
32
33
34
35
36
1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39













-
+















+
+
+







;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;;     GNnU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

;;======================================================================
;; Config file handling
;;======================================================================

(use regex regex-case matchable) ;;  directory-utils)
(declare (unit configf))
(declare (uses process))
(declare (uses env))
(declare (uses keys))
(declare (uses commonmod))

(import (prefix commonmod cmod:))

(include "common_records.scm")

;; return list (path fullpath configname)
(define (find-config configname #!key (toppath #f))
  (if toppath
      (let ((cfname (conc toppath "/" configname)))
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525

526



527
528
529
530
531
532
533
500
501
502
503
504
505
506












507
508
509
510
511
512
513
514
515

516
517
518
519
520
521
522
523
524
525
526
527







-
-
-
-
-
-
-
-
-
-
-
-









-
+

+
+
+







    (if toppath (change-directory toppath)) 
    (if (and toppath pathenvvar)(setenv pathenvvar toppath))
    (let ((configdat  (if configfile 
			  (read-config configfile #f #t environ-patt: environ-patt post-section-procs: (list (cons "^fields$" set-fields)) #f))))
      (if toppath (change-directory curr-dir))
      (list configdat toppath configfile fname))))

(define (configf:lookup cfgdat section var)
  (if (hash-table? cfgdat)
      (let ((sectdat (hash-table-ref/default cfgdat section '())))
	(if (null? sectdat)
	    #f
	    (let ((match (assoc var sectdat)))
	      (if match ;; (and match (list? match)(> (length match) 1))
		  (cadr match)
		  #f))
	    ))
      #f))

;; use to have definitive setting:
;;  [foo]
;;  var yes
;;
;;  (configf:var-is? cfgdat "foo" "var" "yes") => #t
;;
(define (configf:var-is? cfgdat section var expected-val)
  (equal? (configf:lookup cfgdat section var) expected-val))

(define config-lookup configf:lookup)
;; (define config-lookup configf:lookup)
(define configf:read-file read-config)

(define (configf:lookup  cfgdat section var)
  (cmod:lookup cfgdat section var))

;; safely look up a value that is expected to be a number, return
;; a default (#f unless provided)
;;
(define (configf:lookup-number cfdat section varname #!key (default #f))
  (let* ((val (configf:lookup *configdat* section varname))
         (res (if val

Added dbmod.scm version [d04b9ec825].








































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
;;======================================================================
;; Copyright 2017, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit commonmod))

(module commonmod
	*
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)

(define (just-testing)
  (print "JUST TESTING"))

;; (define (debug:print . params) #f)
;; (define (debug:print-info . params) #f)
;; 
;; (define (set-functions dbgp dbgpinfo)
;;   (set! debug:print dbgp)
;;   (set! debug:print-info dbgpinfo))

)