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> 2018-07-16 Nicolas Roche <roche@adacore.com>
* libgnat/a-strunb.adb, libgnat/a-strunb__shared.adb: Adjust growth * libgnat/a-strunb.adb, libgnat/a-strunb__shared.adb: Adjust growth
......
...@@ -1705,29 +1705,46 @@ package body Sem_Eval is ...@@ -1705,29 +1705,46 @@ package body Sem_Eval is
end if; end if;
-- If we have an entity name, then see if it is the name of a constant -- 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 -- and if so, test the corresponding constant value, or the name of an
-- an enumeration literal, which is always a constant. -- enumeration literal, which is always a constant.
if Present (Etype (Op)) and then Is_Entity_Name (Op) then if Present (Etype (Op)) and then Is_Entity_Name (Op) then
declare declare
E : constant Entity_Id := Entity (Op); Ent : constant Entity_Id := Entity (Op);
V : Node_Id; Val : Node_Id;
begin begin
-- Never known at compile time if it is a packed array value. -- Never known at compile time if it is a packed array value. We
-- We might want to try to evaluate these at compile time one -- might want to try to evaluate these at compile time one day,
-- day, but we do not make that attempt now. -- but we do not make that attempt now.
if Is_Packed_Array_Impl_Type (Etype (Op)) then if Is_Packed_Array_Impl_Type (Etype (Op)) then
return False; return False;
end if;
if Ekind (E) = E_Enumeration_Literal then elsif Ekind (Ent) = E_Enumeration_Literal then
return True; return True;
elsif Ekind (E) = E_Constant then elsif Ekind (Ent) = E_Constant then
V := Constant_Value (E); Val := Constant_Value (Ent);
return Present (V) and then Compile_Time_Known_Value (V);
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 if;
end; 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