1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;;======================================================================
;; 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.
|
|
|
>
>
>
>
>
|
|
>
>
>
>
|
|
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
|
;;======================================================================
;; Copyright 2006-2012, 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/>.
;;======================================================================
(declare (unit genexample))
(use posix regex)
(define genexample:example-logpro
#<<EOF
|
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
(if (not (directory? path))
(begin
(print "The path " path " does not exist or is not a directory. Attempting to create it now")
(create-directory path #t)))
;; First check that the directory is empty!
(if (and (file-exists? path)
(not (null? (glob (conc path "/*")))))
(begin
(print "WARNING: directory " path " is not empty, are you sure you want to continue?")
(display "Enter y/n: ")
(if (equal? "y" (read-line))
(print "Using directory " path " for your Megatest area.")
(begin
|
|
|
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
(if (not (directory? path))
(begin
(print "The path " path " does not exist or is not a directory. Attempting to create it now")
(create-directory path #t)))
;; First check that the directory is empty!
(if (and (common:file-exists? path)
(not (null? (glob (conc path "/*")))))
(begin
(print "WARNING: directory " path " is not empty, are you sure you want to continue?")
(display "Enter y/n: ")
(if (equal? "y" (read-line))
(print "Using directory " path " for your Megatest area.")
(begin
|
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
|
(description #f)
(steps '())
(scripts '())
(items '())
(rel-path #f))
(cond
((file-exists? "megatest.config") (set! rel-path "./"))
((file-exists? "../megatest.config") (set! rel-path "../"))
((file-exists? "../../megatest.config") (set! rel-path "../../"))
((file-exists? "../../../megatest.config")(set! rel-path "../../../"))) ;; good enough dang it.
;; Don't gather data or continue if a) megatest.config can't be found or b) testconfig already exists
(if (not rel-path)
(begin
(print "ERROR: I could not find megatest.config, please run -create-test in the top dir of your megatest area")
(exit 1)))
(if (file-exists? (conc rel-path "tests/" testname "/testconfig"))
(begin
(print "WARNING: You already have a testconfig in " rel-path "tests/" testname ", do you want to clobber your files?")
(display "Enter y/n: ")
(if (not (equal? "y" (read-line)))
(begin
(print "INFO: user abort of creation of test " testname)
(exit 1)))))
|
|
|
|
|
|
|
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
|
(description #f)
(steps '())
(scripts '())
(items '())
(rel-path #f))
(cond
((common:file-exists? "megatest.config") (set! rel-path "./"))
((common:file-exists? "../megatest.config") (set! rel-path "../"))
((common:file-exists? "../../megatest.config") (set! rel-path "../../"))
((common:file-exists? "../../../megatest.config")(set! rel-path "../../../"))) ;; good enough dang it.
;; Don't gather data or continue if a) megatest.config can't be found or b) testconfig already exists
(if (not rel-path)
(begin
(print "ERROR: I could not find megatest.config, please run -create-test in the top dir of your megatest area")
(exit 1)))
(if (common:file-exists? (conc rel-path "tests/" testname "/testconfig"))
(begin
(print "WARNING: You already have a testconfig in " rel-path "tests/" testname ", do you want to clobber your files?")
(display "Enter y/n: ")
(if (not (equal? "y" (read-line)))
(begin
(print "INFO: user abort of creation of test " testname)
(exit 1)))))
|