Megatest

Check-in [9d2772b077]
Login
Overview
Comment:rebased v1.80-debugprint forward
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-debugprint
Files: files | file ages | folders
SHA1: 9d2772b07730eae1d5d16ad35a69e7860aef052d
User & Date: matt on 2023-02-10 21:22:54
Other Links: branch diff | manifest | tags
Context
2023-02-13
04:56
missing param setting Leaf check-in: 5c56271302 user: matt tags: v1.80-debugprint
2023-02-10
21:22
rebased v1.80-debugprint forward check-in: 9d2772b077 user: matt tags: v1.80-debugprint
21:16
Merge v1.80-cleanup as it passed QA check-in: 34c5263e66 user: matt tags: v1.80
Changes

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

13
14
15
16
17
18
19




20
21
22
23
24
25
26
;;     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 format)

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

(use canvas-draw)







>
>
>
>







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 [e35890c342] to [2c9382abf0].

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

(module dbfile
	*
	
  (import scheme
	  chicken







|







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

(module dbfile
	*
	
  (import scheme
	  chicken
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
	files
	ports

	commonmod
	;; debugprint
	)

(define keep-age-param (make-parameter 10)) ;; qif file age, if over move to attic
(define num-run-dbs (make-parameter 10))     ;; number of db's in .megatest

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

;; a single Megatest area with it's multiple dbs is







|







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
	files
	ports

	commonmod
	;; debugprint
	)

(import debugprint)
(define num-run-dbs (make-parameter 10))     ;; number of db's in .megatest

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

;; a single Megatest area with it's multiple dbs is
333
334
335
336
337
338
339

340
341
342
343
344
345
346
347
348
349
350
  (with-output-to-port
      (current-error-port)
    (lambda ()
      (apply print params)))
  (exit 1))
    
(define (dbfile:print-err . 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 ()







>
|
|
|
|







333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
  (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))))

(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






















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

(module debugprint
	*
	
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
    ;; chicken.time.posix
    ;; chicken.port
    ;; chicken.process-context
    ;; chicken.process-context.posix
    
    (prefix mtargs args:)
    srfi-1

    ;; system-information
    )
  
;;======================================================================
;; debug stuff
;;======================================================================








>







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
(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 mtargs))
;; (declare (uses mtargs.import))

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

(import dbmod







|
|
|
|







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

(include "mtargs/mtargs.scm")







|

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