[COMMITTED] pkl: gen: add field location info to EOF exceptions while mapping

[Jose E. Marchesi]

This commit adds some location information to E_eof exceptions raised
while mapping structs, whenever possible.  This is an example:

(poke) type Foo = struct { int i; long l; }
(poke) Foo @ iosize - 1#B
unhandled EOF exception
while mapping field Foo.i

2022-01-02  Jose E. Marchesi  <jemarch@gnu.org>

        * libpoke/pkl-gen.pks (field_location_str): New macro.
        (check_struct_field_constraint): Use field_location_str.
        (struct_field_mapper): Add location error message when EOF is
        raised while mapping.
        * testsuite/poke.map/maps-structs-eof-1.pk: New test.
        * testsuite/Makefile.am (EXTRA_DIST): Add new test.
---
 ChangeLog                                |  9 +++++
 libpoke/pkl-gen.pks                      | 61 +++++++++++++++++++++++++-------
 testsuite/Makefile.am                    |  1 +
 testsuite/poke.map/maps-structs-eof-1.pk |  7 ++++
 4 files changed, 65 insertions(+), 13 deletions(-)
 create mode 100644 testsuite/poke.map/maps-structs-eof-1.pk

diff --git a/ChangeLog b/ChangeLog
index 9097a116..a1d54bb6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,14 @@
 2022-01-02  Jose E. Marchesi  <jemarch@gnu.org>
 
+       * libpoke/pkl-gen.pks (field_location_str): New macro.
+       (check_struct_field_constraint): Use field_location_str.
+       (struct_field_mapper): Add location error message when EOF is
+       raised while mapping.
+       * testsuite/poke.map/maps-structs-eof-1.pk: New test.
+       * testsuite/Makefile.am (EXTRA_DIST): Add new test.
+
+2022-01-02  Jose E. Marchesi  <jemarch@gnu.org>
+
        * poke/pk-cmd-ios.c (pk_cmd_load_file): Handle return value of
        pk_file_readable the proper way.
 
diff --git a/libpoke/pkl-gen.pks b/libpoke/pkl-gen.pks
index ce315acf..784bf2b4 100644
--- a/libpoke/pkl-gen.pks
+++ b/libpoke/pkl-gen.pks
@@ -460,6 +460,42 @@
    .c }
         .end
 
+;;; RAS_MACRO_FIELD_LOCATION_STR @struct_type @field
+;;; ( -- STR )
+;;;
+;;; Calculate a string with some location information for the given
+;;; field.  This may evaluate to an empty string if the struct type
+;;; has no name and the field is anonymous.
+;;;
+;;; Macro arguments:
+;;;
+;;; @struct_type is the type to which the field belongs.
+;;; @field is a pkl_ast_node with the struct field.
+
+        .macro field_location_str @struct_type @field
+ .c pkl_ast_node field_name = PKL_AST_STRUCT_TYPE_FIELD_NAME (@field);        
+ .c if (field_name)
+ .c {
+        .let #field_name_str = pvm_make_string (PKL_AST_IDENTIFIER_POINTER 
(field_name))
+ .c   pkl_ast_node struct_type_name = PKL_AST_TYPE_NAME (@struct_type);        
+ .c   if (struct_type_name)
+ .c   {
+        .let #type_name = pvm_make_string (PKL_AST_IDENTIFIER_POINTER 
(struct_type_name))
+        push #type_name
+        push "."
+        sconc
+        nip2
+        push #field_name_str
+        sconc
+        nip2
+ .c   }
+ .c   else
+ .c   {
+        push #field_name_str
+ .c   }
+ .c }
+        .end
+
 ;;; RAS_MACRO_CHECK_STRUCT_FIELD_CONSTRAINT @struct_type @field
 ;;; ( -- )
 ;;;
@@ -487,21 +523,9 @@
    .c pkl_ast_node field_name = PKL_AST_STRUCT_TYPE_FIELD_NAME (@field);
    .c if (field_name)
    .c {
-        .let #field_name_str = pvm_make_string (PKL_AST_IDENTIFIER_POINTER 
(field_name))
         push "msg"
         push "constraint expression failed for field "
-   .c  pkl_ast_node struct_type_name = PKL_AST_TYPE_NAME (@struct_type);
-   .c  if (struct_type_name)
-   .c  {
-        .let #type_name = pvm_make_string (PKL_AST_IDENTIFIER_POINTER 
(struct_type_name))
-        push #type_name
-        sconc
-        nip2
-        push "."
-        sconc
-        nip2
-   .c  }
-        push #field_name_str
+        .e field_location_str @struct_type, @field
         sconc
         nip2
         sset
@@ -726,6 +750,17 @@
         pope
         ba .val_ok
 .eof:
+        ;; Set some location info in the exception's message
+   .c pkl_ast_node field_name = PKL_AST_STRUCT_TYPE_FIELD_NAME (@field);
+   .c if (field_name)
+   .c {
+        push "msg"
+        push "while mapping field "
+        .e field_location_str @struct_type, @field
+        sconc
+        nip2
+        sset
+   .c }
         pope
 .constraint_error:
         ;; This is to keep the right lexical environment in
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index 93b20b68..a6d2dde4 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -331,6 +331,7 @@ EXTRA_DIST = \
   poke.map/maps-structs-endian-10.pk \
   poke.map/maps-structs-endian-11.pk \
   poke.map/maps-structs-endian-diag-1.pk \
+  poke.map/maps-structs-eof-1.pk \
   poke.map/maps-structs-init-1.pk \
   poke.map/maps-structs-init-2.pk \
   poke.map/maps-structs-init-3.pk \
diff --git a/testsuite/poke.map/maps-structs-eof-1.pk 
b/testsuite/poke.map/maps-structs-eof-1.pk
new file mode 100644
index 00000000..b9acc5c4
--- /dev/null
+++ b/testsuite/poke.map/maps-structs-eof-1.pk
@@ -0,0 +1,7 @@
+/* { dg-do run } */
+/* { dg-data {c*} {0x10 0x20 0x30 0x40  0x60 0x50 0x70 0x80   0x90 0xa0 0xb0 
0xc0} } */
+
+type Packet = struct { byte a; byte b; };
+
+/* { dg-command { try Packet @ 11#B; catch (Exception e) { if (e.code == 
EC_eof) print e.msg + "\n"; } } } */
+/* { dg-output "while mapping field Packet\\.b" } */
-- 
2.11.0