with ALI; use ALI;
with ALI.Util; use ALI.Util;
with Binderr; use Binderr;
with Butil; use Butil;
with Casing; use Casing;
with Fname; use Fname;
with Namet; use Namet;
with Opt; use Opt;
with Osint;
with Output; use Output;
with Rident; use Rident;
with Types; use Types;
package body Bcheck is
procedure Check_Consistent_Dynamic_Elaboration_Checking;
procedure Check_Consistent_Floating_Point_Format;
procedure Check_Consistent_Interrupt_States;
procedure Check_Consistent_Locking_Policy;
procedure Check_Consistent_Normalize_Scalars;
procedure Check_Consistent_Queuing_Policy;
procedure Check_Consistent_Restrictions;
procedure Check_Consistent_Zero_Cost_Exception_Handling;
procedure Consistency_Error_Msg (Msg : String);
function Same_Unit (U1 : Name_Id; U2 : Name_Id) return Boolean;
procedure Check_Configuration_Consistency is
begin
if Float_Format_Specified /= ' ' then
Check_Consistent_Floating_Point_Format;
end if;
if Queuing_Policy_Specified /= ' ' then
Check_Consistent_Queuing_Policy;
end if;
if Locking_Policy_Specified /= ' ' then
Check_Consistent_Locking_Policy;
end if;
if Zero_Cost_Exceptions_Specified then
Check_Consistent_Zero_Cost_Exception_Handling;
end if;
Check_Consistent_Normalize_Scalars;
Check_Consistent_Dynamic_Elaboration_Checking;
Check_Consistent_Restrictions;
Check_Consistent_Interrupt_States;
end Check_Configuration_Consistency;
procedure Check_Consistent_Dynamic_Elaboration_Checking is
begin
if Dynamic_Elaboration_Checks_Specified then
for U in First_Unit_Entry .. Units.Last loop
declare
UR : Unit_Record renames Units.Table (U);
begin
if UR.Dynamic_Elab then
for W in UR.First_With .. UR.Last_With loop
declare
WR : With_Record renames Withs.Table (W);
begin
if Get_Name_Table_Info (WR.Uname) /= 0 then
declare
WU : Unit_Record renames
Units.Table
(Unit_Id
(Get_Name_Table_Info (WR.Uname)));
begin
if WR.Elaborate_All then
null;
elsif WU.Dynamic_Elab then
null;
elsif WU.Preelab or WU.Pure then
null;
elsif Is_Internal_File_Name (WU.Sfile) then
null;
else
Error_Msg_Name_1 := UR.Sfile;
Error_Msg
("?% has dynamic elaboration checks " &
"and with's");
Error_Msg_Name_1 := WU.Sfile;
Error_Msg
("? % which has static elaboration " &
"checks");
Warnings_Detected := Warnings_Detected - 1;
end if;
end;
end if;
end;
end loop;
end if;
end;
end loop;
end if;
end Check_Consistent_Dynamic_Elaboration_Checking;
procedure Check_Consistent_Floating_Point_Format is
begin
Find_Format : for A1 in ALIs.First .. ALIs.Last loop
if ALIs.Table (A1).Float_Format /= ' ' then
Check_Format : declare
Format : constant Character := ALIs.Table (A1).Float_Format;
begin
for A2 in A1 + 1 .. ALIs.Last loop
if ALIs.Table (A2).Float_Format /= Format then
Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
Error_Msg_Name_2 := ALIs.Table (A2).Sfile;
Consistency_Error_Msg
("% and % compiled with different " &
"floating-point representations");
exit Find_Format;
end if;
end loop;
end Check_Format;
exit Find_Format;
end if;
end loop Find_Format;
end Check_Consistent_Floating_Point_Format;
procedure Check_Consistent_Interrupt_States is
Max_Intrup : Nat;
begin
if Interrupt_States.Last < Interrupt_States.First then
return;
end if;
Max_Intrup := 0;
for J in Interrupt_States.First .. Interrupt_States.Last loop
if Interrupt_States.Table (J).Interrupt_Id > Max_Intrup then
Max_Intrup := Interrupt_States.Table (J).Interrupt_Id;
end if;
end loop;
declare
Istate : array (0 .. Max_Intrup) of Character := (others => 'n');
Afile : array (0 .. Max_Intrup) of ALI_Id;
Loc : array (0 .. Max_Intrup) of Nat;
Inum : Nat;
Stat : Character;
Lnum : Nat;
begin
for F in ALIs.First .. ALIs.Last loop
for K in ALIs.Table (F).First_Interrupt_State ..
ALIs.Table (F).Last_Interrupt_State
loop
Inum := Interrupt_States.Table (K).Interrupt_Id;
Stat := Interrupt_States.Table (K).Interrupt_State;
Lnum := Interrupt_States.Table (K).IS_Pragma_Line;
if Istate (Inum) = 'n' then
Istate (Inum) := Stat;
Afile (Inum) := F;
Loc (Inum) := Lnum;
elsif Istate (Inum) /= Stat then
Error_Msg_Name_1 := ALIs.Table (Afile (Inum)).Sfile;
Error_Msg_Name_2 := ALIs.Table (F).Sfile;
Error_Msg_Nat_1 := Loc (Inum);
Error_Msg_Nat_2 := Lnum;
Consistency_Error_Msg
("inconsistent interrupt states at %:# and %:#");
end if;
end loop;
end loop;
end;
end Check_Consistent_Interrupt_States;
procedure Check_Consistent_Locking_Policy is
begin
Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
if ALIs.Table (A1).Locking_Policy /= ' ' then
Check_Policy : declare
Policy : constant Character := ALIs.Table (A1).Locking_Policy;
begin
for A2 in A1 + 1 .. ALIs.Last loop
if ALIs.Table (A2).Locking_Policy /= ' ' and
ALIs.Table (A2).Locking_Policy /= Policy
then
Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
Error_Msg_Name_2 := ALIs.Table (A2).Sfile;
Consistency_Error_Msg
("% and % compiled with different locking policies");
exit Find_Policy;
end if;
end loop;
end Check_Policy;
exit Find_Policy;
end if;
end loop Find_Policy;
end Check_Consistent_Locking_Policy;
procedure Check_Consistent_Normalize_Scalars is
begin
if Normalize_Scalars_Specified and No_Normalize_Scalars_Specified then
Consistency_Error_Msg
("some but not all files compiled with Normalize_Scalars");
Write_Eol;
Write_Str ("files compiled with Normalize_Scalars");
Write_Eol;
for A1 in ALIs.First .. ALIs.Last loop
if ALIs.Table (A1).Normalize_Scalars then
Write_Str (" ");
Write_Name (ALIs.Table (A1).Sfile);
Write_Eol;
end if;
end loop;
Write_Eol;
Write_Str ("files compiled without Normalize_Scalars");
Write_Eol;
for A1 in ALIs.First .. ALIs.Last loop
if not ALIs.Table (A1).Normalize_Scalars then
Write_Str (" ");
Write_Name (ALIs.Table (A1).Sfile);
Write_Eol;
end if;
end loop;
end if;
end Check_Consistent_Normalize_Scalars;
procedure Check_Consistent_Queuing_Policy is
begin
Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
if ALIs.Table (A1).Queuing_Policy /= ' ' then
Check_Policy : declare
Policy : constant Character := ALIs.Table (A1).Queuing_Policy;
begin
for A2 in A1 + 1 .. ALIs.Last loop
if ALIs.Table (A2).Queuing_Policy /= ' '
and then
ALIs.Table (A2).Queuing_Policy /= Policy
then
Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
Error_Msg_Name_2 := ALIs.Table (A2).Sfile;
Consistency_Error_Msg
("% and % compiled with different queuing policies");
exit Find_Policy;
end if;
end loop;
end Check_Policy;
exit Find_Policy;
end if;
end loop Find_Policy;
end Check_Consistent_Queuing_Policy;
procedure Check_Consistent_Restrictions is
Restriction_File_Output : Boolean;
procedure Print_Restriction_File (R : All_Restrictions);
procedure Print_Restriction_File (R : All_Restrictions) is
begin
if not Restriction_File_Output then
Restriction_File_Output := True;
for A in ALIs.First .. ALIs.Last loop
if ALIs.Table (A).Restrictions.Set (R)
and then (R in All_Boolean_Restrictions
or else ALIs.Table (A).Restrictions.Value (R) =
Cumulative_Restrictions.Value (R))
then
declare
M1 : constant String := "% has restriction ";
S : constant String := Restriction_Id'Image (R);
M2 : String (1 .. 200); P : Integer;
begin
Name_Buffer (1 .. S'Length) := S;
Name_Len := S'Length;
Set_Casing (Mixed_Case);
M2 (M1'Range) := M1;
P := M1'Length + 1;
M2 (P .. P + S'Length - 1) := Name_Buffer (1 .. S'Length);
P := P + S'Length;
if R in All_Parameter_Restrictions then
M2 (P .. P + 4) := " => #";
Error_Msg_Nat_1 :=
Int (Cumulative_Restrictions.Value (R));
P := P + 5;
end if;
Error_Msg_Name_1 := ALIs.Table (A).Sfile;
Consistency_Error_Msg (M2 (1 .. P - 1));
Consistency_Error_Msg
("but the following files violate this restriction:");
return;
end;
end if;
end loop;
end if;
end Print_Restriction_File;
begin
for R in All_Restrictions loop
if Cumulative_Restrictions.Set (R)
and then Cumulative_Restrictions.Violated (R)
and then (R in Partition_Boolean_Restrictions
or else (R in All_Parameter_Restrictions
and then
Cumulative_Restrictions.Count (R) >
Cumulative_Restrictions.Value (R)))
then
Restriction_File_Output := False;
for A2 in ALIs.First .. ALIs.Last loop
declare
T : ALIs_Record renames ALIs.Table (A2);
begin
if T.Restrictions.Violated (R) then
if not Is_Internal_File_Name (T.Sfile) then
if R in All_Boolean_Restrictions then
Print_Restriction_File (R);
Error_Msg_Name_1 := T.Sfile;
Consistency_Error_Msg (" %");
elsif R in Checked_Add_Parameter_Restrictions
or else T.Restrictions.Count (R) >
Cumulative_Restrictions.Value (R)
then
Print_Restriction_File (R);
Error_Msg_Name_1 := T.Sfile;
Error_Msg_Nat_1 := Int (T.Restrictions.Count (R));
if T.Restrictions.Unknown (R) then
Consistency_Error_Msg
(" % (count = at least #)");
else
Consistency_Error_Msg
(" % (count = #)");
end if;
end if;
end if;
end if;
end;
end loop;
end if;
end loop;
for ND in No_Deps.First .. No_Deps.Last loop
declare
ND_Unit : constant Name_Id := No_Deps.Table (ND).No_Dep_Unit;
begin
for J in ALIs.First .. ALIs.Last loop
declare
A : ALIs_Record renames ALIs.Table (J);
begin
for K in A.First_Unit .. A.Last_Unit loop
declare
U : Unit_Record renames Units.Table (K);
begin
for L in U.First_With .. U.Last_With loop
if Same_Unit (Withs.Table (L).Uname, ND_Unit) then
Error_Msg_Name_1 := U.Uname;
Error_Msg_Name_2 := ND_Unit;
Consistency_Error_Msg
("unit & violates restriction " &
"No_Dependence => %");
end if;
end loop;
end;
end loop;
end;
end loop;
end;
end loop;
end Check_Consistent_Restrictions;
function Same_Unit (U1 : Name_Id; U2 : Name_Id) return Boolean is
begin
if Length_Of_Name (U1) - 2 = Length_Of_Name (U2) then
Get_Name_String (U1);
declare
U1_Str : constant String := Name_Buffer (1 .. Name_Len - 2);
begin
Get_Name_String (U2);
return U1_Str = Name_Buffer (1 .. Name_Len);
end;
else
return False;
end if;
end Same_Unit;
procedure Check_Consistent_Zero_Cost_Exception_Handling is
begin
Check_Mechanism : for A1 in ALIs.First + 1 .. ALIs.Last loop
if ALIs.Table (A1).Zero_Cost_Exceptions /=
ALIs.Table (ALIs.First).Zero_Cost_Exceptions
then
Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
Error_Msg_Name_2 := ALIs.Table (ALIs.First).Sfile;
Consistency_Error_Msg ("% and % compiled with different "
& "exception handling mechanisms");
end if;
end loop Check_Mechanism;
end Check_Consistent_Zero_Cost_Exception_Handling;
procedure Check_Consistency is
Src : Source_Id;
ALI_Path_Id : Name_Id;
begin
for S in Source.First .. Source.Last loop
if Source.Table (S).All_Timestamps_Match then
null;
elsif not Source.Table (S).Source_Found then
null;
elsif not Source.Table (S).All_Checksums_Match then
null;
elsif Check_Source_Files then
if not Checksums_Match
(Source.Table (S).Checksum,
Get_File_Checksum (Source.Table (S).Sfile))
then
Source.Table (S).All_Checksums_Match := False;
end if;
end if;
end loop;
ALIs_Loop : for A in ALIs.First .. ALIs.Last loop
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_Info (Sdep.Table (D).Sfile));
if Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
and then not Source.Table (Src).All_Checksums_Match
then
Error_Msg_Name_1 := ALIs.Table (A).Sfile;
Error_Msg_Name_2 := Sdep.Table (D).Sfile;
if Error_Msg_Name_1 = Error_Msg_Name_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.Find_File ((ALIs.Table (A).Afile), Osint.Library);
if Osint.Is_Readonly_Library (ALI_Path_Id) then
if Tolerate_Consistency_Errors then
Error_Msg ("?% should be recompiled");
Error_Msg_Name_1 := ALI_Path_Id;
Error_Msg ("?(% is obsolete and read-only)");
else
Error_Msg ("% must be compiled");
Error_Msg_Name_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
declare
Msg : constant String := "% time stamp ";
Buf : String (1 .. Msg'Length + Time_Stamp_Length);
begin
Buf (1 .. Msg'Length) := Msg;
Buf (Msg'Length + 1 .. Buf'Length) :=
String (Source.Table (Src).Stamp);
Error_Msg_Name_1 := Sdep.Table (D).Sfile;
Error_Msg (Buf);
end;
declare
Msg : constant String := " conflicts with % timestamp ";
Buf : String (1 .. Msg'Length + Time_Stamp_Length);
begin
Buf (1 .. Msg'Length) := Msg;
Buf (Msg'Length + 1 .. Buf'Length) :=
String (Sdep.Table (D).Stamp);
Error_Msg_Name_1 := Sdep.Table (D).Sfile;
Error_Msg (Buf);
end;
end if;
exit Sdep_Loop;
end if;
<<Continue>>
null;
end loop Sdep_Loop;
end loop ALIs_Loop;
end Check_Consistency;
procedure Check_Duplicated_Subunits is
begin
for J in Sdep.First .. Sdep.Last loop
if Sdep.Table (J).Subunit_Name /= No_Name then
Get_Decoded_Name_String (Sdep.Table (J).Subunit_Name);
Name_Len := Name_Len + 2;
Name_Buffer (Name_Len - 1) := '%';
for K in Boolean loop
if K then
Name_Buffer (Name_Len) := 'b';
else
Name_Buffer (Name_Len) := 's';
end if;
declare
Info : constant Int := Get_Name_Table_Info (Name_Find);
begin
if Info /= 0 then
Set_Standard_Error;
Write_Str ("error: subunit """);
Write_Name_Decoded (Sdep.Table (J).Subunit_Name);
Write_Str (""" in file """);
Write_Name_Decoded (Sdep.Table (J).Sfile);
Write_Char ('"');
Write_Eol;
Write_Str (" has same name as unit """);
Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
Write_Str (""" found in file """);
Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
Write_Char ('"');
Write_Eol;
Write_Str (" this is not allowed within a single "
& "partition (RM 10.2(19))");
Write_Eol;
Osint.Exit_Program (Osint.E_Fatal);
end if;
end;
end loop;
end if;
end loop;
end Check_Duplicated_Subunits;
procedure Check_Versions is
VL : constant Natural := ALIs.Table (ALIs.First).Ver_Len;
begin
for A in ALIs.First .. ALIs.Last loop
if ALIs.Table (A).Ver_Len /= VL
or else ALIs.Table (A).Ver (1 .. VL) /=
ALIs.Table (ALIs.First).Ver (1 .. VL)
then
Error_Msg_Name_1 := ALIs.Table (A).Sfile;
Error_Msg_Name_2 := ALIs.Table (ALIs.First).Sfile;
Consistency_Error_Msg
("% and % compiled with different GNAT versions");
end if;
end loop;
end Check_Versions;
procedure Consistency_Error_Msg (Msg : String) is
begin
if Tolerate_Consistency_Errors then
declare
Warning_Msg : String (1 .. Msg'Length + 1);
begin
Warning_Msg (1) := '?';
Warning_Msg (2 .. Warning_Msg'Last) := Msg;
Error_Msg (Warning_Msg);
end;
else
Error_Msg (Msg);
end if;
end Consistency_Error_Msg;
end Bcheck;