committed: Ada updates
Arnaud Charlet
charlet@ACT-Europe.FR
Wed May 19 16:00:00 GMT 2004
Tested on x86-linux using the pre ssa merge tag.
--
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.
--
Index: exp_dbug.ads
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_dbug.ads,v
retrieving revision 1.7
diff -u -p -r1.7 exp_dbug.ads
--- exp_dbug.ads 23 Oct 2003 11:57:52 -0000 1.7
+++ exp_dbug.ads 19 May 2004 10:47:02 -0000
@@ -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;
Index: sem_ch10.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch10.adb,v
retrieving revision 1.22
diff -u -p -r1.22 sem_ch10.adb
--- sem_ch10.adb 17 May 2004 13:20:44 -0000 1.22
+++ sem_ch10.adb 19 May 2004 10:47:03 -0000
@@ -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
Index: sem_ch6.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch6.adb,v
retrieving revision 1.20
diff -u -p -r1.20 sem_ch6.adb
--- sem_ch6.adb 14 May 2004 13:55:11 -0000 1.20
+++ sem_ch6.adb 19 May 2004 10:47:03 -0000
@@ -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
Index: sem_prag.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_prag.adb,v
retrieving revision 1.30
diff -u -p -r1.30 sem_prag.adb
--- sem_prag.adb 17 May 2004 13:20:44 -0000 1.30
+++ sem_prag.adb 19 May 2004 10:47:04 -0000
@@ -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;
More information about the Gcc-patches
mailing list