Megatest

Check-in [da872f4237]
Login
Overview
Comment:Made -import-sexpr work if runs or tests already exist.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.8031
Files: files | file ages | folders
SHA1: da872f4237c661128c7e6774693be3b53c19094c
User & Date: mmgraham on 2024-04-05 22:18:44
Other Links: branch diff | manifest | tags
Context
2024-08-16
11:45
Patched across adjutant code into v1.8031 Leaf check-in: d861259e2f user: matt tags: v1.8031-adjutant
2024-06-13
14:35
Cherrypicked 583699e19c and created branch v1.8031-dev check-in: 08b69a24b9 user: mrwellan tags: v1.81
2024-04-05
22:18
Made -import-sexpr work if runs or tests already exist. Leaf check-in: da872f4237 user: mmgraham tags: v1.8031
18:08
minor adjustments to -import-sexpr check-in: dc61281d6c user: mmgraham tags: v1.8031
Changes

Modified megatest.scm from [189af99523] to [8ff2c8d3e0].

2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650

2651
2652
2653
2654
2655
2656
2657
2658

2659
2660
2661
2662
2663
2664
2665
2634
2635
2636
2637
2638
2639
2640










2641








2642
2643
2644
2645
2646
2647
2648
2649







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







       'dejunk
       'adj-testids
       'old2new
       )
      (set! *didsomething* #t)))

(if (args:get-arg "-import-sexpr")
 (let*(
   (toppath (launch:setup))
   (tmppath (common:make-tmpdir-name toppath "")))
   (if (file-exists? (conc toppath "/.mtdb")) 
     (if (args:get-arg "-remove-dbs")
       (let* ((dbfiles (conc toppath "/.mtdb/* " tmppath "/*")))
        (debug:print 0 *default-log-port* "Removing db files: " dbfiles)
        (system (conc "rm -rvf " dbfiles))
       )
       (begin
 (begin
         (debug:print 0 *default-log-port* "ERROR: Cannot import sexpr with an existing DB present.")
         (debug:print 0 *default-log-port* "Add '-remove-dbs all'  to remove the current Megatest DBs.")
         (set! *didsomething* #t)
         (exit)
       )
     )
   )
   (db:setup)
   (launch:setup)
   (rmt:import-sexpr (args:get-arg "-import-sexpr"))
   (set! *didsomething* #t)))

(if (args:get-arg "-sync-to-megatest.db")
    (let* ((duh      (launch:setup))
	   (dbstruct (db:setup))
	   (tmpdbpth (dbr:dbstruct-tmppath dbstruct))

Modified rmtmod.scm from [fbb8bf5201] to [bb5d679cbc].

120
121
122
123
124
125
126
127
128












129
130
131
132
133
134
135
120
121
122
123
124
125
126


127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145







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







       (begin
        (debug:print 0 *default-log-port* "Found run-id " (simple-run-id (car runs)) " for runname " runname " target " target)
	(simple-run-id (car runs))
       ))))

(define (rmt:insert-test run-id test-rec)
  (let* ((testname  (alist-ref "testname" test-rec equal?))
	 (item-path (alist-ref "item_path" test-rec equal?)))
    (rmtmod:send-receive 'insert-test run-id test-rec)))
	 (item-path (alist-ref "item_path" test-rec equal?))
         (test-id (rmt:get-test-id run-id testname item-path))
         )
        (if test-id
          (debug:print 0 *default-log-port* "test "testname"/"item-path " already exists in run-id " run-id)
          (begin
            (debug:print 0 *default-log-port* " Insert test in run "run-id": "testname"/"item-path)
            (rmtmod:send-receive 'insert-test run-id test-rec)
          )
        )
  )
)

;;======================================================================
;;  T E S T S
;;======================================================================

;; Just some syntatic sugar
(define (rmt:register-test run-id test-name item-path)