From 326c06d68d57cade18a28d48de8aa3c6643d6321 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Sat, 24 Sep 2016 07:26:41 +0200
Subject: sem_inst: handl forward reference in subprograms

---
 src/vhdl/iirs_utils.adb |  6 +++++-
 src/vhdl/sem_inst.adb   | 34 +++++++++++++++++++++-------------
 2 files changed, 26 insertions(+), 14 deletions(-)

diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb
index ac6a2dd06..7a8dd84bf 100644
--- a/src/vhdl/iirs_utils.adb
+++ b/src/vhdl/iirs_utils.adb
@@ -892,9 +892,13 @@ package body Iirs_Utils is
 
    function Is_Second_Subprogram_Specification (Spec : Iir) return Boolean
    is
-      Bod : constant Iir := Get_Subprogram_Body (Spec);
+      Bod : constant Iir := Get_Chain (Spec);
    begin
+      --  FIXME: don't directly use Subprogram_Body as it is not yet correctly
+      --  set during instantiation.
       return Bod /= Null_Iir
+        and then Kind_In (Bod, Iir_Kind_Function_Body,
+                          Iir_Kind_Procedure_Body)
         and then Get_Subprogram_Specification (Bod) /= Spec;
    end Is_Second_Subprogram_Specification;
 
diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb
index cb52af129..597010b62 100644
--- a/src/vhdl/sem_inst.adb
+++ b/src/vhdl/sem_inst.adb
@@ -384,25 +384,33 @@ package body Sem_Inst is
                      Set_Index_Subtype_List (Res, List);
                   end;
 
+               when Field_Subprogram_Body =>
+                  --  This is a forward reference.  Not yet solved.
+                  Set_Subprogram_Body (Res, Null_Iir);
+
+               when Field_Subprogram_Specification =>
+                  --  Resolve it.
+                  Instantiate_Iir_Field (Res, N, F);
+
+                  --  Set body.
+                  pragma Assert (Kind_In (Res, Iir_Kind_Procedure_Body,
+                                          Iir_Kind_Function_Body));
+                  declare
+                     Spec : constant Iir := Get_Subprogram_Specification (Res);
+                  begin
+                     pragma Assert (Get_Subprogram_Body (Spec) = Null_Iir);
+                     Set_Subprogram_Body (Spec, Res);
+                  end;
+
                when others =>
                   --  Common case.
                   Instantiate_Iir_Field (Res, N, F);
             end case;
          end loop;
 
-         case Kind is
-            when Iir_Kind_Function_Declaration
-              | Iir_Kind_Procedure_Declaration =>
-               --  Subprogram body is a forward declaration.
-               --  Clear Subprogram_Body so that the node is seen as a
-               --  declaration and not a specification of a body.
-               Set_Subprogram_Body (Res, Null_Iir);
-            when others =>
-               --  TODO: other forward references:
-               --  incomplete constant
-               --  attribute_value
-               null;
-         end case;
+         --  TODO: other forward references:
+         --  incomplete constant
+         --  attribute_value
 
          return Res;
       end;
-- 
cgit v1.2.3