OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sem_ch6.adb (Check_Conformance): The null-exclusion feature can be omitted in case of stream attribute subprograms. 

2005-11-14  Javier Miranda  <miranda@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Check_Conformance): The null-exclusion feature can be
	omitted in case of stream attribute subprograms.
	(Check_Inline_Pragma): Handle Inline and Inline_Always pragmas that
	appear immediately after a subprogram body, when there is no previous
	subprogram declaration.
	Change name Is_Package to Is_Package_Or_Generic_Package
	(Process_Formals): A non null qualifier on a non null named access
	type is not an error, and is a warning only if Redundant_Constructs
	are flagged.

From-SVN: r107001
This commit is contained in:
Javier Miranda 2005-11-15 15:02:58 +01:00 committed by Arnaud Charlet
parent 950d3e7dae
commit e660dbf7fe
1 changed files with 149 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

201
gcc/ada/sem_ch6.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2005, 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- --
@ -32,6 +32,7 @@ with Elists; use Elists;
with Errout; use Errout;
with Expander; use Expander;
with Exp_Ch7; use Exp_Ch7;
with Exp_Tss; use Exp_Tss;
with Fname; use Fname;
with Freeze; use Freeze;
with Itypes; use Itypes;
@ -236,7 +237,7 @@ package body Sem_Ch6 is
Analyze (P);
-- A call of the form A.B (X) may be an Ada05 call, which is rewritten
-- as B(A, X). If the rewriting is successful, the call has been
-- as B (A, X). If the rewriting is successful, the call has been
-- analyzed and we just return.
if Nkind (P) = N_Selected_Component
@ -890,9 +891,16 @@ 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_Inline_Pragma (Spec : in out Node_Id);
-- Look ahead to recognize a pragma that may appear after the body.
-- If there is a previous spec, check that it appears in the same
-- declarative part. If the pragma is Inline_Always, perform inlining
-- unconditionally, otherwise only if Front_End_Inlining is requested.
-- If the body acts as a spec, and inlining is required, we create a
-- subprogram declaration for it, in order to attach the body to inline.
procedure Copy_Parameter_List (Plist : List_Id);
-- Comment required ???
procedure Verify_Overriding_Indicator;
-- If there was a previous spec, the entity has been entered in the
@ -900,33 +908,115 @@ package body Sem_Ch6 is
-- indicator, check that it is consistent with the known status of the
-- entity.
----------------------------
-- Check_Following_Pragma --
----------------------------
-------------------------
-- Check_Inline_Pragma --
-------------------------
procedure Check_Following_Pragma is
Prag : Node_Id;
procedure Check_Inline_Pragma (Spec : in out Node_Id) is
Prag : Node_Id;
Plist : List_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)
if not Expander_Active then
return;
end if;
if Is_List_Member (N)
and then Present (Next (N))
and then Nkind (Next (N)) = N_Pragma
then
Prag := Next (N);
if Present (Prag)
and then Nkind (Prag) = N_Pragma
and then Get_Pragma_Id (Chars (Prag)) = Pragma_Inline
if Nkind (Prag) = N_Pragma
and then
Chars
(Expression (First (Pragma_Argument_Associations (Prag))))
= Chars (Body_Id)
(Get_Pragma_Id (Chars (Prag)) = Pragma_Inline_Always
or else
(Front_End_Inlining
and then Get_Pragma_Id (Chars (Prag)) = Pragma_Inline))
and then
Chars
(Expression (First (Pragma_Argument_Associations (Prag))))
= Chars (Body_Id)
then
Analyze (Prag);
Prag := Next (N);
else
Prag := Empty;
end if;
else
Prag := Empty;
end if;
if Present (Prag) then
if Present (Spec_Id) then
if List_Containing (N) =
List_Containing (Unit_Declaration_Node (Spec_Id))
then
Analyze (Prag);
end if;
else
-- Create a subprogram declaration, to make treatment uniform.
declare
Subp : constant Entity_Id :=
Make_Defining_Identifier (Loc, Chars (Body_Id));
Decl : constant Node_Id :=
Make_Subprogram_Declaration (Loc,
Specification => New_Copy_Tree (Specification (N)));
begin
Set_Defining_Unit_Name (Specification (Decl), Subp);
if Present (First_Formal (Body_Id)) then
Plist := New_List;
Copy_Parameter_List (Plist);
Set_Parameter_Specifications
(Specification (Decl), Plist);
end if;
Insert_Before (N, Decl);
Analyze (Decl);
Analyze (Prag);
Set_Has_Pragma_Inline (Subp);
if Get_Pragma_Id (Chars (Prag)) = Pragma_Inline_Always then
Set_Is_Inlined (Subp);
Set_Next_Rep_Item (Prag, First_Rep_Item (Subp));
Set_First_Rep_Item (Subp, Prag);
end if;
Spec := Subp;
end;
end if;
end if;
end Check_Following_Pragma;
end Check_Inline_Pragma;
-------------------------
-- Copy_Parameter_List --
-------------------------
procedure Copy_Parameter_List (Plist : List_Id) is
Formal : Entity_Id;
begin
Formal := First_Formal (Body_Id);
while Present (Formal) loop
Append
(Make_Parameter_Specification (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Sloc (Formal),
Chars => Chars (Formal)),
In_Present => In_Present (Parent (Formal)),
Out_Present => Out_Present (Parent (Formal)),
Parameter_Type =>
New_Reference_To (Etype (Formal), Loc),
Expression =>
New_Copy_Tree (Expression (Parent (Formal)))),
Plist);
Next_Formal (Formal);
end loop;
end Copy_Parameter_List;
---------------------------------
-- Verify_Overriding_Indicator --
@ -1071,6 +1161,8 @@ package body Sem_Ch6 is
end loop;
end if;
Check_Inline_Pragma (Spec_Id);
-- Case of fully private operation in the body of the protected type.
-- We must create a declaration for the subprogram, in order to attach
-- the protected subprogram that will be used in internal calls.
@ -1101,22 +1193,7 @@ package body Sem_Ch6 is
Plist := No_List;
end if;
while Present (Formal) loop
Append
(Make_Parameter_Specification (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Sloc (Formal),
Chars => Chars (Formal)),
In_Present => In_Present (Parent (Formal)),
Out_Present => Out_Present (Parent (Formal)),
Parameter_Type =>
New_Reference_To (Etype (Formal), Loc),
Expression =>
New_Copy_Tree (Expression (Parent (Formal)))),
Plist);
Next_Formal (Formal);
end loop;
Copy_Parameter_List (Plist);
if Nkind (Body_Spec) = N_Procedure_Specification then
New_Spec :=
@ -1337,14 +1414,11 @@ 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 Front_End_Inlining))
then
Check_Following_Pragma;
if Is_Always_Inlined (Spec_Id)
or else (Has_Pragma_Inline (Spec_Id) and then Front_End_Inlining)
then
Build_Body_To_Inline (N, Spec_Id);
end if;
Build_Body_To_Inline (N, Spec_Id);
end if;
-- Ada 2005 (AI-262): In library subprogram bodies, after the analysis
@ -2451,9 +2525,29 @@ package body Sem_Ch6 is
or else Is_Access_Constant (Etype (Old_Formal))
/= Is_Access_Constant (Etype (New_Formal)))
then
Conformance_Error
("type of & does not match!", New_Formal);
return;
-- It is allowed to omit the null-exclusion in case of
-- stream attribute subprograms
declare
TSS_Name : TSS_Name_Type;
begin
Get_Name_String (Chars (New_Id));
TSS_Name :=
TSS_Name_Type
(Name_Buffer
(Name_Len - TSS_Name'Length + 1 .. Name_Len));
if TSS_Name /= TSS_Stream_Read
and then TSS_Name /= TSS_Stream_Write
and then TSS_Name /= TSS_Stream_Input
and then TSS_Name /= TSS_Stream_Output
then
Conformance_Error
("type of & does not match!", New_Formal);
return;
end if;
end;
end if;
-- Check default expressions for in parameters
@ -4696,7 +4790,7 @@ package body Sem_Ch6 is
Decl : constant Node_Id := Unit_Declaration_Node (E);
begin
if Is_Package (Current_Scope)
if Is_Package_Or_Generic_Package (Current_Scope)
and then In_Private_Part (Current_Scope)
then
Priv_Decls :=
@ -5014,7 +5108,7 @@ package body Sem_Ch6 is
-- the fact that the full view of a private extension
-- re-inherits. It has to be dealt with.
if Is_Package (Current_Scope)
if Is_Package_Or_Generic_Package (Current_Scope)
and then In_Private_Part (Current_Scope)
then
Check_Operation_From_Private_View (S, E);
@ -5423,9 +5517,12 @@ package body Sem_Ch6 is
and then Is_Access_Type (Formal_Type)
and then Null_Exclusion_Present (Param_Spec)
then
if Can_Never_Be_Null (Formal_Type) then
if Can_Never_Be_Null (Formal_Type)
and then Comes_From_Source (Related_Nod)
then
Error_Msg_N
("(Ada 2005) already a null-excluding type", Related_Nod);
("null exclusion must apply to a type that does not "
& "exclude null ('R'M 3.10 (14)", Related_Nod);
end if;
Formal_Type :=