Megatest

Check-in [2b506bbc72]
Login
Overview
Comment:Pulled in v1.66
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.66-captain-ulex
Files: files | file ages | folders
SHA1: 2b506bbc7289e1afdaf8ef1a9444faa6ef373fb7
User & Date: matt on 2020-07-28 22:41:04
Other Links: branch diff | manifest | tags
Context
2020-08-03
10:01
Sync check-in: 686c5895a7 user: mrwellan tags: v1.66-captain-ulex
2020-07-28
22:41
Pulled in v1.66 check-in: 2b506bbc72 user: matt tags: v1.66-captain-ulex
22:23
Merged v1.65 Leaf check-in: 2b412d7468 user: matt tags: v1.66
2020-07-26
14:10
Merged in latest from v1.65 check-in: 234fef7d0d user: matt tags: v1.66-captain-ulex
Changes

Modified Makefile from [4cbf1b6ba0] to [60d541cecc].

209
210
211
212
213
214
215




216
217
218
219
220
221
222

common.o : megatest.scm mofiles/commonmod.o common.scm
	csc $(CSCOPTS) -c common.scm mofiles/commonmod.o

configf.o : configf.scm mofiles/commonmod.o
	csc $(CSCOPTS) -c configf.scm mofiles/commonmod.o





$(PREFIX)/bin/.$(ARCHSTR)/bin/mtest : mtest 
	@echo Installing to PREFIX=$(PREFIX)
	$(INSTALL) mtest $(PREFIX)/bin/.$(ARCHSTR)/bin/mtest

$(PREFIX)/bin/megatest : $(PREFIX)/bin/.$(ARCHSTR)/bin/mtest utils/mk_wrapper
	utils/mk_wrapper $(PREFIX) mtest $(PREFIX)/bin/megatest
	chmod a+x $(PREFIX)/bin/megatest







>
>
>
>







209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226

common.o : megatest.scm mofiles/commonmod.o common.scm
	csc $(CSCOPTS) -c common.scm mofiles/commonmod.o

configf.o : configf.scm mofiles/commonmod.o
	csc $(CSCOPTS) -c configf.scm mofiles/commonmod.o

$(PREFIX)/bin/.$(ARCHSTR)/bin/mtest : mtest 

$(PREFIX)/bin/megatest : $(PREFIX)/bin/.$(ARCHSTR)/bin/mtest utils/mk_wrapper

$(PREFIX)/bin/.$(ARCHSTR)/bin/mtest : mtest 
	@echo Installing to PREFIX=$(PREFIX)
	$(INSTALL) mtest $(PREFIX)/bin/.$(ARCHSTR)/bin/mtest

$(PREFIX)/bin/megatest : $(PREFIX)/bin/.$(ARCHSTR)/bin/mtest utils/mk_wrapper
	utils/mk_wrapper $(PREFIX) mtest $(PREFIX)/bin/megatest
	chmod a+x $(PREFIX)/bin/megatest
341
342
343
344
345
346
347
348



349
350
351
352
353
354
355
$(MTQA_FOSSIL) :
	fossil clone https://www.kiatoa.com/fossils/megatest_qa $(MTQA_FOSSIL)

clean : 
	rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS)		\
            $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut	\
            tcmt readline-fix.scm serialize-env dboard *.o		\
            megatest-fossil-hash.* altdb.scm mofiles/*.o



	rm -rf share

#======================================================================
# Deploy section (not complete yet)
#======================================================================

# Eggs to install (straightforward ones)







|
>
>
>







345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
$(MTQA_FOSSIL) :
	fossil clone https://www.kiatoa.com/fossils/megatest_qa $(MTQA_FOSSIL)

clean : 
	rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS)		\
            $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut	\
            tcmt readline-fix.scm serialize-env dboard *.o		\
            megatest-fossil-hash.* altdb.scm mofiles/*.o                \
            mofiles/*.o vg.o cookie.o dashboard-main.o	                \
            ducttape-lib.o ftail.o mutils.o pkts.o rmtmod.o stml2.o	\
            tcmt.o
	rm -rf share

#======================================================================
# Deploy section (not complete yet)
#======================================================================

# Eggs to install (straightforward ones)

Modified NOTES from [77a2fe6f9e] to [7c075bb80d].

156
157
158
159
160
161
162




INFO: (0) Number non-cached queries 74289
INFO: (0) Average non-cached time   1055.09826488444 ms
INFO: (0) Server shutdown complete. Exiting

Start: 0 at Sun Apr 28 22:18:25 MST 2013
Max:  52 at Sun Apr 28 23:06:59 MST 2013
End:   6 at Sun Apr 28 23:47:51 MST 2013











>
>
>
>
156
157
158
159
160
161
162
163
164
165
166
INFO: (0) Number non-cached queries 74289
INFO: (0) Average non-cached time   1055.09826488444 ms
INFO: (0) Server shutdown complete. Exiting

Start: 0 at Sun Apr 28 22:18:25 MST 2013
Max:  52 at Sun Apr 28 23:06:59 MST 2013
End:   6 at Sun Apr 28 23:47:51 MST 2013

========================================================================


Modified docs/manual/megatest_manual.html from [0dce8c2d65] to [7a0b51f248].

2585
2586
2587
2588
2589
2590
2591






















2592
2593
2594
2595
2596
2597
2598

# tabled
[itemstable]
A x y
B 1 2

# Yields x/1 y/2</pre>






















</div></div>
</div>
<div class="sect2">
<h3 id="_requirements_section">Requirements section</h3>
<div class="listingblock">
<div class="title">Header</div>
<div class="content monospaced">







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620

# tabled
[itemstable]
A x y
B 1 2

# Yields x/1 y/2</pre>
</div></div>
<div class="listingblock">
<div class="title">Or use files</div>
<div class="content monospaced">
<pre>[itemopts]
slash path/to/file/with/items
# or
space path/to/file/with/items</pre>
</div></div>
<div class="listingblock">
<div class="title">File format for / delimited</div>
<div class="content monospaced">
<pre>key1/key2/key3
val1/val2/val2
...</pre>
</div></div>
<div class="listingblock">
<div class="title">File format for space delimited</div>
<div class="content monospaced">
<pre>key1 key2 key3
val1 val2 val2
...</pre>
</div></div>
</div>
<div class="sect2">
<h3 id="_requirements_section">Requirements section</h3>
<div class="listingblock">
<div class="title">Header</div>
<div class="content monospaced">

Modified docs/manual/reference.txt from [6c625c002f] to [6aa04b6eea].

322
323
324
325
326
327
328





















329
330
331
332
333
334
335
[itemstable]
A x y
B 1 2

# Yields x/1 y/2
------------------























Requirements section
~~~~~~~~~~~~~~~~~~~~

.Header
-------------------
[requirements]







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
[itemstable]
A x y
B 1 2

# Yields x/1 y/2
------------------

.Or use files
------------------
[itemopts]
slash path/to/file/with/items
# or
space path/to/file/with/items
------------------

.File format for / delimited
------------------
key1/key2/key3
val1/val2/val2
...
------------------

.File format for space delimited
------------------
key1 key2 key3
val1 val2 val2
...
------------------

Requirements section
~~~~~~~~~~~~~~~~~~~~

.Header
-------------------
[requirements]

Modified items.scm from [fd1d57a170] to [16328a4b96].

121
122
123
124
125
126
127
128















































129



130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147




148
149



150
151
152
153
154
155
(define (items:check-valid-items class item)
  (let ((valid-values (let ((s (configf:lookup *configdat* "validvalues" class)))
			(if s (string-split s) #f))))
    (if valid-values
	(if (member item valid-values)
	    item #f)
	item)))
















































(define (items:get-items-from-config tconfig)



  (let* ((have-items  (hash-table-ref/default tconfig "items"      #f))
	 (have-itable (hash-table-ref/default tconfig "itemstable" #f))
	 (items       (hash-table-ref/default tconfig "items"      '()))
	 (itemstable  (hash-table-ref/default tconfig "itemstable" '())))
    (debug:print 5 *default-log-port* "items: " items " itemstable: " itemstable)
    (set! items (map (lambda (item)
		       (if (procedure? (cadr item))
			   (list (car item)((cadr item)))  ;; evaluate the proc
			   item))
		     items))
    (set! itemstable (map (lambda (item)
			    (if (procedure? (cadr item))
				(list (car item)((cadr item)))  ;; evaluate the proc
				item))
			  itemstable))
    (if (and have-items  (null? items))     (debug:print 0 *default-log-port* "WARNING:[items] section in testconfig but no entries defined"))
    (if (and have-itable (null? itemstable))(debug:print 0 *default-log-port* "WARNNG:[itemstable] section in testconfig but no entries defined"))
    (if (or (not (null? items))(not (null? itemstable)))




	(append (item-assoc->item-list items)
		(item-table->item-list itemstable))



	'(()))))

;; (pp (item-assoc->item-list itemdat))


	








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>
|
















|
>
>
>
>

|
>
>
>






121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
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
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
(define (items:check-valid-items class item)
  (let ((valid-values (let ((s (configf:lookup *configdat* "validvalues" class)))
			(if s (string-split s) #f))))
    (if valid-values
	(if (member item valid-values)
	    item #f)
	item)))

;;  '(("k1" "k2" "k3")
;;    ("a" "b" "c")
;;    ("d" "e" "f"))
;;
;;    => '((("k1" "a")("k2" "b")("k3" "c"))
;;         (("k1" "d")("k2" "e")("k3" "f")))
;;
(define (items:first-row-intersperse data)
  (if (< (length data) 2)
      '()
      (let ((header (car data))
	    (rows   (cdr data)))
	(map (lambda (row)
	       (map list header row))
	     rows))))

;; k1/k2/k3
;; a/b/c
;; d/e/f
;;    => '(("k1" "k2" "k3")
;;         ("a" "b" "c")
;;         ("d" "e" "f"))
;;
;;    => '((("k1" "a")("k2" "b")("k3" "c"))
;;         (("k1" "d")("k2" "e")("k3" "f")))
;;
(define (items:read-items-file fname ftype) ;; 'sxml 'slash 'space 
  (if (and fname (file-exists? fname))
      (items:first-row-intersperse (case ftype
				     ((slash space)
				      (let ((splitter (case ftype
							((slash) (lambda (x)(string-split x "/")))
							(else    string-split))))
					(debug:print 0 *default-log-port* "Reading " fname " of type " ftype)
					(with-input-from-file fname
					  (lambda ()
					    (let loop ((inl (read-line))
						       (res '()))
					      (if (eof-object? inl)
						  res
						  (loop (read-line)(cons (splitter inl) res))))))))
				     ((sxml)(with-input-from-file fname read))
				     (else (debug:print 0 *default-log-port* "items file type " ftype " not recognised"))))
      (begin
	(if fname (debug:print 0 *default-log-port* "no items file " fname " found"))
	'())))

(define (items:get-items-from-config tconfig)
  (let* ((slashf      (configf:lookup tconfig "itemopts" "slash")) ;; a/b/c\nd/e/f\n ...
	 (sxmlf       (configf:lookup tconfig "itemopts" "sxml"))  ;; '(("a" "b" "c")("d" "e" "f") ...)
	 (spacef      (configf:lookup tconfig "itemopts" "space")) ;; a b c\nd e f\n ...
	 (have-items  (hash-table-ref/default tconfig "items"      #f))
	 (have-itable (hash-table-ref/default tconfig "itemstable" #f))
	 (items       (hash-table-ref/default tconfig "items"      '()))
	 (itemstable  (hash-table-ref/default tconfig "itemstable" '())))
    (debug:print 5 *default-log-port* "items: " items " itemstable: " itemstable)
    (set! items (map (lambda (item)
		       (if (procedure? (cadr item))
			   (list (car item)((cadr item)))  ;; evaluate the proc
			   item))
		     items))
    (set! itemstable (map (lambda (item)
			    (if (procedure? (cadr item))
				(list (car item)((cadr item)))  ;; evaluate the proc
				item))
			  itemstable))
    (if (and have-items  (null? items))     (debug:print 0 *default-log-port* "WARNING:[items] section in testconfig but no entries defined"))
    (if (and have-itable (null? itemstable))(debug:print 0 *default-log-port* "WARNNG:[itemstable] section in testconfig but no entries defined"))
    (if (or (not (null? items))
	    (not (null? itemstable))
	    slashf
	    sxmlf
	    spacef)
	(append (item-assoc->item-list items)
		(item-table->item-list itemstable)
		(items:read-items-file slashf 'slash)
		(items:read-items-file sxmlf  'sxml)
		(items:read-items-file spacef 'space))
	'(()))))

;; (pp (item-assoc->item-list itemdat))


	

Modified launch.scm from [5a1890aaa4] to [e3c2a4d036].

1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
    ;; level
    (if (not not-iterated) ;; i.e. iterated
	(let ((iterated-parent  (pathname-directory (conc lnkpath "/" item-path))))
	  (debug:print-info 2 *default-log-port* "Creating iterated parent " iterated-parent)
	  (handle-exceptions
	   exn
	   (begin
	     (debug:print-error 0 *default-log-port* " Failed to create directory " iterated-parent ((condition-property-accessor 'exn 'message) exn) ", exiting")
	     (exit 1))
	   (create-directory iterated-parent #t))))

    (if (symbolic-link? lnkpath) 
	(handle-exceptions
	 exn
	 (begin
	   (debug:print-error 0 *default-log-port* " Failed to remove symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", exiting")
	   (exit 1))
	 (delete-file lnkpath)))

    (if (not (or (common:file-exists? lnkpath)
		 (symbolic-link? lnkpath)))
	(handle-exceptions
	 exn
	 (begin
	   (debug:print-error 0 *default-log-port* " Failed to create symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", exiting")
	   (exit 1))
	 (create-symbolic-link toptest-path lnkpath)))
    
    ;; NB - This was not working right - some top tests are not getting the path set!!!
    ;;
    ;; Do the setting of this record after the paths are created so that the shortdir can 
    ;; be set to the real directory location. This is safer for future clean up if the link
    ;; tree is damaged or lost.







|
|






|
|







|
|







1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
    ;; level
    (if (not not-iterated) ;; i.e. iterated
	(let ((iterated-parent  (pathname-directory (conc lnkpath "/" item-path))))
	  (debug:print-info 2 *default-log-port* "Creating iterated parent " iterated-parent)
	  (handle-exceptions
	   exn
	   (begin
	     (debug:print-error 0 *default-log-port* " Failed to create directory " iterated-parent ((condition-property-accessor 'exn 'message) exn) ", continuing but link tree may be corrupted")
	     #;(exit 1))
	   (create-directory iterated-parent #t))))

    (if (symbolic-link? lnkpath) 
	(handle-exceptions
	 exn
	 (begin
	   (debug:print-error 0 *default-log-port* " Failed to remove symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", continuing but link tree may be corrupted.")
	   #;(exit 1))
	 (delete-file lnkpath)))

    (if (not (or (common:file-exists? lnkpath)
		 (symbolic-link? lnkpath)))
	(handle-exceptions
	 exn
	 (begin
	   (debug:print-error 0 *default-log-port* " Failed to create symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", continuing but link tree may be corrupted.")
	   #;(exit 1))
	 (create-symbolic-link toptest-path lnkpath)))
    
    ;; NB - This was not working right - some top tests are not getting the path set!!!
    ;;
    ;; Do the setting of this record after the paths are created so that the shortdir can 
    ;; be set to the real directory location. This is safer for future clean up if the link
    ;; tree is damaged or lost.

Modified utils/mtrunner from [726df7dae8] to [68e483031e].

24
25
26
27
28
29
30
31
  unset ${var}
done
cd $1
shift
export PATH="$1:$PATH"
shift 

"$@"







|
24
25
26
27
28
29
30
31
  unset ${var}
done
cd $1
shift
export PATH="$1:$PATH"
shift 

exec "$@"