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

sem_ch6.adb (Check_Private_Overriding): Refine the legality checks here.

Browse Source 
2015-03-02  Bob Duff  <duff@adacore.com>

	* sem_ch6.adb (Check_Private_Overriding): Refine the legality
	checks here. It used to check that the function is merely
	overriding SOMEthing. Now it checks that the function is
	overriding a corresponding public operation. This is a correction
	to the implementation of the rule in RM-3.9.3(10).

From-SVN: r221110
This commit is contained in:
Bob Duff 2015-03-02 11:05:03 +00:00 committed by Arnaud Charlet
parent 5a271a7f3a
commit acf624f280
2 changed files with 66 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/ada/ChangeLog
View File

@ -1,3 +1,11 @@
2015-03-02 Bob Duff <duff@adacore.com>
* sem_ch6.adb (Check_Private_Overriding): Refine the legality
checks here. It used to check that the function is merely
overriding SOMEthing. Now it checks that the function is
overriding a corresponding public operation. This is a correction
to the implementation of the rule in RM-3.9.3(10).
2015-03-02 Robert Dewar <dewar@adacore.com>
* debug.adb: Document new debug flag -gnatd.1.

60
gcc/ada/sem_ch6.adb
View File

@ -8905,6 +8905,50 @@ package body Sem_Ch6 is
------------------------------
procedure Check_Private_Overriding (T : Entity_Id) is
function Overrides_Visible_Function return Boolean;
-- True if S overrides a function in the visible part. The
-- overridden function could be explicitly or implicitly declared.
function Overrides_Visible_Function return Boolean is
begin
if not Is_Overriding or else not Has_Homonym (S) then
return False;
end if;
if not Present (Incomplete_Or_Partial_View (T)) then
return True;
end if;
-- Search through all the homonyms H of S in the current
-- package spec, and return True if we find one that matches.
-- Note that Parent (H) will be the declaration of the
-- Incomplete_Or_Partial_View of T for a match.
declare
H : Entity_Id := S;
begin
loop
H := Homonym (H);
exit when not Present (H) or else Scope (H) /= Scope (S);
if Nkind_In
(Parent (H),
N_Private_Extension_Declaration,
N_Private_Type_Declaration)
and then Defining_Identifier (Parent (H)) =
Incomplete_Or_Partial_View (T)
then
return True;
end if;
end loop;
end;
return False;
end Overrides_Visible_Function;
-- Start of processing for Check_Private_Overriding
begin
if Is_Package_Or_Generic_Package (Current_Scope)
and then In_Private_Part (Current_Scope)
@ -8919,8 +8963,20 @@ package body Sem_Ch6 is
Error_Msg_N ("abstract subprograms must be visible "
& "(RM 3.9.3(10))!", S);
elsif Ekind (S) = E_Function and then not Is_Overriding then
if Is_Tagged_Type (T) and then T = Base_Type (Etype (S)) then
elsif Ekind (S) = E_Function
and then not Overrides_Visible_Function
then
-- Here, S is "function ... return T;" declared in the
-- private part, not overriding some visible operation.
-- That's illegal in the tagged case (but not if the
-- private type is untagged).
if ((Present (Incomplete_Or_Partial_View (T))
and then Is_Tagged_Type (Incomplete_Or_Partial_View (T)))
or else (not Present (Incomplete_Or_Partial_View (T))
and then Is_Tagged_Type (T)))
and then T = Base_Type (Etype (S))
then
Error_Msg_N ("private function with tagged result must"
& " override visible-part function", S);
Error_Msg_N ("\move subprogram to the visible part"