+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>
* a-coinve.ads, a-coinve.adb: Do the same efficiency
Dhi := Intval (Type_High_Bound (Standard_Integer_32));
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
- -- small values are set to nanoseconds (1.0*(10.0**(-9))
+ -- In 64-bit mode, the size is 64-bits and the delta and
+ -- small values are set to nanoseconds (1.0*(10.0**(-9)).
else
Dlo := Intval (Type_Low_Bound (Standard_Integer_64));
-- d.X A previous version of GNAT allowed indexing aspects to be redefined
-- on derived container types, while the default iterator was
- -- inherited from the aprent type. This non-standard extension is
- -- preserved temporarily for use by the modelling project under debug
+ -- inherited from the parent type. This nonstandard extension is
+ -- preserved temporarily for use by the modeling project under debug
-- flag d.X.
-- d.Z Normally we always enable expansion in configurable run-time mode
function Has_Small_Clause (Id : E) return B is
begin
+ pragma Assert (Is_Ordinary_Fixed_Point_Type (Id));
return Flag67 (Id);
end Has_Small_Clause;
procedure Set_Has_Small_Clause (Id : E; V : B := True) is
begin
+ pragma Assert (Is_Ordinary_Fixed_Point_Type (Id));
Set_Flag67 (Id, V);
end Set_Has_Small_Clause;
end case;
-- 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
return;
Source_Name : File_Name_Type;
Text : Text_Buffer_Ptr;
- Prev_Switch : String_Access;
- -- Previous switch processed
+ First_Arg : Arg_Id;
+ -- 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;
-- 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;
-- True if a given switch has been found
for J in 1 .. Last_Argument loop
- -- Skip -c, -I and -o switches, as well as multilib switches
- -- reinstated by the compiler according to lang-specs.h.
+ -- Skip -c, -I and -o switches
if Arguments (J) (1) = '-'
and then Arguments (J) (2) /= 'c'
and then Arguments (J) (2) /= 'o'
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
Normalize_Compiler_Switches
(Arguments (J).all,
end if;
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
-- Comparing switches is delicate because gcc reorders a number
Prev_Switch (6) /= Switches_To_Check.Table (J) (6))
then
Prev_Switch := Switches_To_Check.Table (J);
- Arg :=
- Units.Table (ALIs.Table (ALI).First_Unit).First_Arg;
+ Arg := First_Arg;
end if;
Switch_Found := False;
- for K in Arg ..
- Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg
- loop
+ for K in Arg .. Last_Arg loop
if
Switches_To_Check.Table (J).all = Args.Table (K).all
then
end if;
end loop;
- if Switches_To_Check.Last /=
- Integer (Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg -
- Units.Table (ALIs.Table (ALI).First_Unit).First_Arg + 1)
- then
+ Number_Of_Switches := Natural (Last_Arg - First_Arg + 1);
+
+ -- Do not count the multilib switches reinstated by the compiler
+ -- 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
Verbose_Msg (ALIs.Table (ALI).Sfile,
"different number of switches");
- for K in Units.Table (ALIs.Table (ALI).First_Unit).First_Arg
- .. Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg
- loop
+ for K in First_Arg .. Last_Arg loop
Write_Str (Args.Table (K).all);
Write_Char (' ');
end loop;
-- same entity we may have to traverse several definitions to recover
-- 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;
-- Similarly, if the formal comes from a nested formal package, the
-- actual may designate the formal through multiple renamings, which
return False;
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 --
--------------------------------
else
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;
else
Id : constant Attribute_Id := Get_Attribute_Id (Chars (N));
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
-- aspects, among others.