+2013-04-11 Arnaud Charlet <charlet@adacore.com>
+
+ * gnat1drv.adb: Minor code clean up.
+
+2013-04-11 Arnaud Charlet <charlet@adacore.com>
+
+ * debug.adb, sem_ch13.adb (Analyze_Enumeration_Representation_Clause):
+ Ignore enumeration rep clauses by default in CodePeer mode, unless
+ -gnatd.I is specified.
+
+2013-04-11 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_util.adb (Safe_To_Capture_Value): If the node belongs to
+ an expression that has been attached to the else_actions of an
+ if-expression, the capture is not safe.
+
+2013-04-11 Yannick Moy <moy@adacore.com>
+
+ * checks.adb (Apply_Type_Conversion_Checks): Put check mark on type
+ conversion for arrays.
+
+2013-04-11 Robert Dewar <dewar@adacore.com>
+
+ * a-cdlili.adb, a-cidlli.adb, a-cbdlli.adb: Minor reformatting.
+
+2013-04-11 Johannes Kanig <kanig@adacore.com>
+
+ * adabkend.adb: Minor comment addition.
+
2013-04-11 Matthew Heaney <heaney@adacore.com>
* a-cdlili.adb, a-cidlli.adb, a-cbdlli.adb ("="): Increment
LR := LR - 1;
return Result;
+
exception
when others =>
BL := BL - 1;
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
- end if;
- if Position.Container /= Container'Unrestricted_Access then
+ elsif Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
- end if;
- pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
+ else
+ pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
- declare
- N : Node_Type renames Container.Nodes (Position.Node);
- begin
- return (Element => N.Element'Access);
- end;
+ declare
+ N : Node_Type renames Container.Nodes (Position.Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end if;
end Constant_Reference;
--------------
begin
if Capacity = 0 then
C := Source.Length;
-
elsif Capacity >= Source.Length then
C := Capacity;
-
else
raise Capacity_Error with "Capacity value too small";
end if;
"attempt to tamper with cursors (list is busy)";
end if;
- for I in 1 .. Count loop
+ for J in 1 .. Count loop
X := Container.First;
pragma Assert (N (N (X).Next).Prev = Container.First);
"attempt to tamper with cursors (list is busy)";
end if;
- for I in 1 .. Count loop
+ for J in 1 .. Count loop
X := Container.Last;
pragma Assert (N (N (X).Prev).Next = Container.Last);
if Position.Node = 0 then
raise Constraint_Error with
"Position cursor has no element";
- end if;
- pragma Assert (Vet (Position), "bad cursor in Element");
+ else
+ pragma Assert (Vet (Position), "bad cursor in Element");
- return Position.Container.Nodes (Position.Node).Element;
+ return Position.Container.Nodes (Position.Node).Element;
+ end if;
end Element;
--------------
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Busy;
-
begin
B := B - 1;
end;
else
return Cursor'(Container'Unrestricted_Access, Result);
end if;
+
exception
when others =>
B := B - 1;
begin
if Container.First = 0 then
return No_Element;
+ else
+ return Cursor'(Container'Unrestricted_Access, Container.First);
end if;
-
- return Cursor'(Container'Unrestricted_Access, Container.First);
end First;
function First (Object : Iterator) return Cursor is
begin
if Container.First = 0 then
raise Constraint_Error with "list is empty";
+ else
+ return Container.Nodes (Container.First).Element;
end if;
-
- return Container.Nodes (Container.First).Element;
end First_Element;
----------
L := L - 1;
return Result;
+
exception
when others =>
B := B - 1;
SB := SB - 1;
SL := SL - 1;
+
exception
when others =>
TB := TB - 1;
B := B - 1;
L := L - 1;
+
exception
when others =>
B := B - 1;
Process (Cursor'(Container'Unrestricted_Access, Node));
Node := Container.Nodes (Node).Next;
end loop;
-
exception
when others =>
B := B - 1;
-- 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;
begin
if Container.Last = 0 then
return No_Element;
+ else
+ return Cursor'(Container'Unrestricted_Access, Container.Last);
end if;
-
- return Cursor'(Container'Unrestricted_Access, Container.Last);
end Last;
function Last (Object : Iterator) return Cursor is
begin
if Container.Last = 0 then
raise Constraint_Error with "list is empty";
+ else
+ return Container.Nodes (Container.Last).Element;
end if;
-
- return Container.Nodes (Container.Last).Element;
end Last_Element;
------------
declare
Nodes : Node_Array renames Position.Container.Nodes;
Node : constant Count_Type := Nodes (Position.Node).Next;
-
begin
if Node = 0 then
return No_Element;
+ else
+ return Cursor'(Position.Container, Node);
end if;
-
- return Cursor'(Position.Container, Node);
end;
end Next;
begin
if Position.Container = null then
return No_Element;
- end if;
-
- if Position.Container /= Object.Container then
+ elsif Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Next designates wrong list";
+ else
+ return Next (Position);
end if;
-
- return Next (Position);
end Next;
-------------
begin
if Node = 0 then
return No_Element;
+ else
+ return Cursor'(Position.Container, Node);
end if;
-
- return Cursor'(Position.Container, Node);
end;
end Previous;
begin
if Position.Container = null then
return No_Element;
- end if;
-
- if Position.Container /= Object.Container then
+ elsif Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Previous designates wrong list";
+ else
+ return Previous (Position);
end if;
-
- return Previous (Position);
end Previous;
-------------------
if N < 0 then
raise Program_Error with "bad list length (corrupt stream)";
- end if;
- if N = 0 then
+ elsif N = 0 then
return;
- end if;
- if N > Item.Capacity then
+ elsif N > Item.Capacity then
raise Constraint_Error with "length exceeds capacity";
- end if;
- for Idx in 1 .. N loop
- Allocate (Item, Stream, New_Node => X);
- Insert_Internal (Item, Before => 0, New_Node => X);
- end loop;
+ else
+ for Idx in 1 .. N loop
+ Allocate (Item, Stream, New_Node => X);
+ Insert_Internal (Item, Before => 0, New_Node => X);
+ end loop;
+ end if;
end Read;
procedure Read
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
- end if;
- if Position.Container /= Container'Unrestricted_Access then
+ elsif Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
- end if;
- pragma Assert (Vet (Position), "bad cursor in function Reference");
+ else
+ pragma Assert (Vet (Position), "bad cursor in function Reference");
- declare
- N : Node_Type renames Container.Nodes (Position.Node);
- begin
- return (Element => N.Element'Access);
- end;
+ declare
+ N : Node_Type renames Container.Nodes (Position.Node);
+ begin
+ return (Element => N.Element'Access);
+ end;
+ end if;
end Reference;
---------------------
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
- end if;
- if Position.Container /= Container'Unchecked_Access then
+ elsif Position.Container /= Container'Unchecked_Access then
raise Program_Error with
"Position cursor designates wrong container";
- end if;
- if Container.Lock > 0 then
+ elsif Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with elements (list is locked)";
- end if;
- pragma Assert (Vet (Position), "bad cursor in Replace_Element");
+ else
+ pragma Assert (Vet (Position), "bad cursor in Replace_Element");
- Container.Nodes (Position.Node).Element := New_Item;
+ Container.Nodes (Position.Node).Element := New_Item;
+ end if;
end Replace_Element;
----------------------
else
return Cursor'(Container'Unrestricted_Access, Result);
end if;
+
exception
when others =>
B := B - 1;
Process (Cursor'(Container'Unrestricted_Access, Node));
Node := Container.Nodes (Node).Prev;
end loop;
-
exception
when others =>
B := B - 1;
pragma Assert (Vet (Before), "bad cursor in Splice");
end if;
- if Target'Address = Source'Address
- or else Source.Length = 0
- then
+ if Target'Address = Source'Address or else Source.Length = 0 then
return;
- end if;
- if Target.Length > Count_Type'Last - Source.Length then
+ elsif Target.Length > Count_Type'Last - Source.Length then
raise Constraint_Error with "new length exceeds maximum";
- end if;
- if Target.Length + Source.Length > Target.Capacity then
+ elsif Target.Length + Source.Length > Target.Capacity then
raise Capacity_Error with "new length exceeds target capacity";
- end if;
- if Target.Busy > 0 then
+ elsif Target.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Target (list is busy)";
- end if;
- if Source.Busy > 0 then
+ elsif Source.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Source (list is busy)";
- end if;
- Splice_Internal (Target, Before.Node, Source);
+ else
+ Splice_Internal (Target, Before.Node, Source);
+ end if;
end Splice;
procedure Splice
pragma Assert (N (Position.Node).Prev /= 0);
- -- ELiminate another possibility
+ -- Eliminate another possibility
if Position.Node = L.Last then
return True;
LR := LR - 1;
return Result;
+
exception
when others =>
BL := BL - 1;
Free (X);
end loop;
+ -- The following comment is unacceptable, more detail needed ???
+
Position := No_Element; -- Post-York behavior
end Delete;
"attempt to tamper with cursors (list is busy)";
end if;
- for I in 1 .. Count loop
+ for J in 1 .. Count loop
X := Container.First;
pragma Assert (X.Next.Prev = Container.First);
"attempt to tamper with cursors (list is busy)";
end if;
- for I in 1 .. Count loop
+ for J in 1 .. Count loop
X := Container.Last;
pragma Assert (X.Prev.Next = Container.Last);
if Position.Node = null then
raise Constraint_Error with
"Position cursor has no element";
- end if;
-
- pragma Assert (Vet (Position), "bad cursor in Element");
+ else
+ pragma Assert (Vet (Position), "bad cursor in Element");
- return Position.Node.Element;
+ return Position.Node.Element;
+ end if;
end Element;
--------------
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
+ else
+ pragma Assert (Vet (Position), "bad cursor in Find");
end if;
-
- pragma Assert (Vet (Position), "bad cursor in Find");
end if;
-- Per AI05-0022, the container implementation is required to detect
if Node.Element = Item then
Result := Node;
exit;
+ else
+ Node := Node.Next;
end if;
-
- Node := Node.Next;
end loop;
B := B - 1;
else
return Cursor'(Container'Unrestricted_Access, Result);
end if;
+
exception
when others =>
B := B - 1;
begin
if Container.First = null then
return No_Element;
+ else
+ return Cursor'(Container'Unrestricted_Access, Container.First);
end if;
-
- return Cursor'(Container'Unrestricted_Access, Container.First);
end First;
function First (Object : Iterator) return Cursor is
begin
if Container.First = null then
raise Constraint_Error with "list is empty";
+ else
+ return Container.First.Element;
end if;
-
- return Container.First.Element;
end First_Element;
----------
procedure Free (X : in out Node_Access) is
procedure Deallocate is
- new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+ new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+
begin
-- While a node is in use, as an active link in a list, its Previous and
-- Next components must be null, or designate a different node; this is
L := L - 1;
return Result;
+
exception
when others =>
B := B - 1;
SB := SB - 1;
SL := SL - 1;
+
exception
when others =>
TB := TB - 1;
---------------
procedure Partition (Pivot : Node_Access; Back : Node_Access) is
- Node : Node_Access := Pivot.Next;
+ Node : Node_Access;
begin
+ Node := Pivot.Next;
while Node /= Back loop
if Node.Element < Pivot.Element then
declare
B := B - 1;
L := L - 1;
+
exception
when others =>
B := B - 1;
if Before.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Before cursor designates wrong list";
+ else
+ pragma Assert (Vet (Before), "bad cursor in Insert");
end if;
-
- pragma Assert (Vet (Before), "bad cursor in Insert");
end if;
if Count = 0 then
Position := Before;
return;
- end if;
- if Container.Length > Count_Type'Last - Count then
+ elsif Container.Length > Count_Type'Last - Count then
raise Constraint_Error with "new length exceeds maximum";
- end if;
- if Container.Busy > 0 then
+ elsif Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors (list is busy)";
- end if;
-
- New_Node := new Node_Type'(New_Item, null, null);
- Insert_Internal (Container, Before.Node, New_Node);
- Position := Cursor'(Container'Unchecked_Access, New_Node);
-
- for J in Count_Type'(2) .. Count loop
+ else
New_Node := new Node_Type'(New_Item, null, null);
Insert_Internal (Container, Before.Node, New_Node);
- end loop;
+
+ Position := Cursor'(Container'Unchecked_Access, New_Node);
+
+ for J in 2 .. Count loop
+ New_Node := new Node_Type'(New_Item, null, null);
+ Insert_Internal (Container, Before.Node, New_Node);
+ end loop;
+ end if;
end Insert;
procedure Insert
if Before.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Before cursor designates wrong list";
+ else
+ pragma Assert (Vet (Before), "bad cursor in Insert");
end if;
-
- pragma Assert (Vet (Before), "bad cursor in Insert");
end if;
if Count = 0 then
if Container.Length > Count_Type'Last - Count then
raise Constraint_Error with "new length exceeds maximum";
- end if;
- if Container.Busy > 0 then
+ elsif Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors (list is busy)";
- end if;
-
- New_Node := new Node_Type;
- Insert_Internal (Container, Before.Node, New_Node);
- Position := Cursor'(Container'Unchecked_Access, New_Node);
-
- for J in Count_Type'(2) .. Count loop
+ else
New_Node := new Node_Type;
Insert_Internal (Container, Before.Node, New_Node);
- end loop;
+
+ Position := Cursor'(Container'Unchecked_Access, New_Node);
+
+ for J in 2 .. Count loop
+ New_Node := new Node_Type;
+ Insert_Internal (Container, Before.Node, New_Node);
+ end loop;
+ end if;
end Insert;
---------------------
-- 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;
if Start = No_Element then
raise Constraint_Error with
"Start position for iterator equals No_Element";
- end if;
- if Start.Container /= Container'Unrestricted_Access then
+ elsif Start.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Start cursor of Iterate designates wrong list";
- end if;
-
- pragma Assert (Vet (Start), "Start cursor of Iterate is bad");
- -- The value of the Node component influences the behavior of the First
- -- and Last selector functions of the iterator object. When the Node
- -- component is non-null (as is the case here), it means that this
- -- is a partial iteration, over a subset of the complete sequence of
- -- items. The iterator object was constructed with a start expression,
- -- indicating the position from which the iteration begins. Note that
- -- the start position has the same value irrespective of whether this
- -- is a forward or reverse iteration.
-
- return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => Start.Node)
- do
- B := B + 1;
- end return;
+ else
+ pragma Assert (Vet (Start), "Start cursor of Iterate is bad");
+
+ -- The value of the Node component influences the behavior of the
+ -- First and Last selector functions of the iterator object. When
+ -- the Node component is non-null (as is the case here), it means
+ -- that this is a partial iteration, over a subset of the complete
+ -- sequence of items. The iterator object was constructed with
+ -- a start expression, indicating the position from which the
+ -- iteration begins. Note that the start position has the same value
+ -- irrespective of whether this is a forward or reverse iteration.
+
+ return It : constant Iterator :=
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => Start.Node)
+ do
+ B := B + 1;
+ end return;
+ end if;
end Iterate;
----------
begin
if Container.Last = null then
return No_Element;
+ else
+ return Cursor'(Container'Unrestricted_Access, Container.Last);
end if;
-
- return Cursor'(Container'Unrestricted_Access, Container.Last);
end Last;
function Last (Object : Iterator) return Cursor is
begin
if Container.Last = null then
raise Constraint_Error with "list is empty";
+ else
+ return Container.Last.Element;
end if;
-
- return Container.Last.Element;
end Last_Element;
------------
begin
if Target'Address = Source'Address then
return;
- end if;
- if Source.Busy > 0 then
+ elsif Source.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Source (list is busy)";
- end if;
- Clear (Target);
+ else
+ Clear (Target);
- Target.First := Source.First;
- Source.First := null;
+ Target.First := Source.First;
+ Source.First := null;
- Target.Last := Source.Last;
- Source.Last := null;
+ Target.Last := Source.Last;
+ Source.Last := null;
- Target.Length := Source.Length;
- Source.Length := 0;
+ Target.Length := Source.Length;
+ Source.Length := 0;
+ end if;
end Move;
----------
begin
if Position.Node = null then
return No_Element;
- end if;
-
- pragma Assert (Vet (Position), "bad cursor in Next");
- declare
- Next_Node : constant Node_Access := Position.Node.Next;
-
- begin
- if Next_Node = null then
- return No_Element;
- end if;
+ else
+ pragma Assert (Vet (Position), "bad cursor in Next");
- return Cursor'(Position.Container, Next_Node);
- end;
+ declare
+ Next_Node : constant Node_Access := Position.Node.Next;
+ begin
+ if Next_Node = null then
+ return No_Element;
+ else
+ return Cursor'(Position.Container, Next_Node);
+ end if;
+ end;
+ end if;
end Next;
function Next
begin
if Position.Container = null then
return No_Element;
- end if;
-
- if Position.Container /= Object.Container then
+ elsif Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Next designates wrong list";
+ else
+ return Next (Position);
end if;
-
- return Next (Position);
end Next;
-------------
begin
if Position.Node = null then
return No_Element;
- end if;
-
- pragma Assert (Vet (Position), "bad cursor in Previous");
- declare
- Prev_Node : constant Node_Access := Position.Node.Prev;
-
- begin
- if Prev_Node = null then
- return No_Element;
- end if;
+ else
+ pragma Assert (Vet (Position), "bad cursor in Previous");
- return Cursor'(Position.Container, Prev_Node);
- end;
+ declare
+ Prev_Node : constant Node_Access := Position.Node.Prev;
+ begin
+ if Prev_Node = null then
+ return No_Element;
+ else
+ return Cursor'(Position.Container, Prev_Node);
+ end if;
+ end;
+ end if;
end Previous;
function Previous
begin
if Position.Container = null then
return No_Element;
- end if;
-
- if Position.Container /= Object.Container then
+ elsif Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Previous designates wrong list";
+ else
+ return Previous (Position);
end if;
-
- return Previous (Position);
end Previous;
-------------------
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
- end if;
- if Position.Container /= Container'Unchecked_Access then
+ elsif Position.Container /= Container'Unchecked_Access then
raise Program_Error with
"Position cursor designates wrong container";
- end if;
- pragma Assert (Vet (Position), "bad cursor in function Reference");
+ else
+ pragma Assert (Vet (Position), "bad cursor in function Reference");
- declare
- C : List renames Position.Container.all;
- B : Natural renames C.Busy;
- L : Natural renames C.Lock;
- begin
- return R : constant Reference_Type :=
- (Element => Position.Node.Element'Access,
- Control => (Controlled with Position.Container))
- do
- B := B + 1;
- L := L + 1;
- end return;
- end;
+ declare
+ C : List renames Position.Container.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
+ begin
+ return R : constant Reference_Type :=
+ (Element => Position.Node.Element'Access,
+ Control => (Controlled with Position.Container))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
+ end;
+ end if;
end Reference;
---------------------
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
- end if;
- if Position.Container /= Container'Unchecked_Access then
+ elsif Position.Container /= Container'Unchecked_Access then
raise Program_Error with
"Position cursor designates wrong container";
- end if;
- if Container.Lock > 0 then
+ elsif Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with elements (list is locked)";
- end if;
- pragma Assert (Vet (Position), "bad cursor in Replace_Element");
+ else
+ pragma Assert (Vet (Position), "bad cursor in Replace_Element");
- Position.Node.Element := New_Item;
+ Position.Node.Element := New_Item;
+ end if;
end Replace_Element;
----------------------
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
+ else
+ pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
end if;
-
- pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
end if;
-- Per AI05-0022, the container implementation is required to detect
else
return Cursor'(Container'Unrestricted_Access, Result);
end if;
+
exception
when others =>
B := B - 1;
Process (Cursor'(Container'Unrestricted_Access, Node));
Node := Node.Prev;
end loop;
-
exception
when others =>
B := B - 1;
if Before.Container /= Target'Unrestricted_Access then
raise Program_Error with
"Before cursor designates wrong container";
+ else
+ pragma Assert (Vet (Before), "bad cursor in Splice");
end if;
-
- pragma Assert (Vet (Before), "bad cursor in Splice");
end if;
- if Target'Address = Source'Address
- or else Source.Length = 0
- then
+ if Target'Address = Source'Address or else Source.Length = 0 then
return;
- end if;
- if Target.Length > Count_Type'Last - Source.Length then
+ elsif Target.Length > Count_Type'Last - Source.Length then
raise Constraint_Error with "new length exceeds maximum";
- end if;
- if Target.Busy > 0 then
+ elsif Target.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Target (list is busy)";
- end if;
- if Source.Busy > 0 then
+ elsif Source.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Source (list is busy)";
- end if;
- Splice_Internal (Target, Before.Node, Source);
+ else
+ Splice_Internal (Target, Before.Node, Source);
+ end if;
end Splice;
procedure Splice
if Before.Container /= Container'Unchecked_Access then
raise Program_Error with
"Before cursor designates wrong container";
+ else
+ pragma Assert (Vet (Before), "bad Before cursor in Splice");
end if;
-
- pragma Assert (Vet (Before), "bad Before cursor in Splice");
end if;
if Position.Node = null then
if Before.Container /= Target'Unrestricted_Access then
raise Program_Error with
"Before cursor designates wrong container";
+ else
+ pragma Assert (Vet (Before), "bad Before cursor in Splice");
end if;
-
- pragma Assert (Vet (Before), "bad Before cursor in Splice");
end if;
if Position.Node = null then
raise Constraint_Error with "Position cursor has no element";
- end if;
- if Position.Container /= Source'Unrestricted_Access then
+ elsif Position.Container /= Source'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
- end if;
- pragma Assert (Vet (Position), "bad Position cursor in Splice");
+ else
+ pragma Assert (Vet (Position), "bad Position cursor in Splice");
- if Target.Length = Count_Type'Last then
- raise Constraint_Error with "Target is full";
- end if;
+ if Target.Length = Count_Type'Last then
+ raise Constraint_Error with "Target is full";
- if Target.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with cursors of Target (list is busy)";
- end if;
+ elsif Target.Busy > 0 then
+ raise Program_Error with
+ "attempt to tamper with cursors of Target (list is busy)";
- if Source.Busy > 0 then
- raise Program_Error with
- "attempt to tamper with cursors of Source (list is busy)";
- end if;
+ elsif Source.Busy > 0 then
+ raise Program_Error with
+ "attempt to tamper with cursors of Source (list is busy)";
- Splice_Internal (Target, Before.Node, Source, Position.Node);
- Position.Container := Target'Unchecked_Access;
+ else
+ Splice_Internal (Target, Before.Node, Source, Position.Node);
+ Position.Container := Target'Unchecked_Access;
+ end if;
+ end if;
end Splice;
---------------------
begin
if Position.Node = null then
raise Constraint_Error with "Position cursor has no element";
- end if;
- if Position.Container /= Container'Unchecked_Access then
+ elsif Position.Container /= Container'Unchecked_Access then
raise Program_Error with
"Position cursor designates wrong container";
- end if;
- pragma Assert (Vet (Position), "bad cursor in Update_Element");
-
- declare
- B : Natural renames Container.Busy;
- L : Natural renames Container.Lock;
+ else
+ pragma Assert (Vet (Position), "bad cursor in Update_Element");
- begin
- B := B + 1;
- L := L + 1;
+ declare
+ B : Natural renames Container.Busy;
+ L : Natural renames Container.Lock;
begin
- Process (Position.Node.Element);
- exception
- when others =>
- L := L - 1;
- B := B - 1;
- raise;
- end;
+ B := B + 1;
+ L := L + 1;
- L := L - 1;
- B := B - 1;
- end;
+ begin
+ Process (Position.Node.Element);
+ exception
+ when others =>
+ L := L - 1;
+ B := B - 1;
+ raise;
+ end;
+
+ L := L - 1;
+ B := B - 1;
+ end;
+ end if;
end Update_Element;
---------
end if;
pragma Assert
- (Position.Node.Prev /= null
- or else Position.Node = L.First);
+ (Position.Node.Prev /= null or else Position.Node = L.First);
if Position.Node.Next = null and then Position.Node /= L.Last then
return False;
LR := LR - 1;
return Result;
+
exception
when others =>
BL := BL - 1;
begin
if Target'Address = Source'Address then
return;
- end if;
- Target.Clear;
+ else
+ Target.Clear;
- Node := Source.First;
- while Node /= null loop
- Target.Append (Node.Element.all);
- Node := Node.Next;
- end loop;
+ Node := Source.First;
+ while Node /= null loop
+ Target.Append (Node.Element.all);
+ Node := Node.Next;
+ end loop;
+ end if;
end Assign;
-----------
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
- end if;
- if Position.Container /= Container'Unrestricted_Access then
+ elsif Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
- end if;
-
- if Position.Node.Element = null then
+ elsif Position.Node.Element = null then
raise Program_Error with "Node has no element";
- end if;
- pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
+ else
+ pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
- declare
- C : List renames Position.Container.all;
- B : Natural renames C.Busy;
- L : Natural renames C.Lock;
- begin
- return R : constant Constant_Reference_Type :=
- (Element => Position.Node.Element.all'Access,
- Control => (Controlled with Position.Container))
- do
- B := B + 1;
- L := L + 1;
- end return;
- end;
+ declare
+ C : List renames Position.Container.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
+ begin
+ return R : constant Constant_Reference_Type :=
+ (Element => Position.Node.Element.all'Access,
+ Control => (Controlled with Position.Container))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
+ end;
+ end if;
end Constant_Reference;
--------------
Free (X);
end loop;
+ -- Fix this junk comment ???
+
Position := No_Element; -- Post-York behavior
end Delete;
if Count >= Container.Length then
Clear (Container);
return;
- end if;
- if Count = 0 then
+ elsif Count = 0 then
return;
- end if;
- if Container.Busy > 0 then
+ elsif Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors (list is busy)";
- end if;
- for I in 1 .. Count loop
- X := Container.First;
- pragma Assert (X.Next.Prev = Container.First);
+ else
+ for J in 1 .. Count loop
+ X := Container.First;
+ pragma Assert (X.Next.Prev = Container.First);
- Container.First := X.Next;
- Container.First.Prev := null;
+ Container.First := X.Next;
+ Container.First.Prev := null;
- Container.Length := Container.Length - 1;
+ Container.Length := Container.Length - 1;
- Free (X);
- end loop;
+ Free (X);
+ end loop;
+ end if;
end Delete_First;
-----------------
if Count >= Container.Length then
Clear (Container);
return;
- end if;
- if Count = 0 then
+ elsif Count = 0 then
return;
- end if;
- if Container.Busy > 0 then
+ elsif Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors (list is busy)";
- end if;
- for I in 1 .. Count loop
- X := Container.Last;
- pragma Assert (X.Prev.Next = Container.Last);
+ else
+ for J in 1 .. Count loop
+ X := Container.Last;
+ pragma Assert (X.Prev.Next = Container.Last);
- Container.Last := X.Prev;
- Container.Last.Next := null;
+ Container.Last := X.Prev;
+ Container.Last.Next := null;
- Container.Length := Container.Length - 1;
+ Container.Length := Container.Length - 1;
- Free (X);
- end loop;
+ Free (X);
+ end loop;
+ end if;
end Delete_Last;
-------------
if Position.Node = null then
raise Constraint_Error with
"Position cursor has no element";
- end if;
- if Position.Node.Element = null then
+ elsif Position.Node.Element = null then
raise Program_Error with
"Position cursor has no element";
- end if;
- pragma Assert (Vet (Position), "bad cursor in Element");
+ else
+ pragma Assert (Vet (Position), "bad cursor in Element");
- return Position.Node.Element.all;
+ return Position.Node.Element.all;
+ end if;
end Element;
--------------
else
if Node.Element = null then
raise Program_Error;
- end if;
- if Position.Container /= Container'Unrestricted_Access then
+ elsif Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
- end if;
- pragma Assert (Vet (Position), "bad cursor in Find");
+ else
+ pragma Assert (Vet (Position), "bad cursor in Find");
+ end if;
end if;
-- Per AI05-0022, the container implementation is required to detect
else
return Cursor'(Container'Unrestricted_Access, Result);
end if;
+
exception
when others =>
B := B - 1;
begin
if Container.First = null then
return No_Element;
+ else
+ return Cursor'(Container'Unrestricted_Access, Container.First);
end if;
-
- return Cursor'(Container'Unrestricted_Access, Container.First);
end First;
function First (Object : Iterator) return Cursor is
begin
if Container.First = null then
raise Constraint_Error with "list is empty";
+ else
+ return Container.First.Element.all;
end if;
-
- return Container.First.Element.all;
end First_Element;
----------
Node := Container.First;
Result := True;
- for I in 2 .. Container.Length loop
+ for J in 2 .. Container.Length loop
if Node.Next.Element.all < Node.Element.all then
Result := False;
exit;
L := L - 1;
return Result;
+
exception
when others =>
B := B - 1;
if Source.Is_Empty then
return;
- end if;
- if Target'Address = Source'Address then
+ elsif Target'Address = Source'Address then
raise Program_Error with
"Target and Source denote same non-empty container";
- end if;
- if Target.Length > Count_Type'Last - Source.Length then
+ elsif Target.Length > Count_Type'Last - Source.Length then
raise Constraint_Error with "new length exceeds maximum";
- end if;
- if Target.Busy > 0 then
+ elsif Target.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Target (list is busy)";
- end if;
- if Source.Busy > 0 then
+ elsif Source.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Source (list is busy)";
end if;
RI := Source.First;
while RI /= null loop
pragma Assert (RI.Next = null
- or else not (RI.Next.Element.all <
- RI.Element.all));
+ or else not (RI.Next.Element.all <
+ RI.Element.all));
if LI = null then
Splice_Internal (Target, null, Source);
end if;
pragma Assert (LI.Next = null
- or else not (LI.Next.Element.all <
- LI.Element.all));
+ or else not (LI.Next.Element.all <
+ LI.Element.all));
if RI.Element.all < LI.Element.all then
RJ := RI;
SB := SB - 1;
SL := SL - 1;
+
exception
when others =>
TB := TB - 1;
procedure Sort (Container : in out List) is
procedure Partition (Pivot : Node_Access; Back : Node_Access);
+ -- Comment ???
procedure Sort (Front, Back : Node_Access);
+ -- Comment??? Confusing name??? change name???
---------------
-- Partition --
---------------
procedure Partition (Pivot : Node_Access; Back : Node_Access) is
- Node : Node_Access := Pivot.Next;
+ Node : Node_Access;
begin
+ Node := Pivot.Next;
while Node /= Back loop
if Node.Element.all < Pivot.Element.all then
declare
Prev : constant Node_Access := Node.Prev;
Next : constant Node_Access := Node.Next;
+
begin
Prev.Next := Next;
if Before.Container /= Container'Unrestricted_Access then
raise Program_Error with
"attempt to tamper with cursors (list is busy)";
- end if;
- if Before.Node = null
- or else Before.Node.Element = null
- then
+ elsif Before.Node = null or else Before.Node.Element = null then
raise Program_Error with
"Before cursor has no element";
- end if;
- pragma Assert (Vet (Before), "bad cursor in Insert");
+ else
+ pragma Assert (Vet (Before), "bad cursor in Insert");
+ end if;
end if;
if Count = 0 then
Insert_Internal (Container, Before.Node, New_Node);
Position := Cursor'(Container'Unchecked_Access, New_Node);
- for J in Count_Type'(2) .. Count loop
-
+ for J in 2 .. Count loop
declare
Element : Element_Access := new Element_Type'(New_Item);
begin
-- 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;
if Start = No_Element then
raise Constraint_Error with
"Start position for iterator equals No_Element";
- end if;
- if Start.Container /= Container'Unrestricted_Access then
+ elsif Start.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Start cursor of Iterate designates wrong list";
- end if;
- pragma Assert (Vet (Start), "Start cursor of Iterate is bad");
-
- -- The value of the Node component influences the behavior of the First
- -- and Last selector functions of the iterator object. When the Node
- -- component is non-null (as is the case here), it means that this
- -- is a partial iteration, over a subset of the complete sequence of
- -- items. The iterator object was constructed with a start expression,
- -- indicating the position from which the iteration begins. Note that
- -- the start position has the same value irrespective of whether this
- -- is a forward or reverse iteration.
-
- return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => Start.Node)
- do
- B := B + 1;
- end return;
+ else
+ pragma Assert (Vet (Start), "Start cursor of Iterate is bad");
+
+ -- The value of the Node component influences the behavior of the
+ -- First and Last selector functions of the iterator object. When
+ -- the Node component is non-null (as is the case here), it means
+ -- that this is a partial iteration, over a subset of the complete
+ -- sequence of items. The iterator object was constructed with
+ -- a start expression, indicating the position from which the
+ -- iteration begins. Note that the start position has the same value
+ -- irrespective of whether this is a forward or reverse iteration.
+
+ return It : constant Iterator :=
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => Start.Node)
+ do
+ B := B + 1;
+ end return;
+ end if;
end Iterate;
----------
begin
if Container.Last = null then
return No_Element;
+ else
+ return Cursor'(Container'Unrestricted_Access, Container.Last);
end if;
-
- return Cursor'(Container'Unrestricted_Access, Container.Last);
end Last;
function Last (Object : Iterator) return Cursor is
begin
if Container.Last = null then
raise Constraint_Error with "list is empty";
+ else
+ return Container.Last.Element.all;
end if;
-
- return Container.Last.Element.all;
end Last_Element;
------------
begin
if Target'Address = Source'Address then
return;
- end if;
- if Source.Busy > 0 then
+ elsif Source.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Source (list is busy)";
- end if;
- Clear (Target);
+ else
+ Clear (Target);
- Target.First := Source.First;
- Source.First := null;
+ Target.First := Source.First;
+ Source.First := null;
- Target.Last := Source.Last;
- Source.Last := null;
+ Target.Last := Source.Last;
+ Source.Last := null;
- Target.Length := Source.Length;
- Source.Length := 0;
+ Target.Length := Source.Length;
+ Source.Length := 0;
+ end if;
end Move;
----------
begin
if Position.Node = null then
return No_Element;
- end if;
- pragma Assert (Vet (Position), "bad cursor in Next");
-
- declare
- Next_Node : constant Node_Access := Position.Node.Next;
- begin
- if Next_Node = null then
- return No_Element;
- end if;
+ else
+ pragma Assert (Vet (Position), "bad cursor in Next");
- return Cursor'(Position.Container, Next_Node);
- end;
+ declare
+ Next_Node : constant Node_Access := Position.Node.Next;
+ begin
+ if Next_Node = null then
+ return No_Element;
+ else
+ return Cursor'(Position.Container, Next_Node);
+ end if;
+ end;
+ end if;
end Next;
function Next (Object : Iterator; Position : Cursor) return Cursor is
begin
if Position.Container = null then
return No_Element;
- end if;
-
- if Position.Container /= Object.Container then
+ elsif Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Next designates wrong list";
+ else
+ return Next (Position);
end if;
-
- return Next (Position);
end Next;
-------------
begin
if Position.Node = null then
return No_Element;
- end if;
- pragma Assert (Vet (Position), "bad cursor in Previous");
-
- declare
- Prev_Node : constant Node_Access := Position.Node.Prev;
- begin
- if Prev_Node = null then
- return No_Element;
- end if;
+ else
+ pragma Assert (Vet (Position), "bad cursor in Previous");
- return Cursor'(Position.Container, Prev_Node);
- end;
+ declare
+ Prev_Node : constant Node_Access := Position.Node.Prev;
+ begin
+ if Prev_Node = null then
+ return No_Element;
+ else
+ return Cursor'(Position.Container, Prev_Node);
+ end if;
+ end;
+ end if;
end Previous;
function Previous (Object : Iterator; Position : Cursor) return Cursor is
begin
if Position.Container = null then
return No_Element;
- end if;
-
- if Position.Container /= Object.Container then
+ elsif Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Previous designates wrong list";
+ else
+ return Previous (Position);
end if;
-
- return Previous (Position);
end Previous;
-------------------
if Position.Node = null then
raise Constraint_Error with
"Position cursor has no element";
- end if;
- if Position.Node.Element = null then
+ elsif Position.Node.Element = null then
raise Program_Error with
"Position cursor has no element";
- end if;
-
- pragma Assert (Vet (Position), "bad cursor in Query_Element");
- declare
- C : List renames Position.Container.all'Unrestricted_Access.all;
- B : Natural renames C.Busy;
- L : Natural renames C.Lock;
+ else
+ pragma Assert (Vet (Position), "bad cursor in Query_Element");
- begin
- B := B + 1;
- L := L + 1;
+ declare
+ C : List renames Position.Container.all'Unrestricted_Access.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
begin
- Process (Position.Node.Element.all);
- exception
- when others =>
- L := L - 1;
- B := B - 1;
- raise;
- end;
+ B := B + 1;
+ L := L + 1;
- L := L - 1;
- B := B - 1;
- end;
+ begin
+ Process (Position.Node.Element.all);
+ exception
+ when others =>
+ L := L - 1;
+ B := B - 1;
+ raise;
+ end;
+
+ L := L - 1;
+ B := B - 1;
+ end;
+ end if;
end Query_Element;
----------
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
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
- end if;
- if Position.Container /= Container'Unrestricted_Access then
+ elsif Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
- end if;
- if Position.Node.Element = null then
+ elsif Position.Node.Element = null then
raise Program_Error with "Node has no element";
- end if;
- pragma Assert (Vet (Position), "bad cursor in function Reference");
+ else
+ pragma Assert (Vet (Position), "bad cursor in function Reference");
- declare
- C : List renames Position.Container.all;
- B : Natural renames C.Busy;
- L : Natural renames C.Lock;
- begin
- return R : constant Reference_Type :=
- (Element => Position.Node.Element.all'Access,
- Control => (Controlled with Position.Container))
- do
- B := B + 1;
- L := L + 1;
- end return;
- end;
+ declare
+ C : List renames Position.Container.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
+ begin
+ return R : constant Reference_Type :=
+ (Element => Position.Node.Element.all'Access,
+ Control => (Controlled with Position.Container))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
+ end;
+ end if;
end Reference;
---------------------
begin
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
- end if;
- if Position.Container /= Container'Unchecked_Access then
+ elsif Position.Container /= Container'Unchecked_Access then
raise Program_Error with
"Position cursor designates wrong container";
- end if;
- if Container.Lock > 0 then
+ elsif Container.Lock > 0 then
raise Program_Error with
"attempt to tamper with elements (list is locked)";
- end if;
- if Position.Node.Element = null then
+ elsif Position.Node.Element = null then
raise Program_Error with
"Position cursor has no element";
- end if;
- pragma Assert (Vet (Position), "bad cursor in Replace_Element");
+ else
+ pragma Assert (Vet (Position), "bad cursor in Replace_Element");
- declare
- -- The element allocator may need an accessibility check in the case
- -- the actual type is class-wide or has access discriminants (see
- -- RM 4.8(10.1) and AI12-0035).
+ declare
+ -- The element allocator may need an accessibility check in the
+ -- case the actual type is class-wide or has access discriminants
+ -- (see RM 4.8(10.1) and AI12-0035).
- pragma Unsuppress (Accessibility_Check);
+ pragma Unsuppress (Accessibility_Check);
- X : Element_Access := Position.Node.Element;
+ X : Element_Access := Position.Node.Element;
- begin
- Position.Node.Element := new Element_Type'(New_Item);
- Free (X);
- end;
+ begin
+ Position.Node.Element := new Element_Type'(New_Item);
+ Free (X);
+ end;
+ end if;
end Replace_Element;
----------------------
else
if Node.Element = null then
raise Program_Error with "Position cursor has no element";
- end if;
- if Position.Container /= Container'Unrestricted_Access then
+ elsif Position.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Position cursor designates wrong container";
- end if;
- pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
+ else
+ pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
+ end if;
end if;
-- Per AI05-0022, the container implementation is required to detect
else
return Cursor'(Container'Unrestricted_Access, Result);
end if;
+
exception
when others =>
B := B - 1;
if Before.Container /= Target'Unrestricted_Access then
raise Program_Error with
"Before cursor designates wrong container";
- end if;
- if Before.Node = null
- or else Before.Node.Element = null
- then
+ elsif Before.Node = null or else Before.Node.Element = null then
raise Program_Error with
"Before cursor has no element";
- end if;
- pragma Assert (Vet (Before), "bad cursor in Splice");
+ else
+ pragma Assert (Vet (Before), "bad cursor in Splice");
+ end if;
end if;
- if Target'Address = Source'Address
- or else Source.Length = 0
- then
+ if Target'Address = Source'Address or else Source.Length = 0 then
return;
- end if;
- if Target.Length > Count_Type'Last - Source.Length then
+ elsif Target.Length > Count_Type'Last - Source.Length then
raise Constraint_Error with "new length exceeds maximum";
- end if;
- if Target.Busy > 0 then
+ elsif Target.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Target (list is busy)";
- end if;
- if Source.Busy > 0 then
+ elsif Source.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors of Source (list is busy)";
- end if;
- Splice_Internal (Target, Before.Node, Source);
+ else
+ Splice_Internal (Target, Before.Node, Source);
+ end if;
end Splice;
procedure Splice
if Before.Container /= Container'Unchecked_Access then
raise Program_Error with
"Before cursor designates wrong container";
- end if;
- if Before.Node = null
- or else Before.Node.Element = null
- then
+ elsif Before.Node = null or else Before.Node.Element = null then
raise Program_Error with
"Before cursor has no element";
- end if;
- pragma Assert (Vet (Before), "bad Before cursor in Splice");
+ else
+ pragma Assert (Vet (Before), "bad Before cursor in Splice");
+ end if;
end if;
if Position.Node = null then
then
if Is_Switch (Argv) then
Fail ("Object file name missing after -gnatO");
+
+ -- In Alfa_Mode, such an object file is never written, and the
+ -- call to Set_Output_Object_File_Name may fail (e.g. when the
+ -- object file name does not have the expected suffix). So we
+ -- skip that call when Alfa_Mode is set.
+
elsif Alfa_Mode then
Output_File_Name_Seen := True;
+
else
Set_Output_Object_File_Name (Argv);
Output_File_Name_Seen := True;
Reason => CE_Discriminant_Check_Failed));
end;
- -- For arrays, conversions are applied during expansion, to take into
- -- accounts changes of representation. The checks become range checks on
- -- the base type or length checks on the subtype, depending on whether
- -- the target type is unconstrained or constrained.
-
- else
- null;
+ -- For arrays, checks are set now, but conversions are applied during
+ -- expansion, to take into accounts changes of representation. The
+ -- checks become range checks on the base type or length checks on the
+ -- subtype, depending on whether the target type is unconstrained or
+ -- constrained.
+
+ elsif Is_Array_Type (Target_Type) then
+ if Is_Constrained (Target_Type) then
+ Set_Do_Length_Check (N);
+ else
+ Set_Do_Range_Check (Expr);
+ end if;
end if;
end Apply_Type_Conversion_Checks;
-- d.F Alfa mode
-- d.G Frame condition mode for gnat2why
-- d.H Standard package only mode for gnat2why
- -- d.I
+ -- d.I Do not ignore enum representation clauses in CodePeer mode
-- d.J Disable parallel SCIL generation mode
-- d.K Alfa detection only mode for gnat2why
-- d.L Depend on back end for limited types in if and case expressions
-- will only generate Why code for package Standard. Any given input
-- file will be ignored.
+ -- d.I Do not ignore enum representation clauses in CodePeer mode.
+ -- The default of ignoring representation clauses for enumeration
+ -- types in CodePeer is good for the majority of Ada code, but in some
+ -- cases being able to change this default might be useful to remove
+ -- some false positives.
+
-- d.J Disable parallel SCIL generation. Normally SCIL file generation is
-- done in parallel to speed processing. This switch disables this
-- behavior.
Formal_Extensions := True;
end if;
- -- Alfa_Mode is activated by default in the gnat2why executable, but
- -- can also be activated using the -gnatd.F switch.
+ -- Enable Alfa_Mode when using -gnatd.F switch
- if Debug_Flag_Dot_FF or else Alfa_Mode then
+ if Debug_Flag_Dot_FF then
Alfa_Mode := True;
+ end if;
+
+ -- Alfa_Mode is also activated by default in the gnat2why executable
+
+ if Alfa_Mode then
-- Set strict standard interpretation of compiler permissions
with Aspects; use Aspects;
with Atree; use Atree;
with Checks; use Checks;
+with Debug; use Debug;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
return;
end if;
+ -- Ignore enumeration rep clauses by default in CodePeer mode,
+ -- unless -gnatd.I is specified, as a work around for potential false
+ -- positive messages.
+
+ if CodePeer_Mode and not Debug_Flag_Dot_II then
+ return;
+ end if;
+
-- First some basic error checks
Find_Type (Ident);
else
Desc := P;
P := Parent (P);
+
+ -- A special Ada 2012 case: the original node may be part
+ -- of the else_actions of a conditional expression, in which
+ -- case it might not have been expanded yet, and appears in
+ -- a non-syntactic list of actions. In that case it is clearly
+ -- not safe to save a value.
+
+ if No (P)
+ and then Is_List_Member (Desc)
+ and then No (Parent (List_Containing (Desc)))
+ then
+ return False;
+ end if;
end if;
end loop;
end;
OSDN Git Service
