Megatest

Check-in [619330088c]
Login
Overview
Comment:Fixed call to runs:clear-cache with wrong arguments. Make tests:get-tests-search-path resistant to bad config data
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64
Files: files | file ages | folders
SHA1: 619330088c6c83783587e49d9b46974ef3744dcd
User & Date: matt on 2017-03-28 13:06:24
Other Links: branch diff | manifest | tags
Context
2017-03-28
14:59
Fixed several unusual crashes check-in: 51fbce80b9 user: matt tags: v1.64
13:06
Fixed call to runs:clear-cache with wrong arguments. Make tests:get-tests-search-path resistant to bad config data check-in: 619330088c user: matt tags: v1.64
11:36
Add small delay on first call to wait-on-server before trying to start a server. check-in: 723b985766 user: matt tags: v1.64
Changes

Modified megatest.scm from [1cdd8cf912] to [25aeedf27e].

531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
      (set! *didsomething* #t)))

;; handle a clean-cache request as early as possible
;;
(if (args:get-arg "-clean-cache")
    (let ((toppath  (launch:setup)))
      (set! *didsomething* #t) ;; suppress the help output.
      (runs:clean-cache (getenv "MT_TARGET")(args:get-arg "-runname" toppath))))
	  
(if (args:get-arg "-env2file")
    (begin
      (save-environment-as-files (args:get-arg "-env2file"))
      (set! *didsomething* #t)))

(if (args:get-arg "-list-disks")







|







531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
      (set! *didsomething* #t)))

;; handle a clean-cache request as early as possible
;;
(if (args:get-arg "-clean-cache")
    (let ((toppath  (launch:setup)))
      (set! *didsomething* #t) ;; suppress the help output.
      (runs:clean-cache (getenv "MT_TARGET")(args:get-arg "-runname") toppath)))
	  
(if (args:get-arg "-env2file")
    (begin
      (save-environment-as-files (args:get-arg "-env2file"))
      (set! *didsomething* #t)))

(if (args:get-arg "-list-disks")

Modified tests.scm from [4ae333f3c3] to [5b19c3cd2c].

39
40
41
42
43
44
45

46




47
48
49
50
51
52
53
;;   returns hash of testname --> fullpath
;;
(define (tests:get-all)
  (let* ((test-search-path   (tests:get-tests-search-path *configdat*)))
    (tests:get-valid-tests (make-hash-table) test-search-path)))

(define (tests:get-tests-search-path cfgdat)

  (let ((paths (map cadr (configf:get-section cfgdat "tests-paths"))))




    (filter (lambda (d)
	      (if (directory-exists? d)
		  d
		  (begin
		    (if (common:low-noise-print 60 "tests:get-tests-search-path" d)
			(debug:print 0 *default-log-port* "WARNING: problem with directory " d ", dropping it from tests path"))
		    #f)))







>
|
>
>
>
>







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
;;   returns hash of testname --> fullpath
;;
(define (tests:get-all)
  (let* ((test-search-path   (tests:get-tests-search-path *configdat*)))
    (tests:get-valid-tests (make-hash-table) test-search-path)))

(define (tests:get-tests-search-path cfgdat)
  (let ((paths (let ((section (if cfgdat
				  (configf:get-section cfgdat "tests-paths")
				  #f)))
		 (if section
		     (map cadr section)
		     '()))))
    (filter (lambda (d)
	      (if (directory-exists? d)
		  d
		  (begin
		    (if (common:low-noise-print 60 "tests:get-tests-search-path" d)
			(debug:print 0 *default-log-port* "WARNING: problem with directory " d ", dropping it from tests path"))
		    #f)))