diff options
author | Gary Dismukes <dismukes@adacore.com> | 2009-04-20 11:37:30 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2009-04-20 11:37:30 +0200 |
commit | 16212e894ae04b6de4d10d6992c2eabe1d6866ac (patch) | |
tree | 067b6fb3d3db09d6874a82087fceda2ef195ae17 | |
parent | 6e55ac7a64a64ac0b066e5fc67969fa47a8f0e89 (diff) | |
download | gcc-16212e894ae04b6de4d10d6992c2eabe1d6866ac.zip gcc-16212e894ae04b6de4d10d6992c2eabe1d6866ac.tar.gz gcc-16212e894ae04b6de4d10d6992c2eabe1d6866ac.tar.bz2 |
sem_elim.ads (Check_For_Eliminated_Subprogram): New procedure for checking for references to eliminated subprograms that should...
2009-04-20 Gary Dismukes <dismukes@adacore.com>
* 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
-rw-r--r-- | gcc/ada/exp_disp.adb | 15 | ||||
-rw-r--r-- | gcc/ada/sem_attr.adb | 15 | ||||
-rw-r--r-- | gcc/ada/sem_disp.adb | 5 | ||||
-rw-r--r-- | gcc/ada/sem_elim.adb | 26 | ||||
-rw-r--r-- | gcc/ada/sem_elim.ads | 14 | ||||
-rw-r--r-- | gcc/ada/sem_res.adb | 5 |
6 files changed, 63 insertions, 17 deletions
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index d090320..2a6f347 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 38f45a8..3e8311b 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 44ec9c3..576ecbc 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 6dd7021..ddcb32b 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 53f0de0..9bb1596 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 676cbc2..e166954 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); |