Megatest

Check-in [f95edbc998]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Protected most create directories, remove directories and links with exception handling and (hopefully) the appropriate recovery action. In many cases I exit as usually this is due to permissions. In some cases I continue on after putting an error on stderr.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | development
Files: files | file ages | folders
SHA1: f95edbc998fe0e5789f2b73e8998303aaba20f94
User & Date: mrwellan on 2013-03-28 10:19:32
Other Links: branch diff | manifest | tags
Context
2013-03-28
13:57
Added exception handling to open of test specific db. check-in: 159e189c05 user: mrwellan tags: development
10:19
Protected most create directories, remove directories and links with exception handling and (hopefully) the appropriate recovery action. In many cases I exit as usually this is due to permissions. In some cases I continue on after putting an error on stderr. check-in: f95edbc998 user: mrwellan tags: development
07:43
Use -test-paths to find location to put eggs check-in: 72d5003fa7 user: matt tags: development
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified launch.scm from [f18b47fd5d] to [4243d5cf59].

︙
471
472
473
474
475
476
477





478

479
480








481
482





483

484
485
486
487
488
489
490





491

492
493
494
495
496
497





498
499


500
501
502
503
504
505
506
507
508
509
510
511








512

513
514
515
516
517
518
519

471
472
473
474
475
476
477
478
479
480
481
482

483
484

485
486
487
488
489
490
491
492
493
494
495
496
497
498
499

500
501
502
503
504
505
506
507
508
509
510
511
512

513
514
515
516

517
518
519
520
521
522
523


524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545

546
547
548
549
550
551
552
553








+
+
+
+
+
-
+

-
+
+
+
+
+
+
+
+


+
+
+
+
+
-
+







+
+
+
+
+
-
+



-


+
+
+
+
+
-
-
+
+












+
+
+
+
+
+
+
+
-
+








    ;; Now create the link from the test path to the link tree, however
    ;; if the test is iterated it is necessary to create the parent path
    ;; to the iteration. use pathname-directory to trim the path by one
    ;; level
    (if (not not-iterated) ;; i.e. iterated
	(let ((iterated-parent  (pathname-directory (conc lnkpath "/" item-path))))
	  (debug:print-info 2 "Creating iterated parent " iterated-parent)
	  (handle-exceptions
	   exn
	   (begin
	     (debug:print 0 "ERROR:  Failed to create directory " iterated-parent ((condition-property-accessor 'exn 'message) exn) ", exiting")
	     (exit 1))
	  (create-directory iterated-parent #t)))
	   (create-directory iterated-parent #t))))

    (if (symbolic-link? lnkpath) (delete-file lnkpath))
    (if (symbolic-link? lnkpath) 
	(handle-exceptions
	 exn
	 (begin
	   (debug:print 0 "ERROR:  Failed to remove symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", exiting")
	   (exit 1))
	 (delete-file lnkpath)))

    (if (not (or (file-exists? lnkpath)
		 (symbolic-link? lnkpath)))
	(handle-exceptions
	 exn
	 (begin
	   (debug:print 0 "ERROR:  Failed to create symlink " lnkpath ((condition-property-accessor 'exn 'message) exn) ", exiting")
	   (exit 1))
	(create-symbolic-link toptest-path lnkpath))
	 (create-symbolic-link toptest-path lnkpath)))
    
    ;; The toptest path has been created, the link to the test in the linktree has
    ;; been created. Now, if this is an iterated test the real test dir must be created
    (if (not not-iterated) ;; this is an iterated test
	(let ((lnktarget (conc lnkpath "/" item-path)))
	  (debug:print 2 "Setting up sub test run area")
	  (debug:print 2 " - creating run area in " test-path)
	  (handle-exceptions
	   exn
	   (begin
	     (debug:print 0 "ERROR:  Failed to create directory " test-path ((condition-property-accessor 'exn 'message) exn) ", exiting")
	     (exit 1))
	  (create-directory test-path #t) ;; (system  (conc "mkdir -p " test-path))
	   (create-directory test-path #t))
	  (debug:print 2 
		       " - creating link from: " test-path "\n"
		       "                   to: " lnktarget)
	  ;; (create-directory lnkpath #t) ;; (system  (conc "mkdir -p " lnkpath))

	  ;; If there is already a symlink delete it and recreate it.
	  (handle-exceptions
	   exn
	   (begin
	     (debug:print 0 "ERROR:  Failed to re-create link " linktarget ((condition-property-accessor 'exn 'message) exn) ", exiting")
	     (exit))
	  (if (symbolic-link? lnktarget)     (delete-file lnktarget))
	  (if (not (file-exists? lnktarget)) (create-symbolic-link test-path lnktarget))))
	   (if (symbolic-link? lnktarget)     (delete-file lnktarget))
	   (if (not (file-exists? lnktarget)) (create-symbolic-link test-path lnktarget)))))

    ;; I suspect this section was deleting test directories under some 
    ;; wierd sitations? This doesn't make sense - reenabling the rm -f 
    ;; I honestly don't remember *why* this chunk was needed...
    ;; (let ((testlink (conc lnkpath "/" testname)))
    ;;   (if (and (file-exists? testlink)
    ;;            (or (regular-file? testlink)
    ;;     	   (symbolic-link? testlink)))
    ;;       (system (conc "rm -f " testlink)))
    ;;   (system  (conc "ln -sf " test-path " " testlink)))
    (if (directory? test-path)
	(begin
	  (let* ((ovrcmd (let ((cmd (config-lookup *configdat* "setup" "testcopycmd")))
			   (if cmd
			       ;; substitute the TEST_SRC_PATH and TEST_TARG_PATH
			       (string-substitute "TEST_TARG_PATH" test-path
						  (string-substitute "TEST_SRC_PATH" test-src-path cmd))
			       #f)))
		 (cmd    (if ovrcmd 
			     ovrcmd
	  (let* ((cmd    (conc "rsync -av" (if (debug:debug-mode 1) "" "q") " " test-src-path "/ " test-path "/"))
			     (conc "rsync -av" (if (debug:debug-mode 1) "" "q") " " test-src-path "/ " test-path "/")))
		 (status (system cmd)))
	    (if (not (eq? status 0))
		(debug:print 2 "ERROR: problem with running \"" cmd "\"")))
	  (list lnkpathf lnkpath ))
	(list #f #f))))

;; 1. look though disks list for disk with most space
︙

Modified mkdeploy/megatest.config from [5868ae3469] to [abe5540207].

︙
21
22
23
24
25
26
27


28

21
22
23
24
25
26
27
28
29
30








+
+


[disks]
disk0 #{getenv MT_RUN_AREA_HOME}/runs

# put env-override last so definitions in site.config by default
# are added as env-override variables
#
[env-override]

# if the file site.config exists it will be used
[include site.config]

Modified runs.scm from [8801ee7227] to [1603d85928].

︙
815
816
817
818
819
820
821



822

823
824
825



826

827
828
829
830
831
832
833

815
816
817
818
819
820
821
822
823
824

825
826
827
828
829
830
831

832
833
834
835
836
837
838
839








+
+
+
-
+



+
+
+
-
+








				   (debug:print 0 "WARNING: test dir " real-dir " appears to not exist or is not readable")))
			     (if real-dir 
				 (debug:print 0 "WARNING: directory " real-dir " does not exist")
				 (debug:print 0 "WARNING: no real directory corrosponding to link " run-dir ", nothing done")))
			 (if (symbolic-link? run-dir)
			     (begin
			       (debug:print-info 1 "Removing symlink " run-dir)
			       (handle-exceptions
				exn
				(debug:print 0 "ERROR:  Failed to remove symlink " run-dir ((condition-property-accessor 'exn 'message) exn) ", attempting to continue")
			       (delete-file run-dir))
				(delete-file run-dir)))
			     (if (directory? run-dir)
				 (if (> (directory-fold (lambda (f x)(+ 1 x)) 0 run-dir) 0)
				     (debug:print 0 "WARNING: refusing to remove " run-dir " as it is not empty")
				      (handle-exceptions
				       exn
				       (debug:print 0 "ERROR:  Failed to remove directory " run-dir ((condition-property-accessor 'exn 'message) exn) ", attempting to continue")
				     (delete-directory run-dir)) ;; it should be empty by here BUG BUG, add error catch
				       (delete-directory run-dir)))
				 (if run-dir
				     (debug:print 0 "WARNING: not removing " run-dir " as it either doesn't exist or is not a symlink")
				     (debug:print 0 "NOTE: the run dir for this test is undefined. Test may have already been deleted."))
				 )))
			((set-state-status)
			 (debug:print-info 2 "new state " (car state-status) ", new status " (cadr state-status))
			 (open-run-close db:test-set-state-status-by-id db (db:test-get-id test) (car state-status)(cadr state-status) #f)))))
︙

Modified tests/fullrun/megatest.config from [5c1993a08a] to [5787cd5928]. 

1
2
3
4
5
6
7
8
9
10
11
12
13











14
15
16
17
18
19
20

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31














+
+
+
+
+
+
+
+
+
+
+








[fields]
sysname TEXT
fsname TEXT
datapath TEXT

# refareas can be searched to find previous runs
# the path points to where megatest.db exists
[refareas]
area1 /tmp/oldarea/megatest

[include #{getenv MT_RUN_AREA_HOME}/config/mt_include_1.config]

[setup]

# It is possible (but not recommended) to override the rsync command used
# to populate the test directories. For test development the following 
# example can be useful
#
testcopycmd cp --remove-destination -rsv TEST_SRC_PATH/. TEST_TARG_PATH/.

# or for hard links

# testcopycmd cp --remove-destination -rlv TEST_SRC_PATH/ TEST_TARG_PATH/

# FULL or 2, NORMAL or 1, OFF or 0
synchronous OFF
# Throttle roughly scales the db access milliseconds to seconds delay
throttle 0.2
# Max retries allows megatest to re-check that a tests status has changed
# as tests can have transient FAIL status occasionally
maxretries 20
︙

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