From 8b1011c0c3208bf6541db4775e573446f216eea5 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 11 Apr 2013 11:51:54 +0200 Subject: [PATCH] [multiple changes] 2013-04-11 Yannick Moy * gnat1drv.adb (Adjust_Global_Switches): Allow missing body in Alfa mode. 2013-04-11 Hristian Kirtchev * exp_ch4.adb (Expand_N_Allocator): Detect the allocation of an anonymous controlled object where the type of the context is named. Use the pool and finalization master of the named access type to allocate the object. 2013-04-11 Vincent Celier * gnat_ugn.texi: Remove most mentions of gprbuild. * projects.texi: Remove all mentions of asociative array attributes. From-SVN: r197753 --- gcc/ada/ChangeLog | 18 +++++++++++ gcc/ada/exp_ch4.adb | 71 ++++++++++++++++++++++++++++++------------- gcc/ada/gnat1drv.adb | 5 +-- gcc/ada/gnat_ugn.texi | 22 +++++++------- gcc/ada/projects.texi | 12 ++++---- 5 files changed, 88 insertions(+), 40 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ed18e974b83..29de82b8893 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2013-04-11 Yannick Moy + + * gnat1drv.adb (Adjust_Global_Switches): Allow missing body in Alfa + mode. + +2013-04-11 Hristian Kirtchev + + * exp_ch4.adb (Expand_N_Allocator): Detect the + allocation of an anonymous controlled object where the type of + the context is named. Use the pool and finalization master of + the named access type to allocate the object. + +2013-04-11 Vincent Celier + + * gnat_ugn.texi: Remove most mentions of gprbuild. + * projects.texi: Remove all mentions of asociative array + attributes. + 2013-04-11 Robert Dewar * sem_prag.adb, sem_attr.adb, gnat1drv.adb, prj-makr.adb, diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 1c87c32c8b4..489c388d44f 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -842,7 +842,7 @@ package body Exp_Ch4 is -- if statement instead of the regular Program_Error circuitry. Insert_Action (N, - Make_If_Statement (Loc, + Make_Implicit_If_Statement (N, Condition => Cond, Then_Statements => Stmts)); end if; @@ -3017,8 +3017,6 @@ package body Exp_Ch4 is -- Start of processing for Expand_Concatenate - -- Kirtchev - begin -- Choose an appropriate computational type @@ -3965,7 +3963,7 @@ package body Exp_Ch4 is Name => New_Occurrence_Of (Nnn, Loc), Expression => Relocate_Node (Lop)), - Make_If_Statement (Loc, + Make_Implicit_If_Statement (N, Condition => Make_Op_Not (Loc, Right_Opnd => @@ -4090,14 +4088,9 @@ package body Exp_Ch4 is ------------------------ procedure Expand_N_Allocator (N : Node_Id) is - PtrT : constant Entity_Id := Etype (N); - Dtyp : constant Entity_Id := Available_View (Designated_Type (PtrT)); - Etyp : constant Entity_Id := Etype (Expression (N)); - Loc : constant Source_Ptr := Sloc (N); - Desig : Entity_Id; - Nod : Node_Id; - Pool : Entity_Id; - Temp : Entity_Id; + Etyp : constant Entity_Id := Etype (Expression (N)); + Loc : constant Source_Ptr := Sloc (N); + PtrT : constant Entity_Id := Etype (N); procedure Rewrite_Coextension (N : Node_Id); -- Static coextensions have the same lifetime as the entity they @@ -4195,6 +4188,15 @@ package body Exp_Ch4 is end; end Size_In_Storage_Elements; + -- Local variables + + Dtyp : constant Entity_Id := Available_View (Designated_Type (PtrT)); + Desig : Entity_Id; + Nod : Node_Id; + Pool : Entity_Id; + Rel_Typ : Entity_Id; + Temp : Entity_Id; + -- Start of processing for Expand_N_Allocator begin @@ -4216,13 +4218,40 @@ package body Exp_Ch4 is (Is_Itype (PtrT) and then No (Finalization_Master (PtrT)))) and then Needs_Finalization (Dtyp) then + -- Detect the allocation of an anonymous controlled object where the + -- type of the context is named. For example: + + -- procedure Proc (Ptr : Named_Access_Typ); + -- Proc (new Designated_Typ); + + -- Regardless of the anonymous-to-named access type conversion, the + -- lifetime of the object must be associated with the named access + -- type. Use the finalization-related attributes of the named access + -- type. + + if Nkind_In (Parent (N), N_Type_Conversion, + N_Unchecked_Type_Conversion) + and then Ekind_In (Etype (Parent (N)), E_Access_Subtype, + E_Access_Type, + E_General_Access_Type) + then + Rel_Typ := Etype (Parent (N)); + else + Rel_Typ := Empty; + end if; + -- Anonymous access-to-controlled types allocate on the global pool. -- Do not set this attribute on .NET/JVM since those targets do not -- support pools. if No (Associated_Storage_Pool (PtrT)) and then VM_Target = No_VM then - Set_Associated_Storage_Pool - (PtrT, Get_Global_Pool_For_Access_Type (PtrT)); + if Present (Rel_Typ) then + Set_Associated_Storage_Pool (PtrT, + Associated_Storage_Pool (Rel_Typ)); + else + Set_Associated_Storage_Pool (PtrT, + Get_Global_Pool_For_Access_Type (PtrT)); + end if; end if; -- The finalization master must be inserted and analyzed as part of @@ -4231,7 +4260,11 @@ package body Exp_Ch4 is -- updated when analysis changes current units. if not Alfa_Mode then - Set_Finalization_Master (PtrT, Current_Anonymous_Master); + if Present (Rel_Typ) then + Set_Finalization_Master (PtrT, Finalization_Master (Rel_Typ)); + else + Set_Finalization_Master (PtrT, Current_Anonymous_Master); + end if; end if; end if; @@ -5186,8 +5219,6 @@ package body Exp_Ch4 is Desig_Typ := Obj_Typ; end if; - -- Kirtchev J730-020 - Desig_Typ := Base_Type (Desig_Typ); -- Generate: @@ -5261,7 +5292,7 @@ package body Exp_Ch4 is if Nkind (Context) /= N_Simple_Return_Statement then Insert_Action_After (Context, - Make_If_Statement (Loc, + Make_Implicit_If_Statement (Obj_Decl, Condition => Make_Op_Ne (Loc, Left_Opnd => New_Reference_To (Temp_Id, Loc), @@ -6729,8 +6760,6 @@ package body Exp_Ch4 is -- Node which is to be replaced by the result of concatenating the nodes -- in the list Opnds. - -- Kirtchev - begin -- Ensure validity of both operands @@ -11552,7 +11581,7 @@ package body Exp_Ch4 is Set_Has_Dereference_Action (Deref); Stmt := - Make_If_Statement (Loc, + Make_Implicit_If_Statement (N, Condition => Make_Function_Call (Loc, Name => diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 7a59c52efb3..7a1c4f5ecd7 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -1030,9 +1030,10 @@ begin elsif Main_Kind in N_Generic_Renaming_Declaration then Back_End_Mode := Generate_Object; - -- It's not an error to generate SCIL for e.g. a spec which has a body + -- It is not an error to analyze (in CodePeer or Alfa modes) a spec + -- which requires a body, when the body is not available. - elsif CodePeer_Mode then + elsif CodePeer_Mode or Alfa_Mode then Back_End_Mode := Generate_Object; -- In all other cases (specs which have bodies, generics, and bodies diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 506356b51a6..b8423f6fc69 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -7944,7 +7944,7 @@ preprocessing is triggered and parameterized. This switch indicates to the compiler the file name (without directory information) of the preprocessor data file to use. The preprocessor data file should be found in the source directories. Note that when the compiler is -called by a builder (@command{gnatmake} or @command{gprbuild}) with a project +called by a builder such as (@command{gnatmake} with a project file, if the object directory is not also a source directory, the builder needs to be called with @option{-x}. @@ -18518,8 +18518,8 @@ $ gnattest --harness-dir=driver -Psimple.gpr a test driver is created in directory "driver". It can be compiled and run: @smallexample -$ cd driver -$ gprbuild -Ptest_driver +$ cd obj/driver +$ gnatmake -Ptest_driver $ test_runner @end smallexample @@ -18584,8 +18584,8 @@ and body of function Dec in simple.ads and simple.adb, running @smallexample gnattest --harness-dir=driver -Psimple.gpr -cd driver -gprbuild -Ptest_driver +cd obj/driver +gnatmake -Ptest_driver test_runner @end smallexample @@ -18680,8 +18680,8 @@ seen by running the test driver generated for the second example. As previously mentioned, actual tests are already written for this example. @smallexample -cd driver -gprbuild -Ptest_driver +cd obj/driver +gnatmake -Ptest_driver test_runner @end smallexample @@ -18722,8 +18722,8 @@ of the type which have overriding primitives: @smallexample gnattest --harness-dir=driver --validate-type-extensions -Ptagged_rec.gpr -cd driver -gprbuild -Ptest_driver +cd obj/driver +gnatmake -Ptest_driver test_runner @end smallexample @@ -18771,8 +18771,8 @@ Assert (Sqrt (-5.0) = -1.0, "wrong error indication"); are acceptable: @smallexample -cd driver -gprbuild -Ptest_driver +cd obj/driver +gnatmake -Ptest_driver test_runner @end smallexample diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index 32ae8f66c5f..cb632ffe283 100644 --- a/gcc/ada/projects.texi +++ b/gcc/ada/projects.texi @@ -1,7 +1,7 @@ @set gprconfig GPRconfig @c ------ projects.texi -@c Copyright (C) 2002-2012, Free Software Foundation, Inc. +@c Copyright (C) 2002-2013, Free Software Foundation, Inc. @c This file is shared between the GNAT user's guide and gprbuild. It is not @c compilable on its own, you should instead compile the other two manuals. @c For that reason, there is no toplevel @menu @@ -3570,7 +3570,7 @@ Here are some examples of attribute declarations: @end smallexample @noindent -Attributes references may be appear anywhere in expressions, and are used +Attributes references may appear anywhere in expressions, and are used to retrieve the value previously assigned to the attribute. If an attribute has not been set in a given package or project, its value defaults to the empty string or the empty list. @@ -3721,7 +3721,7 @@ system (file). The text is between brackets ([]) if the index is optional. @item Required_Switches @tab list @tab Compiler,Binder,Linker @tab insensitive (language) @item Leading_Required_Switches @tab list @tab Compiler @tab insensitive (language) @item Trailing_Required_Switches @tab list @tab Compiler @tab insensitive (language) -@item Pic_Options @tab list @tab Compiler @tab insensitive (language) +@item Pic_Option @tab list @tab Compiler @tab insensitive (language) @item Path_Syntax @tab string @tab Compiler @tab insensitive (language) @item Object_File_Suffix @tab string @tab Compiler @tab insensitive (language) @item Object_File_Switches @tab list @tab Compiler @tab insensitive (language) @@ -3729,7 +3729,7 @@ system (file). The text is between brackets ([]) if the index is optional. @item Multi_Unit_Object_Separator @tab string @tab Compiler @tab insensitive (language) @item Mapping_File_Switches @tab list @tab Compiler @tab insensitive (language) @item Mapping_Spec_Suffix @tab string @tab Compiler @tab insensitive (language) -@item Mapping_body_Suffix @tab string @tab Compiler @tab insensitive (language) +@item Mapping_Body_Suffix @tab string @tab Compiler @tab insensitive (language) @item Config_File_Switches @tab list @tab Compiler @tab insensitive (language) @item Config_Body_File_Name @tab string @tab Compiler @tab insensitive (language) @item Config_Body_File_Name_Index @tab string @tab Compiler @tab insensitive (language) @@ -4654,7 +4654,7 @@ to use to communicate with the target in a cross-compilation environment, e.g.@: @code{"wtx"} or @code{"vxworks"}. @item Compiler_Command -This is an associative array attribute, whose domain is a language name. Its +This is an indexed attribute, whose domain is a language name. Its value is string that denotes the command to be used to invoke the compiler. The value of @code{Compiler_Command ("Ada")} is expected to be compatible with @command{gnatmake}, in particular in the handling of switches. @@ -4664,7 +4664,7 @@ This is simple attribute, Its value is a string that specifies the name of the debugger to be used, such as gdb, powerpc-wrs-vxworks-gdb or gdb-4. @item Default_Switches -This is an associative array attribute. Its indexes are the name of the +This is an indexed attribute. Its indexes are the name of the external tools that the GNAT Programming System (GPS) is supporting. Its value is a list of switches to use when invoking that tool. -- 2.30.2