Megatest

Check-in [99551309fa]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Added funky debug stuff
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-wip
Files: files | file ages | folders
SHA1: 99551309fa5760491b267e1754c2ee79a9c31c6f
User & Date: matt on 2019-10-02 23:41:07
Other Links: branch diff | manifest | tags
Context
2019-10-03
00:02
Removed some of the member:print debug stuff check-in: 9b6c3193e6 user: matt tags: v1.65-wip
2019-10-02
23:41
Added funky debug stuff check-in: 99551309fa user: matt tags: v1.65-wip
17:46
Remove muffs from *toppath* in calc-ro-mode. Added trace to rmtmod.scm while debugging. check-in: dc7ab217fe user: mrwellan tags: v1.65-wip
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified rmt.scm from [a8b59bdcdd] to [1ddc5e0c53].

︙
24
25
26
27
28
29
30



31
32
33
34
35
36
37

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








+
+
+








(declare (uses api))
(declare (uses http-transport))
(include "common_records.scm")
(declare (uses rmtmod))

(import rmtmod)

(define (member:print msg x lst)
  (print "member: " msg " x=" x " lst=" lst)
  (member x lst))

;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;

;; generate entries for ~/.megatestrc with the following
;;
︙
67
68
69
70
71
72
73
74

75
76
77
78
79
80
81

70
71
72
73
74
75
76

77
78
79
80
81
82
83
84








-
+








			    *runremote*)))
    ;; ensure we have a record for our connection for given area
    (if (not runremote)                   ;; can remove this one. should never get here.         
	(begin
	  (set! *runremote* (make-remote))
	  (set! runremote   *runremote*))) ;; new runremote will come from this on next iteration
    
    (if (member cmd '(blah))
    (if (member:print "#2" cmd '(blah))
      (begin
	(mutex-lock! *send-receive-mutex*)
	(if (not *runremote*)(set! *runremote* (make-remote)))
	(let ((ulex:conn (remote-ulex:conn *runremote*)))
	  (if (not ulex:conn)(remote-ulex:conn-set! *runremote* (rmtmod:setup-ulex *toppath*)))
	  (rmtmod:send-receive-ulex ulex:conn cmd rid params attemptnum area-dat)))
      (rmt:send-receive-orig *default-log-port* runremote *rmt-mutex* areapath *db-multi-sync-mutex* cmd rid params attemptnum: attemptnum area-dat: area-dat ro-queries: api:read-only-queries))))
︙
112
113
114
115
116
117
118
119

120
121
122
123
124
125
126

115
116
117
118
119
120
121

122
123
124
125
126
127
128
129








-
+








     ;; give up if more than 15 attempts
     ((> attemptnum 15)
      (debug:print 0 log-port "ERROR: 15 tries to start/connect to server. Giving up.")
      (exit 1))

     ;; readonly mode, read request-  handle it - case 2
     ((and readonly-mode
           (member cmd api:read-only-queries)) 
           (member:print "#3" cmd api:read-only-queries)) 
      ;; (mutex-unlock! rmt-mutex)
      (debug:print-info 12 log-port "rmt:send-receive, case 2")
      (rmt:open-qry-close-locally log-port multi-sync-mutex cmd 0 params ro-queries: api:read-only-queries)
      )

     ;; readonly mode, write request.  Do nothing, return #f
     (readonly-mode (extras-readonly-mode rmt-mutex log-port cmd params))
︙
141
142
143
144
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
174
175
176
177

178
179
180
181
182
183
184

144
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
174
175
176
177
178
179

180
181
182
183
184
185
186
187








-
+






-
+











-
+









-
+








      ;; (mutex-unlock! rmt-mutex)
      (rmt:send-receive-orig log-port runremote rmt-mutex toppath multi-sync-mutex cmd rid params attemptnum: attemptnum))
     

     ;; on homehost and this is a read
     ((and (not (remote-force-server runremote)) ;; honor forced use of server, i.e. server NOT required
	   (cdr (remote-hh-dat runremote))       ;; on homehost
           (member cmd api:read-only-queries))   ;; this is a read
           (member:print "#4" cmd api:read-only-queries))   ;; this is a read
      ;; (mutex-unlock! rmt-mutex)
      (debug:print-info 12 log-port "rmt:send-receive, case  5")
      (rmt:open-qry-close-locally log-port multi-sync-mutex cmd 0 params ro-queries: api:read-only-queries))

     ;; on homehost and this is a write, we already have a server, but server has died
     ((and (cdr (remote-hh-dat runremote))           ;; on homehost
           (not (member cmd api:read-only-queries))  ;; this is a write
           (not (member:print "#5" cmd api:read-only-queries))  ;; this is a write
           (remote-server-url runremote)             ;; have a server
           (not (server:ping (remote-server-url runremote))))  ;; server has died. NOTE: this is not a cheap call! Need better approach.
      (set! *runremote* (make-remote))
      (remote-force-server-set! runremote (common:force-server?))
      ;; (mutex-unlock! rmt-mutex)
      (debug:print-info 12 log-port "rmt:send-receive, case  6")
      (rmt:send-receive-orig log-port runremote rmt-mutex toppath  multi-sync-mutex cmd rid params attemptnum: attemptnum))

     ;; on homehost and this is a write, we already have a server
     ((and (not (remote-force-server runremote))     ;; honor forced use of server, i.e. server NOT required
	   (cdr (remote-hh-dat runremote))           ;; on homehost
           (not (member cmd api:read-only-queries))  ;; this is a write
           (not (member:print "#6" cmd api:read-only-queries))  ;; this is a write
           (remote-server-url runremote))            ;; have a server
      ;;(mutex-unlock! rmt-mutex)
      (debug:print-info 12 log-port "rmt:send-receive, case  4.1")
      (rmt:open-qry-close-locally  log-port multi-sync-mutex cmd 0 params ro-queries: api:read-only-queries))

     ;;  on homehost, no server contact made and this is a write, passively start a server 
     ((and (not (remote-force-server runremote))     ;; honor forced use of server, i.e. server NOT required
	   (cdr (remote-hh-dat runremote))           ;; have homehost
           (not (remote-server-url runremote))       ;; no connection yet
	   (not (member cmd api:read-only-queries))) ;; not a read-only query
	   (not (member:print "#7" cmd api:read-only-queries))) ;; not a read-only query
      (debug:print-info 12 log-port "rmt:send-receive, case  8")
      (let ((server-url  (server:check-if-running toppath))) ;; (server:read-dotserver->url toppath))) ;; (server:check-if-running toppath))) ;; Do NOT want to run server:check-if-running - very expensive to do for every write call
	(if server-url
	    (remote-server-url-set! runremote server-url) ;; the string can be consumed by the client setup if needed
	    (if (common:force-server?)
		(server:start-and-wait toppath)
		(server:kind-run toppath))))
︙
495
496
497
498
499
500
501
502

503
504
505
506
507
508
509

498
499
500
501
502
503
504

505
506
507
508
509
510
511
512








-
+








	(result      '()))
    (if (null? run-id-list)
	'()
	(let loop ((hed     (car run-id-list))
		   (tal     (cdr run-id-list))
		   (threads '()))
	  (if (> (length threads) 5)
	      (loop hed tal (filter (lambda (th)(not (member (thread-state th) '(terminated dead)))) threads))
	      (loop hed tal (filter (lambda (th)(not (member:print "#8" (thread-state th) '(terminated dead)))) threads))
	      (let* ((newthread (make-thread
				 (lambda ()
				   (let ((res (rmt:send-receive 'get-tests-for-run-mindata hed (list hed testpatt states status not-in))))
				     (if (list? res)
					 (begin
					   (mutex-lock! multi-run-mutex)
					   (set! result (append result res))
︙

Modified rmtmod.scm from [544ee0d52f] to [dc8573987a].

︙
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
54
55
56

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
54
55
56
57
58








+
+
+

















-








	*
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)
(import commonmod)
(use (prefix ulex ulex:))

(define (member:print msg x lst)
  (print "member-" msg ": x=" x " lst=" lst)
  (member x lst))

;; Hack to make these functions visible to the refactored code, goal is to eliminate these over time.
(define (rmt:send-receive . params) #f)
(define (http-transport:close-connections . params) #f)
;; from remote defstruct in common.scm
(define (remote-conndat-set! . params) #f)
(define (remote-server-url-set! . params) #f)
(define (remote-ro-mode . params) #f)
(define (remote-ro-mode-set! . params) #f)
(define (remote-ro-mode-checked-set! . params) #f)
(define (remote-ro-mode-checked . params) #f)
(define (debug:print . params) #f)
(define (debug:print-info . params) #f)
(define (debug:print-error . params) #f)
(define (db:dbfile-path . params) #f)
(define (db:setup . params) #f)
(define (api:execute-requests . params) #f)
(define (api:read-only-queries . params) #f)

(define (set-functions send-receive        rsus
		       close-connections   rcs
		       dbgp                dbgpinfo
		       dbgperr
		       ro-mode             ro-mode-set
		       ro-mode-checked-set ro-mode-checked
︙
71
72
73
74
75
76
77
78
79
80
81
82

83
84
85
86
87
88
89

73
74
75
76
77
78
79

80
81
82

83
84
85
86
87
88
89
90








-



-
+








  (set! remote-ro-mode-set!              ro-mode-set)
  (set! remote-ro-mode-checked-set!      ro-mode-checked-set)
  (set! remote-ro-mode-checked           ro-mode-checked)
  ;; db stuff for local db access
  (set! db:dbfile-path                   dbfile-path)
  (set! db:setup                         dbsetup)
  (set! apt:execute-requests             exec-req)
  (set! api:read-only-queries	         read-only-queries)
  )

(define (rmt:open-qry-close-locally log-port multi-sync-mutex cmd run-id params #!key (ro-queries '())(remretries 5))
  (let* ((qry-is-write   (not (member cmd ro-queries)))
  (let* ((qry-is-write   (not (member:print "#1" cmd ro-queries)))
	 (db-file-path   (db:dbfile-path)) ;;  0))
	 (dbstruct-local (db:setup #t))  ;; make-dbr:dbstruct path:  dbdir local: #t)))
	 (read-only      (not (file-write-access? db-file-path)))
	 (start          (current-milliseconds))
	 (resdat         (if (not (and read-only qry-is-write))
			     (let ((v (api:execute-requests dbstruct-local (vector (symbol->string cmd) params))))
			       (handle-exceptions ;; there has been a long history of receiving strange errors from values returned by the client when things go wrong..
︙
193
194
195
196
197
198
199
200

201
202

203

194
195
196
197
198
199
200

201
202

203









-
+

-
+
-




(define (rmtmod:send-receive-ulex ulex:conn cmd rid params attemptnum area-dat)
  #f)

(use trace)(trace-call-sites #t)
(trace member rmtmod:calc-ro-mode rmt:open-qry-close-locally)
(trace member rmtmod:calc-ro-mode rmt:open-qry-close-locally member:print)


)
)

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