https://gcc.gnu.org/g:d2a118197c767ccbd3905c14ff2ebe82bd0fe9ed
commit r15-604-gd2a118197c767ccbd3905c14ff2ebe82bd0fe9ed
Author: Bob Duff <d...@adacore.com>
Date: Fri Mar 8 09:32:51 2024 -0500
ada: gnatbind: subprogram spec no longer exists
If a subprogram spec S is present while compiling something that
says "with S;", but the spec is absent while compiling the body
of S, then gnatbind fails to detect the mismatch. The spec and
body of S might have different parameter and result types.
This patch fixes gnatbind to detect this case and give an error.
gcc/ada/
* bcheck.adb (Check_Consistency_Of_Sdep): Split out new procedure.
Add check for special case of subprogram spec that no longer
exists.
(Check_Consistency): Call Check_Consistency_Of_Sdep, except when
Reified_Child_Spec is True. No need for "goto Continue" or "exit
Sdep_Loop".
* ali.ads (Subunit_Name, Unit_Name): Change the type to
Unit_Name_Type. Add a comment pointing to the ALI file
documentation, because it's in a somewhat-surprising place.
* ali.adb (Scan_ALI): Subunit_Name and Unit_Name are now
Unit_Name_Type. Remove comment explaining why Name_Find is used;
Name_Find is the usual case. Do not remove the "%s" or "%b" from
the Unit_Name. We need to be able to distinguish specs and bodies.
This is also necessary to obey the invariant of Unit_Name_Type.
* binde.adb (Write_Closure): Subunit_Name is now Unit_Name_Type.
* clean.adb (Clean_Executables): Likewise.
Diff:
---
gcc/ada/ali.adb | 9 +--
gcc/ada/ali.ads | 10 +--
gcc/ada/bcheck.adb | 216 ++++++++++++++++++++++++++++++++---------------------
gcc/ada/binde.adb | 2 +-
gcc/ada/clean.adb | 2 +-
5 files changed, 141 insertions(+), 98 deletions(-)
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb
index 6bf48c04afeb..69a91bce5ab9 100644
--- a/gcc/ada/ali.adb
+++ b/gcc/ada/ali.adb
@@ -3287,8 +3287,8 @@ package body ALI is
-- Acquire (sub)unit and reference file name entries
- Sdep.Table (Sdep.Last).Subunit_Name := No_Name;
- Sdep.Table (Sdep.Last).Unit_Name := No_Name;
+ Sdep.Table (Sdep.Last).Subunit_Name := No_Unit_Name;
+ Sdep.Table (Sdep.Last).Unit_Name := No_Unit_Name;
Sdep.Table (Sdep.Last).Rfile :=
Sdep.Table (Sdep.Last).Sfile;
Sdep.Table (Sdep.Last).Start_Line := 1;
@@ -3304,16 +3304,13 @@ package body ALI is
Add_Char_To_Name_Buffer (Getc);
end loop;
- -- Set the (sub)unit name. Note that we use Name_Find rather
- -- than Name_Enter here as the subunit name may already
- -- have been put in the name table by the Project Manager.
+ -- Set the (sub)unit name.
if Name_Len <= 2
or else Name_Buffer (Name_Len - 1) /= '%'
then
Sdep.Table (Sdep.Last).Subunit_Name := Name_Find;
else
- Name_Len := Name_Len - 2;
Sdep.Table (Sdep.Last).Unit_Name := Name_Find;
end if;
diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads
index 67b8fcd1b803..1f4522686818 100644
--- a/gcc/ada/ali.ads
+++ b/gcc/ada/ali.ads
@@ -25,7 +25,7 @@
-- This package defines the internal data structures used for representation
-- of Ada Library Information (ALI) acquired from the ALI files generated by
--- the front end.
+-- the front end. The format of the ALI files is documented in Lib.Writ.
with Casing; use Casing;
with Gnatvsn; use Gnatvsn;
@@ -882,11 +882,11 @@ package ALI is
-- Set True for dummy entries that correspond to missing files or files
-- where no dependency relationship exists.
- Subunit_Name : Name_Id;
- -- Name_Id for subunit name if present, else No_Name
+ Subunit_Name : Unit_Name_Type;
+ -- Subunit name if present, else No_Unit_Name
- Unit_Name : Name_Id;
- -- Name_Id for the unit name if not a subunit (No_Name for a subunit)
+ Unit_Name : Unit_Name_Type;
+ -- Unit name if not a subunit (No_Unit_Name for a subunit)
Rfile : File_Name_Type;
-- Reference file name. Same as Sfile unless a Source_Reference pragma
diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb
index dd2ece80d01c..56a417cc5176 100644
--- a/gcc/ada/bcheck.adb
+++ b/gcc/ada/bcheck.adb
@@ -36,6 +36,7 @@ with Osint;
with Output; use Output;
with Rident; use Rident;
with Types; use Types;
+with Uname;
package body Bcheck is
@@ -68,6 +69,12 @@ package body Bcheck is
-- Used to compare two unit names for No_Dependence checks. U1 is in
-- standard unit name format, and U2 is in literal form with periods.
+ procedure Check_Consistency_Of_Sdep
+ (A : ALIs_Record; D : Sdep_Record; Src : Source_Record);
+ -- Called by Check_Consistency to check the consistency of one Sdep record,
+ -- where A is the ALI, and D represents the unit it depends on, and Src is
+ -- the source file corresponding to D.
+
-------------------------------------
-- Check_Configuration_Consistency --
-------------------------------------
@@ -107,15 +114,129 @@ package body Bcheck is
Check_Consistent_Dispatching_Policy;
end Check_Configuration_Consistency;
+ -------------------------------
+ -- Check_Consistency_Of_Sdep --
+ -------------------------------
+
+ procedure Check_Consistency_Of_Sdep
+ (A : ALIs_Record; D : Sdep_Record; Src : Source_Record)
+ is
+ use Uname;
+ ALI_Path_Id : File_Name_Type;
+ begin
+ -- Check for special case of withing a unit that does not exist any
+ -- more. If the unit was completely missing we would already have
+ -- detected this, but a nasty case arises when we have a subprogram body
+ -- with no spec, and some obsolete unit with's a previous (now
+ -- disappeared) spec. We detect this nasty case by noticing we're
+ -- depending on a spec that has no corresponding unit table entry,
+ -- but the body does.
+
+ if Present (D.Unit_Name)
+ and then Is_Spec_Name (D.Unit_Name)
+ and then Get_Name_Table_Int (D.Unit_Name) = 0 -- no unit table entry?
+ and then Get_Name_Table_Int (Get_Body_Name (D.Unit_Name)) /= 0
+ then
+ Error_Msg_File_1 := A.Sfile;
+ Error_Msg_Unit_1 := D.Unit_Name;
+ Error_Msg ("{ depends on $ which no longer exists");
+ end if;
+
+ -- Now if the time stamps match, or all checksums match, then we are OK;
+ -- otherwise we have an error.
+
+ if D.Stamp /= Src.Stamp and then not Src.All_Checksums_Match then
+ Error_Msg_File_1 := A.Sfile;
+ Error_Msg_File_2 := D.Sfile;
+
+ -- Two styles of message, depending on whether or not
+ -- the updated file is the one that must be recompiled
+
+ if Error_Msg_File_1 = Error_Msg_File_2 then
+ if Tolerate_Consistency_Errors then
+ Error_Msg
+ ("?{ has been modified and should be recompiled");
+ else
+ Error_Msg
+ ("{ has been modified and must be recompiled");
+ end if;
+
+ else
+ ALI_Path_Id :=
+ Osint.Full_Lib_File_Name (A.Afile);
+
+ if Osint.Is_Readonly_Library (ALI_Path_Id) then
+ if Tolerate_Consistency_Errors then
+ Error_Msg ("?{ should be recompiled");
+ Error_Msg_File_1 := ALI_Path_Id;
+ Error_Msg ("?({ is obsolete and read-only)");
+ else
+ Error_Msg ("{ must be compiled");
+ Error_Msg_File_1 := ALI_Path_Id;
+ Error_Msg ("({ is obsolete and read-only)");
+ end if;
+
+ elsif Tolerate_Consistency_Errors then
+ Error_Msg
+ ("?{ should be recompiled ({ has been modified)");
+
+ else
+ Error_Msg ("{ must be recompiled ({ has been modified)");
+ end if;
+ end if;
+
+ if not Tolerate_Consistency_Errors and Verbose_Mode then
+ Error_Msg_File_1 := Src.Stamp_File;
+
+ if Src.Source_Found then
+ Error_Msg_File_1 :=
+ Osint.Full_Source_Name (Error_Msg_File_1);
+ else
+ Error_Msg_File_1 :=
+ Osint.Full_Lib_File_Name (Error_Msg_File_1);
+ end if;
+
+ Error_Msg
+ ("time stamp from { " & String (Src.Stamp));
+
+ Error_Msg_File_1 := D.Sfile;
+ Error_Msg
+ (" conflicts with { timestamp " &
+ String (D.Stamp));
+
+ Error_Msg_File_1 :=
+ Osint.Full_Lib_File_Name (A.Afile);
+ Error_Msg (" from {");
+ end if;
+ end if;
+ end Check_Consistency_Of_Sdep;
+
-----------------------
-- Check_Consistency --
-----------------------
procedure Check_Consistency is
- Src : Source_Id;
- -- Source file Id for this Sdep entry
+ function Reified_Child_Spec (A : ALI_Id; D : Sdep_Id) return Boolean;
+ -- When we have a child subprogram body with no spec, the missing spec
+ -- is reified in the ALI file. This returns True if D is a dependency on
+ -- such a reified spec. The body always immediately follows the spec
+ -- and there is no no unit table entry for the spec in this case.
+ -- We do not want to call Check_Consistency_Of_Sdep for these specs,
+ -- because it confuses the detection of (truly) missing specs.
+
+ function Reified_Child_Spec (A : ALI_Id; D : Sdep_Id) return Boolean is
+ use Uname;
+ begin
+ return Present (Sdep.Table (D).Unit_Name)
+ and then Get_Name_Table_Int (Sdep.Table (D).Unit_Name) = 0
+ and then D /= ALIs.Table (A).Last_Sdep
+ and then Sdep.Table (D).Sfile = Sdep.Table (D + 1).Sfile
+ and then Is_Spec_Name (Sdep.Table (D).Unit_Name)
+ and then Get_Body_Name (Sdep.Table (D).Unit_Name) =
+ Sdep.Table (D + 1).Unit_Name;
+ end Reified_Child_Spec;
- ALI_Path_Id : File_Name_Type;
+ -- Start of processing for Check_Consistency
begin
-- First, we go through the source table to see if there are any cases
@@ -172,89 +293,14 @@ package body Bcheck is
Sdep_Loop : for D in
ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
loop
- if Sdep.Table (D).Dummy_Entry then
- goto Continue;
- end if;
-
- Src := Source_Id (Get_Name_Table_Int (Sdep.Table (D).Sfile));
-
- -- If the time stamps match, or all checksums match, then we
- -- are OK, otherwise we have a definite error.
-
- if Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
- and then not Source.Table (Src).All_Checksums_Match
+ if not Sdep.Table (D).Dummy_Entry
+ and then not Reified_Child_Spec (A, D)
then
- Error_Msg_File_1 := ALIs.Table (A).Sfile;
- Error_Msg_File_2 := Sdep.Table (D).Sfile;
-
- -- Two styles of message, depending on whether or not
- -- the updated file is the one that must be recompiled
-
- if Error_Msg_File_1 = Error_Msg_File_2 then
- if Tolerate_Consistency_Errors then
- Error_Msg
- ("?{ has been modified and should be recompiled");
- else
- Error_Msg
- ("{ has been modified and must be recompiled");
- end if;
-
- else
- ALI_Path_Id :=
- Osint.Full_Lib_File_Name (ALIs.Table (A).Afile);
-
- if Osint.Is_Readonly_Library (ALI_Path_Id) then
- if Tolerate_Consistency_Errors then
- Error_Msg ("?{ should be recompiled");
- Error_Msg_File_1 := ALI_Path_Id;
- Error_Msg ("?({ is obsolete and read-only)");
- else
- Error_Msg ("{ must be compiled");
- Error_Msg_File_1 := ALI_Path_Id;
- Error_Msg ("({ is obsolete and read-only)");
- end if;
-
- elsif Tolerate_Consistency_Errors then
- Error_Msg
- ("?{ should be recompiled ({ has been modified)");
-
- else
- Error_Msg ("{ must be recompiled ({ has been modified)");
- end if;
- end if;
-
- if not Tolerate_Consistency_Errors and Verbose_Mode then
- Error_Msg_File_1 := Source.Table (Src).Stamp_File;
-
- if Source.Table (Src).Source_Found then
- Error_Msg_File_1 :=
- Osint.Full_Source_Name (Error_Msg_File_1);
- else
- Error_Msg_File_1 :=
- Osint.Full_Lib_File_Name (Error_Msg_File_1);
- end if;
-
- Error_Msg
- ("time stamp from { " & String (Source.Table (Src).Stamp));
-
- Error_Msg_File_1 := Sdep.Table (D).Sfile;
- Error_Msg
- (" conflicts with { timestamp " &
- String (Sdep.Table (D).Stamp));
-
- Error_Msg_File_1 :=
- Osint.Full_Lib_File_Name (ALIs.Table (A).Afile);
- Error_Msg (" from {");
- end if;
-
- -- Exit from the loop through Sdep entries once we find one
- -- that does not match.
-
- exit Sdep_Loop;
+ Check_Consistency_Of_Sdep
+ (ALIs.Table (A), Sdep.Table (D),
+ Source.Table
+ (Source_Id (Get_Name_Table_Int (Sdep.Table (D).Sfile))));
end if;
-
- <<Continue>>
- null;
end loop Sdep_Loop;
end loop ALIs_Loop;
end Check_Consistency;
@@ -1263,7 +1309,7 @@ package body Bcheck is
procedure Check_Duplicated_Subunits is
begin
for J in Sdep.First .. Sdep.Last loop
- if Sdep.Table (J).Subunit_Name /= No_Name then
+ if Sdep.Table (J).Subunit_Name /= No_Unit_Name then
Get_Decoded_Name_String (Sdep.Table (J).Subunit_Name);
Name_Len := Name_Len + 2;
Name_Buffer (Name_Len - 1) := '%';
diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb
index a579e420d3bb..61446274dc4f 100644
--- a/gcc/ada/binde.adb
+++ b/gcc/ada/binde.adb
@@ -2334,7 +2334,7 @@ package body Binde is
for J in Sdep.First .. Sdep.Last loop
Source := Sdep.Table (J).Sfile;
- if Sdep.Table (J).Subunit_Name /= No_Name
+ if Sdep.Table (J).Subunit_Name /= No_Unit_Name
and then Put_In_Sources (Source)
and then not Is_Internal_File_Name (Source)
then
diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb
index 925e57605704..66033623765d 100644
--- a/gcc/ada/clean.adb
+++ b/gcc/ada/clean.adb
@@ -248,7 +248,7 @@ package body Clean is
for J in ALIs.Table (The_ALI).First_Sdep ..
ALIs.Table (The_ALI).Last_Sdep
loop
- if Sdep.Table (J).Subunit_Name /= No_Name then
+ if Sdep.Table (J).Subunit_Name /= No_Unit_Name then
Sources.Increment_Last;
Sources.Table (Sources.Last) :=
Sdep.Table (J).Sfile;
