Handle 'break' and 'continue' errors.
* gash/built-ins/utils.scm (string->positive-integer): New function. * gash/built-ins/break.scm (main): Use it to simplify argument checking; check for too many arguments; and print messages on errors. * gash/built-ins/continue.scm (main): Ditto. * gash/shell.scm (sh:exec-let): Throw an error if a special built-in fails. * tests/spec/oil.scm: Enable and adjust previously failing tests.
This commit is contained in:
parent
7d2298d15b
commit
ffe9fc1f47
|
@ -17,8 +17,10 @@
|
|||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gash built-ins break)
|
||||
#:use-module (gash built-ins utils)
|
||||
#:use-module (gash compat)
|
||||
#:use-module (gash environment))
|
||||
#:use-module (gash environment)
|
||||
#:use-module (ice-9 match))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
@ -27,11 +29,15 @@
|
|||
;;; Code:
|
||||
|
||||
(define (main . args)
|
||||
(let* ((arg (and (pair? args) (car args)))
|
||||
(n (string->number (or arg "1"))))
|
||||
(if (and arg (or (not n) (not (exact-integer? n)) (< n 1)))
|
||||
1
|
||||
(begin
|
||||
;; Since we do not return, we have to set the status here.
|
||||
(set-status! 0)
|
||||
(sh:break (1- n))))))
|
||||
(match args
|
||||
(() (main "1"))
|
||||
((arg)
|
||||
(match (string->positive-integer arg)
|
||||
(#f (format (current-error-port)
|
||||
"gash: break: argument must be a positive integer~%")
|
||||
EXIT_FAILURE)
|
||||
(n (set-status! 0)
|
||||
(sh:break (1- n)))))
|
||||
(_ (format (current-error-port)
|
||||
"gash: break: too many arguments~%")
|
||||
EXIT_FAILURE)))
|
||||
|
|
|
@ -17,8 +17,10 @@
|
|||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gash built-ins continue)
|
||||
#:use-module (gash built-ins utils)
|
||||
#:use-module (gash compat)
|
||||
#:use-module (gash environment))
|
||||
#:use-module (gash environment)
|
||||
#:use-module (ice-9 match))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
@ -27,11 +29,15 @@
|
|||
;;; Code:
|
||||
|
||||
(define (main . args)
|
||||
(let* ((arg (and (pair? args) (car args)))
|
||||
(n (string->number (or arg "1"))))
|
||||
(if (and arg (or (not n) (not (exact-integer? n)) (< n 1)))
|
||||
1
|
||||
(begin
|
||||
;; Since we do not return, we have to set the status here.
|
||||
(set-status! 0)
|
||||
(sh:continue (1- n))))))
|
||||
(match args
|
||||
(() (main "1"))
|
||||
((arg)
|
||||
(match (string->positive-integer arg)
|
||||
(#f (format (current-error-port)
|
||||
"gash: continue: argument must be a positive integer~%")
|
||||
EXIT_FAILURE)
|
||||
(n (set-status! 0)
|
||||
(sh:continue (1- n)))))
|
||||
(_ (format (current-error-port)
|
||||
"gash: continue: too many arguments~%")
|
||||
EXIT_FAILURE)))
|
||||
|
|
|
@ -20,7 +20,8 @@
|
|||
#:use-module (ice-9 match)
|
||||
#:export (get-evaluator
|
||||
built-in?
|
||||
split-assignment))
|
||||
split-assignment
|
||||
string->positive-integer))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
@ -53,3 +54,14 @@
|
|||
(match (substring assignment (1+ index))
|
||||
((? string-null?) (values name #f))
|
||||
(value (values name value)))))))
|
||||
|
||||
(define char-set:ascii-digit
|
||||
(char-set-intersection char-set:ascii char-set:digit))
|
||||
|
||||
(define (string->positive-integer s)
|
||||
"Return the positive integer represented by the string @var{s}. If
|
||||
@var{s} does not represent a positive, decimal integer in return
|
||||
@code{#f}."
|
||||
(and=> (and (string-every char-set:ascii-digit s) (string->number s))
|
||||
(lambda (n)
|
||||
(and (exact-integer? n) (> n 0) n))))
|
||||
|
|
|
@ -131,6 +131,8 @@ environment variable bindings @var{bindings}."
|
|||
(setvar! name value)))
|
||||
bindings)
|
||||
(let ((exit-val (apply proc args)))
|
||||
(unless (= exit-val EXIT_SUCCESS)
|
||||
(throw 'shell-error))
|
||||
(set-status! exit-val))))
|
||||
(and=> (getfun name)
|
||||
(lambda (proc)
|
||||
|
|
|
@ -123,7 +123,7 @@
|
|||
out)))
|
||||
(loop (read-line in 'concat) transformers))))))))
|
||||
(tests-to-filter
|
||||
'(("spec/case_.test.sh"
|
||||
`(("spec/case_.test.sh"
|
||||
(;; These two are Bash specific.
|
||||
("Case statement with ;;&")
|
||||
("Case statement with ;&")))
|
||||
|
@ -162,8 +162,16 @@
|
|||
("continue at top level")
|
||||
("continue in subshell")
|
||||
("continue in subshell aborts with errexit")
|
||||
("bad arg to break")
|
||||
("too many args to continue")))
|
||||
;; The Oil shell handles this statically. We
|
||||
;; will treat it as a fatal run-time error (for
|
||||
;; now).
|
||||
("too many args to continue"
|
||||
("## status: 2" ,(string-append
|
||||
"## status: 2\n"
|
||||
"## OK gash status: 1\n"
|
||||
"## OK gash STDOUT:\n"
|
||||
"a\n"
|
||||
"## END")))))
|
||||
("spec/quote.test.sh"
|
||||
(;; We match KornShell on these two tests.
|
||||
("Unterminated single quote"
|
||||
|
|
Loading…
Reference in New Issue