From: Hristian Kirtchev <kirtchev@adacore.com>
Date: Mon, 16 Jul 2018 14:09:44 +0000 (+0000)
Subject: [Ada] Illegal deferred constant causes stack overflow
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=705bcbfeeccd0217f1764e9669ae727960563d24;p=gcc.git

[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
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d7063ae88a2..7b5c30882a9 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+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
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 59e867256ea..957abde6ad0 100644
--- a/gcc/ada/sem_eval.adb
+++ b/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;