From ffe9fc1f47306dd526a5443689c129859e72d7ae Mon Sep 17 00:00:00 2001
From: Timothy Sample <samplet@ngyro.com>
Date: Fri, 7 Jun 2019 11:51:53 -0400
Subject: [PATCH] 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.
---
 gash/built-ins/break.scm    | 24 +++++++++++++++---------
 gash/built-ins/continue.scm | 24 +++++++++++++++---------
 gash/built-ins/utils.scm    | 14 +++++++++++++-
 gash/shell.scm              |  2 ++
 tests/spec/oil.scm          | 14 +++++++++++---
 5 files changed, 56 insertions(+), 22 deletions(-)

diff --git a/gash/built-ins/break.scm b/gash/built-ins/break.scm
index c4d8bf5..30fdba8 100644
--- a/gash/built-ins/break.scm
+++ b/gash/built-ins/break.scm
@@ -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)))
diff --git a/gash/built-ins/continue.scm b/gash/built-ins/continue.scm
index 5a60529..53b46ba 100644
--- a/gash/built-ins/continue.scm
+++ b/gash/built-ins/continue.scm
@@ -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)))
diff --git a/gash/built-ins/utils.scm b/gash/built-ins/utils.scm
index 08e0705..67dc466 100644
--- a/gash/built-ins/utils.scm
+++ b/gash/built-ins/utils.scm
@@ -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))))
diff --git a/gash/shell.scm b/gash/shell.scm
index 0621a37..1aefe86 100644
--- a/gash/shell.scm
+++ b/gash/shell.scm
@@ -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)
diff --git a/tests/spec/oil.scm b/tests/spec/oil.scm
index 4a77167..8b33057 100644
--- a/tests/spec/oil.scm
+++ b/tests/spec/oil.scm
@@ -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"