From c37bb106ec37b73a1d44494a268f5857a2b90b93 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 19 May 2004 16:24:07 +0200 Subject: [PATCH] [multiple changes] 2004-05-19 Joel Brobecker * exp_dbug.ads: Correct comments concerning handling of overloading, since we no longer use $ anymore. 2004-05-19 Sergey Rybin * sem_ch10.adb (Optional_Subunit): When loading a subunit, do not ignore errors if ASIS_Mode is set. This prevents creating ASIS trees with illegal subunits. 2004-05-19 Ed Schonberg * sem_ch6.adb (Check_Following_Pragma): When compiling a subprogram body with front-end inlining enabled, check whether an inline pragma appears immediately after the body and applies to it. * sem_prag.adb (Cannot_Inline): Emit warning if front-end inlining is enabled and the pragma appears after the body of the subprogram. From-SVN: r82026 --- gcc/ada/ChangeLog | 20 ++++++++++++++++++++ gcc/ada/exp_dbug.ads | 26 +++++++++++--------------- gcc/ada/sem_ch10.adb | 10 ++++++++-- gcc/ada/sem_ch6.adb | 42 ++++++++++++++++++++++++++++++++++++------ gcc/ada/sem_prag.adb | 27 ++++++++++++++++++--------- 5 files changed, 93 insertions(+), 32 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c311e987132..87bb01f4bff 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2004-05-19 Joel Brobecker + + * exp_dbug.ads: Correct comments concerning handling of overloading, + since we no longer use $ anymore. + +2004-05-19 Sergey Rybin + + * sem_ch10.adb (Optional_Subunit): When loading a subunit, do not + ignore errors if ASIS_Mode is set. This prevents creating ASIS trees + with illegal subunits. + +2004-05-19 Ed Schonberg + + * sem_ch6.adb (Check_Following_Pragma): When compiling a subprogram + body with front-end inlining enabled, check whether an inline pragma + appears immediately after the body and applies to it. + + * sem_prag.adb (Cannot_Inline): Emit warning if front-end inlining is + enabled and the pragma appears after the body of the subprogram. + 2004-05-17 Richard Kenner Part of function-at-a-time conversion diff --git a/gcc/ada/exp_dbug.ads b/gcc/ada/exp_dbug.ads index e8738b3aad5..080e8661564 100644 --- a/gcc/ada/exp_dbug.ads +++ b/gcc/ada/exp_dbug.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1996-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2004 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- -- @@ -99,23 +99,19 @@ package Exp_Dbug is -- subprograms, since overloading can legitimately result in a -- case of two entities with exactly the same fully qualified names. -- To distinguish between entries in a set of overloaded subprograms, - -- the encoded names are serialized by adding one of the suffixes: + -- the encoded names are serialized by adding the suffix: - -- $n (dollar sign) -- __nn (two underscores) -- where nn is a serial number (2 for the second overloaded function, - -- 2 for the third, etc.). We use $ if this symbol is allowed, and - -- double underscore if it is not. In the remaining examples in this - -- section, we use a $ sign, but the $ is replaced by __ throughout - -- these examples if $ sign is not available. A suffix of $1 is - -- always omitted (i.e. no suffix implies the first instance). + -- 2 for the third, etc.). A suffix of __1 is always omitted (i.e. no + -- suffix implies the first instance). -- These names are prefixed by the normal full qualification. So -- for example, the third instance of the subprogram qrs in package -- yz would have the name: - -- yz__qrs$3 + -- yz__qrs__3 -- A more subtle case arises with entities declared within overloaded -- subprograms. If we have two overloaded subprograms, and both declare @@ -128,7 +124,7 @@ package Exp_Dbug is -- we are talking about. For this purpose, we use a more complex suffix -- which has the form: - -- $nn_nn_nn ... + -- __nn_nn_nn ... -- where the nn values are the homonym numbers as needed for any of -- the qualifying entities, separated by a single underscore. If all @@ -141,13 +137,13 @@ package Exp_Dbug is -- procedure Tuv is ... end; -- Name is yz__qrs__tuv -- begin ... end Qrs; - -- procedure Qrs (X: Int) is -- Name is yz__qrs$2 - -- procedure Tuv is ... end; -- Name is yz__qrs__tuv$2_1 - -- procedure Tuv (X: Int) is -- Name is yz__qrs__tuv$2_2 + -- procedure Qrs (X: Int) is -- Name is yz__qrs__2 + -- procedure Tuv is ... end; -- Name is yz__qrs__tuv__2_1 + -- procedure Tuv (X: Int) is -- Name is yz__qrs__tuv__2_2 -- begin ... end Tuv; - -- procedure Tuv (X: Float) is -- Name is yz__qrs__tuv$2_3 - -- type m is new float; -- Name is yz__qrs__tuv__m$2_3 + -- procedure Tuv (X: Float) is -- Name is yz__qrs__tuv__2_3 + -- type m is new float; -- Name is yz__qrs__tuv__m__2_3 -- begin ... end Tuv; -- begin ... end Qrs; -- end Yz; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index ac065d0edf5..9eaee3e057f 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -948,14 +948,20 @@ package body Sem_Ch10 is -- Errout to ignore all errors. Note that Fatal_Error will still -- be set, so we will be able to check for this case below. - Ignore_Errors_Enable := Ignore_Errors_Enable + 1; + if not ASIS_Mode then + Ignore_Errors_Enable := Ignore_Errors_Enable + 1; + end if; + Unum := Load_Unit (Load_Name => Subunit_Name, Required => False, Subunit => True, Error_Node => N); - Ignore_Errors_Enable := Ignore_Errors_Enable - 1; + + if not ASIS_Mode then + Ignore_Errors_Enable := Ignore_Errors_Enable - 1; + end if; -- All done if we successfully loaded the subunit diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 8e2cd6a8ea7..41d23886b16 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -790,6 +790,33 @@ package body Sem_Ch6 is Missing_Ret : Boolean; P_Ent : Entity_Id; + procedure Check_Following_Pragma; + -- If front-end inlining is enabled, look ahead to recognize a pragma + -- that may appear after the body. + + procedure Check_Following_Pragma is + Prag : Node_Id; + begin + if Front_End_Inlining + and then Is_List_Member (N) + and then Present (Spec_Decl) + and then List_Containing (N) = List_Containing (Spec_Decl) + then + Prag := Next (N); + + if Present (Prag) + and then Nkind (Prag) = N_Pragma + and then Get_Pragma_Id (Chars (Prag)) = Pragma_Inline + and then + Chars + (Expression (First (Pragma_Argument_Associations (Prag)))) + = Chars (Body_Id) + then + Analyze (Prag); + end if; + end if; + end Check_Following_Pragma; + begin if Debug_Flag_C then Write_Str ("==== Compiling subprogram body "); @@ -1141,13 +1168,15 @@ package body Sem_Ch6 is elsif Present (Spec_Id) and then Expander_Active - and then (Is_Always_Inlined (Spec_Id) - or else (Has_Pragma_Inline (Spec_Id) - and then - (Front_End_Inlining - or else Configurable_Run_Time_Mode))) then - Build_Body_To_Inline (N, Spec_Id); + Check_Following_Pragma; + + if Is_Always_Inlined (Spec_Id) + or else (Has_Pragma_Inline (Spec_Id) + and then (Front_End_Inlining or else Configurable_Run_Time_Mode)) + then + Build_Body_To_Inline (N, Spec_Id); + end if; end if; -- Ada 0Y (AI-262): In library subprogram bodies, after the analysis @@ -1169,6 +1198,7 @@ package body Sem_Ch6 is Process_End_Label (HSS, 't', Current_Scope); End_Scope; Check_Subprogram_Order (N); + Set_Analyzed (Body_Id); -- If we have a separate spec, then the analysis of the declarations -- caused the entities in the body to be chained to the spec id, but diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 5daafd59583..afbb68042b6 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -2856,15 +2856,17 @@ package body Sem_Prag is procedure Set_Inline_Flags (Subp : Entity_Id); -- Sets Is_Inlined and Has_Pragma_Inline flags for Subp - function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean; + function Cannot_Inline (Subp : Entity_Id) return Boolean; -- Do not set the inline flag if body is available and contains -- exception handlers, to prevent undefined symbols at link time. + -- Emit warning if front-end inlining is enabled and the pragma + -- appears too late. - ---------------------------- - -- Back_End_Cannot_Inline -- - ---------------------------- + ------------------- + -- Cannot_Inline -- + ------------------- - function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean is + function Cannot_Inline (Subp : Entity_Id) return Boolean is Decl : constant Node_Id := Unit_Declaration_Node (Subp); begin @@ -2876,12 +2878,19 @@ package body Sem_Prag is elsif Nkind (Decl) = N_Subprogram_Declaration and then Present (Corresponding_Body (Decl)) then + if Front_End_Inlining + and then Analyzed (Corresponding_Body (Decl)) + then + Error_Msg_N ("pragma appears too late, ignored?", N); + return True; + -- If the subprogram is a renaming as body, the body is -- just a call to the renamed subprogram, and inlining is -- trivially possible. - if Nkind (Unit_Declaration_Node (Corresponding_Body (Decl))) = - N_Subprogram_Renaming_Declaration + elsif + Nkind (Unit_Declaration_Node (Corresponding_Body (Decl))) + = N_Subprogram_Renaming_Declaration then return False; @@ -2897,7 +2906,7 @@ package body Sem_Prag is return False; end if; - end Back_End_Cannot_Inline; + end Cannot_Inline; ----------------- -- Make_Inline -- @@ -2911,7 +2920,7 @@ package body Sem_Prag is if Etype (Subp) = Any_Type then return; - elsif Back_End_Cannot_Inline (Subp) then + elsif Cannot_Inline (Subp) then Applies := True; -- Do not treat as an error. return; -- 2.30.2