diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 14 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/exp_ch8.adb | 76 | ||||
| -rw-r--r-- | gcc/ada/sem.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 5 |
5 files changed, 96 insertions, 10 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c6e3b62..fe15868 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,19 @@ 2010-09-09 Ed Schonberg <schonberg@adacore.com> + * exp_ch3.adb (Build_Untagged_Equality): Do not set alias of implicit + inequality, it is always rewritten as the negation of the corresponding + equality operation. + * exp_ch8.adb (Expand_N_Subprogram_Renaming): If the subprogram renames + the predefined equality of an untagged record, create a body at the + point of the renaming, to capture the current meaning of equality for + the type. + +2010-09-09 Robert Dewar <dewar@adacore.com> + + * sem.adb, sem_warn.adb: Minor reformatting. + +2010-09-09 Ed Schonberg <schonberg@adacore.com> + * sem_ch6.adb: Improve error message on untagged equality. * sem.adb (Semantics): Include subprogram bodies that act as spec. diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 93303f9..1aec34c 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -3873,7 +3873,6 @@ package body Exp_Ch3 is (Op, Is_Abstract_Subprogram (Eq_Op)); if Chars (Next_Entity (Op)) = Name_Op_Ne then - Set_Alias (Next_Entity (Op), NE_Op); Set_Is_Abstract_Subprogram (Next_Entity (Op), Is_Abstract_Subprogram (NE_Op)); end if; diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb index fc28371..b81fb42 100644 --- a/gcc/ada/exp_ch8.adb +++ b/gcc/ada/exp_ch8.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -25,16 +25,22 @@ with Atree; use Atree; with Einfo; use Einfo; +with Exp_Ch4; use Exp_Ch4; with Exp_Ch6; use Exp_Ch6; with Exp_Dbug; use Exp_Dbug; with Exp_Util; use Exp_Util; with Freeze; use Freeze; +with Namet; use Namet; +with Nmake; use Nmake; with Nlists; use Nlists; with Opt; use Opt; with Sem; use Sem; with Sem_Ch8; use Sem_Ch8; +with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; +with Snames; use Snames; with Stand; use Stand; +with Tbuild; use Tbuild; package body Exp_Ch8 is @@ -350,6 +356,74 @@ package body Exp_Ch8 is elsif Nkind (Nam) = N_Explicit_Dereference then Force_Evaluation (Prefix (Nam)); end if; + + -- Check whether this is a renaming of a predefined equality on an + -- untagged record type (AI05-0123). + + if Is_Entity_Name (Nam) + and then Chars (Entity (Nam)) = Name_Op_Eq + and then Scope (Entity (Nam)) = Standard_Standard + and then Ada_Version >= Ada_2012 + then + declare + Loc : constant Source_Ptr := Sloc (N); + Id : constant Entity_Id := Defining_Entity (N); + Typ : constant Entity_Id := Etype (First_Formal (Id)); + + Decl : Node_Id; + Body_Id : constant Entity_Id + := Make_Defining_Identifier (Sloc (N), Chars (Id)); + + begin + if Is_Record_Type (Typ) + and then not Is_Tagged_Type (Typ) + and then not Is_Frozen (Typ) + then + -- Build body for renamed equality, to capture its current + -- meaning. It may be redefined later, but the renaming is + -- elaborated where it occurs. This is technically known as + -- Squirreling semantics. Renaming is rewritten as a subprogram + -- declaration, and the body is inserted at the end of the + -- current declaration list to prevent premature freezing. + + Set_Alias (Id, Empty); + Set_Has_Completion (Id, False); + Rewrite (N, + Make_Subprogram_Declaration (Sloc (N), + Specification => Specification (N))); + Set_Has_Delayed_Freeze (Id); + + Decl := Make_Subprogram_Body (Loc, + Specification => + Make_Function_Specification (Loc, + Defining_Unit_Name => Body_Id, + Parameter_Specifications => Copy_Parameter_List (Id), + Result_Definition => + New_Occurrence_Of (Standard_Boolean, Loc)), + Declarations => Empty_List, + Handled_Statement_Sequence => Empty); + + Set_Handled_Statement_Sequence (Decl, + Make_Handled_Sequence_Of_Statements (Loc, + Statements => New_List ( + Make_Simple_Return_Statement (Loc, + Expression => + Expand_Record_Equality ( + Id, + Typ => Typ, + Lhs => + Make_Identifier (Loc, + Chars (First_Formal (Id))), + Rhs => + Make_Identifier (Loc, + Chars (Next_Formal (First_Formal (Id)))), + Bodies => Declarations (Decl)))))); + + Append (Decl, List_Containing (N)); + Set_Debug_Info_Needed (Body_Id); + end if; + end; + end if; end Expand_N_Subprogram_Renaming_Declaration; end Exp_Ch8; diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 45f7216..2955b1c 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1452,18 +1452,18 @@ package body Sem is end if; -- Do analysis, and then append the compilation unit onto the - -- Comp_Unit_List, if appropriate. This is done after analysis, so - -- if this unit depends on some others, they have already been + -- Comp_Unit_List, if appropriate. This is done after analysis, + -- so if this unit depends on some others, they have already been -- appended. We ignore bodies, except for the main unit itself, and - -- for subprogram bodies that act as specs. We have also to guard - -- against ill-formed subunits that have an improper context. + -- for subprogram bodies that act as specs. We have also to guard + -- against ill-formed subunits that have an improper context. Do_Analyze; if Present (Comp_Unit) and then Nkind (Unit (Comp_Unit)) in N_Proper_Body and then (Nkind (Unit (Comp_Unit)) /= N_Subprogram_Body - or else not Acts_As_Spec (Comp_Unit)) + or else not Acts_As_Spec (Comp_Unit)) and then not In_Extended_Main_Source_Unit (Comp_Unit) then null; diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 7f18a75..95d0826 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -1422,8 +1422,7 @@ package body Sem_Warn is or else Referenced_As_Out_Parameter_Check_Spec (E1)) - -- Labels, and enumeration literals, and exceptions. The - -- warnings are also placed on local packages that cannot be + -- All other entities, including local packages that cannot be -- referenced from elsewhere, including those declared within a -- package body. @@ -1568,7 +1567,7 @@ package body Sem_Warn is if not Warnings_Off_E1 then Unreferenced_Entities.Append (E1); - -- Force warning on entity + -- Force warning on entity Set_Referenced (E1, False); end if; |