Megatest

Check-in [cdcc055649]
Login
Overview
Comment:Got the tree working. Oops. Forgot that node0 was not dynamic (currently)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: cdcc055649d29493a5bad80f8632f4fd3203cb0f
User & Date: mrwellan on 2015-06-23 08:10:32
Other Links: branch diff | manifest | tags
Context
2015-06-23
22:04
Added ipaddr check-in: ba0aadfa06 user: mrwellan tags: v1.60
08:10
Got the tree working. Oops. Forgot that node0 was not dynamic (currently) check-in: cdcc055649 user: mrwellan tags: v1.60
07:23
Tweaks to queuefeeder check-in: ab4676a1d6 user: mrwellan tags: v1.60
Changes

Modified multi-dboard.scm from [aca154a76d] to [0acf46cb12].

267
268
269
270
271
272
273
274

275
276
277
278
279
280
281
282
283
284
285
286
287
288
289






290
291
292
293
294
295
296
     (let* ((window-dat   (hash-table-ref *windows* window-id))
	    (areas        (data-areas     window-dat))
	    (tabs         (data-tabs      window-dat))
	    (tab-ids      (hash-table-keys tabs))
	    (current-tab  (if (null? tab-ids)
			      #f
			      (hash-table-ref tabs (car tab-ids))))
	    (current-tree (if (null? tab-ids) #f (tab-tree current-tab))))

       ;; now for each area in the window gather the data
       (for-each
	(lambda (area-name)
	  (print "Processing for area-name " area-name)
	  (let* ((area-dat (hash-table-ref areas area-name))
		 (runs     (areadat-runs   area-dat)))
	    (print "Processing " area-dat " for area-name " area-name)
	    (areadb:populate-run-info area-dat)
	    (for-each 
	     (lambda (run-id)
	       (let* ((run     (hash-table-ref runs run-id))
		      (target  (rundat-target run))
		      (runname (rundat-runname run)))
		 (if current-tree
		     (tree:add-node current-tree area-name (append (string-split target "/")(list runname))))






		 ))
	     (hash-table-keys runs))))
	(hash-table-keys areas))))
   (hash-table-keys *windows*)))

;;======================================================================
;; D A S H B O A R D   D B 







|
>














|
>
>
>
>
>
>







267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
     (let* ((window-dat   (hash-table-ref *windows* window-id))
	    (areas        (data-areas     window-dat))
	    (tabs         (data-tabs      window-dat))
	    (tab-ids      (hash-table-keys tabs))
	    (current-tab  (if (null? tab-ids)
			      #f
			      (hash-table-ref tabs (car tab-ids))))
	    (current-tree (if (null? tab-ids) #f (tab-tree current-tab)))
	    (seen-nodes   (make-hash-table)))
       ;; now for each area in the window gather the data
       (for-each
	(lambda (area-name)
	  (print "Processing for area-name " area-name)
	  (let* ((area-dat (hash-table-ref areas area-name))
		 (runs     (areadat-runs   area-dat)))
	    (print "Processing " area-dat " for area-name " area-name)
	    (areadb:populate-run-info area-dat)
	    (for-each 
	     (lambda (run-id)
	       (let* ((run     (hash-table-ref runs run-id))
		      (target  (rundat-target run))
		      (runname (rundat-runname run)))
		 (if current-tree
		     (let* ((partial-path (append (string-split target "/")(list runname)))
			    (full-path    (cons area-name partial-path)))
		       (if (not (hash-table-exists? seen-nodes full-path))
			   (begin
			     (print "INFO: Adding node " partial-path " to section " area-name)
			     (tree:add-node current-tree "Areas" full-path)
			     (hash-table-set! seen-nodes full-path #t)))))
		 ))
	     (hash-table-keys runs))))
	(hash-table-keys areas))))
   (hash-table-keys *windows*)))

;;======================================================================
;; D A S H B O A R D   D B 
342
343
344
345
346
347
348




349
350
351
352
353
354
355
;;======================================================================

;; <area> - <target - ... > - <runname> - <test> - <itempath - ...>

(define (dashboard:tree-browser data adat window-id)
  ;; (iup:split
  (let* ((tb      (iup:treebox




		   #:selection-cb
		   (lambda (obj id state)
		     ;; (print "obj: " obj ", id: " id ", state: " state)
		     (let* ((tree-path (tree:node->path obj id))
			    (area      (car tree-path))
			    (areadat-path (cdr tree-path)))
		       #f







>
>
>
>







349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
;;======================================================================

;; <area> - <target - ... > - <runname> - <test> - <itempath - ...>

(define (dashboard:tree-browser data adat window-id)
  ;; (iup:split
  (let* ((tb      (iup:treebox
		   #:value 0
		   #:title "Areas"
		   #:expand "YES"
		   #:addexpanded "NO"
		   #:selection-cb
		   (lambda (obj id state)
		     ;; (print "obj: " obj ", id: " id ", state: " state)
		     (let* ((tree-path (tree:node->path obj id))
			    (area      (car tree-path))
			    (areadat-path (cdr tree-path)))
		       #f

Modified tests/Makefile from [f77c8857a7] to [0ec8867fd3].

154
155
156
157
158
159
160
161
162
163
164
165

166
167
168
169
170
171
172
	        (cd fullrun;$(MEGATEST) -preclean -runtests priority_10_waiton_1 -target $$sys/$$fs/$$dpath :runname $(RUNNAME) &);\
	     done;done;done

test11 :
	 cd fullrun;time (for a in 1 2 3 4 5 6 7 8 9 10  1 2 3 4 5 6 7 8 9 10  1 2 3 4 5 6 7 8 9 10  1 2 3 4 5 6 7 8 9 10 ;do   (megatest -test-paths -target %/%/% > /dev/null ) & done; wait; )

build : ../*.scm
	if killall mtest -v ;then sleep 5;killall mtest -v -9;fi
	cd ..;make -j && make install
	touch build

cleanstart :

	killall mtest -v;if [ ! $$? ];then sleep 5;killall mtest -v -9;fi

minsetup : build
	mkdir -p mintest/runs mintest/links
	cd mintest;$(MEGATEST) -stop-server 0
	cd mintest;$(MEGATEST) -server - -debug $(DEBUG) > server.log 2> server.log & 
	sleep 3







<




>







154
155
156
157
158
159
160

161
162
163
164
165
166
167
168
169
170
171
172
	        (cd fullrun;$(MEGATEST) -preclean -runtests priority_10_waiton_1 -target $$sys/$$fs/$$dpath :runname $(RUNNAME) &);\
	     done;done;done

test11 :
	 cd fullrun;time (for a in 1 2 3 4 5 6 7 8 9 10  1 2 3 4 5 6 7 8 9 10  1 2 3 4 5 6 7 8 9 10  1 2 3 4 5 6 7 8 9 10 ;do   (megatest -test-paths -target %/%/% > /dev/null ) & done; wait; )

build : ../*.scm

	cd ..;make -j && make install
	touch build

cleanstart :
	if killall mtest -v ;then sleep 5;killall mtest -v -9;fi;true
	killall mtest -v;if [ ! $$? ];then sleep 5;killall mtest -v -9;fi

minsetup : build
	mkdir -p mintest/runs mintest/links
	cd mintest;$(MEGATEST) -stop-server 0
	cd mintest;$(MEGATEST) -server - -debug $(DEBUG) > server.log 2> server.log & 
	sleep 3

Modified tree.scm from [02f8628298] to [1c5a9172b0].

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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
		  (if (> depth node-depth) ;; (+ 1 node-depth))
		      #f
		      (loop hed tal depth (+ nodenum 1)))))
	    #f))))

;; top is the top node name zeroeth node VALUE=0
(define (tree:add-node obj top nodelst #!key (userdata #f))

  (if (or (not (string? (iup:attribute obj "TITLE0")))
	  (string-null? (iup:attribute obj "TITLE0")))

      (iup:attribute-set! obj "ADDBRANCH0" top))
  (cond
   ((not (equal? top (iup:attribute obj "TITLE0")))
    (print "ERROR: top name " top " doesn't match " (iup:attribute obj "TITLE0")))
   ((null? nodelst))
   (else
    (let loop ((hed      (car nodelst))
	       (tal      (cdr nodelst))
	       (depth    1)
	       (pathl    (list top)))
      ;; Because the tree dialog changes node numbers when
      ;; nodes are added or removed we must look up nodes
      ;; each and every time. 0 is the top node so default
      ;; to that.
      (let* ((newpath    (append pathl (list hed)))
	     (parentnode (tree:find-node obj pathl))
	     (nodenum    (tree:find-node obj newpath)))
	;; Add the branch under lastnode if not found
	(if (not nodenum)
	    (begin
	      (iup:attribute-set! obj (conc "ADDBRANCH" parentnode) hed)
		;; ERROR? ADDING DATA TO PARENT, DONT WE WANT IT ON CREATED NODE?
	      (if userdata
		  (iup:attribute-set! obj (conc "USERDATA"   parentnode) userdata))
	      (if (null? tal)
		  #t
		  ;; reset to top
		  (loop (car nodelst)(cdr nodelst) 1 (list top)))) 
	    (if (null? tal) ;; if null here then this path has already been added
		#t
		(loop (car tal)(cdr tal)(+ depth 1) newpath))))))))

(define (tree:node->path obj nodenum)
  (let loop ((currnode 0)
	     (path     '()))
    (let* ((node-depth (string->number (iup:attribute obj (conc "DEPTH" currnode))))
	   (node-title (iup:attribute obj (conc "TITLE" currnode)))
	   (trimpath   (if (and (not (null? path))







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

|
|
|
|
|
|
|
|
|







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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
		  (if (> depth node-depth) ;; (+ 1 node-depth))
		      #f
		      (loop hed tal depth (+ nodenum 1)))))
	    #f))))

;; top is the top node name zeroeth node VALUE=0
(define (tree:add-node obj top nodelst #!key (userdata #f))
  (let ((curr-top (iup:attribute obj "TITLE0")))
    (if (or (not (string? curr-top))
	    (string-null? curr-top)
	    (string-match "^\\s*$" curr-top))
	(iup:attribute-set! obj "ADDBRANCH0" top))
    (cond
     ((not (equal? top (iup:attribute obj "TITLE0")))
      (print "ERROR: top name " top " doesn't match " (iup:attribute obj "TITLE0")))
     ((null? nodelst))
     (else
      (let loop ((hed      (car nodelst))
		 (tal      (cdr nodelst))
		 (depth    1)
		 (pathl    (list top)))
	;; Because the tree dialog changes node numbers when
	;; nodes are added or removed we must look up nodes
	;; each and every time. 0 is the top node so default
	;; to that.
	(let* ((newpath    (append pathl (list hed)))
	       (parentnode (tree:find-node obj pathl))
	       (nodenum    (tree:find-node obj newpath)))
	  ;; Add the branch under lastnode if not found
	  (if (not nodenum)
	      (begin
		(iup:attribute-set! obj (conc "ADDBRANCH" parentnode) hed)
		;; ERROR? ADDING DATA TO PARENT, DONT WE WANT IT ON CREATED NODE?
		(if userdata
		    (iup:attribute-set! obj (conc "USERDATA"   parentnode) userdata))
		(if (null? tal)
		    #t
		    ;; reset to top
		    (loop (car nodelst)(cdr nodelst) 1 (list top)))) 
	      (if (null? tal) ;; if null here then this path has already been added
		  #t
		  (loop (car tal)(cdr tal)(+ depth 1) newpath)))))))))

(define (tree:node->path obj nodenum)
  (let loop ((currnode 0)
	     (path     '()))
    (let* ((node-depth (string->number (iup:attribute obj (conc "DEPTH" currnode))))
	   (node-title (iup:attribute obj (conc "TITLE" currnode)))
	   (trimpath   (if (and (not (null? path))