Megatest

Check-in [263e0fe253]
Login
Overview
Comment:misc needed fixes
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-tcp-inmem
Files: files | file ages | folders
SHA1: 263e0fe253d3a2102f37b0fb6493c248645bbd2d
User & Date: matt on 2023-02-19 22:01:59
Other Links: branch diff | manifest | tags
Context
2023-02-20
07:16
Removed dbmemmod.scm check-in: 74ff6cc920 user: matt tags: v1.80-tcp-inmem
2023-02-19
22:01
misc needed fixes check-in: 263e0fe253 user: matt tags: v1.80-tcp-inmem
21:23
Sync back implemented, compiles but not tested check-in: c70de6806c user: matt tags: v1.80-tcp-inmem
Changes

Modified common.scm from [bd866cb06f] to [a37f58bd5f].

2012
2013
2014
2015
2016
2017
2018


2019
2020
2021
2022
2023
2024








2025
2026
2027
2028
2029
2030
2031
2012
2013
2014
2015
2016
2017
2018
2019
2020






2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035







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







  (let loop ((start-time (current-seconds))) ;; we saw some instances of this being called before *toppath* was set. This might be an early setup race. This delay should help but it is impossible to test...
    (if (not *toppath*)
	(begin
	  (debug:print 0 *default-log-port* "ERROR: common:wait-for-homehost-load called before *toppath* set.")
	  (thread-sleep! 30)
	  (if (< (- (current-seconds) start-time) 300)
	      (loop start-time)))))
  (case (rmt:transport-mode)
    ((http)
  (let* ((hh-dat (if (common:on-homehost?) ;; if we are on the homehost then pass in #f so the calls are local.
                     #f
                     (server:choose-server *toppath* 'homehost)))
         (hh     (if hh-dat (car hh-dat) #f)))
    (common:wait-for-normalized-load maxnormload msg hh)))

     (let* ((hh-dat (if (common:on-homehost?) ;; if we are on the homehost then pass in #f so the calls are local.
			#f
			(server:choose-server *toppath* 'homehost)))
            (hh     (if hh-dat (car hh-dat) #f)))
       (common:wait-for-normalized-load maxnormload msg hh)))
    (else
     (common:wait-for-normalized-load maxnormload msg (get-host-name)))))
    
(define (common:get-num-cpus remote-host)
  (let* ((actual-host (or remote-host (get-host-name))))
    ;; hosts had better not be changing the number of cpus too often!
    (or (hash-table-ref/default *numcpus-cache* actual-host #f)
	(let* ((numcpus (or (common:get-cached-info actual-host "num-cpus" age: (+ 2592000 (random 3600)))
			    (let* ((proc   (lambda ()
					     (let loop ((numcpu 0)

Modified dashboard.scm from [4ad343f07e] to [cb10960643].

52
53
54
55
56
57
58




59
60
61
62
63
64
65
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69







+
+
+
+







(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
(include "vg_records.scm")

;; set some parameters here - these need to be put in something that can be loaded from other
;; executables such as dashboard and mtutil
;;
(include "transport-mode.scm")
(dbfile:db-init-proc db:initialize-main-db)

(define help (conc 
	      "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest version " megatest-version 
              " license GPL, Copyright (C) Matt Welland 2012-2017

Usage: dashboard [options]

Modified dcommon.scm from [2cc987e965] to [4b1e45fd47].

706
707
708
709
710
711
712

713


714
715
716
717
718
719
720
706
707
708
709
710
711
712
713

714
715
716
717
718
719
720
721
722







+
-
+
+







				     #:numcol 7
				     #:numcol-visible 7
				     #:numlin-visible 5
				     ))
	 (colnames       (list "Id" "MTver" "Pid" "Host" "Interface:OutPort" "RunTime" "State" "RunId"))
	 (updater        (lambda ()
			   (if (dashboard:monitor-changed? commondat tabdat)
			       (let ((servers  (case (rmt:transport-mode)
			       (let ((servers  (server:choose-server *toppath* 'all-valid))) ;; (server:get-list *toppath* limit: 10)))
						 ((http)(server:choose-server *toppath* 'all-valid)) ;; (server:get-list *toppath* limit: 10)))
						 (else '()))))
				 (iup:attribute-set! servers-matrix "NUMLIN" (length servers))
				 ;; (set! colnum 0)
				 ;; (for-each (lambda (colname)
				 ;;    	 ;; (print "colnum: " colnum " colname: " colname)
				 ;;    	 (iup:attribute-set! servers-matrix (conc "0:" colnum) colname)
				 ;;    	 (set! colnum (+ 1 colnum)))
				 ;;           colnames)

Modified launch.scm from [0850c0d580] to [c865f0bf0e].

1582
1583
1584
1585
1586
1587
1588
1589

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

1589
1590
1591
1592
1593
1594
1595
1596







-
+







			   (write (list (list 'testpath  test-path)
					;; (list 'transport (conc *transport-type*))
					;; (list 'serverinf *server-info*)
					#;(list 'homehost  (let* ((hhdat (server:get-homehost)))
							   (if hhdat
							       (car hhdat)
							       #f)))
					(list 'serverurl (if *runremote*
					#;(list 'serverurl (if *runremote* ;; would like to add this back ... WORK NEEDED
							     (remote-server-url *runremote*)
							     #f)) ;;
					(list 'areaname  (common:get-testsuite-name))
					(list 'toppath   *toppath*)
					(list 'work-area work-area)
					(list 'test-name test-name) 
					(list 'runscript runscript) 

Modified megatest.scm from [01ee6eb469] to [c6e54a8bd6].

88
89
90
91
92
93
94
95



96
97
98
99
100
101
102
88
89
90
91
92
93
94

95
96
97
98
99
100
101
102
103
104







-
+
+
+







(use sparse-vectors)

(require-library mutils)

(define *usage-log-file* #f)    ;; put path to file for logging usage in this var in the ~/.megatestrc file
(define *usage-use-seconds* #t) ;; for Epoc seconds in usage logging change this to #t in ~/.megatestrc file

;; set some parameters here
;; set some parameters here - these need to be put in something that can be loaded from other
;; executables such as dashboard and mtutil
;;
(include "transport-mode.scm")
(dbfile:db-init-proc db:initialize-main-db)

;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
;;
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
  (if (common:file-exists? debugcontrolf)