Megatest

Check-in [6ba991c430]
Login
Overview
Comment:Replaced call to read-symbolic-link with common:real-path. read-symbolic-link doesn't do what I thought it did
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 6ba991c43019ea10c9b1611739b8571b59bb4e62
User & Date: mrwellan on 2015-07-15 10:31:01
Other Links: branch diff | manifest | tags
Context
2015-07-15
17:49
Added mutex to protect calls to real-path check-in: 2b36e81091 user: mrwellan tags: v1.60
10:31
Replaced call to read-symbolic-link with common:real-path. read-symbolic-link doesn't do what I thought it did check-in: 6ba991c430 user: mrwellan tags: v1.60
09:28
Change archiving ERROR's to WARNING's check-in: 106d429710 user: mrwellan tags: v1.60
Changes

Modified archive.scm from [30e973d73a] to [0008c652a8].

221
222
223
224
225
226
227
228




229
230
231
232
233
234
235
221
222
223
224
225
226
227

228
229
230
231
232
233
234
235
236
237
238







-
+
+
+
+







	      
	      (toplevel/children (and (db:test-get-is-toplevel test-dat)
				      (> (rmt:test-toplevel-num-items run-id test-name) 0)))
	      (test-partial-path (conc target "/" run-name "/" (db:test-make-full-name test-name item-path)))
	      ;; note the trailing slash to get the dir inspite of it being a link
	      (test-path         (conc linktree "/" test-partial-path))
	      ;; if the old path was not deleted then prev-test-physical-path will end up pointing to a real directory
	      (prev-test-physical-path (if (file-exists? test-path) (read-symbolic-link test-path #t) #f))
	      (prev-test-physical-path (if (file-exists? test-path)
					   ;; (read-symbolic-link test-path #t)
					   (common:real-path test-path)
					   #f))

	      (new-test-physical-path  (conc best-disk "/" test-partial-path))
	      (archive-block-id        (db:test-get-archived test-dat))
	      (archive-block-info      (rmt:test-get-archive-block-info archive-block-id))
	      (archive-path            (if (vector? archive-block-info)
					   (vector-ref archive-block-info 2) ;; look in db.scm for test-get-archive-block-info for the vector record info
					   #f)) ;; no archive found?

Modified common.scm from [62a7dd9755] to [c461e87208].

586
587
588
589
590
591
592



593
594
595
596
597
598
599
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602







+
+
+







(define (get-uname . params)
  (let* ((uname-res (cmd-run->list (conc "uname " (if (null? params) "-a" (car params)))))
	 (uname #f))
    (if (null? (car uname-res))
	"unknown"
	(caar uname-res))))

(define (common:real-path inpath)
  (with-input-from-pipe (conc "readlink -f " inpath) read-line))

;;======================================================================
;; D I S K   S P A C E 
;;======================================================================

(define (common:get-disk-space-used fpath)
  (with-input-from-pipe (conc "/usr/bin/du -s " fpath) read))