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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164064 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c6e3b62..fe15868 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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;