grt rtis/wave: handle unbounded record subtypes.

Fix #668

4 files changed, 83 insertions, 19 deletions

diff --git a/src/grt/grt-disp_rti.adb b/src/grt/grt-disp_rti.adb
index 81e7e2b4c..177093747 100644
--- a/src/grt/grt-disp_rti.adb
+++ b/src/grt/grt-disp_rti.adb
@@ -327,9 +327,21 @@ package body Grt.Disp_Rti is
                Disp_Record_Value (Stream, Bt, Ctxt, Obj, Rec_Layout, Is_Sig);
             end;
          when Ghdl_Rtik_Type_Unbounded_Record =>
-            Disp_Record_Value
-              (Stream, To_Ghdl_Rtin_Type_Record_Acc (Rti), Ctxt,
-               Obj, Bounds, Is_Sig);
+            declare
+               Bt : constant Ghdl_Rtin_Type_Record_Acc :=
+                 To_Ghdl_Rtin_Type_Record_Acc (Rti);
+            begin
+               Disp_Record_Value (Stream, Bt, Ctxt, Obj, Bounds, Is_Sig);
+            end;
+         when Ghdl_Rtik_Subtype_Unbounded_Record =>
+            declare
+               St : constant Ghdl_Rtin_Subtype_Composite_Acc :=
+                 To_Ghdl_Rtin_Subtype_Composite_Acc (Rti);
+               Bt : constant Ghdl_Rtin_Type_Record_Acc :=
+                 To_Ghdl_Rtin_Type_Record_Acc (St.Basetype);
+            begin
+               Disp_Record_Value (Stream, Bt, Ctxt, Obj, Bounds, Is_Sig);
+            end;
          when Ghdl_Rtik_Subtype_Record =>
             declare
                St : constant Ghdl_Rtin_Subtype_Composite_Acc :=
diff --git a/src/grt/grt-ghw.ads b/src/grt/grt-ghw.ads
index 4a23fbf41..a605138e7 100644
--- a/src/grt/grt-ghw.ads
+++ b/src/grt/grt-ghw.ads
@@ -48,6 +48,14 @@ package Grt.Ghw is
    type Ghw_Rtik is new Unsigned_8;
    Ghw_Rtik_Error : constant Ghw_Rtik := 0;
    Ghw_Rtik_Eos      : constant Ghw_Rtik := 15; --  End of scope.
+
+   Ghw_Rtik_Signal       : constant Ghw_Rtik := 16; --  Signal.
+   Ghw_Rtik_Port_In      : constant Ghw_Rtik := 17; --  Port
+   Ghw_Rtik_Port_Out     : constant Ghw_Rtik := 18; --  Port
+   Ghw_Rtik_Port_Inout   : constant Ghw_Rtik := 19; --  Port
+   Ghw_Rtik_Port_Buffer  : constant Ghw_Rtik := 20; --  Port
+   Ghw_Rtik_Port_Linkage : constant Ghw_Rtik := 21; --  Port
+
    Ghw_Rtik_Type_B2  : constant Ghw_Rtik := 22;
    Ghw_Rtik_Type_E8  : constant Ghw_Rtik := 23;
    Ghw_Rtik_Type_E32 : constant Ghw_Rtik := 24;  --  Not used in waves
@@ -72,11 +80,4 @@ package Grt.Ghw is
    Ghw_Rtik_Subtype_P32 : constant Ghw_Rtik := 47;
    Ghw_Rtik_Subtype_P64 : constant Ghw_Rtik := 48;
 
-   Ghw_Rtik_Signal       : constant Ghw_Rtik := 16; --  Signal.
-   Ghw_Rtik_Port_In      : constant Ghw_Rtik := 17; --  Port
-   Ghw_Rtik_Port_Out     : constant Ghw_Rtik := 18; --  Port
-   Ghw_Rtik_Port_Inout   : constant Ghw_Rtik := 19; --  Port
-   Ghw_Rtik_Port_Buffer  : constant Ghw_Rtik := 20; --  Port
-   Ghw_Rtik_Port_Linkage : constant Ghw_Rtik := 21; --  Port
-
 end Grt.Ghw;
diff --git a/src/grt/grt-rtis_utils.adb b/src/grt/grt-rtis_utils.adb
index ed4429744..f90ae47a6 100644
--- a/src/grt/grt-rtis_utils.adb
+++ b/src/grt/grt-rtis_utils.adb
@@ -445,6 +445,15 @@ package body Grt.Rtis_Utils is
             when Ghdl_Rtik_Type_Unbounded_Record =>
                --  Bounds (layout) must have been extracted.
                Handle_Record (To_Ghdl_Rtin_Type_Record_Acc (Rti));
+            when Ghdl_Rtik_Subtype_Unbounded_Record =>
+               declare
+                  St : constant Ghdl_Rtin_Subtype_Composite_Acc :=
+                    To_Ghdl_Rtin_Subtype_Composite_Acc (Rti);
+                  Bt : constant Ghdl_Rtin_Type_Record_Acc :=
+                    To_Ghdl_Rtin_Type_Record_Acc (St.Basetype);
+               begin
+                  Handle_Record (Bt);
+               end;
             when Ghdl_Rtik_Subtype_Record =>
                declare
                   St : constant Ghdl_Rtin_Subtype_Composite_Acc :=
diff --git a/src/grt/grt-waves.adb b/src/grt/grt-waves.adb
index ffe174bf6..e1931bfa2 100644
--- a/src/grt/grt-waves.adb
+++ b/src/grt/grt-waves.adb
@@ -678,7 +678,7 @@ package body Grt.Waves is
                end loop;
             end;
          when Ghdl_Rtik_Type_Record
-           | Ghdl_Rtik_Type_Unbounded_Record =>
+           |  Ghdl_Rtik_Type_Unbounded_Record =>
             declare
                Rec : constant Ghdl_Rtin_Type_Record_Acc :=
                  To_Ghdl_Rtin_Type_Record_Acc (Rti);
@@ -699,6 +699,22 @@ package body Grt.Waves is
                Create_String_Id (Rec.Name);
                Create_Type (Rec.Basetype, N_Ctxt);
             end;
+         when Ghdl_Rtik_Subtype_Unbounded_Record =>
+            --  Only the base type.
+            declare
+               St : constant Ghdl_Rtin_Subtype_Composite_Acc :=
+                 To_Ghdl_Rtin_Subtype_Composite_Acc (Rti);
+               B_Ctxt : Rti_Context;
+            begin
+               if Rti_Complex_Type (Rti) then
+                  B_Ctxt := Ctxt;
+               else
+                  B_Ctxt := N_Ctxt;
+               end if;
+               Create_Type (St.Basetype, B_Ctxt);
+
+               return;
+            end;
          when others =>
             Internal_Error ("wave.create_type");
 --              Internal_Error ("wave.create_type: does not handle " &
@@ -729,7 +745,8 @@ package body Grt.Waves is
       --  The real type will be written to the file.
       case Rti.Kind is
          when Ghdl_Rtik_Type_Array
-           | Ghdl_Rtik_Type_Unbounded_Record =>
+           | Ghdl_Rtik_Type_Unbounded_Record
+           | Ghdl_Rtik_Subtype_Unbounded_Record =>
             Add_Type (Avhpi_Get_Rti (Obj), Avhpi_Get_Context (Obj));
          when others =>
             null;
@@ -751,7 +768,8 @@ package body Grt.Waves is
       Rti := Avhpi_Get_Rti (Obj_Type);
       case Rti.Kind is
          when Ghdl_Rtik_Type_Array
-           | Ghdl_Rtik_Type_Unbounded_Record =>
+           | Ghdl_Rtik_Type_Unbounded_Record
+           | Ghdl_Rtik_Subtype_Unbounded_Record =>
             Write_Type_Id (Avhpi_Get_Rti (Obj), Avhpi_Get_Context (Obj));
          when others =>
             Write_Type_Id (Rti, Avhpi_Get_Context (Obj_Type));
@@ -1291,7 +1309,7 @@ package body Grt.Waves is
    end Write_Array_Bounds;
 
    procedure Write_Record_Bounds (Rec : Ghdl_Rtin_Type_Record_Acc;
-                                  Bounds : in out Address)
+                                  Layout : Address)
    is
       El : Ghdl_Rtin_Element_Acc;
    begin
@@ -1300,10 +1318,12 @@ package body Grt.Waves is
          case El.Eltype.Kind is
             when Ghdl_Rtik_Type_Array =>
                Write_Array_Bounds
-                 (To_Ghdl_Rtin_Type_Array_Acc (El.Eltype), Bounds);
+                 (To_Ghdl_Rtin_Type_Array_Acc (El.Eltype),
+                  Array_Layout_To_Bounds (Layout + El.Layout_Off));
             when Ghdl_Rtik_Type_Unbounded_Record =>
                Write_Record_Bounds
-                 (To_Ghdl_Rtin_Type_Record_Acc (El.Eltype), Bounds);
+                 (To_Ghdl_Rtin_Type_Record_Acc (El.Eltype),
+                  Layout + El.Layout_Off);
             when others =>
                null;
          end case;
@@ -1354,15 +1374,29 @@ package body Grt.Waves is
                         Rec : constant Ghdl_Rtin_Type_Record_Acc :=
                           To_Ghdl_Rtin_Type_Record_Acc (Obj_Rti.Obj_Type);
                         Addr : Ghdl_Uc_Array_Acc;
-                        Bounds : Address;
                      begin
                         Wave_Put_Byte (Ghw_Rtik'Pos (Ghw_Rtik_Subtype_Record));
                         Write_String_Id (null);
                         Write_Type_Id (Obj_Rti.Obj_Type, Ctxt);
                         Addr := To_Ghdl_Uc_Array_Acc
                           (Loc_To_Addr (Rti.Depth, Obj_Rti.Loc, Ctxt));
-                        Bounds := Addr.Bounds;
-                        Write_Record_Bounds (Rec, Bounds);
+                        Write_Record_Bounds (Rec, Addr.Bounds);
+                     end;
+                  when Ghdl_Rtik_Subtype_Unbounded_Record =>
+                     declare
+                        St : constant Ghdl_Rtin_Subtype_Composite_Acc :=
+                          To_Ghdl_Rtin_Subtype_Composite_Acc
+                          (Obj_Rti.Obj_Type);
+                        Rec : constant Ghdl_Rtin_Type_Record_Acc :=
+                          To_Ghdl_Rtin_Type_Record_Acc (St.Basetype);
+                        Addr : Ghdl_Uc_Array_Acc;
+                     begin
+                        Wave_Put_Byte (Ghw_Rtik'Pos (Ghw_Rtik_Subtype_Record));
+                        Write_String_Id (null);
+                        Write_Type_Id (St.Basetype, Ctxt);
+                        Addr := To_Ghdl_Uc_Array_Acc
+                          (Loc_To_Addr (Rti.Depth, Obj_Rti.Loc, Ctxt));
+                        Write_Record_Bounds (Rec, Addr.Bounds);
                      end;
                   when others =>
                      Internal_Error ("waves.write_types: unhandled obj kind");
@@ -1445,6 +1479,14 @@ package body Grt.Waves is
                         Write_Record_Bounds (Base, Layout);
                      end if;
                   end;
+               when Ghdl_Rtik_Subtype_Unbounded_Record =>
+                  declare
+                     Rec : constant Ghdl_Rtin_Subtype_Composite_Acc :=
+                       To_Ghdl_Rtin_Subtype_Composite_Acc (Rti);
+                  begin
+                     Write_String_Id (Rec.Name);
+                     Write_Type_Id (Rec.Basetype, Ctxt);
+                  end;
                when Ghdl_Rtik_Subtype_Scalar =>
                   declare
                      Sub : constant Ghdl_Rtin_Subtype_Scalar_Acc :=