Megatest

Check-in [8dc37784e2]
Login
Overview
Comment:Added path to megatest executable to PATH in the setup-for-run call. Added filters for envvars and ability to override a specific variable

Do not merge this in until it is bug free! Problem with env vars?

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | path-and-envvars-fix
Files: files | file ages | folders
SHA1: 8dc37784e215e9be0d2503d57f68814fc3721ee6
User & Date: mrwellan on 2012-05-25 15:09:44
Original Comment: Added path to megatest executable to PATH in the setup-for-run call. Added filters for envvars and ability to override a specific variable
Other Links: branch diff | manifest | tags
Context
2012-05-25
15:39
Merged v1.44 changes into path-and-envvars-fix branch check-in: 0679eecf71 user: fdk71adm tags: path-and-envvars-fix
15:09
Added path to megatest executable to PATH in the setup-for-run call. Added filters for envvars and ability to override a specific variable

Do not merge this in until it is bug free! Problem with env vars? check-in: 8dc37784e2 user: mrwellan tags: path-and-envvars-fix

2012-05-04
10:47
Added MT_TARGET check-in: 1c1e1205c5 user: mrwellan tags: trunk
Changes

Modified common.scm from [7138a29341] to [955623f7b1].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.
;;======================================================================

(use sqlite3 srfi-1 posix regex-case base64 format dot-locking csv-xml)
(require-extension sqlite3 regex posix)

(require-extension (srfi 18) extras tcp rpc)

(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.
;;======================================================================

(use sqlite3 srfi-1 posix regex-case base64 format dot-locking csv-xml posix-extras)
(require-extension sqlite3 regex posix)

(require-extension (srfi 18) extras tcp rpc)

(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))

108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124


125
126
127
128
129

130
131



132




133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
	 (cpu-load #f))
    (for-each (lambda (l)
		(let ((match (string-search load-rx l)))
		  (if match
		      (let ((newval (string->number (cadr match))))
			(if (number? newval)
			    (set! cpu-load newval))))))
	      (car load-res))
    cpu-load))

(define (get-uname . params)
  (let* ((uname-res (cmd-run->list (conc "uname " (if (null? params) "-a" (car params)))))
	 (uname #f))
    (if (null? (car uname-res))
	"unknown"
	(caar uname-res))))
	      


(define (save-environment-as-files fname)
  (let ((envvars (get-environment-variables))
        (whitesp (regexp "[^a-zA-Z0-9_\\-:;,.\\/%$]")))
     (with-output-to-file (conc fname ".csh")
       (lambda ()

          (for-each (lambda (key)
                      (let* ((val (cdr key))



                             (sval (if (string-search whitesp val)(conc "\"" val "\"") val)))




                        (print "setenv " (car key) " " sval)))
                     envvars)))
     (with-output-to-file (conc fname ".sh")
       (lambda ()
          (for-each (lambda (key)
                      (let* ((val (cdr key))
                             (sval (if (string-search whitesp val)(conc "\"" val "\"") val)))
                         (print "export " (car key) "=" sval)))
                    envvars)))))

;; set some env vars from an alist, return an alist with original values
;; (("VAR" "value") ...)
(define (alist->env-vars lst)
  (if (list? lst)
      (let ((res '()))
	(for-each (lambda (p)







|









>
>
|

|
|
<
>
|
|
>
>
>
|
>
>
>
>
|
<
|
|
<
<
<
|
|







108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130

131
132
133
134
135
136
137
138
139
140
141
142

143
144



145
146
147
148
149
150
151
152
153
	 (cpu-load #f))
    (for-each (lambda (l)
		(let ((match (string-search load-rx l)))
		  (if match
		      (let ((newval (string->number (cadr match))))
			(if (number? newval)
			    (set! cpu-load newval))))))
              (car load-res))
    cpu-load))

(define (get-uname . params)
  (let* ((uname-res (cmd-run->list (conc "uname " (if (null? params) "-a" (car params)))))
	 (uname #f))
    (if (null? (car uname-res))
	"unknown"
	(caar uname-res))))
	      
;; filter is a list of vars to not save
;; override is an alist of vars value pairs to override
(define (save-environment-as-files fname #!key (flst '())(overrides '()))
  (let ((envvars (get-environment-variables))
        (whitesp (regexp "[^a-zA-Z0-9_\\-:;,.\\/%$]"))
	(cshport (open-output-file (conc fname ".csh")))

	(bshport (open-output-file (conc fname ".sh"))))
    (for-each (lambda (key)
		(let* ((val (cdr key))
		       (var (car key))
		       (sval (if (assoc var overrides)
				 (cadr (assoc var overrides))
				 (if (string-search whitesp val)(conc "\"" val "\"") val))))
		  (if (not (member var flst))
		      (begin
			(with-output-to-port cshport
			  (lambda ()
			    (print "setenv " (car key) " " sval)))

			(with-output-to-port bshport
			  (lambda ()



			    (print "export " (car key) "=" sval)))))))
	      envvars)))

;; set some env vars from an alist, return an alist with original values
;; (("VAR" "value") ...)
(define (alist->env-vars lst)
  (if (list? lst)
      (let ((res '()))
	(for-each (lambda (p)

Modified launch.scm from [ec07a7aa76] to [30a42f8695].

102
103
104
105
106
107
108
109




110
111
112
113
114
115
116
	  (set-megatest-env-vars db run-id) ;; these may be needed by the launching process
	  (change-directory work-area) 
	  (set-run-config-vars db run-id)
	  ;; environment overrides are done *before* the remaining critical envars.
	  (alist->env-vars env-ovrd)
	  (set-megatest-env-vars db run-id)
	  (set-item-env-vars itemdat)
	  (save-environment-as-files "megatest")




	  (test-set-meta-info db run-id test-name itemdat)
	  (test-set-status! db test-id "REMOTEHOSTSTART" "n/a" (args:get-arg "-m") #f)
	  (if (args:get-arg "-xterm")
	      (set! fullrunscript "xterm")
	      (if (and fullrunscript (not (file-execute-access? fullrunscript)))
		  (system (conc "chmod ug+x " fullrunscript))))
	  ;; We are about to actually kick off the test







|
>
>
>
>







102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
	  (set-megatest-env-vars db run-id) ;; these may be needed by the launching process
	  (change-directory work-area) 
	  (set-run-config-vars db run-id)
	  ;; environment overrides are done *before* the remaining critical envars.
	  (alist->env-vars env-ovrd)
	  (set-megatest-env-vars db run-id)
	  (set-item-env-vars itemdat)
	  (save-environment-as-files "megatest" 
				     flst:      '("DISPLAY")
				     overrides: (if (config-lookup *configdat* "setup" "homedir")
						    (list (list "HOME" (config-lookup *configdat* "setup" "homedir"))
						    (list (list "HOME" work-area)))))
	  (test-set-meta-info db run-id test-name itemdat)
	  (test-set-status! db test-id "REMOTEHOSTSTART" "n/a" (args:get-arg "-m") #f)
	  (if (args:get-arg "-xterm")
	      (set! fullrunscript "xterm")
	      (if (and fullrunscript (not (file-execute-access? fullrunscript)))
		  (system (conc "chmod ug+x " fullrunscript))))
	  ;; We are about to actually kick off the test
352
353
354
355
356
357
358







359
360
361
362
363
364
365
  ;; pass on that idea for now.
  (set! *configinfo* (find-and-read-config (if (args:get-arg "-config")(args:get-arg "-config") "megatest.config") environ-patt: "env-override"))
  (set! *configdat*  (if (car *configinfo*)(car *configinfo*) #f))
  (set! *toppath*    (if (car *configinfo*)(cadr *configinfo*) #f))
  (if *toppath*
      (setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated
      (debug:print 0 "ERROR: failed to find the top path to your run setup."))







  *toppath*)

(define (get-best-disk confdat)
  (let* ((disks    (hash-table-ref/default confdat "disks" #f))
	 (best     #f)
	 (bestsize 0))
    (if disks 







>
>
>
>
>
>
>







356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
  ;; pass on that idea for now.
  (set! *configinfo* (find-and-read-config (if (args:get-arg "-config")(args:get-arg "-config") "megatest.config") environ-patt: "env-override"))
  (set! *configdat*  (if (car *configinfo*)(car *configinfo*) #f))
  (set! *toppath*    (if (car *configinfo*)(cadr *configinfo*) #f))
  (if *toppath*
      (setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated
      (debug:print 0 "ERROR: failed to find the top path to your run setup."))
  ;; here we extract the path to the megatest executable and append it to the path
  (let ((path (pathname-directory (car (argv)))))
    (if path
	(setenv "PATH" (conc
			(get-environment-variable "PATH")
			":"
			(posix-extras#resolve-pathname path)))))
  *toppath*)

(define (get-best-disk confdat)
  (let* ((disks    (hash-table-ref/default confdat "disks" #f))
	 (best     #f)
	 (bestsize 0))
    (if disks 

Modified tests/fullrun/config/mt_include_1.config from [5e42faa87c] to [28b4e77d2c].

1
2
3
4




5
6
7
8
9
10
11
[setup]
# exectutable /path/to/megatest
max_concurrent_jobs 200
linktree /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
# workhosts localhost hermes
launcher nbfake




>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
[setup]
# exectutable /path/to/megatest
max_concurrent_jobs 200
linktree /tmp/mt_links
# homedir overrides the $HOME environment variable. 
# if unset $HOME is set to the test run dir ($MT_TEST_RUN_DIR)
# use #{getenv HOME} to use the normal Unix home
# homedir #{getenv HOME}

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