Megatest

Diff
Login

Differences From Artifact [5100c657f0]:

To Artifact [4d77696a14]:


48
49
50
51
52
53
54







55





56














57
58
59
60
61
62
63
     typed-records
     z3)

(import stml2
	)

(module commonmod







	*




















(import scheme)
(cond-expand
 (chicken-4
  
  (import chicken
	  ports
	  (prefix base64 base64:)







>
>
>
>
>
>
>
|
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>







48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
     typed-records
     z3)

(import stml2
	)

(module commonmod
	(
	 common:get-toppath
	 common:generic-ssh
	 common:file-exists?
	 common:with-env-vars
	 common:nice-path
	 common:get-fields

	 ;; globals
	 *configdat*
	 *db-access-allowed*
	 *db-cache-path*
	 *toppath*
	 
	 keys:target-set-args

	 getenv
	 setenv
	 safe-setenv

	 get-area-path-signature
	 common:simple-file-lock
	 common:low-noise-print
	 common:get-create-writeable-dir
	 common:real-path
	 val->alist
)
	
(import scheme)
(cond-expand
 (chicken-4
  
  (import chicken
	  ports
	  (prefix base64 base64:)
383
384
385
386
387
388
389

390
391
392
393
394
395
396
(define *fdb* #f)

(define *last-launch* (current-seconds)) ;; use for throttling the launch rate. Would be better to use the db and last time of a test in LAUNCHED state.

;; environment vars handy stuff from common.scm
;;
(define getenv get-environment-variable)

(define (safe-setenv key val)
  (if (or (substring-index "!" key)
	  (substring-index ":" key)  ;; variables containing : are for internal use and cannot be environment variables.
	  (substring-index "." key)) ;; periods are not allowed in environment variables
      (debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\" or starting with \"!\"")
      (if (and (string? val)
	       (string? key))







>







409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
(define *fdb* #f)

(define *last-launch* (current-seconds)) ;; use for throttling the launch rate. Would be better to use the db and last time of a test in LAUNCHED state.

;; environment vars handy stuff from common.scm
;;
(define getenv get-environment-variable)

(define (safe-setenv key val)
  (if (or (substring-index "!" key)
	  (substring-index ":" key)  ;; variables containing : are for internal use and cannot be environment variables.
	  (substring-index "." key)) ;; periods are not allowed in environment variables
      (debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\" or starting with \"!\"")
      (if (and (string? val)
	       (string? key))
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
  ;; convert string a=1; b=2; c=a silly thing; d=
  (let ((valstr (lookup cfgdat section var)))
    (if valstr
	(val->alist valstr)
	'()))) ;; should it return empty list or #f to indicate not set?


(define (get-section cfgdat section)
  (hash-table-ref/default cfgdat section '()))

(define (common:make-tmpdir-name areapath tmpadj)
  (let* ((area (pathname-file areapath))
         (dname (conc "/tmp/"(current-user-name)"/megatest_localdb/" area "/" (string-translate areapath "/" ".") tmpadj "/.mtdb")))
    (unless (directory-exists? dname)
      (create-directory dname #t))
    dname))








<
<
<







588
589
590
591
592
593
594



595
596
597
598
599
600
601
  ;; convert string a=1; b=2; c=a silly thing; d=
  (let ((valstr (lookup cfgdat section var)))
    (if valstr
	(val->alist valstr)
	'()))) ;; should it return empty list or #f to indicate not set?





(define (common:make-tmpdir-name areapath tmpadj)
  (let* ((area (pathname-file areapath))
         (dname (conc "/tmp/"(current-user-name)"/megatest_localdb/" area "/" (string-translate areapath "/" ".") tmpadj "/.mtdb")))
    (unless (directory-exists? dname)
      (create-directory dname #t))
    dname))