Megatest

Check-in [83714e16c5]
Login
Overview
Comment:fixed portlogger - there was installed module colliding. moved few more things around and getting close
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-real-new-runs-view-wip2
Files: files | file ages | folders
SHA1: 83714e16c515760f0d225e646694293fc5c59da2
User & Date: matt on 2021-02-24 23:28:13
Other Links: branch diff | manifest | tags
Context
2021-02-25
22:36
Merged some portlogger and module refactoring changes. check-in: b7a7d741be user: matt tags: v1.65-real-new-runs-view
2021-02-24
23:28
fixed portlogger - there was installed module colliding. moved few more things around and getting close Closed-Leaf check-in: 83714e16c5 user: matt tags: v1.65-real-new-runs-view-wip2
23:01
Can't get portlogger to show up in transport. check-in: bddb808811 user: matt tags: v1.65-real-new-runs-view-wip2
Changes

Modified common.scm from [e104413238] to [8132d96410].

387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
387
388
389
390
391
392
393












394
395
396
397
398
399
400







-
-
-
-
-
-
-
-
-
-
-
-







      (debug:print-info 0 *default-log-port* "testpatt defined in "testpatt-key" from runconfigs: " rtestpatt)
      rtestpatt)
     (else 
      (debug:print-info 0 *default-log-port* "using testpatt " args-testpatt " rtestpatt:" rtestpatt)
      args-testpatt))))

;;======================================================================
(define (common:get-linktree)
  (or (getenv "MT_LINKTREE")
      (if *configdat*
	  (configf:lookup *configdat* "setup" "linktree")
	  #f)
      (if (or *toppath* (getenv "MT_RUN_AREA_HOME"))
	  (conc (or *toppath* (getenv "MT_RUN_AREA_HOME")) "/lt")
	  #f)
      (let* ((tp (common:get-toppath #f))
	     (lt (conc tp "/lt")))
	(if (not tp)(debug:print 0 *default-log-port* "WARNING: cannot calculate best path for linktree, using " lt))
	lt)))

(define (common:args-get-runname)
  (let ((res (or (args:get-arg "-runname")
		 (args:get-arg ":runname")
		 (getenv "MT_RUNNAME"))))
    ;; (if res (set-environment-variable "MT_RUNNAME" res)) ;; not sure if this is a good idea. side effect and all ...
    res))

Modified commonmod.scm from [729100655f] to [77ecf25b1f].

677
678
679
680
681
682
683

684
685
686
687
688
689
690
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691







+







;; (define keys:config-get-fields common:get-fields)

(define (common:get-area-path-signature)
  (message-digest-string (md5-primitive) *toppath*))

(define (common:get-signature str)
  (message-digest-string (md5-primitive) str))


;;======================================================================
;; S Y S T E M   S T U F F
;;======================================================================

;;======================================================================
;; lazy-safe get file mod time. on any error (file not existing etc.) return 0

Modified configfmod.scm from [16f9252379] to [9611c6d0e2].

49
50
51
52
53
54
55













56
57
58
59
60
61
62
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75







+
+
+
+
+
+
+
+
+
+
+
+
+







 )

(import commonmod)

;;======================================================================
;; move debug stuff to separate module then put these back where they belong
;;======================================================================

(define (common:get-linktree)
  (or (getenv "MT_LINKTREE")
      (if *configdat*
	  (configf:lookup *configdat* "setup" "linktree")
	  #f)
      (if (or *toppath* (getenv "MT_RUN_AREA_HOME"))
	  (conc (or *toppath* (getenv "MT_RUN_AREA_HOME")) "/lt")
	  #f)
      (let* ((tp (common:get-toppath #f))
	     (lt (conc tp "/lt")))
	(if (not tp)(debug:print 0 *default-log-port* "WARNING: cannot calculate best path for linktree, using " lt))
	lt)))

(define (common:get-testsuite-name)
  (or (configf:lookup *configdat* "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
      (configf:lookup *configdat* "setup" "testsuite" )
      (getenv "MT_TESTSUITE_NAME")
      (pathname-file (or (if (string? *toppath* )
			     (pathname-file *toppath*)

Modified transport.scm from [49215ea3a2] to [8a03c7ec77].

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







+




+
+


-
-



-







;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit transport))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses portlogger))

(module transport
	*
	
(import scheme chicken data-structures extras ports)

(import commonmod)
(import configfmod)
(declare (uses portlogger))
(declare (uses portlogger.import))

(import portlogger)

(import scheme chicken data-structures extras ports)
(import
  (prefix base64 base64:)
  (prefix sqlite3 sqlite3:)
  call-with-environment-variables
  csv
  csv-xml
  directory-utils