Commit 129bbe43 by Robert Dewar Committed by Arnaud Charlet

sem_ch3.adb, [...]: Minor reformatting.

2014-06-13  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, sem_ch9.adb, a-coinho.adb, a-coinho.ads: Minor
	reformatting.

From-SVN: r211628
parent aca670a0
2014-06-13 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_ch9.adb, a-coinho.adb, a-coinho.ads: Minor
reformatting.
2014-06-13 Hristian Kirtchev <kirtchev@adacore.com> 2014-06-13 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Analyze_Pragma): Add local * sem_prag.adb (Analyze_Pragma): Add local
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2014, Free Software Foundation, Inc. -- -- Copyright (C) 2012-2014, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -65,7 +65,11 @@ package body Ada.Containers.Indefinite_Holders is ...@@ -65,7 +65,11 @@ package body Ada.Containers.Indefinite_Holders is
overriding procedure Adjust (Control : in out Reference_Control_Type) is overriding procedure Adjust (Control : in out Reference_Control_Type) is
begin begin
if Control.Container /= null then if Control.Container /= null then
Control.Container.Busy := Control.Container.Busy + 1; declare
B : Natural renames Control.Container.Busy;
begin
B := B + 1;
end;
end if; end if;
end Adjust; end Adjust;
...@@ -109,9 +113,11 @@ package body Ada.Containers.Indefinite_Holders is ...@@ -109,9 +113,11 @@ package body Ada.Containers.Indefinite_Holders is
(Container : aliased Holder) return Constant_Reference_Type (Container : aliased Holder) return Constant_Reference_Type
is is
Ref : constant Constant_Reference_Type := Ref : constant Constant_Reference_Type :=
(Element => Container.Element, (Element => Container.Element.all'Access,
Control => (Controlled with Container'Unrestricted_Access)); Control => (Controlled with Container'Unrestricted_Access));
B : Natural renames Ref.Control.Container.Busy;
begin begin
B := B + 1;
return Ref; return Ref;
end Constant_Reference; end Constant_Reference;
...@@ -154,13 +160,16 @@ package body Ada.Containers.Indefinite_Holders is ...@@ -154,13 +160,16 @@ package body Ada.Containers.Indefinite_Holders is
Free (Container.Element); Free (Container.Element);
end Finalize; end Finalize;
overriding procedure Finalize (Control : in out Reference_Control_Type) overriding procedure Finalize (Control : in out Reference_Control_Type) is
is
begin begin
if Control.Container /= null then if Control.Container /= null then
Control.Container.Busy := Control.Container.Busy - 1; declare
B : Natural renames Control.Container.Busy;
begin
B := B - 1;
end;
end if; end if;
Control.Container := null; Control.Container := null;
end Finalize; end Finalize;
...@@ -262,9 +271,10 @@ package body Ada.Containers.Indefinite_Holders is ...@@ -262,9 +271,10 @@ package body Ada.Containers.Indefinite_Holders is
(Container : aliased in out Holder) return Reference_Type (Container : aliased in out Holder) return Reference_Type
is is
Ref : constant Reference_Type := Ref : constant Reference_Type :=
(Element => Container.Element, (Element => Container.Element.all'Access,
Control => (Controlled with Container'Unrestricted_Access)); Control => (Controlled with Container'Unrestricted_Access));
begin begin
Container.Busy := Container.Busy + 1;
return Ref; return Ref;
end Reference; end Reference;
...@@ -301,6 +311,7 @@ package body Ada.Containers.Indefinite_Holders is ...@@ -301,6 +311,7 @@ package body Ada.Containers.Indefinite_Holders is
--------------- ---------------
function To_Holder (New_Item : Element_Type) return Holder is function To_Holder (New_Item : Element_Type) return Holder is
-- The element allocator may need an accessibility check in the case the -- The element allocator may need an accessibility check in the case the
-- actual type is class-wide or has access discriminants (RM 4.8(10.1) -- actual type is class-wide or has access discriminants (RM 4.8(10.1)
-- and AI12-0035). -- and AI12-0035).
...@@ -354,6 +365,7 @@ package body Ada.Containers.Indefinite_Holders is ...@@ -354,6 +365,7 @@ package body Ada.Containers.Indefinite_Holders is
Element_Type'Output (Stream, Container.Element.all); Element_Type'Output (Stream, Container.Element.all);
end if; end if;
end Write; end Write;
procedure Write procedure Write
(Stream : not null access Root_Stream_Type'Class; (Stream : not null access Root_Stream_Type'Class;
Item : Reference_Type) Item : Reference_Type)
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2014, Free Software Foundation, Inc. -- -- Copyright (C) 2011-2014, Free Software Foundation, Inc. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -131,8 +131,8 @@ private ...@@ -131,8 +131,8 @@ private
pragma Inline (Finalize); pragma Inline (Finalize);
type Constant_Reference_Type type Constant_Reference_Type
(Element : not null access constant Element_Type) (Element : not null access constant Element_Type) is
is record record
Control : Reference_Control_Type; Control : Reference_Control_Type;
end record; end record;
...@@ -148,9 +148,7 @@ private ...@@ -148,9 +148,7 @@ private
for Constant_Reference_Type'Read use Read; for Constant_Reference_Type'Read use Read;
type Reference_Type type Reference_Type (Element : not null access Element_Type) is record
(Element : not null access Element_Type)
is record
Control : Reference_Control_Type; Control : Reference_Control_Type;
end record; end record;
......
...@@ -15598,11 +15598,10 @@ package body Sem_Ch3 is ...@@ -15598,11 +15598,10 @@ package body Sem_Ch3 is
end if; end if;
elsif Nkind (N) = N_Full_Type_Declaration elsif Nkind (N) = N_Full_Type_Declaration
and then and then Nkind_In
(Nkind (Type_Definition (N)) = N_Record_Definition (Type_Definition (N), N_Record_Definition,
or else Nkind (Type_Definition (N)) N_Derived_Type_Definition)
= N_Derived_Type_Definition) and then Interface_Present (Type_Definition (N))
and then Interface_Present (Type_Definition (N))
then then
Error_Msg_N Error_Msg_N
("completion of private type cannot be an interface", N); ("completion of private type cannot be an interface", N);
...@@ -18309,16 +18308,16 @@ package body Sem_Ch3 is ...@@ -18309,16 +18308,16 @@ package body Sem_Ch3 is
if Present (Iface) then if Present (Iface) then
Error_Msg_NE Error_Msg_NE
("interface in partial view& not implemented by full type " & ("interface in partial view& not implemented by full type "
"(RM-2005 7.3 (7.3/2))", Full_T, Iface); & "(RM-2005 7.3 (7.3/2))", Full_T, Iface);
end if; end if;
Iface := Find_Hidden_Interface (Full_T_Ifaces, Priv_T_Ifaces); Iface := Find_Hidden_Interface (Full_T_Ifaces, Priv_T_Ifaces);
if Present (Iface) then if Present (Iface) then
Error_Msg_NE Error_Msg_NE
("interface & not implemented by partial view " & ("interface & not implemented by partial view "
"(RM-2005 7.3 (7.3/2))", Full_T, Iface); & "(RM-2005 7.3 (7.3/2))", Full_T, Iface);
end if; end if;
end; end;
end if; end if;
...@@ -18349,7 +18348,7 @@ package body Sem_Ch3 is ...@@ -18349,7 +18348,7 @@ package body Sem_Ch3 is
if Priv_Parent = Any_Type or else Full_Parent = Any_Type then if Priv_Parent = Any_Type or else Full_Parent = Any_Type then
return; return;
-- Ada 2005 (AI-251): Interfaces in the full-typ can be given in -- Ada 2005 (AI-251): Interfaces in the full type can be given in
-- any order. Therefore we don't have to check that its parent must -- any order. Therefore we don't have to check that its parent must
-- be a descendant of the parent of the private type declaration. -- be a descendant of the parent of the private type declaration.
......
...@@ -3328,7 +3328,7 @@ package body Sem_Ch9 is ...@@ -3328,7 +3328,7 @@ package body Sem_Ch9 is
if Present (Iface) then if Present (Iface) then
Error_Msg_NE Error_Msg_NE
("interface in partial view& not implemented by full " ("interface in partial view& not implemented by full "
& "type (RM-2005 7.3 (7.3/2))", T, Iface); & "type (RM-2005 7.3 (7.3/2))", T, Iface);
end if; end if;
Iface := Find_Hidden_Interface (Full_T_Ifaces, Priv_T_Ifaces); Iface := Find_Hidden_Interface (Full_T_Ifaces, Priv_T_Ifaces);
......
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