Megatest

Changes On Branch 09cc793198f52264
Login

Changes In Branch v2.0001-disallow-eof Excluding Merge-Ins

This is equivalent to a diff from de21785cce to 09cc793198

2022-02-17
12:27
Merged fork check-in: 162628b5d6 user: mrwellan tags: v2.0001
2022-02-16
10:31
Rebase forward. Closed-Leaf check-in: 09cc793198 user: mrwellan tags: v2.0001-disallow-eof
09:59
rebase of v2.0001-dashboard Closed-Leaf check-in: 235f4e077d user: mrwellan tags: v2.0001-dashboard
2022-02-15
11:30
When checking for running tests if on same host do not use ssh check-in: de21785cce user: mrwellan tags: v2.0001
2022-02-14
21:18
Speculative fix for db:get-status-from-final-status-file (untested) check-in: 0bdb58420b user: mrwellan tags: v2.0001

Modified apimod.scm from [e1bfe096ff] to [eef34f67f2].

396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411



412
413
414
415
416
417
418
396
397
398
399
400
401
402

403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420







-








+
+
+







;;
(define (api:execute-requests dbstruct cmd params)
  (let* ((start-t           (current-milliseconds))
	 ;; (readonly-mode     (dbr:dbstruct-read-only dbstruct))
	 ;; (readonly-command  (member cmd api:read-only-queries))
            ;; (writecmd-in-readonly-mode (and readonly-mode (not readonly-command)))
	 (res        (api:dispatch-cmd dbstruct cmd params)))
    
    ;; (if writecmd-in-readonly-mode
    ;; (conc "attempt to run write command "cmd" on a read-only database")

    ;; save all stats
    (let ((delta-t (- (current-milliseconds)
		      start-t)))
      (hash-table-set! *db-api-call-time* cmd
		       (cons delta-t (hash-table-ref/default *db-api-call-time* cmd '()))))
    (assert (not (eof-object? res))
	    (conc "FATAL: eof not allowed as returned value. "cmd", "params))
	    
    res))

;;     (if #f ;; writecmd-in-readonly-mode
;; 	(begin
;; 	  (vector #f res))
;; 	(begin
;;              (vector #t res))))))))

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

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
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
294
295







+
+
-
+









-
+







	 (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)
			    (let ((inp-res (read inp)))
			      (assert (not (eof-object? inp-res)) "FATAL: returning eof not allowed. "cmd", "params)
			    (string->obj (read inp))
			      (string->obj inp-res))
			    ;; (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
	     res))))))))

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

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