vhdl08: preliminary work to support nested package bodies.

6 files changed, 83 insertions, 29 deletions

diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb
index 38dc3a0c0..10e5d2bc8 100644
--- a/src/vhdl/sem.adb
+++ b/src/vhdl/sem.adb
@@ -2555,7 +2555,9 @@ package body Sem is
                --  immediately within the same declarative region as the
                --  corresponding package declaration and textually subsequent
                --  to that package declaration.
-               return True;
+               if Get_Need_Body (El) then
+                  return True;
+               end if;
             when Iir_Kind_Package_Body =>
                null;
             when Iir_Kind_Package_Instantiation_Declaration =>
@@ -2618,26 +2620,63 @@ package body Sem is
    end Sem_Package_Declaration;
 
    --  LRM 2.6  Package Bodies.
-   procedure Sem_Package_Body (Decl: Iir)
+   procedure Sem_Package_Body (Decl : Iir)
    is
-      Package_Ident: Name_Id;
-      Design_Unit: Iir_Design_Unit;
-      Package_Decl: Iir;
+      Package_Ident : constant Name_Id := Get_Identifier (Decl);
+      Package_Decl : Iir;
    begin
       -- First, find the package declaration.
-      Package_Ident := Get_Identifier (Decl);
-      Design_Unit := Libraries.Load_Primary_Unit
-        (Get_Library (Get_Design_File (Get_Current_Design_Unit)),
-         Package_Ident, Decl);
-      if Design_Unit = Null_Iir then
-         Error_Msg_Sem (+Decl, "package %i was not analysed", +Package_Ident);
-         return;
-      end if;
-      Package_Decl := Get_Library_Unit (Design_Unit);
-      if Get_Kind (Package_Decl) /= Iir_Kind_Package_Declaration then
-         Error_Msg_Sem
-           (+Decl, "primary unit %i is not a package", +Package_Ident);
-         return;
+      if not Is_Nested_Package (Decl) then
+         declare
+            Design_Unit: Iir_Design_Unit;
+         begin
+            Design_Unit := Libraries.Load_Primary_Unit
+              (Get_Library (Get_Design_File (Get_Current_Design_Unit)),
+               Package_Ident, Decl);
+            if Design_Unit = Null_Iir then
+               Error_Msg_Sem
+                 (+Decl, "package %i was not analysed", +Package_Ident);
+               return;
+            end if;
+
+            Package_Decl := Get_Library_Unit (Design_Unit);
+            if Get_Kind (Package_Decl) /= Iir_Kind_Package_Declaration then
+               Error_Msg_Sem
+                 (+Decl, "primary unit %i is not a package", +Package_Ident);
+               return;
+            end if;
+
+            --  LRM08 13.5 Order of analysis
+            --  In each case, the second unit depends on the first unit
+            Add_Dependence (Design_Unit);
+
+            Add_Name (Design_Unit);
+
+            --  Add the context clauses from the primary unit.
+            Add_Context_Clauses (Design_Unit);
+         end;
+      else
+         declare
+            Interp : Name_Interpretation_Type;
+         begin
+            Interp := Get_Interpretation (Get_Identifier (Decl));
+            if not Valid_Interpretation (Interp)
+              or else not Is_In_Current_Declarative_Region (Interp)
+              or else Is_Potentially_Visible (Interp)
+            then
+               Error_Msg_Sem
+                 (+Decl, "no corresponding package declaration for %i",
+                  +Package_Ident);
+               return;
+            end if;
+
+            Package_Decl := Get_Declaration (Interp);
+            if Get_Kind (Package_Decl) /= Iir_Kind_Package_Declaration then
+               Error_Msg_Sem
+                 (+Decl, "declaration %i is not a package", +Package_Ident);
+               return;
+            end if;
+         end;
       end if;
 
       --  Emit a warning is a body is not necessary.
@@ -2649,12 +2688,6 @@ package body Sem is
       Set_Package (Decl, Package_Decl);
       Xref_Body (Decl, Package_Decl);
       Set_Package_Body (Package_Decl, Decl);
-      Add_Dependence (Design_Unit);
-
-      Add_Name (Design_Unit);
-
-      --  Add the context clauses from the primary unit.
-      Add_Context_Clauses (Design_Unit);
 
       --  LRM93 10.1 Declarative Region
       --  4. A package declaration, together with the corresponding
diff --git a/src/vhdl/sem_decls.adb b/src/vhdl/sem_decls.adb
index cb1fe09ab..5bb1385a9 100644
--- a/src/vhdl/sem_decls.adb
+++ b/src/vhdl/sem_decls.adb
@@ -3133,6 +3133,12 @@ package body Sem_Decls is
                        (+El, "missing protected type body for %n", +El);
                   end if;
                end;
+            when Iir_Kind_Package_Declaration =>
+               if Get_Need_Body (El)
+                 and then Get_Package_Body (El) = Null_Iir
+               then
+                  Error_Msg_Sem (+El, "missing package body for %n", +El);
+               end if;
             when others =>
                null;
          end case;
diff --git a/src/vhdl/sem_decls.ads b/src/vhdl/sem_decls.ads
index d29b1a49d..63e29ff6b 100644
--- a/src/vhdl/sem_decls.ads
+++ b/src/vhdl/sem_decls.ads
@@ -39,7 +39,7 @@ package Sem_Decls is
    --  type bodies.
    --
    --  Also, report unused declarations if DECL = DECLS_PARENT.
-   --  As a consequence, Check_Full_Declaration must be called after sem
+   --  As a consequence, Check_Full_Declaration must be called after analyze
    --  of statements, if any.
    procedure Check_Full_Declaration (Decls_Parent : Iir; Decl: Iir);
 
diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index d5837d304..1273760fa 100644
--- a/src/vhdl/translate/trans-chap2.adb
+++ b/src/vhdl/translate/trans-chap2.adb
@@ -865,8 +865,9 @@ package body Trans.Chap2 is
 
    procedure Translate_Package_Body (Bod : Iir_Package_Body)
    is
-      Spec : constant Iir_Package_Declaration := Get_Package (Bod);
-      Info : constant Ortho_Info_Acc := Get_Info (Spec);
+      Is_Nested : constant Boolean := Is_Nested_Package (Bod);
+      Spec      : constant Iir_Package_Declaration := Get_Package (Bod);
+      Info      : constant Ortho_Info_Acc := Get_Info (Spec);
       Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack;
       Prev_Storage : constant O_Storage := Global_Storage;
    begin
@@ -916,7 +917,9 @@ package body Trans.Chap2 is
          Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance);
       end if;
 
-      Elab_Package_Body (Spec, Bod);
+      if not Is_Nested then
+         Elab_Package_Body (Spec, Bod);
+      end if;
 
       Global_Storage := Prev_Storage;
    end Translate_Package_Body;
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 0f78919a3..3e7f18b75 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -2453,7 +2453,8 @@ package body Trans.Chap4 is
                | Iir_Kind_Group_Declaration =>
                null;
 
-            when Iir_Kind_Package_Declaration =>
+            when Iir_Kind_Package_Declaration
+              | Iir_Kind_Package_Body =>
                declare
                   Nested_Final : Boolean;
                begin
diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb
index da69bd9b3..8c06460aa 100644
--- a/src/vhdl/translate/trans-rtis.adb
+++ b/src/vhdl/translate/trans-rtis.adb
@@ -2298,6 +2298,17 @@ package body Trans.Rtis is
                   Generate_Block (Decl, Parent_Rti);
                   Pop_Identifier_Prefix (Mark);
                end;
+            when Iir_Kind_Package_Body =>
+               declare
+                  Mark : Id_Mark_Type;
+                  Mark1 : Id_Mark_Type;
+               begin
+                  Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
+                  Push_Identifier_Prefix (Mark1, "BODY");
+                  Generate_Block (Decl, Parent_Rti);
+                  Pop_Identifier_Prefix (Mark1);
+                  Pop_Identifier_Prefix (Mark);
+               end;
 
             when others =>
                Error_Kind ("rti.generate_declaration_chain", Decl);