Megatest

Check-in [0e8fa15f1d]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Use debugprint module in dbfile module as stepping stone to replacing old debug:print calls with new.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | v1.80-debugprint
Files: files | file ages | folders
SHA1: 0e8fa15f1dc53990cb86e2af2f76942e2d96d36c
User & Date: matt on 2023-02-10 20:19:49
Other Links: branch diff | manifest | tags
Context
2023-02-10
20:19
Use debugprint module in dbfile module as stepping stone to replacing old debug:print calls with new. Closed-Leaf check-in: 0e8fa15f1d user: matt tags: v1.80-debugprint
2023-02-02
12:54
Use an actual droop check-in: 19861e6399 user: matt tags: v1.80
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified dashboard.scm from [4ad343f07e] to [2a55359814].

︙
13
14
15
16
17
18
19




20
21
22
23
24
25
26

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30








+
+
+
+








;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     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/>.
;;
;;======================================================================

(declare (uses debugprint))

(import debugprint)

(use format)

(require-library iup)
(import (prefix iup iup:))

(use canvas-draw)
︙

Modified dbfile.scm from [25f8271ef2] to [cb34ff9622].

︙
15
16
17
18
19
20
21
22

23
24
25
26
27
28
29

15
16
17
18
19
20
21

22
23
24
25
26
27
28
29








-
+








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

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

(declare (unit dbfile))
;; (declare (uses debugprint))
(declare (uses debugprint))
(declare (uses commonmod))

(module dbfile
	*
	
  (import scheme
	  chicken
︙
37
38
39
40
41
42
43
44

45
46
47
48
49
50
51

37
38
39
40
41
42
43

44
45
46
47
48
49
50
51








-
+








	stack
	files
	ports

	commonmod
	)

;; (import debugprint)
(import debugprint)

;;======================================================================
;;  R E C O R D S
;;======================================================================

;; a single Megatest area with it's multiple dbs is
;; managed in a dbstruct
︙
320
321
322
323
324
325
326

327
328
329
330




331
332
333
334
335
336
337

320
321
322
323
324
325
326
327




328
329
330
331
332
333
334
335
336
337
338








+
-
-
-
-
+
+
+
+








  (with-output-to-port
      (current-error-port)
    (lambda ()
      (apply print params)))
  (exit 1))
    
(define (dbfile:print-err . params)
  (apply debug:print 0 *default-log-port* params))
  (with-output-to-port
      (current-error-port)
    (lambda ()
      (apply print params))))
;;   (with-output-to-port
;;       (current-error-port)
;;     (lambda ()
;;       (apply print params))))

(define (dbfile:cautious-open-database fname init-proc sync-mode journal-mode #!optional (tries-left 500))
  (let* ((busy-file  (conc fname "-journal"))
	 (delay-time (* (- 51 tries-left) 1.1))
      	 (write-access (file-write-access? fname))
         (dir-access (file-write-access? (pathname-directory fname)))
         (retry      (lambda ()
︙

Modified debugprint.scm from [54f7083883] to [993bf82387]. 






















1
2
3
4
5
6
7

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

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








;;======================================================================
;; Copyright 2017, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     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 srfi-69)

(declare (unit debugprint))
(declare (uses mtargs))

(module debugprint
	*
	




︙


21
22
23
24
25
26
27

28
29
30
31
32
33
34

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56








+








    ;; chicken.time.posix
    ;; chicken.port
    ;; chicken.process-context
    ;; chicken.process-context.posix
    
    (prefix mtargs args:)
    srfi-1
    srfi-69
    ;; system-information
    )
  
;;======================================================================
;; debug stuff
;;======================================================================





︙







Modified megatest.scm
from [79d9696058]
to [a2b02168c4].




︙


43
44
45
46
47
48
49
50
51
52
53




54
55
56
57
58
59
60

43
44
45
46
47
48
49




50
51
52
53
54
55
56
57
58
59
60








-
-
-
-
+
+
+
+








(declare (uses env))
(declare (uses diff-report))
(declare (uses db))
(declare (uses dbmod))
(declare (uses dbmod.import))
(declare (uses commonmod))
(declare (uses commonmod.import))
(declare (uses dbfile))
(declare (uses dbfile.import))
;; (declare (uses debugprint))
;; (declare (uses debugprint.import))
(declare (uses debugprint))
(declare (uses debugprint.import))
(declare (uses dbfile))
(declare (uses dbfile.import))
;; (declare (uses mtargs))
;; (declare (uses mtargs.import))

;; (declare (uses ftail))
;; (import ftail)

(import dbmod




︙







Modified mtargs.scm
from [1e6b59e54f]
to [bf4593d143].




︙


15
16
17
18
19
20
21
22

23

15
16
17
18
19
20
21

22
23








-
+


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

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

(declare (unit mtargs))

(use srfi-69)
(include "mtargs/mtargs.scm")








Modified rmt.scm
from [771d7d8ec4]
to [78a0a807b4].




︙


116
117
118
119
120
121
122

123
124
125
126
127
128
129

116
117
118
119
120
121
122
123
124
125
126
127
128
129
130








+








	  (set! *runremote* (make-remote))
          (let* ((server-info (remote-server-info *runremote*))) 
            (if server-info
		(begin
			(remote-server-url-set! *runremote* (server:record->url server-info))
			(remote-server-id-set! *runremote* (server:record->id server-info)))))  
	  (set! runremote   *runremote*))) ;; new runremote will come from this on next iteration
    
    
    ;; DOT SET_HOMEHOST; // leaving off - doesn't really add to the clarity
    ;; DOT MUTEXLOCK -> SET_HOMEHOST [label="no homehost?"];
    ;; DOT SET_HOMEHOST -> MUTEXLOCK;
    ;; ensure we have a homehost record
    (if (or (not (pair? (remote-hh-dat runremote)))  ;; not on homehost
	    (not (cdr (remote-hh-dat runremote))))   ;; not on homehost




︙












This page was generated in about
0.123s by
Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00