This patch prevents the compiler from entering infinite recursion when
processing an illegal deferred constant.
------------
-- Source --
------------
-- types.ads
package Types is
type Enum is (One, Two);
end Types;
-- types2.ads
with Types;
package Types2 is
type Enum is private;
One : constant Enum;
Two : constant Enum;
private
type Enum is new Types.Enum;
One : constant Enum := One;
Two : constant Enum := Two;
end Types2;
----------------------------
-- Compilation and output --
----------------------------
$ gcc -c types2.ads
types2.ads:10:04: full constant declaration appears too late
types2.ads:11:04: full constant declaration appears too late
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-07-16 Hristian Kirtchev <kirtc...@adacore.com>
gcc/ada/
* sem_eval.adb (Compile_Time_Known_Value): Add a guard which prevents
the compiler from entering infinite recursion when trying to determine
whether a deferred constant has a compile time known value, and the
initialization expression of the constant is a reference to the
constant itself.--- gcc/ada/sem_eval.adb
+++ gcc/ada/sem_eval.adb
@@ -1705,29 +1705,46 @@ package body Sem_Eval is
end if;
-- If we have an entity name, then see if it is the name of a constant
- -- and if so, test the corresponding constant value, or the name of
- -- an enumeration literal, which is always a constant.
+ -- and if so, test the corresponding constant value, or the name of an
+ -- enumeration literal, which is always a constant.
if Present (Etype (Op)) and then Is_Entity_Name (Op) then
declare
- E : constant Entity_Id := Entity (Op);
- V : Node_Id;
+ Ent : constant Entity_Id := Entity (Op);
+ Val : Node_Id;
begin
- -- Never known at compile time if it is a packed array value.
- -- We might want to try to evaluate these at compile time one
- -- day, but we do not make that attempt now.
+ -- Never known at compile time if it is a packed array value. We
+ -- might want to try to evaluate these at compile time one day,
+ -- but we do not make that attempt now.
if Is_Packed_Array_Impl_Type (Etype (Op)) then
return False;
- end if;
- if Ekind (E) = E_Enumeration_Literal then
+ elsif Ekind (Ent) = E_Enumeration_Literal then
return True;
- elsif Ekind (E) = E_Constant then
- V := Constant_Value (E);
- return Present (V) and then Compile_Time_Known_Value (V);
+ elsif Ekind (Ent) = E_Constant then
+ Val := Constant_Value (Ent);
+
+ if Present (Val) then
+
+ -- Guard against an illegal deferred constant whose full
+ -- view is initialized with a reference to itself. Treat
+ -- this case as value not known at compile time.
+
+ if Is_Entity_Name (Val) and then Entity (Val) = Ent then
+ return False;
+ else
+ return Compile_Time_Known_Value (Val);
+ end if;
+
+ -- Otherwise the constant does not have a compile time known
+ -- value.
+
+ else
+ return False;
+ end if;
end if;
end;
