Megatest

Check-in [ce47c7863e]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Sorta working without servers
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: ce47c7863ea73204efe7cea24f00909935b61f20
User & Date: matt on 2014-10-05 22:39:47
Other Links: branch diff | manifest | tags
Context
2014-10-05
22:47
missed these changes ... check-in: 376151225a user: matt tags: v1.60
22:39
Sorta working without servers check-in: ce47c7863e user: matt tags: v1.60
2014-10-03
12:03
Fixed typo check-in: 399217ae55 user: icfadm tags: v1.60
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified api.scm from [49d5650896] to [4a3da8fcef].

︙
79
80
81
82
83
84
85
86

87
88
89
90
91
92
93

79
80
81
82
83
84
85

86
87
88
89
90
91
92
93








-
+








    ((test-toplevel-num-items)         (apply db:test-toplevel-num-items dbstruct params))
    ((get-test-info-by-id)	       (apply db:get-test-info-by-id dbstruct params))
    ((test-get-rundir-from-test-id)    (apply db:test-get-rundir-from-test-id dbstruct params))
    ((test-set-state-status-by-id)     (apply db:test-set-state-status-by-id dbstruct params))
    ((get-count-tests-running)         (apply db:get-count-tests-running dbstruct params))
    ((get-count-tests-running-in-jobgroup) (apply db:get-count-tests-running-in-jobgroup dbstruct params))
    ((delete-test-records)             (apply db:delete-test-records dbstruct params))
    ((delete-test-step-records)        (apply db:delete-test-step-records dbstruct params))
    ;; ((delete-test-step-records)        (apply db:delete-test-step-records dbstruct params))
    ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
    ((test-set-status-state)           (apply db:test-set-status-state dbstruct params))
    ((get-previous-test-run-record)    (apply db:get-previous-test-run-record dbstruct params))
    ((get-matching-previous-test-run-records)(apply db:get-matching-previous-test-run-records dbstruct params))
    ((test-get-logfile-info)           (apply db:test-get-logfile-info dbstruct params))
    ((test-get-records-for-index-file)  (apply db:test-get-records-for-index-file dbstruct params))
    ((get-testinfo-state-status)       (apply db:get-testinfo-state-status dbstruct params))
︙

Modified common.scm from [f2fb725d32] to [0dac47ec76].

︙
47
48
49
50
51
52
53
54

55
56
57
58
59
60
61

47
48
49
50
51
52
53

54
55
56
57
58
59
60
61








-
+








(define *globalexitstatus*  0) ;; attempt to work around possible thread issues
(define *passnum*           0) ;; when running track calls to run-tests or similar
(define *write-frequency*   (make-hash-table)) ;; run-id => (vector (current-seconds) 0))
(define *alt-log-file* #f)  ;; used by -log
(define *db-sync-mutex* (make-mutex))

;; DATABASE
(define *open-dbs* (vector #f (make-hash-table))) ;; megatestdb run-id-dbs
(define *dbstruct-db*  #f)

;; SERVER
(define *my-client-signature* #f)
(define *transport-type*    'http)
(define *megatest-db*       #f)
(define *rpc:listener*      #f) ;; if set up for server communication this will hold the tcp port
(define *runremote*         (make-hash-table)) ;; if set up for server communication this will hold <host port>
︙

Modified db.scm from [09c18c63b7] to [602708e9c7].

︙
169
170
171
172
173
174
175


176



177
178
179
180
181
182
183

169
170
171
172
173
174
175
176
177

178
179
180
181
182
183
184
185
186
187








+
+
-
+
+
+








						    (sqlite3:execute 
						     db
						     "INSERT OR IGNORE INTO tests (id,run_id,testname,event_time,item_path,state,status) VALUES (?,?,'bogustest',strftime('%s','now'),'nowherepath','DELETED','n/a');"
						     (* run-id 30000) ;; allow for up to 30k tests per run
						     run-id)
						    ))) ;; add strings db to rundb, not in use yet
	       ;;   )) ;; (sqlite3:open-database dbpath))
	       (olddb        (if *megatest-db*
				 *megatest-db* 
	       (olddb        (db:open-megatest-db))
				 (let ((db (db:open-megatest-db)))
				   (set! *megatest-db* db)
				   db)))
	       (write-access (file-write-access? dbpath))
	       ;; (handler      (make-busy-timeout 136000))
	       )
	  (if (and dbexists (not write-access))
	      (set! *db-write-access* #f)) ;; only unset so other db's also can use this control
	  (dbr:dbstruct-set-rundb!  dbstruct db)
	  (dbr:dbstruct-set-inuse!  dbstruct #t)
︙
280
281
282
283
284
285
286
287


288
289
290

291
292
293
294
295
296
297

284
285
286
287
288
289
290

291
292
293
294

295
296
297
298
299
300
301
302








-
+
+


-
+








  (let* ((local (dbr:dbstruct-get-local dbstruct))
	 (rundb (dbr:dbstruct-get-rundb dbstruct)))
    (if local
	(for-each
	 (lambda (db)
	   (if (sqlite3:database? db)
	       (sqlite3:finalize! db)))
	 (hash-table-values (dbr:dbstruct-get-locdbs dbstruct)))
	 (hash-table-values (dbr:dbstruct-get-locdbs dbstruct))))
    (if rundb
	(if (sqlite3:database? rundb)
	    (sqlite3:finalize! rundb)
	    (debug:print 0 "WARNING: attempting to close databases but got " rundb " instead of a database")))))
	    (debug:print 2 "WARNING: attempting to close databases but got " rundb " instead of a database")))))

(define (db:open-inmem-db)
  (let* ((db      (sqlite3:open-database ":memory:"))
	 (handler (make-busy-timeout 3600)))
    (db:initialize-run-id-db db)
    (sqlite3:set-busy-handler! db handler)
    db))
︙

Modified megatest.scm from [6effbe511c] to [f7bd26591e].

︙
343
344
345
346
347
348
349




350
351
352
353
354
355
356

343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360








+
+
+
+









(if (args:get-arg "-itempatt")
    (let ((newval (conc (args:get-arg "-testpatt") "/" (args:get-arg "-itempatt"))))
      (debug:print 0 "WARNING: -itempatt has been deprecated, please use -testpatt testpatt/itempatt method, new testpatt is "newval)
      (hash-table-set! args:arg-hash "-testpatt" newval)
      (hash-table-delete! args:arg-hash "-itempatt")))

(on-exit (lambda ()
	   (if *megatest-db*
	       (db:close-all *megatest-db*))))

;;======================================================================
;; Misc general calls
;;======================================================================

(if (args:get-arg "-env2file")
    (begin
      (save-environment-as-files (args:get-arg "-env2file"))
︙

Modified rmt.scm from [1094d13d5a] to [41ba4d4320].

︙
63
64
65
66
67
68
69
70
71
72


73
74
75
76

77

78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93





94
95
96
97

98
99
100
101
102
103
104

63
64
65
66
67
68
69



70
71

72
73
74
75

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90


91
92
93
94
95
96
97
98

99
100
101
102
103
104
105
106








-
-
-
+
+
-



+
-
+














-
-
+
+
+
+
+



-
+








	 (connection-info (let ((cinfo (hash-table-ref/default *runremote* run-id #f)))
			    (if cinfo
				cinfo
				;; if read only query and server not already running
				;; bypass starting the server. 
				;;
				;; NB// can cache the answer for server running for 10 seconds ...
				;;
				(if (and (not (rmt:write-frequency-over-limit? cmd run-id))
					 (not (open-run-close tasks:server-running-or-starting? tasks:open-db run-id)))
				;;  ;; (and (not (rmt:write-frequency-over-limit? cmd run-id))
				(if (open-run-close tasks:server-running-or-starting? tasks:open-db run-id)
				    #f
				    (let ((res (client:setup run-id)))
				      (if res 
					  (hash-table-ref/default *runremote* run-id #f) ;; client:setup filled this in (hopefully)
					  #f))
					  #f))))))
				    #f))))
	 (jparams         (db:obj->string params)))
    (if connection-info
	(let ((res             (http-transport:client-api-send-receive run-id connection-info cmd jparams)))
	  (if res
	      (db:string->obj res)
	      (let ((new-connection-info (client:setup run-id)))
		(debug:print 0 "WARNING: Communication failed, trying call to http-transport:client-api-send-receive again.")
		(rmt:send-receive cmd run-id params))))
	(begin
	  (debug:print-info 4 "no server and read-only query, bypassing normal channel")
	  (rmt:open-qry-close-locally cmd run-id params)))))

(define (rmt:open-qry-close-locally cmd run-id params)
  (let* ((dbdir (conc    (configf:lookup *configdat* "setup" "linktree") "/.db"))
	 (dbstruct-local (make-dbr:dbstruct path:  dbdir
					    local: #t))
	 (dbstruct-local (if *megatest-db*
			     *megatest-db*
			     (let ((db (make-dbr:dbstruct path:  dbdir local: #t)))
			       (set! *megatest-db* db)
			       db)))
	 (db-file-path   (db:dbfile-path 0))
	 ;; (read-only      (not (file-read-access? db-file-path)))
	 (res            (api:execute-requests dbstruct-local (symbol->string cmd) params)))
    (db:close-all dbstruct-local)
    ;; (db:close-all dbstruct-local)
    res))

(define (rmt:send-receive-no-auto-client-setup connection-info cmd run-id params)
  (let* ((run-id   (if run-id run-id 0))
	 (jparams         (db:obj->string params)) ;; (rmt:dat->json-str params))
	 (res (http-transport:client-api-send-receive run-id connection-info cmd jparams)))
    (if res
︙

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