diff mbox series

[Ada] Crash on use of Loop_Entry, Result, and Old as actuals

Message ID 20191212100430.GA114647@adacore.com
State New
Headers show
Series [Ada] Crash on use of Loop_Entry, Result, and Old as actuals | expand

Commit Message

Pierre-Marie de Rodat Dec. 12, 2019, 10:04 a.m. UTC 
This patch fixes an issue whereby the compiler crashes generating
accessibility checks for the attribute references 'Loop_Entry, 'Old, and
'Result when they are used as actuals.

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

2019-12-12  Justin Squirek  <squirek@adacore.com>

gcc/ada/

	* exp_ch6.adb (Expand_Call_Helper): Added null case for
	'Loop_Entry, 'Old, and 'Result when calculating whether to
	create extra accessibility parameters.
	* sem_util.adb (Dynamic_Accessibility_Level): Added null case
	for 'Loop_Entry, 'Old, and 'Result when  calculating
	accessibility level based on access-valued attributes.  Also
	added special handling for uses of 'Loop_Entry when used in its
	indexed component form.
diff mbox series

Patch

--- gcc/ada/exp_ch6.adb
+++ gcc/ada/exp_ch6.adb
@@ -3389,6 +3389,15 @@  package body Exp_Ch6 is
                case Nkind (Prev_Orig) is
                   when N_Attribute_Reference =>
                      case Get_Attribute_Id (Attribute_Name (Prev_Orig)) is
+                        --  Ignore 'Result, 'Loop_Entry, and 'Old as they can
+                        --  be used to identify access objects and do not have
+                        --  an effect on accessibility level.
+
+                        when Attribute_Loop_Entry
+                           | Attribute_Old
+                           | Attribute_Result
+                        =>
+                           null;
 
                         --  For X'Access, pass on the level of the prefix X
 

--- gcc/ada/sem_util.adb
+++ gcc/ada/sem_util.adb
@@ -6488,7 +6488,7 @@  package body Sem_Util is
 
       --  Local variables
 
-      Expr : constant Node_Id := Original_Node (N);
+      Expr : Node_Id := Original_Node (N);
       --  Expr references the original node because at this stage N may be the
       --  reference to a variable internally created by the frontend to remove
       --  side effects of an expression.
@@ -6516,6 +6516,21 @@  package body Sem_Util is
       --  Unimplemented: Ptr.all'Access, where Ptr has Extra_Accessibility ???
 
       case Nkind (Expr) is
+         --  It may be possible that we have an access object denoted by an
+         --  attribute reference for 'Loop_Entry which may, in turn, have an
+         --  indexed component representing a loop identifier.
+
+         --  In this case we must climb up the indexed component and set expr
+         --  to the attribute reference so the rest of the machinery can
+         --  operate as expected.
+
+         when N_Indexed_Component =>
+            if Nkind (Prefix (Expr)) = N_Attribute_Reference
+              and then Get_Attribute_Id (Attribute_Name (Prefix (Expr)))
+                         = Attribute_Loop_Entry
+            then
+               Expr := Prefix (Expr);
+            end if;
 
          --  For access discriminant, the level of the enclosing object
 
@@ -6530,6 +6545,13 @@  package body Sem_Util is
          when N_Attribute_Reference =>
             case Get_Attribute_Id (Attribute_Name (Expr)) is
 
+               --  Ignore 'Loop_Entry, 'Result, and 'Old as they can be used to
+               --  identify access objects and do not have an effect on
+               --  accessibility level.
+
+               when Attribute_Loop_Entry | Attribute_Old | Attribute_Result =>
+                  null;
+
                --  For X'Access, the level of the prefix X
 
                when Attribute_Access =>