git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

2012-04-02  Yannick Moy  <moy@adacore.com>

	* lib-xref-alfa.adb: Code clean up.

2012-04-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Analyze_Subprogram_Instantiation): Do not suppress
	style checks, because the subprogram instance itself may contain
	violations of syle rules.
	* style.adb (Missing_Overriding): Check for missing overriding
	indicator on a subprogram instance.

2012-04-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch6.adb (Last_Implicit_Declaration): New routine.
	(Process_PPCs): Insert the body of _postconditions after the
	last internally generated declaration. This ensures that actual
	subtypes created for formal parameters are visible and properly
	frozen as _postconditions may reference them.

From-SVN: r186070
This commit is contained in:
Arnaud Charlet 2012-04-02 11:19:30 +02:00
parent 99fc068ee8
commit e228f7eed2
5 changed files with 143 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gcc/ada/ChangeLog
View File

@ -1,3 +1,23 @@
2012-04-02 Yannick Moy <moy@adacore.com>
* lib-xref-alfa.adb: Code clean up.
2012-04-02 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Analyze_Subprogram_Instantiation): Do not suppress
style checks, because the subprogram instance itself may contain
violations of syle rules.
* style.adb (Missing_Overriding): Check for missing overriding
indicator on a subprogram instance.
2012-04-02 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch6.adb (Last_Implicit_Declaration): New routine.
(Process_PPCs): Insert the body of _postconditions after the
last internally generated declaration. This ensures that actual
subtypes created for formal parameters are visible and properly
frozen as _postconditions may reference them.
2012-04-02 Robert Dewar <dewar@adacore.com>
* einfo.adb (First_Component_Or_Discriminant) Now applies to

121
gcc/ada/lib-xref-alfa.adb
View File

@ -570,67 +570,68 @@ package body Alfa is
elsif T1.Def /= T2.Def then
return T1.Def < T2.Def;
-- The following should be commented, it sure looks like a test,
-- but it sits uncommented between the "third test" and the "fourth
-- test! ??? Shouldn't this in any case be an assertion ???
elsif T1.Key.Ent /= T2.Key.Ent then
raise Program_Error;
-- Fourth test: if reference is in same unit as entity definition,
-- sort first.
elsif T1.Key.Lun /= T2.Key.Lun
and then T1.Ent_Scope_File = T1.Key.Lun
then
return True;
elsif T1.Key.Lun /= T2.Key.Lun
and then T2.Ent_Scope_File = T2.Key.Lun
then
return False;
-- Fifth test: if reference is in same unit and same scope as entity
-- definition, sort first.
elsif T1.Ent_Scope_File = T1.Key.Lun
and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope
and then T1.Key.Ent_Scope = T1.Key.Ref_Scope
then
return True;
elsif T2.Ent_Scope_File = T2.Key.Lun
and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope
and then T2.Key.Ent_Scope = T2.Key.Ref_Scope
then
return False;
-- Sixth test: for same entity, sort by reference location unit
elsif T1.Key.Lun /= T2.Key.Lun then
return Dependency_Num (T1.Key.Lun) < Dependency_Num (T2.Key.Lun);
-- Seventh test: for same entity, sort by reference location scope
elsif Get_Scope_Num (T1.Key.Ref_Scope) /=
Get_Scope_Num (T2.Key.Ref_Scope)
then
return Get_Scope_Num (T1.Key.Ref_Scope) <
Get_Scope_Num (T2.Key.Ref_Scope);
-- Eighth test: order of location within referencing unit
elsif T1.Key.Loc /= T2.Key.Loc then
return T1.Key.Loc < T2.Key.Loc;
-- Finally, for two locations at the same address prefer the one that
-- does NOT have the type 'r', so that a modification or extension
-- takes preference, when there are more than one reference at the
-- same location. As a result, in the case of entities that are
-- in-out actuals, the read reference follows the modify reference.
else
return T2.Key.Typ = 'r';
-- Both entities must be equal at this point
pragma Assert (T1.Key.Ent = T2.Key.Ent);
-- Fourth test: if reference is in same unit as entity definition,
-- sort first.
if T1.Key.Lun /= T2.Key.Lun
and then T1.Ent_Scope_File = T1.Key.Lun
then
return True;
elsif T1.Key.Lun /= T2.Key.Lun
and then T2.Ent_Scope_File = T2.Key.Lun
then
return False;
-- Fifth test: if reference is in same unit and same scope as
-- entity definition, sort first.
elsif T1.Ent_Scope_File = T1.Key.Lun
and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope
and then T1.Key.Ent_Scope = T1.Key.Ref_Scope
then
return True;
elsif T2.Ent_Scope_File = T2.Key.Lun
and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope
and then T2.Key.Ent_Scope = T2.Key.Ref_Scope
then
return False;
-- Sixth test: for same entity, sort by reference location unit
elsif T1.Key.Lun /= T2.Key.Lun then
return Dependency_Num (T1.Key.Lun) <
Dependency_Num (T2.Key.Lun);
-- Seventh test: for same entity, sort by reference location scope
elsif Get_Scope_Num (T1.Key.Ref_Scope) /=
Get_Scope_Num (T2.Key.Ref_Scope)
then
return Get_Scope_Num (T1.Key.Ref_Scope) <
Get_Scope_Num (T2.Key.Ref_Scope);
-- Eighth test: order of location within referencing unit
elsif T1.Key.Loc /= T2.Key.Loc then
return T1.Key.Loc < T2.Key.Loc;
-- Finally, for two locations at the same address prefer the one
-- that does NOT have the type 'r', so that a modification or
-- extension takes preference, when there are more than one
-- reference at the same location. As a result, in the case of
-- entities that are in-out actuals, the read reference follows
-- the modify reference.
else
return T2.Key.Typ = 'r';
end if;
end if;
end Lt;

17
gcc/ada/sem_ch12.adb
View File

@ -4404,9 +4404,6 @@ package body Sem_Ch12 is
Parent_Installed : Boolean := False;
Renaming_List : List_Id;
Save_Style_Check : constant Boolean := Style_Check;
-- Save style check mode for restore on exit
procedure Analyze_Instance_And_Renamings;
-- The instance must be analyzed in a context that includes the mappings
-- of generic parameters into actuals. We create a package declaration
@ -4587,11 +4584,13 @@ package body Sem_Ch12 is
Instantiation_Node := N;
-- Turn off style checking in instances. If the check is enabled on the
-- generic unit, a warning in an instance would just be noise. If not
-- enabled on the generic, then a warning in an instance is just wrong.
-- For package instantiations we turn off style checks, because they
-- will have been emitted in the generic. For subprogram instantiations
-- we want to apply at least the check on overriding indicators so we
-- do not modify the style check status.
Style_Check := False;
-- The renaming declarations for the actuals do not come from source and
-- will not generate spurious warnings.
Preanalyze_Actuals (N);
@ -4859,8 +4858,6 @@ package body Sem_Ch12 is
Generic_Renamings_HTable.Reset;
end if;
Style_Check := Save_Style_Check;
<<Leave>>
if Has_Aspects (N) then
Analyze_Aspect_Specifications (N, Act_Decl_Id);
@ -4875,8 +4872,6 @@ package body Sem_Ch12 is
if Env_Installed then
Restore_Env;
end if;
Style_Check := Save_Style_Check;
end Analyze_Subprogram_Instantiation;
-------------------------

49
gcc/ada/sem_ch6.adb
View File

@ -11057,6 +11057,9 @@ package body Sem_Ch6 is
-- that an invariant check is required (for an IN OUT parameter, or
-- the returned value of a function.
function Last_Implicit_Declaration return Node_Id;
-- Return the last internally-generated declaration of N
-------------
-- Grab_CC --
-------------
@ -11307,6 +11310,50 @@ package body Sem_Ch6 is
end if;
end Is_Public_Subprogram_For;
-------------------------------
-- Last_Implicit_Declaration --
-------------------------------
function Last_Implicit_Declaration return Node_Id is
Loc : constant Source_Ptr := Sloc (N);
Decls : List_Id := Declarations (N);
Decl : Node_Id;
Succ : Node_Id;
begin
if No (Decls) then
Decls := New_List (Make_Null_Statement (Loc));
Set_Declarations (N, Decls);
elsif Is_Empty_List (Declarations (N)) then
Append_To (Decls, Make_Null_Statement (Loc));
end if;
-- Implicit and source declarations may be interspersed. Search for
-- the last implicit declaration which is either succeeded by a
-- source construct or is the last node in the declarative list.
Decl := First (Declarations (N));
while Present (Decl) loop
Succ := Next (Decl);
-- The current declaration is the last one, do not return Empty
if No (Succ) then
exit;
-- The successor is a source construct
elsif Comes_From_Source (Succ) then
exit;
end if;
Next (Decl);
end loop;
return Decl;
end Last_Implicit_Declaration;
-- Start of processing for Process_PPCs
begin
@ -11712,7 +11759,7 @@ package body Sem_Ch6 is
-- The entity for the _Postconditions procedure
begin
Prepend_To (Declarations (N),
Insert_After (Last_Implicit_Declaration,
Make_Subprogram_Body (Loc,
Specification =>
Make_Procedure_Specification (Loc,

10
gcc/ada/style.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
@ -236,7 +236,13 @@ package body Style is
procedure Missing_Overriding (N : Node_Id; E : Entity_Id) is
begin
if Style_Check_Missing_Overriding and then Comes_From_Source (N) then
-- Perform the check on source subprograms and on subprogram instances,
-- because these can be primitives of untagged types.
if Style_Check_Missing_Overriding
and then (Comes_From_Source (N) or else Is_Generic_Instance (E))
then
if Nkind (N) = N_Subprogram_Body then
Error_Msg_NE -- CODEFIX
("(style) missing OVERRIDING indicator in body of&", N, E);