ada: Fix Generate_Minimal_Reproducer on instantiations

Before this patch, the code that creates a copy of the semantic closure
with the default naming convention was incorrect when the compiler was
processing a library unit that was an instantiation of a generic with a
body. This patch adds code to detect that situation and adjusts the
copying process accordingly.

gcc/ada/ChangeLog:

	* generate_minimal_reproducer.adb (Generate_Minimal_Reproducer):
	Fix when main library item is an instantiation.

diff --git a/gcc/ada/generate_minimal_reproducer.adb b/gcc/ada/generate_minimal_reproducer.adb
index 66d34fe1a4f3c3c425e663a095827a546d0211dd..d13709af6bba8c12f90d02f05cf70751da8f67df 100644 (file)
--- a/gcc/ada/generate_minimal_reproducer.adb
+++ b/gcc/ada/generate_minimal_reproducer.adb
@@ -23,16 +23,18 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Atree;
 with Fmap;
 with Fname.UF;
 with Lib;
-with Namet; use Namet;
-with Osint; use Osint;
-with Output; use Output;
-with Sinfo.Nodes;
+with Namet;         use Namet;
+with Osint;         use Osint;
+with Output;        use Output;
+with Sinfo.Nodes;   use Sinfo.Nodes;
 with System.CRTL;
 with System.OS_Lib; use System.OS_Lib;
-with Types; use Types;
+with Types;         use Types;
+with Uname;
 
 procedure Generate_Minimal_Reproducer is
    Reproducer_Generation_Failed : exception;
@@ -85,6 +87,26 @@ procedure Generate_Minimal_Reproducer is
    Oracle_Path : constant String :=
      Dirname & Directory_Separator & Executable_Name ("oracle");
 
+   Main_Library_Item : constant Node_Id := Unit (Lib.Cunit (Main_Unit));
+
+   --  There is a special case that we need to detect: when the main library
+   --  item is the instantiation of a generic that has a body, and the
+   --  instantiation of generic bodies has started. We start by binding whether
+   --  the main library item is an instantiation to the following constant.
+   Main_Is_Instantiation : constant Boolean :=
+     Nkind (Atree.Original_Node (Main_Library_Item))
+     in N_Generic_Instantiation;
+
+   --  If the main library item is an instantiation and its unit name is a body
+   --  name, it means that Make_Instance_Unit has been called. We need to use
+   --  the corresponding spec name to reconstruct the on-disk form of the
+   --  semantic closure.
+   Main_Unit_Name : constant Unit_Name_Type :=
+     (if Main_Is_Instantiation
+        and then Uname.Is_Body_Name (Lib.Unit_Name (Main_Unit))
+      then Uname.Get_Spec_Name (Lib.Unit_Name (Main_Unit))
+      else Lib.Unit_Name (Main_Unit));
+
    Result : Integer;
 begin
    Create_Semantic_Closure_Project :
@@ -122,8 +144,11 @@ begin
             Path : File_Name_Type :=
               Fmap.Mapped_Path_Name (Lib.Unit_File_Name (J));
 
+            Unit_Name : constant Unit_Name_Type :=
+              (if J = Main_Unit then Main_Unit_Name else Lib.Unit_Name (J));
+
             Default_File_Name : constant String :=
-              Fname.UF.Get_Default_File_Name (Lib.Unit_Name (J));
+              Fname.UF.Get_Default_File_Name (Unit_Name);
 
             File_Copy_Path : constant String :=
               Src_Dir_Path & Directory_Separator & Default_File_Name;
@@ -132,7 +157,7 @@ begin
             --  spec files. We need to filter out those units because we would
             --  create bogus spec files that break compilation if we didn't.
             Is_Synthetic_Subprogram_Spec : constant Boolean :=
-              not Sinfo.Nodes.Comes_From_Source (Lib.Cunit (J));
+              not Comes_From_Source (Lib.Cunit (J));
          begin
             if not Lib.Is_Internal_Unit (J)
               and then not Is_Synthetic_Subprogram_Spec
@@ -197,7 +222,7 @@ begin
              (Fmap.Mapped_Path_Name (Lib.Unit_File_Name (Main_Unit)));
 
          Default_Main_Name : constant String :=
-           Fname.UF.Get_Default_File_Name (Lib.Unit_Name (Main_Unit));
+           Fname.UF.Get_Default_File_Name (Main_Unit_Name);
 
          New_Main_Path : constant String :=
            Src_Dir_Path & Directory_Separator & Default_Main_Name;