Re: [PATCH] pkl: Fix mapper for integral unions

[Jose E. Marchesi]

OK for master.
Thanks for the patch!

> 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" } */