Megatest

Diff
Login

Differences From Artifact [b0572d4f5a]:

To Artifact [eb94f77d10]:


377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394

;; run all tests are are Not COMPLETED and PASS or CHECK
(if (args:get-arg "-runall")
    (general-run-call 
     "-runall"
     "run all tests"
     (lambda (target runname keys keynames keyvallst)
;;       (let ((flags (make-hash-table)))
;;	 (for-each (lambda (parm)
;;		     (hash-table-set! flags parm (args:get-arg parm)))
;;		   (list "-rerun" "-force" "-itempatt"))
	 (runs:run-tests target
			 runname
			 (args:get-arg "-runtests")
			 user
			 args:arg-hash)))) ;; )

;;======================================================================







<
<
<
<







377
378
379
380
381
382
383




384
385
386
387
388
389
390

;; run all tests are are Not COMPLETED and PASS or CHECK
(if (args:get-arg "-runall")
    (general-run-call 
     "-runall"
     "run all tests"
     (lambda (target runname keys keynames keyvallst)




	 (runs:run-tests target
			 runname
			 (args:get-arg "-runtests")
			 user
			 args:arg-hash)))) ;; )

;;======================================================================
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
	       (logfile  (args:get-arg "-setlog")))
	  (change-directory testpath)
	  (if (not (setup-for-run))
	      (begin
		(debug:print 0 "Failed to setup, exiting")
		(exit 1)))
	  (if (and state status)
	      (open-run-close db:teststep-set-status! db test-id step state status itemdat (args:get-arg "-m") logfile)
	      (begin
		(debug:print 0 "ERROR: You must specify :state and :status with every call to -step")
		(exit 6)))
	  (if db (sqlite3:finalize! db))
	  (set! *didsomething* #t))))

(if (or (args:get-arg "-setlog")       ;; since setting up is so costly lets piggyback on -test-status







|







597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
	       (logfile  (args:get-arg "-setlog")))
	  (change-directory testpath)
	  (if (not (setup-for-run))
	      (begin
		(debug:print 0 "Failed to setup, exiting")
		(exit 1)))
	  (if (and state status)
	      (open-run-close db:teststep-set-status! db test-id step state status (args:get-arg "-m") logfile)
	      (begin
		(debug:print 0 "ERROR: You must specify :state and :status with every call to -step")
		(exit 6)))
	  (if db (sqlite3:finalize! db))
	  (set! *didsomething* #t))))

(if (or (args:get-arg "-setlog")       ;; since setting up is so costly lets piggyback on -test-status
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
				       ((tcsh csh ksh)    ">&")
				       ((zsh bash sh ash) "2>&1 >")
				       (else ">&")))
			 (fullcmd    (conc "(" (string-intersperse 
						(cons cmd params) " ")
					   ") " redir " " logfile)))
		    ;; mark the start of the test
		    (open-run-close db:teststep-set-status! db test-id stepname "start" "n/a" itemdat (args:get-arg "-m") logfile)
		    ;; run the test step
		    (debug:print 2 "INFO: Running \"" fullcmd "\"")
		    (change-directory startingdir)
		    (set! exitstat (system fullcmd)) ;; cmd params))
		    (set! *globalexitstatus* exitstat)
		    (change-directory testpath)
		    ;; run logpro if applicable ;; (process-run "ls" (list "/foo" "2>&1" "blah.log"))
		    (if logprofile
			(let* ((htmllogfile (conc stepname ".html"))
			       (oldexitstat exitstat)
			       (cmd         (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " ")))
			  (debug:print 2 "INFO: running \"" cmd "\"")
			  (change-directory startingdir)
			  (set! exitstat (system cmd))
			  (set! *globalexitstatus* exitstat) ;; no necessary
			  (change-directory testpath)
			  (open-run-close db:test-set-log! db test-id htmllogfile)))
		    (let ((msg (args:get-arg "-m")))
		      (open-run-close db:teststep-set-status! db test-id stepname "end" exitstat itemdat msg logfile))
		    )))
	  (if (or (args:get-arg "-test-status")
		  (args:get-arg "-set-values"))
	      (let ((newstatus (cond
				((number? status)       (if (equal? status 0) "PASS" "FAIL"))
				((and (string? status)
				      (string->number status))(if (equal? (string->number status) 0) "PASS" "FAIL"))







|


















|







667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
				       ((tcsh csh ksh)    ">&")
				       ((zsh bash sh ash) "2>&1 >")
				       (else ">&")))
			 (fullcmd    (conc "(" (string-intersperse 
						(cons cmd params) " ")
					   ") " redir " " logfile)))
		    ;; mark the start of the test
		    (open-run-close db:teststep-set-status! db test-id stepname "start" "n/a" (args:get-arg "-m") logfile)
		    ;; run the test step
		    (debug:print 2 "INFO: Running \"" fullcmd "\"")
		    (change-directory startingdir)
		    (set! exitstat (system fullcmd)) ;; cmd params))
		    (set! *globalexitstatus* exitstat)
		    (change-directory testpath)
		    ;; run logpro if applicable ;; (process-run "ls" (list "/foo" "2>&1" "blah.log"))
		    (if logprofile
			(let* ((htmllogfile (conc stepname ".html"))
			       (oldexitstat exitstat)
			       (cmd         (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " ")))
			  (debug:print 2 "INFO: running \"" cmd "\"")
			  (change-directory startingdir)
			  (set! exitstat (system cmd))
			  (set! *globalexitstatus* exitstat) ;; no necessary
			  (change-directory testpath)
			  (open-run-close db:test-set-log! db test-id htmllogfile)))
		    (let ((msg (args:get-arg "-m")))
		      (open-run-close db:teststep-set-status! db test-id stepname "end" exitstat msg logfile))
		    )))
	  (if (or (args:get-arg "-test-status")
		  (args:get-arg "-set-values"))
	      (let ((newstatus (cond
				((number? status)       (if (equal? status 0) "PASS" "FAIL"))
				((and (string? status)
				      (string->number status))(if (equal? (string->number status) 0) "PASS" "FAIL"))
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
(if (args:get-arg "-repl")
    (let* ((toppath (setup-for-run))
	   (db      (if toppath (open-db) #f)))
      (if db
	  (begin
	    (set! *db* db)
	    (if (not (args:get-arg "-server"))
		(server:client-setup db))
	    (import readline)
	    (import apropos)
	    (gnu-history-install-file-manager
	     (string-append
	      (or (get-environment-variable "HOME") ".") "/.megatest_history"))
	    (current-input-port (make-gnu-readline-port "megatest> "))
	    (repl)))







|







787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
(if (args:get-arg "-repl")
    (let* ((toppath (setup-for-run))
	   (db      (if toppath (open-db) #f)))
      (if db
	  (begin
	    (set! *db* db)
	    (if (not (args:get-arg "-server"))
		(server:client-setup))
	    (import readline)
	    (import apropos)
	    (gnu-history-install-file-manager
	     (string-append
	      (or (get-environment-variable "HOME") ".") "/.megatest_history"))
	    (current-input-port (make-gnu-readline-port "megatest> "))
	    (repl)))