OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[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:
Arnaud Charlet 2010-09-09 12:05:15 +02:00
parent a24008b659
commit 3a89c57d9e
5 changed files with 96 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/ada/ChangeLog
View File

@ -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.

1
gcc/ada/exp_ch3.adb
View File

@ -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;

76
gcc/ada/exp_ch8.adb
View File

@ -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;

10
gcc/ada/sem.adb
View File

@ -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;

5
gcc/ada/sem_warn.adb
View File

@ -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;