[PATCH] pkl,doc,testsuite: Add `assert` statement

[Mohammad-Reza Nabipoor]

This commit adds `assert` statement to Poke.

  assert (CONDITION)
  assert (CONDITION, MESSAGE)

2020-11-25  Mohammad-Reza Nabipoor  <m.nabipoor@yahoo.com>

        * libpoke/pkl-lex.l: New token.
        * libpoke/pkl-tab.y (simple_stmt): Add rules for assert expression.
        (pkl_make_assertion): New function.
        * libpoke/pkl-rt.pk (EC_assert): New error code.
        (E_assert): New exception.
        (_pkl_assert): New function.
        * doc/poke.texi (assert): New section.
        * testsuite/poke.pkl/assert-1.pk: New test.
        * testsuite/poke.pkl/assert-2.pk: Likewise.
        * testsuite/poke.pkl/assert-3.pk: Likewise.
        * testsuite/poke.pkl/assert-4.pk: Likewise.
        * testsuite/poke.pkl/assert-5.pk: Likewise.
        * testsuite/poke.pkl/assert-diag-1.pk: Likewise.
        * testsuite/poke.pkl/assert-diag-2.pk: Likewise.
        * testsuite/poke.pkl/assert-diag-3.pk: Likewise.
        * testsuite/poke.pkl/assert-diag-4.pk: Likewise.
        * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
---
 ChangeLog                           | 20 ++++++++
 doc/poke.texi                       | 25 ++++++++++
 libpoke/pkl-lex.l                   |  1 +
 libpoke/pkl-rt.pk                   | 15 ++++++
 libpoke/pkl-tab.y                   | 72 +++++++++++++++++++++++++++++
 testsuite/Makefile.am               |  9 ++++
 testsuite/poke.pkl/assert-1.pk      |  3 ++
 testsuite/poke.pkl/assert-2.pk      |  3 ++
 testsuite/poke.pkl/assert-3.pk      |  3 ++
 testsuite/poke.pkl/assert-4.pk      | 16 +++++++
 testsuite/poke.pkl/assert-5.pk      | 13 ++++++
 testsuite/poke.pkl/assert-diag-1.pk |  3 ++
 testsuite/poke.pkl/assert-diag-2.pk |  5 ++
 testsuite/poke.pkl/assert-diag-3.pk |  5 ++
 testsuite/poke.pkl/assert-diag-4.pk |  3 ++
 15 files changed, 196 insertions(+)
 create mode 100644 testsuite/poke.pkl/assert-1.pk
 create mode 100644 testsuite/poke.pkl/assert-2.pk
 create mode 100644 testsuite/poke.pkl/assert-3.pk
 create mode 100644 testsuite/poke.pkl/assert-4.pk
 create mode 100644 testsuite/poke.pkl/assert-5.pk
 create mode 100644 testsuite/poke.pkl/assert-diag-1.pk
 create mode 100644 testsuite/poke.pkl/assert-diag-2.pk
 create mode 100644 testsuite/poke.pkl/assert-diag-3.pk
 create mode 100644 testsuite/poke.pkl/assert-diag-4.pk

diff --git a/ChangeLog b/ChangeLog
index b1240727..064a8159 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,23 @@
+2020-11-25  Mohammad-Reza Nabipoor  <m.nabipoor@yahoo.com>
+
+       * libpoke/pkl-lex.l: New token.
+       * libpoke/pkl-tab.y (simple_stmt): Add rules for assert expression.
+       (pkl_make_assertion): New function.
+       * libpoke/pkl-rt.pk (EC_assert): New error code.
+       (E_assert): New exception.
+       (_pkl_assert): New function.
+       * doc/poke.texi (assert): New section.
+       * testsuite/poke.pkl/assert-1.pk: New test.
+       * testsuite/poke.pkl/assert-2.pk: Likewise.
+       * testsuite/poke.pkl/assert-3.pk: Likewise.
+       * testsuite/poke.pkl/assert-4.pk: Likewise.
+       * testsuite/poke.pkl/assert-5.pk: Likewise.
+       * testsuite/poke.pkl/assert-diag-1.pk: Likewise.
+       * testsuite/poke.pkl/assert-diag-2.pk: Likewise.
+       * testsuite/poke.pkl/assert-diag-3.pk: Likewise.
+       * testsuite/poke.pkl/assert-diag-4.pk: Likewise.
+       * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
+
 2020-11-24  Jose E. Marchesi  <jemarch@gnu.org>
 
        * doc/poke.texi (Integer Types): Fix formatting.
diff --git a/doc/poke.texi b/doc/poke.texi
index b7e78eb0..ec3284e7 100644
--- a/doc/poke.texi
+++ b/doc/poke.texi
@@ -8875,6 +8875,7 @@ provides an exceptions mechanism to deal with these 
situations.
 * try-catch::          Catching exceptions in programs.
 * try-until::          Running code until some exception occurs.
 * raise::              Raising exceptions in programs.
+* assert::             Asserting conditions in programs.
 @end menu
 
 @node Exceptions
@@ -8944,6 +8945,8 @@ is reached.
 Generic IO exception.
 @item E_io_flags
 Invalid flags were tried while opening an IO device.
+@item E_assert
+Assertion failure exception.  This is raised by @code{assert} statement.
 @end table
 
 The exception codes of the standard exceptions are available in the
@@ -9047,6 +9050,28 @@ raise @var{exception};
 where @var{exception} is an integer.  This integer can be any number,
 but most often is one of the @code{E_*} codes defined in Poke.
 
+@node assert
+@subsection @code{assert}
+@cindex @code{assert}
+
+The @code{assert} statement lets you test if a condition is true,
+if not, the program will raise an exception with code @code{EC_assert}.
+
+@example
+assert (@var{condition})
+assert (@var{condition}, @var{message})
+@end example
+
+The optional @var{message} will be part of the @code{msg} field of
+raised @code{Exception} to explain the situation.
+
+@example
+assert (1 == 1);
+assert (0 == 0, ``Zero is equal to zero'');
+@end example
+
+@code{assert} is useful for writing unit tests.
+
 @node Printing
 @section Printing
 
diff --git a/libpoke/pkl-lex.l b/libpoke/pkl-lex.l
index a2ea3b95..b0708786 100644
--- a/libpoke/pkl-lex.l
+++ b/libpoke/pkl-lex.l
@@ -226,6 +226,7 @@ S ::
 "little"        { return LITTLE; }
 "load"          { return LOAD; }
 "lambda"        { return LAMBDA; }
+"assert"        { return ASSERT; }
 "__PKL_BUILTIN_RAND__" {
    if (yyextra->bootstrapped) REJECT; return BUILTIN_RAND; }
 "__PKL_BUILTIN_GET_ENDIAN__" {
diff --git a/libpoke/pkl-rt.pk b/libpoke/pkl-rt.pk
index 935c4e28..43c45347 100644
--- a/libpoke/pkl-rt.pk
+++ b/libpoke/pkl-rt.pk
@@ -86,6 +86,7 @@ var EC_signal        = 12;
 var EC_io_flags      = 13;
 var EC_inval         = 14;
 var EC_exit          = 15;
+var EC_assert        = 16;
 
 /* Standard exceptions.  */
 
@@ -121,6 +122,8 @@ var E_inval
   = Exception {code = EC_inval, msg = "invalid argument", exit_status = 1};
 var E_exit
   = Exception {code = EC_exit, msg = "exit", exit_status = 0};
+var E_assert
+  = Exception {code = EC_assert, msg = "assertion failure", exit_status = 1};
 
 /* Default exception handler.
 
@@ -140,6 +143,18 @@ fun _pkl_exception_handler = (Exception exception) int<32>:
    return exception.exit_status;
   }
 
+fun _pkl_assert = (uint<64> cond, string msg, string lineinfo) void:
+  {
+    if (cond)
+      return;
+
+    raise Exception {
+      code = EC_assert,
+      msg = "assertion failed at " + lineinfo + (msg'length ? ": " + msg : ""),
+      exit_status = 1,
+    };
+  }
+
 /* Exit a Poke program with the given exit status code.  This is equivalent
    to raise an E_exit exception, but provides a more conventional
    syntax.  */
diff --git a/libpoke/pkl-tab.y b/libpoke/pkl-tab.y
index ba3ff6e9..bc5f4e75 100644
--- a/libpoke/pkl-tab.y
+++ b/libpoke/pkl-tab.y
@@ -120,6 +120,62 @@ pkl_register_arg (struct pkl_parser *parser, pkl_ast_node 
arg)
   return 1;
 }
 
+static pkl_ast_node
+pkl_make_assertion(struct pkl_parser *p, pkl_ast_node cond, pkl_ast_node msg,
+  struct pkl_ast_loc stmt_loc)
+{
+  pkl_ast_node id, varinit, var, call, arg_cond, arg_msg, arg_lineinfo;
+  pkl_ast_node lineinfo, asrt;
+  int back, over;
+  char buf[128];
+  const char *name = "_pkl_assert";
+
+  id = pkl_ast_make_identifier (p->ast, name);
+  varinit = pkl_env_lookup (p->env, PKL_ENV_NS_MAIN, name, &back, &over);
+  if (!varinit || (PKL_AST_DECL_KIND (varinit) != PKL_AST_DECL_KIND_FUNC))
+    {
+      pkl_error (p->compiler, p->ast, stmt_loc,
+                 "undefined function '%s'", name);
+      return NULL;
+    }
+  var = pkl_ast_make_var (p->ast, id, varinit, back, over);
+  PKL_AST_LOC (var) = PKL_AST_LOC (id);
+
+  snprintf (buf, sizeof (buf), "%s:%d:%d",
+            p->filename ? p->filename : "<stdin>", stmt_loc.first_line,
+            stmt_loc.first_column);
+  lineinfo = pkl_ast_make_string (p->ast, buf);
+  PKL_AST_TYPE (lineinfo) = ASTREF (pkl_ast_make_string_type (p->ast));
+  PKL_AST_LOC (lineinfo) = stmt_loc;
+  PKL_AST_LOC (PKL_AST_TYPE (lineinfo)) = stmt_loc;
+
+  arg_cond = pkl_ast_make_funcall_arg (p->ast, cond, NULL);
+  PKL_AST_LOC (arg_cond) = PKL_AST_LOC (cond);
+
+  if (msg == NULL)
+    {
+      msg = pkl_ast_make_string (p->ast, "");
+      PKL_AST_TYPE (msg) = ASTREF (pkl_ast_make_string_type (p->ast));
+      PKL_AST_LOC (msg) = stmt_loc;
+    }
+
+  arg_msg = ASTREF (pkl_ast_make_funcall_arg (p->ast, msg, NULL));
+  PKL_AST_LOC (arg_msg) = PKL_AST_LOC (msg);
+
+  arg_lineinfo = ASTREF (pkl_ast_make_funcall_arg (p->ast, lineinfo, NULL));
+  PKL_AST_LOC (arg_lineinfo) = PKL_AST_LOC (lineinfo);
+
+  call = pkl_ast_make_funcall (
+      p->ast, var,
+      pkl_ast_chainon (arg_cond, pkl_ast_chainon (arg_msg, arg_lineinfo)));
+  PKL_AST_LOC (call) = stmt_loc;
+
+  asrt = pkl_ast_make_exp_stmt (p->ast, call);
+  PKL_AST_LOC (asrt) = stmt_loc;
+
+  return asrt;
+}
+
 #if 0
 /* Register a list of arguments in the compile-time environment.  This
    is used by function specifiers and try-catch statements.
@@ -1932,6 +1988,22 @@ simple_stmt:
                     PKL_AST_LOC (PKL_AST_TYPE ($3)) = @3;
                   PKL_AST_LOC ($$) = @$;
                 }
+        | ASSERT '(' expression ')'
+                {
+                  pkl_ast_node asrt = pkl_make_assertion (pkl_parser, $3, NULL,
+                                                          @$);
+                  if (asrt == NULL)
+                    YYERROR;
+                  $$ = asrt;
+                }
+        | ASSERT '(' expression ',' expression ')'
+                {
+                  pkl_ast_node asrt = pkl_make_assertion (pkl_parser, $3, $5,
+                                                          @$);
+                  if (asrt == NULL)
+                    YYERROR;
+                  $$ = asrt;
+                }
         | funcall_stmt
                 {
                   $$ = pkl_ast_make_exp_stmt (pkl_parser->ast,
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index 382a5246..df53ccae 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -602,6 +602,15 @@ EXTRA_DIST = \
   poke.pkl/ass-struct-int-4.pk \
   poke.pkl/ass-union-int-1.pk \
   poke.pkl/ass-union-int-2.pk \
+  poke.pkl/assert-1.pk \
+  poke.pkl/assert-2.pk \
+  poke.pkl/assert-3.pk \
+  poke.pkl/assert-4.pk \
+  poke.pkl/assert-5.pk \
+  poke.pkl/assert-diag-1.pk \
+  poke.pkl/assert-diag-2.pk \
+  poke.pkl/assert-diag-3.pk \
+  poke.pkl/assert-diag-4.pk \
   poke.pkl/attr-diag-1.pk \
   poke.pkl/attr-ios-1.pk \
   poke.pkl/attr-ios-2.pk \
diff --git a/testsuite/poke.pkl/assert-1.pk b/testsuite/poke.pkl/assert-1.pk
new file mode 100644
index 00000000..8120d61b
--- /dev/null
+++ b/testsuite/poke.pkl/assert-1.pk
@@ -0,0 +1,3 @@
+/* { dg-do run } */
+
+assert (1 == 1);  /* { dg-output "" } */
diff --git a/testsuite/poke.pkl/assert-2.pk b/testsuite/poke.pkl/assert-2.pk
new file mode 100644
index 00000000..43a28479
--- /dev/null
+++ b/testsuite/poke.pkl/assert-2.pk
@@ -0,0 +1,3 @@
+/* { dg-do run } */
+
+assert ("foo" != "bar");  /* { dg-output "" } */
diff --git a/testsuite/poke.pkl/assert-3.pk b/testsuite/poke.pkl/assert-3.pk
new file mode 100644
index 00000000..65482f35
--- /dev/null
+++ b/testsuite/poke.pkl/assert-3.pk
@@ -0,0 +1,3 @@
+/* { dg-do run } */
+
+assert (1#B == 8#b, "One byte equals to 8 bits");  /* { dg-output "" } */
diff --git a/testsuite/poke.pkl/assert-4.pk b/testsuite/poke.pkl/assert-4.pk
new file mode 100644
index 00000000..c2cbf1a5
--- /dev/null
+++ b/testsuite/poke.pkl/assert-4.pk
@@ -0,0 +1,16 @@
+/* { dg-do run } */
+
+fun a = (int cond) void:
+  {
+    assert (1 == 1, "One is equal to one");
+
+    try assert (cond);
+    catch
+      {
+        print ("assertion failed");
+      }
+  }
+
+/* { dg-command { a (1) } } */
+/* { dg-command { a (0) } } */
+/* { dg-output "assertion failed" } */
diff --git a/testsuite/poke.pkl/assert-5.pk b/testsuite/poke.pkl/assert-5.pk
new file mode 100644
index 00000000..839dc504
--- /dev/null
+++ b/testsuite/poke.pkl/assert-5.pk
@@ -0,0 +1,13 @@
+/* { dg-do run } */
+
+fun f = void:
+  {
+    try assert (1 == 0);
+    catch if Exception {code = EC_assert}
+      {
+        print "caught\n";
+      }
+  }
+
+/* { dg-command { f } } */
+/* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/assert-diag-1.pk 
b/testsuite/poke.pkl/assert-diag-1.pk
new file mode 100644
index 00000000..bc266895
--- /dev/null
+++ b/testsuite/poke.pkl/assert-diag-1.pk
@@ -0,0 +1,3 @@
+/* { dg-do run } */
+
+assert ("foo" == "bar");  /* { dg-output "unhandled assertion failed" } */
diff --git a/testsuite/poke.pkl/assert-diag-2.pk 
b/testsuite/poke.pkl/assert-diag-2.pk
new file mode 100644
index 00000000..99a5e9f3
--- /dev/null
+++ b/testsuite/poke.pkl/assert-diag-2.pk
@@ -0,0 +1,5 @@
+/* { dg-do compile } */
+
+/* function argument 1 has the wrong type */
+
+assert ("foo");  /* { dg-error "" } */
diff --git a/testsuite/poke.pkl/assert-diag-3.pk 
b/testsuite/poke.pkl/assert-diag-3.pk
new file mode 100644
index 00000000..48a1362d
--- /dev/null
+++ b/testsuite/poke.pkl/assert-diag-3.pk
@@ -0,0 +1,5 @@
+/* { dg-do compile } */
+
+/* function argument 2 has the wrong type */
+
+assert (2, 0);  /* { dg-error "" } */
diff --git a/testsuite/poke.pkl/assert-diag-4.pk 
b/testsuite/poke.pkl/assert-diag-4.pk
new file mode 100644
index 00000000..56acd245
--- /dev/null
+++ b/testsuite/poke.pkl/assert-diag-4.pk
@@ -0,0 +1,3 @@
+/* { dg-do compile } */
+
+assert (1#B);  /* { dg-error "" } */
-- 
2.29.2