1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
(use srfi-1 data-structures posix regex-case (prefix base64 base64:)
matchable regex posix srfi-18 extras pkts (prefix dbi dbi:)
(prefix sqlite3 sqlite3:)
)
(declare (unit common))
(include "common_records.scm")
;; (require-library margs)
|
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
|
;;======================================================================
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;;======================================================================
(use srfi-1 data-structures posix regex-case (prefix base64 base64:)
matchable regex posix srfi-18 extras pkts (prefix dbi dbi:)
(prefix sqlite3 sqlite3:) typed-records directory-utils
)
(declare (unit common))
(include "common_records.scm")
;; (require-library margs)
|
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
|
#f))) ;; (pathname-file (current-directory)))))
(define common:get-area-name common:get-testsuite-name)
;; WARNING: This code falls back to using the global Megatest
;; variable *toppath*
;;
(define (common:get-db-tmp-area dbstruct)
(if (and dbstruct (dbr:dbstruct-tmpdb-path dbstruct)) ;; *db-cache-path*
(dbr:dbstruct-tmpdb-path dbstruct) ;; *db-cache-path*
(let ((toppath (or (and dbstruct (dbr:dbstruct-area-path dbstruct)) *toppath*))
(tsname (or (and dbstruct (dbr:dbstruct-area-name dbstruct))(common:get-testsuite-name))))
(if toppath ;; common:get-create-writeable-dir
(handle-exceptions
exn
|
|
|
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
|
#f))) ;; (pathname-file (current-directory)))))
(define common:get-area-name common:get-testsuite-name)
;; WARNING: This code falls back to using the global Megatest
;; variable *toppath*
;;
(define (common:get-db-tmp-area #!key (dbstruct #f))
(if (and dbstruct (dbr:dbstruct-tmpdb-path dbstruct)) ;; *db-cache-path*
(dbr:dbstruct-tmpdb-path dbstruct) ;; *db-cache-path*
(let ((toppath (or (and dbstruct (dbr:dbstruct-area-path dbstruct)) *toppath*))
(tsname (or (and dbstruct (dbr:dbstruct-area-name dbstruct))(common:get-testsuite-name))))
(if toppath ;; common:get-create-writeable-dir
(handle-exceptions
exn
|