Megatest

Check-in [dc61281d6c]
Login
Overview
Comment:minor adjustments to -import-sexpr
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.8031
Files: files | file ages | folders
SHA1: dc61281d6c72882161e75b9300adf7eca03f6ecb
User & Date: mmgraham on 2024-04-05 18:08:00
Other Links: branch diff | manifest | tags
Context
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
2024-03-21
17:47
handled the missing args:remove-arg-from-ht check-in: 6fa246c867 user: mmgraham tags: v1.8031
Changes

Modified megatest.scm from [33565db1f2] to [189af99523].

2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
       (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)
       )
     )
     (debug:print 0 *default-log-port* "Did not find " (conc toppath "/.mtdb"))
   )
   (db:setup)
   (rmt:import-sexpr (args:get-arg "-import-sexpr"))
   (set! *didsomething* #t)))

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







<







2650
2651
2652
2653
2654
2655
2656

2657
2658
2659
2660
2661
2662
2663
       (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)
   (rmt:import-sexpr (args:get-arg "-import-sexpr"))
   (set! *didsomething* #t)))

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

Modified rmtmod.scm from [883a743d2f] to [fbb8bf5201].

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
  (let* ((runname    (car run-dat))
	 (all-dat    (cdr run-dat))
	 (tests-data (alist-ref "data" all-dat equal?))
	 (run-meta   (alist-ref "meta" all-dat equal?))
         (run-id     (string->number (alist-ref "id"   run-meta equal?))))

    (rmt:insert-run run-id target runname run-meta)



    (for-each
     (lambda (test-dat)
       (let* ((test-id  (car test-dat))
	      (test-rec (cdr test-dat)))
	 (rmt:insert-test run-id test-rec)))
     tests-data)))






;; insert run if not there, return id either way
(define (rmt:insert-run run-id target runname run-meta)
  ;; look for id, return if found
  (debug:print 0 *default-log-port* "Insert run: "target"/"runname)
  (let* ((runs (rmtmod:send-receive 'simple-get-runs #f
				    ;;    runpatt count offset target last-update)
				    (list runname #f    #f     target #f))))
    (if (null? runs)
       (begin
        (debug:print 0 *default-log-port* "inserting run for runname " runname " target " target)
	(rmtmod:send-receive 'insert-run #f (list run-id target runname run-meta))
       )
       (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)))








>
>
>
|
|
|

|
|
>
>
>
>
>




<










|
<







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
  (let* ((runname    (car run-dat))
	 (all-dat    (cdr run-dat))
	 (tests-data (alist-ref "data" all-dat equal?))
	 (run-meta   (alist-ref "meta" all-dat equal?))
         (run-id     (string->number (alist-ref "id"   run-meta equal?))))

    (rmt:insert-run run-id target runname run-meta)
    (if (list? tests-data)
      (begin
        (debug:print 0 *default-log-port* "import-run: inserting " (length tests-data) " tests")
        (for-each
          (lambda (test-dat)
            (let* ((test-id  (car test-dat))
	      (test-rec (cdr test-dat)))
	      (rmt:insert-test run-id test-rec)))
         tests-data)
      )
      (debug:print 0 *default-log-port* "import-run: run has no tests")
    )
  )
)

;; insert run if not there, return id either way
(define (rmt:insert-run run-id target runname run-meta)
  ;; look for id, return if found

  (let* ((runs (rmtmod:send-receive 'simple-get-runs #f
				    ;;    runpatt count offset target last-update)
				    (list runname #f    #f     target #f))))
    (if (null? runs)
       (begin
        (debug:print 0 *default-log-port* "inserting run for runname " runname " target " target)
	(rmtmod:send-receive 'insert-run #f (list run-id target runname run-meta))
       )
       (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)))