Megatest

Diff
Login

Differences From Artifact [9fa9e34972]:

To Artifact [b79d63c449]:


10
11
12
13
14
15
16
17














18
19
20
21
22
23


24
25
26
27


28



29
30
31
32
33
34
35
10
11
12
13
14
15
16

17
18
19
20
21
22
23
24
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







-
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
-
+
+

-
-

+
+
-
+
+
+







;; This is from the perl world, a hash of hashes is a super easy way to keep a handle on
;; lots of disparate data
;;

(module mutils
    *

  (import chicken scheme
  (import scheme

	  chicken.base
	  chicken.file
	  chicken.file.posix
	  chicken.port
	  chicken.process
	  chicken.process-context
	  chicken.random
	  chicken.condition
	  chicken.io
	  chicken.time
	  chicken.string
	  
	  ;; data-structures posix
	  srfi-1
	  ;; srfi-13
	  srfi-69
	  ports
	  extras
	  srfi-98

	  regex
	  posix
	  data-structures
	  matchable
	  sparse-vectors
	  system-information
	  )
	  
	  )


(define (mutils:hierhash-ref hh . keys)
  (if (null? keys)
      #f
      (let loop ((ht   hh)
		 (key  (car keys))
		 (tail (cdr keys)))
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
103
104
105
106
107
108
109


110
111
112
113
114
115
116







-
-







      (if (eof-object? l)
	  (reverse res)
	  (if (or (string-match comment l)
		  (string-match blank l))
	      (loop (read-line fh) res)
	      (loop (read-line fh) (cons l res)))))))

(use sparse-vectors)

;; this is a simple two dimensional sparse array

;; ONLY TWO DIMENSIONS!!! SEE ARRAY-LIB IF YOUR NEEDS ARE GREATER!!
;;
(define (mutils:make-sparse-array)
  (let ((a (make-sparse-vector)))
    (sparse-vector-set! a 0 (make-sparse-vector))
187
188
189
190
191
192
193
194
195



196
197
198
199
200
201
202
200
201
202
203
204
205
206


207
208
209
210
211
212
213
214
215
216







-
-
+
+
+







	   (apply mutils:hier-list-get @hierlist @path))))

;;======================================================================
;; Other utils
;;======================================================================

(define (check-write-create fpath)
  (and (file-write-access? fpath)
       (let ((fname (conc fpath "/.junk-" (current-seconds) "-" (random 10000))))
  (and (file-writable? fpath)
       (let ((fname (conc fpath "/.junk-" (current-seconds) "-"
			  (pseudo-random-integer 10000))))
	 ;;(print "trying to create/remove " fname)
	 (handle-exceptions
	  exn
	  #f
	  (begin
	    (with-output-to-file fname
	      (lambda ()