Allow generic without default values in top-level entity.

Implement ticket #47.

6 files changed, 121 insertions, 4 deletions

diff --git a/src/grt/grt-change_generics.adb b/src/grt/grt-change_generics.adb
index 7bf5e49e5..dc273c50f 100644
--- a/src/grt/grt-change_generics.adb
+++ b/src/grt/grt-change_generics.adb
@@ -23,6 +23,7 @@
 --  however invalidate any other reasons why the executable file might be
 --  covered by the GNU Public License.
 
+with System;
 with Grt.Types; use Grt.Types;
 with Grt.Lib; use Grt.Lib;
 with Grt.Options; use Grt.Options;
@@ -322,4 +323,55 @@ package body Grt.Change_Generics is
          Over := Over.Next;
       end loop;
    end Change_All_Generics;
+
+   procedure Check_Required_Generic_Override
+   is
+      Root, It, Decl : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      Get_Root_Inst (Root);
+
+      --  Find generic.
+      Vhpi_Iterator (VhpiDecls, Root, It, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("override_generic(1)");
+         return;
+      end if;
+
+      --  Look for the generic.
+      loop
+         Vhpi_Scan (It, Decl, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Internal_Error ("override_generic(2)");
+            return;
+         end if;
+         exit when Vhpi_Get_Kind (Decl) /= VhpiGenericDeclK;
+
+         declare
+            use System;
+            Rti : constant Ghdl_Rti_Access := Avhpi_Get_Rti (Decl);
+            Obj_Rti : constant Ghdl_Rtin_Object_Acc :=
+              To_Ghdl_Rtin_Object_Acc (Rti);
+            Type_Rti : constant Ghdl_Rti_Access := Obj_Rti.Obj_Type;
+            Ctxt : constant Rti_Context := Avhpi_Get_Context (Decl);
+         begin
+            pragma Assert (Rti.Kind = Ghdl_Rtik_Generic);
+            if Type_Rti.Kind = Ghdl_Rtik_Type_Array then
+               declare
+                  Uc_Array : Ghdl_Uc_Array_Acc;
+               begin
+                  Uc_Array := To_Ghdl_Uc_Array_Acc
+                    (Loc_To_Addr (Obj_Rti.Common.Depth, Obj_Rti.Loc, Ctxt));
+                  if Uc_Array.Base = Null_Address then
+                     Error_C ("top-level generic '");
+                     Error_C (Obj_Rti.Name);
+                     Error_E ("' must be overriden (use -gGEN=VAL)");
+                  end if;
+               end;
+            end if;
+         end;
+      end loop;
+   end Check_Required_Generic_Override;
+
 end Grt.Change_Generics;
diff --git a/src/grt/grt-change_generics.ads b/src/grt/grt-change_generics.ads
index e3439b47b..d2dec9b73 100644
--- a/src/grt/grt-change_generics.ads
+++ b/src/grt/grt-change_generics.ads
@@ -26,4 +26,8 @@
 package Grt.Change_Generics is
    --  Override top entity generics, using Generic_Override list from Options.
    procedure Change_All_Generics;
+
+   --  Emit an error if a generic that required override (unconstrained array)
+   --  wasn't overriden.
+   procedure Check_Required_Generic_Override;
 end Grt.Change_Generics;
diff --git a/src/grt/grt-main.adb b/src/grt/grt-main.adb
index ad21a245a..6d595b4cc 100644
--- a/src/grt/grt-main.adb
+++ b/src/grt/grt-main.adb
@@ -64,6 +64,7 @@ package body Grt.Main is
    procedure Ghdl_Init_Top_Generics is
    begin
       Grt.Change_Generics.Change_All_Generics;
+      Grt.Change_Generics.Check_Required_Generic_Override;
    end Ghdl_Init_Top_Generics;
 
    procedure Disp_Stats_Hook (Code : Integer);
diff --git a/src/libraries.adb b/src/libraries.adb
index 0cca4d0b0..e01a9bc24 100644
--- a/src/libraries.adb
+++ b/src/libraries.adb
@@ -236,7 +236,7 @@ package body Libraries is
    -- design_file_format ::=
    --      filename_format { design_unit_format  }
    -- filename_format ::=
-   --      FILE directory "FILENAME" file_time_stamp analyze_time_stamp:
+   --      FILE directory "filename" "file_time_stamp" "analyze_time_stamp":
    -- design_unit_format ::= entity_format
    --                        | architecture_format
    --                        | package_format
diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb
index 9ca279331..37817da91 100644
--- a/src/vhdl/configuration.adb
+++ b/src/vhdl/configuration.adb
@@ -595,6 +595,49 @@ package body Configuration is
    is
       Has_Error : Boolean := False;
 
+      --  Return TRUE if GRT supports override of generic GEN.
+      function Allow_Generic_Override (Gen : Iir) return Boolean
+      is
+         Gen_Type : constant Iir := Get_Type (Gen);
+      begin
+         case Get_Kind (Gen_Type) is
+            when Iir_Kind_Integer_Type_Definition
+              | Iir_Kind_Integer_Subtype_Definition
+              | Iir_Kind_Enumeration_Type_Definition
+              | Iir_Kind_Enumeration_Subtype_Definition =>
+               return True;
+            when Iir_Kind_Array_Type_Definition
+              | Iir_Kind_Array_Subtype_Definition =>
+               --  Only one-dimensional arrays of enumeration are allowed.
+               --  If unconstrained, the index must be of integer type.
+               if Get_Kind (Get_Base_Type (Get_Element_Subtype (Gen_Type)))
+                 /= Iir_Kind_Enumeration_Type_Definition
+               then
+                  --  Not an array of enumeration type.
+                  return False;
+               end if;
+               declare
+                  Indexes : constant Iir_List :=
+                    Get_Index_Subtype_List (Gen_Type);
+               begin
+                  if Get_Nbr_Elements (Indexes) /= 1 then
+                     --  Not a one-dimensional array.
+                     return False;
+                  end if;
+                  if Get_Constraint_State (Gen_Type) /= Fully_Constrained
+                    and then (Get_Kind (Get_Index_Type (Indexes, 0))
+                                /= Iir_Kind_Integer_Subtype_Definition)
+                  then
+                     --  Index not constrained or not of integer subtype.
+                     return False;
+                  end if;
+               end;
+               return True;
+            when others =>
+               return False;
+         end case;
+      end Allow_Generic_Override;
+
       procedure Error (Msg : String; Loc : Iir) is
       begin
          if not Has_Error then
@@ -611,7 +654,9 @@ package body Configuration is
       El := Get_Generic_Chain (Entity);
       while El /= Null_Iir loop
          if Get_Default_Value (El) = Null_Iir then
-            Error ("(" & Disp_Node (El) & " has no default value)", El);
+            if not Allow_Generic_Override (El) then
+               Error ("(" & Disp_Node (El) & " has no default value)", El);
+            end if;
          end if;
          El := Get_Chain (El);
       end loop;
diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb
index 8d6099295..35cbfb0f0 100644
--- a/src/vhdl/translate/trans-chap1.adb
+++ b/src/vhdl/translate/trans-chap1.adb
@@ -41,14 +41,29 @@ package body Trans.Chap1 is
 
    procedure Translate_Entity_Init_Generics (Entity : Iir)
    is
-      El      : Iir;
+      El : Iir;
    begin
       Push_Local_Factory;
 
       El := Get_Generic_Chain (Entity);
       while El /= Null_Iir loop
          Open_Temp;
-         Chap4.Elab_Object_Value (El, Get_Default_Value (El));
+
+         declare
+            Val : constant Iir := Get_Default_Value (El);
+            El_Type : constant Iir := Get_Type (El);
+         begin
+            if Val = Null_Iir
+              and then Get_Kind (El_Type) in Iir_Kinds_Array_Type_Definition
+              and then Get_Constraint_State (El_Type) /= Fully_Constrained
+            then
+               --  Do not initialize unconstrained array.  They will have
+               --  to be overriden by user.
+               null;
+            else
+               Chap4.Elab_Object_Value (El, Val);
+            end if;
+         end;
          Close_Temp;
          El := Get_Chain (El);
       end loop;