From: Ronan Desplanques <desplanq...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/generate_minimal_reproducer.adb | 41 ++++++++++++++++++++-----
1 file changed, 33 insertions(+), 8 deletions(-)
diff --git a/gcc/ada/generate_minimal_reproducer.adb
b/gcc/ada/generate_minimal_reproducer.adb
index 66d34fe1a4f..d13709af6bb 100644
--- 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;
--
2.43.0
