This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[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

Tested on x86_64-pc-linux-gnu, committed on trunk

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.
--- 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;
 


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]