Megatest

Diff
Login

Differences From Artifact [fe39965c84]:

To Artifact [73b38805aa]:


428
429
430
431
432
433
434
435









436
437
438
439
440
441
442
	    (print key-string)))
	(thread-sleep! 0.25)
	(if (file-exists? fname)
	    (with-input-from-file fname
	      (lambda ()
		(equal? key-string (read-line))))
	    #f))))
	









(define (common:simple-file-release-lock fname)
  (delete-file* fname))

;;======================================================================
;; S T A T E S   A N D   S T A T U S E S
;;======================================================================








|
>
>
>
>
>
>
>
>
>







428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
	    (print key-string)))
	(thread-sleep! 0.25)
	(if (file-exists? fname)
	    (with-input-from-file fname
	      (lambda ()
		(equal? key-string (read-line))))
	    #f))))

(define (common:simple-file-lock-and-wait fname #!key (expire-time 300))
  (let ((end-time (+ expire-time (current-seconds))))
    (let loop ((got-lock (common:simple-file-lock fname expire-time: expire-time)))
      (if got-lock
	  #t
	  (if (> end-time (current-seconds))
	      (loop (common:simple-file-lock fname expire-time: expire-time))
	      #f)))))

(define (common:simple-file-release-lock fname)
  (delete-file* fname))

;;======================================================================
;; S T A T E S   A N D   S T A T U S E S
;;======================================================================

1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056



1057
1058
1059
1060
1061
1062
1063
  (not (or (args:get-arg "-no-cache")
	   (and *configdat*
		(equal? (configf:lookup *configdat* "setup" "use-cache") "no")))))

;; force use of server?
;;
(define (common:force-server?)
  (let* ((force-setting (configf:lookup "server" "force"))
         (force-type    (if force-setting (string->symbol force-setting) #f)))
    (case force-type
      ((#f)     #f)
      ((always) #t)
      ((test)   (if (args:get-arg "-execute") ;; we are in a test
		    #t
		    #f)))))




;;======================================================================
;; M I S C   L I S T S
;;======================================================================

;; items in lista are matched value and position in listb
;; return the remaining items in listb or #f







|
|





|
>
>
>







1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
  (not (or (args:get-arg "-no-cache")
	   (and *configdat*
		(equal? (configf:lookup *configdat* "setup" "use-cache") "no")))))

;; force use of server?
;;
(define (common:force-server?)
  (let* ((force-setting (configf:lookup *configdat* "server" "force"))
	 (force-type    (if force-setting (string->symbol force-setting) #f)))
    (case force-type
      ((#f)     #f)
      ((always) #t)
      ((test)   (if (args:get-arg "-execute") ;; we are in a test
		    #t
		    #f))
      (else
       (debug:print 0 *default-log-port* "ERROR: Bad server force setting " force-setting ", forcing server.")
       #t)))) ;; default to requiring server 

;;======================================================================
;; M I S C   L I S T S
;;======================================================================

;; items in lista are matched value and position in listb
;; return the remaining items in listb or #f