Commit 705bcbfe by Hristian Kirtchev Committed by Pierre-Marie de Rodat

[Ada] Illegal deferred constant causes stack overflow

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

2018-07-16  Hristian Kirtchev  <kirtchev@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.

From-SVN: r262698
parent e05a1ce7
2018-07-16 Hristian Kirtchev <kirtchev@adacore.com>
* 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.
2018-07-16 Nicolas Roche <roche@adacore.com>
* libgnat/a-strunb.adb, libgnat/a-strunb__shared.adb: Adjust growth
......
......@@ -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;
......
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