Commit 3c92a2b8 by Arnaud Charlet

Minor reformatting.

From-SVN: r149475
parent 811c6a85
...@@ -3584,7 +3584,7 @@ package body Sem_Prag is ...@@ -3584,7 +3584,7 @@ package body Sem_Prag is
end if; end if;
-- Components of imported CPP types must not have default -- Components of imported CPP types must not have default
-- expressions because the constructor (if any) is in the -- expressions because the constructor (if any) is on the
-- C++ side. -- C++ side.
declare declare
...@@ -6309,9 +6309,9 @@ package body Sem_Prag is ...@@ -6309,9 +6309,9 @@ package body Sem_Prag is
-- because in C++ they don't have a dispatch table slot. -- because in C++ they don't have a dispatch table slot.
-- However, in Ada the constructor has the profile of a -- However, in Ada the constructor has the profile of a
-- function that returns a tagged type and therefore it has -- function that returns a tagged type and therefore it has
-- been considered by the Semantic analyzer a dispatching -- been treated as a primitive operation during semantic
-- primitive operation. We extract it now from the list of -- analysis. We now remove it from the list of primitive
-- primitive operations of the type. -- operations of the type.
if Is_Tagged_Type (Etype (Def_Id)) if Is_Tagged_Type (Etype (Def_Id))
and then not Is_Class_Wide_Type (Etype (Def_Id)) and then not Is_Class_Wide_Type (Etype (Def_Id))
...@@ -6320,9 +6320,7 @@ package body Sem_Prag is ...@@ -6320,9 +6320,7 @@ package body Sem_Prag is
Tag_Typ := Etype (Def_Id); Tag_Typ := Etype (Def_Id);
Elmt := First_Elmt (Primitive_Operations (Tag_Typ)); Elmt := First_Elmt (Primitive_Operations (Tag_Typ));
while Present (Elmt) while Present (Elmt) and then Node (Elmt) /= Def_Id loop
and then Node (Elmt) /= Def_Id
loop
Next_Elmt (Elmt); Next_Elmt (Elmt);
end loop; end loop;
...@@ -6331,8 +6329,8 @@ package body Sem_Prag is ...@@ -6331,8 +6329,8 @@ package body Sem_Prag is
end if; end if;
-- For backward compatibility, if the constructor returns a -- For backward compatibility, if the constructor returns a
-- class wide type we internally change the returned type to -- class wide type, and we internally change the return type to
-- the corresponding non class-wide type. -- the corresponding root type.
if Is_Class_Wide_Type (Etype (Def_Id)) then if Is_Class_Wide_Type (Etype (Def_Id)) then
Set_Etype (Def_Id, Root_Type (Etype (Def_Id))); Set_Etype (Def_Id, Root_Type (Etype (Def_Id)));
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment