Megatest

Check-in [6fa246c867]
Login
Overview
Comment:handled the missing args:remove-arg-from-ht
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.8031
Files: files | file ages | folders
SHA1: 6fa246c867ea3a517d93f98990e3ab8bbbeb3e37
User & Date: mmgraham on 2024-03-21 17:47:37
Other Links: branch diff | manifest | tags
Context
2024-04-05
18:08
minor adjustments to -import-sexpr check-in: dc61281d6c user: mmgraham tags: v1.8031
2024-03-21
17:47
handled the missing args:remove-arg-from-ht check-in: 6fa246c867 user: mmgraham tags: v1.8031
2024-03-14
17:53
corrected a debug:print syntax, corrected the match for servinfo content check-in: 3a97630ba6 user: mmgraham tags: v1.8031
Changes

Modified dashboard.scm from [be4fa4ae07] to [e5b27b795a].

3835
3836
3837
3838
3839
3840
3841

3842
3843
3844
3845
3846
3847
3848
3849
  ;; (print "Starting dashboard main")
    
  (let* ((mtdb-path (conc *toppath* "/.mtdb/main.db"))
         (target (args:get-arg "-target"))
         (commondat       (dboard:commondat-make)))
    (if target
        (begin

          (args:remove-arg-from-ht "-target")
          (dboard:commondat-target-set! commondat target)
        )
    )

    (if (not (launch:setup))
        (begin
          (debug:print 0 *default-log-port* "Failed to find megatest.config, exiting") 







>
|







3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
  ;; (print "Starting dashboard main")
    
  (let* ((mtdb-path (conc *toppath* "/.mtdb/main.db"))
         (target (args:get-arg "-target"))
         (commondat       (dboard:commondat-make)))
    (if target
        (begin
          (hash-table-delete! args:arg-hash "-target")  ;; workaround for the following commented out function
          ;; (args:remove-arg-from-ht "-target")   This function is in mtargs/mtargs.scm, but it's in an egg that is not in the current build of chicken 4.10
          (dboard:commondat-target-set! commondat target)
        )
    )

    (if (not (launch:setup))
        (begin
          (debug:print 0 *default-log-port* "Failed to find megatest.config, exiting") 

Modified mtargs/mtargs.scm from [09e4f74c98] to [c1d2bd2b3a].

18
19
20
21
22
23
24

25
26
27
28
29
30
31

(module mtargs
    (
     arg-hash
     get-arg
     get-arg-number
     get-arg-from

     get-args
     usage
     print-args
     any-defined?
     ) 

(import scheme) ;; gives us cond-expand in chicken-4







>







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

(module mtargs
    (
     arg-hash
     get-arg
     get-arg-number
     get-arg-from
     remove-arg-from-ht
     get-args
     usage
     print-args
     any-defined?
     ) 

(import scheme) ;; gives us cond-expand in chicken-4
62
63
64
65
66
67
68




69
70
71
72
73
74
75

;; (define any any-defined?)

(define (get-arg-from ht arg . default)
  (if (null? default)
      (hash-table-ref/default ht arg #f)
      (hash-table-ref/default ht arg (car default))))





(define (get-args args params switches arg-hash num-needed)
  (let* ((numtargs (length args))
	 (adj-num-needed (if num-needed (+ num-needed 2) #f)))
    (if (< numtargs (if adj-num-needed adj-num-needed 2))
	(if (>= num-needed 1)
	    (usage "No arguments provided")







>
>
>
>







63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

;; (define any any-defined?)

(define (get-arg-from ht arg . default)
  (if (null? default)
      (hash-table-ref/default ht arg #f)
      (hash-table-ref/default ht arg (car default))))

(define (remove-arg-from-ht arg)
      (hash-table-delete! arg-hash arg)
)

(define (get-args args params switches arg-hash num-needed)
  (let* ((numtargs (length args))
	 (adj-num-needed (if num-needed (+ num-needed 2) #f)))
    (if (< numtargs (if adj-num-needed adj-num-needed 2))
	(if (>= num-needed 1)
	    (usage "No arguments provided")