Commit c468e1fb by Arnaud Charlet

[multiple changes]

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.

From-SVN: r251878
parent f8f50235
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,
......
......@@ -423,6 +423,10 @@ package body Exp_Attr is
-- 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
......@@ -475,7 +479,9 @@ package body Exp_Attr is
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;
......@@ -564,6 +570,11 @@ package body Exp_Attr is
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
......
......@@ -6287,10 +6287,16 @@ package body Sem_Ch4 is
-- 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
......@@ -6311,7 +6317,6 @@ package body Sem_Ch4 is
else
T_F := It.Typ;
end if;
else
Found := True;
T_F := T1;
......@@ -6320,7 +6325,6 @@ package body Sem_Ch4 is
Set_Etype (L, T_F);
Find_Non_Universal_Interpretations (N, R, Op_Id, T1);
end if;
end Try_One_Interp;
......@@ -6472,7 +6476,15 @@ package body Sem_Ch4 is
-- 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
......
......@@ -17916,10 +17916,40 @@ package body Sem_Prag is
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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment