[multiple changes]

2013-07-08  Robert Dewar  <dewar@adacore.com>

	* sem.ads: Minor comment updates.
	* s-restri.ads, exp_ch6.adb, lib-load.ads, exp_ch3.adb, sem_ch10.adb:
	Minor reformatting.

2013-07-08  Robert Dewar  <dewar@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference): Add dummy entry
	for Restriction_Set.
	* gnat_rm.texi: Add missing menu entry for Attribute Ref Add
	documentation for attribute Restriction_Set.
	* lib-writ.adb (Write_With_Lines): Generate special W lines
	for Restriction_Set.
	* lib-writ.ads: Document special use of W lines for
	Restriction_Set.
	* lib.ads (Restriction_Set_Dependences): New table.
	* par-ch4.adb (Is_Parameterless_Attribute): Add Loop_Entry to
	list (Scan_Name_Extension_Apostrophe): Remove kludge test for
	Loop_Entry (Scan_Name_Extension_Apostrophe): Handle No_Dependence
	for Restricton_Set.
	* restrict.adb (Check_SPARK_Restriction): Put in Alfa order
	(OK_No_Dependence_Unit_Name): New function.
	* restrict.ads (OK_No_Dependence_Unit_Name): New function.
	* rtsfind.adb: Minor reformatting Minor code reorganization.
	* sem_attr.adb (Analyze_Attribute): Add processing for
	Restriction_Set.
	* sem_prag.adb (Process_Restrictions_Or_Restriction_Warnings):
	Remove Check_Unit_Name and use new function
	OK_No_Dependence_Unit_Name instead.
	* sinfo.ads: Minor comment updates.
	* snames.ads-tmpl: Add entry for Restriction_Set attribute.

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

	* exp_ch4.adb (Apply_Accessibility_Check): Remove local constant
	Pool_Id and local variable Free_Stmt. Do not deallocate the faulty
	object as "free" is not available on all targets/profiles.

2013-07-08  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications): Handle
	Storage_Size aspect for task type in case discriminant is
	referenced.
	(Analyze_Attribute_Definition_Clause): Do not flag Storage_Size
	attribute definition clause as obsolescent if from aspect.

From-SVN: r200771

1 files changed, 17 insertions, 62 deletions

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 46cf44b..6fec955 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -725,11 +725,9 @@ package body Exp_Ch4 is
         (Ref            : Node_Id;
          Built_In_Place : Boolean := False)
       is
-         Pool_Id   : constant Entity_Id := Associated_Storage_Pool (PtrT);
-         Cond      : Node_Id;
-         Free_Stmt : Node_Id;
-         Obj_Ref   : Node_Id;
-         Stmts     : List_Id;
+         Cond    : Node_Id;
+         Obj_Ref : Node_Id;
+         Stmts   : List_Id;
 
       begin
          if Ada_Version >= Ada_2005
@@ -761,70 +759,27 @@ package body Exp_Ch4 is
 
             Stmts := New_List;
 
-            --  If the target does not support allocation/deallocation, simply
-            --  finalize the object (if applicable). Generate:
+            --  Why don't we free the object ??? discussion and explanation
+            --  needed of why old approach did not work ???
 
+            --  Generate:
             --    [Deep_]Finalize (Obj_Ref.all);
 
-            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;
-
-            --  Finalize (if applicable) and deallocate the object in case the
-            --  accessibility check fails.
-
-            else
-               --  Create an explicit free statement to clean up the allocated
-               --  object in case the accessibility check fails. Generate:
-
-               --    Free (Obj_Ref);
-
-               Free_Stmt := Make_Free_Statement (Loc, New_Copy (Obj_Ref));
-               Set_Storage_Pool (Free_Stmt, Pool_Id);
-
-               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;
+            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;
 
             --  Signal the accessibility failure through a Program_Error
 
+            --  Since we may have a storage leak, I would be inclined to
+            --  define a new PE_ code that warns of this possibility where
+            --  the message would be Accessibility_Check_Failed (causing
+            --  storage leak) ???
+
             Append_To (Stmts,
               Make_Raise_Program_Error (Loc,
                 Condition => New_Reference_To (Standard_True, Loc),