Megatest

Check-in [1c26ffbc56]
Login
Overview
Comment:Fixed typo
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.55 | v1.5502
Files: files | file ages | folders
SHA1: 1c26ffbc56ab22e5f5297906bf8ba16c1fe432ad
User & Date: mrwellan on 2013-06-08 01:22:29
Other Links: branch diff | manifest | tags
Context
2013-06-12
10:53
Create mt.scm for mt: api calls. Move all common calls to here and or wrap them here. Several fixes related to tests with large numbers of iterations. WARNING: This commit has a bug in the logic of getting runs by state and status check-in: 68082baf95 user: mrwellan tags: v1.55
2013-06-08
01:22
Fixed typo check-in: 1c26ffbc56 user: mrwellan tags: v1.55, v1.5502
00:58
Changed logic on creation of top level html file for an iterated test. The lock is only attempted to be obtained for a few seconds. Then we give up. On tests with 1000's of iterations the creation of this file over and over again was becoming a serious bottleneck check-in: d16d9de26f user: mrwellan tags: v1.55
Changes

Modified tests.scm from [7cba9866a4] to [459d3fcaed].

365
366
367
368
369
370
371
372

373
374
375
376
377
378
379
365
366
367
368
369
370
371

372
373
374
375
376
377
378
379







-
+







	;; (set! outputfilename (conc path "/" outputfilename)))
	(print "No such path: " path))
    (debug:print 4 "summarize-items with logf " logf ", outputfilename " outputfilename " and force " force)
    (if (or (equal? logf "logs/final.log")
	    (equal? logf outputfilename)
	    force)
	(begin
	  (if Onot (obtain-dot-lock outputfilename 1 5 7)) ;; retry every second for 20 seconds, call it dead after 30 seconds and steal the lock
	  (if (not (obtain-dot-lock outputfilename 1 5 7)) ;; retry every second for 20 seconds, call it dead after 30 seconds and steal the lock
	      (print "Failed to obtain lock for " outputfilename)
	      (begin
		(print "Obtained lock for " outputfilename)
		(let ((oup    (open-output-file outputfilename))
		      (counts (make-hash-table))
		      (statecounts (make-hash-table))
		      (outtxt "")
430
431
432
433
434
435
436
437

438
439
440
441
442
443
444
430
431
432
433
434
435
436

437
438
439
440
441
442
443
444







-
+







			     "<tr><td>Item</td><td>State</td><td>Status</td><td>Comment</td>"
			     outtxt "</table></body></html>")
		      (release-dot-lock outputfilename)))
		  (close-output-port oup)
		  (change-directory orig-dir)
		  ;; NB// tests:test-set-toplog! is remote internal...
		  (tests:test-set-toplog! db run-id test-name outputfilename)
		  ))))))
		  )))))))

(define (get-all-legal-tests)
  (let* ((tests  (glob (conc *toppath* "/tests/*")))
	 (res    '()))
    (debug:print-info 4 "Looking at tests " (string-intersperse tests ","))
    (for-each (lambda (testpath)
		(if (file-exists? (conc testpath "/testconfig"))