Add arithmetic expansion.
* gash/arithmetic.scm: New file. * Makefile.am (SOURCES): Add it. * gash/lexer.scm (get-arithmetic-expansion): New procedure. (get-expansion): Check for "$((" and use the new procedure to read an arithmetic expansion. * gash/eval.scm (word->qword): Handle '<sh-arithmetic>'. * tests/unit/eval.scm: Add tests. * tests/spec/Makefile.am (TESTS): Add 'arith'. * tests/spec/oil.scm: Patch seven of its tests and filter out fifteen others. * doc/gash.texi, doc/syntax.txt: Add '<sh-arithmetic>' syntax.
This commit is contained in:
parent
d3244e0ec0
commit
87229e4b3a
|
@ -35,6 +35,7 @@ EXTRA_DIST += \
|
||||||
#####################
|
#####################
|
||||||
|
|
||||||
SOURCES = \
|
SOURCES = \
|
||||||
|
gash/arithmetic.scm \
|
||||||
gash/built-ins/break.scm \
|
gash/built-ins/break.scm \
|
||||||
gash/built-ins/cd.scm \
|
gash/built-ins/cd.scm \
|
||||||
gash/built-ins/colon.scm \
|
gash/built-ins/colon.scm \
|
||||||
|
|
|
@ -273,9 +273,6 @@ exhaustive, but covers the most glaring omissions.
|
||||||
|
|
||||||
@itemize @bullet
|
@itemize @bullet
|
||||||
|
|
||||||
@item
|
|
||||||
Arithmetic substitution.
|
|
||||||
|
|
||||||
@item
|
@item
|
||||||
Job control.
|
Job control.
|
||||||
|
|
||||||
|
@ -743,6 +740,7 @@ word ::= string
|
||||||
| (word ...)
|
| (word ...)
|
||||||
| ('<sh-quote> word)
|
| ('<sh-quote> word)
|
||||||
| ('<sh-cmd-sub> sync ...)
|
| ('<sh-cmd-sub> sync ...)
|
||||||
|
| ('<sh-arithmetic> word)
|
||||||
| ('<sh-ref> var)
|
| ('<sh-ref> var)
|
||||||
| ('<sh-ref-or> var [word])
|
| ('<sh-ref-or> var [word])
|
||||||
| ('<sh-ref-or*> var [word])
|
| ('<sh-ref-or*> var [word])
|
||||||
|
|
|
@ -48,6 +48,7 @@ word ::= string
|
||||||
| (word ...)
|
| (word ...)
|
||||||
| ('<sh-quote> word)
|
| ('<sh-quote> word)
|
||||||
| ('<sh-cmd-sub> sync ...)
|
| ('<sh-cmd-sub> sync ...)
|
||||||
|
| ('<sh-arithmetic> word)
|
||||||
| ('<sh-ref> var)
|
| ('<sh-ref> var)
|
||||||
| ('<sh-ref-or> var [word])
|
| ('<sh-ref-or> var [word])
|
||||||
| ('<sh-ref-or*> var [word])
|
| ('<sh-ref-or*> var [word])
|
||||||
|
|
|
@ -0,0 +1,268 @@
|
||||||
|
;;; Gash -- Guile As SHell
|
||||||
|
;;; Copyright © 2020, 2021 Timothy Sample <samplet@ngyro.com>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of Gash.
|
||||||
|
;;;
|
||||||
|
;;; Gash is free software: you can redistribute it and/or modify
|
||||||
|
;;; it under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation, either version 3 of the License, or
|
||||||
|
;;; (at your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; Gash is distributed in the hope that it will be useful,
|
||||||
|
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-module (gash arithmetic)
|
||||||
|
#:use-module (ice-9 i18n)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (ice-9 receive)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (srfi srfi-26)
|
||||||
|
#:use-module (system base lalr)
|
||||||
|
#:export (read-arithmetic))
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;;;
|
||||||
|
;;; This module contains the lexer and parser for reading arithmetic
|
||||||
|
;;; expansions.
|
||||||
|
;;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(define nonzero-digit?
|
||||||
|
(let ((nonzero-digits (string->char-set "123456789")))
|
||||||
|
(lambda (chr)
|
||||||
|
"Check if @var{chr} is a nonzero digit."
|
||||||
|
(char-set-contains? nonzero-digits chr))))
|
||||||
|
|
||||||
|
(define* (lex-number str #:optional (start 0) (end (string-length str)))
|
||||||
|
"Read a number token from @var{str} and return two values: the token
|
||||||
|
and its length. If a number cannot be read, then the resulting token
|
||||||
|
will be @code{#f} and the length will be zero."
|
||||||
|
(define (->token offset base)
|
||||||
|
(let ((str* (substring str (+ start offset) end)))
|
||||||
|
(receive (n count) (locale-string->integer str* base)
|
||||||
|
(if n
|
||||||
|
(values (make-lexical-token 'NUMBER #f n) (+ offset count))
|
||||||
|
(values #f 0)))))
|
||||||
|
(match (string-ref str start)
|
||||||
|
(#\0 (match (and (< (1+ start) end) (string-ref str (1+ start)))
|
||||||
|
((or #\x #\X) (->token 2 16))
|
||||||
|
(_ (->token 0 8))))
|
||||||
|
((? nonzero-digit?) (->token 0 10))
|
||||||
|
(_ (values #f 0))))
|
||||||
|
|
||||||
|
(define *operators*
|
||||||
|
`(("(" . LPAREN)
|
||||||
|
(")" . RPAREN)
|
||||||
|
("~" . BITNOT)
|
||||||
|
("!" . LOGNOT)
|
||||||
|
("*" . *)
|
||||||
|
("/" . /)
|
||||||
|
("%" . %)
|
||||||
|
("+" . +)
|
||||||
|
("-" . -)
|
||||||
|
("<<" . <<)
|
||||||
|
(">>" . >>)
|
||||||
|
("<" . <)
|
||||||
|
("<=" . <=)
|
||||||
|
(">" . >)
|
||||||
|
(">=" . >=)
|
||||||
|
("==" . ==)
|
||||||
|
("!=" . !=)
|
||||||
|
("&" . BITAND)
|
||||||
|
("^" . BITXOR)
|
||||||
|
("|" . BITIOR)
|
||||||
|
("&&" . LOGAND)
|
||||||
|
("||" . LOGIOR)
|
||||||
|
("?" . ?)
|
||||||
|
(":" . :)
|
||||||
|
("=" . =)
|
||||||
|
("*=" . *=)
|
||||||
|
("/=" . /=)
|
||||||
|
("%=" . %=)
|
||||||
|
("+=" . +=)
|
||||||
|
("-=" . -=)
|
||||||
|
("<<=" . <<=)
|
||||||
|
(">>=" . >>=)
|
||||||
|
("&=" . BITAND-ASSIGN)
|
||||||
|
("^=" . BITXOR-ASSIGN)
|
||||||
|
("|=" . BITIOR-ASSIGN)))
|
||||||
|
|
||||||
|
(define* (operator-prefix? str #:optional (start 0) (end (string-length str)))
|
||||||
|
"Check if @var{str} is a prefix of an arithmetic operator."
|
||||||
|
(any (cut string-prefix? str <> start end)
|
||||||
|
(map car *operators*)))
|
||||||
|
|
||||||
|
(define* (lex-operator str #:optional (start 0) (end (string-length str)))
|
||||||
|
"Read an operator token from @var{str} and return two values: the
|
||||||
|
token and its length. If an operator cannot be read, then the resulting
|
||||||
|
token will be @code{#f} and the length will be zero."
|
||||||
|
(define (->token op)
|
||||||
|
(if (string-null? op)
|
||||||
|
(values #f 0)
|
||||||
|
(values (make-lexical-token (assoc-ref *operators* op) #f op)
|
||||||
|
(string-length op))))
|
||||||
|
(let loop ((k start) (acc ""))
|
||||||
|
(if (< k end)
|
||||||
|
(let ((next (string-append acc (string (string-ref str k)))))
|
||||||
|
(if (operator-prefix? next)
|
||||||
|
(loop (1+ k) next)
|
||||||
|
(->token acc)))
|
||||||
|
(->token acc))))
|
||||||
|
|
||||||
|
(define name-start-char?
|
||||||
|
(let ((char-set:name-start
|
||||||
|
(char-set-intersection char-set:ascii
|
||||||
|
(char-set-union char-set:letter
|
||||||
|
(char-set #\_)))))
|
||||||
|
(lambda (chr)
|
||||||
|
"Check if @var{chr} is a valid first character for a name."
|
||||||
|
(and (char? chr)
|
||||||
|
(char-set-contains? char-set:name-start chr)))))
|
||||||
|
|
||||||
|
(define name-char?
|
||||||
|
(let ((char-set:name
|
||||||
|
(char-set-intersection char-set:ascii
|
||||||
|
(char-set-union char-set:letter+digit
|
||||||
|
(char-set #\_)))))
|
||||||
|
(lambda (chr)
|
||||||
|
"Check if @var{chr} is a valid character for a name."
|
||||||
|
(and (char? chr)
|
||||||
|
(char-set-contains? char-set:name chr)))))
|
||||||
|
|
||||||
|
(define* (lex-name str #:optional (start 0) (end (string-length str)))
|
||||||
|
"Read a name token from @var{str} and return two values: the token and
|
||||||
|
its length. If a name cannot be read, then the resulting token will be
|
||||||
|
@code{#f} and the length will be zero."
|
||||||
|
(match (string-ref str start)
|
||||||
|
((? name-start-char? ch)
|
||||||
|
(let loop ((k (1+ start)) (acc (list ch)))
|
||||||
|
(match (and (< k end) (string-ref str k))
|
||||||
|
((? name-char? ch) (loop (1+ k) (cons ch acc)))
|
||||||
|
(_ (let ((result (reverse-list->string acc)))
|
||||||
|
(values (make-lexical-token 'NAME #f result)
|
||||||
|
(string-length result)))))))
|
||||||
|
(_ (values #f 0))))
|
||||||
|
|
||||||
|
(define (make-lexer str)
|
||||||
|
"Return a lexer that reads tokens from @var{str}. This lexer is a
|
||||||
|
stateful thunk that returns the next token each time it is called. It
|
||||||
|
is suitable to be used with an @code{lalr-parser}."
|
||||||
|
(define %lexers (list lex-number lex-operator lex-name))
|
||||||
|
(define idx 0)
|
||||||
|
(lambda ()
|
||||||
|
(set! idx (string-index str char-set:graphic idx))
|
||||||
|
(if (and idx (< idx (string-length str)))
|
||||||
|
(let loop ((lexers %lexers))
|
||||||
|
(match lexers
|
||||||
|
(() (error "could not read arithmetic substitution" str idx))
|
||||||
|
((lex . rest)
|
||||||
|
(receive (token count) (lex str idx)
|
||||||
|
(if token
|
||||||
|
(begin
|
||||||
|
(set! idx (+ idx count))
|
||||||
|
token)
|
||||||
|
(loop rest))))))
|
||||||
|
'*eoi*)))
|
||||||
|
|
||||||
|
(define (make-ref name)
|
||||||
|
"Return a Scheme expression that looks up @var{name} in the current
|
||||||
|
Gash environment, returning zero if @var{name} is not set."
|
||||||
|
`(or (string->number (getvar ,name "0")) 0))
|
||||||
|
|
||||||
|
(define* (make-assign name expr #:optional make-expr)
|
||||||
|
"Return a Scheme expression that sets @var{name} to the result of
|
||||||
|
@var{expr} in the current Gash environment. Optionally, @var{make-expr}
|
||||||
|
can be used to adjust the result of @var{expr} while setting
|
||||||
|
@var{name}."
|
||||||
|
`(let ((result ,(match make-expr
|
||||||
|
((? symbol?) `(,make-expr ,(make-ref name) ,expr))
|
||||||
|
((? procedure?) (make-expr (make-ref name) expr))
|
||||||
|
(#f expr))))
|
||||||
|
(setvar! ,name (number->string result))
|
||||||
|
result))
|
||||||
|
|
||||||
|
(define (make-bool expr)
|
||||||
|
"Return a Scheme expression that converts the Boolean expression
|
||||||
|
@var{expr} into a number (one for true, zero for false)."
|
||||||
|
`(if ,expr 1 0))
|
||||||
|
|
||||||
|
(define (nonzero? expr)
|
||||||
|
"Return a Scheme expression that checks if @var{expr} is an expression
|
||||||
|
that returns a nonzero number."
|
||||||
|
`(not (zero? ,expr)))
|
||||||
|
|
||||||
|
(define (make-parser)
|
||||||
|
"Create a parser that reads arithmetic expansion expressions and
|
||||||
|
returns equivalent Scheme expressions."
|
||||||
|
(lalr-parser
|
||||||
|
(NAME
|
||||||
|
NUMBER
|
||||||
|
LPAREN
|
||||||
|
RPAREN
|
||||||
|
(right: = *= /= %= += -= <<= >>=
|
||||||
|
BITAND-ASSIGN BITXOR-ASSIGN BITIOR-ASSIGN)
|
||||||
|
(right: ? :)
|
||||||
|
(left: LOGIOR)
|
||||||
|
(left: LOGAND)
|
||||||
|
(left: BITIOR)
|
||||||
|
(left: BITXOR)
|
||||||
|
(left: BITAND)
|
||||||
|
(left: == !=)
|
||||||
|
(left: < <= > >=)
|
||||||
|
(left: << >>)
|
||||||
|
(left: + -)
|
||||||
|
(left: * / %)
|
||||||
|
(nonassoc: LOGNOT)
|
||||||
|
(nonassoc: BITNOT)
|
||||||
|
(nonassoc: unary-)
|
||||||
|
(nonassoc: unary+))
|
||||||
|
(expr
|
||||||
|
(NAME) : (make-ref $1)
|
||||||
|
(NUMBER) : $1
|
||||||
|
(LPAREN expr RPAREN) : $2
|
||||||
|
(+ expr (prec: unary+)) : `(+ ,$2)
|
||||||
|
(- expr (prec: unary-)) : `(- ,$2)
|
||||||
|
(BITNOT expr) : `(lognot ,$2)
|
||||||
|
(LOGNOT expr) : (make-bool `(zero? ,$2))
|
||||||
|
(expr * expr) : `(* ,$1 ,$3)
|
||||||
|
(expr / expr) : `(quotient ,$1 ,$3)
|
||||||
|
(expr % expr) : `(modulo ,$1 ,$3)
|
||||||
|
(expr + expr) : `(+ ,$1 ,$3)
|
||||||
|
(expr - expr) : `(- ,$1 ,$3)
|
||||||
|
(expr << expr) : `(ash ,$1 ,$3)
|
||||||
|
(expr >> expr) : `(ash ,$1 (- ,$3))
|
||||||
|
(expr < expr) : (make-bool `(< ,$1 ,$3))
|
||||||
|
(expr <= expr) : (make-bool `(<= ,$1 ,$3))
|
||||||
|
(expr > expr) : (make-bool `(> ,$1 ,$3))
|
||||||
|
(expr >= expr) : (make-bool `(>= ,$1 ,$3))
|
||||||
|
(expr == expr) : (make-bool `(= ,$1 ,$3))
|
||||||
|
(expr != expr) : (make-bool `(not (= ,$1 ,$3)))
|
||||||
|
(expr BITAND expr) : `(logand ,$1 ,$3)
|
||||||
|
(expr BITXOR expr) : `(logxor ,$1 ,$3)
|
||||||
|
(expr BITIOR expr) : `(logior ,$1 ,$3)
|
||||||
|
(expr LOGAND expr) : (make-bool `(and ,(nonzero? $1) ,(nonzero? $3)))
|
||||||
|
(expr LOGIOR expr) : (make-bool `(or ,(nonzero? $1) ,(nonzero? $3)))
|
||||||
|
(expr ? expr : expr) : `(if ,(nonzero? $1) ,$3 ,$5)
|
||||||
|
(NAME = expr) : (make-assign $1 $3)
|
||||||
|
(NAME *= expr) : (make-assign $1 $3 '*)
|
||||||
|
(NAME /= expr) : (make-assign $1 $3 'quotient)
|
||||||
|
(NAME %= expr) : (make-assign $1 $3 'modulo)
|
||||||
|
(NAME += expr) : (make-assign $1 $3 '+)
|
||||||
|
(NAME -= expr) : (make-assign $1 $3 '-)
|
||||||
|
(NAME <<= expr) : (make-assign $1 $3 'ash)
|
||||||
|
(NAME >>= expr) : (make-assign $1 $3 (lambda (x y) `(ash ,x (- ,y))))
|
||||||
|
(NAME BITAND-ASSIGN expr) : (make-assign $1 $3 'logand)
|
||||||
|
(NAME BITXOR-ASSIGN expr) : (make-assign $1 $3 'logxor)
|
||||||
|
(NAME BITIOR-ASSIGN expr) : (make-assign $1 $3 'logior))))
|
||||||
|
|
||||||
|
(define (read-arithmetic str)
|
||||||
|
"Read @var{str} as an arithmetic expansion expression and return an
|
||||||
|
equivalent Scheme expression."
|
||||||
|
(let ((lexer (make-lexer str))
|
||||||
|
(parser (make-parser)))
|
||||||
|
(parser lexer error)))
|
|
@ -18,6 +18,7 @@
|
||||||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (gash eval)
|
(define-module (gash eval)
|
||||||
|
#:use-module (gash arithmetic)
|
||||||
#:use-module (gash compat)
|
#:use-module (gash compat)
|
||||||
#:use-module (gash environment)
|
#:use-module (gash environment)
|
||||||
#:use-module (gash pattern)
|
#:use-module (gash pattern)
|
||||||
|
@ -52,6 +53,11 @@ and arithmetic substitions."
|
||||||
`(<sh-quote> ,(word->qword quoted-word)))
|
`(<sh-quote> ,(word->qword quoted-word)))
|
||||||
(('<sh-cmd-sub> . exps)
|
(('<sh-cmd-sub> . exps)
|
||||||
((eval-cmd-sub) exps))
|
((eval-cmd-sub) exps))
|
||||||
|
(('<sh-arithmetic> word)
|
||||||
|
(let* ((arithmetic (expand-word word #:output 'string))
|
||||||
|
(expr `(begin (use-modules (gash environment))
|
||||||
|
(number->string ,(read-arithmetic arithmetic)))))
|
||||||
|
(eval expr (interaction-environment))))
|
||||||
(('<sh-ref> name)
|
(('<sh-ref> name)
|
||||||
(parameter-ref name ""))
|
(parameter-ref name ""))
|
||||||
(('<sh-ref-or> name default)
|
(('<sh-ref-or> name default)
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; Gash -- Guile As SHell
|
;;; Gash -- Guile As SHell
|
||||||
;;; Copyright © 2017, 2018 Timothy Sample <samplet@ngyro.com>
|
;;; Copyright © 2017, 2018, 2020, 2021 Timothy Sample <samplet@ngyro.com>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of Gash.
|
;;; This file is part of Gash.
|
||||||
;;;
|
;;;
|
||||||
|
@ -325,6 +325,48 @@ leading '$')."
|
||||||
((op "LINENO" x) `(,op ("LINENO" . ,(1+ (port-line port))) ,x))
|
((op "LINENO" x) `(,op ("LINENO" . ,(1+ (port-line port))) ,x))
|
||||||
(_ result))))
|
(_ result))))
|
||||||
|
|
||||||
|
(define (get-arithmetic-expansion port)
|
||||||
|
"Get an arithmetic expansion from @var{port}."
|
||||||
|
|
||||||
|
(define (get-arithmetic-expansion-string port)
|
||||||
|
(let loop ((chr (lookahead-char port)) (acc '()))
|
||||||
|
(match chr
|
||||||
|
((? eof-object?) (throw 'lex-error))
|
||||||
|
((or #\( #\) #\$ #\` #\\) (list->string (reverse! acc)))
|
||||||
|
(_ (loop (next-char port) (cons chr acc))))))
|
||||||
|
|
||||||
|
(match (list (get-char port) (get-char port))
|
||||||
|
((#\( #\()
|
||||||
|
(let loop ((chr (lookahead-char port)) (depth 0) (acc '()))
|
||||||
|
(match chr
|
||||||
|
(#\( (loop (next-char port) (1+ depth) (cons "(" acc)))
|
||||||
|
(#\) (cond
|
||||||
|
((and (zero? depth) (equal? (next-char port) #\)))
|
||||||
|
(get-char port)
|
||||||
|
`(<sh-arithmetic>
|
||||||
|
,(match (join-contiguous-strings (reverse! acc))
|
||||||
|
(() "")
|
||||||
|
((word) word)
|
||||||
|
(words words))))
|
||||||
|
((positive? depth)
|
||||||
|
(loop (next-char port) (1- depth) (cons ")" acc)))
|
||||||
|
(else
|
||||||
|
(throw 'lex-error))))
|
||||||
|
((or #\$ #\`)
|
||||||
|
(let ((expansion (get-expansion port)))
|
||||||
|
(loop (lookahead-char port)
|
||||||
|
depth
|
||||||
|
(cons (or expansion (string chr)) acc))))
|
||||||
|
(#\\ (let ((escape (get-escape port
|
||||||
|
(cut member <> '(#\$ #\` #\\)))))
|
||||||
|
(loop (lookahead-char port) depth (append escape acc))))
|
||||||
|
(_ (let ((str (get-arithmetic-expansion-string port)))
|
||||||
|
(loop (lookahead-char port)
|
||||||
|
depth
|
||||||
|
(if (not (string-null? str))
|
||||||
|
(cons str acc)
|
||||||
|
acc)))))))))
|
||||||
|
|
||||||
(define (get-bracketed-command port)
|
(define (get-bracketed-command port)
|
||||||
"Get a bracketed command ('$(...)') from @var{port} (excluding the
|
"Get a bracketed command ('$(...)') from @var{port} (excluding the
|
||||||
leading '$')."
|
leading '$')."
|
||||||
|
@ -352,7 +394,11 @@ they were quoted."
|
||||||
(#\$ (begin
|
(#\$ (begin
|
||||||
(get-char port)
|
(get-char port)
|
||||||
(match (lookahead-char port)
|
(match (lookahead-char port)
|
||||||
(#\( (get-bracketed-command port))
|
(#\( (let ((next (next-char port)))
|
||||||
|
(unget-char port #\()
|
||||||
|
(match next
|
||||||
|
(#\( (get-arithmetic-expansion port))
|
||||||
|
(_ (get-bracketed-command port)))))
|
||||||
(_ (get-parameter-expansion port)))))
|
(_ (get-parameter-expansion port)))))
|
||||||
(#\` (get-backquoted-command port #:quoted? quoted?))))
|
(#\` (get-backquoted-command port #:quoted? quoted?))))
|
||||||
|
|
||||||
|
|
|
@ -36,6 +36,7 @@ TEST_EXTENSIONS = .sh
|
||||||
SH_LOG_COMPILER = ./check-spec
|
SH_LOG_COMPILER = ./check-spec
|
||||||
|
|
||||||
TESTS = \
|
TESTS = \
|
||||||
|
oil/spec/arith.test.sh \
|
||||||
oil/spec/case_.test.sh \
|
oil/spec/case_.test.sh \
|
||||||
oil/spec/command-sub.test.sh \
|
oil/spec/command-sub.test.sh \
|
||||||
oil/spec/errexit.test.sh \
|
oil/spec/errexit.test.sh \
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; Gash -- Guile As SHell
|
;;; Gash -- Guile As SHell
|
||||||
;;; Copyright © 2018, 2019 Timothy Sample <samplet@ngyro.com>
|
;;; Copyright © 2018, 2019, 2021 Timothy Sample <samplet@ngyro.com>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of Gash.
|
;;; This file is part of Gash.
|
||||||
;;;
|
;;;
|
||||||
|
@ -128,7 +128,54 @@
|
||||||
out)))
|
out)))
|
||||||
(loop (read-line in 'concat) transformers))))))))
|
(loop (read-line in 'concat) transformers))))))))
|
||||||
(tests-to-filter
|
(tests-to-filter
|
||||||
`(("spec/case_.test.sh"
|
`(("spec/arith.test.sh"
|
||||||
|
(;; These are Bash specific.
|
||||||
|
("Side Effect in Array Indexing")
|
||||||
|
("Array indexing in arith")
|
||||||
|
;; These go beyond POSIX.
|
||||||
|
("Invalid string to int with strict-arith")
|
||||||
|
("Preincrement")
|
||||||
|
("Postincrement")
|
||||||
|
("Increment undefined variables")
|
||||||
|
("Increment and decrement array")
|
||||||
|
("Increment undefined variables with nounset")
|
||||||
|
("Comma operator (borrowed from C)")
|
||||||
|
("Constants in base 36")
|
||||||
|
("Constants in bases 2 to 64")
|
||||||
|
("Dynamic base constants")
|
||||||
|
;; Following POSIX, we keep the quotes in the
|
||||||
|
;; expession.
|
||||||
|
("Constant with quotes like '1'"
|
||||||
|
("N-I bash/zsh" "N-I bash/zsh/gash"))
|
||||||
|
;; Follow bash/mksh and return status 1.
|
||||||
|
("No floating point"
|
||||||
|
("OK bash/mksh" "OK bash/mksh/gash"))
|
||||||
|
;; We do not support nounset yet.
|
||||||
|
("nounset with arithmetic")
|
||||||
|
;; We return 1 here.
|
||||||
|
("Invalid LValue"
|
||||||
|
("## status: 2" ,(string-append
|
||||||
|
"## status: 2\n"
|
||||||
|
"## OK gash status: 1\n")))
|
||||||
|
;; Follow Dash on these two.
|
||||||
|
("Invalid LValue that looks like array"
|
||||||
|
("N-I dash" "N-I dash/gash"))
|
||||||
|
("Invalid LValue: two sets of brackets"
|
||||||
|
("N-I dash" "N-I dash/gash"))
|
||||||
|
;; We do not support exponentiation.
|
||||||
|
("Exponentiation with **")
|
||||||
|
("Exponentiation operator has buggy precedence")
|
||||||
|
;; This test seems to be broken.
|
||||||
|
("Logical Ops Short Circuit"
|
||||||
|
("\\(\\(" "y=$(("))
|
||||||
|
;; Not sure about this one. We only do one
|
||||||
|
;; layer of variable lookup.
|
||||||
|
("Bizarre recursive name evaluation - result of runtime parse/eval"
|
||||||
|
("## stdout: 6 6 6 6"
|
||||||
|
,(string-append
|
||||||
|
"## stdout: 6 6 6 6\n"
|
||||||
|
"## OK gash stdout: 6 1 1 1\n")))))
|
||||||
|
("spec/case_.test.sh"
|
||||||
(;; These two are Bash specific.
|
(;; These two are Bash specific.
|
||||||
("Case statement with ;;&")
|
("Case statement with ;;&")
|
||||||
("Case statement with ;&")))
|
("Case statement with ;&")))
|
||||||
|
|
|
@ -19,6 +19,7 @@
|
||||||
(define-module (test-eval)
|
(define-module (test-eval)
|
||||||
#:use-module (gash environment)
|
#:use-module (gash environment)
|
||||||
#:use-module (gash eval)
|
#:use-module (gash eval)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
#:use-module (tests unit automake))
|
#:use-module (tests unit automake))
|
||||||
|
|
||||||
|
@ -294,7 +295,166 @@
|
||||||
|
|
||||||
|
|
||||||
;;; Arithmetic expansion.
|
;;; Arithmetic expansion.
|
||||||
;;;
|
|
||||||
;;; Not yet implemented.
|
(test-equal "Evaluates arithmetic constant (decimal)"
|
||||||
|
'("42")
|
||||||
|
(eval-word '(<sh-arithmetic> "42")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic constant (octal)"
|
||||||
|
'("34")
|
||||||
|
(eval-word '(<sh-arithmetic> "042")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic constant (hexadecimal)"
|
||||||
|
'("66")
|
||||||
|
(eval-word '(<sh-arithmetic> "0x42")))
|
||||||
|
|
||||||
|
;;; Binary (and tertiary) operators
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic addition"
|
||||||
|
'("6")
|
||||||
|
(eval-word '(<sh-arithmetic> "2 + 4")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic subtraction"
|
||||||
|
'("2")
|
||||||
|
(eval-word '(<sh-arithmetic> "4 - 2")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic multiplication"
|
||||||
|
'("12")
|
||||||
|
(eval-word '(<sh-arithmetic> "3 * 4")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic division"
|
||||||
|
'("6")
|
||||||
|
(eval-word '(<sh-arithmetic> "19 / 3")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic modulo"
|
||||||
|
'("2")
|
||||||
|
(eval-word '(<sh-arithmetic> "32 % 3")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic left shift"
|
||||||
|
'("12")
|
||||||
|
(eval-word '(<sh-arithmetic> "3 << 2")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic right shift"
|
||||||
|
'("3")
|
||||||
|
(eval-word '(<sh-arithmetic> "15 >> 2")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic greater than"
|
||||||
|
'("1")
|
||||||
|
(eval-word '(<sh-arithmetic> "5 > 3")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic greater than or equal to"
|
||||||
|
'("0")
|
||||||
|
(eval-word '(<sh-arithmetic> "3 >= 5")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic less than"
|
||||||
|
'("0")
|
||||||
|
(eval-word '(<sh-arithmetic> "5 < 3")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic less than or equal to"
|
||||||
|
'("1")
|
||||||
|
(eval-word '(<sh-arithmetic> "3 <= 5")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic equals"
|
||||||
|
'("0")
|
||||||
|
(eval-word '(<sh-arithmetic> "0 == 1")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic not equals"
|
||||||
|
'("1")
|
||||||
|
(eval-word '(<sh-arithmetic> "0 != 1")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic bitwise and"
|
||||||
|
'("4")
|
||||||
|
(eval-word '(<sh-arithmetic> "12 & 7")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic bitwise inclusive or"
|
||||||
|
'("9")
|
||||||
|
(eval-word '(<sh-arithmetic> "8 | 1")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic bitwise exclusive or"
|
||||||
|
'("5")
|
||||||
|
(eval-word '(<sh-arithmetic> "15 ^ 10")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic logical and"
|
||||||
|
'("0")
|
||||||
|
(eval-word '(<sh-arithmetic> "0 && 1")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic logical or"
|
||||||
|
'("1")
|
||||||
|
(eval-word '(<sh-arithmetic> "0 || 1")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic conditional"
|
||||||
|
'("3")
|
||||||
|
(eval-word '(<sh-arithmetic> "0 ? 5 : 3")))
|
||||||
|
|
||||||
|
;;; Variables
|
||||||
|
|
||||||
|
(test-equal "Evaluates variables in arithmetic"
|
||||||
|
'("5")
|
||||||
|
(with-variables '(("x" . "3"))
|
||||||
|
(lambda ()
|
||||||
|
(eval-word `(<sh-arithmetic> "x + 2")))))
|
||||||
|
|
||||||
|
(test-equal "Evaluates non-numeric variables as zero in arithmetic"
|
||||||
|
'("0")
|
||||||
|
(with-variables '(("x" . "hello"))
|
||||||
|
(lambda ()
|
||||||
|
(eval-word `(<sh-arithmetic> "x")))))
|
||||||
|
|
||||||
|
;;; Assignments
|
||||||
|
|
||||||
|
(for-each (match-lambda
|
||||||
|
((op . result)
|
||||||
|
(test-equal (string-append "Evaluates arithmetic " op)
|
||||||
|
result
|
||||||
|
(with-variables '(("x" . "7"))
|
||||||
|
(lambda ()
|
||||||
|
(eval-word `(<sh-arithmetic>
|
||||||
|
,(string-append "x " op " 3")))
|
||||||
|
(getvar "x"))))))
|
||||||
|
'(("=" . "3")
|
||||||
|
("*=" . "21")
|
||||||
|
("/=" . "2")
|
||||||
|
("%=" . "1")
|
||||||
|
("+=" . "10")
|
||||||
|
("-=" . "4")
|
||||||
|
("<<=" . "56")
|
||||||
|
(">>=" . "0")
|
||||||
|
("&=" . "3")
|
||||||
|
("^=" . "4")
|
||||||
|
("|=" . "7")))
|
||||||
|
|
||||||
|
;;; Unary operators
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic negation"
|
||||||
|
'("-3")
|
||||||
|
(with-variables '(("x" . "3"))
|
||||||
|
(lambda ()
|
||||||
|
(eval-word `(<sh-arithmetic> "-x")))))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic unary plus"
|
||||||
|
'("3")
|
||||||
|
(with-variables '(("x" . "3"))
|
||||||
|
(lambda ()
|
||||||
|
(eval-word `(<sh-arithmetic> "+x")))))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic bitwise complement"
|
||||||
|
'("-6")
|
||||||
|
(eval-word `(<sh-arithmetic> "~5")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic logical complement"
|
||||||
|
'("0")
|
||||||
|
(eval-word `(<sh-arithmetic> "!1")))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic negation on the left"
|
||||||
|
'("-12")
|
||||||
|
(with-variables '(("x" . "3"))
|
||||||
|
(lambda ()
|
||||||
|
(eval-word `(<sh-arithmetic> "-x * 4")))))
|
||||||
|
|
||||||
|
(test-equal "Evaluates arithmetic negation on the right"
|
||||||
|
'("0")
|
||||||
|
(with-variables '(("x" . "3"))
|
||||||
|
(lambda ()
|
||||||
|
(eval-word `(<sh-arithmetic> "3 + -x")))))
|
||||||
|
|
||||||
(test-end "eval")
|
(test-end "eval")
|
||||||
|
|
Loading…
Reference in New Issue