[Ada] fix bug in handling of equality operator
Arnaud Charlet
charlet@adacore.com
Tue Mar 15 15:39:00 GMT 2005
Tested on i686-linux. Committed on mainline.
An implicit inequality operator is created whenever there is user-defined
equality operation, either inherited or explicit. The inequality is built
only for semantic analysis, and eventually rewritten as the negation of
the corresponding equality operation. Because of this transient nature,
it is handled in an abbreviated matter, and its declaration is not visible
to the back-end. Previous code simply set the Parent field of the operator
declaration. This is incorrect when the operation is declared in a private
part and overrides an inherited operation declared in the visible part
of a package. Because the declaration was not properly part of a list of
declarations, the predicate Is_Private_Operation could malfunction, either
aborting when built with assertions, or returning an incorrect result. The
new code ensures that Is_Private_Operation works properly.
The following procedure must compile and execute quietly:
with P; use P;
with text_io; use text_io;
procedure try is
this, that: t;
yes : boolean := this /= that;
begin if not yes then put_line ("FAILED"); end if; end;
package q is
type t is null record;
function "=" (this, that: t) return boolean;
end;
package body q is
function "=" (this, that: t) return boolean is begin return False; end;
end;
with q;
package p is
type t is new q.t;
private
function "=" (this, that: t) return boolean;
end;
package body p is
function "=" (this, that: t) return boolean is begin return True; end;
this, that : t;
end;
2005-03-08 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Is_Private_Declaration): Verify that the declaration is
attached to a list before checking whether it appears in the private
declarations of the current package.
(Make_Inequality_Operator): Insert declaration in proper declarative
list rather than just setting the Parent field, so that
Is_Private_Declaration can handle it properly.
-------------- next part --------------
Index: sem_ch6.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch6.adb,v
retrieving revision 1.30
diff -u -p -r1.30 sem_ch6.adb
--- sem_ch6.adb 10 Feb 2005 13:50:45 -0000 1.30
+++ sem_ch6.adb 15 Mar 2005 13:56:17 -0000
@@ -255,7 +255,6 @@ package body Sem_Ch6 is
if Present (L) then
Actual := First (L);
-
while Present (Actual) loop
Analyze (Actual);
Check_Parameterless_Call (Actual);
@@ -1511,7 +1510,6 @@ package body Sem_Ch6 is
then
Check_Overriding_Operation (N, Designator);
end if;
-
end Analyze_Subprogram_Declaration;
--------------------------------------
@@ -2311,7 +2309,6 @@ package body Sem_Ch6 is
Conformance_Error ("too many parameters!", New_Formal);
return;
end if;
-
end Check_Conformance;
------------------------------
@@ -2552,7 +2549,6 @@ package body Sem_Ch6 is
Err_Loc : Node_Id := Empty)
is
Result : Boolean;
-
begin
Check_Conformance
(New_Id, Old_Id, Fully_Conformant, True, Result, Err_Loc);
@@ -3285,7 +3281,6 @@ package body Sem_Ch6 is
else
return False;
end if;
-
end Conforming_Types;
--------------------------
@@ -3642,7 +3637,6 @@ package body Sem_Ch6 is
function Fully_Conformant (New_Id, Old_Id : Entity_Id) return Boolean is
Result : Boolean;
-
begin
Check_Conformance (New_Id, Old_Id, Fully_Conformant, False, Result);
return Result;
@@ -4374,25 +4368,31 @@ package body Sem_Ch6 is
Subtype_Mark => New_Reference_To (Standard_Boolean, Loc)));
-- Insert inequality right after equality if it is explicit or after
- -- the derived type when implicit. These entities are created only
- -- for visibility purposes, and eventually replaced in the course of
+ -- the derived type when implicit. These entities are created only for
+ -- visibility purposes, and eventually replaced in the course of
-- expansion, so they do not need to be attached to the tree and seen
-- by the back-end. Keeping them internal also avoids spurious freezing
- -- problems. The parent field is set simply to make analysis safe.
+ -- problems. The declaration is inserted in the tree for analysis, and
+ -- removed afterwards. If the equality operator comes from an explicit
+ -- declaration, attach the inequality immediately after. Else the
+ -- equality is inherited from a derived type declaration, so insert
+ -- inequality after that declaration.
if No (Alias (S)) then
- Set_Parent (Decl, Parent (Unit_Declaration_Node (S)));
+ Insert_After (Unit_Declaration_Node (S), Decl);
+ elsif Is_List_Member (Parent (S)) then
+ Insert_After (Parent (S), Decl);
else
- Set_Parent (Decl, Parent (Parent (Etype (First_Formal (S)))));
+ Insert_After (Parent (Etype (First_Formal (S))), Decl);
end if;
Mark_Rewrite_Insertion (Decl);
Set_Is_Intrinsic_Subprogram (Op_Name);
Analyze (Decl);
+ Remove (Decl);
Set_Has_Completion (Op_Name);
Set_Corresponding_Equality (Op_Name, S);
Set_Is_Abstract (Op_Name, Is_Abstract (S));
-
end Make_Inequality_Operator;
----------------------
@@ -4472,7 +4472,9 @@ package body Sem_Ch6 is
Specification (Unit_Declaration_Node (Current_Scope)));
return In_Package_Body (Current_Scope)
- or else List_Containing (Decl) = Priv_Decls
+ or else
+ (Is_List_Member (Decl)
+ and then List_Containing (Decl) = Priv_Decls)
or else (Nkind (Parent (Decl)) = N_Package_Specification
and then not Is_Compilation_Unit (
Defining_Entity (Parent (Decl)))
@@ -4858,7 +4860,7 @@ package body Sem_Ch6 is
-- If the private operation is dispatching, we achieve
-- the overriding by keeping the implicit operation
- -- but setting its alias to be the overring one. In
+ -- but setting its alias to be the overriding one. In
-- this fashion the proper body is executed in all
-- cases, but the original signature is used outside
-- of the package.
@@ -5511,7 +5513,6 @@ package body Sem_Ch6 is
function Subtype_Conformant (New_Id, Old_Id : Entity_Id) return Boolean is
Result : Boolean;
-
begin
Check_Conformance (New_Id, Old_Id, Subtype_Conformant, False, Result);
return Result;
More information about the Gcc-patches
mailing list