+2012-10-01 Arnaud Charlet <charlet@adacore.com>
+
+ * a-catizo.adb, a-stwiun.adb, a-cdlili.adb, a-cihama.adb, a-direct.adb,
+ a-coinve.adb, a-calend.adb, a-ciorse.adb, a-coorma.adb, a-cfdlli.adb,
+ a-stzunb-shared.adb, a-cfhase.adb, bindgen.adb, ceinfo.adb, a-tags.adb,
+ einfo.adb, checks.adb, eval_fat.adb, a-cborma.adb, a-stwifi.adb,
+ a-tifiio.adb, a-textio.adb, a-cidlli.adb, a-strunb-shared.adb,
+ a-cimutr.adb, a-calcon.adb, a-exexpr-gcc.adb, a-ciormu.adb,
+ a-stzunb.adb, a-stzsea.adb, a-ngelfu.adb, a-stzfix.adb,
+ a-cihase.adb, a-cohama.adb, a-exetim-posix.adb, a-dirval-vms.adb,
+ a-caldel-vms.adb, a-coorse.adb, errout.adb,
+ a-except.adb, butil.adb, a-dirval-mingw.adb, a-cforma.adb,
+ a-except-2005.adb, a-wtedit.adb, cstand.adb, a-stwiun-shared.adb,
+ a-cbhama.adb, a-direio.adb, clean.adb, a-cborse.adb, back_end.adb,
+ binde.adb, a-exexda.adb, a-comutr.adb, a-ciorma.adb, a-cobove.adb,
+ a-coormu.adb, a-teioed.adb, a-convec.adb, a-wtenau.adb, exp_aggr.adb,
+ a-ztedit.adb, a-cohase.adb, a-exetim-mingw.adb, bcheck.adb,
+ a-dynpri.adb, a-cfhama.adb, a-calfor.adb, a-cbdlli.adb,
+ a-crdlli.adb, a-cbmutr.adb, a-sequio.adb, a-ngcoar.adb, a-cforse.adb,
+ a-strunb.adb, a-calend-vms.adb, a-clrefi.adb, a-cofove.adb,
+ a-ztenau.adb, a-strfix.adb, a-cbhase.adb, a-stzsup.adb: Minor
+ reformatting.
+
2012-10-01 Vincent Pucci <pucci@adacore.com>
* s-gearop.adb (Vector_Matrix_Product): Dimensions check fixed. Index
-- --
-- B o d y --
-- --
--- Copyright (C) 2008-2009 Free Software Foundation, Inc. --
+-- Copyright (C) 2008-2012, 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- --
function To_Unix_Time (Ada_Time : Time) return long is
Val : constant Long_Integer :=
- Conversion_Operations.To_Unix_Time (Ada_Time);
+ Conversion_Operations.To_Unix_Time (Ada_Time);
begin
return long (Val);
end To_Unix_Time;
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2010, AdaCore --
+-- Copyright (C) 1995-2012, AdaCore --
-- --
-- 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- --
-- cause overflow.
Safe_T : constant Time :=
- (if T > Safe_Ada_High then Safe_Ada_High else T);
+ (if T > Safe_Ada_High then Safe_Ada_High else T);
begin
return OSP.To_Duration (OSP.OS_Time (Safe_T), OSP.Absolute_Calendar);
-- UTC, it must be increased to include all leap seconds.
Ada_High_And_Leaps : constant OS_Time :=
- Ada_High + OS_Time (Leap_Seconds_Count) * Mili;
+ Ada_High + OS_Time (Leap_Seconds_Count) * Mili;
-- Two constants used in the calculations of elapsed leap seconds.
-- End_Of_Time is later than Ada_High in time zone -28. Start_Of_Time
-- The bound of type Duration expressed as time
Dur_High : constant OS_Time :=
- OS_Time (To_Relative_Time (Duration'Last));
+ OS_Time (To_Relative_Time (Duration'Last));
Dur_Low : constant OS_Time :=
- OS_Time (To_Relative_Time (Duration'First));
+ OS_Time (To_Relative_Time (Duration'First));
Res_M : OS_Time;
-- UTC, it must be increased to include all leap seconds.
Ada_High_And_Leaps : constant Time_Rep :=
- Ada_High + Time_Rep (Leap_Seconds_Count) * Nano;
+ Ada_High + Time_Rep (Leap_Seconds_Count) * Nano;
-- Two constants used in the calculations of elapsed leap seconds.
-- End_Of_Time is later than Ada_High in time zone -28. Start_Of_Time
-- is earlier than Ada_Low in time zone +28.
End_Of_Time : constant Time_Rep :=
- Ada_High + Time_Rep (3) * Nanos_In_Day;
+ Ada_High + Time_Rep (3) * Nanos_In_Day;
Start_Of_Time : constant Time_Rep :=
- Ada_Low - Time_Rep (3) * Nanos_In_Day;
+ Ada_Low - Time_Rep (3) * Nanos_In_Day;
-- The Unix lower time bound expressed as nanoseconds since the start of
-- Ada time in UTC.
Unix_Min : constant Time_Rep :=
- Ada_Low + Time_Rep (17 * 366 + 52 * 365) * Nanos_In_Day;
+ Ada_Low + Time_Rep (17 * 366 + 52 * 365) * Nanos_In_Day;
-- The Unix upper time bound expressed as nanoseconds since the start of
-- Ada time in UTC.
Unix_Max : constant Time_Rep :=
- Ada_Low + Time_Rep (34 * 366 + 102 * 365) * Nanos_In_Day +
- Time_Rep (Leap_Seconds_Count) * Nano;
+ Ada_Low + Time_Rep (34 * 366 + 102 * 365) * Nanos_In_Day +
+ Time_Rep (Leap_Seconds_Count) * Nano;
Epoch_Offset : constant Time_Rep := (136 * 365 + 44 * 366) * Nanos_In_Day;
-- The difference between 2150-1-1 UTC and 1970-1-1 UTC expressed in
-- by adding the number of nanoseconds between the two origins.
Res_N : Time_Rep :=
- Duration_To_Time_Rep (System.OS_Primitives.Clock) + Unix_Min;
+ Duration_To_Time_Rep (System.OS_Primitives.Clock) + Unix_Min;
begin
-- If the target supports leap seconds, determine the number of leap
else
declare
Off : constant Long_Integer :=
- UTC_Time_Offset (Time (Date_N), Is_Historic);
+ UTC_Time_Offset (Time (Date_N), Is_Historic);
begin
Date_N := Date_N + Time_Rep (Off) * Nano;
else
declare
Cur_Off : constant Long_Integer :=
- UTC_Time_Offset (Time (Res_N), Is_Historic);
+ UTC_Time_Offset (Time (Res_N), Is_Historic);
Cur_Res_N : constant Time_Rep :=
- Res_N - Time_Rep (Cur_Off) * Nano;
+ Res_N - Time_Rep (Cur_Off) * Nano;
Off : constant Long_Integer :=
- UTC_Time_Offset (Time (Cur_Res_N), Is_Historic);
+ UTC_Time_Offset (Time (Cur_Res_N), Is_Historic);
begin
Res_N := Res_N - Time_Rep (Off) * Nano;
Result : String := "0000-00-00 00:00:00.00";
Last : constant Positive :=
- Result'Last - (if Include_Time_Fraction then 0 else 3);
+ Result'Last - (if Include_Time_Fraction then 0 else 3);
begin
Split (Date, Year, Month, Day,
function UTC_Time_Offset (Date : Time := Clock) return Time_Offset is
Offset_L : constant Long_Integer :=
- Time_Zones_Operations.UTC_Time_Offset (Date);
+ Time_Zones_Operations.UTC_Time_Offset (Date);
Offset : Time_Offset;
begin
procedure Sort (Front, Back : Count_Type) is
Pivot : constant Count_Type :=
- (if Front = 0 then Container.First else N (Front).Next);
+ (if Front = 0 then Container.First else N (Front).Next);
begin
if Pivot /= Back then
Partition (Pivot, Back);
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => 0)
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => 0)
do
B := B + 1;
end return;
-- is a forward or reverse iteration.
return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => Start.Node)
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => Start.Node)
do
B := B + 1;
end return;
begin
return It : constant Iterator :=
- (Limited_Controlled with
- Container => Container'Unrestricted_Access)
+ (Limited_Controlled with
+ Container => Container'Unrestricted_Access)
do
B := B + 1;
end return;
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2012, 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- --
L_Node : Node_Type) return Boolean
is
R_Index : constant Hash_Type :=
- Element_Keys.Index (R_HT, L_Node.Element);
+ Element_Keys.Index (R_HT, L_Node.Element);
R_Node : Count_Type := R_HT.Buckets (R_Index);
L_Node : Node_Type) return Boolean
is
R_Index : constant Hash_Type :=
- Element_Keys.Index (R_HT, L_Node.Element);
+ Element_Keys.Index (R_HT, L_Node.Element);
R_Node : Count_Type := R_HT.Buckets (R_Index);
begin
B := B + 1;
return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access);
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access);
end Iterate;
------------
(Container : in out Set;
New_Item : Element_Type)
is
- Node : constant Count_Type :=
- Element_Keys.Find (Container, New_Item);
+ Node : constant Count_Type := Element_Keys.Find (Container, New_Item);
begin
if Node = 0 then
-- --
-- B o d y --
-- --
--- Copyright (C) 2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2011-2012, 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- --
end if;
return It : constant Child_Iterator :=
- Child_Iterator'(Limited_Controlled with
- Container => C,
- Subtree => Parent.Node)
+ Child_Iterator'(Limited_Controlled with
+ Container => C,
+ Subtree => Parent.Node)
do
B := B + 1;
end return;
B : Natural renames Position.Container.Busy;
begin
return It : constant Subtree_Iterator :=
- (Limited_Controlled with
- Container => Position.Container,
- Subtree => Position.Node)
+ (Limited_Controlled with
+ Container => Position.Container,
+ Subtree => Position.Node)
do
B := B + 1;
end return;
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator :=
- (Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => 0)
+ (Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => 0)
do
B := B + 1;
end return;
-- is a forward or reverse iteration.)
return It : constant Iterator :=
- (Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => Start.Node)
+ (Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => Start.Node)
do
B := B + 1;
end return;
M : Map renames Position.Container.all;
Node : constant Count_Type :=
- Tree_Operations.Next (M, Position.Node);
+ Tree_Operations.Next (M, Position.Node);
begin
if Node = 0 then
M : Map renames Position.Container.all;
Node : constant Count_Type :=
- Tree_Operations.Previous (M, Position.Node);
+ Tree_Operations.Previous (M, Position.Node);
begin
if Node = 0 then
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2012, 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- --
function Ceiling (Container : Set; Item : Element_Type) return Cursor is
Node : constant Count_Type :=
- Element_Keys.Ceiling (Container, Item);
+ Element_Keys.Ceiling (Container, Item);
begin
return (if Node = 0 then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
function Ceiling (Container : Set; Key : Key_Type) return Cursor is
Node : constant Count_Type :=
- Key_Keys.Ceiling (Container, Key);
+ Key_Keys.Ceiling (Container, Key);
begin
return (if Node = 0 then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => 0)
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => 0)
do
B := B + 1;
end return;
-- is a forward or reverse iteration.)
return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => Start.Node)
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => Start.Node)
do
B := B + 1;
end return;
declare
Node : constant Count_Type :=
- Tree_Operations.Next (Position.Container.all, Position.Node);
+ Tree_Operations.Next (Position.Container.all, Position.Node);
begin
if Node = 0 then
declare
Node : constant Count_Type :=
- Tree_Operations.Previous
- (Position.Container.all,
- Position.Node);
+ Tree_Operations.Previous (Position.Container.all, Position.Node);
begin
return (if Node = 0 then No_Element
else Cursor'(Position.Container, Node));
L : Natural renames C.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Position.Node.Element'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Position.Node.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
procedure Sort (Front, Back : Node_Access) is
Pivot : constant Node_Access :=
- (if Front = null then Container.First else Front.Next);
+ (if Front = null then Container.First else Front.Next);
begin
if Pivot /= Back then
Partition (Pivot, Back);
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => null)
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => null)
do
B := B + 1;
end return;
-- is a forward or reverse iteration.
return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => Start.Node)
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => Start.Node)
do
B := B + 1;
end return;
L : Natural renames C.Lock;
begin
return R : constant Reference_Type :=
- (Element => Position.Node.Element'Access,
- Control => (Controlled with Position.Container))
+ (Element => Position.Node.Element'Access,
+ Control => (Controlled with Position.Container))
do
B := B + 1;
L := L + 1;
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2012, 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- --
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator :=
- Iterator'(Ada.Finalization.Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => 0)
+ Iterator'(Ada.Finalization.Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => 0)
do
B := B + 1;
end return;
-- is a forward or reverse iteration.
return It : constant Iterator :=
- Iterator'(Ada.Finalization.Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => Start.Node)
+ Iterator'(Ada.Finalization.Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => Start.Node)
do
B := B + 1;
end return;
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2012, 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- --
Capacity : Count_Type := 0) return Map
is
C : constant Count_Type :=
- Count_Type'Max (Capacity, Source.Capacity);
+ Count_Type'Max (Capacity, Source.Capacity);
H : Hash_Type;
N : Count_Type;
Target : Map (C, Source.Modulus);
----------
function Find (Container : Map; Key : Key_Type) return Cursor is
- Node : constant Count_Type :=
- Key_Ops.Find (Container, Key);
+ Node : constant Count_Type := Key_Ops.Find (Container, Key);
begin
if Node = 0 then
function Left (Container : Map; Position : Cursor) return Map is
Curs : Cursor;
C : Map (Container.Capacity, Container.Modulus) :=
- Copy (Container, Container.Capacity);
+ Copy (Container, Container.Capacity);
Node : Count_Type;
begin
function Right (Container : Map; Position : Cursor) return Map is
Curs : Cursor := First (Container);
C : Map (Container.Capacity, Container.Modulus) :=
- Copy (Container, Container.Capacity);
+ Copy (Container, Container.Capacity);
Node : Count_Type;
begin
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2012, 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- --
Capacity : Count_Type := 0) return Set
is
C : constant Count_Type :=
- Count_Type'Max (Capacity, Source.Capacity);
+ Count_Type'Max (Capacity, Source.Capacity);
H : Hash_Type;
N : Count_Type;
Target : Set (C, Source.Modulus);
L_Node : Node_Type) return Boolean
is
R_Index : constant Hash_Type :=
- Element_Keys.Index (R_HT, L_Node.Element);
+ Element_Keys.Index (R_HT, L_Node.Element);
R_Node : Count_Type := R_HT.Buckets (R_Index);
RN : Nodes_Type renames R_HT.Nodes;
function Left (Container : Set; Position : Cursor) return Set is
Curs : Cursor := Position;
C : Set (Container.Capacity, Container.Modulus) :=
- Copy (Container, Container.Capacity);
+ Copy (Container, Container.Capacity);
Node : Count_Type;
begin
function Right (Container : Set; Position : Cursor) return Set is
Curs : Cursor := First (Container);
C : Set (Container.Capacity, Container.Modulus) :=
- Copy (Container, Container.Capacity);
+ Copy (Container, Container.Capacity);
Node : Count_Type;
begin
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2012, 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- --
declare
Node : constant Count_Type :=
- Tree_Operations.Previous (Container, Position.Node);
+ Tree_Operations.Previous (Container, Position.Node);
begin
if Node = 0 then
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2012, 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- --
declare
Node : constant Count_Type :=
- Tree_Operations.Previous (Container, Position.Node);
+ Tree_Operations.Previous (Container, Position.Node);
begin
return (if Node = 0 then No_Element else (Node => Node));
end;
L : Natural renames C.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Position.Node.Element.all'Access,
- Control => (Controlled with Position.Container))
+ (Element => Position.Node.Element.all'Access,
+ Control => (Controlled with Position.Container))
do
B := B + 1;
L := L + 1;
procedure Sort (Front, Back : Node_Access) is
Pivot : constant Node_Access :=
- (if Front = null then Container.First else Front.Next);
+ (if Front = null then Container.First else Front.Next);
begin
if Pivot /= Back then
Partition (Pivot, Back);
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => null)
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => null)
do
B := B + 1;
end return;
-- is a forward or reverse iteration.
return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => Start.Node)
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => Start.Node)
do
B := B + 1;
end return;
declare
Element : Element_Access :=
- new Element_Type'(Element_Type'Input (Stream));
+ new Element_Type'(Element_Type'Input (Stream));
begin
Dst := new Node_Type'(Element, null, null);
exception
while Item.Length < N loop
declare
Element : Element_Access :=
- new Element_Type'(Element_Type'Input (Stream));
+ new Element_Type'(Element_Type'Input (Stream));
begin
Dst := new Node_Type'(Element, Next => null, Prev => Item.Last);
exception
L : Natural renames C.Lock;
begin
return R : constant Reference_Type :=
- (Element => Position.Node.Element.all'Access,
- Control => (Controlled with Position.Container))
+ (Element => Position.Node.Element.all'Access,
+ Control => (Controlled with Position.Container))
do
B := B + 1;
L := L + 1;
L : Natural renames HT.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Position.Node.Element.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Position.Node.Element.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
L : Natural renames HT.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Node.Element.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Node.Element.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
B : Natural renames Container'Unrestricted_Access.all.HT.Busy;
begin
return It : constant Iterator :=
- (Limited_Controlled with
- Container => Container'Unrestricted_Access)
+ (Limited_Controlled with Container => Container'Unrestricted_Access)
do
B := B + 1;
end return;
L : Natural renames HT.Lock;
begin
return R : constant Reference_Type :=
- (Element => Position.Node.Element.all'Access,
- Control => (Controlled with Position.Container))
+ (Element => Position.Node.Element.all'Access,
+ Control => (Controlled with Position.Container))
do
B := B + 1;
L := L + 1;
L : Natural renames HT.Lock;
begin
return R : constant Reference_Type :=
- (Element => Node.Element.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Node.Element.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
L : Natural renames HT.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Position.Node.Element.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Position.Node.Element.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
L_Node : Node_Access) return Boolean
is
R_Index : constant Hash_Type :=
- Element_Keys.Index (R_HT, L_Node.Element.all);
+ Element_Keys.Index (R_HT, L_Node.Element.all);
R_Node : Node_Access := R_HT.Buckets (R_Index);
L_Node : Node_Access) return Boolean
is
R_Index : constant Hash_Type :=
- Element_Keys.Index (R_HT, L_Node.Element.all);
+ Element_Keys.Index (R_HT, L_Node.Element.all);
R_Node : Node_Access := R_HT.Buckets (R_Index);
B : Natural renames Container'Unrestricted_Access.all.HT.Busy;
begin
return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access)
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access)
do
B := B + 1;
end return;
New_Item : Element_Type)
is
Node : constant Node_Access :=
- Element_Keys.Find (Container.HT, New_Item);
+ Element_Keys.Find (Container.HT, New_Item);
X : Element_Access;
pragma Warnings (Off, X);
declare
Size : constant Hash_Type :=
- Prime_Numbers.To_Prime (Left.Length + Right.Length);
+ Prime_Numbers.To_Prime (Left.Length + Right.Length);
begin
Buckets := HT_Ops.New_Buckets (Length => Size);
end;
declare
Size : constant Hash_Type :=
- Prime_Numbers.To_Prime (Left.Length + Right.Length);
+ Prime_Numbers.To_Prime (Left.Length + Right.Length);
begin
Buckets := HT_Ops.New_Buckets (Length => Size);
end;
Key : Key_Type) return Constant_Reference_Type
is
Node : constant Node_Access :=
- Key_Keys.Find (Container.HT, Key);
+ Key_Keys.Find (Container.HT, Key);
begin
if Node = null then
L : Natural renames HT.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Node.Element.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Node.Element.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
Key : Key_Type) return Reference_Type
is
Node : constant Node_Access :=
- Key_Keys.Find (Container.HT, Key);
+ Key_Keys.Find (Container.HT, Key);
begin
if Node = null then
New_Item : Element_Type)
is
Node : constant Node_Access :=
- Key_Keys.Find (Container.HT, Key);
+ Key_Keys.Find (Container.HT, Key);
begin
if Node = null then
L : Natural renames C.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Position.Node.Element.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Position.Node.Element.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
Item : Element_Type) return Cursor
is
N : constant Tree_Node_Access :=
- Find_In_Children (Root_Node (Container), Item);
+ Find_In_Children (Root_Node (Container), Item);
begin
if N = null then
end if;
return It : constant Child_Iterator :=
- Child_Iterator'(Limited_Controlled with
- Container => C,
- Subtree => Parent.Node)
+ Child_Iterator'(Limited_Controlled with
+ Container => C,
+ Subtree => Parent.Node)
do
B := B + 1;
end return;
B : Natural renames Position.Container.Busy;
begin
return It : constant Subtree_Iterator :=
- (Limited_Controlled with
- Container => Position.Container,
- Subtree => Position.Node)
+ (Limited_Controlled with
+ Container => Position.Container,
+ Subtree => Position.Node)
do
B := B + 1;
end return;
(Parent : Tree_Node_Access) return Tree_Node_Access
is
Element : constant Element_Access :=
- new Element_Type'(Element_Type'Input (Stream));
+ new Element_Type'(Element_Type'Input (Stream));
Subtree : constant Tree_Node_Access :=
- new Tree_Node_Type'
- (Parent => Parent,
- Element => Element,
- others => <>);
+ new Tree_Node_Type'
+ (Parent => Parent, Element => Element, others => <>);
begin
Read_Count := Read_Count + 1;
L : Natural renames C.Lock;
begin
return R : constant Reference_Type :=
- (Element => Position.Node.Element.all'Access,
- Control => (Controlled with Position.Container))
+ (Element => Position.Node.Element.all'Access,
+ Control => (Controlled with Position.Container))
do
B := B + 1;
L := L + 1;
L : Natural renames T.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Position.Node.Element.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Position.Node.Element.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
L : Natural renames T.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Node.Element.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Node.Element.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator :=
- (Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => null)
+ (Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => null)
do
B := B + 1;
end return;
-- is a forward or reverse iteration.
return It : constant Iterator :=
- (Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => Start.Node)
+ (Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => Start.Node)
do
B := B + 1;
end return;
declare
Node : constant Node_Access :=
- Tree_Operations.Next (Position.Node);
+ Tree_Operations.Next (Position.Node);
begin
return (if Node = null then No_Element
else Cursor'(Position.Container, Node));
declare
Node : constant Node_Access :=
- Tree_Operations.Previous (Position.Node);
+ Tree_Operations.Previous (Position.Node);
begin
return (if Node = null then No_Element
else Cursor'(Position.Container, Node));
L : Natural renames T.Lock;
begin
return R : constant Reference_Type :=
- (Element => Position.Node.Element.all'Access,
- Control => (Controlled with Position.Container))
+ (Element => Position.Node.Element.all'Access,
+ Control => (Controlled with Position.Container))
do
B := B + 1;
L := L + 1;
L : Natural renames T.Lock;
begin
return R : constant Reference_Type :=
- (Element => Node.Element.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Node.Element.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
Key : Key_Type;
New_Item : Element_Type)
is
- Node : constant Node_Access :=
- Key_Ops.Find (Container.Tree, Key);
+ Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
K : Key_Access;
E : Element_Access;
function Ceiling (Container : Set; Item : Element_Type) return Cursor is
Node : constant Node_Access :=
- Element_Keys.Ceiling (Container.Tree, Item);
+ Element_Keys.Ceiling (Container.Tree, Item);
begin
if Node = null then
end Difference;
function Difference (Left, Right : Set) return Set is
- Tree : constant Tree_Type :=
- Set_Ops.Difference (Left.Tree, Right.Tree);
+ Tree : constant Tree_Type := Set_Ops.Difference (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Difference;
----------
function Find (Container : Set; Item : Element_Type) return Cursor is
- Node : constant Node_Access :=
- Element_Keys.Find (Container.Tree, Item);
+ Node : constant Node_Access := Element_Keys.Find (Container.Tree, Item);
begin
if Node = null then
-----------
function Floor (Container : Set; Item : Element_Type) return Cursor is
- Node : constant Node_Access :=
- Element_Keys.Floor (Container.Tree, Item);
+ Node : constant Node_Access := Element_Keys.Floor (Container.Tree, Item);
begin
if Node = null then
-------------
function Ceiling (Container : Set; Key : Key_Type) return Cursor is
- Node : constant Node_Access :=
- Key_Keys.Ceiling (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Ceiling (Container.Tree, Key);
begin
if Node = null then
-------------
function Element (Container : Set; Key : Key_Type) return Element_Type is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
function Intersection (Left, Right : Set) return Set is
Tree : constant Tree_Type :=
- Set_Ops.Intersection (Left.Tree, Right.Tree);
+ Set_Ops.Intersection (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Intersection;
function Ceiling (Container : Set; Item : Element_Type) return Cursor is
Node : constant Node_Access :=
- Element_Keys.Ceiling (Container.Tree, Item);
+ Element_Keys.Ceiling (Container.Tree, Item);
begin
return (if Node = null then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
L : Natural renames Tree.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Position.Node.Element.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Position.Node.Element.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
end Delete;
procedure Delete (Container : in out Set; Item : Element_Type) is
- X : Node_Access :=
- Element_Keys.Find (Container.Tree, Item);
+ X : Node_Access := Element_Keys.Find (Container.Tree, Item);
begin
if X = null then
-------------
procedure Exclude (Container : in out Set; Item : Element_Type) is
- X : Node_Access :=
- Element_Keys.Find (Container.Tree, Item);
+ X : Node_Access := Element_Keys.Find (Container.Tree, Item);
begin
if X /= null then
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
----------
function Find (Container : Set; Item : Element_Type) return Cursor is
- Node : constant Node_Access :=
- Element_Keys.Find (Container.Tree, Item);
+ Node : constant Node_Access := Element_Keys.Find (Container.Tree, Item);
begin
if Node = null then
return No_Element;
-----------
function Floor (Container : Set; Item : Element_Type) return Cursor is
- Node : constant Node_Access :=
- Element_Keys.Floor (Container.Tree, Item);
+ Node : constant Node_Access := Element_Keys.Floor (Container.Tree, Item);
begin
return (if Node = null then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
-------------
function Ceiling (Container : Set; Key : Key_Type) return Cursor is
- Node : constant Node_Access :=
- Key_Keys.Ceiling (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Ceiling (Container.Tree, Key);
begin
return (if Node = null then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
L : Natural renames Tree.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Node.Element.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Node.Element.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
-------------
function Element (Container : Set; Key : Key_Type) return Element_Type is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
raise Constraint_Error with "key not in set";
----------
function Find (Container : Set; Key : Key_Type) return Cursor is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
begin
return (if Node = null then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
-----------
function Floor (Container : Set; Key : Key_Type) return Cursor is
- Node : constant Node_Access :=
- Key_Keys.Floor (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Floor (Container.Tree, Key);
begin
return (if Node = null then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
--------------
function New_Node return Node_Access is
- Element : Element_Access :=
- new Element_Type'(Src_Node.Element.all);
+ Element : Element_Access := new Element_Type'(Src_Node.Element.all);
Node : Node_Access;
begin
function Intersection (Left, Right : Set) return Set is
Tree : constant Tree_Type :=
- Set_Ops.Intersection (Left.Tree, Right.Tree);
+ Set_Ops.Intersection (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Intersection;
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => null)
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => null)
do
B := B + 1;
end return;
-- a forward or reverse iteration.
return It : constant Iterator :=
- (Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => Start.Node)
+ (Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => Start.Node)
do
B := B + 1;
end return;
"bad cursor in Next");
declare
- Node : constant Node_Access :=
- Tree_Operations.Next (Position.Node);
+ Node : constant Node_Access := Tree_Operations.Next (Position.Node);
begin
return (if Node = null then No_Element
else Cursor'(Position.Container, Node));
declare
Node : constant Node_Access :=
- Tree_Operations.Previous (Position.Node);
+ Tree_Operations.Previous (Position.Node);
begin
return (if Node = null then No_Element
else Cursor'(Position.Container, Node));
procedure Replace (Container : in out Set; New_Item : Element_Type) is
Node : constant Node_Access :=
- Element_Keys.Find (Container.Tree, New_Item);
+ Element_Keys.Find (Container.Tree, New_Item);
X : Element_Access;
pragma Warnings (Off, X);
function Symmetric_Difference (Left, Right : Set) return Set is
Tree : constant Tree_Type :=
- Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
+ Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Symmetric_Difference;
end Union;
function Union (Left, Right : Set) return Set is
- Tree : constant Tree_Type :=
- Set_Ops.Union (Left.Tree, Right.Tree);
+ Tree : constant Tree_Type := Set_Ops.Union (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Union;
-- --
-- B o d y --
-- --
--- Copyright (C) 2007-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2007-2012, 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- --
if Last_Arg = Arguments'Last then
declare
New_Arguments : constant Argument_List_Access :=
- new Argument_List (1 .. Arguments'Last * 2);
+ new Argument_List (1 .. Arguments'Last * 2);
begin
New_Arguments (Arguments'Range) := Arguments.all;
Arguments.all := (others => null);
declare
Inc_File_Name : constant String :=
- Arguments (Arg)
- (2 .. Arguments (Arg)'Last);
+ Arguments (Arg) (2 .. Arguments (Arg)'Last);
Current_Arguments : constant Argument_List :=
- Arguments (1 .. Last_Arg);
+ Arguments (1 .. Last_Arg);
begin
Recurse (Inc_File_Name);
declare
New_Arguments : constant Argument_List :=
- Arguments (1 .. Last_Arg);
+ Arguments (1 .. Last_Arg);
New_Last_Arg : constant Positive :=
- Current_Arguments'Length +
- New_Arguments'Length - 1;
+ Current_Arguments'Length +
+ New_Arguments'Length - 1;
begin
-- Grow Arguments if it is not large enough
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator :=
- (Limited_Controlled with
- Container => V,
- Index => No_Index)
+ (Limited_Controlled with
+ Container => V,
+ Index => No_Index)
do
B := B + 1;
end return;
-- a forward or reverse iteration.
return It : constant Iterator :=
- (Limited_Controlled with
- Container => V,
- Index => Start.Index)
+ (Limited_Controlled with
+ Container => V,
+ Index => Start.Index)
do
B := B + 1;
end return;
Index : Index_Type := Index_Type'Last) return Extended_Index
is
Last : constant Index_Type'Base :=
- Index_Type'Min (Container.Last, Index);
+ Index_Type'Min (Container.Last, Index);
begin
for Indx in reverse Index_Type'First .. Last loop
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2012, 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- --
declare
E : constant Elements_Array (1 .. Length (Right)) :=
- Right.Elements (1 .. RN);
+ Right.Elements (1 .. RN);
begin
return (Length (Right), E, Last => Right.Last, others => <>);
end;
if RN = 0 then
declare
E : constant Elements_Array (1 .. Length (Left)) :=
- Left.Elements (1 .. LN);
+ Left.Elements (1 .. LN);
begin
return (Length (Left), E, Last => Left.Last, others => <>);
end;
New_Last_As_Int : constant Int'Base := Old_Last_As_Int - N;
New_Last : constant Index_Type :=
- Index_Type (New_Last_As_Int);
+ Index_Type (New_Last_As_Int);
KK : constant Int := New_Last_As_Int - Int (No_Index);
K : constant Count_Type := Count_Type (KK);
declare
Dst_Last_As_Int : constant Int'Base :=
- Int (Before) + Int (N) - 1 - Int (No_Index);
+ Int (Before) + Int (N) - 1 - Int (No_Index);
Dst_Last : constant Count_Type := Count_Type (Dst_Last_As_Int);
Container.Elements (Dst_Last + 1 .. Length (Container));
Index_As_Int : constant Int'Base :=
- Dst_Last_As_Int - Src'Length + 1;
+ Dst_Last_As_Int - Src'Length + 1;
Index : constant Count_Type := Count_Type (Index_As_Int);
declare
Last_As_Int : constant Int'Base :=
- Int (Index_Type'First) + Int (Length) - 1;
+ Int (Index_Type'First) + Int (Length) - 1;
begin
Container.Last := Index_Type'Base (Last_As_Int);
end;
L : Natural renames HT.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Position.Node.Element'Access,
- Control => (Controlled with Position.Container))
+ (Element => Position.Node.Element'Access,
+ Control => (Controlled with Position.Container))
do
B := B + 1;
L := L + 1;
L : Natural renames HT.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Node.Element'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Node.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
(Source : Node_Access) return Node_Access
is
Target : constant Node_Access :=
- new Node_Type'(Key => Source.Key,
- Element => Source.Element,
- Next => null);
+ new Node_Type'(Key => Source.Key,
+ Element => Source.Element,
+ Next => null);
begin
return Target;
end Copy_Node;
B : Natural renames Container'Unrestricted_Access.all.HT.Busy;
begin
return It : constant Iterator :=
- (Limited_Controlled with
- Container => Container'Unrestricted_Access)
+ (Limited_Controlled with Container => Container'Unrestricted_Access)
do
B := B + 1;
end return;
L : Natural renames HT.Lock;
begin
return R : constant Reference_Type :=
- (Element => Position.Node.Element'Access,
- Control => (Controlled with Position.Container))
+ (Element => Position.Node.Element'Access,
+ Control => (Controlled with Position.Container))
do
B := B + 1;
L := L + 1;
L : Natural renames HT.Lock;
begin
return R : constant Reference_Type :=
- (Element => Node.Element'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Node.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
L : Natural renames HT.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Position.Node.Element'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Position.Node.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
if not Is_In (Right.HT, L_Node) then
declare
J : constant Hash_Type :=
- Hash (L_Node.Element) mod Buckets'Length;
+ Hash (L_Node.Element) mod Buckets'Length;
Bucket : Node_Access renames Buckets (J);
L_Node : Node_Access) return Boolean
is
R_Index : constant Hash_Type :=
- Element_Keys.Index (R_HT, L_Node.Element);
+ Element_Keys.Index (R_HT, L_Node.Element);
R_Node : Node_Access := R_HT.Buckets (R_Index);
L_Node : Node_Access) return Boolean
is
R_Index : constant Hash_Type :=
- Element_Keys.Index (R_HT, L_Node.Element);
+ Element_Keys.Index (R_HT, L_Node.Element);
R_Node : Node_Access := R_HT.Buckets (R_Index);
if Is_In (Right.HT, L_Node) then
declare
J : constant Hash_Type :=
- Hash (L_Node.Element) mod Buckets'Length;
+ Hash (L_Node.Element) mod Buckets'Length;
Bucket : Node_Access renames Buckets (J);
New_Item : Element_Type)
is
Node : constant Node_Access :=
- Element_Keys.Find (Container.HT, New_Item);
+ Element_Keys.Find (Container.HT, New_Item);
begin
if Node = null then
declare
Size : constant Hash_Type :=
- Prime_Numbers.To_Prime (Left.Length + Right.Length);
+ Prime_Numbers.To_Prime (Left.Length + Right.Length);
begin
Buckets := HT_Ops.New_Buckets (Length => Size);
end;
function New_Node (Next : Node_Access) return Node_Access is
Node : constant Node_Access :=
- new Node_Type'(Src_Node.Element, Next);
+ new Node_Type'(Src_Node.Element, Next);
begin
return Node;
end New_Node;
declare
Size : constant Hash_Type :=
- Prime_Numbers.To_Prime (Left.Length + Right.Length);
+ Prime_Numbers.To_Prime (Left.Length + Right.Length);
begin
Buckets := HT_Ops.New_Buckets (Length => Size);
end;
procedure Process (L_Node : Node_Access) is
J : constant Hash_Type :=
- Hash (L_Node.Element) mod Buckets'Length;
+ Hash (L_Node.Element) mod Buckets'Length;
begin
Buckets (J) := new Node_Type'(L_Node.Element, Buckets (J));
procedure Process (Src_Node : Node_Access) is
J : constant Hash_Type :=
- Hash (Src_Node.Element) mod Buckets'Length;
+ Hash (Src_Node.Element) mod Buckets'Length;
Tgt_Node : Node_Access := Buckets (J);
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.HT, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
begin
if Node = null then
L : Natural renames HT.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Node.Element'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Node.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
(Container : Set;
Key : Key_Type) return Cursor
is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.HT, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
begin
if Node = null then
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.HT, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
begin
if Node = null then
Key : Key_Type;
New_Item : Element_Type)
is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.HT, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
begin
if Node = null then
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
- Elements : Elements_Access :=
- new Elements_Type (Right.Last);
+ Elements : Elements_Access := new Elements_Type (Right.Last);
begin
-- Elements of an indefinite vector are allocated, so we cannot
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
- Elements : Elements_Access :=
- new Elements_Type (Left.Last);
+ Elements : Elements_Access := new Elements_Type (Left.Last);
begin
-- Elements of an indefinite vector are allocated, so we cannot
LE : Elements_Array renames
Left.Elements.EA (Index_Type'First .. Left.Last);
- Elements : Elements_Access :=
- new Elements_Type (Last);
+ Elements : Elements_Access := new Elements_Type (Last);
begin
for I in LE'Range loop
RE : Elements_Array renames
Right.Elements.EA (Index_Type'First .. Right.Last);
- Elements : Elements_Access :=
- new Elements_Type (Last);
+ Elements : Elements_Access := new Elements_Type (Last);
I : Index_Type'Base := Index_Type'First;
L : Natural renames C.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => E.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => E.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
L : Natural renames C.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => E.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => E.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
declare
EA : constant Element_Access :=
- Position.Container.Elements.EA (Position.Index);
+ Position.Container.Elements.EA (Position.Index);
begin
if EA = null then
declare
EA : constant Element_Access :=
- Container.Elements.EA (Index_Type'First);
+ Container.Elements.EA (Index_Type'First);
begin
if EA = null then
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator :=
- (Limited_Controlled with
- Container => V,
- Index => No_Index)
+ (Limited_Controlled with
+ Container => V,
+ Index => No_Index)
do
B := B + 1;
end return;
-- is a forward or reverse iteration.
return It : constant Iterator :=
- (Limited_Controlled with
- Container => V,
- Index => Start.Index)
+ (Limited_Controlled with
+ Container => V,
+ Index => Start.Index)
do
B := B + 1;
end return;
declare
EA : constant Element_Access :=
- Container.Elements.EA (Container.Last);
+ Container.Elements.EA (Container.Last);
begin
if EA = null then
L : Natural renames C.Lock;
begin
return R : constant Reference_Type :=
- (Element => E.all'Access,
- Control => (Controlled with Position.Container))
+ (Element => E.all'Access,
+ Control => (Controlled with Position.Container))
do
B := B + 1;
L := L + 1;
L : Natural renames C.Lock;
begin
return R : constant Reference_Type :=
- (Element => E.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => E.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
Index : Index_Type := Index_Type'Last) return Extended_Index
is
Last : constant Index_Type'Base :=
- (if Index > Container.Last then Container.Last else Index);
+ (if Index > Container.Last then Container.Last else Index);
begin
for Indx in reverse Index_Type'First .. Last loop
if Container.Elements.EA (Indx) /= null
L : Natural renames C.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Position.Node.Element'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Position.Node.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
Item : Element_Type) return Cursor
is
N : constant Tree_Node_Access :=
- Find_In_Children (Root_Node (Container), Item);
+ Find_In_Children (Root_Node (Container), Item);
begin
if N = null then
return No_Element;
end if;
return It : constant Child_Iterator :=
- (Limited_Controlled with
- Container => C,
- Subtree => Parent.Node)
+ (Limited_Controlled with
+ Container => C,
+ Subtree => Parent.Node)
do
B := B + 1;
end return;
B : Natural renames Position.Container.Busy;
begin
return It : constant Subtree_Iterator :=
- (Limited_Controlled with
- Container => Position.Container,
- Subtree => Position.Node)
+ (Limited_Controlled with
+ Container => Position.Container,
+ Subtree => Position.Node)
do
B := B + 1;
end return;
(Parent : Tree_Node_Access) return Tree_Node_Access
is
Subtree : constant Tree_Node_Access :=
- new Tree_Node_Type'
- (Parent => Parent,
- Element => Element_Type'Input (Stream),
- others => <>);
+ new Tree_Node_Type'
+ (Parent => Parent,
+ Element => Element_Type'Input (Stream),
+ others => <>);
begin
Read_Count := Read_Count + 1;
L : Natural renames C.Lock;
begin
return R : constant Reference_Type :=
- (Element => Position.Node.Element'Access,
- Control => (Controlled with Position.Container))
+ (Element => Position.Node.Element'Access,
+ Control => (Controlled with Position.Container))
do
B := B + 1;
L := L + 1;
declare
RE : Elements_Array renames
- Right.Elements.EA (Index_Type'First .. Right.Last);
+ Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : constant Elements_Access :=
- new Elements_Type'(Right.Last, RE);
+ new Elements_Type'(Right.Last, RE);
begin
return (Controlled with Elements, Right.Last, 0, 0);
Left.Elements.EA (Index_Type'First .. Left.Last);
Elements : constant Elements_Access :=
- new Elements_Type'(Left.Last, LE);
+ new Elements_Type'(Left.Last, LE);
begin
return (Controlled with Elements, Left.Last, 0, 0);
declare
LE : Elements_Array renames
- Left.Elements.EA (Index_Type'First .. Left.Last);
+ Left.Elements.EA (Index_Type'First .. Left.Last);
RE : Elements_Array renames
- Right.Elements.EA (Index_Type'First .. Right.Last);
+ Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : constant Elements_Access :=
- new Elements_Type'(Last, LE & RE);
+ new Elements_Type'(Last, LE & RE);
begin
return (Controlled with Elements, Last, 0, 0);
if Left.Is_Empty then
declare
Elements : constant Elements_Access :=
- new Elements_Type'
- (Last => Index_Type'First,
- EA => (others => Right));
+ new Elements_Type'
+ (Last => Index_Type'First,
+ EA => (others => Right));
begin
return (Controlled with Elements, Index_Type'First, 0, 0);
Left.Elements.EA (Index_Type'First .. Left.Last);
Elements : constant Elements_Access :=
- new Elements_Type'(Last => Last, EA => LE & Right);
+ new Elements_Type'(Last => Last, EA => LE & Right);
begin
return (Controlled with Elements, Last, 0, 0);
if Right.Is_Empty then
declare
Elements : constant Elements_Access :=
- new Elements_Type'
- (Last => Index_Type'First,
- EA => (others => Left));
+ new Elements_Type'
+ (Last => Index_Type'First,
+ EA => (others => Left));
begin
return (Controlled with Elements, Index_Type'First, 0, 0);
Right.Elements.EA (Index_Type'First .. Right.Last);
Elements : constant Elements_Access :=
- new Elements_Type'
- (Last => Last,
- EA => Left & RE);
+ new Elements_Type'
+ (Last => Last,
+ EA => Left & RE);
begin
return (Controlled with Elements, Last, 0, 0);
Last : constant Index_Type := Index_Type'First + 1;
Elements : constant Elements_Access :=
- new Elements_Type'
- (Last => Last,
- EA => (Left, Right));
+ new Elements_Type'
+ (Last => Last,
+ EA => (Left, Right));
begin
return (Controlled with Elements, Last, 0, 0);
L : Natural renames C.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element =>
- Container.Elements.EA (Position.Index)'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Container.Elements.EA (Position.Index)'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
L : Natural renames C.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Container.Elements.EA (Index)'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Container.Elements.EA (Index)'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator :=
- (Limited_Controlled with
- Container => V,
- Index => No_Index)
+ (Limited_Controlled with
+ Container => V,
+ Index => No_Index)
do
B := B + 1;
end return;
-- is a forward or reverse iteration.
return It : constant Iterator :=
- (Limited_Controlled with
- Container => V,
- Index => Start.Index)
+ (Limited_Controlled with
+ Container => V,
+ Index => Start.Index)
do
B := B + 1;
end return;
L : Natural renames C.Lock;
begin
return R : constant Reference_Type :=
- (Element =>
- Container.Elements.EA (Position.Index)'Access,
- Control => (Controlled with Position.Container))
+ (Element => Container.Elements.EA (Position.Index)'Access,
+ Control => (Controlled with Position.Container))
do
B := B + 1;
L := L + 1;
L : Natural renames C.Lock;
begin
return R : constant Reference_Type :=
- (Element => Container.Elements.EA (Index)'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Container.Elements.EA (Index)'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
Index : Index_Type := Index_Type'Last) return Extended_Index
is
Last : constant Index_Type'Base :=
- Index_Type'Min (Container.Last, Index);
+ Index_Type'Min (Container.Last, Index);
begin
for Indx in reverse Index_Type'First .. Last loop
L : Natural renames T.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Position.Node.Element'Access,
- Control => (Controlled with Position.Container))
+ (Element => Position.Node.Element'Access,
+ Control => (Controlled with Position.Container))
do
B := B + 1;
L := L + 1;
L : Natural renames T.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Node.Element'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Node.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
function Copy_Node (Source : Node_Access) return Node_Access is
Target : constant Node_Access :=
- new Node_Type'(Color => Source.Color,
- Key => Source.Key,
- Element => Source.Element,
- Parent => null,
- Left => null,
- Right => null);
+ new Node_Type'(Color => Source.Color,
+ Key => Source.Key,
+ Element => Source.Element,
+ Parent => null,
+ Left => null,
+ Right => null);
begin
return Target;
end Copy_Node;
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator :=
- (Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => null)
+ (Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => null)
do
B := B + 1;
end return;
-- is a forward or reverse iteration.
return It : constant Iterator :=
- (Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => Start.Node)
+ (Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => Start.Node)
do
B := B + 1;
end return;
"Position cursor of Next is bad");
declare
- Node : constant Node_Access :=
- Tree_Operations.Next (Position.Node);
+ Node : constant Node_Access := Tree_Operations.Next (Position.Node);
begin
if Node = null then
declare
Node : constant Node_Access :=
- Tree_Operations.Previous (Position.Node);
+ Tree_Operations.Previous (Position.Node);
begin
if Node = null then
L : Natural renames T.Lock;
begin
return R : constant Reference_Type :=
- (Element => Position.Node.Element'Access,
- Control => (Controlled with Position.Container))
+ (Element => Position.Node.Element'Access,
+ Control => (Controlled with Position.Container))
do
B := B + 1;
L := L + 1;
L : Natural renames T.Lock;
begin
return R : constant Reference_Type :=
- (Element => Node.Element'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Node.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2012, 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- --
function Ceiling (Container : Set; Item : Element_Type) return Cursor is
Node : constant Node_Access :=
- Element_Keys.Ceiling (Container.Tree, Item);
+ Element_Keys.Ceiling (Container.Tree, Item);
begin
if Node = null then
function Copy_Node (Source : Node_Access) return Node_Access is
Target : constant Node_Access :=
- new Node_Type'(Parent => null,
- Left => null,
- Right => null,
- Color => Source.Color,
- Element => Source.Element);
+ new Node_Type'(Parent => null,
+ Left => null,
+ Right => null,
+ Color => Source.Color,
+ Element => Source.Element);
begin
return Target;
end Copy_Node;
function Difference (Left, Right : Set) return Set is
Tree : constant Tree_Type :=
- Set_Ops.Difference (Left.Tree, Right.Tree);
+ Set_Ops.Difference (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Difference;
function Find (Container : Set; Item : Element_Type) return Cursor is
Node : constant Node_Access :=
- Element_Keys.Find (Container.Tree, Item);
+ Element_Keys.Find (Container.Tree, Item);
begin
if Node = null then
function Floor (Container : Set; Item : Element_Type) return Cursor is
Node : constant Node_Access :=
- Element_Keys.Floor (Container.Tree, Item);
+ Element_Keys.Floor (Container.Tree, Item);
begin
if Node = null then
function Ceiling (Container : Set; Key : Key_Type) return Cursor is
Node : constant Node_Access :=
- Key_Keys.Ceiling (Container.Tree, Key);
+ Key_Keys.Ceiling (Container.Tree, Key);
begin
if Node = null then
-------------
function Element (Container : Set; Key : Key_Type) return Element_Type is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
raise Constraint_Error with "key not in set";
----------
function Find (Container : Set; Key : Key_Type) return Cursor is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
-----------
function Floor (Container : Set; Key : Key_Type) return Cursor is
- Node : constant Node_Access :=
- Key_Keys.Floor (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Floor (Container.Tree, Key);
begin
if Node = null then
function New_Node return Node_Access is
Node : constant Node_Access :=
- new Node_Type'(Parent => null,
- Left => null,
- Right => null,
- Color => Red_Black_Trees.Red,
- Element => New_Item);
+ new Node_Type'(Parent => null,
+ Left => null,
+ Right => null,
+ Color => Red_Black_Trees.Red,
+ Element => New_Item);
begin
return Node;
end New_Node;
function New_Node return Node_Access is
Node : constant Node_Access :=
- new Node_Type'(Parent => null,
- Left => null,
- Right => null,
- Color => Red,
- Element => Src_Node.Element);
+ new Node_Type'(Parent => null,
+ Left => null,
+ Right => null,
+ Color => Red,
+ Element => Src_Node.Element);
begin
return Node;
end New_Node;
function Intersection (Left, Right : Set) return Set is
Tree : constant Tree_Type :=
- Set_Ops.Intersection (Left.Tree, Right.Tree);
+ Set_Ops.Intersection (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Intersection;
-- a forward or reverse iteration.
return It : constant Iterator :=
- (Limited_Controlled with S, Start.Node)
+ (Limited_Controlled with S, Start.Node)
do
B := B + 1;
end return;
"bad cursor in Next");
declare
- Node : constant Node_Access :=
- Tree_Operations.Next (Position.Node);
+ Node : constant Node_Access := Tree_Operations.Next (Position.Node);
begin
if Node = null then
return No_Element;
declare
Node : constant Node_Access :=
- Tree_Operations.Previous (Position.Node);
+ Tree_Operations.Previous (Position.Node);
begin
return (if Node = null then No_Element
else Cursor'(Position.Container, Node));
function Symmetric_Difference (Left, Right : Set) return Set is
Tree : constant Tree_Type :=
- Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
+ Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Symmetric_Difference;
end Union;
function Union (Left, Right : Set) return Set is
- Tree : constant Tree_Type :=
- Set_Ops.Union (Left.Tree, Right.Tree);
+ Tree : constant Tree_Type := Set_Ops.Union (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Union;
function Ceiling (Container : Set; Item : Element_Type) return Cursor is
Node : constant Node_Access :=
- Element_Keys.Ceiling (Container.Tree, Item);
+ Element_Keys.Ceiling (Container.Tree, Item);
begin
return (if Node = null then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
L : Natural renames Tree.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Position.Node.Element'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Position.Node.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
function Copy_Node (Source : Node_Access) return Node_Access is
Target : constant Node_Access :=
- new Node_Type'(Parent => null,
- Left => null,
- Right => null,
- Color => Source.Color,
- Element => Source.Element);
+ new Node_Type'(Parent => null,
+ Left => null,
+ Right => null,
+ Color => Source.Color,
+ Element => Source.Element);
begin
return Target;
end Copy_Node;
end Difference;
function Difference (Left, Right : Set) return Set is
- Tree : constant Tree_Type :=
- Set_Ops.Difference (Left.Tree, Right.Tree);
+ Tree : constant Tree_Type := Set_Ops.Difference (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Difference;
----------
function Find (Container : Set; Item : Element_Type) return Cursor is
- Node : constant Node_Access :=
- Element_Keys.Find (Container.Tree, Item);
+ Node : constant Node_Access := Element_Keys.Find (Container.Tree, Item);
begin
return (if Node = null then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
-----------
function Floor (Container : Set; Item : Element_Type) return Cursor is
- Node : constant Node_Access :=
- Element_Keys.Floor (Container.Tree, Item);
+ Node : constant Node_Access := Element_Keys.Floor (Container.Tree, Item);
begin
return (if Node = null then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
-------------
function Ceiling (Container : Set; Key : Key_Type) return Cursor is
- Node : constant Node_Access :=
- Key_Keys.Ceiling (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Ceiling (Container.Tree, Key);
begin
return (if Node = null then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
L : Natural renames Tree.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Node.Element'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Node.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
-------------
function Element (Container : Set; Key : Key_Type) return Element_Type is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
function Intersection (Left, Right : Set) return Set is
Tree : constant Tree_Type :=
- Set_Ops.Intersection (Left.Tree, Right.Tree);
+ Set_Ops.Intersection (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Intersection;
B := B + 1;
return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => null);
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => null);
end Iterate;
function Iterate (Container : Set; Start : Cursor)
B := B + 1;
return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => Start.Node);
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => Start.Node);
end Iterate;
----------
declare
Node : constant Node_Access :=
- Tree_Operations.Next (Position.Node);
+ Tree_Operations.Next (Position.Node);
begin
return (if Node = null then No_Element
else Cursor'(Position.Container, Node));
declare
Node : constant Node_Access :=
- Tree_Operations.Previous (Position.Node);
+ Tree_Operations.Previous (Position.Node);
begin
return (if Node = null then No_Element
else Cursor'(Position.Container, Node));
procedure Replace (Container : in out Set; New_Item : Element_Type) is
Node : constant Node_Access :=
- Element_Keys.Find (Container.Tree, New_Item);
+ Element_Keys.Find (Container.Tree, New_Item);
begin
if Node = null then
function Symmetric_Difference (Left, Right : Set) return Set is
Tree : constant Tree_Type :=
- Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
+ Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Symmetric_Difference;
function Union (Left, Right : Set) return Set is
Tree : constant Tree_Type :=
- Set_Ops.Union (Left.Tree, Right.Tree);
+ Set_Ops.Union (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Union;
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2012, 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- --
procedure Sort (Front, Back : Count_Type) is
Pivot : constant Count_Type :=
- (if Front = 0 then Container.First else N (Front).Next);
+ (if Front = 0 then Container.First else N (Front).Next);
begin
if Pivot /= Back then
Partition (Pivot, Back);
Norm : constant String := Normalize_Pathname (Name);
Last_DS : constant Natural :=
- Strings.Fixed.Index
- (Name, Dir_Seps, Going => Strings.Backward);
+ Strings.Fixed.Index (Name, Dir_Seps, Going => Strings.Backward);
begin
if Last_DS = 0 then
Target => Path_String_Access);
Path_Access : constant Path_String_Access :=
- Address_To_Access (Filename_Addr);
+ Address_To_Access (Filename_Addr);
begin
Last := Filename_Len;
if Match (Name (1 .. Last), Search.Value.Pattern) then
declare
Full_Name : constant String :=
- Compose
- (To_String
- (Search.Value.Name), Name (1 .. Last));
+ Compose (To_String (Search.Value.Name), Name (1 .. Last));
Found : Boolean := False;
begin
function Simple_Name_Internal (Path : String) return String is
Cut_Start : Natural :=
- Strings.Fixed.Index
- (Path, Dir_Seps, Going => Strings.Backward);
+ Strings.Fixed.Index (Path, Dir_Seps, Going => Strings.Backward);
Cut_End : Natural;
begin
BN : constant String := Path (Cut_Start .. Cut_End);
Has_Drive_Letter : constant Boolean :=
- OS_Lib.Path_Separator /= ':';
+ OS_Lib.Path_Separator /= ':';
-- If Path separator is not ':' then we are on a DOS based OS
-- where this character is used as a drive letter separator.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
package body Ada.Direct_IO is
Zeroes : constant System.Storage_Elements.Storage_Array :=
- (1 .. System.Storage_Elements.Storage_Offset (Bytes) => 0);
+ (1 .. System.Storage_Elements.Storage_Offset (Bytes) => 0);
-- Buffer used to fill out partial records
package FCB renames System.File_Control_Block;
-- B o d y --
-- (Windows Version) --
-- --
--- Copyright (C) 2004-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2012, 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- --
package body Ada.Directories.Validity is
Invalid_Character : constant array (Character) of Boolean :=
- (NUL .. US | '\' => True,
- '/' | ':' | '*' | '?' => True,
- '"' | '<' | '>' | '|' => True,
- DEL .. NBSP => True,
- others => False);
+ (NUL .. US | '\' => True,
+ '/' | ':' | '*' | '?' => True,
+ '"' | '<' | '>' | '|' => True,
+ DEL .. NBSP => True,
+ others => False);
---------------------------------
-- Is_Path_Name_Case_Sensitive --
-- B o d y --
-- (VMS Version) --
-- --
--- Copyright (C) 2004-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2012, 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- --
Max_Path_Length : constant := 1_024;
Invalid_Character : constant array (Character) of Boolean :=
- ('a' .. 'z' => False,
- 'A' .. 'Z' => False,
- '0' .. '9' => False,
- '_' | '$' | '-' | '.' => False,
- others => True);
+ ('a' .. 'z' => False,
+ 'A' .. 'Z' => False,
+ '0' .. '9' => False,
+ '_' | '$' | '-' | '.' => False,
+ others => True);
---------------------------------
-- Is_Path_Name_Case_Sensitive --
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
procedure Set_Priority
(Priority : System.Any_Priority;
T : Ada.Task_Identification.Task_Id :=
- Ada.Task_Identification.Current_Task)
+ Ada.Task_Identification.Current_Task)
is
Target : constant Task_Id := Convert_Ids (T);
Error_Message : constant String := "Trying to set the priority of a ";
Prefix : constant String := "adjust/finalize raised ";
Orig_Msg : constant String := Exception_Message (X);
Orig_Prefix_Length : constant Natural :=
- Integer'Min (Prefix'Length, Orig_Msg'Length);
+ Integer'Min (Prefix'Length, Orig_Msg'Length);
Orig_Prefix : String renames Orig_Msg
- (Orig_Msg'First ..
- Orig_Msg'First + Orig_Prefix_Length - 1);
+ (Orig_Msg'First ..
+ Orig_Msg'First + Orig_Prefix_Length - 1);
begin
-- Message already has the proper prefix, just re-raise
(File : System.Address; Line, Column, Index, First, Last : Integer)
is
Msg : constant String :=
- Rmsg_05 (Rmsg_05'First .. Rmsg_05'Last - 1) & ASCII.LF &
- "index " & Image (Index) & " not in " & Image (First) &
- ".." & Image (Last) & ASCII.NUL;
+ Rmsg_05 (Rmsg_05'First .. Rmsg_05'Last - 1) & ASCII.LF &
+ "index " & Image (Index) & " not in " & Image (First) &
+ ".." & Image (Last) & ASCII.NUL;
begin
Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
end Rcheck_CE_Index_Check_Ext;
(File : System.Address; Line, Column, Index, First, Last : Integer)
is
Msg : constant String :=
- Rmsg_06 (Rmsg_06'First .. Rmsg_06'Last - 1) & ASCII.LF &
- "value " & Image (Index) & " not in " & Image (First) &
- ".." & Image (Last) & ASCII.NUL;
+ Rmsg_06 (Rmsg_06'First .. Rmsg_06'Last - 1) & ASCII.LF &
+ "value " & Image (Index) & " not in " & Image (First) &
+ ".." & Image (Last) & ASCII.NUL;
begin
Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
end Rcheck_CE_Invalid_Data_Ext;
(File : System.Address; Line, Column, Index, First, Last : Integer)
is
Msg : constant String :=
- Rmsg_12 (Rmsg_12'First .. Rmsg_12'Last - 1) & ASCII.LF &
- "value " & Image (Index) & " not in " & Image (First) &
- ".." & Image (Last) & ASCII.NUL;
+ Rmsg_12 (Rmsg_12'First .. Rmsg_12'Last - 1) & ASCII.LF &
+ "value " & Image (Index) & " not in " & Image (First) &
+ ".." & Image (Last) & ASCII.NUL;
begin
Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address);
end Rcheck_CE_Range_Check_Ext;
Prefix : constant String := "adjust/finalize raised ";
Orig_Msg : constant String := Exception_Message (X);
Orig_Prefix_Length : constant Natural :=
- Integer'Min (Prefix'Length, Orig_Msg'Length);
+ Integer'Min (Prefix'Length, Orig_Msg'Length);
Orig_Prefix : String renames Orig_Msg
- (Orig_Msg'First ..
- Orig_Msg'First + Orig_Prefix_Length - 1);
+ (Orig_Msg'First .. Orig_Msg'First + Orig_Prefix_Length - 1);
begin
-- Message already has proper prefix, just re-reraise
-- --
-- B o d y --
-- --
--- Copyright (C) 2007-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2007-2012, 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- --
function Clock
(T : Ada.Task_Identification.Task_Id :=
- Ada.Task_Identification.Current_Task) return CPU_Time
+ Ada.Task_Identification.Current_Task) return CPU_Time
is
Hundreds_Nano_In_Sec : constant Long_Long_Float := 1.0E7;
-- --
-- B o d y --
-- --
--- Copyright (C) 2007-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2007-2012, 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- --
function Clock
(T : Ada.Task_Identification.Task_Id :=
- Ada.Task_Identification.Current_Task)
- return CPU_Time
+ Ada.Task_Identification.Current_Task) return CPU_Time
is
TS : aliased timespec;
Result : Interfaces.C.int;
N : Integer_Address;
H : constant array (Integer range 0 .. 15) of Character :=
- "0123456789abcdef";
+ "0123456789abcdef";
begin
P := S'Last;
N := To_Integer (A);
Message : String)
is
Len : constant Natural :=
- Natural'Min (Message'Length, Exception_Msg_Max_Length);
+ Natural'Min (Message'Length, Exception_Msg_Max_Length);
First : constant Integer := Message'First;
begin
Excep.Exception_Raised := False;
-- call become inoffensive.
Wrapper : constant Traceback_Decorator_Wrapper_Call :=
- Traceback_Decorator_Wrapper;
+ Traceback_Decorator_Wrapper;
begin
if Wrapper = null then
declare
GNAT_Occurrence : constant GNAT_GCC_Exception_Access :=
- To_GNAT_GCC_Exception (GCC_Exception);
+ To_GNAT_GCC_Exception (GCC_Exception);
begin
Excep.all := GNAT_Occurrence.Occurrence;
-- --
-- B o d y --
-- --
--- Copyright (C) 2006-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2006-2012, 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- --
for K in 1 .. N loop
declare
C : constant Complex :=
- (A (A'First (1) + (J - 1), A'First (2) + (K - 1)));
+ (A (A'First (1) + (J - 1), A'First (2) + (K - 1)));
begin
M (J, K) := Re (C);
M (J + N, K + N) := Re (C);
for K in 1 .. N loop
declare
C : constant Complex :=
- (A (A'First (1) + (J - 1), A'First (2) + (K - 1)));
+ (A (A'First (1) + (J - 1), A'First (2) + (K - 1)));
begin
M (J, K) := Re (C);
M (J + N, K + N) := Re (C);
G : constant Float_Type'Base := Y * Y;
Float_Type_Digits_15_Or_More : constant Boolean :=
- Float_Type'Digits > 14;
+ Float_Type'Digits > 14;
begin
if X < Half_Log_Epsilon then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
then
declare
RsizS : constant SSE.Storage_Offset :=
- SSE.Storage_Offset (Rsiz - 1);
+ SSE.Storage_Offset (Rsiz - 1);
type SA is new SSE.Storage_Array (0 .. RsizS);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
declare
Result_Length : constant Natural :=
- Integer'Max
- (Source'Length,
- Position - Source'First + New_Item'Length);
+ Integer'Max
+ (Source'Length,
+ Position - Source'First + New_Item'Length);
Result : String (1 .. Result_Length);
Front : constant Integer := Position - Source'First;
if High >= Low then
declare
Front_Len : constant Integer :=
- Integer'Max (0, Low - Source'First);
+ Integer'Max (0, Low - Source'First);
-- Length of prefix of Source copied to result
Back_Len : constant Integer :=
- Integer'Max (0, Source'Last - High);
+ Integer'Max (0, Source'Last - High);
-- Length of suffix of Source copied to result
Result_Length : constant Integer :=
- Front_Len + By'Length + Back_Len;
+ Front_Len + By'Length + Back_Len;
-- Length of result
Result : String (1 .. Result_Length);
function Aligned_Max_Length (Max_Length : Natural) return Natural is
Static_Size : constant Natural :=
- Empty_Shared_String'Size / Standard'Storage_Unit;
+ Empty_Shared_String'Size / Standard'Storage_Unit;
-- Total size of all static components
begin
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
if Chunk_Size > S_Length - Source.Last then
declare
New_Size : constant Positive :=
- S_Length + Chunk_Size + (S_Length / Growth_Factor);
+ S_Length + Chunk_Size + (S_Length / Growth_Factor);
New_Rounded_Up_Size : constant Positive :=
- ((New_Size - 1) / Min_Mul_Alloc + 1) *
- Min_Mul_Alloc;
+ ((New_Size - 1) / Min_Mul_Alloc + 1) * Min_Mul_Alloc;
Tmp : constant String_Access :=
- new String (1 .. New_Rounded_Up_Size);
+ new String (1 .. New_Rounded_Up_Size);
begin
Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
else
declare
Result_Length : constant Natural :=
- Natural'Max
- (Source'Length,
- Position - Source'First + New_Item'Length);
+ Natural'Max
+ (Source'Length,
+ Position - Source'First + New_Item'Length);
Result : Wide_String (1 .. Result_Length);
if High >= Low then
declare
Front_Len : constant Integer :=
- Integer'Max (0, Low - Source'First);
+ Integer'Max (0, Low - Source'First);
-- Length of prefix of Source copied to result
- Back_Len : constant Integer :=
- Integer'Max (0, Source'Last - High);
+ Back_Len : constant Integer := Integer'Max (0, Source'Last - High);
-- Length of suffix of Source copied to result
Result_Length : constant Integer :=
- Front_Len + By'Length + Back_Len;
+ Front_Len + By'Length + Back_Len;
-- Length of result
Result : Wide_String (1 .. Result_Length);
else
declare
Result : constant Wide_String (1 .. High - Low + 1) :=
- Source (Low .. High);
+ Source (Low .. High);
begin
return Result;
function Aligned_Max_Length (Max_Length : Natural) return Natural is
Static_Size : constant Natural :=
- Empty_Shared_Wide_String'Size / Standard'Storage_Unit;
+ Empty_Shared_Wide_String'Size / Standard'Storage_Unit;
-- Total size of all static components
Element_Size : constant Natural :=
- Wide_Character'Size / Standard'Storage_Unit;
+ Wide_Character'Size / Standard'Storage_Unit;
begin
return
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
if Chunk_Size > S_Length - Source.Last then
declare
New_Size : constant Positive :=
- S_Length + Chunk_Size + (S_Length / Growth_Factor);
+ S_Length + Chunk_Size + (S_Length / Growth_Factor);
New_Rounded_Up_Size : constant Positive :=
- ((New_Size - 1) / Min_Mul_Alloc + 1) *
- Min_Mul_Alloc;
+ ((New_Size - 1) / Min_Mul_Alloc + 1) * Min_Mul_Alloc;
Tmp : constant Wide_String_Access :=
- new Wide_String (1 .. New_Rounded_Up_Size);
+ new Wide_String (1 .. New_Rounded_Up_Size);
begin
Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
Pattern : Wide_Wide_String;
Going : Direction := Forward;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity)
+ Wide_Wide_Maps.Identity)
return Natural
renames Ada.Strings.Wide_Wide_Search.Index;
From : Positive;
Going : Direction := Forward;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity)
+ Wide_Wide_Maps.Identity)
return Natural
renames Ada.Strings.Wide_Wide_Search.Index;
(Source : Wide_Wide_String;
Pattern : Wide_Wide_String;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity)
+ Wide_Wide_Maps.Identity)
return Natural
renames Ada.Strings.Wide_Wide_Search.Count;
else
declare
Result_Length : constant Natural :=
- Natural'Max
- (Source'Length,
- Position - Source'First + New_Item'Length);
+ Natural'Max
+ (Source'Length,
+ Position - Source'First + New_Item'Length);
Result : Wide_Wide_String (1 .. Result_Length);
if High >= Low then
declare
Front_Len : constant Integer :=
- Integer'Max (0, Low - Source'First);
+ Integer'Max (0, Low - Source'First);
-- Length of prefix of Source copied to result
Back_Len : constant Integer :=
- Integer'Max (0, Source'Last - High);
+ Integer'Max (0, Source'Last - High);
-- Length of suffix of Source copied to result
Result_Length : constant Integer :=
- Front_Len + By'Length + Back_Len;
+ Front_Len + By'Length + Back_Len;
-- Length of result
Result : Wide_Wide_String (1 .. Result_Length);
else
declare
Result : constant Wide_Wide_String (1 .. High - Low + 1) :=
- Source (Low .. High);
+ Source (Low .. High);
begin
return Result;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
(Source : Wide_Wide_String;
Pattern : Wide_Wide_String;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity)
- return Natural
+ Wide_Wide_Maps.Identity) return Natural
is
PL1 : constant Integer := Pattern'Length - 1;
Num : Natural;
Pattern : Wide_Wide_String;
Going : Direction := Forward;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity)
- return Natural
+ Wide_Wide_Maps.Identity) return Natural
is
PL1 : constant Integer := Pattern'Length - 1;
Cur : Natural;
From : Positive;
Going : Direction := Forward;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity)
- return Natural
+ Wide_Wide_Maps.Identity) return Natural
is
begin
if Going = Forward then
(Source : Super_String;
Pattern : Wide_Wide_String;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity)
- return Natural
+ Wide_Wide_Maps.Identity) return Natural
is
begin
return
Pattern : Wide_Wide_String;
Going : Strings.Direction := Strings.Forward;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity)
- return Natural
+ Wide_Wide_Maps.Identity) return Natural
is
begin
return Wide_Wide_Search.Index
From : Positive;
Going : Direction := Forward;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity)
- return Natural
+ Wide_Wide_Maps.Identity) return Natural
is
begin
return Wide_Wide_Search.Index
function Aligned_Max_Length (Max_Length : Natural) return Natural is
Static_Size : constant Natural :=
- Empty_Shared_Wide_Wide_String'Size
- / Standard'Storage_Unit;
+ Empty_Shared_Wide_Wide_String'Size / Standard'Storage_Unit;
-- Total size of all static components
Element_Size : constant Natural :=
- Wide_Wide_Character'Size / Standard'Storage_Unit;
+ Wide_Wide_Character'Size / Standard'Storage_Unit;
begin
return
(Source : Unbounded_Wide_Wide_String;
Pattern : Wide_Wide_String;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity)
- return Natural
+ Wide_Wide_Maps.Identity) return Natural
is
SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
begin
Pattern : Wide_Wide_String;
Going : Strings.Direction := Strings.Forward;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity)
- return Natural
+ Wide_Wide_Maps.Identity) return Natural
is
SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
begin
From : Positive;
Going : Direction := Forward;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity)
- return Natural
+ Wide_Wide_Maps.Identity) return Natural
is
SR : constant Shared_Wide_Wide_String_Access := Source.Reference;
begin
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
(Source : Unbounded_Wide_Wide_String;
Pattern : Wide_Wide_String;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity)
- return Natural
+ Wide_Wide_Maps.Identity) return Natural
is
begin
return
Pattern : Wide_Wide_String;
Going : Strings.Direction := Strings.Forward;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity)
- return Natural
+ Wide_Wide_Maps.Identity) return Natural
is
begin
return
From : Positive;
Going : Direction := Forward;
Mapping : Wide_Wide_Maps.Wide_Wide_Character_Mapping :=
- Wide_Wide_Maps.Identity)
- return Natural
+ Wide_Wide_Maps.Identity) return Natural
is
begin
return
if Chunk_Size > S_Length - Source.Last then
declare
New_Size : constant Positive :=
- S_Length + Chunk_Size + (S_Length / Growth_Factor);
+ S_Length + Chunk_Size + (S_Length / Growth_Factor);
New_Rounded_Up_Size : constant Positive :=
- ((New_Size - 1) / Min_Mul_Alloc + 1) *
- Min_Mul_Alloc;
+ ((New_Size - 1) / Min_Mul_Alloc + 1) * Min_Mul_Alloc;
Tmp : constant Wide_Wide_String_Access :=
- new Wide_Wide_String (1 .. New_Rounded_Up_Size);
+ new Wide_Wide_String (1 .. New_Rounded_Up_Size);
begin
Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
function CW_Membership (Obj_Tag : Tag; Typ_Tag : Tag) return Boolean is
Obj_TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (Obj_Tag) - DT_Typeinfo_Ptr_Size);
+ To_Addr_Ptr (To_Address (Obj_Tag) - DT_Typeinfo_Ptr_Size);
Typ_TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (Typ_Tag) - DT_Typeinfo_Ptr_Size);
+ To_Addr_Ptr (To_Address (Typ_Tag) - DT_Typeinfo_Ptr_Size);
Obj_TSD : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (Obj_TSD_Ptr.all);
+ To_Type_Specific_Data_Ptr (Obj_TSD_Ptr.all);
Typ_TSD : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (Typ_TSD_Ptr.all);
+ To_Type_Specific_Data_Ptr (Typ_TSD_Ptr.all);
Pos : constant Integer := Obj_TSD.Idepth - Typ_TSD.Idepth;
begin
return Pos >= 0 and then Obj_TSD.Tags_Table (Pos) = Typ_Tag;
function Get_External_Tag (T : Tag) return System.Address is
TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+ To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
TSD : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+ To_Type_Specific_Data_Ptr (TSD_Ptr.all);
begin
return To_Address (TSD.External_Tag);
end Get_External_Tag;
function OSD (T : Tag) return Object_Specific_Data_Ptr is
OSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+ To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
begin
return To_Object_Specific_Data_Ptr (OSD_Ptr.all);
end OSD;
function SSD (T : Tag) return Select_Specific_Data_Ptr is
TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+ To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
TSD : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+ To_Type_Specific_Data_Ptr (TSD_Ptr.all);
begin
return TSD.SSD;
end SSD;
function Get_HT_Link (T : Tag) return Tag is
TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+ To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
TSD : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+ To_Type_Specific_Data_Ptr (TSD_Ptr.all);
begin
return TSD.HT_Link.all;
end Get_HT_Link;
procedure Set_HT_Link (T : Tag; Next : Tag) is
TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+ To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
TSD : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+ To_Type_Specific_Data_Ptr (TSD_Ptr.all);
begin
TSD.HT_Link.all := Next;
end Set_HT_Link;
function DT (T : Tag) return Dispatch_Table_Ptr is
Offset : constant SSE.Storage_Offset :=
- To_Dispatch_Table_Ptr (T).Prims_Ptr'Position;
+ To_Dispatch_Table_Ptr (T).Prims_Ptr'Position;
begin
return To_Dispatch_Table_Ptr (To_Address (T) - Offset);
end DT;
function Interface_Ancestor_Tags (T : Tag) return Tag_Array is
TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+ To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
TSD : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+ To_Type_Specific_Data_Ptr (TSD_Ptr.all);
Iface_Table : constant Interface_Data_Ptr := TSD.Interfaces_Table;
begin
then
declare
Addr_First : constant Natural :=
- External'First + Internal_Tag_Header'Length;
+ External'First + Internal_Tag_Header'Length;
Addr_Last : Natural;
Addr : Integer_Address;
Ancestor : Tag) return Boolean
is
D_TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (Descendant)
- - DT_Typeinfo_Ptr_Size);
+ To_Addr_Ptr (To_Address (Descendant) - DT_Typeinfo_Ptr_Size);
A_TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (Ancestor) - DT_Typeinfo_Ptr_Size);
+ To_Addr_Ptr (To_Address (Ancestor) - DT_Typeinfo_Ptr_Size);
D_TSD : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (D_TSD_Ptr.all);
+ To_Type_Specific_Data_Ptr (D_TSD_Ptr.all);
A_TSD : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (A_TSD_Ptr.all);
+ To_Type_Specific_Data_Ptr (A_TSD_Ptr.all);
begin
return CW_Membership (Descendant, Ancestor)
function Needs_Finalization (T : Tag) return Boolean is
TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+ To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
TSD : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+ To_Type_Specific_Data_Ptr (TSD_Ptr.all);
begin
return TSD.Needs_Finalization;
end Needs_Finalization;
-- ancestor tags.
TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+ To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
TSD : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+ To_Type_Specific_Data_Ptr (TSD_Ptr.all);
-- Pointer to the TSD
Parent_Tag : constant Tag := TSD.Tags_Table (Parent_Slot);
Parent_TSD_Ptr : constant Addr_Ptr :=
- To_Addr_Ptr (To_Address (Parent_Tag)
- - DT_Typeinfo_Ptr_Size);
+ To_Addr_Ptr (To_Address (Parent_Tag) - DT_Typeinfo_Ptr_Size);
Parent_TSD : constant Type_Specific_Data_Ptr :=
- To_Type_Specific_Data_Ptr (Parent_TSD_Ptr.all);
+ To_Type_Specific_Data_Ptr (Parent_TSD_Ptr.all);
begin
-- Here we compute the size of the _parent field of the object
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
function Pic_String (Pic : Picture) return String is
Temp : String (1 .. Pic.Contents.Picture.Length) :=
- Pic.Contents.Picture.Expanded;
+ Pic.Contents.Picture.Expanded;
begin
for J in Temp'Range loop
if Temp (J) = 'b' then
end Has_Translated_Characters;
Needs_Binary_Write : constant Boolean :=
- text_translation_required
- and then Has_Translated_Characters;
+ text_translation_required and then Has_Translated_Characters;
-- Start of processing for Write
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
and then Num'Small * 10.0**Scale < 10.0);
Exact : constant Boolean :=
- Float'Floor (Num'Small) = Float'Ceiling (Num'Small)
- or else Float'Floor (1.0 / Num'Small) =
- Float'Ceiling (1.0 / Num'Small)
- or else Num'Small >= 10.0**Max_Digits;
+ Float'Floor (Num'Small) = Float'Ceiling (Num'Small)
+ or else Float'Floor (1.0 / Num'Small) = Float'Ceiling (1.0 / Num'Small)
+ or else Num'Small >= 10.0**Max_Digits;
-- True iff a numerator and denominator can be calculated such that
-- their ratio exactly represents the small of Num.
Exp : Field := Default_Exp)
is
Fore : constant Integer :=
- To'Length
- - 1 -- Decimal point
- - Field'Max (1, Aft) -- Decimal part
- - Boolean'Pos (Exp /= 0) -- Exponent indicator
- - Exp; -- Exponent
+ To'Length
+ - 1 -- Decimal point
+ - Field'Max (1, Aft) -- Decimal part
+ - Boolean'Pos (Exp /= 0) -- Exponent indicator
+ - Exp; -- Exponent
Last : Natural;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
function Pic_String (Pic : Picture) return String is
Temp : String (1 .. Pic.Contents.Picture.Length) :=
- Pic.Contents.Picture.Expanded;
+ Pic.Contents.Picture.Expanded;
begin
for J in Temp'Range loop
if Temp (J) = 'b' then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
Set : Type_Set)
is
Actual_Width : constant Integer :=
- Integer'Max (Integer (Width), Item'Length);
+ Integer'Max (Integer (Width), Item'Length);
begin
Check_On_One_Line (TFT (File), Actual_Width);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
function Pic_String (Pic : Picture) return String is
Temp : String (1 .. Pic.Contents.Picture.Length) :=
- Pic.Contents.Picture.Expanded;
+ Pic.Contents.Picture.Expanded;
begin
for J in Temp'Range loop
if Temp (J) = 'b' then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
Set : Type_Set)
is
Actual_Width : constant Integer :=
- Integer'Max (Integer (Width), Item'Length);
+ Integer'Max (Integer (Width), Item'Length);
begin
Check_On_One_Line (TFT (File), Actual_Width);
Argv_Ptr : constant Big_String_Ptr := save_argv (Arg);
Argv_Len : constant Nat := Len_Arg (Arg);
Argv : constant String :=
- Argv_Ptr (1 .. Natural (Argv_Len));
+ Argv_Ptr (1 .. Natural (Argv_Len));
begin
Args (Positive (Arg)) := new String'(Argv);
end;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
Check_Policy : declare
Policy : constant Character :=
- ALIs.Table (A1).Task_Dispatching_Policy;
+ ALIs.Table (A1).Task_Dispatching_Policy;
begin
for A2 in A1 + 1 .. ALIs.Last loop
end record;
PSD_Table : array (0 .. Max_Prio) of Specific_Dispatching_Entry :=
- (others => Specific_Dispatching_Entry'
- (Dispatching_Policy => ' ',
- Afile => No_ALI_Id,
- Loc => 0));
+ (others => Specific_Dispatching_Entry'
+ (Dispatching_Policy => ' ',
+ Afile => No_ALI_Id,
+ Loc => 0));
-- Array containing an entry per priority containing the location
-- where there is a Priority_Specific_Dispatching pragma that
-- applies to the priority.
for ND in No_Deps.First .. No_Deps.Last loop
declare
- ND_Unit : constant Name_Id :=
- No_Deps.Table (ND).No_Dep_Unit;
-
+ ND_Unit : constant Name_Id := No_Deps.Table (ND).No_Dep_Unit;
begin
for J in ALIs.First .. ALIs.Last loop
declare
if AFN /= No_File then
declare
WAI : constant ALI_Id :=
- ALI_Id (Get_Name_Table_Info (AFN));
+ ALI_Id (Get_Name_Table_Info (AFN));
WTE : ALIs_Record renames ALIs.Table (WAI);
begin
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
elsif Is_Waiting_Body (U1) and then Is_Waiting_Body (U2) then
declare
Result : constant Boolean :=
- UNR.Table (Corresponding_Spec (U1)).Elab_Position >
- UNR.Table (Corresponding_Spec (U2)).Elab_Position;
+ UNR.Table (Corresponding_Spec (U1)).Elab_Position >
+ UNR.Table (Corresponding_Spec (U2)).Elab_Position;
begin
if Debug_Flag_B then
if Result then
then
declare
Result : constant Boolean :=
- UNR.Table (Corresponding_Body (U1)).Num_Pred <
- UNR.Table (Corresponding_Body (U2)).Num_Pred;
+ UNR.Table (Corresponding_Body (U1)).Num_Pred <
+ UNR.Table (Corresponding_Body (U2)).Num_Pred;
begin
if Debug_Flag_B then
if Result then
then
declare
Info : constant Int :=
- Get_Name_Table_Info
- (Withs.Table (W).Uname);
+ Get_Name_Table_Info (Withs.Table (W).Uname);
begin
-- If the unit is unknown, for some unknown reason, fail
if Info = 0 or else Unit_Id (Info) = No_Unit_Id then
declare
Withed : String :=
- Get_Name_String (Withs.Table (W).Uname);
+ Get_Name_String (Withs.Table (W).Uname);
Last_Withed : Natural := Withed'Last;
Withing : String :=
- Get_Name_String
- (Units.Table (Before).Uname);
+ Get_Name_String (Units.Table (Before).Uname);
Last_Withing : Natural := Withing'Last;
Spec_Body : String := " (Spec)";
elsif Is_Waiting_Body (U1) and then Is_Waiting_Body (U2) then
declare
Result : constant Boolean :=
- UNR.Table (Corresponding_Spec (U1)).Elab_Position <
- UNR.Table (Corresponding_Spec (U2)).Elab_Position;
+ UNR.Table (Corresponding_Spec (U1)).Elab_Position <
+ UNR.Table (Corresponding_Spec (U2)).Elab_Position;
begin
if Debug_Flag_B then
if Result then
then
declare
Result : constant Boolean :=
- UNR.Table (Corresponding_Body (U1)).Num_Pred >=
- UNR.Table (Corresponding_Body (U2)).Num_Pred;
+ UNR.Table (Corresponding_Body (U1)).Num_Pred >=
+ UNR.Table (Corresponding_Body (U2)).Num_Pred;
begin
if Debug_Flag_B then
if Result then
-- function Get_Ada_Main_Name for details on the form of the name.
Needs_Library_Finalization : constant Boolean :=
- not Configurable_Run_Time_On_Target
- and then Has_Finalizer;
+ not Configurable_Run_Time_On_Target and then Has_Finalizer;
-- For restricted run-time libraries (ZFP and Ravenscar) tasks are
-- non-terminating, so we do not want finalization.
function Get_Ada_Main_Name return String is
Suffix : constant String := "_00";
Name : String (1 .. Opt.Ada_Main_Name.all'Length + Suffix'Length) :=
- Opt.Ada_Main_Name.all & Suffix;
+ Opt.Ada_Main_Name.all & Suffix;
Nlen : Natural;
begin
loop
declare
Inum : constant Int :=
- Interrupt_States.Table (K).Interrupt_Id;
+ Interrupt_States.Table (K).Interrupt_Id;
Stat : constant Character :=
- Interrupt_States.Table (K).Interrupt_State;
+ Interrupt_States.Table (K).Interrupt_State;
begin
while IS_Pragma_Settings.Last < Inum loop
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
declare
U1_Name : constant String (1 .. Name_Len) :=
- Name_Buffer (1 .. Name_Len);
+ Name_Buffer (1 .. Name_Len);
Min_Length : Natural;
begin
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2012, 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- --
Fnam : constant Pattern := (UC & Break (' ')) * Fieldnm;
Field_Def : constant Pattern :=
- "-- " & Fnam & " (" & Break (')') * Accessfunc;
+ "-- " & Fnam & " (" & Break (')') * Accessfunc;
Field_Ref : constant Pattern :=
- " -- " & Fnam & Break ('(') & Len (1) &
- Break (')') * Accessfunc;
+ " -- " & Fnam & Break ('(') & Len (1) &
+ Break (')') * Accessfunc;
Field_Com : constant Pattern := " -- " & Fnam & Span (' ') &
(Break (' ') or Rest) * Accessfunc;
Internal_Static_Sloc : constant Source_Ptr := Static_Sloc;
Checks_On : constant Boolean :=
- (not Index_Checks_Suppressed (Suppress_Typ))
- or else
- (not Range_Checks_Suppressed (Suppress_Typ));
+ (not Index_Checks_Suppressed (Suppress_Typ))
+ or else (not Range_Checks_Suppressed (Suppress_Typ));
begin
-- For now we just return if Checks_On is false, however this should
then
declare
Target_Type : constant Entity_Id :=
- Base_Type (Entity (Subtype_Mark (Parent (N))));
+ Base_Type (Entity (Subtype_Mark (Parent (N))));
Llo, Lhi : Uint;
Rlo, Rhi : Uint;
then
declare
Alloc_Typ : constant Entity_Id :=
- Entity (Expression (Original_Node (N)));
+ Entity (Expression (Original_Node (N)));
begin
if Alloc_Typ = T_Typ
then
declare
Type_Def : constant Node_Id :=
- Type_Definition
- (Original_Node (Parent (T_Typ)));
+ Type_Definition (Original_Node (Parent (T_Typ)));
begin
if Nkind (Type_Def) = N_Derived_Type_Definition
and then Is_Entity_Name (Subtype_Indication (Type_Def))
Loc : constant Source_Ptr := Sloc (Ck_Node);
Expr_Type : constant Entity_Id := Base_Type (Etype (Ck_Node));
Target_Base : constant Entity_Id :=
- Implementation_Base_Type (Target_Typ);
+ Implementation_Base_Type (Target_Typ);
Par : constant Node_Id := Parent (Ck_Node);
pragma Assert (Nkind (Par) = N_Type_Conversion);
Truncate : constant Boolean := Float_Truncate (Par);
Max_Bound : constant Uint :=
- UI_Expon
- (Machine_Radix_Value (Expr_Type),
- Machine_Mantissa_Value (Expr_Type) - 1) - 1;
+ UI_Expon
+ (Machine_Radix_Value (Expr_Type),
+ Machine_Mantissa_Value (Expr_Type) - 1) - 1;
-- Largest bound, so bound plus or minus half is a machine number of F
Loc : constant Source_Ptr := Sloc (Ck_Node);
Checks_On : constant Boolean :=
- (not Index_Checks_Suppressed (Target_Typ))
- or else
- (not Length_Checks_Suppressed (Target_Typ));
+ (not Index_Checks_Suppressed (Target_Typ))
+ or else (not Length_Checks_Suppressed (Target_Typ));
begin
if not Full_Expander_Active then
Loc : constant Source_Ptr := Sloc (Ck_Node);
Checks_On : constant Boolean :=
- (not Index_Checks_Suppressed (Target_Typ))
- or else
- (not Range_Checks_Suppressed (Target_Typ));
+ (not Index_Checks_Suppressed (Target_Typ))
+ or else (not Range_Checks_Suppressed (Target_Typ));
begin
if not Full_Expander_Active or else not Checks_On then
-- fixed point values must be read as integral values.
Float_To_Int : constant Boolean :=
- Is_Floating_Point_Type (Expr_Type)
- and then Is_Integer_Type (Target_Type);
+ Is_Floating_Point_Type (Expr_Type)
+ and then Is_Integer_Type (Target_Type);
begin
if not Overflow_Checks_Suppressed (Target_Base)
New_Constraints : constant Elist_Id := New_Elmt_List;
Old_Constraints : constant Elist_Id :=
- Discriminant_Constraint (Expr_Type);
+ Discriminant_Constraint (Expr_Type);
begin
Constraint := First_Elmt (Stored_Constraint (Target_Type));
Sel : constant Node_Id := Selector_Name (N);
Orig_Comp : constant Entity_Id :=
- Original_Record_Component (Entity (Sel));
+ Original_Record_Component (Entity (Sel));
-- The original component to be checked
Discr_Fct : constant Entity_Id :=
- Discriminant_Checking_Func (Orig_Comp);
+ Discriminant_Checking_Func (Orig_Comp);
-- The discriminant checking function
Discr : Entity_Id;
Check_Node : Node_Id;
Checks_On : constant Boolean :=
- (not Index_Checks_Suppressed (Suppress_Typ))
- or else
- (not Range_Checks_Suppressed (Suppress_Typ));
+ (not Index_Checks_Suppressed (Suppress_Typ))
+ or else (not Range_Checks_Suppressed (Suppress_Typ));
begin
-- For now we just return if Checks_On is false, however this should be
Out_Of_Range : Boolean;
Static_Bounds : constant Boolean :=
- Compile_Time_Known_Value (LB)
- and Compile_Time_Known_Value (UB);
+ Compile_Time_Known_Value (LB)
+ and Compile_Time_Known_Value (UB);
begin
-- Following range tests should use Sem_Eval routine ???
-- --
-- B o d y --
-- --
--- Copyright (C) 2003-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2003-2012, 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- --
-- Changed to "b__" for VMS in the body of the package.
Project_Tree : constant Project_Tree_Ref :=
- new Project_Tree_Data (Is_Root_Tree => True);
+ new Project_Tree_Data (Is_Root_Tree => True);
-- The project tree
Object_Directory_Path : String_Access := null;
-- The name of the archive dependency file for this project
Obj_Dir : constant String :=
- Get_Name_String (Project.Object_Directory.Display_Name);
+ Get_Name_String (Project.Object_Directory.Display_Name);
begin
Change_Dir (Obj_Dir);
declare
Obj_Dir : constant String :=
- Dir_Name (Get_Name_String (Full_Lib_File));
+ Dir_Name (Get_Name_String (Full_Lib_File));
Obj : constant String := Object_File_Name (Lib_File);
Adt : constant String := Tree_File_Name (Lib_File);
Asm : constant String := Assembly_File_Name (Lib_File);
for J in 1 .. Sources.Last loop
declare
Deb : constant String :=
- Debug_File_Name (Sources.Table (J));
+ Debug_File_Name (Sources.Table (J));
Rep : constant String :=
- Repinfo_File_Name (Sources.Table (J));
+ Repinfo_File_Name (Sources.Table (J));
begin
if Is_Regular_File (Obj_Dir & Dir_Separator & Deb) then
if not Compile_Only then
declare
Source : constant File_Name_Type :=
- Strip_Suffix (Main_Lib_File);
+ Strip_Suffix (Main_Lib_File);
Executable : constant String :=
- Get_Name_String (Executable_Name (Source));
+ Get_Name_String (Executable_Name (Source));
begin
if Is_Regular_File (Executable) then
Delete ("", Executable);
then
declare
Directory : constant String :=
- Get_Name_String (Project.Library_Src_Dir.Display_Name);
+ Get_Name_String (Project.Library_Src_Dir.Display_Name);
begin
Change_Dir (Directory);
Lib_Filename : constant String := Get_Name_String (Project.Library_Name);
DLL_Name : String :=
- DLL_Prefix & Lib_Filename & "." & DLL_Ext;
+ DLL_Prefix & Lib_Filename & "." & DLL_Ext;
Archive_Name : String :=
- "lib" & Lib_Filename & "." & Archive_Ext;
+ "lib" & Lib_Filename & "." & Archive_Ext;
Direc : Dir_Type;
Name : String (1 .. 200);
declare
Lib_Directory : constant String :=
- Get_Name_String
- (Project.Library_Dir.Display_Name);
+ Get_Name_String (Project.Library_Dir.Display_Name);
Lib_ALI_Directory : constant String :=
- Get_Name_String
- (Project.Library_ALI_Dir.Display_Name);
+ Get_Name_String (Project.Library_ALI_Dir.Display_Name);
begin
Canonical_Case_File_Name (Archive_Name);
if Project.Object_Directory /= No_Path_Information then
declare
Obj_Dir : constant String :=
- Get_Name_String
- (Project.Object_Directory.Display_Name);
+ Get_Name_String (Project.Object_Directory.Display_Name);
begin
Change_Dir (Obj_Dir);
declare
Asm : constant String :=
- Assembly_File_Name (Lib_File);
+ Assembly_File_Name (Lib_File);
ALI : constant String :=
- ALI_File_Name (Lib_File);
+ ALI_File_Name (Lib_File);
Obj : constant String :=
- Object_File_Name (Lib_File);
+ Object_File_Name (Lib_File);
Adt : constant String :=
- Tree_File_Name (Lib_File);
+ Tree_File_Name (Lib_File);
Deb : constant String :=
- Debug_File_Name (File_Name1);
+ Debug_File_Name (File_Name1);
Rep : constant String :=
- Repinfo_File_Name (File_Name1);
+ Repinfo_File_Name (File_Name1);
Del : Boolean := True;
begin
if File_Name2 /= No_File then
declare
Deb : constant String :=
- Debug_File_Name (File_Name2);
+ Debug_File_Name (File_Name2);
Rep : constant String :=
- Repinfo_File_Name (File_Name2);
+ Repinfo_File_Name (File_Name2);
begin
if Is_Regular_File (Deb) then
then
declare
Exec_Dir : constant String :=
- Get_Name_String (Project.Exec_Directory.Display_Name);
+ Get_Name_String (Project.Exec_Directory.Display_Name);
begin
Change_Dir (Exec_Dir);
declare
Exec_File_Name : constant String :=
- Get_Name_String (Executable);
+ Get_Name_String (Executable);
begin
if Is_Absolute_Path (Name => Exec_File_Name) then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
procedure Pack_String_Type (String_Type : Entity_Id) is
Prag : constant Node_Id :=
- Make_Pragma (Stloc,
- Chars => Name_Pack,
- Pragma_Argument_Associations =>
- New_List (
- Make_Pragma_Argument_Association (Stloc,
- Expression =>
- New_Occurrence_Of (String_Type, Stloc))));
+ Make_Pragma (Stloc,
+ Chars => Name_Pack,
+ Pragma_Argument_Associations =>
+ New_List (
+ Make_Pragma_Argument_Association (Stloc,
+ Expression => New_Occurrence_Of (String_Type, Stloc))));
begin
Append (Prag, Decl_S);
Record_Rep_Item (String_Type, Prag);
-- Global flag table allowing rapid computation of this function
Entity_Is_Base_Type : constant array (Entity_Kind) of Boolean :=
- (E_Enumeration_Subtype |
- E_Incomplete_Type |
- E_Signed_Integer_Subtype |
- E_Modular_Integer_Subtype |
- E_Floating_Point_Subtype |
- E_Ordinary_Fixed_Point_Subtype |
- E_Decimal_Fixed_Point_Subtype |
- E_Array_Subtype |
- E_String_Subtype |
- E_Record_Subtype |
- E_Private_Subtype |
- E_Record_Subtype_With_Private |
- E_Limited_Private_Subtype |
- E_Access_Subtype |
- E_Protected_Subtype |
- E_Task_Subtype |
- E_String_Literal_Subtype |
- E_Class_Wide_Subtype => False,
- others => True);
+ (E_Enumeration_Subtype |
+ E_Incomplete_Type |
+ E_Signed_Integer_Subtype |
+ E_Modular_Integer_Subtype |
+ E_Floating_Point_Subtype |
+ E_Ordinary_Fixed_Point_Subtype |
+ E_Decimal_Fixed_Point_Subtype |
+ E_Array_Subtype |
+ E_String_Subtype |
+ E_Record_Subtype |
+ E_Private_Subtype |
+ E_Record_Subtype_With_Private |
+ E_Limited_Private_Subtype |
+ E_Access_Subtype |
+ E_Protected_Subtype |
+ E_Task_Subtype |
+ E_String_Literal_Subtype |
+ E_Class_Wide_Subtype => False,
+ others => True);
function Is_Base_Type (Id : E) return Boolean is
begin
if Sloc (Error_Msg_Node_1) > Standard_Location then
declare
Iloc : constant Source_Ptr :=
- Instantiation_Location (Sloc (Error_Msg_Node_1));
+ Instantiation_Location (Sloc (Error_Msg_Node_1));
begin
if Iloc /= No_Location
if Is_Itype (Ent) then
declare
Assoc : constant Node_Id :=
- Associated_Node_For_Itype (Ent);
+ Associated_Node_For_Itype (Ent);
begin
if Nkind (Assoc) in N_Subprogram_Specification then
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
type Radix_Power_Table is array (Int range 1 .. 4) of Int;
Radix_Powers : constant Radix_Power_Table :=
- (Radix ** 1, Radix ** 2, Radix ** 3, Radix ** 4);
+ (Radix ** 1, Radix ** 2, Radix ** 3, Radix ** 4);
-----------------------
-- Local Subprograms --
-- True iff Fraction is even
Most_Significant_Digit : constant UI :=
- Radix ** (Machine_Mantissa_Value (RT) - 1);
+ Radix ** (Machine_Mantissa_Value (RT) - 1);
Uintp_Mark : Uintp.Save_Mark;
-- The code is divided into blocks that systematically release
-- components.
Max_Aggr_Size : constant Nat :=
- 5000 + (2 ** 24 - 5000) *
- Boolean'Pos
- (Restriction_Active (No_Elaboration_Code)
- or else
- Restriction_Active (No_Implicit_Loops)
- or else
- Is_Two_Dim_Packed_Array (Typ)
- or else
- ((Ekind (Current_Scope) = E_Package
- and then
- Static_Elaboration_Desired (Current_Scope))));
+ 5000 + (2 ** 24 - 5000) *
+ Boolean'Pos
+ (Restriction_Active (No_Elaboration_Code)
+ or else Restriction_Active (No_Implicit_Loops)
+ or else Is_Two_Dim_Packed_Array (Typ)
+ or else ((Ekind (Current_Scope) = E_Package
+ and then Static_Elaboration_Desired (Current_Scope))));
function Component_Count (T : Entity_Id) return Int;
-- The limit is applied to the total number of components that the
elsif Is_Array_Type (T) then
declare
Lo : constant Node_Id :=
- Type_Low_Bound (Etype (First_Index (T)));
+ Type_Low_Bound (Etype (First_Index (T)));
Hi : constant Node_Id :=
- Type_High_Bound (Etype (First_Index (T)));
+ Type_High_Bound (Etype (First_Index (T)));
Siz : constant Int := Component_Count (Component_Type (T));
then
declare
Index_Type : constant Entity_Id :=
- Etype
- (First_Index
- (Etype (Defining_Identifier (Parent (N)))));
+ Etype
+ (First_Index (Etype (Defining_Identifier (Parent (N)))));
Indx : Node_Id;
begin
and then CPP_Num_Prims (Typ) > 0
then
Invoke_Constructor : declare
- CPP_Parent : constant Entity_Id :=
- Enclosing_CPP_Parent (Typ);
+ CPP_Parent : constant Entity_Id := Enclosing_CPP_Parent (Typ);
procedure Invoke_IC_Proc (T : Entity_Id);
-- Recursive routine used to climb to parents. Required because
SubE : constant Entity_Id := Make_Temporary (Loc, 'T');
SubD : constant Node_Id :=
- Make_Subtype_Declaration (Loc,
- Defining_Identifier => SubE,
- Subtype_Indication =>
- Make_Subtype_Indication (Loc,
- Subtype_Mark =>
- New_Reference_To
- (Etype (Comp_Type), Loc),
- Constraint =>
- Make_Index_Or_Discriminant_Constraint
- (Loc,
- Constraints => New_List (
- New_Copy_Tree
- (Aggregate_Bounds (Expr_Q))))));
+ Make_Subtype_Declaration (Loc,
+ Defining_Identifier => SubE,
+ Subtype_Indication =>
+ Make_Subtype_Indication (Loc,
+ Subtype_Mark =>
+ New_Reference_To (Etype (Comp_Type), Loc),
+ Constraint =>
+ Make_Index_Or_Discriminant_Constraint
+ (Loc,
+ Constraints => New_List (
+ New_Copy_Tree
+ (Aggregate_Bounds (Expr_Q))))));
-- Create a temporary array of the above subtype which
-- will be used to capture the aggregate assignments.
TmpE : constant Entity_Id := Make_Temporary (Loc, 'A', N);
TmpD : constant Node_Id :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => TmpE,
- Object_Definition =>
- New_Reference_To (SubE, Loc));
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => TmpE,
+ Object_Definition => New_Reference_To (SubE, Loc));
begin
Set_No_Initialization (TmpD);
Temp : constant Entity_Id := Defining_Identifier (Decl);
Occ : constant Node_Id :=
- Unchecked_Convert_To (Typ,
- Make_Explicit_Dereference (Loc,
- New_Reference_To (Temp, Loc)));
+ Unchecked_Convert_To (Typ,
+ Make_Explicit_Dereference (Loc, New_Reference_To (Temp, Loc)));
begin
if Is_Array_Type (Typ) then
declare
P : constant Entity_Id :=
- Cunit_Entity (Current_Sem_Unit);
+ Cunit_Entity (Current_Sem_Unit);
begin
-- Check if duplication OK and if so continue
-- possible, provided other conditions are met on the LHS.
Others_Present : array (1 .. Aggr_Dimension) of Boolean :=
- (others => False);
+ (others => False);
-- If Others_Present (J) is True, then there is an others choice
-- in one of the sub-aggregates of N at dimension J.
elsif Tagged_Type_Expansion then
declare
Tag_Name : constant Node_Id :=
- New_Occurrence_Of
- (First_Tag_Component (Typ), Loc);
+ New_Occurrence_Of (First_Tag_Component (Typ), Loc);
Typ_Tag : constant Entity_Id := RTE (RE_Tag);
Conv_Node : constant Node_Id :=
- Unchecked_Convert_To (Typ_Tag, Tag_Value);
+ Unchecked_Convert_To (Typ_Tag, Tag_Value);
begin
Set_Etype (Conv_Node, Typ_Tag);