Megatest

Check-in [e05e127ba0]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Improved feedback when archiving is blocked for some reason
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: e05e127ba0486036ed61d6e89c4d58c119476e60
User & Date: mrwellan on 2015-07-14 15:21:32
Other Links: branch diff | manifest | tags
Context
2015-07-15
09:28
Change archiving ERROR's to WARNING's check-in: 106d429710 user: mrwellan tags: v1.60
2015-07-14
15:21
Improved feedback when archiving is blocked for some reason check-in: e05e127ba0 user: mrwellan tags: v1.60
14:02
Bumped version to 1.6021 check-in: bb8b165e5f user: mrwellan tags: v1.60, v1.6021
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified archive.scm from [1e200bee3b] to [8c7a48b5ff].

︙
143
144
145
146
147
148
149

150
151



152
153
154
155
156
157
158
159
160
161
162
163












164
165
166
167
168
169
170

143
144
145
146
147
148
149
150


151
152
153












154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172








+
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+








	      (test-base         (if (and partial-path-index 
					  test-physical-path )
				     (substring test-physical-path
						0
						partial-path-index)
				     #f)))
	 
 	 (cond
 	 (if (or toplevel/children
		 (not (file-exists? test-path)))
	  (toplevel/children
	   (debug:print 0 "ERROR: cannot archive " test-name " with id " test-id " as it is a toplevel test with children"))
	  ((not (file-exists? test-path))
	     #f
	     (begin
	       (debug:print 0
			    "From test-dat=" test-dat " derived the following:\n"
			    "test-partial-path  = " test-partial-path "\n"
			    "test-path          = " test-path "\n"
			    "test-physical-path = " test-physical-path "\n"
			    "partial-path-index = " partial-path-index "\n"
			    "test-base          = " test-base)
	       (hash-table-set! disk-groups test-base (cons test-physical-path (hash-table-ref/default disk-groups test-base '())))
	       (hash-table-set! test-groups test-base (cons test-dat (hash-table-ref/default test-groups test-base '())))
	       test-path))))
	   (debug:print 0 "ERROR: Cannot archive " test-name "/" item-path " as path " test-path " does not exist"))
	  (else
	   (debug:print 0
			"From test-dat=" test-dat " derived the following:\n"
			"test-partial-path  = " test-partial-path "\n"
			"test-path          = " test-path "\n"
			"test-physical-path = " test-physical-path "\n"
			"partial-path-index = " partial-path-index "\n"
			"test-base          = " test-base)
	   (hash-table-set! disk-groups test-base (cons test-physical-path (hash-table-ref/default disk-groups test-base '())))
	   (hash-table-set! test-groups test-base (cons test-dat (hash-table-ref/default test-groups test-base '())))
	   test-path))))
     tests)
    ;; for each disk-group
    (for-each 
     (lambda (disk-group)
       (debug:print 0 "Processing disk-group " disk-group)
       (let* ((test-paths (hash-table-ref disk-groups disk-group))
	      ;; ((string-intersperse (map cadr (rmt:get-key-val-pairs 1)) "-")
︙

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