Random Bits of Open Code

Check-in [3602c6e29e]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:fixed rget in mtconfigf
Timelines: family | ancestors | descendants | both | modularize-debug
Files: files | file ages | folders
SHA1:3602c6e29edb82010bbaca2200dd2e7b2591ca3b
User & Date: bjbarcla 2019-01-07 18:18:27
Context
2019-01-07
18:52
added mtconfigf test for eval-string-in-environment check-in: 859807ca0b user: bjbarcla tags: modularize-debug
18:18
fixed rget in mtconfigf check-in: 3602c6e29e user: bjbarcla tags: modularize-debug
17:17
updated add-eval-string in mtconfigf to uniquify added strings check-in: 46f419b7b7 user: bjbarcla tags: modularize-debug
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to mtutils/mtconfigf/mtconfigf.scm.

302
303
304
305
306
307
308

309
310
311
312
313
314
315
...
373
374
375
376
377
378
379


380
381
382
383
384
385
386
387
;; 
(define (runconfigs-get config var) ;; .dvars is a special bin for storing metadata such as target
  (let ((targ (lookup config ".dvars" "target"))) ;; (common:args-get-target))) ;; (or (args:get-arg "-reqtarg")(args:get-arg "-target")(getenv "MT_TARGET"))))
    (if targ
	(or (lookup config targ var)
	    (lookup config "default" var))
	(lookup config "default" var))))


(define (realpath x) (resolve-pathname  (pathname-expand (or x "/dev/null")) ))
(define (common:get-this-exe-fullpath #!key (argv (argv)))
  (let* ((this-script
          (cond
           ((and (> (length argv) 2)
                 (string-match "^(.*/csi|csi)$" (car argv))
................................................................................
				       (conc "; " (string-intersperse (map conc arguments) ", "))
				       ""))
		      ;; (debug:print 0 *default-log-port* "exn=" (condition->list exn))
		      (set! result (conc "#{( " cmdtype ") " cmd "}, full expansion: " fullcmd)))
		  (if (or allow-system
			  (not (member cmdtype '("system" "shell" "sh"))))
                      (if (member cmdsym '(runconfigs-get rget))


                          fullcmd
		          (with-input-from-string fullcmd
			    (lambda ()
			      (set! result ((eval (read)#;(module-environment 'mtconfigf)) ht)))))
		      (set! result (conc "#{(" cmdtype ") "  cmd "}"))))
		(case cmdsym
		  ((system shell scheme scm sh)
		   (let ((delta (- (current-seconds) start-time)))







>







 







>
>
|







302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
...
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
;; 
(define (runconfigs-get config var) ;; .dvars is a special bin for storing metadata such as target
  (let ((targ (lookup config ".dvars" "target"))) ;; (common:args-get-target))) ;; (or (args:get-arg "-reqtarg")(args:get-arg "-target")(getenv "MT_TARGET"))))
    (if targ
	(or (lookup config targ var)
	    (lookup config "default" var))
	(lookup config "default" var))))


(define (realpath x) (resolve-pathname  (pathname-expand (or x "/dev/null")) ))
(define (common:get-this-exe-fullpath #!key (argv (argv)))
  (let* ((this-script
          (cond
           ((and (> (length argv) 2)
                 (string-match "^(.*/csi|csi)$" (car argv))
................................................................................
				       (conc "; " (string-intersperse (map conc arguments) ", "))
				       ""))
		      ;; (debug:print 0 *default-log-port* "exn=" (condition->list exn))
		      (set! result (conc "#{( " cmdtype ") " cmd "}, full expansion: " fullcmd)))
		  (if (or allow-system
			  (not (member cmdtype '("system" "shell" "sh"))))
                      (if (member cmdsym '(runconfigs-get rget))
                          (begin
                            (set! result fullcmd)
                            fullcmd)
		          (with-input-from-string fullcmd
			    (lambda ()
			      (set! result ((eval (read)#;(module-environment 'mtconfigf)) ht)))))
		      (set! result (conc "#{(" cmdtype ") "  cmd "}"))))
		(case cmdsym
		  ((system shell scheme scm sh)
		   (let ((delta (- (current-seconds) start-time)))

Changes to mtutils/mtconfigf/tests/run.scm.

22
23
24
25
26
27
28
29

30
31
32
33
34
35
36
  (test #f 2 (config:lookup-number cfgdat "basic" "two"))
  
  )

(config:add-eval-string "(define (customfunc) \"hello\")")
(let* ((cfgdat
        (config:read-config "tests/test2.config" #f #f)))
  (test #f "bar" (config:lookup cfgdat "schemy" "rgetref"))

  (test #f "2" (config:lookup cfgdat "schemy" "addup"))
  (test #f 2 (config:lookup-number cfgdat "schemy" "addup"))
  (test #f "hello" (config:lookup cfgdat "schemy" "custom"))
  )


(let* ((cfgdat







|
>







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
  (test #f 2 (config:lookup-number cfgdat "basic" "two"))
  
  )

(config:add-eval-string "(define (customfunc) \"hello\")")
(let* ((cfgdat
        (config:read-config "tests/test2.config" #f #f)))
  (test #f "bar" (config:lookup cfgdat "schemy" "rgetreftarget"))
  (test #f "baz" (config:lookup cfgdat "schemy" "rgetrefdefault"))
  (test #f "2" (config:lookup cfgdat "schemy" "addup"))
  (test #f 2 (config:lookup-number cfgdat "schemy" "addup"))
  (test #f "hello" (config:lookup cfgdat "schemy" "custom"))
  )


(let* ((cfgdat

Changes to mtutils/mtconfigf/tests/test2.config.







1
2
3
4
5
6
7
8
9
10







[.dvars]
target reference

[reference]
foo bar

[schemy]
addup #{scheme (+ 1 1)}
custom #{scheme (customfunc)}
rgetref #{rget foo}

>
>
>
>
>
>

|

<
<




|
>
1
2
3
4
5
6
7
8
9


10
11
12
13
14
15
[default]
deffoo baz

[a-target]
foo bar

[.dvars]
target a-target




[schemy]
addup #{scheme (+ 1 1)}
custom #{scheme (customfunc)}
rgetreftarget #{rget foo}
rgetrefdefault #{rget deffoo}