[multiple changes]

2004-05-19  Joel Brobecker  <brobecker@gnat.com>

	* exp_dbug.ads: Correct comments concerning handling of overloading,
	since we no longer use $ anymore.

2004-05-19  Sergey Rybin  <rybin@act-europe.fr>

	* 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  <schonberg@gnat.com>

	* 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
This commit is contained in:
Arnaud Charlet 2004-05-19 16:24:07 +02:00
parent 31a52b868a
commit c37bb106ec
5 changed files with 93 additions and 32 deletions

View File

@ -1,3 +1,23 @@
2004-05-19 Joel Brobecker <brobecker@gnat.com>
* exp_dbug.ads: Correct comments concerning handling of overloading,
since we no longer use $ anymore.
2004-05-19 Sergey Rybin <rybin@act-europe.fr>
* 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 <schonberg@gnat.com>
* 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 <kenner@vlsi1.ultra.nyu.edu>
Part of function-at-a-time conversion

View File

@ -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;

View File

@ -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

View File

@ -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

View File

@ -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;