Megatest

Check-in [a861379b83]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Partial edits towards getting dashboard responding to db changes after moving to /tmp
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.62-no-rpc
Files: files | file ages | folders
SHA1: a861379b8383d7e70506241ac06b1662a541f800
User & Date: matt on 2016-11-21 00:02:29
Other Links: branch diff | manifest | tags
Context
2016-11-21
08:18
update to arch figure check-in: dea64201d8 user: mrwellan tags: v1.62-no-rpc
00:02
Partial edits towards getting dashboard responding to db changes after moving to /tmp check-in: a861379b83 user: matt tags: v1.62-no-rpc
2016-11-20
20:56
Lock on homehost. Servers *always* started if not on homehost check-in: efae6c6bbf user: matt tags: v1.62-no-rpc
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified common.scm from [46ccba8588] to [7c2ea3f6ac].

︙
94
95
96
97
98
99
100

101
102
103
104
105
106
107

94
95
96
97
98
99
100
101
102
103
104
105
106
107
108








+








(define *megatest-db*         #f)
(define *last-db-access*      (current-seconds))  ;; update when db is accessed via server
(define *db-write-access*     #t)
(define *inmemdb*             #f)
(define *task-db*             #f) ;; (vector db path-to-db)
(define *db-access-allowed*   #t) ;; flag to allow access
(define *db-access-mutex*     (make-mutex))
(define *db-cache-path*       #f)

;; SERVER
(define *my-client-signature* #f)
(define *transport-type*    'http)
(define *transport-type*    'http)             ;; override with [server] transport http|rpc|nmsg
(define *runremote*         (make-hash-table)) ;; if set up for server communication this will hold <host port>
(define *max-cache-size*    0)
︙
391
392
393
394
395
396
397


398
399
400
401






402
403
404
405
406
407
408

392
393
394
395
396
397
398
399
400




401
402
403
404
405
406
407
408
409
410
411
412
413








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








(define (common:get-testsuite-name)
  (or (configf:lookup *configdat* "setup" "testsuite" )
      (if *toppath* 
          (pathname-file *toppath*)
          (pathname-file (current-directory)))))

(define (common:get-db-tmp-area)
  (if *db-cache-path*
      *db-cache-path*
  (create-directory (conc "/tmp/" (current-user-name)
                          "/megatest/"
                          (common:get-testsuite-name) "/"
                          (string-translate *toppath* "/" "_")) #t))
      (let ((dbpath (create-directory (conc "/tmp/" (current-user-name)
					    "/megatest_cachedb/"
					    (common:get-testsuite-name) "/"
					    (string-translate *toppath* "/" ".")) #t)))
	(set! *db-cache-path* dbpath)
	dbpath)))

;;======================================================================
;; E X I T   H A N D L I N G
;;======================================================================

(define (common:legacy-sync-recommended)
  (or (args:get-arg "-runtests")
︙

Modified dashboard-tests.scm from [2a1074e05f] to [e8603abab6].

︙
156
157
158
159
160
161
162
163

164
165
166
167
168
169
170

156
157
158
159
160
161
162

163
164
165
166
167
168
169
170








-
+










;;======================================================================
;; Run info panel
;;======================================================================
(define (run-info-panel db keydat testdat runname)
  (let* ((run-id     (db:test-get-run_id testdat))
	 (rundat     (db:get-run-info db run-id))
	 (rundat     (rmt:get-run-info run-id))
	 (header     (db:get-header rundat))
	 (event_time (db:get-value-by-header (db:get-rows rundat)
					     (db:get-header rundat)
					     "event_time")))
    (iup:frame 
     #:title "Megatest Run Info" ; #:expand "YES"
     (iup:hbox ; #:expand "YES"
︙
414
415
416
417
418
419
420
421
422


423
424
425
426
427
428
429

414
415
416
417
418
419
420


421
422
423
424
425
426
427
428
429








-
-
+
+










;;======================================================================
;;
;;======================================================================
(define (dashboard-tests:examine-test run-id test-id) ;; run-id run-key origtest)
  (let* ((db-path       (db:dbfile-path run-id)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/db/" run-id ".db"))
	 (dbstruct      (make-dbr:dbstruct path:  (db:dbfile-path #f) ;; (configf:lookup *configdat* "setup" "linktree") 
					   local: #t))
	 (dbstruct      #f) ;; (make-dbr:dbstruct path:  (db:dbfile-path #f) ;; (configf:lookup *configdat* "setup" "linktree") 
			    ;;		   local: #t))
	 (testdat        (rmt:get-test-info-by-id run-id test-id)) ;; (db:get-test-info-by-id dbstruct run-id test-id))
	 (db-mod-time   0) ;; (file-modification-time db-path))
	 (last-update   0) ;; (current-seconds))
	 (request-update #t))
    (if (not testdat)
	(begin
	  (debug:print 2 *default-log-port* "ERROR: No test data found for test " test-id ", exiting")
︙

Modified dashboard.scm from [ef1ffd321d] to [3bb1b86063].

︙
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129

115
116
117
118
119
120
121

122
123
124
125
126
127
128








-








  update-mutex
  updaters 
  updating
  uidat ;; needs to move to tabdat at some time
  hide-not-hide-tabs
  )


(define (dboard:commondat-make)
  (make-dboard:commondat
   curr-tab-num:         0
   tabdats:              (make-hash-table)
   please-update:        #t
   update-mutex:         (make-mutex)
   updaters:             (make-hash-table)
︙
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046

2031
2032
2033
2034
2035
2036
2037

2038
2039
2040
2041
2042
2043
2044








-








				 (debug:catch-and-dump
				  (lambda ()
				    (mark-for-update tabdat)
				    (update-search commondat tabdat "test-name" val))
				  "make-controls")))
	 (iup:hbox
	  (iup:button "Quit"      #:action (lambda (obj)
					     ;; (if (dboard:tabdat-dblocal tabdat) (db:close-all (dboard:tabdat-dblocal tabdat)))
					     (exit))
		      #:expand "NO" #:size "40x15")
	  (iup:button "Refresh"   #:action (lambda (obj)
					     (mark-for-update tabdat))
		      #:expand "NO" #:size "40x15")
	  (iup:button "Collapse"  #:action (lambda (obj)
					     (debug:catch-and-dump
︙
2583
2584
2585
2586
2587
2588
2589
2590

2591
2592
2593
2594
2595
2596
2597

2581
2582
2583
2584
2585
2586
2587

2588
2589
2590
2591
2592
2593
2594
2595








-
+








  (handle-exceptions
   exn
   (begin
     (debug:print 0 *default-log-port* "WARNING: error in accessing databases in get-youngest-run-db-mod-time: " ((condition-property-accessor 'exn 'message) exn))
     (current-seconds)) ;; something went wrong - just print an error and return current-seconds
   (common:max (map (lambda (filen)
		     (file-modification-time filen))
		   (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db"))))))
		   (glob (conc (dboard:tabdat-dbdir tabdat) "/*.db*"))))))

(define (dashboard:monitor-changed? commondat tabdat)
  (let* ((run-update-time (current-seconds))
	 (monitor-db-path (dboard:tabdat-monitor-db-path tabdat))
	 (monitor-modtime (if (and monitor-db-path (file-exists? monitor-db-path))
			      (file-modification-time monitor-db-path)
			      -1)))
︙
3317
3318
3319
3320
3321
3322
3323
3324

3325
3326
3327
3328
3329
3330
3331

3315
3316
3317
3318
3319
3320
3321

3322
3323
3324
3325
3326
3327
3328
3329








-
+








	      (dashboard-tests:examine-test run-id test-id)
	      (begin
		(debug:print 3 *default-log-port* "INFO: tried to open test with invalid run-id,test-id. " (args:get-arg "-test"))
		(exit 1)))))
       ;; ((args:get-arg "-guimonitor")
       ;;  (gui-monitor (dboard:tabdat-dblocal tabdat)))
       (else
	(dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat)) ;; (dboard:tabdat-dblocal data)
	(dboard:commondat-uidat-set! commondat (make-dashboard-buttons commondat))
	(dboard:commondat-curr-tab-num-set! commondat 0)
	(dboard:commondat-add-updater 
	 commondat 
	 (lambda ()
	   (dashboard:runs-tab-updater commondat 1))
	 tab-num: 1)
	(iup:callback-set! *tim*
︙

Modified db.scm from [8a10ffb751] to [3ea07afb90].

︙
184
185
186
187
188
189
190
191
192
193



194
195
196
197
198
199
200

184
185
186
187
188
189
190



191
192
193
194
195
196
197
198
199
200








-
-
-
+
+
+








     (if (not (directory? dbdir))(create-directory dbdir #t)))
    (if fname
	(conc dbdir "/" fname) 
	dbdir)))

;; Returns the database location as specified in config file
;;
(define (db:get-dbdir)
  (or (configf:lookup *configdat* "setup" "dbdir")
      (conc (configf:lookup *configdat* "setup" "linktree") "/.db")))
(define db:get-dbdir common:get-db-tmp-area)
;;  (or (configf:lookup *configdat* "setup" "dbdir")
;;      (conc (configf:lookup *configdat* "setup" "linktree") "/.db")))
	       
(define (db:set-sync db)
  (let ((syncprag (configf:lookup *configdat* "setup" "sychronous")))
    (sqlite3:execute db (conc "PRAGMA synchronous = " (or syncprag 1) ";")))) 

;; open an sql database inside a file lock
;; returns: db existed-prior-to-opening
︙

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