From 2cbac6c692b9a68e9fedaa193ae756eea8ac23c5 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 8 Jul 2013 10:15:25 +0200 Subject: [multiple changes] 2013-07-08 Robert Dewar * 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 * 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 * 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 * 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 --- gcc/ada/exp_ch4.adb | 79 ++++++++++++----------------------------------------- 1 file changed, 17 insertions(+), 62 deletions(-) (limited to 'gcc/ada/exp_ch4.adb') 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), -- cgit v1.1