Megatest

Check-in [65618b033e]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:megatest -repl and -h work
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.90-proper-interface-lists
Files: files | file ages | folders
SHA1: 65618b033ee6cf58145de6004a1fabc1b3ca9436
User & Date: mrwellan on 2024-02-13 12:40:48
Other Links: branch diff | manifest | tags
Context
2024-02-13
15:17
dashboard runs check-in: 947952bcfb user: mrwellan tags: v1.90-proper-interface-lists
12:40
megatest -repl and -h work check-in: 65618b033e user: mrwellan tags: v1.90-proper-interface-lists
07:27
wip check-in: b7ce99fe0a user: mrwellan tags: v1.90-proper-interface-lists
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified Makefile from [73c983d707] to [3320918a2c].

︙
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
58
59
60
61

62
63
64
65
66
67
68

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
58
59
60

61
62
63
64
65
66
67
68








-
+













-
+












-
+








SHELL=/bin/bash
PREFIX=$(PWD)
CSCOPTS=
INSTALL=install
SRCFILES = launch.scm runconfig.scm	\
           server.scm configf.scm keys.scm		\
           process.scm runs.scm \
           tdb.scm mt.scm	\
           mt.scm	\
           ezsteps.scm api.scm		\
           subrun.scm archive.scm env.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 \
            pkts.scm testsmod.scm pgdb.scm cookie.scm launchmod.scm \
            subrunmod.scm runsmod.scm tasksmod.scm archivemod.scm \
            ezstepsmod.scm mtbody.scm envmod.scm genexample.scm mutils.scm \
            diff-report.scm
            diff-report.scm tdb.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

mtest : transport-mode.scm
dboard : dashboard-transport-mode.scm

# dbmod.import.o is just a hack here

mofiles/mtbody.o     : mofiles/launchmod.o readline-fix.scm mofiles/envmod.o mofiles/genexample.o mofiles/mutils.o mofiles/diff-report.o
mofiles/mtbody.o     : mofiles/launchmod.o readline-fix.scm mofiles/envmod.o mofiles/genexample.o mofiles/mutils.o mofiles/diff-report.o mofiles/tdb.o
process.o            : mofiles/processmod.o
mofiles/configfmod.o : mofiles/processmod.o
mofiles/processmod.o : mofiles/commonmod.o
mofiles/servermod.o  : mofiles/commonmod.o
mofiles/rmtmod.o     : mofiles/mtmod.o mofiles/apimod.o
mofiles/dbmod.o      : mofiles/mtmod.o
# mofiles/mtmod.o      : mofiles/tcp-transportmod.o
︙

Modified megatest.scm from [6b51934130] to [a02aadc475].

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

15
16
17
18
19
20
21



22
23
24
25
26
27
28








-
-
-








;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

;; (include "common.scm")
;; (include "megatest-version.scm")

;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)

;; (declare (uses common))
;; (declare (uses megatest-version))
;; (declare (uses margs))
(declare (uses mtargs))
(declare (uses mtargs.import))
(declare (uses debugprint))
(declare (uses debugprint.import))
︙
84
85
86
87
88
89
90




91
92
93

81
82
83
84
85
86
87
88
89
90
91
92
93
94








+
+
+
+




(declare (uses diff-report))
(declare (uses runs))
(declare (uses launch))
(declare (uses server))
(declare (uses genexample))
(declare (uses mtbody))

(import csi)
;; fake out readline usage of toplevel-command
(set! toplevel-command (lambda (a b) #f))

(import mtbody)

(main)

Modified mtbody.scm from [2c54722bd3] to [c8247e48cf].

︙
34
35
36
37
38
39
40

41
42


43
44
45
46
47
48
49

34
35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
50
51








+

-
+
+








(declare (uses genexample))
(declare (uses rmtmod))
(declare (uses archivemod))
(declare (uses mutils))
(declare (uses odsmod))
(declare (uses testsmod))
(declare (uses diff-report))
(declare (uses tdb))

(use srfi-69 readline)
(use srfi-69)
(import csi)

(module mtbody
	*
	
(import scheme)
(cond-expand
 (chicken-4
︙
59
60
61
62
63
64
65
66

67
68
69
70
71
72
73

61
62
63
64
65
66
67

68
69
70
71
72
73
74
75








-
+








	  files
	  matchable
	  md5
	  message-digest
	  pathname-expand
	  posix
	  posix-extras
	  readline
	  ;;	  readline
	  regex
	  regex-case
	  sparse-vectors
	  srfi-1
	  srfi-18
	  srfi-69
	  typed-records
︙
114
115
116
117
118
119
120
121


122
123
124
125
126
127
128

116
117
118
119
120
121
122

123
124
125
126
127
128
129
130
131








-
+
+








	  typed-records
	  system-information

	  debugprint
  )))

;; imports common to chk5 and ck4
(import srfi-13)
(import srfi-13
	csi)

(import (prefix mtargs args:)
        archivemod
	debugprint
	dbmod
	commonmod
	processmod
︙
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

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
177
178
179
180
181








+





+
+







-
-
-
+
+
+
+
+








	envmod
	apimod
	genexample
	mutils
	odsmod
	testsmod
	diff-report
	tdb
        )

(include "common_records.scm")

(define *db* #f) ;; this is only for the repl, do not use in general!!!!

;; (set! toplevel-command toplevel-command)

;; (include "common_records.scm")
;; (include "key_records.scm")
;; (include "db_records.scm")
(include "run_records.scm")
(include "megatest-fossil-hash.scm")

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:))
(use readline apropos json http-client directory-utils typed-records)
(use http-client srfi-18 extras format tcp-server tcp)
(import (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:))
(import
 ;; readline
 apropos json http-client directory-utils typed-records)
(import http-client srfi-18 extras format tcp-server tcp)

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

(require-library mutils)
︙
2204
2205
2206
2207
2208
2209
2210
2211

2212
2213
2214
2215
2216
2217
2218

2212
2213
2214
2215
2216
2217
2218

2219
2220
2221
2222
2223
2224
2225
2226








-
+








       (lambda (target runname keys keyvals)
	 (runs:handle-locking 
	  target
	  keys
	  (or (args:get-arg "-runname")(args:get-arg ":runname") )
	  (args:get-arg "-lock")
	  (args:get-arg "-unlock")
	  user))))
	  (current-user-name)))))

  ;;======================================================================
  ;; Get paths to tests
  ;;======================================================================
  ;; Get test paths matching target, runname, and testpatt
  (if (or (args:get-arg "-test-files")(args:get-arg "-test-paths"))
      ;; if we are in a test use the MT_CMDINFO data
︙
2605
2606
2607
2608
2609
2610
2611
2612

2613
2614
2615
2616
2617
2618
2619

2613
2614
2615
2616
2617
2618
2619

2620
2621
2622
2623
2624
2625
2626
2627








-
+








	;;	    (debug:print 0 *default-log-port* "Servers are not running on this host or no servers alive. Cannot run cleanup-db")
	;;	    (exit 1)))

	(let ((dbstructs (db:setup)))
          (common:cleanup-db dbstructs))
	(set! *didsomething* #t)))

  (if (args:get-arg "-mark-incompletes")
  #;(if (args:get-arg "-mark-incompletes")
      (begin
	(if (not (launch:setup))
	    (begin
	      (debug:print 0 *default-log-port* "Failed to setup, exiting")
	      (exit 1)))
	(open-run-close db:find-and-mark-incomplete #f)
	(set! *didsomething* #t)))
︙
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647

2641
2642
2643
2644
2645
2646
2647

2648
2649
2650
2651
2652
2653
2654








-









  ;;======================================================================
  ;; Start a repl
  ;;======================================================================

  ;; fakeout readline
  (include "readline-fix.scm")


  (when (args:get-arg "-diff-rep")
    (when (and
           (not (args:get-arg "-diff-html"))
           (not (args:get-arg "-diff-email")))
      (debug:print 0 *default-log-port* "Must specify -diff-html or -diff-email with -diff-rep")
      (set! *didsomething* 1)
︙
2676
2677
2678
2679
2680
2681
2682
2683

2684
2685
2686

2687
2688
2689
2690

2691
2692

2693
2694
2695
2696
2697
2698


2699
2700
2701
2702
2703
2704
2705

2683
2684
2685
2686
2687
2688
2689

2690
2691
2692
2693
2694
2695
2696
2697

2698
2699
2700
2701
2702
2703
2704
2705


2706
2707
2708
2709
2710
2711
2712
2713
2714








-
+



+



-
+


+




-
-
+
+








	      ;; #!/bin/bash
	      ;;
	      ;; export MT_RUNSCRIPT=yes
	      ;; megatest << EOF
	      ;; (print "Hello world")
	      ;; (exit)
	      ;; EOF

    
	      (repl))
	     (else
	      (begin
		(define toplevel-command (lambda (a b)(print a " "b)))
		(set! *db* dbstructs)
		(import extras) ;; might not be needed
		;; (import csi)
		(import readline)
		;; (import readline)
		(import apropos)
		(import dbfile)
		
		;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...

		(if *use-new-readline*
		    (begin
		      (install-history-file (get-environment-variable "HOME") ".megatest_history") ;;  [homedir] [filename] [nlines])
		      (current-input-port (make-readline-port "megatest> ")))
		      #;(install-history-file (get-environment-variable "HOME") ".megatest_history") ;;  [homedir] [filename] [nlines])
		      #;(current-input-port (make-readline-port "megatest> ")))
		    #;(begin
		      (gnu-history-install-file-manager
		       (string-append
			(or (get-environment-variable "HOME") ".") "/.megatest_history"))
		      (current-input-port (make-gnu-readline-port "megatest> "))))
		(if (args:get-arg "-repl")
		    (repl)
︙

Modified rmtmod.scm from [eb436a7132] to [981fa22127].

︙
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








+








(declare (uses mtmod))
(declare (uses tcp-transportmod))
(declare (uses apimod))
(declare (uses servermod))

(module rmtmod
	(
	 rmt:test-data-rollup
	 rmt:import-sexpr
	 rmt:read-test-data-varpatt
	 rmt:get-run-status
	 rmt:set-run-status

	 rmtmod:send-receive
	 rmt:send-receive
︙
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301

281
282
283
284
285
286
287








288
289
290
291
292
293
294








-
-
-
-
-
-
-
-









(define (rmt:get-test-state-status-by-id run-id test-id)
  (rmtmod:send-receive 'get-test-state-status-by-id run-id (list run-id test-id)))

(define (rmt:test-get-rundir-from-test-id run-id test-id)
  (rmtmod:send-receive 'test-get-rundir-from-test-id run-id (list run-id test-id)))

;; (define (rmt:open-test-db-by-test-id run-id test-id #!key (work-area #f))
;;   (assert (number? run-id) "FATAL: Run id required.")
;;   (let* ((test-path (if (string? work-area)
;; 			work-area
;; 			(rmt:test-get-rundir-from-test-id run-id test-id))))
;;     (debug:print 3 *default-log-port* "TEST PATH: " test-path)
;;     (open-test-db test-path)))

;; WARNING: This currently bypasses the transaction wrapped writes system
(define (rmt:test-set-state-status-by-id run-id test-id newstate newstatus newcomment)
  (assert (number? run-id) "FATAL: Run id required.")
  (rmtmod:send-receive 'test-set-state-status-by-id run-id (list run-id test-id newstate newstatus newcomment)))

(define (rmt:set-tests-state-status run-id testnames currstate currstatus newstate newstatus)
  (assert (number? run-id) "FATAL: Run id required.")
︙

Modified tdb.scm from [3c5dc20bcf] to [6bf4733c7a]. 

1

2
3
4
5
6
7
8


1
2
3
4
5
6
7
8

-
+








;;======================================================================
>;;======================================================================
;; Copyright 2006-2013, 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
︙
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









58
59
60
61
62
63
64

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

58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84









+
+
+
+
+
+
+
+

+
-
+
+
+











-
+










+
+
+
+
+
+
+
+
+








(declare (uses debugprint))
;; (declare (uses common))
(declare (uses keys))
(declare (uses mt))
(declare (uses commonmod))
(declare (uses mtargs))
(declare (uses rmtmod))

(module tdb
	*

(import scheme
	chicken
	data-structures
	)

(require-extension (srfi 18) extras tcp)

(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64)
(import srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5
	message-digest base64)

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

(import commonmod
	debugprint
	rmtmod
	(prefix mtargs args:))

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

;;======================================================================
;;
;; T E S T   D A T A B A S E S
;;
;;======================================================================

;;======================================================================
;; T E S T   S P E C I F I C   D B 
;;======================================================================

;; (define (rmt:open-test-db-by-test-id run-id test-id #!key (work-area #f))
;;   (assert (number? run-id) "FATAL: Run id required.")
;;   (let* ((test-path (if (string? work-area)
;; 			work-area
;; 			(rmt:test-get-rundir-from-test-id run-id test-id))))
;;     (debug:print 3 *default-log-port* "TEST PATH: " test-path)
;;     (open-test-db test-path)))


;; =not-used= ;; Create the sqlite db for the individual test(s)
;; =not-used= ;;
;; =not-used= ;; Moved these tables into <runid>.db
;; =not-used= ;; THIS CODE TO BE REMOVED
;; =not-used= ;;
;; =not-used= (define (open-test-db work-area)
︙
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249













250
251
252
253
254
255
256

250
251
252
253
254
255
256













257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276








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








          (rmt:csv->test-data run-id test-id lin)
          ;;)
	  (loop (read-line)))))
  ;; roll up the current results.
  ;; FIXME: Add the status too 
  (rmt:test-data-rollup run-id test-id #f))

;; NOTE: Run this local with #f for db !!!
(define (tdb:load-logpro-data run-id test-id)
  (let loop ((lin (read-line)))
    (if (not (eof-object? lin))
	(begin
	  (debug:print 4 *default-log-port* lin)
          ;;(when lin  ;; this when blocked stack dump caused by .dat file from logpro being 0-byte.  fixed by upgrading logpro
          (rmt:csv->test-data run-id test-id lin)
          ;;)
	  (loop (read-line)))))
  ;; roll up the current results.
  ;; FIXME: Add the status too 
  (rmt:test-data-rollup run-id test-id #f))
;; ;; NOTE: Run this local with #f for db !!!
;; (define (tdb:load-logpro-data run-id test-id)
;;   (let loop ((lin (read-line)))
;;     (if (not (eof-object? lin))
;; 	(begin
;; 	  (debug:print 4 *default-log-port* lin)
;;           ;;(when lin  ;; this when blocked stack dump caused by .dat file from logpro being 0-byte.  fixed by upgrading logpro
;;           (rmt:csv->test-data run-id test-id lin)
;;           ;;)
;; 	  (loop (read-line)))))
;;   ;; roll up the current results.
;;   ;; FIXME: Add the status too 
;;   (rmt:test-data-rollup run-id test-id #f))

;;======================================================================
;; S T E P S 
;;======================================================================

(define (tdb:step-get-time-as-string vec)
  (seconds->time-string (tdb:step-get-event_time vec)))
︙
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416












421
422
423
424
425
426
427









428
429
430
431
432
433
434
435
436
437
438








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

			 (if (eq? time-a time-b)
			     (string<? (conc (vector-ref a 2))
				       (conc (vector-ref b 2)))
			     #f))
		     (string<? (conc time-a)(conc time-b))))))))

;; 
(define (tdb:remote-update-testdat-meta-info run-id test-id work-area cpuload diskfree minutes)
  (let ((tdb         (rmt:open-test-db-by-test-id run-id test-id work-area: work-area)))
    (if (sqlite3:database? tdb)
	(begin
	  (sqlite3:execute tdb "INSERT INTO test_rundat (update_time,cpuload,diskfree,run_duration) VALUES (strftime('%s','now'),?,?,?);"
			   cpuload diskfree minutes)
	  (sqlite3:finalize! tdb))
	(debug:print 2 *default-log-port* "Can't update testdat.db for test " test-id " read-only or non-existant"))))
    
;; (define (tdb:remote-update-testdat-meta-info run-id test-id work-area
;; 					     cpuload diskfree minutes)
;;   (let ((tdb         (rmt:open-test-db-by-test-id run-id test-id work-area: work-area)))
;;     (if (sqlite3:database? tdb)
;; 	(begin
;; 	  (sqlite3:execute tdb "INSERT INTO test_rundat (update_time,cpuload,diskfree,run_duration) VALUES (strftime('%s','now'),?,?,?);"
;; 			   cpuload diskfree minutes)
;; 	  (sqlite3:finalize! tdb))
;; 	(debug:print 2 *default-log-port* "Can't update testdat.db for test " test-id " read-only or non-existant"))))
;;     
)

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