procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
2012-07-30  Robert Dewar  <dewar@adacore.com>

	* par_sco.adb, a-cihama.adb, a-coinve.adb, exp_ch7.adb, a-ciorse.adb,
	exp_ch9.adb, sem_dim.adb, par-ch13.adb, sem_ch9.adb, a-cidlli.adb,
	a-cimutr.adb, freeze.adb, a-ciormu.adb, sem_res.adb, sem_attr.adb,
	a-cihase.adb, exp_ch4.adb, sem_ch4.adb, a-ciorma.adb,
	s-tasinf-linux.ads, sem_ch13.adb, a-coinho.adb: Minor reformatting.
	Add comments.

From-SVN: r189977
This commit is contained in:
Robert Dewar 2012-07-30 15:15:00 +00:00 • committed by Arnaud Charlet
parent b5059fa089
commit 29ba9f52ee
23 changed files with 201 additions and 105 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gcc/ada/ChangeLog
View file

@ -1,3 +1,12 @@
2012-07-30 Robert Dewar <dewar@adacore.com>
* par_sco.adb, a-cihama.adb, a-coinve.adb, exp_ch7.adb, a-ciorse.adb,
exp_ch9.adb, sem_dim.adb, par-ch13.adb, sem_ch9.adb, a-cidlli.adb,
a-cimutr.adb, freeze.adb, a-ciormu.adb, sem_res.adb, sem_attr.adb,
a-cihase.adb, exp_ch4.adb, sem_ch4.adb, a-ciorma.adb,
s-tasinf-linux.ads, sem_ch13.adb, a-coinho.adb: Minor reformatting.
Add comments.
2012-07-30 Vincent Pucci <pucci@adacore.com>
* sem_ch9.adb (Allows_Lock_Free_Implementation): Restrict implicit

9
gcc/ada/a-cidlli.adb
View file

@ -888,16 +888,19 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
end if;
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035). We don't unsuppress the check on the
-- allocator in the loop below, because the one in this block would
-- have failed already.
pragma Unsuppress (Accessibility_Check);
Element : Element_Access := new Element_Type'(New_Item);
begin
New_Node := new Node_Type'(Element, null, null);
exception
when others =>
Free (Element);
@ -1468,12 +1471,14 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
pragma Assert (Vet (Position), "bad cursor in Replace_Element");
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
X : Element_Access := Position.Node.Element;
begin
Position.Node.Element := new Element_Type'(New_Item);
Free (X);

18
gcc/ada/a-cihama.adb
View file

@ -695,12 +695,15 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
Position.Node.Key := new Key_Type'(Key);
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the
-- case the actual type is class-wide or has access discriminants
-- (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Position.Node.Element := new Element_Type'(New_Item);
exception
when others =>
Free_Key (K);
@ -736,14 +739,16 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
K : Key_Access := new Key_Type'(Key);
E : Element_Access;
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
E := new Element_Type'(New_Item);
return new Node_Type'(K, E, Next);
exception
when others =>
Free_Key (K);
@ -1177,12 +1182,15 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
Node.Key := new Key_Type'(Key);
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Node.Element := new Element_Type'(New_Item);
exception
when others =>
Free_Key (K);
@ -1230,10 +1238,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
declare
X : Element_Access := Position.Node.Element;
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Position.Node.Element := new Element_Type'(New_Item);
Free_Element (X);

28
gcc/ada/a-cihase.adb
View file

@ -186,10 +186,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
procedure Assign (Node : Node_Access; Item : Element_Type) is
X : Element_Access := Node.Element;
pragma Unsuppress (Accessibility_Check);
-- 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)
-- and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Node.Element := new Element_Type'(Item);
Free_Element (X);
@ -199,10 +201,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
begin
if Target'Address = Source'Address then
return;
else
Target.Clear;
Target.Union (Source);
end if;
Target.Clear;
Target.Union (Source);
end Assign;
--------------
@ -813,10 +815,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
X := Position.Node.Element;
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the
-- case the actual type is class-wide or has access discriminants
-- (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Position.Node.Element := new Element_Type'(New_Item);
end;
@ -875,14 +879,18 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
--------------
function New_Node (Next : Node_Access) return Node_Access is
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
Element : Element_Access := new Element_Type'(New_Item);
begin
return new Node_Type'(Element, Next);
exception
when others =>
Free_Element (Element);
@ -898,9 +906,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Local_Insert (HT, New_Item, Node, Inserted);
if Inserted
and then HT.Length > HT_Ops.Capacity (HT)
then
if Inserted and then HT.Length > HT_Ops.Capacity (HT) then
HT_Ops.Reserve_Capacity (HT, HT.Length);
end if;
end Insert;
@ -1335,10 +1341,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
X := Node.Element;
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Node.Element := new Element_Type'(New_Item);
end;

16
gcc/ada/a-cimutr.adb
View file

@ -292,12 +292,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
end if;
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035). We don't unsuppress the check on the
-- allocator in the loop below, because the one in this block would
-- have failed already.
pragma Unsuppress (Accessibility_Check);
begin
Element := new Element_Type'(New_Item);
end;
@ -1251,12 +1253,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
Position.Container := Parent.Container;
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035). We don't unsuppress the check on the
-- allocator in the loop below, because the one in this block would
-- have failed already.
pragma Unsuppress (Accessibility_Check);
begin
Element := new Element_Type'(New_Item);
end;
@ -1826,12 +1830,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
end if;
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035). We don't unsuppress the check on the
-- allocator in the loop below, because the one in this block would
-- have failed already.
pragma Unsuppress (Accessibility_Check);
begin
Element := new Element_Type'(New_Item);
end;
@ -2194,10 +2200,12 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
end if;
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
E := new Element_Type'(New_Item);
end;

23
gcc/ada/a-ciorma.adb
View file

@ -813,12 +813,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
Position.Node.Key := new Key_Type'(Key);
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the
-- case the actual type is class-wide or has access discriminants
-- (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Position.Node.Element := new Element_Type'(New_Item);
exception
when others =>
Free_Key (K);
@ -857,10 +860,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function New_Node return Node_Access is
Node : Node_Access := new Node_Type;
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Node.Key := new Key_Type'(Key);
Node.Element := new Element_Type'(New_Item);
@ -869,9 +874,10 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
exception
when others =>
-- On exception, deallocate key and elem
-- On exception, deallocate key and elem. Note that free
-- deallocates both the key and the elem.
Free (Node); -- Note that Free deallocates key and elem too
Free (Node);
raise;
end New_Node;
@ -1502,12 +1508,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
Node.Key := new Key_Type'(Key);
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Node.Element := new Element_Type'(New_Item);
exception
when others =>
Free_Key (K);
@ -1556,10 +1565,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
declare
X : Element_Access := Position.Node.Element;
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Position.Node.Element := new Element_Type'(New_Item);
Free_Element (X);

13
gcc/ada/a-ciormu.adb
View file

@ -1167,11 +1167,12 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
--------------
function New_Node return Node_Access is
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
Element : Element_Access := new Element_Type'(New_Item);
begin
@ -1180,6 +1181,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
Right => null,
Color => Red_Black_Trees.Red,
Element => Element);
exception
when others =>
Free_Element (Element);
@ -1774,10 +1776,12 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
declare
X : Element_Access := Node.Element;
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the
-- case the actual type is class-wide or has access discriminants
-- (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Node.Element := new Element_Type'(Item);
Free_Element (X);
@ -1803,10 +1807,13 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
--------------
function New_Node return Node_Access is
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the
-- case the actual type is class-wide or has access discriminants
-- (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Node.Element := new Element_Type'(Item); -- OK if fails
Node.Color := Red_Black_Trees.Red;

29
gcc/ada/a-ciorse.adb
View file

@ -1174,10 +1174,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
end if;
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the
-- case the actual type is class-wide or has access discriminants
-- (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
X := Position.Node.Element;
Position.Node.Element := new Element_Type'(New_Item);
@ -1245,11 +1247,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
--------------
function New_Node return Node_Access is
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
Element : Element_Access := new Element_Type'(New_Item);
begin
@ -1258,6 +1261,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
Right => null,
Color => Red_Black_Trees.Red,
Element => Element);
exception
when others =>
Free_Element (Element);
@ -1831,10 +1835,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
end if;
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
X := Node.Element;
Node.Element := new Element_Type'(New_Item);
@ -1873,10 +1879,13 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
--------------
function New_Node return Node_Access is
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
-- RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Node.Element := new Element_Type'(Item); -- OK if fails
Node.Color := Red;
@ -1895,9 +1904,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
-- Start of processing for Replace_Element
begin
if Item < Node.Element.all
or else Node.Element.all < Item
then
if Item < Node.Element.all or else Node.Element.all < Item then
null;
else
@ -1907,10 +1914,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
end if;
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the
-- case the actual type is class-wide or has access discriminants
-- (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Node.Element := new Element_Type'(Item);
Free_Element (X);
@ -1932,10 +1941,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
end if;
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the
-- case actual type is class-wide or has access discriminants
-- (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Node.Element := new Element_Type'(Item);
Free_Element (X);

8
gcc/ada/a-coinho.adb
View file

@ -223,10 +223,12 @@ package body Ada.Containers.Indefinite_Holders is
declare
X : Element_Access := Container.Element;
pragma Unsuppress (Accessibility_Check);
-- Element allocator may need an accessibility check in case actual
-- type is class-wide or has access discriminants (RM 4.8(10.1) and
-- AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Container.Element := new Element_Type'(New_Item);
Free (X);
@ -238,10 +240,12 @@ package body Ada.Containers.Indefinite_Holders is
---------------
function To_Holder (New_Item : Element_Type) return Holder is
pragma Unsuppress (Accessibility_Check);
-- 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)
-- and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
return (AF.Controlled with new Element_Type'(New_Item), 0);
end To_Holder;

33
gcc/ada/a-coinve.adb
View file

@ -1699,10 +1699,12 @@ package body Ada.Containers.Indefinite_Vectors is
-- storage available, or because element initialization fails).
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the
-- case actual type is class-wide or has access discriminants
-- (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Container.Elements.EA (Idx) := new Element_Type'(New_Item);
end;
@ -1752,10 +1754,12 @@ package body Ada.Containers.Indefinite_Vectors is
-- initialization fails).
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check
-- in case the actual type is class-wide or has access
-- discriminants (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
E (Idx) := new Element_Type'(New_Item);
end;
@ -1794,11 +1798,14 @@ package body Ada.Containers.Indefinite_Vectors is
-- K always has a value if the exception handler triggers.
K := Before;
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in
-- the case the actual type is class-wide or has access
-- discriminants (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
while K < Index loop
E (K) := new Element_Type'(New_Item);
@ -1905,10 +1912,12 @@ package body Ada.Containers.Indefinite_Vectors is
-- initialization fails).
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in
-- the case the actual type is class-wide or has access
-- discriminants (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Dst.EA (Idx) := new Element_Type'(New_Item);
end;
@ -1952,10 +1961,12 @@ package body Ada.Containers.Indefinite_Vectors is
-- let it propagate.
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in
-- the case the actual type is class-wide or has access
-- discriminants (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Dst.EA (Idx) := new Element_Type'(New_Item);
end;
@ -3208,10 +3219,12 @@ package body Ada.Containers.Indefinite_Vectors is
declare
X : Element_Access := Container.Elements.EA (Index);
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- where the actual type is class-wide or has access discriminants
-- (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Container.Elements.EA (Index) := new Element_Type'(New_Item);
Free (X);
@ -3244,10 +3257,12 @@ package body Ada.Containers.Indefinite_Vectors is
declare
X : Element_Access := Container.Elements.EA (Position.Index);
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- where the actual type is class-wide or has access discriminants
-- (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
Container.Elements.EA (Position.Index) := new Element_Type'(New_Item);
Free (X);
@ -3993,10 +4008,12 @@ package body Ada.Containers.Indefinite_Vectors is
Last := Index_Type'First;
declare
pragma Unsuppress (Accessibility_Check);
-- The element allocator may need an accessibility check in the case
-- where the actual type is class-wide or has access discriminants
-- (see RM 4.8(10.1) and AI12-0035).
pragma Unsuppress (Accessibility_Check);
begin
loop
Elements.EA (Last) := new Element_Type'(New_Item);

3
gcc/ada/exp_ch4.adb
View file

@ -705,8 +705,7 @@ package body Exp_Ch4 is
or else
(Is_Class_Wide_Type (Etype (Exp))
and then Scope (PtrT) /= Current_Scope))
and then
(Tagged_Type_Expansion or else VM_Target /= No_VM)
and then (Tagged_Type_Expansion or else VM_Target /= No_VM)
then
-- If the allocator was built in place, Ref is already a reference
-- to the access object initialized to the result of the allocator

3
gcc/ada/exp_ch7.adb
View file

@ -4568,6 +4568,9 @@ package body Exp_Ch7 is
-- finalization blocks, and we put everything into a wrapper
-- block to clearly expose the construct to the back-end.
-- This requirement for "clearly expose" must be properly
-- documented in sinfo/einfo ???
if Present (Prev_Fin) then
Insert_Before_And_Analyze (Prev_Fin, Fin_Block);
else

4
gcc/ada/exp_ch9.adb
View file

@ -5485,6 +5485,7 @@ package body Exp_Ch9 is
procedure Ensure_Statement_Present (Loc : Source_Ptr; Alt : Node_Id) is
Stmt : Node_Id;
begin
if Opt.Suppress_Control_Flow_Optimizations
and then Is_Empty_List (Statements (Alt))
@ -5494,6 +5495,9 @@ package body Exp_Ch9 is
-- Mark NULL statement as coming from source so that it is not
-- eliminated by GIGI.
-- Another covert channel! If this is a requirement, it must be
-- documented in sinfo/einfo ???
Set_Comes_From_Source (Stmt, True);
Set_Statements (Alt, New_List (Stmt));

2
gcc/ada/freeze.adb
View file

@ -3029,7 +3029,7 @@ package body Freeze is
-- Pre/post conditions are implemented through a subprogram in
-- the corresponding body, and therefore are not checked on an
-- imported subprogram, for which the body is not available.
-- imported subprogram for which the body is not available.
-- Could consider generating a wrapper to take care of this???

4
gcc/ada/par-ch13.adb
View file

@ -645,7 +645,6 @@ package body Ch13 is
Ptr : Source_Ptr;
begin
-- Aspect Specification is present
Ptr := Token_Ptr;
@ -834,11 +833,10 @@ package body Ch13 is
-- Otherwise we have an illegal range attribute. Note that P_Name
-- ensures that Token = Tok_Range is the only possibility left here.
else -- Token = Tok_Range
else
Error_Msg_SC ("RANGE attribute illegal here!");
raise Error_Resync;
end if;
end P_Code_Statement;
end Ch13;

17
gcc/ada/par_sco.adb
View file

@ -492,13 +492,16 @@ package body Par_SCO is
-- For entry guard, the token sloc is from the N_Entry_Body.
-- For PRAGMA, we must get the location from the pragma node.
-- Argument N is the pragma argument, and we have to go up two
-- levels (through the pragma argument association) to get to
-- the pragma node itself. For the guard on a select
-- alternative, we do not have access to the token location
-- for the WHEN, so we use the first sloc of the condition
-- itself (note: we use First_Sloc, not Sloc, because this is
-- what is referenced by dominance markers).
-- Argument N is the pragma argument, and we have to go up
-- two levels (through the pragma argument association) to
-- get to the pragma node itself. For the guard on a select
-- alternative, we do not have access to the token location for
-- the WHEN, so we use the first sloc of the condition itself
-- (note: we use First_Sloc, not Sloc, because this is what is
-- referenced by dominance markers).
-- Doesn't this requirement of using First_Sloc need to be
-- documented in the spec ???
if Nkind_In (Parent (N), N_Accept_Alternative,
N_Delay_Alternative,

8
gcc/ada/s-tasinf-linux.ads
View file

@ -48,10 +48,10 @@ package System.Task_Info is
pragma Elaborate_Body;
-- To ensure that a body is allowed
-- Linux provides a way to define the ideal processor to use for a given
-- thread. The ideal processor is not necessarily the one that will be used
-- by the OS but the OS will always try to schedule this thread to the
-- specified processor if it is available.
-- The Linux kernel provides a way to define the ideal processor to use for
-- a given thread. The ideal processor is not necessarily the one that will
-- be used by the OS but the OS will always try to schedule this thread to
-- the specified processor if it is available.
-- The Task_Info pragma:

18
gcc/ada/sem_attr.adb
View file

@ -4029,10 +4029,10 @@ package body Sem_Attr is
-- within the subprogram itself. If the prefix includes a function
-- call it may involve finalization actions that should only be
-- inserted when the attribute has been rewritten as a declarations.
-- As a result, if the prefix is not a simple name we create a
-- declaration for it now, and insert it at the start of the
-- enclosing subprogram. This is properly an expansion activity but
-- it has to be performed now to prevent out-of-order issues.
-- As a result, if the prefix is not a simple name we create
-- a declaration for it now, and insert it at the start of the
-- enclosing subprogram. This is properly an expansion activity
-- but it has to be performed now to prevent out-of-order issues.
if not Is_Entity_Name (P) then
P_Type := Base_Type (P_Type);
@ -4474,9 +4474,9 @@ package body Sem_Attr is
Check_Decimal_Fixed_Point_Type;
Set_Etype (N, P_Base_Type);
-- Because the context is universal_real (3.5.10(12)) it is a legal
-- context for a universal fixed expression. This is the only
-- attribute whose functional description involves U_R.
-- Because the context is universal_real (3.5.10(12)) it is a
-- legal context for a universal fixed expression. This is the
-- only attribute whose functional description involves U_R.
if Etype (E1) = Universal_Fixed then
declare
@ -4771,8 +4771,8 @@ package body Sem_Attr is
Validate_Remote_Access_To_Class_Wide_Type (N);
-- The prefix is allowed to be an implicit dereference
-- of an access value designating a task.
-- The prefix is allowed to be an implicit dereference of an
-- access value designating a task.
else
Check_Task_Prefix;

12
gcc/ada/sem_ch13.adb
View file

@ -1866,8 +1866,8 @@ package body Sem_Ch13 is
Chars => Name_Address,
Expression => Expression (N)));
-- We preserve Comes_From_Source, since logically the clause still
-- comes from the source program even though it is changed in form.
-- We preserve Comes_From_Source, since logically the clause still comes
-- from the source program even though it is changed in form.
Set_Comes_From_Source (N, CS);
@ -2685,8 +2685,8 @@ package body Sem_Ch13 is
-- Legality checks on the address clause for initialized
-- objects is deferred until the freeze point, because
-- a subsequent pragma might indicate that the object is
-- imported and thus not initialized.
-- a subsequent pragma might indicate that the object
-- is imported and thus not initialized.
Set_Has_Delayed_Freeze (U_Ent);
@ -3120,8 +3120,8 @@ package body Sem_Ch13 is
when Attribute_Implicit_Dereference =>
-- Legality checks already performed at the point of
-- the type declaration, aspect is not delayed.
-- Legality checks already performed at the point of the type
-- declaration, aspect is not delayed.
null;

15
gcc/ada/sem_ch4.adb
View file

@ -4231,8 +4231,9 @@ package body Sem_Ch4 is
begin
Set_Parent (Par, Parent (Parent (N)));
if Try_Object_Operation
(Sinfo.Name (Par), CW_Test_Only => True)
(Sinfo.Name (Par), CW_Test_Only => True)
then
return;
end if;
@ -6531,7 +6532,6 @@ package body Sem_Ch4 is
declare
Arg : Node_Id;
begin
Arg := First (Exprs);
while Present (Arg) loop
@ -6542,9 +6542,10 @@ package body Sem_Ch4 is
if not Is_Overloaded (Func_Name) then
Func := Entity (Func_Name);
Indexing := Make_Function_Call (Loc,
Name => New_Occurrence_Of (Func, Loc),
Parameter_Associations => Assoc);
Indexing :=
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Func, Loc),
Parameter_Associations => Assoc);
Rewrite (N, Indexing);
Analyze (N);
@ -6609,8 +6610,8 @@ package body Sem_Ch4 is
end if;
if Etype (N) = Any_Type then
Error_Msg_NE ("container cannot be indexed with&",
N, Etype (First (Exprs)));
Error_Msg_NE
("container cannot be indexed with&", N, Etype (First (Exprs)));
Rewrite (N, New_Occurrence_Of (Any_Id, Loc));
else
Analyze (N);

26
gcc/ada/sem_ch9.adb
View file

@ -68,7 +68,7 @@ package body Sem_Ch9 is
-----------------------
function Allows_Lock_Free_Implementation
(N : Node_Id;
(N : Node_Id;
Lock_Free_Given : Boolean := False) return Boolean;
-- This routine returns True iff N satisfies the following list of lock-
-- free restrictions for protected type declaration and protected body:
@ -130,9 +130,8 @@ package body Sem_Ch9 is
-- when Lock_Free_Given is True.
begin
pragma Assert (Nkind_In (N,
N_Protected_Type_Declaration,
N_Protected_Body));
pragma Assert (Nkind_In (N, N_Protected_Type_Declaration,
N_Protected_Body));
-- The lock-free implementation is currently enabled through a debug
-- flag. When Lock_Free_Given is True, an aspect Lock_Free forces the
@ -418,8 +417,8 @@ package body Sem_Ch9 is
and then Is_Access_Type (Etype (Prefix (N))))
then
if Lock_Free_Given then
Error_Msg_N ("dereference of access value " &
"not allowed", N);
Error_Msg_N
("dereference of access value not allowed", N);
return Skip;
end if;
@ -431,8 +430,8 @@ package body Sem_Ch9 is
and then not Is_Static_Expression (N)
then
if Lock_Free_Given then
Error_Msg_N ("non-static function call not allowed",
N);
Error_Msg_N
("non-static function call not allowed", N);
return Skip;
end if;
@ -463,10 +462,12 @@ package body Sem_Ch9 is
-- outside the protected subprogram scope.
if Ekind (Id) in Assignable_Kind
and then not Scope_Within_Or_Same (Scope (Id),
Sub_Id)
and then not Scope_Within_Or_Same (Scope (Id),
Protected_Body_Subprogram (Sub_Id))
and then not
Scope_Within_Or_Same (Scope (Id), Sub_Id)
and then not
Scope_Within_Or_Same
(Scope (Id),
Protected_Body_Subprogram (Sub_Id))
then
if Lock_Free_Given then
Error_Msg_NE
@ -647,7 +648,6 @@ package body Sem_Ch9 is
and then (not Lock_Free_Given
or else Errors_Count = Serious_Errors_Detected)
then
-- Establish a relation between the subprogram body and the
-- unique protected component it references.

4
gcc/ada/sem_dim.adb
View file

@ -1712,9 +1712,7 @@ package body Sem_Dim is
-- entity when the object is a constant whose type is a
-- dimensioned type.
if Constant_Present (N)
and then not Exists (Dim_Of_Etyp)
then
if Constant_Present (N) and then not Exists (Dim_Of_Etyp) then
Set_Dimensions (Id, Dim_Of_Expr);
-- Otherwise, issue an error message

4
gcc/ada/sem_res.adb
View file

@ -7129,9 +7129,9 @@ package body Sem_Res is
return;
end if;
else
-- If not overloaded, resolve P with its own type
-- If not overloaded, resolve P with its own type
else
Resolve (P);
end if;