From 7a4c217d9a21bf241c8760750bd10408c7855f35 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Wed, 5 Aug 2020 18:33:44 +0200
Subject: grt: adjust previous patch on grt-waves

Write bounds only when the element subtype of the base type is unbounded.
---
 src/grt/grt-disp_rti.adb   | 13 -------------
 src/grt/grt-rtis_utils.adb | 13 +++++++++++++
 src/grt/grt-rtis_utils.ads |  3 +++
 src/grt/grt-waves.adb      | 26 +++++++++++++++++++-------
 4 files changed, 35 insertions(+), 20 deletions(-)

(limited to 'src/grt')

diff --git a/src/grt/grt-disp_rti.adb b/src/grt/grt-disp_rti.adb
index f56c1a921..6dafdff93 100644
--- a/src/grt/grt-disp_rti.adb
+++ b/src/grt/grt-disp_rti.adb
@@ -578,19 +578,6 @@ package body Grt.Disp_Rti is
       end case;
    end Disp_Scalar_Type_Name;
 
-   function Is_Unbounded (Rti : Ghdl_Rti_Access) return Boolean is
-   begin
-      case Rti.Kind is
-         when Ghdl_Rtik_Type_Array
-           | Ghdl_Rtik_Subtype_Unbounded_Array
-           | Ghdl_Rtik_Type_Unbounded_Record
-           | Ghdl_Rtik_Subtype_Unbounded_Record =>
-            return True;
-         when others =>
-            return False;
-      end case;
-   end Is_Unbounded;
-
    procedure Disp_Type_Composite_Bounds
      (Def : Ghdl_Rti_Access; Bounds : Address);
 
diff --git a/src/grt/grt-rtis_utils.adb b/src/grt/grt-rtis_utils.adb
index 60266c0f5..e40e3a753 100644
--- a/src/grt/grt-rtis_utils.adb
+++ b/src/grt/grt-rtis_utils.adb
@@ -225,6 +225,19 @@ package body Grt.Rtis_Utils is
       end case;
    end Record_To_Element;
 
+   function Is_Unbounded (Rti : Ghdl_Rti_Access) return Boolean is
+   begin
+      case Rti.Kind is
+         when Ghdl_Rtik_Type_Array
+           | Ghdl_Rtik_Subtype_Unbounded_Array
+           | Ghdl_Rtik_Type_Unbounded_Record
+           | Ghdl_Rtik_Subtype_Unbounded_Record =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Is_Unbounded;
+
    procedure Foreach_Scalar (Ctxt : Rti_Context;
                              Obj_Type : Ghdl_Rti_Access;
                              Obj_Addr : Address;
diff --git a/src/grt/grt-rtis_utils.ads b/src/grt/grt-rtis_utils.ads
index 537f1bff8..e1ee7a9c5 100644
--- a/src/grt/grt-rtis_utils.ads
+++ b/src/grt/grt-rtis_utils.ads
@@ -77,6 +77,9 @@ package Grt.Rtis_Utils is
                                 El_Addr : out Address;
                                 El_Bounds : out Address);
 
+   --  Return True iff RTI is an unbounded type.
+   function Is_Unbounded (Rti : Ghdl_Rti_Access) return Boolean;
+
    procedure Get_Value (Str : in out Vstring;
                         Value : Value_Union;
                         Type_Rti : Ghdl_Rti_Access);
diff --git a/src/grt/grt-waves.adb b/src/grt/grt-waves.adb
index f97f55ac7..db6afb838 100644
--- a/src/grt/grt-waves.adb
+++ b/src/grt/grt-waves.adb
@@ -1298,6 +1298,7 @@ package body Grt.Waves is
                  To_Ghdl_Rtin_Type_Array_Acc (Rti);
                Rng : Ghdl_Range_Ptr;
                Index_Type : Ghdl_Rti_Access;
+               El_Type : Ghdl_Rti_Access;
                Bounds1 : Address;
             begin
                Bounds1 := Bounds;
@@ -1306,8 +1307,14 @@ package body Grt.Waves is
                   Extract_Range (Bounds1, Index_Type, Rng);
                   Write_Range (Index_Type, Rng);
                end loop;
-               Bounds1 := Array_Layout_To_Element (Bounds1, Arr.Element);
-               Write_Composite_Bounds (Get_Base_Type (Arr.Element), Bounds1);
+               --  Write bounds only if the element subtype of the base type
+               --  is unbounded.
+               El_Type := Arr.Element;
+               if Rtis_Utils.Is_Unbounded (El_Type) then
+                  El_Type := Get_Base_Type (El_Type);
+                  Bounds1 := Array_Layout_To_Element (Bounds1, El_Type);
+                  Write_Composite_Bounds (El_Type, Bounds1);
+               end if;
             end;
          when Ghdl_Rtik_Type_Record =>
             return;
@@ -1316,15 +1323,20 @@ package body Grt.Waves is
                Rec : constant Ghdl_Rtin_Type_Record_Acc :=
                  To_Ghdl_Rtin_Type_Record_Acc (Rti);
                El : Ghdl_Rtin_Element_Acc;
-               Eltype : Ghdl_Rti_Access;
+               El_Type : Ghdl_Rti_Access;
                Bounds1 : Address;
             begin
                for I in 1 .. Rec.Nbrel loop
                   El := To_Ghdl_Rtin_Element_Acc (Rec.Elements (I - 1));
-                  Eltype := Get_Base_Type (El.Eltype);
-                  Bounds1 := Array_Layout_To_Element
-                    (Bounds + El.Layout_Off, Eltype);
-                  Write_Composite_Bounds (Eltype, Bounds1);
+                  --  Write bounds only if the element subtype of the base
+                  --  type is unbounded.
+                  El_Type := El.Eltype;
+                  if Rtis_Utils.Is_Unbounded (El_Type) then
+                     El_Type := Get_Base_Type (El_Type);
+                     Bounds1 := Array_Layout_To_Element
+                       (Bounds + El.Layout_Off, El_Type);
+                     Write_Composite_Bounds (El_Type, Bounds1);
+                  end if;
                end loop;
             end;
          when others =>
-- 
cgit v1.2.3