Megatest

Check-in [8d21f434ab]
Login
Overview
Comment:Added missing finalize for lock-queue
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.55
Files: files | file ages | folders
SHA1: 8d21f434abefb2834d715cfc5026e45ec4c124b7
User & Date: matt on 2013-08-12 01:18:42
Other Links: branch diff | manifest | tags
Context
2013-08-12
23:53
Removed JOIN from -test-paths query check-in: be4c49d8e4 user: matt tags: v1.55
01:18
Added missing finalize for lock-queue check-in: 8d21f434ab user: matt tags: v1.55
00:51
Fixed locking on rollup bug by writing simple locking queue explictly for the needed behavior check-in: 7180157463 user: matt tags: v1.55
Changes

Modified lock-queue.scm from [9cc456adfe] to [41e679e50c].

64
65
66
67
68
69
70

71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87



88
89
90
91
92




93
94
95
96
97
98
99
100
101
102
103
104
105

106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122


123
124
125
126
     "SELECT test_id FROM queue WHERE start_time > ?;" mystart)
    res))

(define (lock-queue:get-lock db test-id)
  (let ((res       #f)
	(lckqry    (sqlite3:prepare db "SELECT test_id,run_lock FROM runlocks WHERE run_lock='locked';"))
	(mklckqry  (sqlite3:prepare db "INSERT INTO runlocks (test_id,run_lock) VALUES (?,'locked');")))

    (handle-exceptions
     exn
     #f
     (sqlite3:with-transaction
      db
      (lambda ()
	(sqlite3:for-each-row (lambda (tid lockstate)
				(set! res (list tid lockstate)))
			      lckqry)
	(if res
	    (if (equal? (car res) test-id)
		#t ;; already have the lock
		#f)
	    (begin
	      (sqlite3:execute mklckqry test-id)
	      ;; if no error handled then return #t for got the lock
	      #t)))))))




(define (lock-queue:release-lock fname test-id)
  (let ((db (lock-queue:open-db fname)))
    (sqlite3:execute db "DELETE FROM runlocks WHERE test_id=?;" test-id)
    (sqlite3:finalize! db)))





;; returns #f if ok to skip the task
;; returns #t if ok to proceed with task
;; otherwise waits
;;
(define (lock-queue:wait-turn fname test-id)
  (let ((db      (lock-queue:open-db fname))
	(mystart (current-seconds)))
    (sqlite3:execute
     db
     "INSERT OR REPLACE INTO queue (test_id,start_time,state) VALUES (?,?,'waiting');"
     test-id mystart)
    (thread-sleep! 1) ;; give other tests a chance to register

    (let loop ((younger-waiting (lock-queue:any-younger? db mystart test-id)))
      (if younger-waiting
	  (begin
	    ;; no need for us to wait. mark in the lock queue db as skipping
	    (lock-queue:set-state db test-id "skipping")
	    (begin
	      ;; (sqlite3:finalize! db)
	      #f)) ;; let the calling process know that nothing needs to be done
	  (if (lock-queue:get-lock db test-id)
	      (begin
		;; (sqlite3:finalize! db)
		#t)
	      (if (> (- (current-seconds) mystart) 36000) ;; waited too long, steal the lock
		  (lock-queue:steal-lock db test-id)
		  (begin
		    (thread-sleep! 1)
		    (loop (lock-queue:any-younger? db mystart test-id)))))))))


	  
            
;; (use trace)
;; (trace lock-queue:get-lock lock-queue:release-lock lock-queue:wait-turn lock-queue:any-younger? lock-queue:set-state)







>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>





>
>
>
>













>
|
|
|
|
|
<
<
|
|
<
<
|
|
|
|
|
|
>
>




64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119


120
121


122
123
124
125
126
127
128
129
130
131
132
133
     "SELECT test_id FROM queue WHERE start_time > ?;" mystart)
    res))

(define (lock-queue:get-lock db test-id)
  (let ((res       #f)
	(lckqry    (sqlite3:prepare db "SELECT test_id,run_lock FROM runlocks WHERE run_lock='locked';"))
	(mklckqry  (sqlite3:prepare db "INSERT INTO runlocks (test_id,run_lock) VALUES (?,'locked');")))
    (let ((result 
	   (handle-exceptions
	    exn
	    #f
	    (sqlite3:with-transaction
	     db
	     (lambda ()
	       (sqlite3:for-each-row (lambda (tid lockstate)
				       (set! res (list tid lockstate)))
				     lckqry)
	       (if res
		   (if (equal? (car res) test-id)
		       #t ;; already have the lock
		       #f)
		   (begin
		     (sqlite3:execute mklckqry test-id)
		     ;; if no error handled then return #t for got the lock
		     #t)))))))
      (sqlite3:finalize! lckqry)
      (sqlite3:finalize! mklckqry)
      result)))

(define (lock-queue:release-lock fname test-id)
  (let ((db (lock-queue:open-db fname)))
    (sqlite3:execute db "DELETE FROM runlocks WHERE test_id=?;" test-id)
    (sqlite3:finalize! db)))

(define (lock-queue:steal-lock db test-id)
  (sqlite3:execute db "DELETE FROM runlocks WHERE run_lock='locked';")
  (lock-queue:get-lock db test-it))

;; returns #f if ok to skip the task
;; returns #t if ok to proceed with task
;; otherwise waits
;;
(define (lock-queue:wait-turn fname test-id)
  (let ((db      (lock-queue:open-db fname))
	(mystart (current-seconds)))
    (sqlite3:execute
     db
     "INSERT OR REPLACE INTO queue (test_id,start_time,state) VALUES (?,?,'waiting');"
     test-id mystart)
    (thread-sleep! 1) ;; give other tests a chance to register
    (let ((result 
	   (let loop ((younger-waiting (lock-queue:any-younger? db mystart test-id)))
	     (if younger-waiting
		 (begin
		   ;; no need for us to wait. mark in the lock queue db as skipping
		   (lock-queue:set-state db test-id "skipping")


		   #f) ;; let the calling process know that nothing needs to be done
		 (if (lock-queue:get-lock db test-id)


		     #t
		     (if (> (- (current-seconds) mystart) 36000) ;; waited too long, steal the lock
			 (lock-queue:steal-lock db test-id)
			 (begin
			   (thread-sleep! 1)
			   (loop (lock-queue:any-younger? db mystart test-id)))))))))
      (sqlite3:finalize! db)
      result)))
	  
            
;; (use trace)
;; (trace lock-queue:get-lock lock-queue:release-lock lock-queue:wait-turn lock-queue:any-younger? lock-queue:set-state)