Megatest

Check-in [b17dd1edec]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:fix handling of setenv in configf and merge bug in db.scm
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: b17dd1edec41548beb7c02505bc6064d55453b67
User & Date: mrwellan on 2013-11-27 08:39:22
Other Links: manifest | tags
Context
2014-03-08
08:42
pulled old, lost changes forward check-in: 49464f8312 user: matt tags: trunk
2013-11-27
08:47
Merged in couple minor fixes from trunk check-in: 07ba8e0db4 user: mrwellan tags: inmem-per-run-db
08:39
fix handling of setenv in configf and merge bug in db.scm check-in: b17dd1edec user: mrwellan tags: trunk
2013-11-24
10:30
Ensure that strings passed to setenv are not junk and let user know check-in: c13908f993 user: matt tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified configf.scm from [59f66d81cc] to [90be5f0412].

︙︙
215
216
217
218
219
220
221

222
223
224
225
226
227
228
229
230
231
232
233
234

							  (loop (configf:read-line inp res allow-system) curr-section-name #f #f)))
	       (configf:key-val-pr ( x key unk1 val unk2 ) (let* ((alist   (hash-table-ref/default res curr-section-name '()))
								  (envar   (and environ-patt (string-search (regexp environ-patt) curr-section-name)))
								  (realval (if envar
									       (config:eval-string-in-environment val)
									       val)))
							     (debug:print-info 6 "read-config env setting, envar: " envar " realval: " realval " val: " val " key: " key " curr-section-name: " curr-section-name)

							     (if (and envar
								      (string? realval)
								      (not (string-search (integer->char 0) realval)))
								   ;; (debug:print-info 4 "read-config key=" key ", val=" val ", realval=" realval)
								   (setenv key realval)
								   (debug:print 0 "ERROR: bad value for setenv, key=" key ", value=" realval))							     
							     (hash-table-set! res curr-section-name 
									      (config:assoc-safe-add alist key realval))
							     (loop (configf:read-line inp res allow-system) curr-section-name key #f)))
	       (configf:key-no-val ( 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 #t))
							      (loop (configf:read-line inp res allow-system) curr-section-name key #f)))








>
|




|








215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235

							  (loop (configf:read-line inp res allow-system) curr-section-name #f #f)))
	       (configf:key-val-pr ( x key unk1 val unk2 ) (let* ((alist   (hash-table-ref/default res curr-section-name '()))
								  (envar   (and environ-patt (string-search (regexp environ-patt) curr-section-name)))
								  (realval (if envar
									       (config:eval-string-in-environment val)
									       val)))
							     (debug:print-info 6 "read-config env setting, envar: " envar " realval: " realval " val: " val " key: " key " curr-section-name: " curr-section-name)
							     (if envar
								(if (and envar
								      (string? realval)
								      (not (string-search (integer->char 0) realval)))
								   ;; (debug:print-info 4 "read-config key=" key ", val=" val ", realval=" realval)
								   (setenv key realval)
								   (debug:print 0 "ERROR: bad value for setenv, key=" key ", value=" realval)))							     
							     (hash-table-set! res curr-section-name 
									      (config:assoc-safe-add alist key realval))
							     (loop (configf:read-line inp res allow-system) curr-section-name key #f)))
	       (configf:key-no-val ( 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 #t))
							      (loop (configf:read-line inp res allow-system) curr-section-name key #f)))
︙︙

Modified db.scm from [dd4d66d695] to [4436d7e0c5].

︙︙
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772

  (if msg
      (db:general-call db 'state-status-msg (list state status msg test-id))
      (db:general-call db 'state-status     (list state status test-id))))

(define (db:roll-up-pass-fail-counts db run-id test-name item-path status)
  (if (and (not (equal? item-path ""))
	   (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP")))
      (handle-exceptions
       exn
       (begin 
	 (debug:print 0 "Problem with call to cdb:remote-run, database may be locked and read-only, waiting and trying again ...")
	 (thread-sleep! 10)
	 (apply cdb:remote-run proc db params))
       (apply cdb:client-call *runremote* 'immediate #f *default-numtries* open-run-close proc #f params))
      (begin
	(db:general-call db 'update-pass-fail-counts (list run-id test-name run-id test-name run-id test-name))
	(if (equal? status "RUNNING")
	    (db:general-call db 'top-test-set-running (list run-id test-name))
	    (db:general-call db 'top-test-set-per-pf-counts (list run-id test-name run-id test-name run-id test-name)))
	#f)
      #f))








<
<
<
<
<
<
<








1752
1753
1754
1755
1756
1757
1758







1759
1760
1761
1762
1763
1764
1765

  (if msg
      (db:general-call db 'state-status-msg (list state status msg test-id))
      (db:general-call db 'state-status     (list state status test-id))))

(define (db:roll-up-pass-fail-counts db run-id test-name item-path status)
  (if (and (not (equal? item-path ""))
	   (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP")))







      (begin
	(db:general-call db 'update-pass-fail-counts (list run-id test-name run-id test-name run-id test-name))
	(if (equal? status "RUNNING")
	    (db:general-call db 'top-test-set-running (list run-id test-name))
	    (db:general-call db 'top-test-set-per-pf-counts (list run-id test-name run-id test-name run-id test-name)))
	#f)
      #f))
︙︙

Modified tests/fullrun/config/mt_include_1.config from [8f5c4be50c] to [4c90d470ad]. 

1
2
3
4
5
6
7
8
9
10

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

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 250

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
︙︙

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