+2017-09-08 Yannick Moy <moy@adacore.com>
+
+ * sem_prag.adb (Analyze_Pragma): Issue more precise error messages on
+ Loop_Variant.
+
+2017-09-08 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_attr.adb (Build_Record_VS_Func): If the record is an
+ unchecked union, do not emit checks for its (non-existent)
+ discriminants, or for variant parts that depend on them.
+
+2017-09-08 Justin Squirek <squirek@adacore.com>
+
+ * sem_ch4.adb (Find_Equality_Types.Try_One_Interp,
+ Find_Comparison_Type.Try_One_Interp): Add check for generic
+ instances.
+
2017-09-08 Arnaud Charlet <charlet@adacore.com>
* sem_ch3.adb, layout.adb, layout.ads, exp_attr.adb, debug.adb,
-- return True;
-- end _Valid_Scalars;
+ -- If the record type is an unchecked union, we can only check components
+ -- in the invariant part, given that there are no discriminant values to
+ -- select a variant.
+
function Build_Record_VS_Func
(R_Type : Entity_Id;
Nod : Node_Id) return Entity_Id
begin
Append_To (Result, Make_VS_If (E, Component_Items (CL)));
- if No (Variant_Part (CL)) then
+ if No (Variant_Part (CL))
+ or else Is_Unchecked_Union (R_Type)
+ then
return Result;
end if;
elsif Field_Name = Name_uTag then
null;
+ elsif Ekind (Def_Id) = E_Discriminant
+ and then Is_Unchecked_Union (R_Type)
+ then
+ null;
+
-- Don't bother with component with no scalar components
elsif not Scalar_Part_Present (Etype (Def_Id)) then
-- If the operator is an expanded name, then the type of the operand
-- must be defined in the corresponding scope. If the type is
- -- universal, the context will impose the correct type.
+ -- universal, the context will impose the correct type. Note that we
+ -- also avoid returning if we are currently within a generic instance
+ -- due to the fact that the generic package declaration has already
+ -- been successfully analyzed and Defined_In_Scope expects the base
+ -- type to be defined within the instance which will never be the
+ -- case.
if Present (Scop)
and then not Defined_In_Scope (T1, Scop)
+ and then not In_Instance
and then T1 /= Universal_Integer
and then T1 /= Universal_Real
and then T1 /= Any_String
else
T_F := It.Typ;
end if;
-
else
Found := True;
T_F := T1;
Set_Etype (L, T_F);
Find_Non_Universal_Interpretations (N, R, Op_Id, T1);
-
end if;
end Try_One_Interp;
-- is declared in Standard, and preference rules apply to it.
if Present (Scop) then
+
+ -- Note that we avoid returning if we are currently within a
+ -- generic instance due to the fact that the generic package
+ -- declaration has already been successfully analyzed and
+ -- Defined_In_Scope expects the base type to be defined within the
+ -- instance which will never be the case.
+
if Defined_In_Scope (T1, Scop)
+ or else In_Instance
or else T1 = Universal_Integer
or else T1 = Universal_Real
or else T1 = Any_Access
Variant := First (Pragma_Argument_Associations (N));
while Present (Variant) loop
- if not Nam_In (Chars (Variant), Name_Decreases,
- Name_Increases)
+ if Chars (Variant) = No_Name then
+ Error_Pragma_Arg ("expect name `Increases`", Variant);
+
+ elsif not Nam_In (Chars (Variant), Name_Decreases,
+ Name_Increases)
then
- Error_Pragma_Arg ("wrong change modifier", Variant);
+ declare
+ Name : constant String :=
+ Get_Name_String (Chars (Variant));
+ begin
+ -- It is a common mistake to write "Increasing" for
+ -- "Increases" or "Decreasing" for "Decreases". Recognize
+ -- specially names starting with "Incr" or "Decr" to
+ -- suggest the corresponding name.
+
+ if Name'Length >= 4
+ and then (Name (1 .. 4) = "Incr"
+ or else Name (1 .. 4) = "incr")
+ then
+ Error_Pragma_Arg_Ident
+ ("expect name `Increases`", Variant);
+
+ elsif Name'Length >= 4
+ and then (Name (1 .. 4) = "Decr"
+ or else Name (1 .. 4) = "decr")
+ then
+ Error_Pragma_Arg_Ident
+ ("expect name `Decreases`", Variant);
+
+ else
+ Error_Pragma_Arg_Ident
+ ("expect name `Increases` or `Decreases`", Variant);
+ end if;
+ end;
end if;
Preanalyze_Assert_Expression
projects / gcc.git / commitdiff