Megatest

Diff
Login

Differences From Artifact [678efe323e]:

To Artifact [346b188c56]:


1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483

1484


1485


1486
1487
1488
1489

1490
1491

1492
1493
1494
1495
1496
1497
1498
1499
1500

1501
1502
1503
1504

1505


1506








1507
1508
1509
1510
1511
1512
1513
1514
1515



1516
1517
1518

1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
  (let ((runs (db:simple-get-runs dbstruct runname #f #f target #f))) ;; runpatt count offset target last-update
    (if (null? runs)
	#f
	(simple-run-id (car runs)))))

;; called with run-id=#f so will operate on main.db
;;
(define (db:insert-run dbstruct target runname run-meta)
  (let* ((keys (db:get-keys dbstruct))
     	 (runs (db:simple-get-runs dbstruct runname #f #f target #f))) ;; runpatt count offset target last-update
    ;; need to insert run based on target and runname
    (let* ((targvals (string-split target "/"))
	   (keystr   (string-intersperse keys ","))
	   (key?str  (string-intersperse (make-list (length targvals) "?") ","))
	   (qrystr   (conc "INSERT INTO runs (runname,"keystr") VALUES (?,"key?str")"))
	   (get-var  (lambda (db qrystr)
		       (let* ((res #f))
			 (sqlite3:for-each-row
			  (lambda row
			    (set res (car row)))
			  db qrystr runname)
			 res))))
      (if (null? runs)

	  (db:create-initial-run-record dbstruct runname target))


      (let* ((run-id (db:get-run-id dbstruct runname target)))


	(db:with-db
	 dbstruct
	 #f #t
	 (lambda (dbdat db)

	   (for-each
	    (lambda (keyval)

	      (let* ((fieldname (car keyval))
		     (getqry    (conc "SELECT "fieldname" FROM runs WHERE id=?;"))
		     (setqry    (conc "UPDATE runs SET "fieldname"=? WHERE id=?;"))
		     (val       (cdr keyval))
		     (valnum    (if (number? val)
				    val
				    (if (string? val)
					(string->number val)
					#f))))

		(if (not (member fieldname (cons "runname" keys))) ;; don't attempt to tweak these
		    (let* ((curr-val (get-var db getqry))
			   (have-it  (or (equal? curr-val val)
					 (equal? curr-val valnum))))

		      (if (not have-it)


			  (sqlite3:execute db setqry (or valnum val) run-id))))))








	    run-meta)))
	run-id))))
  
(define (db:create-initial-run-record dbstruct runname target)	  
  (let* ((keys     (db:get-keys dbstruct))
     	 (targvals (string-split target "/"))
	 (keystr   (string-intersperse keys ","))
	 (key?str  (string-intersperse (make-list (length targvals) "?") ","))
	 (qrystr   (conc "INSERT INTO runs (runname,"keystr") VALUES (?,"key?str")")))



    (db:with-db
     dbstruct #f #t
     (lambda (dbdat db)

       (apply sqlite3:execute db qrystr runname targvals)))))

(define (db:insert-test dbstruct run-id test-rec)
  (let* ((testname  (alist-ref "testname" test-rec equal?))
	 (item-path (alist-ref "item_path" test-rec equal?))
	 (id        (db:get-test-id dbstruct run-id testname item-path))
	 (fieldvals (filter (lambda (x)(not (member (car x) '("id" "last_update")))) test-rec))
	 (setqry    (conc "UPDATE tests SET "(string-intersperse
					      (map (lambda (dat)
						     (conc (car dat)"=?"))
						   fieldvals)
					      ",")" WHERE id=?;"))
	 (insqry   (conc "INSERT INTO tests ("(string-intersperse (map (lambda (x) (car x)) fieldvals) ",")
			 ") VALUES ("(string-intersperse (make-list (length fieldvals) "?") ",")");")))
    (debug:print 0 *default-log-port* "id: "id"\nset: "setqry"\ninsqry: "insqry)
    (db:with-db
     dbstruct
     run-id #t
     (lambda (dbdat db)
       (if id
	   (apply sqlite3:execute db setqry (append (map cdr fieldvals) (list id)))
	   (apply sqlite3:execute db insqry (map cdr fieldvals)))))))







|






|





|


>
|
>
>
|
>
>
|



>


>









>




>

>
>
|
>
>
>
>
>
>
>
>



|



|
|
>
>
>

|

>
|













|







1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
  (let ((runs (db:simple-get-runs dbstruct runname #f #f target #f))) ;; runpatt count offset target last-update
    (if (null? runs)
	#f
	(simple-run-id (car runs)))))

;; called with run-id=#f so will operate on main.db
;;
(define (db:insert-run dbstruct run-id target runname run-meta)
  (let* ((keys (db:get-keys dbstruct))
     	 (runs (db:simple-get-runs dbstruct runname #f #f target #f))) ;; runpatt count offset target last-update
    ;; need to insert run based on target and runname
    (let* ((targvals (string-split target "/"))
	   (keystr   (string-intersperse keys ","))
	   (key?str  (string-intersperse (make-list (length targvals) "?") ","))
	   (qrystr   (conc "INSERT INTO runs (id,runname,"keystr") VALUES (?,?,"key?str")"))
	   (get-var  (lambda (db qrystr)
		       (let* ((res #f))
			 (sqlite3:for-each-row
			  (lambda row
			    (set res (car row)))
			  db qrystr run-id runname)
			 res))))
      (if (null? runs)
        (begin
	  (db:create-initial-run-record dbstruct run-id runname target)
        )
      )
      (let* ()
        ;;(debug:print 0 *default-log-port* "db:insert-run: Calling db:with-db to update the run record")
        (debug:print 0 *default-log-port* "db:insert-run: runid = " run-id)
#; (db:with-db
	 dbstruct
	 #f #t
	 (lambda (dbdat db)
           (debug:print 0 *default-log-port* "In the lambda proc for " dbdat " " db)
	   (for-each
	    (lambda (keyval)
              (debug:print 0 *default-log-port* "In the lambda proc for " keyval)
	      (let* ((fieldname (car keyval))
		     (getqry    (conc "SELECT "fieldname" FROM runs WHERE id=?;"))
		     (setqry    (conc "UPDATE runs SET "fieldname"=? WHERE id=?;"))
		     (val       (cdr keyval))
		     (valnum    (if (number? val)
				    val
				    (if (string? val)
					(string->number val)
					#f))))
                (debug:print 0 *default-log-port* "fieldname " fieldname " val " val " valnum " valnum)
		(if (not (member fieldname (cons "runname" keys))) ;; don't attempt to tweak these
		    (let* ((curr-val (get-var db getqry))
			   (have-it  (or (equal? curr-val val)
					 (equal? curr-val valnum))))
                      (debug:print 0 *default-log-port* "have-it = " have-it)
		      (if (not have-it)
                        (begin
                          (debug:print 0 *default-log-port* "Do sqlite3:execute")
			  ;; (sqlite3:execute db setqry (or valnum val) run-id)
                        )
                      )
                    )
                 )
                (debug:print 0 *default-log-port* "Done with update")
              )
              (debug:print 0 *default-log-port* "next keyval")
            )
	    run-meta)))
	run-id))))
  
(define (db:create-initial-run-record dbstruct run-id runname target)	  
  (let* ((keys     (db:get-keys dbstruct))
     	 (targvals (string-split target "/"))
	 (keystr   (string-intersperse keys ","))
	 (key?str  (string-intersperse (make-list (length targvals) "?") ",")) ;; a string with the same length as targvals, where each element is "?" and interspersed with commas.
	 (qrystr   (conc "INSERT INTO runs (id,runname,"keystr") VALUES (?,?,"key?str")")))
    (debug:print 0 *default-log-port* "db:create-initial-run-record")
    (debug:print 0 *default-log-port* "qrystr = " qrystr)

    (db:with-db
     dbstruct #f #t ;; run-id writable
     (lambda (dbdat db)
       (debug:print 0 *default-log-port* "lambda proc: dbdat: " dbdat " db: " db) 
       (apply sqlite3:execute db qrystr run-id runname targvals)))))

(define (db:insert-test dbstruct run-id test-rec)
  (let* ((testname  (alist-ref "testname" test-rec equal?))
	 (item-path (alist-ref "item_path" test-rec equal?))
	 (id        (db:get-test-id dbstruct run-id testname item-path))
	 (fieldvals (filter (lambda (x)(not (member (car x) '("id" "last_update")))) test-rec))
	 (setqry    (conc "UPDATE tests SET "(string-intersperse
					      (map (lambda (dat)
						     (conc (car dat)"=?"))
						   fieldvals)
					      ",")" WHERE id=?;"))
	 (insqry   (conc "INSERT INTO tests ("(string-intersperse (map (lambda (x) (car x)) fieldvals) ",")
			 ") VALUES ("(string-intersperse (make-list (length fieldvals) "?") ",")");")))
    ;; (debug:print 0 *default-log-port* "id: "id"\nset: "setqry"\ninsqry: "insqry)
    (db:with-db
     dbstruct
     run-id #t
     (lambda (dbdat db)
       (if id
	   (apply sqlite3:execute db setqry (append (map cdr fieldvals) (list id)))
	   (apply sqlite3:execute db insqry (map cdr fieldvals)))))))