Megatest

Check-in [998265e2aa]
Login
Overview
Comment:Added ability to add message to -set-run-status
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.55 | v1.5515
Files: files | file ages | folders
SHA1: 998265e2aa3464c1279181921f65d0b930d8d59b
User & Date: mrwellan on 2014-02-21 13:45:32
Other Links: branch diff | manifest | tags
Context
2014-02-24
14:42
Fixed debug issue on invalid debug setting. Fixed show-config bug. Added -start-dir check-in: 405e0970e6 user: mrwellan tags: v1.55, v1.5515
2014-02-21
13:45
Added ability to add message to -set-run-status check-in: 998265e2aa user: mrwellan tags: v1.55, v1.5515
2014-02-20
14:06
Bumped version to v1.5515 check-in: 735ec6a4b3 user: icfadm tags: v1.55, v1.5515
Changes

Modified db.scm from [b4b6c484fd] to [f1965d6123].

903
904
905
906
907
908
909
910
911




912
913
914
915
916
917
918
903
904
905
906
907
908
909


910
911
912
913
914
915
916
917
918
919
920







-
-
+
+
+
+







			    "unlocked"
			    "locked")))) ;; semi-failsafe
    (sqlite3:execute db "UPDATE runs SET state=? WHERE id=?;" newlockval run-id)
    (sqlite3:execute db "INSERT INTO access_log (user,accessed,args) VALUES(?,strftime('%s','now'),?);"
		     user (conc newlockval " " run-id))
    (debug:print-info 1 "" newlockval " run number " run-id)))

(define (db:set-run-status db run-id status)
  (sqlite3:execute db "UPDATE runs SET status=? WHERE id=?;" status run-id))
(define (db:set-run-status db run-id status #!key (msg #f))
  (if msg
      (sqlite3:execute db "UPDATE runs SET status=?,comment=? WHERE id=?;" status msg run-id)
      (sqlite3:execute db "UPDATE runs SET status=? WHERE id=?;" status run-id)))

(define (db:get-run-status db run-id)
  (let ((res "n/a"))
    (sqlite3:for-each-row 
     (lambda (status)
       (set! res status))
     db 

Modified megatest.scm from [aa8d363bf8] to [0866bc0857].

569
570
571
572
573
574
575
576

577
578
579
580
581
582
583
569
570
571
572
573
574
575

576
577
578
579
580
581
582
583







-
+







	 (if (null? rows)
	     (begin
	       (debug:print-info 0 "No matching run found.")
	       (exit 1))
	     (let* ((row      (car (vector-ref runsdat 1)))
		    (run-id   (db:get-value-by-header row header "id")))
	       (if (args:get-arg "-set-run-status")
		   (cdb:remote-run db:set-run-status #f run-id (args:get-arg "-set-run-status"))
		   (cdb:remote-run db:set-run-status #f run-id (args:get-arg "-set-run-status") msg: (args:get-arg "-m"))
		   (print (open-run-close db:get-run-status #f run-id))
		   )))))))

;;======================================================================
;; Query runs
;;======================================================================