[multiple changes]

2015-10-20  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch13.adb: Minor reference change (RM => AARM).

2015-10-20  Eric Botcazou  <ebotcazou@adacore.com>

	* make.adb (Check): Skip multilib switches reinstated by the
	compiler only when counting the number of switches, since it is
	what really matters in the regular operating mode.

2015-10-20  Arnaud Charlet  <charlet@adacore.com>

	* einfo.adb: Add extra assertion for small clause.
	* cstand.adb: Minor style fix in comment.
	* debug.adb: Minor reformatting.
	* exp_util.adb: Fix minor typo.

2015-10-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Same_Instantiated_Function): New predicate in
	Check_Formal_Package_Instance, used to verify that the formal
	and the actual of an actual package match when both are functions
	given as attribute references.

From-SVN: r229034
This commit is contained in:
Arnaud Charlet 2015-10-20 12:00:15 +02:00
parent e9f97e7931
commit 47b79f7801
8 changed files with 100 additions and 27 deletions

View File

@ -1,3 +1,27 @@
2015-10-20 Gary Dismukes <dismukes@adacore.com>
* sem_ch13.adb: Minor reference change (RM => AARM).
2015-10-20 Eric Botcazou <ebotcazou@adacore.com>
* make.adb (Check): Skip multilib switches reinstated by the
compiler only when counting the number of switches, since it is
what really matters in the regular operating mode.
2015-10-20 Arnaud Charlet <charlet@adacore.com>
* einfo.adb: Add extra assertion for small clause.
* cstand.adb: Minor style fix in comment.
* debug.adb: Minor reformatting.
* exp_util.adb: Fix minor typo.
2015-10-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Same_Instantiated_Function): New predicate in
Check_Formal_Package_Instance, used to verify that the formal
and the actual of an actual package match when both are functions
given as attribute references.
2015-10-20 Bob Duff <duff@adacore.com> 2015-10-20 Bob Duff <duff@adacore.com>
* a-coinve.ads, a-coinve.adb: Do the same efficiency * a-coinve.ads, a-coinve.adb: Do the same efficiency

View File

@ -1425,8 +1425,8 @@ package body CStand is
Dhi := Intval (Type_High_Bound (Standard_Integer_32)); Dhi := Intval (Type_High_Bound (Standard_Integer_32));
Delta_Val := UR_From_Components (UI_From_Int (20), Uint_3, 10); Delta_Val := UR_From_Components (UI_From_Int (20), Uint_3, 10);
-- In standard 64-bit mode, the size is 64-bits and the delta and -- In 64-bit mode, the size is 64-bits and the delta and
-- small values are set to nanoseconds (1.0*(10.0**(-9)) -- small values are set to nanoseconds (1.0*(10.0**(-9)).
else else
Dlo := Intval (Type_Low_Bound (Standard_Integer_64)); Dlo := Intval (Type_Low_Bound (Standard_Integer_64));

View File

@ -694,8 +694,8 @@ package body Debug is
-- d.X A previous version of GNAT allowed indexing aspects to be redefined -- d.X A previous version of GNAT allowed indexing aspects to be redefined
-- on derived container types, while the default iterator was -- on derived container types, while the default iterator was
-- inherited from the aprent type. This non-standard extension is -- inherited from the parent type. This nonstandard extension is
-- preserved temporarily for use by the modelling project under debug -- preserved temporarily for use by the modeling project under debug
-- flag d.X. -- flag d.X.
-- d.Z Normally we always enable expansion in configurable run-time mode -- d.Z Normally we always enable expansion in configurable run-time mode

View File

@ -1763,6 +1763,7 @@ package body Einfo is
function Has_Small_Clause (Id : E) return B is function Has_Small_Clause (Id : E) return B is
begin begin
pragma Assert (Is_Ordinary_Fixed_Point_Type (Id));
return Flag67 (Id); return Flag67 (Id);
end Has_Small_Clause; end Has_Small_Clause;
@ -4663,6 +4664,7 @@ package body Einfo is
procedure Set_Has_Small_Clause (Id : E; V : B := True) is procedure Set_Has_Small_Clause (Id : E; V : B := True) is
begin begin
pragma Assert (Is_Ordinary_Fixed_Point_Type (Id));
Set_Flag67 (Id, V); Set_Flag67 (Id, V);
end Set_Has_Small_Clause; end Set_Has_Small_Clause;

View File

@ -206,7 +206,7 @@ package body Exp_Util is
end case; end case;
-- Nothing to do for the identifier in an object renaming declaration, -- Nothing to do for the identifier in an object renaming declaration,
-- the renaming itself does not need atomic syncrhonization. -- the renaming itself does not need atomic synchronization.
if Nkind (Parent (N)) = N_Object_Renaming_Declaration then if Nkind (Parent (N)) = N_Object_Renaming_Declaration then
return; return;

View File

@ -1572,12 +1572,21 @@ package body Make is
Source_Name : File_Name_Type; Source_Name : File_Name_Type;
Text : Text_Buffer_Ptr; Text : Text_Buffer_Ptr;
Prev_Switch : String_Access; First_Arg : Arg_Id;
-- Previous switch processed -- Index of the first argument in Args.Table for a given unit
Last_Arg : Arg_Id;
-- Index of the last argument in Args.Table for a given unit
Arg : Arg_Id := Arg_Id'First; Arg : Arg_Id := Arg_Id'First;
-- Current index in Args.Table for a given unit (init to stop warning) -- Current index in Args.Table for a given unit (init to stop warning)
Number_Of_Switches : Natural;
-- Number of switches recorded for a given unit
Prev_Switch : String_Access;
-- Previous switch processed
Switch_Found : Boolean; Switch_Found : Boolean;
-- True if a given switch has been found -- True if a given switch has been found
@ -1720,17 +1729,12 @@ package body Make is
for J in 1 .. Last_Argument loop for J in 1 .. Last_Argument loop
-- Skip -c, -I and -o switches, as well as multilib switches -- Skip -c, -I and -o switches
-- reinstated by the compiler according to lang-specs.h.
if Arguments (J) (1) = '-' if Arguments (J) (1) = '-'
and then Arguments (J) (2) /= 'c' and then Arguments (J) (2) /= 'c'
and then Arguments (J) (2) /= 'o' and then Arguments (J) (2) /= 'o'
and then Arguments (J) (2) /= 'I' and then Arguments (J) (2) /= 'I'
and then not (Arguments (J)'Length = 5
and then Arguments (J) (2 .. 5) = "mrtp")
and then not (Arguments (J)'Length = 6
and then Arguments (J) (2 .. 6) = "fsjlj")
then then
Normalize_Compiler_Switches Normalize_Compiler_Switches
(Arguments (J).all, (Arguments (J).all,
@ -1745,6 +1749,9 @@ package body Make is
end if; end if;
end loop; end loop;
First_Arg := Units.Table (ALIs.Table (ALI).First_Unit).First_Arg;
Last_Arg := Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg;
for J in 1 .. Switches_To_Check.Last loop for J in 1 .. Switches_To_Check.Last loop
-- Comparing switches is delicate because gcc reorders a number -- Comparing switches is delicate because gcc reorders a number
@ -1762,15 +1769,12 @@ package body Make is
Prev_Switch (6) /= Switches_To_Check.Table (J) (6)) Prev_Switch (6) /= Switches_To_Check.Table (J) (6))
then then
Prev_Switch := Switches_To_Check.Table (J); Prev_Switch := Switches_To_Check.Table (J);
Arg := Arg := First_Arg;
Units.Table (ALIs.Table (ALI).First_Unit).First_Arg;
end if; end if;
Switch_Found := False; Switch_Found := False;
for K in Arg .. for K in Arg .. Last_Arg loop
Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg
loop
if if
Switches_To_Check.Table (J).all = Args.Table (K).all Switches_To_Check.Table (J).all = Args.Table (K).all
then then
@ -1792,17 +1796,25 @@ package body Make is
end if; end if;
end loop; end loop;
if Switches_To_Check.Last /= Number_Of_Switches := Natural (Last_Arg - First_Arg + 1);
Integer (Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg -
Units.Table (ALIs.Table (ALI).First_Unit).First_Arg + 1) -- Do not count the multilib switches reinstated by the compiler
then -- according to the lang-specs.h.settings.
for K in First_Arg .. Last_Arg loop
if Args.Table (K).all = "-mrtp"
or else Args.Table (K).all = "-fsjlj"
then
Number_Of_Switches := Number_Of_Switches - 1;
end if;
end loop;
if Switches_To_Check.Last /= Number_Of_Switches then
if Verbose_Mode then if Verbose_Mode then
Verbose_Msg (ALIs.Table (ALI).Sfile, Verbose_Msg (ALIs.Table (ALI).Sfile,
"different number of switches"); "different number of switches");
for K in Units.Table (ALIs.Table (ALI).First_Unit).First_Arg for K in First_Arg .. Last_Arg loop
.. Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg
loop
Write_Str (Args.Table (K).all); Write_Str (Args.Table (K).all);
Write_Char (' '); Write_Char (' ');
end loop; end loop;

View File

@ -5759,6 +5759,11 @@ package body Sem_Ch12 is
-- same entity we may have to traverse several definitions to recover -- same entity we may have to traverse several definitions to recover
-- the ultimate entity that they refer to. -- the ultimate entity that they refer to.
function Same_Instantiated_Function (E1, E2 : Entity_Id) return Boolean;
-- The formal and the actual must be identical, but if both are
-- given by attributes they end up renaming different generated bodies,
-- and we must verify that the attributes themselves match.
function Same_Instantiated_Variable (E1, E2 : Entity_Id) return Boolean; function Same_Instantiated_Variable (E1, E2 : Entity_Id) return Boolean;
-- Similarly, if the formal comes from a nested formal package, the -- Similarly, if the formal comes from a nested formal package, the
-- actual may designate the formal through multiple renamings, which -- actual may designate the formal through multiple renamings, which
@ -5833,6 +5838,35 @@ package body Sem_Ch12 is
return False; return False;
end Same_Instantiated_Constant; end Same_Instantiated_Constant;
--------------------------------
-- Same_Instantiated_Function --
--------------------------------
function Same_Instantiated_Function
(E1, E2 : Entity_Id) return Boolean
is
U1, U2 : Node_Id;
begin
if Alias (E1) = Alias (E2) then
return True;
elsif Present (Alias (E2)) then
U1 := Original_Node (Unit_Declaration_Node (E1));
U2 := Original_Node (Unit_Declaration_Node (Alias (E2)));
return Nkind (U1) = N_Subprogram_Renaming_Declaration
and then Nkind (Name (U1)) = N_Attribute_Reference
and then Nkind (U2) = N_Subprogram_Renaming_Declaration
and then Nkind (Name (U2)) = N_Attribute_Reference
and then
Attribute_Name (Name (U1)) = Attribute_Name (Name (U2));
else
return False;
end if;
end Same_Instantiated_Function;
-------------------------------- --------------------------------
-- Same_Instantiated_Variable -- -- Same_Instantiated_Variable --
-------------------------------- --------------------------------
@ -6050,7 +6084,8 @@ package body Sem_Ch12 is
else else
Check_Mismatch Check_Mismatch
(Ekind (E2) /= Ekind (E1) or else (Alias (E1)) /= Alias (E2)); (Ekind (E2) /= Ekind (E1)
or else not Same_Instantiated_Function (E1, E2));
end if; end if;
else else

View File

@ -11420,7 +11420,7 @@ package body Sem_Ch13 is
Id : constant Attribute_Id := Get_Attribute_Id (Chars (N)); Id : constant Attribute_Id := Get_Attribute_Id (Chars (N));
begin begin
-- List of operational items is given in RM 13.1(8.mm/1). -- List of operational items is given in AARM 13.1(8.mm/1).
-- It is clearly incomplete, as it does not include iterator -- It is clearly incomplete, as it does not include iterator
-- aspects, among others. -- aspects, among others.