Megatest

Check-in [4722dc82a1]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Added exit code check to [system ...] calls in config processing. Fixed xterm launching in dashboard
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 4722dc82a158e4a0ad03dfcf57d0abd07c709e31
User & Date: mrwellan on 2011-06-13 22:16:50
Other Links: manifest | tags
Context
2011-06-14
23:04
Added filters on test and items to dashboard. Not even close to having real scrolling but it'll have to do for now check-in: a76b6398d6 user: mrwellan tags: trunk
2011-06-13
22:16
Added exit code check to [system ...] calls in config processing. Fixed xterm launching in dashboard check-in: 4722dc82a1 user: mrwellan tags: trunk
2011-06-07
00:48
Added testname to popup edit window title check-in: ffaa4fa4b2 user: mrwellan tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified Makefile from [65424085b1] to [882324e3f3]. 

1
2
3
4
5
6

7
8
9
10
11
12
13

1
2
3
4
5

6
7
8
9
10
11
12
13






-
+








FILES=$(glob *.scm)

megatest: common.scm configf.scm db.scm keys.scm launch.scm megatest.scm process.scm runs.scm gui.scm
	csc megatest.scm 

dashboard: megatest
dashboard: megatest dashboard.scm 
	csc dashboard.scm

$(PREFIX)/bin/megatest : megatest
	@echo Installing to PREFIX=$(PREFIX), use ^C to cancel and change
	sleep 5
	cp megatest $(PREFIX)/bin/megatest
︙

Modified configf.scm from [55fe90e96b] to [dcdd50d791].

︙
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

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








-
+
+
+
+
+
+
+












-
+








	       (comment-rx _                  (loop (read-line inp) curr-section-name))
	       (blank-l-rx _                  (loop (read-line inp) curr-section-name))
	       (include-rx ( x include-file ) (begin
						(read-config include-file res)
						(loop (read-line inp) curr-section-name)))
	       (section-rx ( x section-name ) (loop (read-line inp) section-name))
	       (key-sys-pr ( x key cmd      ) (let ((alist (hash-table-ref/default res curr-section-name '()))
						    (val   (let ((res (car (cmd-run->list cmd))))
						    (val   (let* ((cmdres  (cmd-run->list cmd))
								  (status  (cadr cmdres))
								  (res     (car  cmdres)))
							     (if (not (eq? status 0))
								 (begin
								   (print "ERROR: problem with " inl ", return code not 0")
								   (exit 1)))
							     (if (null? res)
								 ""
								 (string-intersperse res " ")))))
						(hash-table-set! res curr-section-name 
								 (config:assoc-safe-add alist key val))
								 ;; (append alist (list (list key val))))
						(loop (read-line inp) curr-section-name)))
	       (key-val-pr ( x key val      ) (let ((alist (hash-table-ref/default res curr-section-name '())))
						(hash-table-set! res curr-section-name 
								 (config:assoc-safe-add alist key val))
								 ;; (append alist (list (list key val))))
						(loop (read-line inp) curr-section-name)))
	       (else (print "ERROR: Should not get here,\n   \"" inl "\"")
	       (else (print "ERROR: problem parsing " path ",\n   \"" inl "\"")
		     (loop (read-line inp) curr-section-name))))))))
  
(define (find-and-read-config fname)
  (let* ((curr-dir   (current-directory))
         (configinfo (find-config fname))
	 (toppath    (car configinfo))
	 (configfile (cadr configinfo)))
︙

Modified dashboard.scm from [021a9fd27c] to [377ac3812f].

︙
103
104
105
106
107
108
109



110


111
112
113
114
115
116
117

103
104
105
106
107
108
109
110
111
112

113
114
115
116
117
118
119
120
121








+
+
+
-
+
+








	       (logfile      (conc (db:test-get-rundir test) "/" (db:test-get-final_logf test)))
	       (viewlog      (lambda (x)
			       (if (file-exists? logfile)
				   (system (conc "firefox " logfile "&"))
				   (message-window (conc "File " logfile " not found")))))
	       (xterm        (lambda (x)
			       (if (directory-exists? rundir)
				   (let ((shell (if (get-environment-variable "SHELL") 
						    (conc "-e " (get-environment-variable "SHELL"))
						    "")))
				   (system (conc "cd " rundir ";xterm -T " (string-translate testfullname "()" "  ") "&"))
				     (system (conc "cd " rundir 
						   ";xterm -T \"" (string-translate testfullname "()" "  ") "\" " shell "&")))
				   (message-window  (conc "Directory " rundir " not found")))))
	       (newstatus    currstatus)
	       (newstate     currstate)
	       (self         #f))
	  
	  ;;  (test-set-status! db run-id test-name state status itemdat)
	  (set! self
︙

This page was generated in about 0.112s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00