Megatest

Check-in [17048d6779]
Login
Overview
Comment:A couple of fixes to remove compile warnings
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.90
Files: files | file ages | folders
SHA1: 17048d6779e2c6cba5978fe715a0a1a228171935
User & Date: mmgraham on 2024-02-06 16:02:19
Other Links: branch diff | manifest | tags
Context
2024-02-08
08:14
Merged fork check-in: b8c6e3aae0 user: mrwellan tags: v1.90
2024-02-06
16:02
A couple of fixes to remove compile warnings check-in: 17048d6779 user: mmgraham tags: v1.90
15:13
Added import of megatestmod to dashboard-context-menu.scm to fix testconfig editing check-in: 0475314063 user: mmgraham tags: v1.90
Changes

Modified archivemod.scm from [e47f9a6099] to [7184f03fc6].

234
235
236
237
238
239
240
241

242
243
244
245
246
247

248
249
250
251
252
253
254
234
235
236
237
238
239
240

241
242
243
244
245
246

247
248
249
250
251
252
253
254







-
+





-
+







        (archiver       (let ((s (configf:lookup *configdat* "archive" "archiver")))
			   (if s (string->symbol s) 'bup)))
        (rsync-exe (or (configf:lookup *configdat* "archive" "rsync") "rsync"))   
        (print-prefix      "Running: ") 
        (archive-info (archive:allocate-new-archive-block blockid-cache *toppath* tsname min-space target-patt run-patt "megatest-db"))
	(archive-dir  (if archive-info (cdr archive-info) #f))
	(archive-id   (if archive-info (car archive-info) -1))
        (home-host    #f) ;; FIXME! (server:choose-server *toppath* 'homehost))
        (home-host    (get-host-name)) ;; FIXME! (server:choose-server *toppath* 'homehost))
        (archive-time (seconds->std-time-str (current-seconds)))
        (archive-staging-db (conc *toppath* "/.db-snapshot/archive_" archive-time))
        (tmp-db-path (conc (dbfile:make-tmpdir-name *toppath* "") "/megatest.db"))
        (dbfile             (conc  archive-staging-db "/megatest.db"))) 
        (create-directory archive-staging-db #t)
        (let-values (((pid-val exit-status exit-code) (run-n-wait rsync-exe params: (list "-v" (conc (car home-host) ":"tmp-db-path) archive-staging-db) print-cmd: print-prefix)))
        (let-values (((pid-val exit-status exit-code) (run-n-wait rsync-exe params: (list "-v" (conc home-host ":"tmp-db-path) archive-staging-db) print-cmd: print-prefix)))
            (if (eq? exit-code 0)   
              (case archiver
	        ((bup) ;; Archive using bup
	          (let* ((bup-init-params  (list "-d" archive-dir "init"))
		         (bup-index-params (list "-d" archive-dir "index" archive-staging-db))
		         (bup-save-params  (list "-d" archive-dir "save" ;; (conc "--strip-path=" linktree)
						     (conc "-" compress) ;; or (conc "--compress=" compress)

Modified stml2/stml2.scm from [ee4c13898d] to [2ad7e0b3e0].

1148
1149
1150
1151
1152
1153
1154
1155

1156
1157
1158
1159
1160
1161
1162
1148
1149
1150
1151
1152
1153
1154

1155
1156
1157
1158
1159
1160
1161
1162







-
+







	    ;; 		       (munged (s:process-cgi-input datstr)))
	    ;; 		  (print "datstr: " datstr " munged: " munged)
	    (if (and (not (null? alldats))
		     (not (null? (car alldats)))
		     (not (null? (caar alldats))))
		(formdat:load formdat  (s:process-cgi-input (caaar alldats))))) ;; munged))
	;;		    (format debugp "formdat : name: ~A content: ~A\n" name content)
	(if debugp (close-output-port debugp))
	;; (if debugp (close-output-port debugp))
	;; (sdat-formdat-set! s:session formdat)
	formdat))))
		
#|
(define inp (open-input-file "tests/example.post.in"))
(define dat (read-string #f inp))
(define datstr (open-input-string dat))