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

[Mohammad-Reza Nabipoor]

This commit adds `assert` statement to Poke.

  assert (CONDITION)
  assert (CONDITION, MESSAGE)

2020-11-26  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.
        * libpoke/pvm.h (PVM_E_ASSERT*): New exception.
        * 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.
---

Hi, Jose!

Thanks for your detailed review.

- Refactored the `pkl_make_assertion` to make it more readable.
  And also removed the unnecessary `PKL_AST_LOC`s.
- Added `PKL_AST_LOC ($$) = @$;` to the new rules (despite the fact
  that the location has already been set in `pkl_make_assertion` function).
- Changed `assert-4.pk` to verify more of output message.

And could you please make sure that I get the memory management right, in
`pkl_make_assertion`?


Regards,
Mohammad-Reza


 ChangeLog                           | 21 +++++++
 doc/poke.texi                       | 25 ++++++++
 libpoke/pkl-lex.l                   |  1 +
 libpoke/pkl-rt.pk                   | 24 ++++++++
 libpoke/pkl-tab.y                   | 93 +++++++++++++++++++++++++++++
 libpoke/pvm.h                       |  4 ++
 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 +
 16 files changed, 231 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 cca48552..6d1dd5c0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,24 @@
+2020-11-26  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.
+       * libpoke/pvm.h (PVM_E_ASSERT*): New exception.
+       * 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-25  Jose E. Marchesi  <jemarch@gnu.org>
 
        * poke/poke.pk (pk_help_topics): New variable.
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 073311ae..55262869 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..75856477 100644
--- a/libpoke/pkl-rt.pk
+++ b/libpoke/pkl-rt.pk
@@ -66,6 +66,7 @@ type Exception =
   };
 
 /* Standard exception codes.
+   These codes should be in sync with PVM_E_* macros in pvm.h.
    Note that user-defined exceptions must have codes starting with
    255.
    Note also that EC_generic _must_ be zero.  */
@@ -86,6 +87,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 +123,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 +144,26 @@ fun _pkl_exception_handler = (Exception exception) int<32>:
    return exception.exit_status;
   }
 
+/* Assertion function.
+
+   Poke parser transforms assert statement to invocation of this
+   function.  COND is first argument of assert statement, and MSG is
+   the optional second argument.  LINEINFO contains the source location
+   of the assert statement formatted like "<FILENAME>:<LINE>:<COLUMN>".
+   */
+
+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..7b1b138c 100644
--- a/libpoke/pkl-tab.y
+++ b/libpoke/pkl-tab.y
@@ -120,6 +120,81 @@ pkl_register_arg (struct pkl_parser *parser, pkl_ast_node 
arg)
   return 1;
 }
 
+/* Assert statement is a syntatic sugar that transforms to invocation of
+   _pkl_assert function with appropriate arguments.
+
+   This function accepts AST nodes corresponding to the condition and
+   optional message of the assert statement, and also the location info
+   of the statement.
+
+   Returns NULL on failure, and expression statement AST node on success.  */
+
+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 vfunc, call, asrt;
+  pkl_ast_node arg_cond, arg_msg, arg_lineinfo; /* _pkl_assert args */
+  const char *name = "_pkl_assert"; /* Function defined in pkl-rt.pk */
+
+  /* Make variable for `_pkl_assert` */
+  {
+    pkl_ast_node vfunc_init;
+    int back, over;
+
+    vfunc_init = pkl_env_lookup (p->env, PKL_ENV_NS_MAIN, name, &back, &over);
+    if (!vfunc_init
+        || (PKL_AST_DECL_KIND (vfunc_init) != PKL_AST_DECL_KIND_FUNC))
+      {
+        pkl_error (p->compiler, p->ast, stmt_loc, "undefined function '%s'",
+                   name);
+        return NULL;
+      }
+    vfunc = pkl_ast_make_var (p->ast, pkl_ast_make_identifier (p->ast, name),
+                              vfunc_init, back, over);
+  }
+
+  /* First argument of _pkl_assert */
+  arg_cond = pkl_ast_make_funcall_arg (p->ast, cond, NULL);
+  PKL_AST_LOC (arg_cond) = PKL_AST_LOC (cond);
+
+  /* Second argument of _pkl_assert */
+  if (msg == NULL)
+    {
+      msg = pkl_ast_make_string (p->ast, "");
+      PKL_AST_TYPE (msg) = ASTREF (pkl_ast_make_string_type (p->ast));
+    }
+  arg_msg = ASTREF (pkl_ast_make_funcall_arg (p->ast, msg, NULL));
+  PKL_AST_LOC (arg_msg) = PKL_AST_LOC (msg);
+
+  /* Third argument of _pkl_assert to report the location of the assert
+     statement with the following format "<FILENAME>:<LINE>:<COLUMN>".  */
+  {
+    char *str;
+    pkl_ast_node lineinfo;
+
+    if (asprintf (&str, "%s:%d:%d", p->filename ? p->filename : "<stdin>",
+                  stmt_loc.first_line, stmt_loc.first_column)
+        == -1)
+      return NULL;
+    lineinfo = pkl_ast_make_string (p->ast, str);
+    free (str);
+    PKL_AST_TYPE (lineinfo) = ASTREF (pkl_ast_make_string_type (p->ast));
+
+    arg_lineinfo = ASTREF (pkl_ast_make_funcall_arg (p->ast, lineinfo, NULL));
+  }
+
+  call = pkl_ast_make_funcall (
+      p->ast, vfunc,
+      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 +2007,24 @@ 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;
+                  PKL_AST_LOC ($$) = @$;
+                }
+        | ASSERT '(' expression ',' expression ')'
+                {
+                  pkl_ast_node asrt = pkl_make_assertion (pkl_parser, $3, $5,
+                                                          @$);
+                  if (asrt == NULL)
+                    YYERROR;
+                  $$ = asrt;
+                  PKL_AST_LOC ($$) = @$;
+                }
         | funcall_stmt
                 {
                   $$ = pkl_ast_make_exp_stmt (pkl_parser->ast,
diff --git a/libpoke/pvm.h b/libpoke/pvm.h
index abae03ed..b03e60a2 100644
--- a/libpoke/pvm.h
+++ b/libpoke/pvm.h
@@ -519,6 +519,10 @@ enum pvm_exit_code
 #define PVM_E_EXIT_MSG ""
 #define PVM_E_EXIT_ESTATUS 0
 
+#define PVM_E_ASSERT       16
+#define PVM_E_ASSERT_MSG "assertion failure"
+#define PVM_E_ASSERT_ESTATUS 1
+
 typedef struct pvm *pvm;
 
 /* Initialize a new Poke Virtual Machine and return it.  */
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index 43b260c8..3787c197 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..b36313ad
--- /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); /* Line 7. Assert statement starts at column 9. */
+    catch (Exception ex)
+      {
+        print (ex.msg + "\n");
+      }
+  }
+
+/* { dg-command { a (1) } } */
+/* { dg-command { a (0) } } */
+/* { dg-output "assertion failed at .*:7:9" } */
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..3d71006a
--- /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 at " } */
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