From: Arnaud Charlet Date: Thu, 11 Apr 2013 12:25:16 +0000 (+0200) Subject: [multiple changes] X-Git-Tag: releases/gcc-4.9.0~6531 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=8bfbd380f2c411f1b264fa234b3beb9cde53752b;p=thirdparty%2Fgcc.git [multiple changes] 2013-04-11 Arnaud Charlet * gnat1drv.adb: Minor code clean up. 2013-04-11 Arnaud Charlet * 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 * 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 * checks.adb (Apply_Type_Conversion_Checks): Put check mark on type conversion for arrays. 2013-04-11 Robert Dewar * a-cdlili.adb, a-cidlli.adb, a-cbdlli.adb: Minor reformatting. 2013-04-11 Johannes Kanig * adabkend.adb: Minor comment addition. From-SVN: r197773 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0d54e5e135c3..547ca6859830 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2013-04-11 Arnaud Charlet + + * gnat1drv.adb: Minor code clean up. + +2013-04-11 Arnaud Charlet + + * 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 + + * 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 + + * checks.adb (Apply_Type_Conversion_Checks): Put check mark on type + conversion for arrays. + +2013-04-11 Robert Dewar + + * a-cdlili.adb, a-cidlli.adb, a-cbdlli.adb: Minor reformatting. + +2013-04-11 Johannes Kanig + + * adabkend.adb: Minor comment addition. + 2013-04-11 Matthew Heaney * a-cdlili.adb, a-cidlli.adb, a-cbdlli.adb ("="): Increment diff --git a/gcc/ada/a-cbdlli.adb b/gcc/ada/a-cbdlli.adb index 1c2502230105..f3e8c8bee30c 100644 --- a/gcc/ada/a-cbdlli.adb +++ b/gcc/ada/a-cbdlli.adb @@ -156,6 +156,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is LR := LR - 1; return Result; + exception when others => BL := BL - 1; @@ -359,20 +360,20 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is 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; -------------- @@ -397,10 +398,8 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is 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; @@ -508,7 +507,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is "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); @@ -547,7 +546,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is "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); @@ -569,11 +568,12 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is 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; -------------- @@ -585,7 +585,6 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is if Object.Container /= null then declare B : Natural renames Object.Container.all.Busy; - begin B := B - 1; end; @@ -648,6 +647,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is else return Cursor'(Container'Unrestricted_Access, Result); end if; + exception when others => B := B - 1; @@ -664,9 +664,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is 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 @@ -699,9 +699,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists 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; ---------- @@ -858,6 +858,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is L := L - 1; return Result; + exception when others => B := B - 1; @@ -962,6 +963,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is SB := SB - 1; SL := SL - 1; + exception when others => TB := TB - 1; @@ -1076,6 +1078,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is B := B - 1; L := L - 1; + exception when others => B := B - 1; @@ -1287,7 +1290,6 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is Process (Cursor'(Container'Unrestricted_Access, Node)); Node := Container.Nodes (Node).Next; end loop; - exception when others => B := B - 1; @@ -1315,9 +1317,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is -- 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; @@ -1380,9 +1382,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is 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 @@ -1415,9 +1417,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists 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; ------------ @@ -1536,13 +1538,12 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is 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; @@ -1553,14 +1554,12 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists 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; ------------- @@ -1599,9 +1598,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is begin if Node = 0 then return No_Element; + else + return Cursor'(Position.Container, Node); end if; - - return Cursor'(Position.Container, Node); end; end Previous; @@ -1612,14 +1611,12 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists 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; ------------------- @@ -1680,20 +1677,19 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is 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 @@ -1731,20 +1727,20 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is 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; --------------------- @@ -1759,21 +1755,20 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is 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; ---------------------- @@ -1919,6 +1914,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is else return Cursor'(Container'Unrestricted_Access, Result); end if; + exception when others => B := B - 1; @@ -1948,7 +1944,6 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is Process (Cursor'(Container'Unrestricted_Access, Node)); Node := Container.Nodes (Node).Prev; end loop; - exception when others => B := B - 1; @@ -1977,31 +1972,26 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is 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 @@ -2583,7 +2573,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is pragma Assert (N (Position.Node).Prev /= 0); - -- ELiminate another possibility + -- Eliminate another possibility if Position.Node = L.Last then return True; diff --git a/gcc/ada/a-cdlili.adb b/gcc/ada/a-cdlili.adb index 2fedd3c3b64a..e7333d892757 100644 --- a/gcc/ada/a-cdlili.adb +++ b/gcc/ada/a-cdlili.adb @@ -135,6 +135,7 @@ package body Ada.Containers.Doubly_Linked_Lists is LR := LR - 1; return Result; + exception when others => BL := BL - 1; @@ -404,6 +405,8 @@ package body Ada.Containers.Doubly_Linked_Lists is Free (X); end loop; + -- The following comment is unacceptable, more detail needed ??? + Position := No_Element; -- Post-York behavior end Delete; @@ -432,7 +435,7 @@ package body Ada.Containers.Doubly_Linked_Lists is "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); @@ -470,7 +473,7 @@ package body Ada.Containers.Doubly_Linked_Lists is "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); @@ -492,11 +495,11 @@ package body Ada.Containers.Doubly_Linked_Lists is 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; -------------- @@ -549,9 +552,9 @@ package body Ada.Containers.Doubly_Linked_Lists is 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 @@ -572,9 +575,9 @@ package body Ada.Containers.Doubly_Linked_Lists is if Node.Element = Item then Result := Node; exit; + else + Node := Node.Next; end if; - - Node := Node.Next; end loop; B := B - 1; @@ -585,6 +588,7 @@ package body Ada.Containers.Doubly_Linked_Lists is else return Cursor'(Container'Unrestricted_Access, Result); end if; + exception when others => B := B - 1; @@ -601,9 +605,9 @@ package body Ada.Containers.Doubly_Linked_Lists is 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 @@ -636,9 +640,9 @@ package body Ada.Containers.Doubly_Linked_Lists 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; ---------- @@ -647,7 +651,8 @@ package body Ada.Containers.Doubly_Linked_Lists is 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 @@ -708,6 +713,7 @@ package body Ada.Containers.Doubly_Linked_Lists is L := L - 1; return Result; + exception when others => B := B - 1; @@ -803,6 +809,7 @@ package body Ada.Containers.Doubly_Linked_Lists is SB := SB - 1; SL := SL - 1; + exception when others => TB := TB - 1; @@ -830,9 +837,10 @@ package body Ada.Containers.Doubly_Linked_Lists is --------------- 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 @@ -913,6 +921,7 @@ package body Ada.Containers.Doubly_Linked_Lists is B := B - 1; L := L - 1; + exception when others => B := B - 1; @@ -954,34 +963,33 @@ package body Ada.Containers.Doubly_Linked_Lists is 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 @@ -1009,9 +1017,9 @@ package body Ada.Containers.Doubly_Linked_Lists is 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 @@ -1021,22 +1029,22 @@ package body Ada.Containers.Doubly_Linked_Lists is 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; --------------------- @@ -1141,9 +1149,9 @@ package body Ada.Containers.Doubly_Linked_Lists is -- 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; @@ -1169,31 +1177,31 @@ package body Ada.Containers.Doubly_Linked_Lists is 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; ---------- @@ -1204,9 +1212,9 @@ package body Ada.Containers.Doubly_Linked_Lists is 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 @@ -1239,9 +1247,9 @@ package body Ada.Containers.Doubly_Linked_Lists 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; ------------ @@ -1264,23 +1272,23 @@ package body Ada.Containers.Doubly_Linked_Lists is 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; ---------- @@ -1296,20 +1304,20 @@ package body Ada.Containers.Doubly_Linked_Lists is 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 @@ -1319,14 +1327,12 @@ package body Ada.Containers.Doubly_Linked_Lists 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; ------------- @@ -1355,20 +1361,20 @@ package body Ada.Containers.Doubly_Linked_Lists is 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 @@ -1378,14 +1384,12 @@ package body Ada.Containers.Doubly_Linked_Lists 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; ------------------- @@ -1514,28 +1518,28 @@ package body Ada.Containers.Doubly_Linked_Lists is 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; --------------------- @@ -1550,21 +1554,20 @@ package body Ada.Containers.Doubly_Linked_Lists is 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; ---------------------- @@ -1673,9 +1676,9 @@ package body Ada.Containers.Doubly_Linked_Lists is 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 @@ -1709,6 +1712,7 @@ package body Ada.Containers.Doubly_Linked_Lists is else return Cursor'(Container'Unrestricted_Access, Result); end if; + exception when others => B := B - 1; @@ -1738,7 +1742,6 @@ package body Ada.Containers.Doubly_Linked_Lists is Process (Cursor'(Container'Unrestricted_Access, Node)); Node := Node.Prev; end loop; - exception when others => B := B - 1; @@ -1762,32 +1765,28 @@ package body Ada.Containers.Doubly_Linked_Lists is 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 @@ -1800,9 +1799,9 @@ package body Ada.Containers.Doubly_Linked_Lists is 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 @@ -1908,38 +1907,37 @@ package body Ada.Containers.Doubly_Linked_Lists is 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; --------------------- @@ -2210,35 +2208,35 @@ package body Ada.Containers.Doubly_Linked_Lists is 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; --------- @@ -2305,8 +2303,7 @@ package body Ada.Containers.Doubly_Linked_Lists is 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; diff --git a/gcc/ada/a-cidlli.adb b/gcc/ada/a-cidlli.adb index 458df261c065..9907406ebdf7 100644 --- a/gcc/ada/a-cidlli.adb +++ b/gcc/ada/a-cidlli.adb @@ -138,6 +138,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is LR := LR - 1; return Result; + exception when others => BL := BL - 1; @@ -247,15 +248,16 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; ----------- @@ -316,32 +318,30 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; -------------- @@ -434,6 +434,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is Free (X); end loop; + -- Fix this junk comment ??? + Position := No_Element; -- Post-York behavior end Delete; @@ -451,28 +453,27 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; ----------------- @@ -489,28 +490,27 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; ------------- @@ -522,16 +522,16 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; -------------- @@ -583,14 +583,14 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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 @@ -624,6 +624,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is else return Cursor'(Container'Unrestricted_Access, Result); end if; + exception when others => B := B - 1; @@ -640,9 +641,9 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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 @@ -675,9 +676,9 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists 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; ---------- @@ -747,7 +748,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; @@ -760,6 +761,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is L := L - 1; return Result; + exception when others => B := B - 1; @@ -786,23 +788,19 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; @@ -827,8 +825,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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); @@ -836,8 +834,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; @@ -854,6 +852,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is SB := SB - 1; SL := SL - 1; + exception when others => TB := TB - 1; @@ -872,22 +871,26 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; @@ -1003,16 +1006,14 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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 @@ -1052,8 +1053,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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 @@ -1183,9 +1183,9 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is -- 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; @@ -1213,31 +1213,31 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; ---------- @@ -1248,9 +1248,9 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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 @@ -1283,9 +1283,9 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists 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; ------------ @@ -1305,23 +1305,23 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; ---------- @@ -1337,33 +1337,32 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; ------------- @@ -1392,33 +1391,32 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; ------------------- @@ -1433,36 +1431,36 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; ---------- @@ -1487,7 +1485,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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 @@ -1503,7 +1501,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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 @@ -1553,32 +1551,31 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; --------------------- @@ -1593,38 +1590,36 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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; ---------------------- @@ -1732,14 +1727,14 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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 @@ -1773,6 +1768,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is else return Cursor'(Container'Unrestricted_Access, Result); end if; + exception when others => B := B - 1; @@ -1825,39 +1821,33 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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 @@ -1870,16 +1860,14 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is 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 diff --git a/gcc/ada/adabkend.adb b/gcc/ada/adabkend.adb index e80876236818..6588b4f3f9cc 100644 --- a/gcc/ada/adabkend.adb +++ b/gcc/ada/adabkend.adb @@ -234,8 +234,15 @@ package body Adabkend is 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; diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 7afabd1c2c68..05a0c6f8c30c 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -3244,13 +3244,18 @@ package body Checks is 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; diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 183413ff0810..cd6d30339a72 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -126,7 +126,7 @@ package body Debug is -- 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 @@ -614,6 +614,12 @@ package body Debug is -- 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. diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 69d37ad0f4fc..0fd6b1a7d213 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -293,11 +293,15 @@ procedure Gnat1drv is 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 diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 4f2d56c16842..56bc0fecc761 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -26,6 +26,7 @@ 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; @@ -4253,6 +4254,14 @@ package body Sem_Ch13 is 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); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 2e05690b55df..d964d0feb900 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -12984,6 +12984,19 @@ package body Sem_Util is 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;