diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 26 | ||||
| -rw-r--r-- | gcc/ada/a-cfdlli.adb | 473 | ||||
| -rw-r--r-- | gcc/ada/a-cfdlli.ads | 110 | ||||
| -rw-r--r-- | gcc/ada/g-socket.adb | 21 | ||||
| -rw-r--r-- | gcc/ada/g-socket.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/s-fileio.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem.ads | 17 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 2 |
11 files changed, 70 insertions, 605 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 57dc294..1976278 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,29 @@ +2013-04-12 Robert Dewar <dewar@adacore.com> + + * sem.ads, opt.ads: Minor comment edits. + * sem_warn.adb, sem_ch6.adb: Minor reformatting. + +2013-04-12 Claire Dross <dross@adacore.com> + + * a-cfdlli.adb a-cfdlli.ads (List, Not_No_Element, Iterate, + Reverse_Iterate, Query_Element, Update_Element, Read, Write): Removed, + not suitable for formal analysis. + +2013-04-12 Ed Schonberg <schonberg@adacore.com> + + * sem_prag.adb (Analyze_Abstract_State): Use Defining entity + to locate package entity, which may be a child unit. + +2013-04-12 Thomas Quinot <quinot@adacore.com> + + * g-socket.adb, g-socket.ads (Connect_Socket, version with timeout): If + the specified timeout is 0, do not attempt to determine whether the + connection succeeded. + +2013-04-12 Doug Rupp <rupp@adacore.com> + + * s-fileio.adb (Form_RMS Context_Key): Fix some thinkos. + 2013-04-12 Doug Rupp <rupp@adacore.com> * s-fileio.adb: Minor reformatting. diff --git a/gcc/ada/a-cfdlli.adb b/gcc/ada/a-cfdlli.adb index f0ed998..34668bd 100644 --- a/gcc/ada/a-cfdlli.adb +++ b/gcc/ada/a-cfdlli.adb @@ -176,8 +176,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is if Container.Length = 0 then pragma Assert (Container.First = 0); pragma Assert (Container.Last = 0); - pragma Assert (Container.Busy = 0); - pragma Assert (Container.Lock = 0); return; end if; @@ -186,11 +184,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is pragma Assert (N (Container.First).Prev = 0); pragma Assert (N (Container.Last).Next = 0); - if Container.Busy > 0 then - raise Program_Error with - "attempt to tamper with elements (list is busy)"; - end if; - while Container.Length > 1 loop X := Container.First; @@ -297,11 +290,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is return; end if; - if Container.Busy > 0 then - raise Program_Error with - "attempt to tamper with elements (list is busy)"; - end if; - for Index in 1 .. Count loop pragma Assert (Container.Length >= 2); @@ -350,11 +338,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is return; end if; - if Container.Busy > 0 then - raise Program_Error with - "attempt to tamper with elements (list is busy)"; - end if; - for J in 1 .. Count loop X := Container.First; pragma Assert (N (N (X).Next).Prev = Container.First); @@ -389,11 +372,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is return; end if; - if Container.Busy > 0 then - raise Program_Error with - "attempt to tamper with elements (list is busy)"; - end if; - for J in 1 .. Count loop X := Container.Last; pragma Assert (N (N (X).Prev).Next = Container.Last); @@ -424,21 +402,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is return Container.Nodes (Position.Node).Element; end Element; - -------------- - -- Finalize -- - -------------- - - procedure Finalize (Object : in out Iterator) is - begin - if Object.Container /= null then - declare - B : Natural renames Object.Container.all.Busy; - begin - B := B - 1; - end; - end if; - end Finalize; - ---------- -- Find -- ---------- @@ -490,28 +453,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is return (Node => Container.First); end First; - function First (Object : Iterator) return Cursor is - begin - -- The value of the iterator object's Node component influences the - -- behavior of the First (and Last) selector function. - - -- When the Node component is null, this means the iterator object was - -- constructed without a start expression, in which case the (forward) - -- iteration starts from the (logical) beginning of the entire sequence - -- of items (corresponding to Container.First, for a forward iterator). - - -- Otherwise, this is iteration over a partial sequence of items. When - -- the Node component is non-null, the iterator object was constructed - -- with a start expression, that specifies the position from which the - -- (forward) partial iteration begins. - - if Object.Node = 0 then - return First (Object.Container.all); - else - return (Node => Object.Node); - end if; - end First; - ------------------- -- First_Element -- ------------------- @@ -613,16 +554,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is return; end if; - if 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 - raise Program_Error with - "attempt to tamper with cursors of Source (list is busy)"; - end if; - LI := First (Target); RI := First (Source); while RI.Node /= 0 loop @@ -739,11 +670,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is pragma Assert (N (Container.First).Prev = 0); pragma Assert (N (Container.Last).Next = 0); - if Container.Busy > 0 then - raise Program_Error with - "attempt to tamper with elements (list is busy)"; - end if; - Sort (Front => 0, Back => 0); pragma Assert (N (Container.First).Prev = 0); @@ -792,11 +718,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is raise Constraint_Error with "new length exceeds capacity"; end if; - if Container.Busy > 0 then - raise Program_Error with - "attempt to tamper with elements (list is busy)"; - end if; - Allocate (Container, New_Item, New_Node => J); Insert_Internal (Container, Before.Node, New_Node => J); Position := (Node => J); @@ -840,11 +761,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is raise Constraint_Error with "new length exceeds capacity"; end if; - if Container.Busy > 0 then - raise Program_Error with - "attempt to tamper with elements (list is busy)"; - end if; - Allocate (Container, New_Node => J); Insert_Internal (Container, Before.Node, New_Node => J); Position := (Node => J); @@ -919,103 +835,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is return Length (Container) = 0; end Is_Empty; - ------------- - -- Iterate -- - ------------- - - procedure Iterate - (Container : List; - Process : - not null access procedure (Container : List; Position : Cursor)) - is - C : List renames Container'Unrestricted_Access.all; - B : Natural renames C.Busy; - Node : Count_Type; - - begin - B := B + 1; - - begin - Node := Container.First; - while Node /= 0 loop - Process (Container, (Node => Node)); - Node := Container.Nodes (Node).Next; - end loop; - - exception - when others => - B := B - 1; - raise; - end; - - B := B - 1; - end Iterate; - - function Iterate (Container : List) - return List_Iterator_Interfaces.Reversible_Iterator'Class - is - B : Natural renames Container'Unrestricted_Access.all.Busy; - - begin - -- 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 null (as is the case here), this means the iterator - -- object was constructed without a start expression. This is a - -- complete iterator, meaning that the iteration starts from the - -- (logical) beginning of the sequence of items. - - -- Note: For a forward iterator, Container.First is the beginning, and - -- for a reverse iterator, Container.Last is the beginning. - - return It : constant Iterator := - Iterator'(Ada.Finalization.Limited_Controlled with - Container => Container'Unrestricted_Access, - Node => 0) - do - B := B + 1; - end return; - end Iterate; - - function Iterate (Container : List; Start : Cursor) - return List_Iterator_Interfaces.Reversible_Iterator'Class - is - B : Natural renames Container'Unrestricted_Access.all.Busy; - - begin - -- It was formerly the case that when Start = No_Element, the partial - -- iterator was defined to behave the same as for a complete iterator, - -- and iterate over the entire sequence of items. However, those - -- semantics were unintuitive and arguably error-prone (it is too easy - -- to accidentally create an endless loop), and so they were changed, - -- per the ARG meeting in Denver on 2011/11. However, there was no - -- consensus about what positive meaning this corner case should have, - -- and so it was decided to simply raise an exception. This does imply, - -- however, that it is not possible to use a partial iterator to specify - -- an empty sequence of items. - - if not Has_Element (Container, Start) then - raise Constraint_Error with - "Start position for iterator is not a valid cursor"; - end if; - - -- 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'(Ada.Finalization.Limited_Controlled with - Container => Container'Unrestricted_Access, - Node => Start.Node) - do - B := B + 1; - end return; - end Iterate; - ---------- -- Last -- ---------- @@ -1028,28 +847,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is return (Node => Container.Last); end Last; - function Last (Object : Iterator) return Cursor is - begin - -- The value of the iterator object's Node component influences the - -- behavior of the Last (and First) selector function. - - -- When the Node component is null, this means the iterator object was - -- constructed without a start expression, in which case the (reverse) - -- iteration starts from the (logical) beginning of the entire sequence - -- (corresponding to Container.Last, for a reverse iterator). - - -- Otherwise, this is iteration over a partial sequence of items. When - -- the Node component is non-null, the iterator object was constructed - -- with a start expression, that specifies the position from which the - -- (reverse) partial iteration begins. - - if Object.Node = 0 then - return Last (Object.Container.all); - else - return (Node => Object.Node); - end if; - end Last; - ------------------ -- Last_Element -- ------------------ @@ -1121,11 +918,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is "Source length exceeds Target capacity"; end if; - if Source.Busy > 0 then - raise Program_Error with - "attempt to tamper with cursors of Source (list is busy)"; - end if; - Clear (Target); while Source.Length > 1 loop @@ -1208,23 +1000,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is return (Node => Container.Nodes (Position.Node).Next); end Next; - function Next - (Object : Iterator; - Position : Cursor) return Cursor - is - begin - return Next (Object.Container.all, Position); - end Next; - - -------------------- - -- Not_No_Element -- - -------------------- - - function Not_No_Element (Position : Cursor) return Boolean is - begin - return Position /= No_Element; - end Not_No_Element; - ------------- -- Prepend -- ------------- @@ -1260,106 +1035,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is return (Node => Container.Nodes (Position.Node).Prev); end Previous; - function Previous - (Object : Iterator; - Position : Cursor) return Cursor - is - begin - return Previous (Object.Container.all, Position); - end Previous; - - ------------------- - -- Query_Element -- - ------------------- - - procedure Query_Element - (Container : List; Position : Cursor; - Process : not null access procedure (Element : Element_Type)) - is - C : List renames Container'Unrestricted_Access.all; - B : Natural renames C.Busy; - L : Natural renames C.Lock; - - begin - if not Has_Element (Container, Position) then - raise Constraint_Error with - "Position cursor has no element"; - end if; - - B := B + 1; - L := L + 1; - - declare - N : Node_Type renames C.Nodes (Position.Node); - begin - Process (N.Element); - exception - when others => - L := L - 1; - B := B - 1; - raise; - end; - - L := L - 1; - B := B - 1; - end Query_Element; - - ---------- - -- Read -- - ---------- - - procedure Read - (Stream : not null access Root_Stream_Type'Class; - Item : out List) - is - N : Count_Type'Base; - - begin - Clear (Item); - - Count_Type'Base'Read (Stream, N); - - if N < 0 then - raise Program_Error with "bad list length"; - end if; - - if N = 0 then - return; - end if; - - if N > Item.Capacity then - raise Constraint_Error with "length exceeds capacity"; - end if; - - for J in 1 .. N loop - Item.Append (Element_Type'Input (Stream)); -- ??? - end loop; - end Read; - - procedure Read - (Stream : not null access Root_Stream_Type'Class; - Item : out Cursor) - is - begin - raise Program_Error with "attempt to stream list cursor"; - end Read; - - --------------- - -- Reference -- - --------------- - - function Constant_Reference - (Container : List; - Position : Cursor) return Constant_Reference_Type - is - begin - if not Has_Element (Container, Position) then - raise Constraint_Error with "Position cursor has no element"; - end if; - - return (Element => Container.Nodes (Position.Node).Element'Access); - end Constant_Reference; - --------------------- -- Replace_Element -- --------------------- @@ -1374,11 +1049,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is raise Constraint_Error with "Position cursor has no element"; end if; - if Container.Lock > 0 then - raise Program_Error with - "attempt to tamper with cursors (list is locked)"; - end if; - pragma Assert (Vet (Container, Position), "bad cursor in Replace_Element"); @@ -1444,11 +1114,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is pragma Assert (N (Container.First).Prev = 0); pragma Assert (N (Container.Last).Next = 0); - if Container.Busy > 0 then - raise Program_Error with - "attempt to tamper with elements (list is busy)"; - end if; - Container.First := J; Container.Last := I; loop @@ -1503,39 +1168,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is return No_Element; end Reverse_Find; - --------------------- - -- Reverse_Iterate -- - --------------------- - - procedure Reverse_Iterate - (Container : List; - Process : - not null access procedure (Container : List; Position : Cursor)) - is - C : List renames Container'Unrestricted_Access.all; - B : Natural renames C.Busy; - - Node : Count_Type; - - begin - B := B + 1; - - begin - Node := Container.Last; - while Node /= 0 loop - Process (Container, (Node => Node)); - Node := Container.Nodes (Node).Prev; - end loop; - - exception - when others => - B := B - 1; - raise; - end; - - B := B - 1; - end Reverse_Iterate; - ----------- -- Right -- ----------- @@ -1597,16 +1229,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is raise Constraint_Error; end if; - if 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 - raise Program_Error with - "attempt to tamper with cursors of Source (list is busy)"; - end if; - loop Insert (Target, Before, SN (Source.Last).Element); Delete_Last (Source); @@ -1638,16 +1260,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is raise Constraint_Error; end if; - if 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 - raise Program_Error with - "attempt to tamper with cursors of Source (list is busy)"; - end if; - Insert (Container => Target, Before => Before, @@ -1686,11 +1298,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is pragma Assert (Container.Length >= 2); - if Container.Busy > 0 then - raise Program_Error with - "attempt to tamper with elements (list is busy)"; - end if; - if Before.Node = 0 then pragma Assert (Position.Node /= Container.Last); @@ -1800,11 +1407,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is return; end if; - if Container.Lock > 0 then - raise Program_Error with - "attempt to tamper with cursors (list is locked)"; - end if; - pragma Assert (Vet (Container, I), "bad I cursor in Swap"); pragma Assert (Vet (Container, J), "bad J cursor in Swap"); @@ -1844,11 +1446,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is return; end if; - if Container.Busy > 0 then - raise Program_Error with - "attempt to tamper with elements (list is busy)"; - end if; - pragma Assert (Vet (Container, I), "bad I cursor in Swap_Links"); pragma Assert (Vet (Container, J), "bad J cursor in Swap_Links"); @@ -1871,47 +1468,6 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is end if; end Swap_Links; - -------------------- - -- Update_Element -- - -------------------- - - procedure Update_Element - (Container : in out List; - Position : Cursor; - Process : not null access procedure (Element : in out Element_Type)) - is - begin - if Position.Node = 0 then - raise Constraint_Error with "Position cursor has no element"; - end if; - - pragma Assert - (Vet (Container, Position), "bad cursor in Update_Element"); - - declare - B : Natural renames Container.Busy; - L : Natural renames Container.Lock; - - begin - B := B + 1; - L := L + 1; - - declare - N : Node_Type renames Container.Nodes (Position.Node); - begin - Process (N.Element); - exception - when others => - L := L - 1; - B := B - 1; - raise; - end; - - L := L - 1; - B := B - 1; - end; - end Update_Element; - --------- -- Vet -- --------- @@ -2047,33 +1603,4 @@ package body Ada.Containers.Formal_Doubly_Linked_Lists is return True; end Vet; - ----------- - -- Write -- - ----------- - - procedure Write - (Stream : not null access Root_Stream_Type'Class; - Item : List) - is - N : Node_Array renames Item.Nodes; - Node : Count_Type; - - begin - Count_Type'Base'Write (Stream, Item.Length); - - Node := Item.First; - while Node /= 0 loop - Element_Type'Write (Stream, N (Node).Element); - Node := N (Node).Next; - end loop; - end Write; - - procedure Write - (Stream : not null access Root_Stream_Type'Class; - Item : Cursor) - is - begin - raise Program_Error with "attempt to stream list cursor"; - end Write; - end Ada.Containers.Formal_Doubly_Linked_Lists; diff --git a/gcc/ada/a-cfdlli.ads b/gcc/ada/a-cfdlli.ads index 58a67fa..994589f 100644 --- a/gcc/ada/a-cfdlli.ads +++ b/gcc/ada/a-cfdlli.ads @@ -51,9 +51,9 @@ -- See detailed specifications for these subprograms -private with Ada.Streams; -private with Ada.Finalization; -with Ada.Iterator_Interfaces; +-- private with Ada.Streams; +-- private with Ada.Finalization; +-- with Ada.Iterator_Interfaces; generic type Element_Type is private; @@ -64,11 +64,8 @@ generic package Ada.Containers.Formal_Doubly_Linked_Lists is pragma Pure; - type List (Capacity : Count_Type) is tagged private with - Constant_Indexing => Constant_Reference, - Default_Iterator => Iterate, - Iterator_Element => Element_Type; - -- pragma Preelaborable_Initialization (List); + type List (Capacity : Count_Type) is private; + pragma Preelaborable_Initialization (List); type Cursor is private; pragma Preelaborable_Initialization (Cursor); @@ -77,17 +74,6 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is No_Element : constant Cursor; - function Not_No_Element (Position : Cursor) return Boolean; - - package List_Iterator_Interfaces is new - Ada.Iterator_Interfaces (Cursor => Cursor, Has_Element => Not_No_Element); - - function Iterate (Container : List; Start : Cursor) - return List_Iterator_Interfaces.Reversible_Iterator'Class; - - function Iterate (Container : List) - return List_Iterator_Interfaces.Reversible_Iterator'Class; - function "=" (Left, Right : List) return Boolean; function Length (Container : List) return Count_Type; @@ -107,15 +93,6 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is Position : Cursor; New_Item : Element_Type); - procedure Query_Element - (Container : List; Position : Cursor; - Process : not null access procedure (Element : Element_Type)); - - procedure Update_Element - (Container : in out List; - Position : Cursor; - Process : not null access procedure (Element : in out Element_Type)); - procedure Move (Target : in out List; Source : in out List); procedure Insert @@ -218,16 +195,6 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is function Has_Element (Container : List; Position : Cursor) return Boolean; - procedure Iterate - (Container : List; - Process : - not null access procedure (Container : List; Position : Cursor)); - - procedure Reverse_Iterate - (Container : List; - Process : - not null access procedure (Container : List; Position : Cursor)); - generic with function "<" (Left, Right : Element_Type) return Boolean is <>; package Generic_Sorting is @@ -240,15 +207,6 @@ package Ada.Containers.Formal_Doubly_Linked_Lists is end Generic_Sorting; - type Constant_Reference_Type - (Element : not null access constant Element_Type) is private - with - Implicit_Dereference => Element; - - function Constant_Reference - (Container : List; -- SHOULD BE ALIASED ??? - Position : Cursor) return Constant_Reference_Type; - function Strict_Equal (Left, Right : List) return Boolean; -- Strict_Equal returns True if the containers are physically equal, i.e. -- they are structurally equal (function "=" returns True) and that they @@ -268,7 +226,7 @@ private type Node_Type is record Prev : Count_Type'Base := -1; Next : Count_Type; - Element : aliased Element_Type; + Element : Element_Type; end record; function "=" (L, R : Node_Type) return Boolean is abstract; @@ -279,73 +237,17 @@ private type List (Capacity : Count_Type) is tagged record Nodes : Node_Array (1 .. Capacity) := (others => <>); Free : Count_Type'Base := -1; - Busy : Natural := 0; - Lock : Natural := 0; Length : Count_Type := 0; First : Count_Type := 0; Last : Count_Type := 0; end record; - use Ada.Streams; - - procedure Read - (Stream : not null access Root_Stream_Type'Class; - Item : out List); - - for List'Read use Read; - - procedure Write - (Stream : not null access Root_Stream_Type'Class; - Item : List); - - for List'Write use Write; - - type List_Access is access all List; - for List_Access'Storage_Size use 0; - type Cursor is record Node : Count_Type := 0; end record; - type Constant_Reference_Type - (Element : not null access constant Element_Type) is null record; - - procedure Read - (Stream : not null access Root_Stream_Type'Class; - Item : out Cursor); - - for Cursor'Read use Read; - - procedure Write - (Stream : not null access Root_Stream_Type'Class; - Item : Cursor); - - for Cursor'Write use Write; - Empty_List : constant List := (0, others => <>); No_Element : constant Cursor := (Node => 0); - use Ada.Finalization; - - type Iterator is new Limited_Controlled and - List_Iterator_Interfaces.Reversible_Iterator with - record - Container : List_Access; - Node : Count_Type; - end record; - - overriding procedure Finalize (Object : in out Iterator); - - overriding function First (Object : Iterator) return Cursor; - overriding function Last (Object : Iterator) return Cursor; - - overriding function Next - (Object : Iterator; - Position : Cursor) return Cursor; - - overriding function Previous - (Object : Iterator; - Position : Cursor) return Cursor; - end Ada.Containers.Formal_Doubly_Linked_Lists; diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index 7f9f34d..8079e80 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -516,10 +516,6 @@ package body GNAT.Sockets is (Selector, R_Socket_Set, W_Socket_Set, E_Socket_Set, Status, Timeout); end Check_Selector; - -------------------- - -- Check_Selector -- - -------------------- - procedure Check_Selector (Selector : Selector_Type; R_Socket_Set : in out Socket_Set_Type; @@ -739,12 +735,17 @@ package body GNAT.Sockets is -- Wait for socket to become available for writing - Wait_On_Socket - (Socket => Socket, - For_Read => False, - Timeout => Timeout, - Selector => Selector, - Status => Status); + if Timeout = 0.0 then + Status := Expired; + + else + Wait_On_Socket + (Socket => Socket, + For_Read => False, + Timeout => Timeout, + Selector => Selector, + Status => Status); + end if; -- Check error condition (the asynchronous connect may have terminated -- with an error, e.g. ECONNREFUSED) if select(2) completed. diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads index 4625562..4761f3a 100644 --- a/gcc/ada/g-socket.ads +++ b/gcc/ada/g-socket.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2011, AdaCore -- +-- Copyright (C) 2001-2013, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -858,7 +858,9 @@ package GNAT.Sockets is -- whether the operation completed successfully, timed out, or was aborted. -- If Selector is not null, the designated selector is used to wait for the -- socket to become available, else a private selector object is created - -- by this procedure and destroyed before it returns. + -- by this procedure and destroyed before it returns. If Timeout is 0.0, + -- no attempt is made to detect whether the connection has succeeded; it + -- is up to the user to determine this using Check_Selector later on. procedure Control_Socket (Socket : Socket_Type; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index b446eea..efa9b4f 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -597,7 +597,7 @@ package Opt is Fast_Math : Boolean := False; -- GNAT -- Indicates the current setting of Fast_Math mode, as set by the use - -- of a Fast_Math pragma (set on by Fast_Math (On)). + -- of a Fast_Math pragma (set True by Fast_Math (On)). Float_Format : Character := ' '; -- GNAT @@ -1274,8 +1274,8 @@ package Opt is -- GNAT -- Set True if Style_Check was set for the main unit. This is used to -- renable style checks for units in the mail extended source that get - -- with'ed indirectly. It is set on by use of either the -gnatg or -gnaty - -- switches, but not by use of the Style_Checks pragma. + -- with'ed indirectly. It is set True by use of either the -gnatg or + -- -gnaty switches, but not by use of the Style_Checks pragma. Suppress_All_Inlining : Boolean := False; -- GNAT @@ -1411,7 +1411,7 @@ package Opt is -- Flag set to force attempt at semantic analysis, even if parser errors -- occur. This will probably cause blowups at this stage in the game. On -- the other hand, most such blowups will be caught cleanly and simply - -- say compilation abandoned. This flag is set on by -gnatq or -gnatQ. + -- say compilation abandoned. This flag is set True by -gnatq or -gnatQ. Unchecked_Shared_Lib_Imports : Boolean := False; -- GPRBUILD diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb index a9e04e8..32f0c90 100644 --- a/gcc/ada/s-fileio.adb +++ b/gcc/ada/s-fileio.adb @@ -696,12 +696,14 @@ package body System.File_IO is Klen := KImage'Length; To_Lower (KImage); - if Form (Index .. Index + Klen - 1) = KImage then + if Index + Klen - 1 <= Form'Last and then + Form (Index .. Index + Klen - 1) = KImage + then case Parm is when Force_Record_Mode => VMS_Form (Pos) := '"'; Pos := Pos + 1; - VMS_Form (Pos .. Pos + 7) := "ctx=rec"; + VMS_Form (Pos .. Pos + 6) := "ctx=rec"; Pos := Pos + 7; VMS_Form (Pos) := '"'; Pos := Pos + 1; @@ -711,7 +713,7 @@ package body System.File_IO is when Force_Stream_Mode => VMS_Form (Pos) := '"'; Pos := Pos + 1; - VMS_Form (Pos .. Pos + 7) := "ctx=stm"; + VMS_Form (Pos .. Pos + 6) := "ctx=stm"; Pos := Pos + 7; VMS_Form (Pos) := '"'; Pos := Pos + 1; diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads index 41297f4..545aadc 100644 --- a/gcc/ada/sem.ads +++ b/gcc/ada/sem.ads @@ -429,11 +429,11 @@ package Sem is -- compilation unit. These sections are separated by distinct occurrences -- of package Standard. The currently active section of the scope stack -- goes from the current scope to the first (innermost) occurrence of - -- Standard, which is additionally marked with the flag - -- Is_Active_Stack_Base. The basic visibility routine (Find_Direct_Name, in - -- Sem_Ch8) uses this contiguous section of the scope stack to determine - -- whether a given entity is or is not visible at a point. In_Open_Scopes - -- only examines the currently active section of the scope stack. + -- Standard, which is additionally marked with flag Is_Active_Stack_Base. + -- The basic visibility routine (Find_Direct_Name, in Sem_Ch8) uses this + -- contiguous section of the scope stack to determine whether a given + -- entity is or is not visible at a point. In_Open_Scopes only examines + -- the currently active section of the scope stack. -- Similar complications arise when processing child instances. These -- must be compiled in the context of parent instances, and therefore the @@ -464,7 +464,12 @@ package Sem is -- Save contents of Local_Suppress_Stack on entry to restore on exit Save_Check_Policy_List : Node_Id; - -- Save contents of Check_Policy_List on entry to restore on exit + -- Save contents of Check_Policy_List on entry to restore on exit. The + -- Check_Policy pragmas are chained with Check_Policy_List pointing to + -- the most recent entry. This list is searched starting here, so that + -- the search finds the most recent appicable entry. When we restore + -- Check_Policy_List on exit from the scope, the effect is to remove + -- all entries set in the scope being exited. Save_Default_Storage_Pool : Node_Id; -- Save contents of Default_Storage_Pool on entry to restore on exit diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 2257f47..e57d95f 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -12242,7 +12242,7 @@ package body Sem_Ch6 is while Present (Prag) loop if Nkind (Prag) = N_Pragma then - -- If pragma, capture if enabled postcondition, else ignore + -- If pragma, capture if postconditions enabled, else ignore if Pragma_Name (Prag) = Name_Postcondition and then Check_Enabled (Name_Postcondition) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 9616c6f..fd67596 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -7012,7 +7012,7 @@ package body Sem_Prag is return; end if; - Pack_Id := Defining_Unit_Name (Specification (Par)); + Pack_Id := Defining_Entity (Par); State := Expression (Arg1); -- Multiple abstract states appear as an aggregate diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 2d44751..281b6e8 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -645,7 +645,7 @@ package body Sem_Warn is end if; -- If an unconditional exit statement is the last statement in the - -- loop assume that no warning is needed. without any attempt at + -- loop, assume that no warning is needed, without any attempt at -- checking whether the exit is reachable. elsif Exit_Stmt = Last (Statements (Loop_Statement)) then |