Megatest

Check-in [50237f6e1f]
Login
Overview
Comment:fixed-save
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-broken
Files: files | file ages | folders
SHA1: 50237f6e1f5f369b5e1022774427028c4dba7d6b
User & Date: mrwellan on 2020-05-05 12:38:27
Other Links: branch diff | manifest | tags
Context
2020-05-05
12:55
Fixed the first run archive disk not found issue check-in: 64aa9347d5 user: mrwellan tags: v1.65-broken
12:38
fixed-save check-in: 50237f6e1f user: mrwellan tags: v1.65-broken
11:30
Added -inlcude support to save and get for archive check-in: e28be4def5 user: mrwellan tags: v1.65-broken
Changes

Modified archive.scm from [09abb4e185] to [e3fbfd8139].

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
	(hash-table-ref blockid-cache key)
	(let* ((pscript     (configf:lookup *configdat* "archive" "pathscript"))
	       (pscript-cmd (conc pscript " " testsuite-name " " target " " run-name " " test-name))
	       (apath       (if pscript
				(handle-exceptions
				 exn
				 (begin
				   (debug:print 0 "ERROR: script \"" pscript-cmd "\" failed to run properly.")
				   (exit 1))
				 (with-input-from-pipe
				  pscript-cmd
				  read-line))
				#f)) ;; this is the user-calculated archive path
	       (adisks    (archive:get-archive-disks))
	       (best-disk (common:get-disk-with-most-free-space adisks dneeded)))







|







88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
	(hash-table-ref blockid-cache key)
	(let* ((pscript     (configf:lookup *configdat* "archive" "pathscript"))
	       (pscript-cmd (conc pscript " " testsuite-name " " target " " run-name " " test-name))
	       (apath       (if pscript
				(handle-exceptions
				 exn
				 (begin
				   (debug:print 0 *current-log-port* "ERROR: script \"" pscript-cmd "\" failed to run properly.")
				   (exit 1))
				 (with-input-from-pipe
				  pscript-cmd
				  read-line))
				#f)) ;; this is the user-calculated archive path
	       (adisks    (archive:get-archive-disks))
	       (best-disk (common:get-disk-with-most-free-space adisks dneeded)))
114
115
116
117
118
119
120


121


122
123
124
125
126
127
128
129
130
		     (archive-path  (conc bdisk-path "/" archive-name))
		     (block-id      (rmt:archive-register-block-name bdisk-id archive-path)))
		;;   (allocation-id (rmt:archive-allocate-testsuite/area-to-block block-id testsuite-name area-key)))
		(if block-id ;; (and block-id allocation-id)
		    (let ((res (cons block-id archive-path)))
		      (hash-table-set! blockid-cache key res)
		      res)


		    #f))


	      #f)) ;; no best disk found
	  )))

;; archive - run bup
;;
;; 1. create the bup dir if not exists
;; 2. start the du of each directory
;; 3. gen index
;; 4. save







>
>
|
>
>
|
<







114
115
116
117
118
119
120
121
122
123
124
125
126

127
128
129
130
131
132
133
		     (archive-path  (conc bdisk-path "/" archive-name))
		     (block-id      (rmt:archive-register-block-name bdisk-id archive-path)))
		;;   (allocation-id (rmt:archive-allocate-testsuite/area-to-block block-id testsuite-name area-key)))
		(if block-id ;; (and block-id allocation-id)
		    (let ((res (cons block-id archive-path)))
		      (hash-table-set! blockid-cache key res)
		      res)
		    (begin
		      (debug:print 0 *current-log-port* "WARNING: no disk found for " target ", " run-name ", " test-name ", block-id=" block-id)
		      #f)))
	      (begin
		(debug:print 0 *current-log-port* "WARNING: no disk found for " target ", " run-name ", " test-name ", block-id=" block-id)
		#f)))))) ;; no best disk found


;; archive - run bup
;;
;; 1. create the bup dir if not exists
;; 2. start the du of each directory
;; 3. gen index
;; 4. save