[Ada] Accessibility checks and profile Ravenscar

Submitted by Arnaud Charlet on July 8, 2013, 7:51 a.m.

Details

Message ID 20130708075102.GA6567@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet July 8, 2013, 7:51 a.m.
This patch prevents the generation of deallocation code in order to clean up an
allocated object when it fails an accessibility check when profile Ravenscar is
in effect.

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

2013-07-08  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Apply_Accessibility_Check): Do not deallocate the object
	on targets that can't deallocate.

Patch hide | download patch | download mbox

Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 200709)
+++ exp_ch4.adb	(working copy)
@@ -751,47 +751,66 @@ 
 
             Stmts := New_List;
 
-            --  Create an explicit free statement to clean up the allocated
-            --  object in case the accessibility check fails. Generate:
+            --  If the target does not support allocation/deallocation, simply
+            --  finalize the object (if applicable). Generate:
 
-            --    Free (Obj_Ref);
+            --    [Deep_]Finalize (Obj_Ref.all);
 
-            Free_Stmt := Make_Free_Statement (Loc, New_Copy (Obj_Ref));
-            Set_Storage_Pool (Free_Stmt, Pool_Id);
+            if Restriction_Active (No_Implicit_Heap_Allocations) then
+               if Needs_Finalization (DesigT) then
+                  Append_To (Stmts,
+                    Make_Final_Call (
+                      Obj_Ref =>
+                        Make_Explicit_Dereference (Loc, New_Copy (Obj_Ref)),
+                      Typ     => DesigT));
+               end if;
 
-            Append_To (Stmts, Free_Stmt);
+            --  Finalize (if applicable) and deallocate the object in case the
+            --  accessibility check fails.
 
-            --  Finalize the object (if applicable), but wrap the call inside
-            --  a block to ensure that the object would still be deallocated in
-            --  case the finalization fails. Generate:
+            else
+               --  Create an explicit free statement to clean up the allocated
+               --  object in case the accessibility check fails. Generate:
 
-            --    begin
-            --       [Deep_]Finalize (Obj_Ref.all);
-            --    exception
-            --       when others =>
-            --          Free (Obj_Ref);
-            --          raise;
-            --    end;
+               --    Free (Obj_Ref);
 
-            if Needs_Finalization (DesigT) then
-               Prepend_To (Stmts,
-                 Make_Block_Statement (Loc,
-                   Handled_Statement_Sequence =>
-                     Make_Handled_Sequence_Of_Statements (Loc,
-                       Statements => New_List (
-                         Make_Final_Call (
-                           Obj_Ref =>
-                             Make_Explicit_Dereference (Loc,
-                               Prefix => New_Copy (Obj_Ref)),
-                           Typ     => DesigT)),
+               Free_Stmt := Make_Free_Statement (Loc, New_Copy (Obj_Ref));
+               Set_Storage_Pool (Free_Stmt, Pool_Id);
 
-                     Exception_Handlers => New_List (
-                       Make_Exception_Handler (Loc,
-                         Exception_Choices => New_List (
-                           Make_Others_Choice (Loc)),
-                         Statements        => New_List (
-                           New_Copy_Tree (Free_Stmt),
-                           Make_Raise_Statement (Loc)))))));
+               Append_To (Stmts, Free_Stmt);
+
+               --  Finalize the object (if applicable), but wrap the call
+               --  inside a block to ensure that the object would still be
+               --  deallocated in case the finalization fails. Generate:
+
+               --    begin
+               --       [Deep_]Finalize (Obj_Ref.all);
+               --    exception
+               --       when others =>
+               --          Free (Obj_Ref);
+               --          raise;
+               --    end;
+
+               if Needs_Finalization (DesigT) then
+                  Prepend_To (Stmts,
+                    Make_Block_Statement (Loc,
+                      Handled_Statement_Sequence =>
+                        Make_Handled_Sequence_Of_Statements (Loc,
+                          Statements => New_List (
+                            Make_Final_Call (
+                              Obj_Ref =>
+                                Make_Explicit_Dereference (Loc,
+                                  Prefix => New_Copy (Obj_Ref)),
+                              Typ     => DesigT)),
+
+                        Exception_Handlers => New_List (
+                          Make_Exception_Handler (Loc,
+                            Exception_Choices => New_List (
+                              Make_Others_Choice (Loc)),
+                            Statements        => New_List (
+                              New_Copy_Tree (Free_Stmt),
+                              Make_Raise_Statement (Loc)))))));
+               end if;
             end if;
 
             --  Signal the accessibility failure through a Program_Error