Megatest

Check-in [db9c121e0f]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Tweaks to triggers implementation. Use caching (dangerous but necessary as performance is terrible otherwise)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.55
Files: files | file ages | folders
SHA1: db9c121e0fbf3b494393bb65c4983a2dcb9589ea
User & Date: matt on 2013-08-18 14:53:54
Other Links: branch diff | manifest | tags
Context
2013-08-18
16:01
Improved cache factors for testconfig check-in: fd11c410ee user: matt tags: v1.55
14:53
Tweaks to triggers implementation. Use caching (dangerous but necessary as performance is terrible otherwise) check-in: db9c121e0f user: matt tags: v1.55
14:53
Changed launch to useshell by default and to run in background check-in: c04fad23ea user: matt tags: v1.55
Changes
Hide Diffs Unified Diffs Show Whitespace Changes Patch

Modified db.scm from [15ceac39e1] to [2c451cc1a4].

︙︙
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596

  (cdb:client-call serverdat 'immediate #f *default-numtries* open-run-close db:roll-up-pass-fail-counts #f run-id test-name item-path status))

(define (cdb:get-test-info serverdat run-id test-name item-path)
  (cdb:client-call serverdat 'immediate #f *default-numtries* open-run-close db:get-test-info #f run-id test-name item-path))

(define (cdb:get-test-info-by-id serverdat test-id)
  (let ((test-dat (cdb:client-call serverdat 'immediate #f *default-numtries* open-run-close db:get-test-info-by-id #f test-id)))
    (hash-table-set! *test-info* test-id test-dat) ;; cached for use where up-to-date info is not needed
    test-dat))

;; db should be db open proc or #f
(define (cdb:remote-run proc db . params)
  (apply cdb:client-call *runremote* 'immediate #f *default-numtries* open-run-close proc #f params))

(define (db:test-get-logfile-info db run-id test-name)








|








1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596

  (cdb:client-call serverdat 'immediate #f *default-numtries* open-run-close db:roll-up-pass-fail-counts #f run-id test-name item-path status))

(define (cdb:get-test-info serverdat run-id test-name item-path)
  (cdb:client-call serverdat 'immediate #f *default-numtries* open-run-close db:get-test-info #f run-id test-name item-path))

(define (cdb:get-test-info-by-id serverdat test-id)
  (let ((test-dat (cdb:client-call serverdat 'immediate #f *default-numtries* open-run-close db:get-test-info-by-id #f test-id)))
    (hash-table-set! *test-info* test-id (vector (current-seconds) test-dat)) ;; cached for use where up-to-date info is not needed
    test-dat))

;; db should be db open proc or #f
(define (cdb:remote-run proc db . params)
  (apply cdb:client-call *runremote* 'immediate #f *default-numtries* open-run-close proc #f params))

(define (db:test-get-logfile-info db run-id test-name)
︙︙

Modified mt.scm from [847075e4b1] to [ff7cd2e663].

︙︙
91
92
93
94
95
96
97
98


99
100
101
102
103
104
105
106
107
108
109


110
111
112
113
114
115
116
117
118
119
120

;;======================================================================
;;  T R I G G E R S
;;======================================================================

(define (mt:process-triggers test-id newstate newstatus)
  (let* ((test-dat      (mt:lazy-get-test-info-by-id test-id))
	 (test-rundir   (db:test-get-rundir test-dat))
	 (tconfig       #f))


    (if (and (file-exists? test-rundir)
	     (directory? test-rundir))
	(begin
	  (push-directory test-rundir)
	  (set! tconfig (mt:lazy-read-test-config test-dat))
	  (pop-directory)
	  (for-each (lambda (trigger)
		      (let ((cmd  (configf:lookup tconfig "triggers" trigger))
			    (logf (conc  test-rundir "/last-trigger.log")))
			(if cmd
			    (system (conc "(" cmd " " test-id " " test-rundir " " trigger ") >> " logf " 2>&1")))))


		    (list
		     (conc newstate "/" newstatus)
		     (conc newstate "/")
		     (conc "/" newstatus)))))))
    
;;======================================================================
;;  S T A T E   A N D   S T A T U S   F O R   T E S T S 
;;======================================================================

(define (mt:roll-up-pass-fail-counts run-id test-name item-path status)
  (if (and (not (equal? item-path ""))








|
>
>










|
>
>

|
|
|








91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124

;;======================================================================
;;  T R I G G E R S
;;======================================================================

(define (mt:process-triggers test-id newstate newstatus)
  (let* ((test-dat      (mt:lazy-get-test-info-by-id test-id))
	 (test-rundir   (db:test-get-rundir test-dat))
	 (tconfig       #f)
	 (state         (if newstate  newstate  (db:test-get-state  test-dat)))
	 (status        (if newstatus newstatus (db:test-get-status test-dat))))
    (if (and (file-exists? test-rundir)
	     (directory? test-rundir))
	(begin
	  (push-directory test-rundir)
	  (set! tconfig (mt:lazy-read-test-config test-dat))
	  (pop-directory)
	  (for-each (lambda (trigger)
		      (let ((cmd  (configf:lookup tconfig "triggers" trigger))
			    (logf (conc  test-rundir "/last-trigger.log")))
			(if cmd
			    (let ((fullcmd (conc "(" cmd " " test-id " " test-rundir " " trigger ") >> " logf " 2>&1")))
			      (debug:print-info 0 "TRIGGERED on " trigger ", running command " fullcmd)
			      (process-run fullcmd)))))
		    (list
		     (conc state "/" status)
		     (conc state "/")
		     (conc "/" status)))))))
    
;;======================================================================
;;  S T A T E   A N D   S T A T U S   F O R   T E S T S 
;;======================================================================

(define (mt:roll-up-pass-fail-counts run-id test-name item-path status)
  (if (and (not (equal? item-path ""))
︙︙
138
139
140
141
142
143
144
145
146

147
148
149
150
151
152
153
154
155
156
157
158
159
160

    (if newstate   (cdb:client-call *runremote* 'set-test-state #t *default-numtries* newstate test-id))
    (if newstatus  (cdb:client-call *runremote* 'set-test-status #t *default-numtries* newstatus test-id))
    (if newcomment (cdb:client-call *runremote* 'set-test-comment #t *default-numtries* newcomment test-id))))
   (mt:process-triggers test-id newstate newstatus)
   #t)

(define (mt:lazy-get-test-info-by-id test-id)
  (let ((tdat (hash-table-ref/default *test-info* test-id #f)))
    (if tdat 

	tdat
	;; no need to update *test-info* as that is done in cdb:get-test-info-by-id
	(cdb:get-test-info-by-id *runremote* test-id))))

(define (mt:lazy-read-test-config test-dat)
  (let* ((test-id     (db:test-get-id test-dat))
	 (test-rundir (db:test-get-rundir test-dat))
	 (tconfig     (hash-table-ref/default *testconfigs* test-id #f)))
    (if tconfig 
	tconfig
	(let ((newtcfg (read-config (conc test-rundir "/testconfig") #f #f))) ;; NOTE: Does NOT run [system ...]
	  (hash-table-set! *testconfigs* test-id newtcfg)
	  newtcfg))))









|
|
>
|














142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165

    (if newstate   (cdb:client-call *runremote* 'set-test-state #t *default-numtries* newstate test-id))
    (if newstatus  (cdb:client-call *runremote* 'set-test-status #t *default-numtries* newstatus test-id))
    (if newcomment (cdb:client-call *runremote* 'set-test-comment #t *default-numtries* newcomment test-id))))
   (mt:process-triggers test-id newstate newstatus)
   #t)

(define (mt:lazy-get-test-info-by-id test-id)
  (let* ((tdat (hash-table-ref/default *test-info* test-id #f)))
    (if (and tdat 
	     (< (current-seconds)(+ (vector-ref tdat 0) 10)))
	(vector-ref tdat 1)
	;; no need to update *test-info* as that is done in cdb:get-test-info-by-id
	(cdb:get-test-info-by-id *runremote* test-id))))

(define (mt:lazy-read-test-config test-dat)
  (let* ((test-id     (db:test-get-id test-dat))
	 (test-rundir (db:test-get-rundir test-dat))
	 (tconfig     (hash-table-ref/default *testconfigs* test-id #f)))
    (if tconfig 
	tconfig
	(let ((newtcfg (read-config (conc test-rundir "/testconfig") #f #f))) ;; NOTE: Does NOT run [system ...]
	  (hash-table-set! *testconfigs* test-id newtcfg)
	  newtcfg))))

Modified tests/fdktestqa/testqa/Makefile from [0b9ed605a6] to [e13e6735ff].

︙︙
18
19
20
21
22
23
24

25
26
27
28

bigrun2 :
	$(MEGATEST) -runtests bigrun2 -target a/bigrun2 :runname a -transport http

dashboard : 
	$(DASHBOARD) -rows 20 &

compile :

	(cd ../../..;make && make install)

clean :
	rm -rf ../simple*/*/* megatest.db








>





18
19
20
21
22
23
24
25
26
27
28
29

bigrun2 :
	$(MEGATEST) -runtests bigrun2 -target a/bigrun2 :runname a -transport http

dashboard : 
	$(DASHBOARD) -rows 20 &

compile :
	$(MEGATEST) -stop-server 0
	(cd ../../..;make && make install)

clean :
	rm -rf ../simple*/*/* megatest.db

Modified tests/fullrun/config/mt_include_1.config from [a782579a4c] to [6243d15a3d]. 

1
2
3
4
5
6
7
8
9
10

[setup]
# exectutable /path/to/megatest
max_concurrent_jobs 15

linktree #{getenv MT_RUN_AREA_HOME}/tmp/mt_links

[jobtools]
useshell yes
# ## launcher launches jobs, the job is managed on the target host
## by megatest, comment out launcher to run local



|








1
2
3
4
5
6
7
8
9
10

[setup]
# exectutable /path/to/megatest
max_concurrent_jobs 25

linktree #{getenv MT_RUN_AREA_HOME}/tmp/mt_links

[jobtools]
useshell yes
# ## launcher launches jobs, the job is managed on the target host
## by megatest, comment out launcher to run local
︙︙

Modified tests/fullrun/megatest.config from [7450f4e4e1] to [ddb8ea0c45].

︙︙
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33


[setup]
# Set launchwait to no to use the more agressive code that does not wait for the launch to complete before proceeding
launchwait no

# Use http instead of direct filesystem access
transport http


# If set to "default" the old code is used. Otherwise defaults to 200 or uses
# numeric value given.
#
runqueue 20










<








19
20
21
22
23
24
25

26
27
28
29
30
31
32


[setup]
# Set launchwait to no to use the more agressive code that does not wait for the launch to complete before proceeding
launchwait no

# Use http instead of direct filesystem access
transport http


# If set to "default" the old code is used. Otherwise defaults to 200 or uses
# numeric value given.
#
runqueue 20
︙︙

tests/installall/config/megatest.config.dat became a symlink with target [736a5da885].

whitespace changes only

tests/installall/config/runconfigs.config.dat became a symlink with target [3b8f260acb].

whitespace changes only

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