diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 41 | ||||
| -rw-r--r-- | gcc/ada/alfa.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/debug.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/errout.ads | 9 | ||||
| -rw-r--r-- | gcc/ada/get_alfa.adb | 30 | ||||
| -rw-r--r-- | gcc/ada/hostparm.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/lib-xref-alfa.adb | 23 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 20 | ||||
| -rw-r--r-- | gcc/ada/put_alfa.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/sem_elab.adb | 131 | ||||
| -rw-r--r-- | gcc/ada/sem_elab.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/switch-c.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/switch.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/usage.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/vms_data.ads | 20 |
18 files changed, 274 insertions, 100 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1617c1a..9fa56eb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,44 @@ +2012-03-15 Robert Dewar <dewar@adacore.com> + + * errout.ads: Add entry for translating -gnateinn to + /MAX_INSTANTIATIONS for VMS. + * hostparm.ads (Max_Instantiations): Moved to Opt. + * opt.ads (Maximum_Instantiations): Moved from Hostparm, and renamed. + * sem_ch12.adb (Maximum_Instantiations): New name of + Max_Instantiations (Analyze_Package_Instantiation): Change error + msg for too many instantiations (mention -gnateinn switch). + * switch-c.adb (Scan_Front_End_Switches): Implement -gnateinn switch. + * switch.ads: Minor comment update. + * usage.adb (Usage): Output line for -maxeinn switch. + * vms_data.ads: Add entry for MAX_INSTANTIATIONS (-gnateinn). + +2012-03-15 Yannick Moy <moy@adacore.com> + + * alfa.ads Update the decription of ALI sections. + (Alfa_File_Record): Add a component Unit_File_Name to store the + unit file name for subunits. + * get_alfa.adb, put_alfa.adb Adapt to the possible presence of + a unit file name. + * lib-xref-alfa.adb (Add_Alfa_File): For subunits, retrieve the + file name of the unit. + +2012-03-15 Yannick Moy <moy@adacore.com> + + * sem_ch6.adb (Check_Subprogram_Contract): Do + not issue warning on missing 'Result in postcondition if all + postconditions and contract-cases already get a warning for only + referring to pre-state. + +2012-03-15 Bob Duff <duff@adacore.com> + + * debug.adb: Add new debug switch -gnatd.U, which disables the + support added below, in case someone trips over a cycle, and needs + to disable this. + * sem_attr.adb (Analyze_Access_Attribute): + Treat Subp'Access as a call for elaboration purposes. + * sem_elab.ads, sem_elab.adb (Check_Elab_Call): Add support + for Subp'Access. + 2012-03-15 Vincent Pucci <pucci@adacore.com> * sem.ads, sem.adb (Preanalyze): New routine. diff --git a/gcc/ada/alfa.ads b/gcc/ada/alfa.ads index 7531f9e..26c8247 100644 --- a/gcc/ada/alfa.ads +++ b/gcc/ada/alfa.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2011-2012, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- @@ -70,7 +70,7 @@ package Alfa is -- subprogram declaration and body, when both present, define two different -- scopes. - -- FD dependency-number filename + -- FD dependency-number filename (-> unit-filename)? -- This header precedes scope information for the unit identified by -- dependency number and file name. The dependency number is the index @@ -89,6 +89,8 @@ package Alfa is -- reading of the Alfa information, and means that the Alfa information -- can stand on its own without needing other parts of the ALI file. + -- The optional unit filename is given only for subunits. + -- FS . scope line type col entity (-> spec-file . spec-scope)? -- (The ? mark stands for an optional entry in the syntax) @@ -314,6 +316,10 @@ package Alfa is File_Name : String_Ptr; -- Pointer to file name in ALI file + Unit_File_Name : String_Ptr; + -- Pointer to file name for unit in ALI file, when File_Name refers to a + -- subunit. Otherwise null. + File_Num : Nat; -- Dependency number in ALI file diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 3fd2d64..a420704 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -138,7 +138,7 @@ package body Debug is -- d.R -- d.S Force Optimize_Alignment (Space) -- d.T Force Optimize_Alignment (Time) - -- d.U + -- d.U Ignore indirect calls for static elaboration -- d.V -- d.W Print out debugging information for Walk_Library_Items -- d.X Use Expression_With_Actions @@ -642,6 +642,12 @@ package body Debug is -- d.T Force Optimize_Alignment (Time) mode as the default + -- d.U Ignore indirect calls for static elaboration. The static + -- elaboration model is conservative, especially regarding indirect + -- calls. If you say Proc'Access, it will assume you might call + -- Proc. This can cause elaboration cycles at bind time. This flag + -- reverts to the behavior of earlier compilers. + -- d.W Print out debugging information for Walk_Library_Items, including -- the order in which units are walked. This is primarily for use in -- debugging CodePeer mode. diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index dc444f0..13ce3ac4 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -380,6 +380,9 @@ package Errout is Gname8 : aliased constant String := "gnat2012"; Vname8 : aliased constant String := "2012"; + Gname9 : aliased constant String := "gnateinn"; + Vname9 : aliased constant String := "MAX_INSTANTIATIONS=nn"; + type Cstring_Ptr is access constant String; Gnames : array (Nat range <>) of Cstring_Ptr := @@ -390,7 +393,8 @@ package Errout is Gname5'Access, Gname6'Access, Gname7'Access, - Gname8'Access); + Gname8'Access, + Gname9'Access); Vnames : array (Nat range <>) of Cstring_Ptr := (Vname1'Access, @@ -400,7 +404,8 @@ package Errout is Vname5'Access, Vname6'Access, Vname7'Access, - Vname8'Access); + Vname8'Access, + Vname9'Access); ----------------------------------------------------- -- Global Values Used for Error Message Insertions -- diff --git a/gcc/ada/get_alfa.adb b/gcc/ada/get_alfa.adb index 8c90f75..a10637c 100644 --- a/gcc/ada/get_alfa.adb +++ b/gcc/ada/get_alfa.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2011-2012, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- @@ -51,6 +51,9 @@ procedure Get_Alfa is -- Local string used to store name of File/entity scanned as -- Name_Str (1 .. Name_Len). + File_Name : String_Ptr; + Unit_File_Name : String_Ptr; + ----------------------- -- Local Subprograms -- ----------------------- @@ -236,15 +239,32 @@ begin Skip_Spaces; Cur_File := Get_Nat; Skip_Spaces; + Get_Name; + File_Name := new String'(Name_Str (1 .. Name_Len)); + Skip_Spaces; + + -- Scan out unit file name when present (for subunits) + + if Nextc = '-' then + Skipc; + Check ('>'); + Skip_Spaces; + Get_Name; + Unit_File_Name := new String'(Name_Str (1 .. Name_Len)); + + else + Unit_File_Name := null; + end if; -- Make new File table entry (will fill in To_Scope later) Alfa_File_Table.Append ( - (File_Name => new String'(Name_Str (1 .. Name_Len)), - File_Num => Cur_File, - From_Scope => Alfa_Scope_Table.Last + 1, - To_Scope => 0)); + (File_Name => File_Name, + Unit_File_Name => Unit_File_Name, + File_Num => Cur_File, + From_Scope => Alfa_Scope_Table.Last + 1, + To_Scope => 0)); -- Initialize counter for scopes diff --git a/gcc/ada/hostparm.ads b/gcc/ada/hostparm.ads index 67a7f1d..ebecd5c 100644 --- a/gcc/ada/hostparm.ads +++ b/gcc/ada/hostparm.ads @@ -69,11 +69,6 @@ package Hostparm is -- of file names in the library, must be at least Max_Line_Length, but -- can be larger. - Max_Instantiations : constant := 8000; - -- Maximum number of instantiations permitted (to stop runaway cases - -- of nested instantiations). These situations probably only occur in - -- specially concocted test cases. - Tag_Errors : constant Boolean := False; -- If set to true, then brief form error messages will be prefaced by -- the string "error:". Used as default for Opt.Unique_Error_Tag. diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb index cc0aa3a..c1c6b25 100644 --- a/gcc/ada/lib-xref-alfa.adb +++ b/gcc/ada/lib-xref-alfa.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2011-2012, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- @@ -214,6 +214,8 @@ package body Alfa is S : constant Source_File_Index := Source_Index (U); + File_Name, Unit_File_Name : String_Ptr; + begin -- Source file could be inexistant as a result of an error, if option -- gnatQ is used. @@ -275,12 +277,23 @@ package body Alfa is -- Make entry for new file in file table Get_Name_String (Reference_Name (S)); + File_Name := new String'(Name_Buffer (1 .. Name_Len)); + + -- For subunits, also retrieve the file name of the unit + + if Present (Cunit (Unit (S))) + and then Nkind (Unit (Cunit (Unit (S)))) = N_Subunit + then + Get_Name_String (Reference_Name (Main_Source_File)); + Unit_File_Name := new String'(Name_Buffer (1 .. Name_Len)); + end if; Alfa_File_Table.Append ( - (File_Name => new String'(Name_Buffer (1 .. Name_Len)), - File_Num => D, - From_Scope => From, - To_Scope => Alfa_Scope_Table.Last)); + (File_Name => File_Name, + Unit_File_Name => Unit_File_Name, + File_Num => D, + From_Scope => From, + To_Scope => Alfa_Scope_Table.Last)); end Add_Alfa_File; -------------------- diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 555283c..5fcd0bf 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- @@ -931,6 +931,12 @@ package Opt is -- extension, as set by the appropriate switch. If no switch is given, -- then this value is initialized by Osint to the appropriate value. + Maximum_Instantiations : Int := 8000; + -- GNAT + -- Maximum number of instantiations permitted (to stop runaway cases + -- of nested instantiations). These situations probably only occur in + -- specially concocted test cases. Can be modified by -gnateinn switch. + Maximum_Processes : Positive := 1; -- GNATMAKE, GPRMAKE, GPRBUILD -- Maximum number of processes that should be spawned to carry out @@ -940,12 +946,6 @@ package Opt is -- GNATMAKE -- Set to True if minimal recompilation mode requested - Special_Exception_Package_Used : Boolean := False; - -- GNAT - -- Set to True if either of the unit GNAT.Most_Recent_Exception or - -- GNAT.Exception_Traces is with'ed. Used to inhibit transformation of - -- local raise statements into gotos in the presence of either package. - Multiple_Unit_Index : Int; -- GNAT -- This is set non-zero if the current unit is being compiled in multiple @@ -1182,6 +1182,12 @@ package Opt is -- GNAT -- Set True if a pragma Short_Descriptors applies to the current unit. + Special_Exception_Package_Used : Boolean := False; + -- GNAT + -- Set to True if either of the unit GNAT.Most_Recent_Exception or + -- GNAT.Exception_Traces is with'ed. Used to inhibit transformation of + -- local raise statements into gotos in the presence of either package. + Sprint_Line_Limit : Nat := 72; -- GNAT -- Limit values for chopping long lines in Sprint output, can be reset diff --git a/gcc/ada/put_alfa.adb b/gcc/ada/put_alfa.adb index 49dfac8..a5580a8 100644 --- a/gcc/ada/put_alfa.adb +++ b/gcc/ada/put_alfa.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2011-2012, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- @@ -49,6 +49,18 @@ begin Write_Info_Char (F.File_Name (N)); end loop; + -- If file is a subunit, print the file name for the unit + + if F.Unit_File_Name /= null then + Write_Info_Char (' '); + Write_Info_Char ('-'); + Write_Info_Char ('>'); + Write_Info_Char (' '); + for N in F.Unit_File_Name'Range loop + Write_Info_Char (F.Unit_File_Name (N)); + end loop; + end if; + Write_Info_Terminate; -- Loop through scope entries for this file diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index f007a9d..084e621 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -28,6 +28,7 @@ with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; with Atree; use Atree; with Casing; use Casing; with Checks; use Checks; +with Debug; use Debug; with Einfo; use Einfo; with Errout; use Errout; with Eval_Fat; @@ -54,6 +55,7 @@ with Sem_Ch8; use Sem_Ch8; with Sem_Ch10; use Sem_Ch10; with Sem_Dim; use Sem_Dim; with Sem_Dist; use Sem_Dist; +with Sem_Elab; use Sem_Elab; with Sem_Elim; use Sem_Elim; with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; @@ -644,6 +646,13 @@ package body Sem_Attr is Kill_Current_Values; end if; + -- Treat as call for elaboration purposes and we are all + -- done. Suppress this treatment under debug flag. + + if not Debug_Flag_Dot_UU then + Check_Elab_Call (N); + end if; + return; -- Component is an operation of a protected type diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 5ab842d..0547729 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -34,7 +34,6 @@ with Exp_Disp; use Exp_Disp; with Fname; use Fname; with Fname.UF; use Fname.UF; with Freeze; use Freeze; -with Hostparm; with Itypes; use Itypes; with Lib; use Lib; with Lib.Load; use Lib.Load; @@ -3784,8 +3783,10 @@ package body Sem_Ch12 is -- Here is a defence against a ludicrous number of instantiations -- caused by a circular set of instantiation attempts. - if Pending_Instantiations.Last > Hostparm.Max_Instantiations then - Error_Msg_N ("too many instantiations", N); + if Pending_Instantiations.Last > Maximum_Instantiations then + Error_Msg_Uint_1 := UI_From_Int (Maximum_Instantiations); + Error_Msg_N ("too many instantiations, exceeds max of^", N); + Error_Msg_N ("\limit can be changed using -gnateinn switch", N); raise Unrecoverable_Error; end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index d9be307..a2d729c 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6937,6 +6937,10 @@ package body Sem_Ch6 is Attribute_Result_Mentioned : Boolean := False; -- Whether attribute 'Result is mentioned in a postcondition + No_Warning_On_Some_Postcondition : Boolean := False; + -- Whether there exists a postcondition or a contract-case without a + -- corresponding warning. + Post_State_Mentioned : Boolean := False; -- Whether some expression mentioned in a postcondition can have a -- different value in the post-state than in the pre-state. @@ -7081,7 +7085,9 @@ package body Sem_Ch6 is Post_State_Mentioned := False; Ignored := Find_Post_State (Arg); - if not Post_State_Mentioned then + if Post_State_Mentioned then + No_Warning_On_Some_Postcondition := True; + else Error_Msg_N ("?`Ensures` component refers only to pre-state", Prag); end if; @@ -7133,7 +7139,9 @@ package body Sem_Ch6 is Post_State_Mentioned := False; Ignored := Find_Post_State (Arg); - if not Post_State_Mentioned then + if Post_State_Mentioned then + No_Warning_On_Some_Postcondition := True; + else Error_Msg_N ("?postcondition refers only to pre-state", Prag); end if; @@ -7177,12 +7185,15 @@ package body Sem_Ch6 is end if; -- Issue warning for functions whose postcondition does not mention - -- 'Result after all postconditions have been processed. + -- 'Result after all postconditions have been processed, and provided + -- all postconditions do not already get a warning that they only refer + -- to pre-state. if Ekind_In (Spec_Id, E_Function, E_Generic_Function) and then (Present (Last_Postcondition) or else Present (Last_Contract_Case)) and then not Attribute_Result_Mentioned + and then No_Warning_On_Some_Postcondition then if Present (Last_Postcondition) then if Present (Last_Contract_Case) then diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 6df8c32..2656f46 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1997-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2012, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- @@ -180,7 +180,7 @@ package body Sem_Elab is Inter_Unit_Only : Boolean; Generate_Warnings : Boolean := True; In_Init_Proc : Boolean := False); - -- This is the internal recursive routine that is called to check for a + -- This is the internal recursive routine that is called to check for -- possible elaboration error. The argument N is a subprogram call or -- generic instantiation to be checked, and E is the entity of the called -- subprogram, or instantiated generic unit. The flag Outer_Scope is the @@ -188,8 +188,11 @@ package body Sem_Elab is -- call is only to be checked in the case where it is to another unit (and -- skipped if within a unit). Generate_Warnings is set to False to suppress -- warning messages about missing pragma Elaborate_All's. These messages - -- are not wanted for inner calls in the dynamic model. Flag In_Init_Proc - -- should be set whenever the current context is a type init proc. + -- are not wanted for inner calls in the dynamic model. Note that an + -- instance of the Access attribute applied to a subprogram also generates + -- a call to this procedure (since the referenced subprogram may be called + -- later indirectly). Flag In_Init_Proc should be set whenever the current + -- context is a type init proc. procedure Check_Bad_Instantiation (N : Node_Id); -- N is a node for an instantiation (if called with any other node kind, @@ -270,6 +273,13 @@ package body Sem_Elab is -- On entry C_Scope is set to some scope. On return, C_Scope is reset -- to be the enclosing compilation unit of this scope. + function Get_Referenced_Ent (N : Node_Id) return Entity_Id; + -- N is either a function or procedure call or an access attribute that + -- references a subprogram. This call retrieves the relevant entity. If + -- this is a call to a protected subprogram, the entity is a selected + -- component. The callable entity may be absent, in which case Empty is + -- returned. This happens with non-analyzed calls in nested generics. + procedure Set_Elaboration_Constraint (Call : Node_Id; Subp : Entity_Id; @@ -827,14 +837,19 @@ package body Sem_Elab is -- the init proc is in the root package, and we start from the entity -- of the name in the call. - if Is_Entity_Name (Name (N)) - and then Is_Init_Proc (Entity (Name (N))) - and then not In_Same_Extended_Unit (N, Entity (Name (N))) - then - W_Scope := Scope (Entity (Name (N))); - else - W_Scope := E; - end if; + declare + Ent : constant Entity_Id := Get_Referenced_Ent (N); + begin + if Is_Init_Proc (Ent) + and then not In_Same_Extended_Unit (N, Ent) + then + W_Scope := Scope (Ent); + else + W_Scope := E; + end if; + end; + + -- Now loop through scopes to get to the enclosing compilation unit while not Is_Compilation_Unit (W_Scope) loop W_Scope := Scope (W_Scope); @@ -1126,36 +1141,6 @@ package body Sem_Elab is Ent : Entity_Id; P : Node_Id; - function Get_Called_Ent return Entity_Id; - -- Retrieve called entity. If this is a call to a protected subprogram, - -- entity is a selected component. The callable entity may be absent, - -- in which case there is no check to perform. This happens with - -- non-analyzed calls in nested generics. - - -------------------- - -- Get_Called_Ent -- - -------------------- - - function Get_Called_Ent return Entity_Id is - Nam : Node_Id; - - begin - Nam := Name (N); - - if No (Nam) then - return Empty; - - elsif Nkind (Nam) = N_Selected_Component then - return Entity (Selector_Name (Nam)); - - elsif not Is_Entity_Name (Nam) then - return Empty; - - else - return Entity (Nam); - end if; - end Get_Called_Ent; - -- Start of processing for Check_Elab_Call begin @@ -1174,11 +1159,12 @@ package body Sem_Elab is then Check_Restriction (No_Entry_Calls_In_Elaboration_Code, N); - -- Nothing to do if this is not a call (happens in some error - -- conditions, and in some cases where rewriting occurs). + -- Nothing to do if this is not a call or attribute reference (happens + -- in some error conditions, and in some cases where rewriting occurs). elsif Nkind (N) /= N_Function_Call and then Nkind (N) /= N_Procedure_Call_Statement + and then Nkind (N) /= N_Attribute_Reference then return; @@ -1267,6 +1253,7 @@ package body Sem_Elab is if Comes_From_Source (N) and then In_Preelaborated_Unit and then not In_Inlined_Body + and then Nkind (N) /= N_Attribute_Reference then -- This is a warning in GNAT mode allowing such calls to be -- used in the predefined library with appropriate care. @@ -1352,12 +1339,10 @@ package body Sem_Elab is elsif Dynamic_Elaboration_Checks then - -- This is a rather new check, going into version - -- 3.14a1 for the first time (V1.80 of this unit), so - -- we provide a debug flag to enable it. That way we - -- have an easy work around for regressions that are - -- caused by this new check. This debug flag can be - -- removed later. + -- We provide a debug flag to disable this check. That + -- way we have an easy work around for regressions + -- that are caused by this new check. This debug flag + -- can be removed later. if Debug_Flag_DD then return; @@ -1373,7 +1358,7 @@ package body Sem_Elab is -- but we need to capture local suppress pragmas -- that may inhibit checks on this call. - Ent := Get_Called_Ent; + Ent := Get_Referenced_Ent (N); if No (Ent) then return; @@ -1400,7 +1385,7 @@ package body Sem_Elab is end if; end if; - Ent := Get_Called_Ent; + Ent := Get_Referenced_Ent (N); if No (Ent) then return; @@ -2012,6 +1997,20 @@ package body Sem_Elab is return OK; + -- If we have an access attribute for a subprogram, check + -- it. Suppress this behavior under debug flag. + + elsif not Debug_Flag_Dot_UU + and then Nkind (N) = N_Attribute_Reference + and then (Attribute_Name (N) = Name_Access + or else + Attribute_Name (N) = Name_Unrestricted_Access) + and then Is_Entity_Name (Prefix (N)) + and then Is_Subprogram (Entity (Prefix (N))) + then + Check_Elab_Call (N, Outer_Scope); + return OK; + -- If we have a generic instantiation, check it elsif Nkind (N) in N_Generic_Instantiation then @@ -2605,6 +2604,34 @@ package body Sem_Elab is Set_Suppress_Elaboration_Warnings (Elab_Unit, True); end Set_Elaboration_Constraint; + ------------------------ + -- Get_Referenced_Ent -- + ------------------------ + + function Get_Referenced_Ent (N : Node_Id) return Entity_Id is + Nam : Node_Id; + + begin + if Nkind (N) = N_Attribute_Reference then + Nam := Prefix (N); + else + Nam := Name (N); + end if; + + if No (Nam) then + return Empty; + + elsif Nkind (Nam) = N_Selected_Component then + return Entity (Selector_Name (Nam)); + + elsif not Is_Entity_Name (Nam) then + return Empty; + + else + return Entity (Nam); + end if; + end Get_Referenced_Ent; + ---------------------- -- Has_Generic_Body -- ---------------------- diff --git a/gcc/ada/sem_elab.ads b/gcc/ada/sem_elab.ads index 2bea37d..abae4dd 100644 --- a/gcc/ada/sem_elab.ads +++ b/gcc/ada/sem_elab.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1997-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2012, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- @@ -122,8 +122,9 @@ package Sem_Elab is (N : Node_Id; Outer_Scope : Entity_Id := Empty; In_Init_Proc : Boolean := False); - -- Check a call for possible elaboration problems. The node N is either - -- an N_Function_Call or N_Procedure_Call_Statement node. The Outer_Scope + -- Check a call for possible elaboration problems. The node N is either an + -- N_Function_Call or N_Procedure_Call_Statement node or an access + -- attribute reference whose prefix is a subprogram. The Outer_Scope -- argument indicates whether this is an outer level call from Sem_Res -- (Outer_Scope set to Empty), or an internal recursive call (Outer_Scope -- set to entity of outermost call, see body). Flag In_Init_Proc should be diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index e900faa..cece294 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2012, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- @@ -482,6 +482,13 @@ package body Switch.C is Generate_Processed_File := True; Ptr := Ptr + 1; + -- -gnatei (max number of instantiations) + + when 'i' => + Ptr := Ptr + 1; + Scan_Pos + (Switch_Chars, Max, Ptr, Maximum_Instantiations, C); + -- -gnateI (index of unit in multi-unit source) when 'I' => diff --git a/gcc/ada/switch.ads b/gcc/ada/switch.ads index b55e2fc..5f02ba2 100644 --- a/gcc/ada/switch.ads +++ b/gcc/ada/switch.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- @@ -123,9 +123,8 @@ private Ptr : in out Integer; Result : out Pos; Switch : Character); - -- Scan positive integer parameter for switch. On entry, Ptr points just - -- past the switch character, on exit it points past the last digit of the - -- integer value. + -- Scan positive integer parameter for switch. Identical to Scan_Nat with + -- same parameters except that zero is considered out of range. procedure Bad_Switch (Switch : Character); procedure Bad_Switch (Switch : String); diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index c4e7176..637097b 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- @@ -197,6 +197,11 @@ begin Write_Switch_Char ("eG"); Write_Line ("Generate preprocessed source"); + -- Line for -gnatei switch + + Write_Switch_Char ("einn"); + Write_Line ("Set maximumum number of instantiations to nn"); + -- Line for -gnateI switch Write_Switch_Char ("eInn"); diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index 12eca51..f89ab63 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1996-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2012, Free Software Foundation, Inc. -- -- -- -- GNAT 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- -- @@ -1926,11 +1926,14 @@ package VMS_Data is -- When using a project file, GNAT MAKE creates a temporary mapping file -- and communicates it to the compiler using this switch. - S_GCC_Multi : aliased constant S := "/MULTI_UNIT_INDEX=#" & - "-gnateI#"; - -- /MULTI_UNIT_INDEX=nnn + S_GCC_MaxI : aliased constant S := "/MAX_INSTANTIATIONS=#" & + "-gnatei#"; + + -- /MAX_INSTANTIATIONS=nnn -- - -- Specify the index of the unit to compile in a multi-unit source file. + -- Specify the maximum number of instantiations permitted. The default + -- value is 8000, which is probably enough for all programs except those + -- containing some kind of runaway unintended instantiation loop. S_GCC_Mess : aliased constant S := "/MESSAGES_PROJECT_FILE=" & "DEFAULT " & @@ -1951,6 +1954,12 @@ package VMS_Data is -- HIGH A great number of messages are output, most of them not -- being useful for the user. + S_GCC_Multi : aliased constant S := "/MULTI_UNIT_INDEX=#" & + "-gnateI#"; + -- /MULTI_UNIT_INDEX=nnn + -- + -- Specify the index of the unit to compile in a multi-unit source file. + S_GCC_Nesting : aliased constant S := "/MAX_NESTING=#" & "-gnatyL#"; -- /MAX_NESTING=nnn @@ -3585,6 +3594,7 @@ package VMS_Data is S_GCC_Output 'Access, S_GCC_Machine 'Access, S_GCC_Mapping 'Access, + S_GCC_MaxI 'Access, S_GCC_Multi 'Access, S_GCC_Mess 'Access, S_GCC_Nesting 'Access, |