Megatest

Check-in [97f137eb53]
Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v2.01-local-mtfiles | v2.01-try-1
Files: files | file ages | folders
SHA1: 97f137eb53ea1bb37d4cc3b17ffab0aa1f84e20f
User & Date: bjbarcla on 2019-01-04 20:05:04
Other Links: branch diff | manifest | tags
Context
2019-01-07
10:18
added modules.scm into Makefile dependencies; sped up config processing by changing uses to inports in dynamic configf code additions check-in: cdd8afd673 user: bjbarcla tags: v2.01-local-mtfiles, v2.01-try-1
2019-01-04
20:05
wip check-in: 97f137eb53 user: bjbarcla tags: v2.01-local-mtfiles, v2.01-try-1
2019-01-03
18:17
undid ugly (define debug:print debug:dprint) check-in: 7616160fe5 user: bjbarcla tags: v2.01-local-mtfiles, v2.01-try-1
Changes

Modified megatest.scm from [b092021a3d] to [32872ea46a].

570
571
572
573
574
575
576
577

578
579
580
581
582
583

584
585
586
587
588
589
590
570
571
572
573
574
575
576

577
578
579
580
581
582

583
584
585
586
587
588
589
590







-
+





-
+







					    (printf "Sending signal/term to ~A\n" pid)
					    (process-signal pid signal/term))))))
		       (process:children #f))
		      (original-exit exit-code)))))

;; for some switches always print the command to stderr
;;
(if (args:any? "-run" "-runall" "-remove-runs" "-set-state-status")
(if (args:any-defined? "-run" "-runall" "-remove-runs" "-set-state-status")
    (debug:print 0 *default-log-port* (string-intersperse (argv) " ")))

;; some switches imply homehost. Exit here if not on homehost
;;
(let ((homehost-required  (list "-cleanup-db" "-server")))
  (if (apply args:any? homehost-required)
  (if (apply args:any-defined? homehost-required)
      (if (not (common:on-homehost?))
	  (for-each
	   (lambda (switch)
	     (if (args:get-arg switch)
		 (begin
		   (debug:print 0 *default-log-port* "ERROR: you must be on the homehost to run with " switch
				", you can move homehost by removing the .homehost file but this will disrupt any runs in progress.")

Modified modules.scm from [5e6618e242] to [c6074c6fe9].

14
15
16
17
18
19
20
21

22
23
24
25
26
27
28








29






30



14
15
16
17
18
19
20

21
22
23





24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42







-
+


-
-
-
-
-
+
+
+
+
+
+
+
+

+
+
+
+
+
+

+
+
+
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;======================================================================

(use (prefix mtargs    args:))
(use (prefix mtdebug   debug:))
(use mtdebug)
(use (prefix mtconfigf configf:))

(print "BB> called once")
(configf:add-eval-string "(use (prefix mtargs    args:))
                          (use (prefix mtdebug   debug:))
                          (use (prefix mtconfigf configf:))")

;; configure mtdebug  ;; TODO: move to megatest.scm with other command line arg processing
(if (args:get-arg "-v")     (debug:set-verbose-mode))
(if (args:get-arg "-q")     (debug:set-quiet-mode))
(if (args:get-arg "-debug") (debug:set-debug-mode))
(if (args:get-arg "-color")
    (case (string->symbol (args:get-arg "-color"))
      ((y Y yes YES t T) (debug:force-color))
      ((n N no NO f F)   (debug:suppress-color))))

;; configure mtconfigf
(let* ((normal-fn debug:print)
       (info-fn   debug:print-info)
       (error-fn  debug:print-error)
       (default-port *default-log-port*))
  (set-debug-printers normal-fn info-fn error-fn default-port))

(configf:add-eval-string "(use (prefix mtargs    args:))
                          (use mtdebug)
                          (use (prefix mtconfigf configf:))")

Modified mtut.scm from [728214218f] to [e6768aeeb6].

473
474
475
476
477
478
479
480

481
482
483
484
485
486
487
473
474
475
476
477
478
479

480
481
482
483
484
485
486
487







-
+







	       (args:get-arg "-envcap")
	       (args:get-arg "-envdelta")
	       (member *action* '("db" "tsend" "tlisten"))   ;; very loose checks on db and tsend/listen
	       (equal? *action* "show")    ;; just keep going if list
	       )))
    (debug:print-error 0 *default-log-port* "Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv))  " ")))

(if (or (args:any? "-h" "help" "-help" "--help")
(if (or (args:any-defined? "-h" "help" "-help" "--help")
	(member *action* '("-h" "-help" "--help" "help")))
    (begin
      (print help)
      (exit 1)))

;;======================================================================
;; Nanomsg transport