Megatest

Check-in [5ce7b7ae18]
Login
Overview
Comment:Add exception handler to decoder and reduce some noise
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v2.0001
Files: files | file ages | folders
SHA1: 5ce7b7ae18391f51dfd5188bf83a1106a3237541
User & Date: matt on 2022-01-20 07:35:29
Other Links: branch diff | manifest | tags
Context
2022-01-20
18:31
Remove dbmgrmod.scm as it is generated from a template. Added simple-excpetions to configf:std-imports check-in: 6697b4c75c user: mrwellan tags: v2.0001
07:35
Add exception handler to decoder and reduce some noise check-in: 5ce7b7ae18 user: matt tags: v2.0001
2022-01-19
18:58
Rewire inputs and outputs to address tcp-server stuff. check-in: c6f20213d4 user: matt tags: v2.0001
Changes

Modified runsmod.scm from [f7fd47400d] to [ad4f7727f0].

251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
;; to-soon delay, when matching event happened in less than dseconds delay wseconds
;;
(define (runs:too-soon-delay key dseconds wseconds)
  (let* ((last-time (hash-table-ref/default *too-soon-delays* key #f)))
    (if (and last-time
	     (< (- (current-seconds) last-time) dseconds))
	(begin
	  (debug:print-info 0 *default-log-port* "Whoa, slow down there ... "key" has been too recently seen.")
	  (thread-sleep! wseconds)))
    (hash-table-set! *too-soon-delays* key (current-seconds))))

(define (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs)

  ;; Take advantage of a good place to exit if running the one-pass methodology
  (if (and (> (runs:dat-can-run-more-tests-count runsdat) 20)







|







251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
;; to-soon delay, when matching event happened in less than dseconds delay wseconds
;;
(define (runs:too-soon-delay key dseconds wseconds)
  (let* ((last-time (hash-table-ref/default *too-soon-delays* key #f)))
    (if (and last-time
	     (< (- (current-seconds) last-time) dseconds))
	(begin
	  (debug:print-info 4 *default-log-port* "Whoa, slow down there ... "key" has been too recently seen.")
	  (thread-sleep! wseconds)))
    (hash-table-set! *too-soon-delays* key (current-seconds))))

(define (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs)

  ;; Take advantage of a good place to exit if running the one-pass methodology
  (if (and (> (runs:dat-can-run-more-tests-count runsdat) 20)

Modified ulex-simple/ulex.scm from [9d24cf68f8] to [db661a09b9].

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
    ((write)(with-output-to-string (lambda ()(write obj))))
    ((s11n) (with-output-to-string (lambda ()(serialize obj))))
    (else obj))) ;; rpc

(define (string->obj msg #!key (transport 'http))
  (case (serializing-method)
    ((complex)





     (if (string? msg)
         (with-input-from-string 
             (z3:decode-buffer
              (base64:base64-decode
               (string-substitute 
                (regexp "_") "=" msg #t)))
           (lambda ()(deserialize)))
         (begin
           (print "ULEX ERROR: cannot translate received data \""msg"\"")
           (print-call-chain (current-error-port))
           msg))) ;; crude reply for when things go awry
    ((write)(with-input-from-string msg (lambda ()(read))))
    ((s11n)(with-input-from-string msg (lambda ()(deserialize))))
    (else msg))) ;; rpc


;;======================================================================
;; listener







>
>
>
>
>
|
|
|
|
|
|
|
<
<
<
<







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
    ((write)(with-output-to-string (lambda ()(write obj))))
    ((s11n) (with-output-to-string (lambda ()(serialize obj))))
    (else obj))) ;; rpc

(define (string->obj msg #!key (transport 'http))
  (case (serializing-method)
    ((complex)
     (handle-exceptions
      exn
      (begin
        (print "ULEX ERROR: cannot translate received data \""msg"\"")
        (print-call-chain (current-error-port))
        msg)
      (with-input-from-string 
          (z3:decode-buffer
           (base64:base64-decode
            (string-substitute 
             (regexp "_") "=" msg #t)))
        (lambda ()(deserialize)))))




    ((write)(with-input-from-string msg (lambda ()(read))))
    ((s11n)(with-input-from-string msg (lambda ()(deserialize))))
    (else msg))) ;; rpc


;;======================================================================
;; listener
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
	 (my-host-port (and udata (udat-host-port udata)))          ;; remote will return to this
	 (isme         (equal? host-port my-host-port)) ;; calling myself?
	 ;; dat is a self-contained work block that can be sent or handled locally
	 (dat          (list my-host-port 'qrykey cmd params #;(cons (current-seconds)(current-milliseconds)))))
    (cond
     (isme (do-work udata dat)) ;; no transmission needed
     (else
      ;; (handle-exceptions ;; TODO - MAKE THIS EXCEPTION CMD SPECIFIC?
      ;;  exn
      ;;  (begin
      ;;    (print "ULEX send-receive: exn="exn)
      ;;    (message exn))
      ;;  (begin
	 ;; (mutex-lock! *send-mutex*) ;; DOESN'T SEEM TO HELP
	 (let-values (((inp oup)(tcp-connect host port)))
	   (let ((res (if (and inp oup)
			  (begin
			    (write (obj->string dat) oup)
			    ;; (write dat oup)
			    ;; (serialize dat oup)
			    (close-output-port oup)
			    (string->obj (read inp))
			    ;; (read inp)
			    ;; (deserialize inp)
			    )
			  (begin
			    (print "ERROR: send called but no receiver has been setup. Please call setup first!")
			    #f))))
	     ;; (close-output-port oup)
	     (close-input-port inp)
	     ;; (mutex-unlock! *send-mutex*) ;; DOESN'T SEEM TO HELP
	     res))))));; )) ;; res will always be 'ack unless return-method is direct

;;======================================================================
;; work queues - this is all happening on the listener side
;;======================================================================

;; move the logic to return the result somewhere else?
;;







|
|
|
|
|
|


















|







255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
	 (my-host-port (and udata (udat-host-port udata)))          ;; remote will return to this
	 (isme         (equal? host-port my-host-port)) ;; calling myself?
	 ;; dat is a self-contained work block that can be sent or handled locally
	 (dat          (list my-host-port 'qrykey cmd params #;(cons (current-seconds)(current-milliseconds)))))
    (cond
     (isme (do-work udata dat)) ;; no transmission needed
     (else
      (handle-exceptions ;; TODO - MAKE THIS EXCEPTION CMD SPECIFIC?
       exn
       (begin
         (print "ULEX send-receive: "cmd", "params", exn="exn)
         (message exn))
       (begin
	 ;; (mutex-lock! *send-mutex*) ;; DOESN'T SEEM TO HELP
	 (let-values (((inp oup)(tcp-connect host port)))
	   (let ((res (if (and inp oup)
			  (begin
			    (write (obj->string dat) oup)
			    ;; (write dat oup)
			    ;; (serialize dat oup)
			    (close-output-port oup)
			    (string->obj (read inp))
			    ;; (read inp)
			    ;; (deserialize inp)
			    )
			  (begin
			    (print "ERROR: send called but no receiver has been setup. Please call setup first!")
			    #f))))
	     ;; (close-output-port oup)
	     (close-input-port inp)
	     ;; (mutex-unlock! *send-mutex*) ;; DOESN'T SEEM TO HELP
	     res)))))))) ;; res will always be 'ack unless return-method is direct

;;======================================================================
;; work queues - this is all happening on the listener side
;;======================================================================

;; move the logic to return the result somewhere else?
;;