[multiple changes]
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. From-SVN: r164064
This commit is contained in:
parent
a24008b659
commit
3a89c57d9e
|
@ -1,3 +1,17 @@
|
|||
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.
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Reference in New Issue