[PATCH] pkl: Fix mapper for integral unions

[Mohammad-Reza Nabipoor]

2022-11-03  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>

        * libpoke/pkl-gen.pks (struct_mapper): Handle integral unions.
        * testsuite/poke.map/maps-int-union-6.pk: New test.
        * testsuite/Makefile.am (EXTRA_DIST): Update.
---
 ChangeLog                              |  6 +++++
 libpoke/pkl-gen.pks                    | 32 +++++++++++---------------
 testsuite/Makefile.am                  |  1 +
 testsuite/poke.map/maps-int-union-6.pk |  9 ++++++++
 4 files changed, 30 insertions(+), 18 deletions(-)
 create mode 100644 testsuite/poke.map/maps-int-union-6.pk

diff --git a/ChangeLog b/ChangeLog
index 0d42e313..67ef1d32 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2022-11-03  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
+
+       * libpoke/pkl-gen.pks (struct_mapper): Handle integral unions.
+       * testsuite/poke.map/maps-int-union-6.pk: New test.
+       * testsuite/Makefile.am (EXTRA_DIST): Update.
+
 2022-11-03  Jose E. Marchesi  <jemarch@gnu.org>
 
        * poke/pk-cmd-misc.c (pk_cmd_jmd): New quote.
diff --git a/libpoke/pkl-gen.pks b/libpoke/pkl-gen.pks
index d58b2b27..db08d84b 100644
--- a/libpoke/pkl-gen.pks
+++ b/libpoke/pkl-gen.pks
@@ -1144,6 +1144,10 @@
         pushe .eof_in_alternative
         push PVM_E_CONSTRAINT
         pushe .constraint_in_alternative
+        ;; Note that this `dup' is necessary in order to not disturb
+        ;; the value at the TOS present when the EOF and CONSTRAINT
+        ;; handlers are installed.
+        dup                      ; ...[EBOFF ENAME EVAL] [NEBOFF] NEBOFF
  .c   }
  .c   if (PKL_AST_TYPE_S_ITYPE (@type_struct))
  .c   {
@@ -1160,33 +1164,29 @@
         ;; Note that at this point the field is assured to be
         ;; an integral type, as per typify.
         pushvar $strict
-        swap                     ; ...[EBOFF ENAME EVAL] STRICT NEBOFF
+        swap                     ; ...[EBOFF ENAME EVAL] [NEBOFF] STRICT NEBOFF
         pushvar $boff
-        pushvar $ivalue          ; ...[EBOFF ENAME EVAL] STRICT NEBOFF OFF IVAL
-        .e struct_field_extractor @type_struct, @field, @struct_itype, 
@field_type, \
-                                  #ivalw, #fieldw
-                                 ; ...[EBOFF ENAME EVAL] NEBOFF
+        pushvar $ivalue          ; ...[EBOFF ENAME EVAL] [NEBOFF] STRICT 
NEBOFF OFF IVAL
+        .e struct_field_extractor @type_struct, @field, @struct_itype, \
+                                  @field_type, #ivalw, #fieldw
+                                 ; ...[EBOFF ENAME EVAL] [NEBOFF] EBOFF ENAME 
EVAL NEBOFF
  .c   }
  .c   else
  .c   {
- .c     if (PKL_AST_TYPE_S_UNION_P (@type_struct))
- .c     {
-        ;; Note that this `dup' is necessary in order to not disturb
-        ;; the value at the TOS present when the EOF and CONSTRAINT
-        ;; handlers are installed.
-        dup                      ; ...[EBOFF ENAME EVAL] [NEBOFF] NEBOFF
- .c     }
         ;; Attempt the mapping.
         pushvar $strict          ; ...[EBOFF ENAME EVAL] [NEBOFF] NEBOFF STRICT
         swap                     ; ...[EBOFF ENAME EVAL] [NEBOFF] STRICT NEBOFF
         pushvar $ios             ; ...[EBOFF ENAME EVAL] [NEBOFF] STRICT 
NEBOFF IOS
         swap                     ; ...[EBOFF ENAME EVAL] [NEBOFF] STRICT IOS 
NEBOFF
         pushvar $boff            ; ...[EBOFF ENAME EVAL] [NEBOFF] STRICT IOS 
NEBOFF OFF
+        ; ( STRICT IOS BOFF SBOFF -- BOFF STR VAL NBOFF )
         .e struct_field_mapper @type_struct, @field
                                 ; ...[NEBOFF] [EBOFF ENAME EVAL] NEBOFF
 .omitted_field:
- .c     if (PKL_AST_TYPE_S_UNION_P (@type_struct))
- .c     {
+ .c   }
+ .c   if (PKL_AST_TYPE_S_UNION_P (@type_struct))
+ .c   {
+        ; Drop the value created from dup
         tor
         tor
         tor
@@ -1196,10 +1196,6 @@
         fromr
         fromr
         fromr
- .c     }
- .c   }
- .c   if (PKL_AST_TYPE_S_UNION_P (@type_struct))
- .c   {
         pope
         pope
  .c   }
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index 5783c220..2e146c7d 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -307,6 +307,7 @@ EXTRA_DIST = \
   poke.map/maps-int-union-4.pk \
   poke.map/maps-int-union-3.pk \
   poke.map/maps-int-union-5.pk \
+  poke.map/maps-int-union-6.pk \
   poke.map/maps-ios-1.pk \
   poke.map/maps-ios-2.pk \
   poke.map/maps-ios-3.pk \
diff --git a/testsuite/poke.map/maps-int-union-6.pk 
b/testsuite/poke.map/maps-int-union-6.pk
new file mode 100644
index 00000000..b283d86f
--- /dev/null
+++ b/testsuite/poke.map/maps-int-union-6.pk
@@ -0,0 +1,9 @@
+/* { dg-do run } */
+/* { dg-data {c*} {0x10 0x20 0x30 0x40 0x50} } */
+
+type Foo = struct int { int i : 0; };
+type Bar = struct int { int i : 0; };
+type Baz = union int { Foo f; Bar b; };
+
+/* { dg-command {try Baz @ 1#B; catch if E_constraint {print "caught";}} } */
+/* { dg-output "caught" } */
-- 
2.38.1