Better checking for the inter-switch dependencies.
In particular, the code now complains if -e was used with an end-option, switches to non-interactive-mode for -e and ensures that -ds,-dm, and -de always get -s <script> as end-option. In addition, better diagnostics is provided.
This commit is contained in:
		
							parent
							
								
									bd890a7338
								
							
						
					
					
						commit
						388d2f7b2b
					
				
							
								
								
									
										55
									
								
								scsh/top.scm
								
								
								
								
							
							
						
						
									
										55
									
								
								scsh/top.scm
								
								
								
								
							| 
						 | 
				
			
			@ -107,7 +107,7 @@
 | 
			
		|||
(define (parse-scsh-args args)
 | 
			
		||||
  (let lp ((args (meta-arg-process-arglist args))
 | 
			
		||||
	   (switches '())	; A list of handler thunks
 | 
			
		||||
	   (top-entry #f)	; -t <entry>
 | 
			
		||||
	   (top-entry #f)	; -e <entry>
 | 
			
		||||
	   (need-script? #f))	; Found a -ds, -dm, or -de?
 | 
			
		||||
;    (display args    (current-output-port))
 | 
			
		||||
    (if (pair? args)
 | 
			
		||||
| 
						 | 
				
			
			@ -115,31 +115,47 @@
 | 
			
		|||
	      (args (cdr args)))
 | 
			
		||||
 | 
			
		||||
	  (cond ((string=? arg "-c")
 | 
			
		||||
		 (if (or need-script? top-entry (not (pair? args)))
 | 
			
		||||
		     (bad-arg)
 | 
			
		||||
                 (cond ((not (pair? args))
 | 
			
		||||
                        (bad-arg "-c switch requires argument"))
 | 
			
		||||
                       (top-entry
 | 
			
		||||
                        (bad-arg "-c switch used with -e switch"))
 | 
			
		||||
                       (need-script?
 | 
			
		||||
                        (bad-arg "-ds, -dm, or -de switch requires -s <script>"))
 | 
			
		||||
                       (else
 | 
			
		||||
                        (values (reverse switches) 'c (car args)
 | 
			
		||||
			     top-entry (cdr args))))
 | 
			
		||||
                                top-entry (cdr args)))))
 | 
			
		||||
 | 
			
		||||
		((string=? arg "-s")
 | 
			
		||||
		 (if (not (pair? args))
 | 
			
		||||
		     (bad-arg "-s switch requires argument")
 | 
			
		||||
		 (cond ((not (pair? args))
 | 
			
		||||
                        (bad-arg "-s switch requires argument"))
 | 
			
		||||
                       (top-entry
 | 
			
		||||
                        (bad-arg "-s switch used with -e switch"))
 | 
			
		||||
                       (need-script?
 | 
			
		||||
                        (bad-arg "-ds, -dm, or -de switch requires -s <script>"))
 | 
			
		||||
                       (else
 | 
			
		||||
                        (values (reverse switches) 's (car args)
 | 
			
		||||
			     top-entry (cdr args))))
 | 
			
		||||
                                top-entry (cdr args)))))
 | 
			
		||||
 | 
			
		||||
		;; -sfd <num>
 | 
			
		||||
		((string=? arg "-sfd")
 | 
			
		||||
		 (if (not (pair? args))
 | 
			
		||||
		     (bad-arg "-sfd switch requires argument")
 | 
			
		||||
                 (cond ((not (pair? args))
 | 
			
		||||
                        (bad-arg "-sfd switch requires argument"))
 | 
			
		||||
                       (top-entry
 | 
			
		||||
                        (bad-arg "-sdf switch used with -e switch"))
 | 
			
		||||
                       (else
 | 
			
		||||
                        (let* ((fd (string->number (car args)))
 | 
			
		||||
                               (p (fdes->inport fd)))
 | 
			
		||||
                          (release-port-handle p)	; Unreveal the port.
 | 
			
		||||
                          (values (reverse switches) 'sfd p
 | 
			
		||||
			       top-entry (cdr args)))))
 | 
			
		||||
                                  top-entry (cdr args))))))
 | 
			
		||||
 | 
			
		||||
		((string=? arg "--")
 | 
			
		||||
		 (if need-script?
 | 
			
		||||
		     (bad-arg "-ds, -dm, or -de switch requires -s <script>")
 | 
			
		||||
		     (values (reverse switches) #f #f top-entry args)))
 | 
			
		||||
		 (cond (need-script?
 | 
			
		||||
                        (bad-arg "-ds, -dm, or -de switch requires -s <script>"))
 | 
			
		||||
                       (top-entry
 | 
			
		||||
                        (bad-arg "-- switch used with -e switch"))
 | 
			
		||||
                       (else
 | 
			
		||||
                        (values (reverse switches) #f #f top-entry args))))
 | 
			
		||||
 | 
			
		||||
		((or (string=? arg "-ds")
 | 
			
		||||
		     (string=? arg "-dm")
 | 
			
		||||
| 
						 | 
				
			
			@ -186,8 +202,10 @@
 | 
			
		|||
		     (string->symbol (car args)) need-script?))
 | 
			
		||||
 | 
			
		||||
	    (else (bad-arg "Unknown switch" arg))))
 | 
			
		||||
 | 
			
		||||
	(values (reverse switches) #f #f top-entry '()))))
 | 
			
		||||
        (cond (need-script?
 | 
			
		||||
               (bad-arg "-ds, -dm, or -de switch requires -s <script>"))
 | 
			
		||||
              (else
 | 
			
		||||
               (values (reverse switches) #f #f top-entry '()))))))
 | 
			
		||||
 | 
			
		||||
;;; Do each -ds, -dm, -de, -o, -n, -m, -l/lm/ll, +lp/+lpe/lp+/lpe+, or
 | 
			
		||||
;;; -lp-clear/lp-default switch, and return the final result package and a
 | 
			
		||||
| 
						 | 
				
			
			@ -341,6 +359,7 @@
 | 
			
		|||
(define (parse-switches-and-execute all-args context)
 | 
			
		||||
  (receive (switches term-switch term-val top-entry args)
 | 
			
		||||
      (parse-scsh-args (cdr all-args))
 | 
			
		||||
    (let ((interactive? (not (or term-switch top-entry))))
 | 
			
		||||
      (with-handler 
 | 
			
		||||
       (lambda (cond more)
 | 
			
		||||
         (if (warning? cond)
 | 
			
		||||
| 
						 | 
				
			
			@ -353,7 +372,7 @@
 | 
			
		|||
                (more)))))
 | 
			
		||||
       (lambda ()
 | 
			
		||||
         (with-scsh-initialized
 | 
			
		||||
	(not term-switch) context args
 | 
			
		||||
          interactive? context args
 | 
			
		||||
          (lambda ()
 | 
			
		||||
            ;; Have to do these before calling DO-SWITCHES, because actions
 | 
			
		||||
            ;; performed while processing the switches may use these guys.
 | 
			
		||||
| 
						 | 
				
			
			@ -373,7 +392,7 @@
 | 
			
		|||
                      (if (eq? term-switch 'sfd)
 | 
			
		||||
                          (load-port-quietly term-val (interaction-environment)))))
 | 
			
		||||
	   
 | 
			
		||||
	    (cond ((not term-switch)	; -- interactive
 | 
			
		||||
              (cond (interactive?
 | 
			
		||||
                     (scsh-exit-now ;; TODO: ,exit will bypass this
 | 
			
		||||
                      (restart-command-processor 
 | 
			
		||||
                       args 
 | 
			
		||||
| 
						 | 
				
			
			@ -402,7 +421,7 @@
 | 
			
		|||
		 
 | 
			
		||||
                    ;; Otherwise, the script executed as it loaded,
 | 
			
		||||
                    ;; so we're done.
 | 
			
		||||
		  (else (scsh-exit-now 0))))))))))
 | 
			
		||||
                    (else (scsh-exit-now 0)))))))))))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
(define (read-exactly-one-sexp-from-string s)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue