Megatest

Check-in [87b708cb94]
Login
Overview
Comment:partial completion of remove-runs changes, and increase on min-inodes default from 0 to 1000000
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: 87b708cb94564b18e2dfff80355054e400e9abd9
User & Date: mmgraham on 2020-06-04 10:36:09
Other Links: branch diff | manifest | tags
Context
2020-06-04
16:57
enhanced -remove-runs to check for the existence of the target and run name in paths to delete, and to delete all run paths on each disk. check-in: 6bb9465eb1 user: mmgraham tags: v1.65
10:36
partial completion of remove-runs changes, and increase on min-inodes default from 0 to 1000000 check-in: 87b708cb94 user: mmgraham tags: v1.65
2020-06-01
13:34
merged fork check-in: fb18c65fe3 user: pjhatwal tags: v1.65, v1.6549
Changes

Modified common.scm from [e0587bf118] to [9a1d758071].

2163
2164
2165
2166
2167
2168
2169
2170

2171


2172


2173
2174
2175
2176
2177
2178
2179
2163
2164
2165
2166
2167
2168
2169

2170
2171
2172
2173

2174
2175
2176
2177
2178
2179
2180
2181
2182







-
+

+
+
-
+
+







	(begin
	  (debug:print-error 0 *default-log-port* "Insufficient space in " dbdir ", require " required ", have " dbspace  ", exiting now.")
	  (exit 1)))))
  
;; paths is list of lists ((name path) ... )
;;
(define (common:get-disk-with-most-free-space disks minsize)
  (let ((best     #f)
  (let* ((best     #f)
	(bestsize 0)
        (default-min-inodes-string "1000000")
        (default-min-inodes (string->number default-min-inodes-string))
        (min-inodes (or (string->number (if (configf:lookup *configdat* "setup" "min_inodes") (configf:lookup *configdat* "setup" "min_inodes") "0")) 0)))
        (min-inodes (or (string->number (if (configf:lookup *configdat* "setup" "min_inodes") (configf:lookup *configdat* "setup" "min_inodes") default-min-inodes-string)) default-min-inodes)))

    (for-each 
     (lambda (disk-num)
       (let* ((dirpath    (cadr (assoc disk-num disks)))
	      (freespc    (cond
			   ((not (directory? dirpath))
			    (if (common:low-noise-print 300 "disks not a dir " disk-num)
				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not a directory - ignoring it."))
2201
2202
2203
2204
2205
2206
2207

2208
2209
2210
2211
2212
2213
2214
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218







+







			    (if (common:low-noise-print 300 "disks not a proper path " disk-num)
				(debug:print 0 *default-log-port* "WARNING: disk " disk-num " at path \"" dirpath "\" is not a fully qualified path - ignoring it."))
			    -1)
			   (else
			    (get-free-inodes dirpath))))
             ;;(free-inodes (get-free-inodes dirpath))
             )
             (debug:print 2 *default-log-port* "INFO: disk " disk-num " path " dirpath " free space " freespc " free inodes " free-inodes)
	 (if (and (> freespc bestsize)(> free-inodes min-inodes ))
	     (begin
	       (set! best     (cons disk-num dirpath))
	       (set! bestsize freespc)))
        ;;(print "Processing: " disk-num " bestsize: " bestsize " best: " best " freespc: " freespc " min-inodes: " min-inodes " free-inodes: " free-inodes)
      ))
     (map car disks))

Modified runs.scm from [2d71b3332e] to [b5a23771e7].

2334
2335
2336
2337
2338
2339
2340


2341

2342
2343

2344
2345
2346



2347
2348
2349
2350
2351
2352
2353
2334
2335
2336
2337
2338
2339
2340
2341
2342

2343


2344



2345
2346
2347
2348
2349
2350
2351
2352
2353
2354







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







                                              (mt:test-set-state-status-by-id run-id (db:test-get-id test) "KILLREQ" "n/a" #f)
                                              (thread-sleep! 1)))
                                        ;; NOTE: This is suboptimal as the testdata will be used later and the state/status may have changed ...
                                        (if (null? tal)
                                            (loop new-test-dat tal)
                                            (loop (car tal)(append tal (list new-test-dat)))))
                                      (begin
                                        (if (and (not (string=  (db:test-get-rundir new-test-dat) "/tmp/badname")) (file-exists? (db:test-get-rundir new-test-dat)))
                                          (begin
                                        (set! lasttpath (db:test-get-rundir new-test-dat)) ;; remember this path for run removal
                                            (set! lasttpath (db:test-get-rundir new-test-dat)) ;; remember this path for run removal
                                        (if (file-exists? lasttpath) 
                                          (set! lastrealpath (resolve-pathname lasttpath))
                                            (set! lastrealpath (resolve-pathname lasttpath))
                                          (set! lastrealpath lasttpath)
                                        )
                                        (runs:remove-test-directory new-test-dat mode) ;; 'remove-all)
                                            (runs:remove-test-directory new-test-dat mode) ;; 'remove-all)
                                          )
                                        )

                                        (if (not (null? tal))
                                            (loop (car tal)(cdr tal)))))))
				(rmt:update-run-stats run-id (rmt:get-raw-run-stats run-id)))
                               ((kill-runs)
                                ;; RUNNING -> KILLREQ
                                ;; LAUNCHED,RUNNING,REMOTEHOSTSTART -> NOT STARTED
2418
2419
2420
2421
2422
2423
2424

2425
2426
2427
2428
2429
2430
2431
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433







+







                   (common:join-backgrounded-threads))))
	   
	   ;; remove the run if zero tests remain
	   (if (eq? action 'remove-runs)
	       (let* ((run-id   (db:get-value-by-header run header "id")) ;; NB// masks run-id from above?
                      (remtests (mt:get-tests-for-run run-id #f '("DELETED") '("n/a") not-in: #t)))
		 (if (null? remtests) ;; no more tests remaining

         ;; Remove the last dir from the path.
         ;; And same for the link-resolved path
		     (let* ((dparts  (string-split lasttpath "/"))
			      (linkspath (conc "/" (string-intersperse (take dparts (- (length dparts) 1)) "/")))
            (real-dparts (string-split lastrealpath "/"))
			      (realpath (conc "/" (string-intersperse (take real-dparts (- (length real-dparts) 1)) "/")))
            )