+2016-07-06 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_attr.adb, sem_attr.adb, sem_ch13.adb: Minor reformatting.
+
+2016-07-06 Arnaud Charlet <charlet@adacore.com>
+
+ * lib.adb (Check_Same_Extended_Unit): Prevent looping forever.
+ * gnatbind.adb: Disable some consistency checks in codepeer mode,
+ which are not needed.
+
+2016-07-06 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.adb (Check_Fixed_Point_Actual): Add a warning when
+ a formal fixed point type is instantiated with a type that has
+ a user-defined arithmetic operations, but the generic has no
+ corresponding formal functions. This is worth a warning because
+ of the special semantics of fixed-point operators.
+
2016-07-06 Bob Duff <duff@adacore.com>
* sem_attr.adb (Analyze_Attribute): Allow any expression of
when Attribute_Enum_Rep => Enum_Rep : declare
Expr : Node_Id;
+
begin
- -- Get the expression, which is X for Enum_Type'Enum_Rep (X)
- -- or X'Enum_Rep.
+ -- Get the expression, which is X for Enum_Type'Enum_Rep (X) or
+ -- X'Enum_Rep.
if Is_Non_Empty_List (Exprs) then
Expr := First (Exprs);
Expr := Pref;
end if;
- -- If the expression is an enumeration literal, it is
- -- replaced by the literal value.
+ -- If the expression is an enumeration literal, it is replaced by the
+ -- literal value.
if Nkind (Expr) in N_Has_Entity
and then Ekind (Entity (Expr)) = E_Enumeration_Literal
Make_Integer_Literal (Loc, Enumeration_Rep (Entity (Expr))));
-- If this is a renaming of a literal, recover the representation
- -- of the original. If it renames an expression there is nothing
- -- to fold.
+ -- of the original. If it renames an expression there is nothing to
+ -- fold.
elsif Nkind (Expr) in N_Has_Entity
and then Ekind (Entity (Expr)) = E_Constant
-- might be an illegal conversion.
else
- Rewrite (N,
- OK_Convert_To (Typ, Relocate_Node (Expr)));
+ Rewrite (N, OK_Convert_To (Typ, Relocate_Node (Expr)));
end if;
Set_Etype (N, Typ);
end;
end if;
- -- Perform consistency and correctness checks
-
- Check_Duplicated_Subunits;
- Check_Versions;
- Check_Consistency;
- Check_Configuration_Consistency;
+ -- Perform consistency and correctness checks. Disable these in CodePeer
+ -- mode where we want to be more flexible.
+
+ if not CodePeer_Mode then
+ Check_Duplicated_Subunits;
+ Check_Versions;
+ Check_Consistency;
+ Check_Configuration_Consistency;
+ end if;
-- List restrictions that could be applied to this partition
with Einfo; use Einfo;
with Fname; use Fname;
with Nlists; use Nlists;
+with Opt; use Opt;
with Output; use Output;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
------------------------------
function Check_Same_Extended_Unit (S1, S2 : Source_Ptr) return SEU_Result is
- Sloc1 : Source_Ptr;
- Sloc2 : Source_Ptr;
- Sind1 : Source_File_Index;
- Sind2 : Source_File_Index;
- Inst1 : Source_Ptr;
- Inst2 : Source_Ptr;
- Unum1 : Unit_Number_Type;
- Unum2 : Unit_Number_Type;
- Unit1 : Node_Id;
- Unit2 : Node_Id;
- Depth1 : Nat;
- Depth2 : Nat;
+ Max_Iterations : constant Nat := Maximum_Instantiations * 2;
+ -- Limit to prevent a potential infinite loop
+
+ Counter : Nat := 0;
+ Depth1 : Nat;
+ Depth2 : Nat;
+ Inst1 : Source_Ptr;
+ Inst2 : Source_Ptr;
+ Sind1 : Source_File_Index;
+ Sind2 : Source_File_Index;
+ Sloc1 : Source_Ptr;
+ Sloc2 : Source_Ptr;
+ Unit1 : Node_Id;
+ Unit2 : Node_Id;
+ Unum1 : Unit_Number_Type;
+ Unum2 : Unit_Number_Type;
begin
if S1 = No_Location or else S2 = No_Location then
return No;
<<Continue>>
- null;
+ Counter := Counter + 1;
+
+ -- Prevent looping forever
+
+ if Counter > Max_Iterations then
+ raise Program_Error;
+ end if;
end loop;
end Check_Same_Extended_Unit;
Check_E1;
Check_Discrete_Type;
Resolve (E1, P_Base_Type);
+
elsif not Is_Discrete_Type (Etype (P)) then
Error_Attr_P ("prefix of % attribute must be of discrete type");
end if;
-- In Ada 2005, indicates partial parameterization of a formal
-- package. As usual an other association must be last in the list.
+ procedure Check_Fixed_Point_Actual (Actual : Node_Id);
+ -- Warn if an actual fixed-point type has user-defined arithmetic
+ -- operations, but there is no corresponding formal in the generic,
+ -- in which case the predefined operations will be used. This merits
+ -- a warning because of the special semantics of fixed point ops.
+
procedure Check_Overloaded_Formal_Subprogram (Formal : Entity_Id);
-- Apply RM 12.3(9): if a formal subprogram is overloaded, the instance
-- cannot have a named association for it. AI05-0025 extends this rule
end loop;
end Check_Overloaded_Formal_Subprogram;
+ -------------------------------
+ -- Check_Fixed_Point_Actual --
+ -------------------------------
+
+ procedure Check_Fixed_Point_Actual (Actual : Node_Id) is
+ Typ : constant Entity_Id := Entity (Actual);
+ Prims : constant Elist_Id := Collect_Primitive_Operations (Typ);
+ Elem : Elmt_Id;
+ Formal : Node_Id;
+
+ begin
+ -- Locate primitive operations of the type that are arithmetic
+ -- operations.
+
+ Elem := First_Elmt (Prims);
+ while Present (Elem) loop
+ if Nkind (Node (Elem)) = N_Defining_Operator_Symbol then
+
+ -- Check whether the generic unit has a formal subprogram of
+ -- the same name. This does not check types but is good enough
+ -- to justify a warning.
+
+ Formal := First_Non_Pragma (Formals);
+ while Present (Formal) loop
+ if Nkind (Formal) = N_Formal_Concrete_Subprogram_Declaration
+ and then Chars (Defining_Entity (Formal)) =
+ Chars (Node (Elem))
+ then
+ exit;
+ end if;
+
+ Next (Formal);
+ end loop;
+
+ if No (Formal) then
+ Error_Msg_Sloc := Sloc (Node (Elem));
+ Error_Msg_NE
+ ("?instance does not use primitive operation&#",
+ Actual, Node (Elem));
+ end if;
+ end if;
+
+ Next_Elmt (Elem);
+ end loop;
+ end Check_Fixed_Point_Actual;
+
-------------------------------
-- Has_Fully_Defined_Profile --
-------------------------------
(Formal, Match, Analyzed_Formal, Assoc),
Assoc);
+ if Is_Fixed_Point_Type (Entity (Match)) then
+ Check_Fixed_Point_Actual (Match);
+ end if;
+
-- An instantiation is a freeze point for the actuals,
-- unless this is a rewritten formal package, or the
-- formal is an Ada 2012 formal incomplete type.
if not Implementation_Defined_Aspect (A_Id) then
Error_Msg_Name_1 := Nam;
- -- Not allowed for renaming declarations. Examine original
+ -- Not allowed for renaming declarations. Examine the original
-- node because a subprogram renaming may have been rewritten
-- as a body.
projects / gcc.git / commitdiff