Megatest

Check-in [770f557677]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:fixed indentation
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: 770f557677d68da0ac633088a03d7f1c8af2aca1
User & Date: pjhatwal on 2020-10-23 16:00:22
Other Links: branch diff | manifest | tags
Context
2020-10-27
17:01
enabled -remove-runs with % wildcards in the target Closed-Leaf check-in: 69da469153 user: mmgraham tags: 1.65-remove-runs-wildcard
2020-10-26
13:16
cherrypicked from 1.65-archive Leaf check-in: d891fc7b0e user: pjhatwal tags: 1.65-archive2
2020-10-23
23:05
merge-sync'd with test-rundat2 in prep for merging rundat changes. check-in: e0ddc9d3c5 user: matt tags: v1.65
16:00
fixed indentation check-in: 770f557677 user: pjhatwal tags: v1.65
2020-10-22
23:57
Added some hints to query-rest check-in: 12cc9e54fa user: matt tags: v1.65
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified cgisetup/models/pgdb.scm from [4136225c9c] to [b49201d65c].

︙
175
176
177
178
179
180
181
182

183
184
185
186

187
188
189
190
191
192
193

175
176
177
178
179
180
181

182
183
184
185

186
187
188
189
190
191
192
193








-
+



-
+








      state=?,status=?,owner=?,event_time=?,comment=?,fail_count=?,pass_count=?,last_update=?,publish_time=?  
     WHERE id=? and area_id=?;"
   state status owner event-time comment fail-count pass-count last_update publish-time run-id area-id ))

;; given all needed info create run record
;;
(define (pgdb:insert-run dbh ttype-id target run-name state status owner event-time comment fail-count pass-count area-id last-update publish-time)
    (dbi:exec
  (dbi:exec
   dbh
   "INSERT INTO runs (ttype_id,target,run_name,state,status,owner,event_time,comment,fail_count,pass_count,area_id,last_update,publish_time)
      VALUES (?,?,?,?,?,?,?,?,?,?,?,?, ?);"
    ttype-id target run-name state status owner event-time comment fail-count pass-count area-id last-update publish-time))
   ttype-id target run-name state status owner event-time comment fail-count pass-count area-id last-update publish-time))

;;======================================================================
;;  T E S T - S T E P S
;;======================================================================

(define (pgdb:get-test-step-id dbh test-id stepname state)
  (dbi:get-one
︙

Modified tasks.scm from [b621e9649f] to [0f134c8e45].

︙
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460













461
462
463
464
465
466
467

441
442
443
444
445
446
447













448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467








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








;; remove tasks given by a string of numbers comma separated
(define (tasks:remove-queue-entries dbstruct task-ids)
  (db:with-db
   dbstruct #f #t
   (lambda (db)
     (sqlite3:execute db (conc "DELETE FROM tasks_queue WHERE id IN (" task-ids ");")))))

#;(define (tasks:process-queue dbstruct)
  (let* ((task   (tasks:snag-a-task dbstruct))
	 (action (if task (tasks:task-get-action task) #f)))
    (if action (print "tasks:process-queue task: " task))
    (if action
	(case (string->symbol action)
	  ((run)       (tasks:start-run     dbstruct task))
	  ((remove)    (tasks:remove-runs   dbstruct task))
	  ((lock)      (tasks:lock-runs     dbstruct task))
	  ;; ((monitor)   (tasks:start-monitor db task))
	  #;((rollup)    (tasks:rollup-runs   dbstruct task))
	  ((updatemeta)(tasks:update-meta   dbstruct task))
	  #;((kill)      (tasks:kill-monitors dbstruct task))))))
;; #;(define (tasks:process-queue dbstruct)
;;   (let* ((task   (tasks:snag-a-task dbstruct))
;; 	 (action (if task (tasks:task-get-action task) #f)))
;;     (if action (print "tasks:process-queue task: " task))
;;     (if action
;; 	(case (string->symbol action)
;; 	  ((run)       (tasks:start-run     dbstruct task))
;; 	  ((remove)    (tasks:remove-runs   dbstruct task))
;; 	  ((lock)      (tasks:lock-runs     dbstruct task))
;; 	  ;; ((monitor)   (tasks:start-monitor db task))
;; 	  #;((rollup)    (tasks:rollup-runs   dbstruct task))
;; 	  ((updatemeta)(tasks:update-meta   dbstruct task))
;; 	  #;((kill)      (tasks:kill-monitors dbstruct task))))))

(define (tasks:tasks->text tasks)
  (let ((fmtstr "~10a~10a~10a~12a~20a~12a~12a~10a"))
    (conc (format #f fmtstr "id" "action" "owner" "state" "target" "runname" "testpatts" "params") "\n"
	  (string-intersperse 
	   (map (lambda (task)
		  (format #f fmtstr
︙
740
741
742
743
744
745
746
747

748
749
750
751
752
753
754
755
756
757
758
759
760

761
762
763
764
765
766
767






768
769
770


771
772

773
774

775
776
777
778


779
780
781
782



783
784
785
786
787
788





789
790
791
792
793
794
795



796
797

798
799
800
801
802
803
804






805
806
807
808
809
810
811
812
813
814









815
816
817
818
819
820
821

740
741
742
743
744
745
746

747
748
749
750
751
752
753
754
755
756
757
758
759

760
761






762
763
764
765
766
767
768


769
770
771

772
773

774
775
776


777
778
779



780
781
782
783





784
785
786
787
788
789
790
791
792



793
794
795
796

797
798






799
800
801
802
803
804
805









806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821








-
+












-
+

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

-
-
+
+

-
+

-
+


-
-
+
+

-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+




-
-
-
+
+
+

-
+

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

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









;; gets mtpg-run-id and syncs the record if different
;;
(define (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time)
  (let* ((runs-ht (hash-table-ref cached-info 'runs))
	 (runinf  (hash-table-ref/default runs-ht run-id #f))
         (area-id (vector-ref area-info 0)))
       (if runinf
    (if runinf
	runinf ;; already cached
	(let* ((run-dat    (rmt:get-run-info run-id))               ;; NOTE: get-run-info returns a vector < row header >
	       (run-name   (rmt:get-run-name-from-id run-id))
	       (row        (db:get-rows run-dat))                   ;; yes, this returns a single row
	       (header     (db:get-header run-dat))
	       (state      (db:get-value-by-header row header "state"))
	       (status     (db:get-value-by-header row header "status"))
	       (owner      (db:get-value-by-header row header "owner"))
	       (event-time (db:get-value-by-header row header "event_time"))
	       (comment    (db:get-value-by-header row header "comment"))
	       (fail-count (db:get-value-by-header row header "fail_count"))
	       (pass-count (db:get-value-by-header row header "pass_count"))
         (db-contour (db:get-value-by-header row header "contour"))
	       (db-contour (db:get-value-by-header row header "contour"))
	       (contour    (if (args:get-arg "-prepend-contour") 
                                 (if (and db-contour (not (equal? db-contour ""))  (string? db-contour )) 
                                           (begin 
                                            (debug:print-info 1 *default-log-port*  "db-contour") 
 						db-contour)
					    (args:get-arg "-contour"))))
         (run-tag (if (args:get-arg "-run-tag")
			       (if (and db-contour (not (equal? db-contour ""))  (string? db-contour )) 
				   (begin 
				     (debug:print-info 1 *default-log-port*  "db-contour") 
				     db-contour)
				   (args:get-arg "-contour"))))
	       (run-tag (if (args:get-arg "-run-tag")
                            (args:get-arg "-run-tag")
									""))
         (last-update (db:get-value-by-header row header "last_update"))
			    ""))
	       (last-update (db:get-value-by-header row header "last_update"))
	       (keytarg    (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target"))
	       			(conc "MT_CONTOUR/MT_AREA/" (string-intersperse (rmt:get-keys) "/")) (string-intersperse (rmt:get-keys) "/"))) ;; e.g. version/iteration/platform
			       (conc "MT_CONTOUR/MT_AREA/" (string-intersperse (rmt:get-keys) "/")) (string-intersperse (rmt:get-keys) "/"))) ;; e.g. version/iteration/platform
	       (target     (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target")) 
	       			(conc (or (args:get-arg "-prefix-target") (conc contour "/" (common:get-area-name) "/")) (rmt:get-target run-id)) (rmt:get-target run-id)))                 ;; e.g. v1.63/a3e1/ubuntu
			       (conc (or (args:get-arg "-prefix-target") (conc contour "/" (common:get-area-name) "/")) (rmt:get-target run-id)) (rmt:get-target run-id)))                 ;; e.g. v1.63/a3e1/ubuntu
	       (spec-id    (pgdb:get-ttype dbh keytarg))
	       (publish-time (if (args:get-arg "-cp-eventtime-to-publishtime")
                            event-time
                           (current-seconds))) 
				 event-time
				 (current-seconds))) 
	       (new-run-id (pgdb:get-run-id dbh spec-id target run-name area-id)))
         (if new-run-id
	         (begin ;; let ((run-record (pgdb:get-run-info dbh new-run-id))
		        (hash-table-set! runs-ht run-id new-run-id)
	  (if new-run-id
	      (begin ;; let ((run-record (pgdb:get-run-info dbh new-run-id))
		(hash-table-set! runs-ht run-id new-run-id)
		;; ensure key fields are up to date
     ;; if last_update == pgdb_last_update do not update smallest-last-update-time  
    (let* ((pgdb-last-update (pgdb:get-run-last-update dbh new-run-id))
           (smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f)))
     (if (and  (> last-update pgdb-last-update) (or (not smallest-time) (< last-update smallest-time)))
        (hash-table-set! smallest-last-update-time "smallest-time" last-update)))
		;; if last_update == pgdb_last_update do not update smallest-last-update-time  
		(let* ((pgdb-last-update (pgdb:get-run-last-update dbh new-run-id))
		       (smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f)))
		  (if (and  (> last-update pgdb-last-update) (or (not smallest-time) (< last-update smallest-time)))
		      (hash-table-set! smallest-last-update-time "smallest-time" last-update)))
		(pgdb:refresh-run-info
		 dbh
		 new-run-id
		 state status owner event-time comment fail-count pass-count area-id last-update publish-time)
     (debug:print-info 0 *default-log-port* "Working on run-id " run-id " pgdb-id "  new-run-id )
     (if (not (equal? run-tag ""))
      (task:add-run-tag dbh new-run-id run-tag))
		(debug:print-info 0 *default-log-port* "Working on run-id " run-id " pgdb-id "  new-run-id )
		(if (not (equal? run-tag ""))
		    (task:add-run-tag dbh new-run-id run-tag))
		new-run-id) 
      
	      
	      (if (equal? state "deleted")
          (begin 
          (debug:print-info 1 *default-log-port*  "Warning: Run with id " run-id " was created after previous sync and deleted before the sync") #f)
          (if (handle-exceptions
		        exn
		        (begin (print-call-chain)
              (print ((condition-property-accessor 'exn 'message) exn))     
		  (begin 
		    (debug:print-info 1 *default-log-port*  "Warning: Run with id " run-id " was created after previous sync and deleted before the sync") #f)
		  (if (handle-exceptions
		       exn
		       (begin (print-call-chain)
			      (print ((condition-property-accessor 'exn 'message) exn))     
			      #f)
            
            (pgdb:insert-run
		     dbh
		     spec-id target run-name state status owner event-time comment fail-count pass-count  area-id last-update publish-time))
		       (let* ((smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f)))
             (if (or (not smallest-time) (< last-update smallest-time))
        				(hash-table-set! smallest-last-update-time "smallest-time" last-update))
             (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time))
		  #f)))))))
		       
		       (pgdb:insert-run
			dbh
			spec-id target run-name state status owner event-time comment fail-count pass-count  area-id last-update publish-time))
		      (let* ((smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f)))
			(if (or (not smallest-time) (< last-update smallest-time))
			    (hash-table-set! smallest-last-update-time "smallest-time" last-update))
			(tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time))
		      #f)))))))

(define (task:add-run-tag dbh run-id tag) 
  (let* ((tag-info (pgdb:get-tag-info-by-name dbh tag)))
   (if (not tag-info)
     (begin   
     (if (handle-exceptions
	   exn
︙
1013
1014
1015
1016
1017
1018
1019
1020

1021
1022
1023
1024
1025
1026
1027

1013
1014
1015
1016
1017
1018
1019

1020
1021
1022
1023
1024
1025
1026
1027








-
+








	   (pgdb:insert-area-tag  dbh   (vector-ref tag-info 0)  (vector-ref area-info 0))))))

(define (tasks:sync-run-data dbh cached-info run-ids area-info smallest-last-update-time) 
  (for-each
     (lambda (run-id)
      (debug:print-info 1 *default-log-port*   "Check if run with " run-id " needs to be synced" )
       (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time))
run-ids))
     run-ids))


;; get runs changed since last sync
;; (define (tasks:sync-test-data dbh cached-info area-info)
;;   (let* ((

(define (tasks:sync-to-postgres configdat dest)
︙

This page was generated in about 0.109s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00