From: Gary Dismukes Date: Mon, 20 Apr 2009 09:37:30 +0000 (+0200) Subject: sem_elim.ads (Check_For_Eliminated_Subprogram): New procedure for checking for refere... X-Git-Tag: releases/gcc-4.5.0~6381 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=16212e894ae04b6de4d10d6992c2eabe1d6866ac;p=thirdparty%2Fgcc.git sem_elim.ads (Check_For_Eliminated_Subprogram): New procedure for checking for references to eliminated subprograms that should... 2009-04-20 Gary Dismukes * sem_elim.ads (Check_For_Eliminated_Subprogram): New procedure for checking for references to eliminated subprograms that should be flagged. (Eliminate_Error_Message): Update comment to say "references" rather than "calls" (since attribute cases are handled here as well). * sem_elim.adb (Check_For_Eliminated_Subprogram): New procedure for checking for references to eliminated subprograms that should be flagged. Add with and use of Sem and Sem_Util. * sem_res.adb (Resolve_Call): Reject calls to eliminated subprograms. Add with and use of Sem_Elim. * sem_attr.adb (Analyze_Access_Attribute): Reject access attributes applied to eliminated subprograms. (Analyze_Attribute): Reject 'Address and 'Code_Address applied to eliminated subprograms. Add with and use of Sem_Elim. * sem_disp.adb (Check_Dispatching_Call): Remove error check for calls to eliminated subprograms, now handled during Resolve_Call. Remove with and use of Sem_Elim. * exp_disp.adb (Make_DT): Get Ultimate_Alias of primitive before testing Is_Eliminated, for proper handling of primitive derived from eliminated subprograms. From-SVN: r146385 --- diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index d0903200a59f..2a6f3473a9b8 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -5160,22 +5160,19 @@ package body Exp_Disp is while Present (Prim_Elmt) loop Prim := Node (Prim_Elmt); + -- Retrieve the ultimate alias of the primitive for proper + -- handling of renamings and eliminated primitives. + + E := Ultimate_Alias (Prim); + if Is_Imported (Prim) or else Present (Interface_Alias (Prim)) or else Is_Predefined_Dispatching_Operation (Prim) - or else Is_Eliminated (Prim) + or else Is_Eliminated (E) then null; else - -- Traverse the list of aliased entities to handle - -- renamings of predefined primitives. - - E := Prim; - while Present (Alias (E)) loop - E := Alias (E); - end loop; - if not Is_Predefined_Dispatching_Operation (E) and then not Is_Abstract_Subprogram (E) and then not Present (Interface_Alias (E)) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 38f45a850591..3e8311b60970 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -51,6 +51,7 @@ with Sem_Cat; use Sem_Cat; with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; with Sem_Dist; use Sem_Dist; +with Sem_Elim; use Sem_Elim; with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Type; use Sem_Type; @@ -573,6 +574,10 @@ package body Sem_Attr is Error_Attr ("attribute% cannot be applied to a subprogram", P); end if; + -- Issue an error if the prefix denotes an eliminated subprogram + + Check_For_Eliminated_Subprogram (P, Entity (P)); + -- Build the appropriate subprogram type Build_Access_Subprogram_Type (P); @@ -2076,6 +2081,11 @@ package body Sem_Attr is Error_Msg_N ("cannot take Address of intrinsic subprogram", N); end if; + + -- Issue an error if prefix denotes an eliminated subprogram + + else + Check_For_Eliminated_Subprogram (P, Ent); end if; elsif Is_Object (Ent) @@ -2516,6 +2526,11 @@ package body Sem_Attr is then Error_Attr ("invalid prefix for % attribute", P); Set_Address_Taken (Entity (P)); + + -- Issue an error if the prefix denotes an eliminated subprogram + + else + Check_For_Eliminated_Subprogram (P, Entity (P)); end if; Set_Etype (N, RTE (RE_Address)); diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 44ec9c332538..576ecbc701c6 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -44,7 +44,6 @@ with Sem; use Sem; with Sem_Aux; use Sem_Aux; with Sem_Ch3; use Sem_Ch3; with Sem_Ch6; use Sem_Ch6; -with Sem_Elim; use Sem_Elim; with Sem_Eval; use Sem_Eval; with Sem_Type; use Sem_Type; with Sem_Util; use Sem_Util; @@ -486,10 +485,6 @@ package body Sem_Disp is Set_Controlling_Argument (N, Control); Check_Restriction (No_Dispatching_Calls, N); - if Is_Eliminated (Ultimate_Alias (Subp_Entity)) then - Eliminate_Error_Msg (N, Ultimate_Alias (Subp_Entity)); - end if; - -- If there is a statically tagged actual and a tag-indeterminate -- call to a function of the ancestor (such as that provided by a -- default), then treat this as a dispatching call and propagate diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb index 6dd7021e7cf1..ddcb32b8fc59 100644 --- a/gcc/ada/sem_elim.adb +++ b/gcc/ada/sem_elim.adb @@ -28,7 +28,9 @@ with Einfo; use Einfo; with Errout; use Errout; with Namet; use Namet; with Nlists; use Nlists; +with Sem; use Sem; with Sem_Prag; use Sem_Prag; +with Sem_Util; use Sem_Util; with Sinput; use Sinput; with Sinfo; use Sinfo; with Snames; use Snames; @@ -662,6 +664,30 @@ package body Sem_Elim is return; end Check_Eliminated; + ------------------------------------- + -- Check_For_Eliminated_Subprogram -- + ------------------------------------- + + procedure Check_For_Eliminated_Subprogram (N : Node_Id; S : Entity_Id) is + Ultimate_Subp : constant Entity_Id := Ultimate_Alias (S); + Enclosing_Subp : Entity_Id; + + begin + if Is_Eliminated (Ultimate_Subp) and then not Inside_A_Generic then + + Enclosing_Subp := Current_Subprogram; + while Present (Enclosing_Subp) loop + if Is_Eliminated (Enclosing_Subp) then + return; + end if; + + Enclosing_Subp := Enclosing_Subprogram (Enclosing_Subp); + end loop; + + Eliminate_Error_Msg (N, Ultimate_Subp); + end if; + end Check_For_Eliminated_Subprogram; + ------------------------- -- Eliminate_Error_Msg -- ------------------------- diff --git a/gcc/ada/sem_elim.ads b/gcc/ada/sem_elim.ads index 53f0de0c9c0f..9bb1596336d5 100644 --- a/gcc/ada/sem_elim.ads +++ b/gcc/ada/sem_elim.ads @@ -52,9 +52,17 @@ package Sem_Elim is -- Checks if entity E is eliminated, and if so sets the Is_Eliminated -- flag on the given entity. + procedure Check_For_Eliminated_Subprogram (N : Node_Id; S : Entity_Id); + -- Check that the subprogram S (or its ultimate parent in the case of a + -- derived subprogram or renaming) has not been eliminated. An error will + -- be flagged if the subprogram has been eliminated, unless the node N + -- occurs within an eliminated subprogram or within a generic unit. The + -- error will be posted on N. + procedure Eliminate_Error_Msg (N : Node_Id; E : Entity_Id); - -- Called by the front-end and back-end on encountering a call to an - -- eliminated subprogram. N is the node for the call, and E is the - -- entity of the subprogram being eliminated. + -- Called by the front-end and back-end on encountering a reference to an + -- eliminated subprogram. N is the node for the reference (such as occurs + -- in a call or attribute), and E is the entity of the subprogram that has + -- been eliminated. end Sem_Elim; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 676cbc2bf424..e166954e3901 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -60,6 +60,7 @@ with Sem_Ch8; use Sem_Ch8; with Sem_Ch13; use Sem_Ch13; with Sem_Disp; use Sem_Disp; with Sem_Dist; use Sem_Dist; +with Sem_Elim; use Sem_Elim; with Sem_Elab; use Sem_Elab; with Sem_Eval; use Sem_Eval; with Sem_Intr; use Sem_Intr; @@ -5255,6 +5256,10 @@ package body Sem_Res is Check_Potentially_Blocking_Operation (N); end if; + -- Issue an error for a call to an eliminated subprogram + + Check_For_Eliminated_Subprogram (Subp, Nam); + -- All done, evaluate call and deal with elaboration issues Eval_Call (N);