From: charlet Date: Tue, 6 Sep 2011 10:43:17 +0000 (+0000) Subject: 2011-09-06 Yannick Moy X-Git-Tag: upstream/4.9.2~17891 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=cce84b09e105d119e21714d124766a8b3a8bfd8f;p=platform%2Fupstream%2Flinaro-gcc.git 2011-09-06 Yannick Moy * sem_ch13.adb (Analyze_Aspect_Specifications): Call Set_Corresponding_Aspect when creating pragma from aspect. (Add_Predicates): Use new field Corresponding_Aspect. * sem_prag.adb (Analyze_Pragma): Make Pname hold source aspect name when present, for the purpose of issuing error messages; remove local procedure Error_Pragma_Arg_Alternate_Name. * sinfo.adb, sinfo.ads (Corresponding_Aspect): New field in N_Pragma node. (From_Dynamic_Predicate, From_Static_Predicate): Remove fields from N_Pragma node. 2011-09-06 Robert Dewar * checks.adb, s-except.ads, g-socket.adb: Minor reformatting. 2011-09-06 Hristian Kirtchev * exp_ch6.adb (Build_Heap_Allocator): Add new local variable Desig_Typ. Code and comment reformatting. Add machinery to ensure that the allocation uses a fat pointer when the type of the return object is a constrained array and the function return type is an unconstrained array. 2011-09-06 Vincent Celier * make.adb, prj-part.adb, prj-nmsc.adb: Remove unused formal parameters in subprograms. 2011-09-06 Arnaud Charlet * s-taprop-mingw.adb (Finalize_TCB): Fix typo. 2011-09-06 Thomas Quinot * s-taprop-vxworks.adb, s-tpoaal.adb, s-tpopsp-vxworks.adb (System.Tasking.Primitive_Operations.Specific.Delete): Remove subprogram. (System.Tasking.Primitive_Operations.Specific.Set): If argument is null, destroy task specific data, to make API consistent with other platforms, and thus compatible with the shared version of s-tpoaal.adb. (System.Tasking.Primitive_Operations.ATCB_Allocation.Free_ATCB): Document the above assumption. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178583 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0b5216f..f39c314 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,49 @@ +2011-09-06 Yannick Moy + + * sem_ch13.adb (Analyze_Aspect_Specifications): Call + Set_Corresponding_Aspect when creating pragma from aspect. + (Add_Predicates): Use new field Corresponding_Aspect. + * sem_prag.adb (Analyze_Pragma): Make Pname hold source aspect + name when present, for the purpose of issuing error messages; + remove local procedure Error_Pragma_Arg_Alternate_Name. + * sinfo.adb, sinfo.ads (Corresponding_Aspect): New field in + N_Pragma node. + (From_Dynamic_Predicate, From_Static_Predicate): Remove fields from + N_Pragma node. + +2011-09-06 Robert Dewar + + * checks.adb, s-except.ads, g-socket.adb: Minor reformatting. + +2011-09-06 Hristian Kirtchev + + * exp_ch6.adb (Build_Heap_Allocator): Add new + local variable Desig_Typ. Code and comment reformatting. Add + machinery to ensure that the allocation uses a fat pointer when + the type of the return object is a constrained array and the + function return type is an unconstrained array. + +2011-09-06 Vincent Celier + + * make.adb, prj-part.adb, prj-nmsc.adb: Remove unused formal + parameters in subprograms. + +2011-09-06 Arnaud Charlet + + * s-taprop-mingw.adb (Finalize_TCB): Fix typo. + +2011-09-06 Thomas Quinot + + * s-taprop-vxworks.adb, s-tpoaal.adb, s-tpopsp-vxworks.adb + (System.Tasking.Primitive_Operations.Specific.Delete): Remove + subprogram. + (System.Tasking.Primitive_Operations.Specific.Set): If argument + is null, destroy task specific data, to make API consistent with + other platforms, and thus compatible with the shared version + of s-tpoaal.adb. + (System.Tasking.Primitive_Operations.ATCB_Allocation.Free_ATCB): + Document the above assumption. + 2011-09-06 Ed Schonberg * exp_ch6.adb (Expand_Inlined_Call): Fix use of uninitialized diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 336b144..0d2322a 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -1877,6 +1877,7 @@ package body Checks is if Is_Subscr_Ref then Arr := Prefix (Parnt); Arr_Typ := Get_Actual_Subtype_If_Available (Arr); + if Is_Access_Type (Arr_Typ) then Arr_Typ := Directly_Designated_Type (Arr_Typ); end if; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index b300389..8955e5d 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -4651,10 +4651,10 @@ package body Exp_Ch6 is Build_In_Place_Formal (Func_Id, BIP_Finalization_Master); Stmts : constant List_Id := New_List; - - Local_Id : Entity_Id; - Pool_Id : Entity_Id; - Ptr_Typ : Entity_Id; + Desig_Typ : Entity_Id; + Local_Id : Entity_Id; + Pool_Id : Entity_Id; + Ptr_Typ : Entity_Id; begin -- Generate: @@ -4684,8 +4684,19 @@ package body Exp_Ch6 is -- of the temporary. Otherwise the secondary stack allocation -- will fail. + Desig_Typ := Ret_Typ; + + -- Ensure that the build-in-place machinery uses a fat pointer + -- when allocating an unconstrained array on the heap. In this + -- case the result object type is a constrained array type even + -- though the function type is unconstrained. + + if Ekind (Desig_Typ) = E_Array_Subtype then + Desig_Typ := Base_Type (Desig_Typ); + end if; + -- Generate: - -- type Ptr_Typ is access Ret_Typ; + -- type Ptr_Typ is access Desig_Typ; Ptr_Typ := Make_Temporary (Loc, 'P'); @@ -4695,7 +4706,7 @@ package body Exp_Ch6 is Type_Definition => Make_Access_To_Object_Definition (Loc, Subtype_Indication => - New_Reference_To (Ret_Typ, Loc)))); + New_Reference_To (Desig_Typ, Loc)))); -- Perform minor decoration in order to set the master and the -- storage pool attributes. diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index 59e63bd..bf1fe9f 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -474,6 +474,7 @@ package body GNAT.Sockets is procedure Check_For_Fd_Set (Fd : Socket_Type) is use SOSC; + begin -- On Windows, fd_set is a FD_SETSIZE array of socket ids: -- no check required. Warnings suppressed because condition diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 13777bb..bf6a21a 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -608,8 +608,6 @@ package body Make is procedure Compute_Switches_For_Main (Main_Source_File : in out File_Name_Type; - Main_Index : Int; - Project_Node_Tree : Project_Node_Tree_Ref; Root_Environment : in out Prj.Tree.Environment; Compute_Builder : Boolean; Current_Work_Dir : String); @@ -744,10 +742,8 @@ package body Make is procedure Add_Switches (The_Package : Package_Id; File_Name : String; - Index : Int; Program : Make_Program_Type; Unknown_Switches_To_The_Compiler : Boolean := True; - Project_Node_Tree : Project_Node_Tree_Ref; Env : in out Prj.Tree.Environment); procedure Add_Switch (S : String_Access; @@ -769,7 +765,6 @@ package body Make is procedure Check (Source_File : File_Name_Type; - Source_Index : Int; Is_Main_Source : Boolean; The_Args : Argument_List; Lib_File : File_Name_Type; @@ -1276,10 +1271,8 @@ package body Make is procedure Add_Switches (The_Package : Package_Id; File_Name : String; - Index : Int; Program : Make_Program_Type; Unknown_Switches_To_The_Compiler : Boolean := True; - Project_Node_Tree : Project_Node_Tree_Ref; Env : in out Prj.Tree.Environment) is Switches : Variable_Value; @@ -1445,7 +1438,6 @@ package body Make is procedure Check (Source_File : File_Name_Type; - Source_Index : Int; Is_Main_Source : Boolean; The_Args : Argument_List; Lib_File : File_Name_Type; @@ -3445,7 +3437,6 @@ package body Make is if not Force_Compilations then Check (Source_File => Source.File, - Source_Index => Source.Index, Is_Main_Source => Source.File = Main_Source, The_Args => Args, Lib_File => Lib_File, @@ -5206,8 +5197,6 @@ package body Make is procedure Compute_Switches_For_Main (Main_Source_File : in out File_Name_Type; - Main_Index : Int; - Project_Node_Tree : Project_Node_Tree_Ref; Root_Environment : in out Prj.Tree.Environment; Compute_Builder : Boolean; Current_Work_Dir : String) @@ -5349,10 +5338,8 @@ package body Make is end if; Add_Switches - (Project_Node_Tree => Project_Node_Tree, - Env => Root_Environment, + (Env => Root_Environment, File_Name => Main_Unit_File_Name, - Index => Main_Index, The_Package => Binder_Package, Program => Binder); end if; @@ -5367,10 +5354,8 @@ package body Make is end if; Add_Switches - (Project_Node_Tree => Project_Node_Tree, - Env => Root_Environment, + (Env => Root_Environment, File_Name => Main_Unit_File_Name, - Index => Main_Index, The_Package => Linker_Package, Program => Linker); end if; @@ -6029,8 +6014,6 @@ package body Make is Compute_Switches_For_Main (Main_Source_File, - Main_Index, - Project_Node_Tree, Root_Environment, Compute_Builder => Is_First_Main, Current_Work_Dir => Current_Work_Dir.all); diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 9ebd300..e7d9c5a 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -426,8 +426,7 @@ package body Prj.Nmsc is Naming : Lang_Naming_Data; Kind : out Source_Kind; Unit : out Name_Id; - Project : Project_Processing_Data; - In_Tree : Project_Tree_Ref); + Project : Project_Processing_Data); -- Check whether the file matches the naming scheme. If it does, -- compute its unit name. If Unit is set to No_Name on exit, none of the -- other out parameters are relevant. @@ -5627,8 +5626,7 @@ package body Prj.Nmsc is Naming : Lang_Naming_Data; Kind : out Source_Kind; Unit : out Name_Id; - Project : Project_Processing_Data; - In_Tree : Project_Tree_Ref) + Project : Project_Processing_Data) is Filename : constant String := Get_Name_String (File_Name); Last : Integer := Filename'Last; @@ -6724,8 +6722,7 @@ package body Prj.Nmsc is Naming => Config.Naming_Data, Kind => Kind, Unit => Unit, - Project => Project, - In_Tree => In_Tree); + Project => Project); if Unit /= No_Name then Language := Tmp_Lang; diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index 3b07a80..1c18680 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -215,7 +215,6 @@ package body Prj.Part is Imported_Projects : in out Project_Node_Id; Project_Directory : Path_Name_Type; From_Extended : Extension_Origin; - In_Limited : Boolean; Packages_To_Check : String_List_Access; Depth : Natural; Current_Dir : String; @@ -752,7 +751,6 @@ package body Prj.Part is Imported_Projects : in out Project_Node_Id; Project_Directory : Path_Name_Type; From_Extended : Extension_Origin; - In_Limited : Boolean; Packages_To_Check : String_List_Access; Depth : Natural; Current_Dir : String; @@ -1503,7 +1501,6 @@ package body Prj.Part is Imported_Projects => Imported_Projects, Project_Directory => Project_Directory, From_Extended => From_Ext, - In_Limited => In_Limited, Packages_To_Check => Packages_To_Check, Depth => Depth + 1, Current_Dir => Current_Dir, @@ -1863,7 +1860,6 @@ package body Prj.Part is Imported_Projects => Imported_Projects, Project_Directory => Project_Directory, From_Extended => From_Ext, - In_Limited => In_Limited, Packages_To_Check => Packages_To_Check, Depth => Depth + 1, Current_Dir => Current_Dir, diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb index d26568f..7fc505e 100644 --- a/gcc/ada/s-taprop-mingw.adb +++ b/gcc/ada/s-taprop-mingw.adb @@ -997,7 +997,7 @@ package body System.Task_Primitives.Operations is Known_Tasks (T.Known_Tasks_Index) := null; end if; - if Self_ID.Common.LL.Thread /= 0 then + if T.Common.LL.Thread /= 0 then -- This task has been activated. Wait for the thread to terminate -- then close it. This is needed to release system resources. diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index 6b3c35e..be76162 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.adb @@ -124,11 +124,8 @@ package body System.Task_Primitives.Operations is procedure Set (Self_Id : Task_Id); pragma Inline (Set); - -- Set the self id for the current task - - procedure Delete; - pragma Inline (Delete); - -- Delete the task specific data associated with the current task + -- Set the self id for the current task, unless Self_Id is null, in + -- which case the task specific data is deleted. function Self return Task_Id; pragma Inline (Self); diff --git a/gcc/ada/s-tpoaal.adb b/gcc/ada/s-tpoaal.adb index 0e79f45..1d25fb8 100644 --- a/gcc/ada/s-tpoaal.adb +++ b/gcc/ada/s-tpoaal.adb @@ -59,6 +59,10 @@ package body ATCB_Allocation is Specific.Set (Local_ATCB'Unchecked_Access); Free (Tmp); + + -- Note: it is assumed here that for all platforms, Specific.Set + -- deletes the task specific information if passed a null value. + Specific.Set (null); end; diff --git a/gcc/ada/s-tpopsp-vxworks.adb b/gcc/ada/s-tpopsp-vxworks.adb index 64bf10c..09c03ef 100644 --- a/gcc/ada/s-tpopsp-vxworks.adb +++ b/gcc/ada/s-tpopsp-vxworks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- -- -- -- GNARL is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -44,17 +44,6 @@ package body Specific is -- implementation. This mechanism is used to minimize impact on other -- targets. - ------------ - -- Delete -- - ------------ - - procedure Delete is - Result : STATUS; - begin - Result := taskVarDelete (taskIdSelf, ATCB_Key'Access); - pragma Assert (Result /= ERROR); - end Delete; - ---------------- -- Initialize -- ---------------- @@ -81,6 +70,14 @@ package body Specific is Result : STATUS; begin + -- If Self_Id is null, delete task specific data + + if Self_Id = null then + Result := taskVarDelete (taskIdSelf, ATCB_Key'Access); + pragma Assert (Result /= ERROR); + return; + end if; + if taskVarGet (0, ATCB_Key'Access) = ERROR then Result := taskVarAdd (0, ATCB_Key'Access); pragma Assert (Result = OK); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 2655b25..f5b52d0 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1146,6 +1146,7 @@ package body Sem_Ch13 is New_List (Ent, Relocate_Node (Expr))); Set_From_Aspect_Specification (Aitem, True); + Set_Corresponding_Aspect (Aitem, Aspect); pragma Assert (not Delay_Required); @@ -1181,6 +1182,7 @@ package body Sem_Ch13 is Expression => Relocate_Node (Expr)))); Set_From_Aspect_Specification (Aitem, True); + Set_Corresponding_Aspect (Aitem, Aspect); pragma Assert (not Delay_Required); end; @@ -1259,6 +1261,7 @@ package body Sem_Ch13 is end if; Set_From_Aspect_Specification (Aitem, True); + Set_Corresponding_Aspect (Aitem, Aspect); Set_Is_Delayed_Aspect (Aspect); -- For Pre/Post cases, insert immediately after the entity @@ -1316,6 +1319,7 @@ package body Sem_Ch13 is end if; Set_From_Aspect_Specification (Aitem, True); + Set_Corresponding_Aspect (Aitem, Aspect); Set_Is_Delayed_Aspect (Aspect); -- For Invariant case, insert immediately after the entity @@ -1345,14 +1349,7 @@ package body Sem_Ch13 is Make_Identifier (Sloc (Id), Name_Predicate)); Set_From_Aspect_Specification (Aitem, True); - - -- Set special flags for dynamic/static cases - - if A_Id = Aspect_Dynamic_Predicate then - Set_From_Dynamic_Predicate (Aitem); - elsif A_Id = Aspect_Static_Predicate then - Set_From_Static_Predicate (Aitem); - end if; + Set_Corresponding_Aspect (Aitem, Aspect); -- Make sure we have a freeze node (it might otherwise be -- missing in cases like subtype X is Y, and we would not @@ -1426,6 +1423,7 @@ package body Sem_Ch13 is Args); Set_From_Aspect_Specification (Aitem, True); + Set_Corresponding_Aspect (Aitem, Aspect); Set_Is_Delayed_Aspect (Aspect); -- Insert immediately after the entity declaration @@ -1444,6 +1442,11 @@ package body Sem_Ch13 is if Delay_Required then if Present (Aitem) then Set_From_Aspect_Specification (Aitem, True); + + if Nkind (Aitem) = N_Pragma then + Set_Corresponding_Aspect (Aitem, Aspect); + end if; + Set_Is_Delayed_Aspect (Aitem); Set_Aspect_Rep_Item (Aspect, Aitem); end if; @@ -1457,6 +1460,10 @@ package body Sem_Ch13 is else Set_From_Aspect_Specification (Aitem, True); + if Nkind (Aitem) = N_Pragma then + Set_Corresponding_Aspect (Aitem, Aspect); + end if; + -- If this is a compilation unit, we will put the pragma in -- the Pragmas_After list of the N_Compilation_Unit_Aux node. @@ -4734,10 +4741,15 @@ package body Sem_Ch13 is if Nkind (Ritem) = N_Pragma and then Pragma_Name (Ritem) = Name_Predicate then - if From_Dynamic_Predicate (Ritem) then - Dynamic_Predicate_Present := True; - elsif From_Static_Predicate (Ritem) then - Static_Predicate_Present := Ritem; + if Present (Corresponding_Aspect (Ritem)) then + case Chars (Identifier (Corresponding_Aspect (Ritem))) is + when Name_Dynamic_Predicate => + Dynamic_Predicate_Present := True; + when Name_Static_Predicate => + Static_Predicate_Present := Ritem; + when others => + null; + end case; end if; -- Acquire arguments diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 2ca9417..e3db807 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -29,65 +29,63 @@ -- to complete the syntax checks. Certain pragmas are handled partially or -- completely by the parser (see Par.Prag for further details). -with System.Case_Util; - -with Atree; use Atree; -with Casing; use Casing; -with Checks; use Checks; -with Csets; use Csets; -with Debug; use Debug; -with Einfo; use Einfo; -with Elists; use Elists; -with Errout; use Errout; -with Exp_Dist; use Exp_Dist; -with Exp_Util; use Exp_Util; -with Freeze; use Freeze; -with Lib; use Lib; -with Lib.Writ; use Lib.Writ; -with Lib.Xref; use Lib.Xref; -with Namet.Sp; use Namet.Sp; -with Nlists; use Nlists; -with Nmake; use Nmake; -with Opt; use Opt; -with Output; use Output; -with Par_SCO; use Par_SCO; -with Restrict; use Restrict; -with Rident; use Rident; -with Rtsfind; use Rtsfind; -with Sem; use Sem; -with Sem_Aux; use Sem_Aux; -with Sem_Ch3; use Sem_Ch3; -with Sem_Ch6; use Sem_Ch6; -with Sem_Ch8; use Sem_Ch8; -with Sem_Ch12; use Sem_Ch12; -with Sem_Ch13; use Sem_Ch13; -with Sem_Disp; use Sem_Disp; -with Sem_Dist; use Sem_Dist; -with Sem_Elim; use Sem_Elim; -with Sem_Eval; use Sem_Eval; -with Sem_Intr; use Sem_Intr; -with Sem_Mech; use Sem_Mech; -with Sem_Res; use Sem_Res; -with Sem_Type; use Sem_Type; -with Sem_Util; use Sem_Util; -with Sem_VFpt; use Sem_VFpt; -with Sem_Warn; use Sem_Warn; -with Stand; use Stand; -with Sinfo; use Sinfo; -with Sinfo.CN; use Sinfo.CN; -with Sinput; use Sinput; -with Snames; use Snames; -with Stringt; use Stringt; -with Stylesw; use Stylesw; +with Atree; use Atree; +with Casing; use Casing; +with Checks; use Checks; +with Csets; use Csets; +with Debug; use Debug; +with Einfo; use Einfo; +with Elists; use Elists; +with Errout; use Errout; +with Exp_Dist; use Exp_Dist; +with Exp_Util; use Exp_Util; +with Freeze; use Freeze; +with Lib; use Lib; +with Lib.Writ; use Lib.Writ; +with Lib.Xref; use Lib.Xref; +with Namet.Sp; use Namet.Sp; +with Nlists; use Nlists; +with Nmake; use Nmake; +with Opt; use Opt; +with Output; use Output; +with Par_SCO; use Par_SCO; +with Restrict; use Restrict; +with Rident; use Rident; +with Rtsfind; use Rtsfind; +with Sem; use Sem; +with Sem_Aux; use Sem_Aux; +with Sem_Ch3; use Sem_Ch3; +with Sem_Ch6; use Sem_Ch6; +with Sem_Ch8; use Sem_Ch8; +with Sem_Ch12; use Sem_Ch12; +with Sem_Ch13; use Sem_Ch13; +with Sem_Disp; use Sem_Disp; +with Sem_Dist; use Sem_Dist; +with Sem_Elim; use Sem_Elim; +with Sem_Eval; use Sem_Eval; +with Sem_Intr; use Sem_Intr; +with Sem_Mech; use Sem_Mech; +with Sem_Res; use Sem_Res; +with Sem_Type; use Sem_Type; +with Sem_Util; use Sem_Util; +with Sem_VFpt; use Sem_VFpt; +with Sem_Warn; use Sem_Warn; +with Stand; use Stand; +with Sinfo; use Sinfo; +with Sinfo.CN; use Sinfo.CN; +with Sinput; use Sinput; +with Snames; use Snames; +with Stringt; use Stringt; +with Stylesw; use Stylesw; with Table; -with Targparm; use Targparm; -with Tbuild; use Tbuild; +with Targparm; use Targparm; +with Tbuild; use Tbuild; with Ttypes; -with Uintp; use Uintp; -with Uname; use Uname; -with Urealp; use Urealp; -with Validsw; use Validsw; -with Warnsw; use Warnsw; +with Uintp; use Uintp; +with Uname; use Uname; +with Urealp; use Urealp; +with Validsw; use Validsw; +with Warnsw; use Warnsw; package body Sem_Prag is @@ -374,9 +372,13 @@ package body Sem_Prag is procedure Analyze_Pragma (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); - Pname : constant Name_Id := Pragma_Name (N); Prag_Id : Pragma_Id; + Pname : Name_Id; + -- Name of the source pragma, or name of the corresponding aspect for + -- pragmas which originate in a source aspect. In the latter case, the + -- name may be different from the pragma name. + Pragma_Exit : exception; -- This exception is used to exit pragma processing completely. It is -- used when an error is detected, and no further processing is @@ -648,17 +650,6 @@ package body Sem_Prag is -- Similar to above form of Error_Pragma_Arg except that two messages -- are provided, the second is a continuation comment starting with \. - procedure Error_Pragma_Arg_Alternate_Name - (Msg : String; - Arg : Node_Id; - Alt_Name : Name_Id); - pragma No_Return (Error_Pragma_Arg_Alternate_Name); - -- Outputs error message for current pragma, similar to - -- Error_Pragma_Arg, except the source name of the aspect/pragma to use - -- in warnings may be equal to Alt_Name (which should be equivalent to - -- the name used in pragma). The location for the source name should be - -- pointed to by Arg. - procedure Error_Pragma_Arg_Ident (Msg : String; Arg : Node_Id); pragma No_Return (Error_Pragma_Arg_Ident); -- Outputs error message for current pragma. The message may contain @@ -2440,34 +2431,6 @@ package body Sem_Prag is Error_Pragma_Arg (Msg2, Arg); end Error_Pragma_Arg; - ------------------------------------- - -- Error_Pragma_Arg_Alternate_Name -- - ------------------------------------- - - procedure Error_Pragma_Arg_Alternate_Name - (Msg : String; - Arg : Node_Id; - Alt_Name : Name_Id) - is - MsgF : String := Msg; - Source_Name : String := Exact_Source_Name (Sloc (Arg)); - Alter_Name : String := Get_Name_String (Alt_Name); - - begin - System.Case_Util.To_Lower (Source_Name); - System.Case_Util.To_Lower (Alter_Name); - - if Source_Name = Alter_Name then - Error_Msg_Name_1 := Alt_Name; - else - Error_Msg_Name_1 := Pname; - end if; - - Fix_Error (MsgF); - Error_Msg_N (MsgF, Get_Pragma_Arg (Arg)); - raise Pragma_Exit; - end Error_Pragma_Arg_Alternate_Name; - ---------------------------- -- Error_Pragma_Arg_Ident -- ---------------------------- @@ -6212,6 +6175,8 @@ package body Sem_Prag is -- Deal with unrecognized pragma + Pname := Pragma_Name (N); + if not Is_Pragma_Name (Pname) then if Warn_On_Unrecognized_Pragma then Error_Msg_Name_1 := Pname; @@ -6234,6 +6199,10 @@ package body Sem_Prag is Prag_Id := Get_Pragma_Id (Pname); + if Present (Corresponding_Aspect (N)) then + Pname := Chars (Identifier (Corresponding_Aspect (N))); + end if; + -- Preset arguments Arg_Count := 0; @@ -10182,15 +10151,13 @@ package body Sem_Prag is null; elsif In_Private_Part (Current_Scope) then - Error_Pragma_Arg_Alternate_Name + Error_Pragma_Arg ("pragma% only allowed for private type " & - "declared in visible part", Arg1, - Alt_Name => Name_Type_Invariant); + "declared in visible part", Arg1); else - Error_Pragma_Arg_Alternate_Name - ("pragma% only allowed for private type", Arg1, - Alt_Name => Name_Type_Invariant); + Error_Pragma_Arg + ("pragma% only allowed for private type", Arg1); end if; -- Note that the type has at least one invariant, and also that diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 32d9938..7543347 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -590,6 +590,14 @@ package body Sinfo is return Flag14 (N); end Conversion_OK; + function Corresponding_Aspect + (N : Node_Id) return Node_Id is + begin + pragma Assert (False + or else NT (N).Nkind = N_Pragma); + return Node3 (N); + end Corresponding_Aspect; + function Corresponding_Body (N : Node_Id) return Node_Id is begin @@ -1337,22 +1345,6 @@ package body Sinfo is return Flag6 (N); end From_Default; - function From_Dynamic_Predicate - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return Flag7 (N); - end From_Dynamic_Predicate; - - function From_Static_Predicate - (N : Node_Id) return Boolean is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - return Flag8 (N); - end From_Static_Predicate; - function Generic_Associations (N : Node_Id) return List_Id is begin @@ -3658,6 +3650,14 @@ package body Sinfo is Set_Flag14 (N, Val); end Set_Conversion_OK; + procedure Set_Corresponding_Aspect + (N : Node_Id; Val : Node_Id) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Pragma); + Set_Node3 (N, Val); + end Set_Corresponding_Aspect; + procedure Set_Corresponding_Body (N : Node_Id; Val : Node_Id) is begin @@ -4396,22 +4396,6 @@ package body Sinfo is Set_Flag6 (N, Val); end Set_From_Default; - procedure Set_From_Dynamic_Predicate - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_Flag7 (N, Val); - end Set_From_Dynamic_Predicate; - - procedure Set_From_Static_Predicate - (N : Node_Id; Val : Boolean := True) is - begin - pragma Assert (False - or else NT (N).Nkind = N_Pragma); - Set_Flag8 (N, Val); - end Set_From_Static_Predicate; - procedure Set_Generic_Associations (N : Node_Id; Val : List_Id) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 203d186..4e239b8 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -717,6 +717,10 @@ package Sinfo is -- direct conversion of the underlying integer result, with no regard to -- the small operand. + -- Corresponding_Aspect (Node3-Sem) + -- Present in N_Pragma node. Used to point back to the source aspect from + -- the corresponding pragma. This field is Empty for source pragmas. + -- Corresponding_Body (Node5-Sem) -- This field is set in subprogram declarations, package declarations, -- entry declarations of protected types, and in generic units. It points @@ -1076,14 +1080,6 @@ package Sinfo is -- declaration is treated as an implicit reference to the formal in the -- ali file. - -- From_Dynamic_Predicate (Flag7-Sem) - -- Set for generated pragma Predicate node if this is generated by a - -- Dynamic_Predicate aspect. - - -- From_Static_Predicate (Flag8-Sem) - -- Set for generated pragma Predicate node if this is generated by a - -- Static_Predicate aspect. - -- Generic_Parent (Node5-Sem) -- Generic_Parent is defined on declaration nodes that are instances. The -- value of Generic_Parent is the generic entity from which the instance @@ -2063,6 +2059,7 @@ package Sinfo is -- Sloc points to PRAGMA -- Next_Pragma (Node1-Sem) -- Pragma_Argument_Associations (List2) (set to No_List if none) + -- Corresponding_Aspect (Node3-Sem) (set to Empty if not present) -- Pragma_Identifier (Node4) -- Next_Rep_Item (Node5-Sem) -- From_Aspect_Specification (Flag13-Sem) @@ -2070,8 +2067,6 @@ package Sinfo is -- Import_Interface_Present (Flag16-Sem) -- Split_PPC (Flag17) set if corresponding aspect had Split_PPC set -- Class_Present (Flag6) set if from Aspect with 'Class - -- From_Dynamic_Predicate (Flag7-Sem) Set if Dynamic_Predicate aspect - -- From_Static_Predicate (Flag8-Sem) Set if Static_Predicate aspect -- Note: we should have a section on what pragmas are passed on to -- the back end to be processed. This section should note that pragma @@ -8242,6 +8237,9 @@ package Sinfo is function Conversion_OK (N : Node_Id) return Boolean; -- Flag14 + function Corresponding_Aspect + (N : Node_Id) return Node_Id; -- Node3 + function Corresponding_Body (N : Node_Id) return Node_Id; -- Node5 @@ -8464,12 +8462,6 @@ package Sinfo is function From_Default (N : Node_Id) return Boolean; -- Flag6 - function From_Dynamic_Predicate - (N : Node_Id) return Boolean; -- Flag7 - - function From_Static_Predicate - (N : Node_Id) return Boolean; -- Flag8 - function Generic_Associations (N : Node_Id) return List_Id; -- List3 @@ -9220,6 +9212,9 @@ package Sinfo is procedure Set_Conversion_OK (N : Node_Id; Val : Boolean := True); -- Flag14 + procedure Set_Corresponding_Aspect + (N : Node_Id; Val : Node_Id); -- Node3 + procedure Set_Corresponding_Body (N : Node_Id; Val : Node_Id); -- Node5 @@ -9439,12 +9434,6 @@ package Sinfo is procedure Set_From_Default (N : Node_Id; Val : Boolean := True); -- Flag6 - procedure Set_From_Dynamic_Predicate - (N : Node_Id; Val : Boolean := True); -- Flag7 - - procedure Set_From_Static_Predicate - (N : Node_Id; Val : Boolean := True); -- Flag8 - procedure Set_Generic_Associations (N : Node_Id; Val : List_Id); -- List3 @@ -11813,6 +11802,7 @@ package Sinfo is pragma Inline (Context_Pending); pragma Inline (Controlling_Argument); pragma Inline (Conversion_OK); + pragma Inline (Corresponding_Aspect); pragma Inline (Corresponding_Body); pragma Inline (Corresponding_Formal_Spec); pragma Inline (Corresponding_Generic_Association); @@ -11887,8 +11877,6 @@ package Sinfo is pragma Inline (From_At_End); pragma Inline (From_At_Mod); pragma Inline (From_Default); - pragma Inline (From_Dynamic_Predicate); - pragma Inline (From_Static_Predicate); pragma Inline (Generic_Associations); pragma Inline (Generic_Formal_Declarations); pragma Inline (Generic_Parent); @@ -12136,6 +12124,7 @@ package Sinfo is pragma Inline (Set_Context_Pending); pragma Inline (Set_Controlling_Argument); pragma Inline (Set_Conversion_OK); + pragma Inline (Set_Corresponding_Aspect); pragma Inline (Set_Corresponding_Body); pragma Inline (Set_Corresponding_Formal_Spec); pragma Inline (Set_Corresponding_Generic_Association); @@ -12209,8 +12198,6 @@ package Sinfo is pragma Inline (Set_From_At_End); pragma Inline (Set_From_At_Mod); pragma Inline (Set_From_Default); - pragma Inline (Set_From_Dynamic_Predicate); - pragma Inline (Set_From_Static_Predicate); pragma Inline (Set_Generic_Associations); pragma Inline (Set_Generic_Formal_Declarations); pragma Inline (Set_Generic_Parent);