Megatest

Check-in [5cb7bf9076]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:configf ext-tests fixed.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80
Files: files | file ages | folders
SHA1: 5cb7bf90769e614860bbb67b3242cc21b4f95599
User & Date: matt on 2023-02-23 08:46:55
Other Links: branch diff | manifest | tags
Context
2023-02-23
11:53
Fixed get-target check-in: 78fc9c5443 user: matt tags: v1.80
08:46
configf ext-tests fixed. check-in: 5cb7bf9076 user: matt tags: v1.80
06:04
rmt:get-key-val-pairs was using wrong db. check-in: 335653cb5f user: matt tags: v1.80
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified Makefile from [7b082d9b05] to [36df27952a].

︙
42
43
44
45
46
47
48

49
50
51
52
53
54
55

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56








+








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

megatest.scm : transport-mode.scm
dashboard.scm : dashboard-transport-mode.scm

# dbmod.import.o is just a hack here
mofiles/dbfile.o     : mofiles/debugprint.o mofiles/commonmod.o dbmod.import.o
configf.o : commonmod.import.o
db.o : dbmod.import.o
mofiles/debugprint.o : mofiles/mtargs.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
︙
104
105
106
107
108
109
110
111
112


113
114
115
116
117
118
119

105
106
107
108
109
110
111


112
113
114
115
116
117
118
119
120








-
-
+
+









showmtesthash:
	@echo $(MTESTHASH)

dboard : $(OFILES) $(GOFILES) dashboard.scm $(MOFILES) $(MOIMPFILES) megatest-version.scm megatest-fossil-hash.scm
	csc $(CSCOPTS) $(OFILES) dashboard.scm $(GOFILES) $(MOFILES) $(MOIMPFILES) -o dboard

mtut: $(OFILES) $(MOFILES) megatest-fossil-hash.scm mtut.scm megatest-version.scm
	csc $(CSCOPTS) $(OFILES) $(MOFILES) mtut.scm -o mtut
mtut: $(OFILES) $(MOFILES) $(MOIMPFILES) megatest-fossil-hash.scm mtut.scm megatest-version.scm 
	csc $(CSCOPTS) $(OFILES) $(MOFILES)  $(MOIMPFILES) mtut.scm -o mtut

# include makefile.inc

TCMTOBJS = \
	api.o \
	archive.o \
	cgisetup/models/pgdb.o \
︙
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383

384
385

386
387
388
389
390
391
392

368
369
370
371
372
373
374

375
376
377
378
379
380
381
382
383
384
385

386
387
388
389
390
391
392
393








-









+

-
+








	if [[ $(ARCHSTR) == 12.5 ]]; then \
	mkdir -p $(PREFIX)/bin/.$(ARCHSTR)/lib; \
	$(INSTALL) lib/libxcb-xlib.so.0 $(PREFIX)/bin/.$(ARCHSTR)/lib/libxcb-xlib.so.0; \
        fi

install : $(PREFIX)/bin/.$(ARCHSTR) $(PREFIX)/bin/.$(ARCHSTR)/mtest $(PREFIX)/bin/megatest \
          $(PREFIX)/bin/.$(ARCHSTR)/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \
          $(PREFIX)/bin/.$(ARCHSTR)/mtexec $(PREFIX)/bin/mtexec $(PREFIX)/bin/serialize-env \
	  $(PREFIX)/bin/nbfind $(PREFIX)/bin/mtrunner $(PREFIX)/bin/viewscreen $(PREFIX)/bin/mt_xterm \
          $(PREFIX)/bin/mt-old-to-new.sh $(PREFIX)/bin/mt-new-to-old.sh \
	  $(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)/lib/libpangox-1.0.so \
          $(PREFIX)/bin/.$(ARCHSTR)/lib/libpangox-1.0.so.0 \
          $(PREFIX)/bin/.$(ARCHSTR)/lib/libxcb-xlib.so.0

#         $(PREFIX)/bin/.$(ARCHSTR)/ndboard

#         $(PREFIX)/bin/.$(ARCHSTR)/mtexec $(PREFIX)/bin/mtexec $(PREFIX)/bin/serialize-env \
# $(PREFIX)/bin/newdashboard

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

test: tests/tests.scm
︙

Modified archive.scm from [25e6383e3d] to [220e8f084a].

︙
19
20
21
22
23
24
25


26
27
28
29
30
31
32

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34








+
+








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

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 format md5 message-digest srfi-18)

(declare (unit archive))
(declare (uses db))
(declare (uses common))
(declare (uses commonmod))
(import commonmod)

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

;;======================================================================
;; 
;;======================================================================
︙

Modified client.scm from [732bd78865] to [cc83111095].

︙
25
26
27
28
29
30
31


32
33
34
35
36
37
38

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40








+
+








     spiffy-request-vars uri-common intarweb directory-utils)

(declare (unit client))

(declare (uses common))
(declare (uses db))
(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
(declare (uses commonmod))
(import commonmod)

(module client
*

)

(import client)
︙

Modified common.scm from [a37f58bd5f] to [4838fd1409].

︙
22
23
24
25
26
27
28


29
30
31
32
33
34
35

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37








+
+








     format dot-locking csv-xml z3 udp ;; sql-de-lite
     hostinfo md5 message-digest typed-records directory-utils stack
     matchable regex posix (srfi 18) extras ;; tcp 
     (prefix nanomsg nmsg:)
     (prefix sqlite3 sqlite3:)
     pkts (prefix dbi dbi:)
     )
(use posix-extras pathname-expand files)


(declare (unit common))
(declare (uses commonmod))
(import commonmod)

(include "common_records.scm")
︙
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223

210
211
212
213
214
215
216


217
218
219
220
221
222
223








-
-








(define *launch-setup-mutex* (make-mutex))     ;; need to be able to call launch:setup often so mutex it and re-call the real deal only if *toppath* not set
(define *homehost-mutex*     (make-mutex))

;; Miscellaneous
(define *triggers-mutex*     (make-mutex))     ;; block overlapping processing of triggers
(define *numcpus-cache* (make-hash-table))

(use posix-extras pathname-expand files)

;; this plugs a hole in posix-extras in recent chicken versions > 4.9)
(let-values (( (chicken-release-number chicken-major-version)
               (apply values
                      (map string->number
                           (take
                            (string-split (chicken-version) ".")
                            2)))))
︙
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736

720
721
722
723
724
725
726



727
728
729
730
731
732
733








-
-
-








;; 	 (currtime (current-seconds)))
;;     (if (> (- currtime lasttime) waitval)
;; 	(begin
;; 	  (hash-table-set! *common:denoise* key currtime)
;; 	  #t)
;; 	#f)))

(define (common:get-megatest-exe)
  (or (getenv "MT_MEGATEST") "megatest"))

(define (common:read-encoded-string instr)
  (handle-exceptions
   exn
   (handle-exceptions
    exn
    (begin
      (debug:print-error 0 *default-log-port* "received bad encoded string \"" instr "\", message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn)
︙
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073

1041
1042
1043
1044
1045
1046
1047
















1048
1049
1050
1051
1052
1053
1054








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








;;======================================================================
;; '(print (string-intersperse (map cadr (hash-table-ref/default (read-config "megatest.config" \#f \#t) "disks" '"'"'("none" ""))) "\n"))'
(define (common:get-disks #!key (configf #f))
  (hash-table-ref/default 
   (or configf (read-config "megatest.config" #f #t))
   "disks" '("none" "")))

;;======================================================================
;; return first command that exists, else #f
;;
(define (common:which cmds)
  (if (null? cmds)
      #f
      (let loop ((hed (car cmds))
		 (tal (cdr cmds)))
	(let ((res (with-input-from-pipe (conc "which " hed) read-line)))
	  (if (and (string? res)
		   (common:file-exists? res))
	      res
	      (if (null? tal)
		  #f
		  (loop (car tal)(cdr tal))))))))
  
(define (common:get-install-area)
  (let ((exe-path (car (argv))))
    (if (common:file-exists? exe-path)
	(handle-exceptions
	 exn
	 #f
	 (pathname-directory
︙

Modified commonmod.scm from [56d21c8b94] to [09e197a941].

︙
32
33
34
35
36
37
38

39

40
41
42
43
44
45
46

32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48








+

+








	(prefix sqlite3 sqlite3:)
	data-structures
	extras
	files
	matchable
	md5
	message-digest
	pathname-expand
	posix
	posix-extras
	regex
	regex-case
	srfi-1
	srfi-18
	srfi-69
	typed-records
︙
150
151
152
153
154
155
156












































157
158
159
160
161
162
163

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
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209








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








      #f ;; I don't really care why this failed (at least for now)
    (delete-file* fname)))

;;======================================================================
;; misc conversion, data manipulation functions
;;======================================================================

;;======================================================================
;; return first command that exists, else #f
;;
(define (common:which cmds)
  (if (null? cmds)
      #f
      (let loop ((hed (car cmds))
		 (tal (cdr cmds)))
	(let ((res (with-input-from-pipe (conc "which " hed) read-line)))
	  (if (and (string? res)
		   (file-exists? res))
	      res
	      (if (null? tal)
		  #f
		  (loop (car tal)(cdr tal))))))))
  
(define (common:get-megatest-exe)
  (let* ((mtexe (or (get-environment-variable "MT_MEGATEST")
		    (common:which '("megatest"))
		    "megatest")))
    (if (file-exists? mtexe)
	(realpath mtexe)
	mtexe)))

(define (common:get-megatest-exe-dir)
  (let* ((mtexe (common:get-megatest-exe)))
    (pathname-directory mtexe)))

;; more generic and comprehensive version of get-megatest-exe
;;
(define (common:get-mtexe)
  (let* ((mtpathdir  (common:get-megatest-exe-dir)))
    (or (common:get-megatest-exe)
	(if mtpathdir
	    (conc mtpathdir"/megatest")
	    #f)
	"megatest")))

(define (common:get-megatest-exe-path)
  (let* ((mtpathdir (common:get-megatest-exe-dir)))
    (conc mtpathdir":"(get-environment-variable "PATH") ":.")))

(define (realpath x) (resolve-pathname  (pathname-expand (or x "/dev/null")) ))

;; if it looks like a number -> convert it to a number, else return it
;;
(define (lazy-convert inval)
  (let* ((as-num (if (string? inval)(string->number inval) #f)))
    (or as-num inval)))

;; to '((a . 1)(b . 2)(c . "a silly thing")(d . ""))
︙

Modified configf.scm from [6390e213ef] to [1768130e73].

︙
23
24
25
26
27
28
29



30
31
32
33
34
35
36

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








+
+
+








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

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

(include "common_records.scm")

;; return list (path fullpath configname)
(define (find-config configname #!key (toppath #f))
  (if toppath
      (let ((cfname (conc toppath "/" configname)))
︙
95
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

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
124
125
126
127
128








+
+














-
+








;; read a line and process any #{ ... } constructs

(define configf:var-expand-regex (regexp "^(.*)#\\{(scheme|system|shell|getenv|get|runconfigs-get|rget|scm|sh|rp|gv|g|mtrah)\\s+([^\\}\\{]*)\\}(.*)"))

(define (configf:system ht cmd)
  (system cmd)
  )

(define configf:imports "(import commonmod)")

(define (configf:process-line l ht allow-system #!key (linenum #f))
  (let loop ((res l))
    (if (string? res)
	(let ((matchdat (string-search configf:var-expand-regex res)))
	  (if matchdat
	      (let* ((prestr  (list-ref matchdat 1))
		     (cmdtype (list-ref matchdat 2)) ;; eval, system, shell, getenv
		     (cmd     (list-ref matchdat 3))
		     (poststr (list-ref matchdat 4))
		     (result  #f)
		     (start-time (current-seconds))
		     (cmdsym  (string->symbol cmdtype))
		     (fullcmd (case cmdsym
				((scheme scm) (conc "(lambda (ht)" cmd ")"))
				((scheme scm) (conc "(lambda (ht)(begin " configf:imports cmd "))"))
				((system)     (conc "(lambda (ht)(configf:system ht \"" cmd "\"))"))
				((shell sh)   (conc "(lambda (ht)(string-translate (shell \""  cmd "\") \"\n\" \" \"))"))
				((realpath rp)(conc "(lambda (ht)(common:nice-path \"" cmd "\"))"))
				((getenv gv)  (conc "(lambda (ht)(get-environment-variable \"" cmd "\"))"))
				((mtrah)      (conc "(lambda (ht)"
                                                    "    (let ((extra \"" cmd "\"))"
						    "       (conc (or *toppath* (get-environment-variable \"MT_RUN_AREA_HOME\"))"
︙

Modified dashboard-guimonitor.scm from [60455a8a12] to [76c7fb97a3].

︙
32
33
34
35
36
37
38


39
40
41
42
43
44
45

32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47








+
+








(import (prefix sqlite3 sqlite3:))

(declare (unit dashboard-guimonitor))
(declare (uses common))
(declare (uses keys))
(declare (uses db))
(declare (uses tasks))
(declare (uses commonmod))
(import commonmod)

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

(define (control-panel db tdb keys)
︙

Modified dashboard.scm from [1463b2c62c] to [b72cad9255].

︙
45
46
47
48
49
50
51



52
53
54
55
56
57
58

45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61








+
+
+








(declare (uses dashboard-context-menu))
(declare (uses vg))
(declare (uses subrun))
(declare (uses mt))
(declare (uses dbmod))
;; (declare (uses dbmemmod))
(declare (uses dbfile))
(declare (uses commonmod))
(declare (uses commonmod.import))
(import commonmod)

(import dbmod dbfile)

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
︙

Modified db.scm from [b785a065ec] to [4ae5518584].

︙
29
30
31
32
33
34
35


36
37
38
39
40
41
42

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








+
+








(declare (uses debugprint))
(declare (uses dbmod))
(declare (uses dbfile))
(declare (uses keys))
(declare (uses ods))
(declare (uses client))
(declare (uses mt))
(declare (uses commonmod))
(import commonmod)

(use (srfi 18)
     extras
     tcp
     stack
     (prefix sqlite3 sqlite3:)
     srfi-1
︙

Modified diff-report.scm from [f999ffe6db] to [0fbca9ae2f].

︙
15
16
17
18
19
20
21


22
23
24
25
26
27
28

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








+
+








;;     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 diff-report))
(declare (uses common))
(declare (uses rmt))
(declare (uses commonmod))
(import commonmod)
         
(include "common_records.scm")
(use matchable)
(use fmt)
(use ducttape-lib)
(define css "")
︙

Modified ezsteps.scm from [aab87817a5] to [077453aa67].

︙
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

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








+
+











-
+








(declare (unit ezsteps))
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses commonmod))
(import commonmod)

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


;;(rmt:get-test-info-by-id run-id test-id) -> testdat

;; TODO: deprecate me in favor of ezsteps.scm
;;
(define (launch:runstep ezstep run-id test-id exit-info m tal testconfig all-steps-dat)
(define (ezsteps:runstep ezstep run-id test-id exit-info m tal testconfig all-steps-dat)
  (let* ((stepname       (car ezstep))  ;; do stuff to run the step
	 (stepinfo       (cadr ezstep))
	;; (let ((info (cadr ezstep)))
	;; 		   (if (proc? info) "" info)))
	;; (stepproc       (let ((info (cadr ezstep)))
	;; 		   (if (proc? info) info #f)))
	 (stepparts      (string-match (regexp "^(\\{([^\\}\\{]*)\\}\\s*|)(.*)$") stepinfo))
︙
61
62
63
64
65
66
67
68


69
70
71
72
73
74
75

63
64
65
66
67
68
69

70
71
72
73
74
75
76
77
78








-
+
+








			     (list-ref stepparts 3)
			     (conc "# error, no command for step "stepname)))
	 (script         "") ; "#!/bin/bash\n") ;; yep, we depend on bin/bash FIXME!!!\
	 (logpro-file    (conc stepname ".logpro"))
	 (html-file      (conc stepname ".html"))
	 (dat-file       (conc stepname ".dat"))
	 (tconfig-logpro (configf:lookup testconfig "logpro" stepname))
	 (logpro-used    (common:file-exists? logpro-file)))
	 (logpro-used    (common:file-exists? logpro-file))
	 (mtexepath      (common:get-megatest-exe-path)))
    (setenv "MT_STEP_NAME" stepname)
    (hash-table-set! all-steps-dat stepname `((params . ,paramparts)))
    (debug:print 0 *default-log-port* "stepparts: " stepparts ", stepparams: " stepparams
                 ", paramparts: " paramparts ", subrun: " subrun ", stepcmd: " stepcmd)
    
    (if (and tconfig-logpro
	     (not logpro-used)) ;; no logpro file found but have a defn in the testconfig
︙
94
95
96
97
98
99
100
101

102
103
104
105
106
107
108

97
98
99
100
101
102
103

104
105
106
107
108
109
110
111








-
+








    ;; call the command using mt_ezstep
    ;; (set! script (conc "mt_ezstep " stepname " " (if prevstep prevstep "x") " " stepcmd))
    
    (debug:print 4 *default-log-port* "script: " script)
    (rmt:teststep-set-status! run-id test-id stepname "start" "-" #f #f)
    ;; now launch the actual process
    (call-with-environment-variables 
     (list (cons "PATH" (conc (get-environment-variable "PATH") ":.")))
     (list (cons "PATH" mtexepath))
     (lambda () ;; (process-run "/bin/bash" "-c" "exec ls -l /tmp/foobar > /tmp/delme-more.log 2>&1")
       (let* ((cmd (conc stepcmd " > " stepname ".log 2>&1")) ;; >outfile 2>&1 
	      (pid #f))
	 (let ((proc (lambda ()
		       (set! pid (process-run "/bin/bash" (list "-c" cmd))))))
	   (if subrun
               (begin
︙

Modified index-tree.scm from [10c620fbfc] to [6384bce0d0].

︙
27
28
29
30
31
32
33


34
35
36
37
38
39
40

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42








+
+









(declare (unit tests))
(declare (uses lock-queue))
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(declare (uses commonmod))
(import commonmod)

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

Modified items.scm from [16328a4b96] to [4ca6320933].

︙
19
20
21
22
23
24
25


26
27
28
29
30
31
32

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34








+
+









;; (define itemdat '((ripeness    "green ripe overripe")
;; 		     (temperature "cool medium hot")
;; 		     (season      "summer winter fall spring")))

(declare (unit items))
(declare (uses common))
(declare (uses commonmod))
(import commonmod)

(include "common_records.scm")

;; Puts out all combinations
(define (process-itemlist hierdepth curritemkey itemlist)
  (let ((res '()))
    (if (not hierdepth)
︙

Modified keys.scm from [9fa2c0cfa5] to [d7b8d553eb].

︙
22
23
24
25
26
27
28


29
30
31
32
33
34
35

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37








+
+








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

(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))

(declare (unit keys))
(declare (uses common))
(declare (uses commonmod))
(import commonmod)

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

(define (keys->keystr keys) ;; => key1,key2,key3,additiona1, ...
  (string-intersperse keys ","))
︙

Modified launch.scm from [c865f0bf0e] to [6fda936e21].

︙
186
187
188
189
190
191
192
193

194
195
196
197
198
199
200

186
187
188
189
190
191
192

193
194
195
196
197
198
199
200








-
+








		   (setenv "MT_STEP_NAMES" (string-intersperse all-step-names " "))
		   (let loop ((ezstep (car ezstepslst))
			     (tal    (cdr ezstepslst))
			     (prevstep #f))
                    (debug:print-info 0 *default-log-port* "Processing ezstep \"" (string-intersperse ezstep " ") "\"")
		    ;; check exit-info (vector-ref exit-info 1)
		    (if (launch:einf-exit-status exit-info) ;; (vector-ref exit-info 1)
			(let* ((logpro-used (launch:runstep ezstep run-id test-id exit-info m tal testconfig all-steps-dat))
			(let* ((logpro-used (ezsteps:runstep ezstep run-id test-id exit-info m tal testconfig all-steps-dat))
			       (stepname    (car ezstep))
			       (stepparms   (hash-table-ref all-steps-dat stepname)))
			  (setenv "MT_STEP_NAME" stepname)
			  (pp (hash-table->alist all-steps-dat))
			  ;; if logpro-used read in the stepname.dat file
			  (if (and logpro-used (common:file-exists? (conc stepname ".dat")))
			      (launch:load-logpro-dat run-id test-id stepname))
︙

Modified lock-queue.scm from [21543b63ce] to [fbbd0328d6].

︙
17
18
19
20
21
22
23


24
25
26
27
28
29
30

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32








+
+








;;

(use (prefix sqlite3 sqlite3:) srfi-18)

(declare (unit lock-queue))
(declare (uses common))
(declare (uses tasks))
(declare (uses commonmod))
(import commonmod)

;;======================================================================
;; attempt to prevent overlapping updates of rollup files by queueing
;; update requests in an sqlite db
;;======================================================================

;;======================================================================
︙

Modified mlaunch.scm from [5bcd34288f] to [62be2ae3e1].

︙
26
27
28
29
30
31
32


33

26
27
28
29
30
31
32
33
34
35








+
+


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

(use sqlite3 srfi-1 posix regex regex-case srfi-69 format)

(declare (unit mlaunch))
(declare (uses db))
(declare (uses common))
(declare (uses commonmod))
(import commonmod)

Modified monitor.scm from [3df55c85ea] to [3205ec8bdb].

︙
21
22
23
24
25
26
27


28
29
30
31
32
33

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35








+
+







(import (prefix sqlite3 sqlite3:))

(declare (unit runs))
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(declare (uses commonmod))
(import commonmod)

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

Modified mtexec.scm from [6016ee8684] to [3a9610856f].

︙
27
28
29
30
31
32
33


34
35
36
37
38
39
40

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42








+
+








     (prefix dbi dbi:)
     )

;; (declare (uses common))
(declare (uses margs))
(declare (uses configf))
;; (declare (uses rmt))
(declare (uses commonmod))
(import commonmod)

;; (use ducttape-lib)
(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")

;; (require-library stml)
︙

Modified mtut.scm from [413cf26858] to [b04fee463b].

︙
28
29
30
31
32
33
34



35
36
37
38
39
40
41

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








+
+
+








     (prefix sqlite3 sqlite3:)
     nanomsg)

(declare (uses common))
(declare (uses margs))
(declare (uses configf))
;; (declare (uses rmt))
(declare (uses commonmod))
(declare (uses commonmod.import))
(import commonmod)

(use ducttape-lib)

(include "megatest-fossil-hash.scm")

(require-library stml)
︙

Modified newdashboard.scm from [a0c1909f88] to [c27106b5bc].

︙
27
28
29
30
31
32
33


34
35
36
37
38
39
40

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42








+
+









(use sql-de-lite srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors ;; defstruct
     (prefix dbi dbi:))

(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses commonmod))
(import commonmod)

;; (declare (uses launch))
;; (declare (uses gutils))
;; (declare (uses db))
;; (declare (uses server))
;; (declare (uses synchash))
(declare (uses dcommon))
︙

Modified ods.scm from [42e94b826f] to [1b93bc9256].

︙
15
16
17
18
19
20
21


22
23
24
25
26
27
28

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








+
+








;;     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)

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

Modified runconfig.scm from [66b9c38588] to [7a53eaa476].

︙
20
21
22
23
24
25
26


27
28
29
30
31
32
33

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35








+
+








;; to this run field1val/field2val/field3val ...
;;======================================================================

(use format directory-utils)

(declare (unit runconfig))
(declare (uses common))
(declare (uses commonmod))
(import commonmod)

(include "common_records.scm")

(define (runconfig:read fname target environ-patt)
  (let ((ht (make-hash-table)))
    (if target (hash-table-set! ht target '()))
    (read-config fname ht #t environ-patt: environ-patt sections: (if target (list "default" target) #f))))
︙

Modified subrun.scm from [8e4ec606e5] to [4fc2a9b685].

︙
21
22
23
24
25
26
27

28
29
30
31
32
33
34


35
36
37
38
39
40
41

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44








+







+
+








(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 
     posix-extras directory-utils pathname-expand typed-records format
     call-with-environment-variables)
(declare (unit subrun))
;;(declare (uses runs))
(declare (uses db))
(declare (uses common))
(declare (uses commonmod))
;;(declare (uses items))
;;(declare (uses runconfig))
;;(declare (uses tests))
;;(declare (uses server))
(declare (uses mt))
;;(declare (uses archive))
;; (declare (uses filedb))

(import commonmod)

;(include "common_records.scm")
;;(include "key_records.scm")
(include "db_records.scm") ;; provides db:test-get-id
;;(include "run_records.scm")
;;(include "test_records.scm")
︙
133
134
135
136
137
138
139
140

141
142
143
144
145
146
147

136
137
138
139
140
141
142

143
144
145
146
147
148
149
150








-
+








(define (subrun:launch-cmd test-run-dir run-mode #!optional (sub-cmd "-run")) ;; BUG: "-run" should be changed to "-rerun-clean" but current doesn't work
  (if (subrun:subrun-removed? test-run-dir)
      (subrun:unset-subrun-removed test-run-dir))      

  (let* ((log-prefix "run")
         (switches (subrun:selector+log-switches test-run-dir log-prefix))
         (run-wait (equal? run-mode "yes"))
         (cmd      (conc "megatest " sub-cmd " " switches" "
         (cmd      (conc (common:get-mtexe)" "sub-cmd" "switches" "
                         (if run-wait "-run-wait " ""))))
    cmd))


(define (subrun:sanitize-path inpath)
  (let* ((insane-pattern (irregex "[^[a-zA-Z0-9_\\-]")))
    (regex#string-substitute insane-pattern "_" inpath #t)))
︙
230
231
232
233
234
235
236


237


238
239


240
241
242
243
244
245
246

247
248
249
250
251
252
253

233
234
235
236
237
238
239
240
241
242
243
244


245
246
247
248
249
250
251
252

253
254
255
256
257
258
259
260








+
+

+
+
-
-
+
+






-
+








            (map
             (lambda (x)
               (list (car x) (cdr x)))
             switch-alist))
           " ")))
    res))

;; NOTE: Here we run sub megatest but this is not intended for one version
;;       of megatest to test another version. Thus we propagate the 
(define (subrun:exec-sub-megatest test-run-dir action-switches-str log-prefix)
  (let* ((mtpathdir          (common:get-megatest-exe-dir))
	 (mtexe              (common:get-mtexe))
  (let* ((selector-switches  (subrun:selector+log-switches test-run-dir log-prefix))
         (cmd (conc "megatest " selector-switches " " action-switches-str ))
	 (selector-switches  (subrun:selector+log-switches test-run-dir log-prefix))
         (cmd (conc mtexe" "selector-switches" "action-switches-str ))
         (pid #f)
         (proc (lambda ()
                 (debug:print-info 0 *default-log-port* "Running sub megatest command: "cmd)
                 ;;(set! pid (process-run "/usr/bin/xterm" (list ))))))
                 (set! pid (process-run "/bin/bash" (list "-c" cmd))))))
    (call-with-environment-variables 
     (list (cons "PATH" (conc (get-environment-variable "PATH") ":.")))
     (list (cons "PATH"  (common:get-megatest-exe-path)))
     (lambda  ()
       (common:without-vars proc "^MT_.*")))
    (let processloop ((i 0))
      (let-values (((pid-val exit-status exit-code)(process-wait pid #t)))
        (if (eq? pid-val 0)
            (begin
              (thread-sleep! 2)
︙

Modified tasks.scm from [0f38bdbcce] to [499c2cc5ba].

︙
23
24
25
26
27
28
29


30
31
32
33
34
35
36

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38








+
+









(declare (unit tasks))
(declare (uses dbfile))
(declare (uses db))
(declare (uses rmt))
(declare (uses common))
(declare (uses pgdb))
(declare (uses commonmod))
(import commonmod)

(import dbfile)
;; (import pgdb) ;; pgdb is a module

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

Modified tcmt.scm from [6658a745e5] to [bb0554607f].

︙
28
29
30
31
32
33
34


35
36
37
38
39
40
41

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43








+
+








(use trace)
;; (trace-call-sites #t)

(declare (uses margs))
(declare (uses rmt))
(declare (uses common))
;; (declare (uses megatest-version))
(declare (uses commonmod))
(import commonmod)

(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
(include "db_records.scm")

(define origargs (cdr (argv)))
(define remargs (args:get-args
︙

Modified tcp-transportmod.scm from [b0099fec72] to [1b8b1d78a6].

︙
165
166
167
168
169
170
171
172

173
174
175
176
177
178
179

165
166
167
168
169
170
171

172
173
174
175
176
177
178
179








-
+








    ;;
    ;; need two threads, one a 5 second timer
    ;;
    (match res
      ((status errmsg result meta)
       (if (equal? result server-id)
	   (begin
	     (debug:print 0 *default-log-port* "Ping to "host":"port" successful.")
	     ;; (debug:print 0 *default-log-port* "Ping to "host":"port" successful.")
	     #t) ;; then we are good
	   (begin
	     (debug:print 0 *default-log-port* "WARNING: server-id does not match, expected: "server-id", got: "result)
	     #f)))
      (else
       ;; (debug:print 0 *default-log-port* "res not in form (status errmsg result meta), got: "res)
       #f))))
︙

Modified tdb.scm from [6edff6262d] to [0211217236].

︙
30
31
32
33
34
35
36


37
38
39
40
41
42
43

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








+
+








(declare (unit tdb))
(declare (uses common))
(declare (uses keys))
(declare (uses ods))
(declare (uses client))
(declare (uses mt))
(declare (uses db))
(declare (uses commonmod))
(import commonmod)

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

;;======================================================================
︙

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