Megatest

Check-in [5b8df5d5d2]
Login
Overview
Comment:Compiles
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-revolution-remodularization
Files: files | file ages | folders
SHA1: 5b8df5d5d2bb84b4afe89f625fd42a2ce33593b7
User & Date: matt on 2024-02-03 18:30:17
Other Links: branch diff | manifest | tags
Context
2024-02-03
19:48
server and repl now work check-in: d5a5af944d user: matt tags: v1.80-revolution-remodularization
18:30
Compiles check-in: 5b8df5d5d2 user: matt tags: v1.80-revolution-remodularization
17:53
wip check-in: a6f9565756 user: matt tags: v1.80-revolution-remodularization
Changes

Modified Makefile from [6a96adb19b] to [f3f38cddee].

30
31
32
33
34
35
36
37


38
39
40
41
42
43
44
45
46
47
48
49
50
51
INSTALL=install
SRCFILES = common.scm items.scm launch.scm ods.scm runconfig.scm	\
           server.scm configf.scm db.scm keys.scm		\
           process.scm runs.scm tasks.scm tests.scm genexample.scm	\
           tdb.scm mt.scm	\
           ezsteps.scm rmt.scm api.scm		\
           subrun.scm archive.scm env.scm		\
           diff-report.scm cgisetup/models/pgdb.scm



# module source files
MSRCFILES = dbfile.scm debugprint.scm mtargs.scm commonmod.scm dbmod.scm \
            tcp-transportmod.scm rmtmod.scm portlogger.scm apimod.scm \
	    configfmod.scm processmod.scm servermod.scm megatestmod.scm \
	    stml2.scm fsmod.scm cpumod.scm mtmod.scm odsmod.scm tasksmod.scm \
            pkts.scm testsmod.scm

transport-mode.scm : transport-mode.scm.template
	cp transport-mode.scm.template transport-mode.scm

dashboard-transport-mode.scm : dashboard-transport-mode.scm.template
	cp dashboard-transport-mode.scm.template dashboard-transport-mode.scm








|
>
>






|







30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
INSTALL=install
SRCFILES = common.scm items.scm launch.scm ods.scm runconfig.scm	\
           server.scm configf.scm db.scm keys.scm		\
           process.scm runs.scm tasks.scm tests.scm genexample.scm	\
           tdb.scm mt.scm	\
           ezsteps.scm rmt.scm api.scm		\
           subrun.scm archive.scm env.scm		\
           diff-report.scm

# cgisetup/models/pgdb.scm

# module source files
MSRCFILES = dbfile.scm debugprint.scm mtargs.scm commonmod.scm dbmod.scm \
            tcp-transportmod.scm rmtmod.scm portlogger.scm apimod.scm \
	    configfmod.scm processmod.scm servermod.scm megatestmod.scm \
	    stml2.scm fsmod.scm cpumod.scm mtmod.scm odsmod.scm tasksmod.scm \
            pkts.scm testsmod.scm pgdb.scm

transport-mode.scm : transport-mode.scm.template
	cp transport-mode.scm.template transport-mode.scm

dashboard-transport-mode.scm : dashboard-transport-mode.scm.template
	cp dashboard-transport-mode.scm.template dashboard-transport-mode.scm

72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
mofiles/commonmod.o : mofiles/debugprint.o mofiles/stml2.o
configf.o : commonmod.import.o
mofiles/dbfile.o : mofiles/debugprint.o
mofiles/rmtmod.o mofiles/dbmod.o : mofiles/dbfile.o mofiles/commonmod.o mofiles/debugprint.o
db.o : mofiles/dbmod.o mofiles/dbfile.o
mofiles/debugprint.o : mofiles/mtargs.o
mofiles/tcp-transportmod.o : mofiles/portlogger.o
mofiles/tasksmod.o : mofiles/rmtmod.o

# ftail.scm rmtmod.scm commonmod.scm removed
# MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm	\
#             mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm	\
#             rmtmod.scm apimod.scm

GUISRCF = dashboard-context-menu.scm dashboard-tests.scm		\







|







74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
mofiles/commonmod.o : mofiles/debugprint.o mofiles/stml2.o
configf.o : commonmod.import.o
mofiles/dbfile.o : mofiles/debugprint.o
mofiles/rmtmod.o mofiles/dbmod.o : mofiles/dbfile.o mofiles/commonmod.o mofiles/debugprint.o
db.o : mofiles/dbmod.o mofiles/dbfile.o
mofiles/debugprint.o : mofiles/mtargs.o
mofiles/tcp-transportmod.o : mofiles/portlogger.o
mofiles/tasksmod.o : mofiles/rmtmod.o mofiles/pgdb.o

# ftail.scm rmtmod.scm commonmod.scm removed
# MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm	\
#             mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm	\
#             rmtmod.scm apimod.scm

GUISRCF = dashboard-context-menu.scm dashboard-tests.scm		\

Modified cgisetup/models/pgdb.scm from [2ad595b83f] to [d5efcde6bc].

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
40
41
42
43
44
;; 
;;     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 pgdb))
(declare (uses configf))
(declare (uses mtargs))


;; I don't know how to mix compilation units and modules, so no module here.
;;
;; (module pgdb

;;     (
;;      open-pgdb
;;      )
;; 
;; (import scheme)
;; (import data-structures)
;; (import chicken)

(use typed-records (prefix dbi dbi:))




(import (prefix mtargs args:))




;; given a configdat lookup the connection info and open the db
;;
(define (pgdb:open configdat #!key (dbname #f)(dbispec #f))  
  (let ((pgconf (or dbispec
		    (args:get-arg "-pgsync")
		    (if configdat







|

>



|
>
|
<
<
<
|
|
|

|
>
>
>
>
|
>
>
>







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
40
41
42
43
44
45
46
47
48
49
50
;; 
;;     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 pgdb))
(declare (uses configfmod))
(declare (uses mtargs))
(declare (uses debugprint))

;; I don't know how to mix compilation units and modules, so no module here.
;;
(module pgdb
    *




(import scheme)
(import data-structures)
(import chicken)

(use typed-records
     (prefix dbi dbi:)
     srfi-69
     srfi-1
     )
(import (prefix mtargs args:)
	debugprint
	configfmod
	)

;; given a configdat lookup the connection info and open the db
;;
(define (pgdb:open configdat #!key (dbname #f)(dbispec #f))  
  (let ((pgconf (or dbispec
		    (args:get-arg "-pgsync")
		    (if configdat
652
653
654
655
656
657
658

             (lst `()))
                       (cond
                        ((> i tab2-pages )
                        lst) 
                      (else 
		  	(loop (+ i 1) (append   lst (list i)))))))









>
658
659
660
661
662
663
664
665
             (lst `()))
                       (cond
                        ((> i tab2-pages )
                        lst) 
                      (else 
		  	(loop (+ i 1) (append   lst (list i)))))))

)

Modified megatestmod.scm from [9862464d20] to [cfcf5706ce].

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
(declare (uses dbfile))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses processmod))
(declare (uses mtmod))
(declare (uses pkts))
(declare (uses servermod))
(declare (uses dbi))

(use srfi-69)

(module megatestmod
	*

(import scheme)







<







31
32
33
34
35
36
37

38
39
40
41
42
43
44
(declare (uses dbfile))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses processmod))
(declare (uses mtmod))
(declare (uses pkts))
(declare (uses servermod))


(use srfi-69)

(module megatestmod
	*

(import scheme)

Modified odsmod.scm from [015e413cc7] to [9072959ec4].

13
14
15
16
17
18
19
20
21
22


23
24
25
26
27

















28
29
30
31
32
33
34
;;     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/>.
;;

(use csv-xml regex)
(declare (unit ods))
(declare (uses common))
(declare (uses commonmod))


(import commonmod)

(module odsmod
	*
	

















(define ods:dirs
  '("Configurations2"
    "Configurations2/toolpanel"
    "Configurations2/menubar"
    "Configurations2/toolbar"
    "Configurations2/progressbar"
    "Configurations2/floater"







|


>
>
|




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







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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
;;     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/>.
;;

(use csv-xml regex)
(declare (unit odsmod))
(declare (uses common))
(declare (uses commonmod))
(declare (uses debugprint))
(declare (uses dbfile))
(declare (uses dbmod))

(module odsmod
	*
	
(import scheme
	chicken
	data-structures
	extras
	posix
	ports
	regex
	srfi-1
	srfi-13
	(prefix sqlite3 sqlite3:)
	
	commonmod
	debugprint
	dbfile
	dbmod
	)

(define ods:dirs
  '("Configurations2"
    "Configurations2/toolpanel"
    "Configurations2/menubar"
    "Configurations2/toolbar"
    "Configurations2/progressbar"
    "Configurations2/floater"

Added pgdb.scm version [9904f1a9ea].















































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
;;======================================================================
;; Copyright 2019, 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 pgdb))

(include "cgisetup/models/pgdb.scm")

Modified tasksmod.scm from [ba207adbea] to [2e8f6ca8e7].

28
29
30
31
32
33
34





35
36
37
38
39
40
41
(declare (uses debugprint))
(declare (uses mtargs))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses dbfile))
(declare (uses dbmod))
(declare (uses rmtmod))






(use srfi-69)

(module tasksmod
	*

(import scheme)







>
>
>
>
>







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
(declare (uses debugprint))
(declare (uses mtargs))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses dbfile))
(declare (uses dbmod))
(declare (uses rmtmod))
(declare (uses servermod))
(declare (uses processmod))
(declare (uses pgdb))
(declare (uses mtmod))
(declare (uses megatestmod))

(use srfi-69)

(module tasksmod
	*

(import scheme)
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
	  regex-case
	  sparse-vectors
	  
	  )
  (use srfi-69))
 (chicken-5
  (import (prefix sqlite3 sqlite3:)
	  ;; data-structures
	  ;; extras
	  ;; files
	  ;; posix
	  ;; posix-extras
	  chicken.base
	  chicken.condition
	  chicken.file
	  chicken.file.posix
	  chicken.io
	  chicken.pathname
	  chicken.port







<
<
<
<
<







60
61
62
63
64
65
66





67
68
69
70
71
72
73
	  regex-case
	  sparse-vectors
	  
	  )
  (use srfi-69))
 (chicken-5
  (import (prefix sqlite3 sqlite3:)





	  chicken.base
	  chicken.condition
	  chicken.file
	  chicken.file.posix
	  chicken.io
	  chicken.pathname
	  chicken.port
96
97
98
99
100
101
102

103
104
105
106
107
108
109
110





111
112
113
114
115
116
117
	srfi-69
	typed-records
	(prefix base64 base64:)
	(prefix sqlite3 sqlite3:)
	md5
	message-digest
	z3

	
	debugprint
	commonmod
	configfmod
	(prefix mtargs args:)
	dbmod
	dbfile
	rmtmod





	)

(include "task_records.scm")
(include "db_records.scm")

;;======================================================================
;; Tasks db







>








>
>
>
>
>







96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
	srfi-69
	typed-records
	(prefix base64 base64:)
	(prefix sqlite3 sqlite3:)
	md5
	message-digest
	z3
	directory-utils
	
	debugprint
	commonmod
	configfmod
	(prefix mtargs args:)
	dbmod
	dbfile
	rmtmod
	servermod
	processmod
	pgdb
	mtmod
	megatestmod
	)

(include "task_records.scm")
(include "db_records.scm")

;;======================================================================
;; Tasks db
1414
1415
1416
1417
1418
1419
1420

















1421
1422
1423
1424
1425
1426
1427
				    (if (null? tal)
					#t
					(loop (car tal)(cdr tal)))
				    #f))))))
	    (pop-directory)
	    result)))))



















;; if .testconfig exists in test directory read and return it
;; else if have cached copy in *testconfigs* return it IFF there is a section "have fulldata"
;; else read the testconfig file
;;   if have path to test directory save the config as .testconfig and return it
;;
(define (tests:get-testconfig test-name item-path test-registry system-allowed #!key (force-create #f)(allow-write-cache #t)(wait-a-minute #f))







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







1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
				    (if (null? tal)
					#t
					(loop (car tal)(cdr tal)))
				    #f))))))
	    (pop-directory)
	    result)))))


(define (tests:get-test-path-from-environment)
  (if (and (getenv "MT_LINKTREE")
	   (getenv "MT_TARGET")
	   (getenv "MT_RUNNAME")
	   (getenv "MT_TEST_NAME")
	   (getenv "MT_ITEMPATH"))
      (conc (getenv "MT_LINKTREE")  "/"
	    (getenv "MT_TARGET")    "/"
	    (getenv "MT_RUNNAME")   "/"
	    (getenv "MT_TEST_NAME")
	    (if (and (getenv "MT_ITEMPATH")
                     (not (string=? "" (getenv "MT_ITEMPATH"))))
		(conc "/" (getenv "MT_ITEMPATH"))
                ""))
      #f))


;; if .testconfig exists in test directory read and return it
;; else if have cached copy in *testconfigs* return it IFF there is a section "have fulldata"
;; else read the testconfig file
;;   if have path to test directory save the config as .testconfig and return it
;;
(define (tests:get-testconfig test-name item-path test-registry system-allowed #!key (force-create #f)(allow-write-cache #t)(wait-a-minute #f))

Modified tests.scm from [866c24247d] to [30699547ce].

1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
;;     (set! tests (filter (lambda (test)(common:file-exists? (conc test "/testconfig"))) tests))
;;     (delete-duplicates
;;      (filter (lambda (testname)
;; 	       (tests:match test-patts testname #f))
;; 	     (map (lambda (testp)
;; 		    (last (string-split testp "/")))
;; 		  tests)))))

(define (tests:get-test-path-from-environment)
  (if (and (getenv "MT_LINKTREE")
	   (getenv "MT_TARGET")
	   (getenv "MT_RUNNAME")
	   (getenv "MT_TEST_NAME")
	   (getenv "MT_ITEMPATH"))
      (conc (getenv "MT_LINKTREE")  "/"
	    (getenv "MT_TARGET")    "/"
	    (getenv "MT_RUNNAME")   "/"
	    (getenv "MT_TEST_NAME")
	    (if (and (getenv "MT_ITEMPATH")
                     (not (string=? "" (getenv "MT_ITEMPATH"))))
		(conc "/" (getenv "MT_ITEMPATH"))
                ""))
      #f))

;; sort tests by priority and waiton
;; Move test specific stuff to a test unit FIXME one of these days
(define (tests:sort-by-priority-and-waiton test-records)
  (if (eq? (hash-table-size test-records) 0)
      '()
      (let* ((mungepriority (lambda (priority)
			      (if priority







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







1068
1069
1070
1071
1072
1073
1074

















1075
1076
1077
1078
1079
1080
1081
;;     (set! tests (filter (lambda (test)(common:file-exists? (conc test "/testconfig"))) tests))
;;     (delete-duplicates
;;      (filter (lambda (testname)
;; 	       (tests:match test-patts testname #f))
;; 	     (map (lambda (testp)
;; 		    (last (string-split testp "/")))
;; 		  tests)))))

















;; sort tests by priority and waiton
;; Move test specific stuff to a test unit FIXME one of these days
(define (tests:sort-by-priority-and-waiton test-records)
  (if (eq? (hash-table-size test-records) 0)
      '()
      (let* ((mungepriority (lambda (priority)
			      (if priority