Megatest

Check-in [2bb0d5f0ff]
Login
Overview
Comment:Added lock between test launch and removing test data
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64
Files: files | file ages | folders
SHA1: 2bb0d5f0ff9f91a6ac481140b9e2935c00177c11
User & Date: mrwellan on 2017-07-10 18:08:14
Other Links: branch diff | manifest | tags
Context
2017-07-11
15:23
Added missing WARN and WAIVED to teamcity testFinished status. check-in: 9da9d38cfc user: mrwellan tags: v1.64, v1.6424
2017-07-10
18:08
Added lock between test launch and removing test data check-in: 2bb0d5f0ff user: mrwellan tags: v1.64
10:47
Bump version to v1.6424 check-in: 7249f37836 user: mrwellan tags: v1.64
Changes

Modified db.scm from [05a6ad4f54] to [d861a30e88].

1858
1859
1860
1861
1862
1863
1864

1865
1866
1867
1868
1869







1870
1871
1872
1873
1874
1875
1876
1858
1859
1860
1861
1862
1863
1864
1865





1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879







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







    db))

;; if we are not a server create a db handle. this is not finalized
;; so watch for problems. I'm still not clear if it is needed to manually
;; finalize sqlite3 dbs with the sqlite3 egg.
;;
(define (db:no-sync-db db-in)
  (mutex-lock! *db-access-mutex*)
  (if db-in
      db-in
      (let ((db (db:open-no-sync-db)))
	(set! *no-sync-db* db)
	db)))
  (let ((res (if db-in
                 db-in
                 (let ((db (db:open-no-sync-db)))
                   (set! *no-sync-db* db)
                   db))))
    (mutex-unlock! *db-access-mutex*)
    res))

(define (db:no-sync-set db var val)
  (sqlite3:execute (db:no-sync-db db) "INSERT OR REPLACE INTO no_sync_metadat (var,val) VALUES (?,?);" var val))

(define (db:no-sync-del! db var)
  (sqlite3:execute (db:no-sync-db db) "DELETE FROM no_sync_metadat WHERE var=?;" var))

Modified runs.scm from [a5f78f22d5] to [642d238014].

1959
1960
1961
1962
1963
1964
1965
1966















1967
1968
1969
1970
1971
1972
1973
1959
1960
1961
1962
1963
1964
1965

1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987







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








(define (runs:remove-test-directory test mode) ;; remove-data-only)
  (let* ((run-dir       (db:test-get-rundir test))    ;; run dir is from the link tree
	 (real-dir      (if (common:file-exists? run-dir)
			    ;; (resolve-pathname run-dir)
			    (common:nice-path run-dir)
			    #f))
         (clean-mode    (or mode 'remove-all)))
         (clean-mode    (or mode 'remove-all))
         (test-id       (db:test-get-id test))
         (lock-key      (conc "test-" test-id))
         (got-lock      (let loop ((lock        (rmt:no-sync-get-lock lock-key))
				     (expire-time (+ (current-seconds) 30))) ;; give up on getting the lock and steal it after 15 seconds
			    (if (car lock)
				#t
				(if (> (current-seconds) expire-time)
				    (begin
				      (debug:print-info 0 *default-log-port* "Timed out waiting for a lock to clean test with id " test-id)
				      (rmt:no-sync-del! lock-key) ;; destroy the lock
				      (loop (rmt:no-sync-get-lock lock-key) expire-time)) ;; 
				    (begin
				      (thread-sleep! 1)
				      (loop (rmt:no-sync-get-lock lock-key) expire-time)))))))
    (case clean-mode
      ((remove-data-only)(mt:test-set-state-status-by-id (db:test-get-run_id test)(db:test-get-id test) "CLEANING" "LOCKED" #f))
      ((remove-all)      (mt:test-set-state-status-by-id (db:test-get-run_id test)(db:test-get-id test) "REMOVING" "LOCKED" #f))
      ((archive-remove)  (mt:test-set-state-status-by-id (db:test-get-run_id test)(db:test-get-id test) "ARCHIVE_REMOVING" #f #f)))
    (debug:print-info 1 *default-log-port* "Attempting to remove " (if real-dir (conc " dir " real-dir " and ") "") " link " run-dir)
    (if (and real-dir 
	     (> (string-length real-dir) 5)
1999
2000
2001
2002
2003
2004
2005
2006


2007
2008
2009
2010
2011
2012
2013
2013
2014
2015
2016
2017
2018
2019

2020
2021
2022
2023
2024
2025
2026
2027
2028







-
+
+







		(debug:print 0 *default-log-port* "WARNING: not removing " run-dir " as it either doesn't exist or is not a symlink")
		(debug:print 0 *default-log-port* "NOTE: the run dir for this test is undefined. Test may have already been deleted."))
	    ))
    ;; Only delete the records *after* removing the directory. If things fail we have a record 
    (case clean-mode
      ((remove-data-only)(mt:test-set-state-status-by-id (db:test-get-run_id test)(db:test-get-id test) (db:test-get-state test)(db:test-get-status test) #f))
      ((archive-remove)  (mt:test-set-state-status-by-id (db:test-get-run_id test)(db:test-get-id test) "ARCHIVED" #f #f))
      (else (rmt:delete-test-records (db:test-get-run_id test) (db:test-get-id test))))))
      (else (rmt:delete-test-records (db:test-get-run_id test) (db:test-get-id test))))
    (rmt:no-sync-del! lock-key)))

;;======================================================================
;; Routines for manipulating runs
;;======================================================================

;; Since many calls to a run require pretty much the same setup 
;; this wrapper is used to reduce the replication of code