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

[multiple changes] 

2012-06-12  Robert Dewar  <dewar@adacore.com>

        * gcc-interface/Make-lang.in: Update dependencies.
	* sem_ch9.ads, einfo.adb, einfo.ads, sem_prag.adb, freeze.adb,
	sem_util.adb, sem_ch13.adb, sem_ch13.ads, exp_ch3.adb: Add comments.
	Minor reformatting.

2012-06-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Instantiate_Formal_Subprogram): Remove code that
	implements AI05-0296, because the actual may be overloaded.
	* sem_ch8.adb (Analyze_Subprogram_Renaming): and move it here,
	to be applied once the actual subprogram is properly resolved.

From-SVN: r188456
This commit is contained in:
Arnaud Charlet 2012-06-12 15:16:38 +02:00
parent b98e296954
commit 02e4edeaf4
13 changed files with 2260 additions and 2816 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/ada/ChangeLog
View File

@ -1,3 +1,17 @@
2012-06-12 Robert Dewar <dewar@adacore.com>
* gcc-interface/Make-lang.in: Update dependencies.
* sem_ch9.ads, einfo.adb, einfo.ads, sem_prag.adb, freeze.adb,
sem_util.adb, sem_ch13.adb, sem_ch13.ads, exp_ch3.adb: Add comments.
Minor reformatting.
2012-06-12 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Instantiate_Formal_Subprogram): Remove code that
implements AI05-0296, because the actual may be overloaded.
* sem_ch8.adb (Analyze_Subprogram_Renaming): and move it here,
to be applied once the actual subprogram is properly resolved.
2012-06-12 Robert Dewar <dewar@adacore.com>
* switch-c.adb, a-exexpr-gcc.adb: Minor reformatting.

5
gcc/ada/einfo.adb
View File

@ -35,7 +35,7 @@ pragma Style_Checks (All_Checks);
with Atree; use Atree;
with Nlists; use Nlists;
with Output; use Output;
with Sem_Aux; use Sem_Aux;
with Sem_Aux; use Sem_Aux; -- wrong dependency ???
with Sinfo; use Sinfo;
with Stand; use Stand;
@ -5992,14 +5992,11 @@ package body Einfo is
begin
N := First_Rep_Item (E);
while Present (N) loop
if Nkind (N) = N_Pragma then
N_Nam := Pragma_Name (N);
elsif Nkind (N) = N_Attribute_Definition_Clause then
N_Nam := Chars (N);
elsif Nkind (N) = N_Aspect_Specification then
N_Nam := Chars (Identifier (N));
end if;

12
gcc/ada/einfo.ads
View File

@ -3851,7 +3851,7 @@ package Einfo is
-- entity which may or may not be a type, with the intent that if it is a
-- type, its underlying type is taken.
-- Universal_Aliasing (Flag216) [base type only]
-- Universal_Aliasing (Flag216) [implementation base type only]
-- Present in all type entities. Set to direct the back-end to avoid
-- any optimizations based on type-based alias analysis for this type.
-- Indicates that objects of this type can alias objects of any other
@ -4941,7 +4941,7 @@ package Einfo is
-- Strict_Alignment (Flag145) (base type only)
-- Suppress_Initialization (Flag105)
-- Treat_As_Volatile (Flag41)
-- Universal_Aliasing (Flag216) (base type only)
-- Universal_Aliasing (Flag216) (impl base type only)
-- Alignment_Clause (synth)
-- Base_Type (synth)
@ -7190,6 +7190,9 @@ package Einfo is
-- value returned is the N_Attribute_Definition_Clause node, otherwise
-- Empty is returned.
-- What is difference between following two, and why are they named
-- the way they are ???
function Get_Rep_Item
(E : Entity_Id;
Nam : Name_Id) return Node_Id;
@ -7215,6 +7218,9 @@ package Einfo is
-- representation clause, and if found, returns it. Returns Empty
-- if no such clause is found.
-- I still don't get it, if the first one returns stuff from the parent
-- it should say so, and it doesn't, and the names make no sense ???
function Get_Rep_Pragma (E : Entity_Id; Nam : Name_Id) return Node_Id;
-- Searches the Rep_Item chain for the given entity E, for an instance
-- a representation pragma with the given name Nam. If found then the
@ -7232,6 +7238,8 @@ package Einfo is
-- of rep item with the given name Nam. If found then True is returned,
-- otherwise False indicates that no matching entry was found.
-- Again, the following two have bizarre names, and unclear specs ???
function Has_Rep_Pragma (E : Entity_Id; Nam : Name_Id) return Boolean;
-- Searches the Rep_Item chain for the given entity E, for an instance
-- of representation pragma with the given name Nam. If found then True

7
gcc/ada/exp_ch3.adb
View File

@ -2642,9 +2642,9 @@ package body Exp_Ch3 is
elsif Ekind (Scope (Id)) = E_Record_Type
and then Present (Corresponding_Concurrent_Type (Scope (Id)))
and then (Chars (Id) = Name_uCPU
or else Chars (Id) = Name_uDispatching_Domain
or else Chars (Id) = Name_uPriority)
and then (Chars (Id) = Name_uCPU or else
Chars (Id) = Name_uDispatching_Domain or else
Chars (Id) = Name_uPriority)
then
declare
Exp : Node_Id;
@ -2671,6 +2671,7 @@ package body Exp_Ch3 is
(Corresponding_Concurrent_Type (Scope (Id)), Nam);
if Present (Ritem) then
-- Pragma case
if Nkind (Ritem) = N_Pragma then

1
gcc/ada/freeze.adb
View File

@ -1324,6 +1324,7 @@ package body Freeze is
-- for a description of how we handle aspect visibility).
elsif Has_Delayed_Aspects (E) then
-- Retrieve the visibility to the discriminants in order to
-- analyze properly the aspects.

4853
gcc/ada/gcc-interface/Make-lang.in
View File

File diff suppressed because it is too large Load Diff

57
gcc/ada/sem_ch12.adb
View File

@ -9419,63 +9419,6 @@ package body Sem_Ch12 is
end;
end if;
-- In Ada 2012, enforce the (RM 13.14(10.2/3)) freezing rule concerning
-- formal incomplete types: a callable entity freezes its profile,
-- unless it has an incomplete untagged formal.
if Ada_Version >= Ada_2012 then
declare
F : Entity_Id;
Has_Untagged_Inc : Boolean;
begin
F := First_Formal (Analyzed_S);
Has_Untagged_Inc := False;
while Present (F) loop
if Ekind (Etype (F)) = E_Incomplete_Type
and then not Is_Tagged_Type (Etype (F))
then
Has_Untagged_Inc := True;
exit;
end if;
F := Next_Formal (F);
end loop;
if Ekind (Analyzed_S) = E_Function
and then Ekind (Etype (Analyzed_S)) = E_Incomplete_Type
and then not Is_Tagged_Type (Etype (F))
then
Has_Untagged_Inc := True;
end if;
-- This is a temporary implementation. Most of this code has
-- to be moved to sem_ch8, and will be commented then ???
if Is_Entity_Name (Actual)
and then not Is_Overloaded (Actual)
and then not Has_Untagged_Inc
then
F := First_Formal (Entity (Actual));
while Present (F) loop
Freeze_Before (Instantiation_Node, Etype (F));
if Is_Incomplete_Or_Private_Type (Etype (F))
and then No (Underlying_Type (Etype (F)))
and then not Is_Generic_Type (Etype (F))
then
Error_Msg_NE
("type& must be frozen before this point",
Instantiation_Node, Etype (F));
Abandon_Instantiation (Instantiation_Node);
end if;
F := Next_Formal (F);
end loop;
end if;
end;
end if;
return Decl_Node;
end Instantiate_Formal_Subprogram;

45
gcc/ada/sem_ch13.adb
View File

@ -762,7 +762,6 @@ package body Sem_Ch13 is
begin
A := First (L);
while Present (A) loop
exit when Chars (Identifier (A)) = Name_Export
or else Chars (Identifier (A)) = Name_Import;
@ -795,7 +794,6 @@ package body Sem_Ch13 is
begin
Disc := First_Discriminant (E);
while Present (Disc) loop
if Chars (Expr) = Chars (Disc)
and then Ekind (Etype (Disc)) =
@ -1451,9 +1449,7 @@ package body Sem_Ch13 is
goto Continue;
elsif A_Id = Aspect_Import
or else A_Id = Aspect_Export
then
elsif A_Id = Aspect_Import or else A_Id = Aspect_Export then
-- Verify that there is an aspect Convention that will
-- incorporate the Import/Export aspect, and eventual
@ -6152,8 +6148,8 @@ package body Sem_Ch13 is
-- Case of stream attributes, just have to compare entities
elsif A_Id = Aspect_Input or else
A_Id = Aspect_Output or else
A_Id = Aspect_Read or else
A_Id = Aspect_Output or else
A_Id = Aspect_Read or else
A_Id = Aspect_Write
then
Analyze (End_Decl_Expr);
@ -6231,7 +6227,7 @@ package body Sem_Ch13 is
A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (Ident));
T : Entity_Id := Empty;
T : Entity_Id := Empty;
-- Type required for preanalyze call
begin
@ -6255,7 +6251,7 @@ package body Sem_Ch13 is
when No_Aspect =>
raise Program_Error;
-- Aspects taking an optional boolean argument.
-- Aspects taking an optional boolean argument
when Boolean_Aspects |
Library_Unit_Aspects =>
@ -6332,23 +6328,23 @@ package body Sem_Ch13 is
-- Special case, the expression of these aspects is just an entity
-- that does not need any resolution, so just analyze.
when Aspect_Input |
Aspect_Output |
Aspect_Read |
Aspect_Suppress |
Aspect_Unsuppress |
Aspect_Warnings |
Aspect_Write =>
when Aspect_Input |
Aspect_Output |
Aspect_Read |
Aspect_Suppress |
Aspect_Unsuppress |
Aspect_Warnings |
Aspect_Write =>
Analyze (Expression (ASN));
return;
-- Same for Iterator aspects, where the expression is a function
-- name. Legality rules are checked separately.
when Aspect_Constant_Indexing |
Aspect_Default_Iterator |
Aspect_Iterator_Element |
Aspect_Variable_Indexing =>
when Aspect_Constant_Indexing |
Aspect_Default_Iterator |
Aspect_Iterator_Element |
Aspect_Variable_Indexing =>
Analyze (Expression (ASN));
return;
@ -7599,14 +7595,13 @@ package body Sem_Ch13 is
Ritem : Node_Id;
procedure Analyze_Aspect_Default_Value (ASN : Node_Id);
-- This routine analyzes an Aspect_Default_Value or
-- Aspect_Default_Component_Value denoted by the aspect specification
-- node ASN.
-- This routine analyzes an Aspect_Default_[Component_]Value denoted by
-- the aspect specification node ASN.
procedure Make_Pragma_From_Boolean_Aspect (ASN : Node_Id);
-- Given an aspect specification node ASN whose expression is an
-- optional Boolean, this routines creates the corresponding pragma at
-- the freezing point.
-- optional Boolean, this routines creates the corresponding pragma
-- at the freezing point.
----------------------------------
-- Analyze_Aspect_Default_Value --

3
gcc/ada/sem_ch13.ads
View File

@ -309,6 +309,5 @@ package Sem_Ch13 is
-- Again, ASN is the N_Aspect_Specification node for the aspect.
procedure Evaluate_Aspects_At_Freeze_Point (E : Entity_Id);
-- This routines evaluates all the delayed aspects for entity E at freezing
-- point.
-- Evaluates all the delayed aspects for entity E at freezing point
end Sem_Ch13;

57
gcc/ada/sem_ch8.adb
View File

@ -1688,6 +1688,11 @@ package body Sem_Ch8 is
-- have one. Otherwise the subtype of Sub's return profile must
-- exclude null.
procedure Freeze_Actual_Profile;
-- In Ada 2012, enforce the freezing rule concerning formal incomplete
-- types: a callable entity freezes its profile, unless it has an
-- incomplete untagged formal (RM 13.14(10.2/3)).
function Original_Subprogram (Subp : Entity_Id) return Entity_Id;
-- Find renamed entity when the declaration is a renaming_as_body and
-- the renamed entity may itself be a renaming_as_body. Used to enforce
@ -1925,6 +1930,57 @@ package body Sem_Ch8 is
end if;
end Check_Null_Exclusion;
---------------------------
-- Freeze_Actual_Profile --
---------------------------
procedure Freeze_Actual_Profile is
F : Entity_Id;
Has_Untagged_Inc : Boolean;
Instantiation_Node : constant Node_Id := Parent (N);
begin
if Ada_Version >= Ada_2012 then
F := First_Formal (Formal_Spec);
Has_Untagged_Inc := False;
while Present (F) loop
if Ekind (Etype (F)) = E_Incomplete_Type
and then not Is_Tagged_Type (Etype (F))
then
Has_Untagged_Inc := True;
exit;
end if;
F := Next_Formal (F);
end loop;
if Ekind (Formal_Spec) = E_Function
and then Ekind (Etype (Formal_Spec)) = E_Incomplete_Type
and then not Is_Tagged_Type (Etype (F))
then
Has_Untagged_Inc := True;
end if;
if not Has_Untagged_Inc then
F := First_Formal (Old_S);
while Present (F) loop
Freeze_Before (Instantiation_Node, Etype (F));
if Is_Incomplete_Or_Private_Type (Etype (F))
and then No (Underlying_Type (Etype (F)))
and then not Is_Generic_Type (Etype (F))
then
Error_Msg_NE
("type& must be frozen before this point",
Instantiation_Node, Etype (F));
end if;
F := Next_Formal (F);
end loop;
end if;
end if;
end Freeze_Actual_Profile;
---------------------------
-- Has_Class_Wide_Actual --
---------------------------
@ -2702,6 +2758,7 @@ package body Sem_Ch8 is
if Is_Actual then
Freeze_Before (N, Old_S);
Freeze_Actual_Profile;
Set_Has_Delayed_Freeze (New_S, False);
Freeze_Before (N, New_S);

17
gcc/ada/sem_ch9.ads
View File

@ -55,23 +55,22 @@ package Sem_Ch9 is
procedure Analyze_Triggering_Alternative (N : Node_Id);
procedure Install_Declarations (Spec : Entity_Id);
-- Utility to make visible in corresponding body the entities defined in
-- task, protected type declaration, or entry declaration.
-- Make visible in corresponding body the entities defined in a task,
-- protected type declaration, or entry declaration.
procedure Install_Discriminants (E : Entity_Id);
-- Utility to make visible the discriminants of type entity E
-- Make visible the discriminants of type entity E
procedure Push_Scope_And_Install_Discriminants (E : Entity_Id);
-- Utility that pushes the scope E and makes visible the discriminants of
-- type entity E if E has discriminants.
-- Push scope E and makes visible the discriminants of type entity E if E
-- has discriminants.
procedure Uninstall_Discriminants (E : Entity_Id);
-- Utility that removes the visibility to the discriminants of type entity
-- E.
-- Remove visibility to the discriminants of type entity E
procedure Uninstall_Discriminants_And_Pop_Scope (E : Entity_Id);
-- Utility that removes the visibility to the discriminants of type entity
-- E and pop the scope stack if E has discriminants.
-- Remove visibility to the discriminants of type entity E and pop the
-- scope stack if E has discriminants.
------------------------------
-- Lock Free Data Structure --

4
gcc/ada/sem_prag.adb
View File

@ -1622,9 +1622,7 @@ package body Sem_Prag is
-- For a single protected or a single task object, the error is
-- issued on the original entity.
if Ekind (Id) = E_Task_Type
or else Ekind (Id) = E_Protected_Type
then
if Ekind_In (Id, E_Task_Type, E_Protected_Type) then
Id := Defining_Identifier (Original_Node (Parent (Id)));
end if;

1
gcc/ada/sem_util.adb
View File

@ -2259,6 +2259,7 @@ package body Sem_Util is
end if;
if Wmsg then
-- Check whether the context is an Init_Proc
if Inside_Init_Proc then