diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 23 | ||||
| -rw-r--r-- | gcc/ada/g-socthi-mingw.adb | 112 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 9 |
7 files changed, 173 insertions, 26 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f8f8317b19a..8408a559241 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,28 @@ 2010-06-22 Robert Dewar <dewar@adacore.com> + * sem_aggr.adb (Resolve_Record_Aggregate): Do style check on component + name. + * sem_ch10.adb (Analyze_Subunit): Do style check on parent unit name. + * sem_ch8.adb (Find_Direct_Name): For non-overloadable entities, do + style check. + * sem_res.adb (Resolve_Entity_Name): Do style check for enumeration + literals. + +2010-06-22 Vincent Celier <celier@adacore.com> + + * make.adb (Scan_Make_Arg): No longer pass -nostdlib to the compiler as + it has no effect. Always pass -nostdlib to gnatlink, even on VMS. + +2010-06-22 Pascal Obry <obry@adacore.com> + + * g-socthi-mingw.adb: Fix implementation of the vectored sockets on + Windows. + (C_Recvmsg): Make sure the routine is atomic. Also fully + fill vectors in the proper order. + (C_Sendmsg): Make sure the routine is atomic. + +2010-06-22 Robert Dewar <dewar@adacore.com> + * sem_ch8.adb: Update comment. * sem_res.adb: Minor code reorganization (use Ekind_In). diff --git a/gcc/ada/g-socthi-mingw.adb b/gcc/ada/g-socthi-mingw.adb index 23bab2c9a74..6cf0058e96c 100644 --- a/gcc/ada/g-socthi-mingw.adb +++ b/gcc/ada/g-socthi-mingw.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2009, AdaCore -- +-- Copyright (C) 2001-2010, 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- -- @@ -37,8 +37,13 @@ -- This version is for NT -with Interfaces.C.Strings; use Interfaces.C.Strings; -with System; use System; +with Ada.Streams; use Ada.Streams; +with Ada.Unchecked_Conversion; +with Interfaces.C.Strings; use Interfaces.C.Strings; +with System; use System; +with System.Storage_Elements; use System.Storage_Elements; + +with GNAT.Task_Lock; package body GNAT.Sockets.Thin is @@ -273,8 +278,10 @@ package body GNAT.Sockets.Thin is is use type C.size_t; - Res : C.int; - Count : C.int := 0; + Res : C.int; + Count : C.int := 0; + Locked : Boolean := False; + -- Set to false when the lock is activated MH : Msghdr; for MH'Address use Msg; @@ -283,26 +290,105 @@ package body GNAT.Sockets.Thin is for Iovec'Address use MH.Msg_Iov; pragma Import (Ada, Iovec); + Iov_Index : Integer; + Current_Iovec : Vector_Element; + + function To_Access is new Ada.Unchecked_Conversion + (System.Address, Stream_Element_Reference); + pragma Warnings (Off, Stream_Element_Reference); + + Req : Request_Type (Name => N_Bytes_To_Read); + begin -- Windows does not provide an implementation of recvmsg(). The spec for -- WSARecvMsg() is incompatible with the data types we define, and is -- not available in all versions of Windows. So, we use C_Recv instead. - for J in Iovec'Range loop + -- First, wait for some data to be available if socket is blocking + + declare + Selector : Selector_Type; + R_Socket_Set : Socket_Set_Type; + W_Socket_Set : Socket_Set_Type; + Status : Selector_Status; + Req : Request_Type (Name => Non_Blocking_IO); + begin + Control_Socket (Socket_Type (S), Req); + + if not Req.Enabled then + -- We are in a blocking IO mode + Create_Selector (Selector); + + Set (R_Socket_Set, Socket_Type (S)); + + Check_Selector (Selector, R_Socket_Set, W_Socket_Set, Status); + + Close_Selector (Selector); + end if; + end; + + GNAT.Task_Lock.Lock; + Locked := True; + + -- Check how much data are available + + Control_Socket (Socket_Type (S), Req); + + -- Fill the vectors + + Iov_Index := -1; + Current_Iovec := (Base => null, Length => 0); + + loop + if Current_Iovec.Length = 0 then + Iov_Index := Iov_Index + 1; + exit when Iov_Index > Integer (Iovec'Last); + Current_Iovec := Iovec (SOSC.Msg_Iovlen_T (Iov_Index)); + end if; + Res := C_Recv (S, - Iovec (J).Base.all'Address, - C.int (Iovec (J).Length), + Current_Iovec.Base.all'Address, + C.int (Current_Iovec.Length), Flags); if Res < 0 then + Task_Lock.Unlock; return System.CRTL.ssize_t (Res); + + elsif Res = 0 then + exit; + else + pragma Assert (Stream_Element_Count (Res) <= Current_Iovec.Length); + Count := Count + Res; + Current_Iovec.Length := + Current_Iovec.Length - Stream_Element_Count (Res); + Current_Iovec.Base := + To_Access (Current_Iovec.Base.all'Address + + Storage_Offset (Res)); + + -- If we have read all the data that was initially available, + -- do not attempt to receive more, since this might block, or + -- merge data from successive datagrams in case of a datagram- + -- oriented socket. + + exit when Natural (Count) >= Req.Size; end if; end loop; + + Task_Lock.Unlock; + return System.CRTL.ssize_t (Count); + + exception + when others => + if Locked then + Task_Lock.Unlock; + end if; + raise; end C_Recvmsg; -------------- @@ -428,7 +514,10 @@ package body GNAT.Sockets.Thin is -- not available in all versions of Windows. So, we'll use C_Sendto -- instead. + Task_Lock.Lock; + for J in Iovec'Range loop + Res := C_Sendto (S, @@ -439,13 +528,20 @@ package body GNAT.Sockets.Thin is Tolen => C.int (MH.Msg_Namelen)); if Res < 0 then + Task_Lock.Unlock; return System.CRTL.ssize_t (Res); else Count := Count + Res; end if; end loop; + Task_Lock.Unlock; + return System.CRTL.ssize_t (Count); + exception + when others => + Task_Lock.Unlock; + raise; end C_Sendmsg; -------------- diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index eb18485c77b..8251052258b 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -8213,17 +8213,11 @@ package body Make is elsif Argv (2 .. Argv'Last) = "nostdlib" then - No_Stdlib := True; + -- Pass -nstdlib to gnatbind and gnatlink - Add_Switch (Argv, Compiler, And_Save => And_Save); + No_Stdlib := True; Add_Switch (Argv, Binder, And_Save => And_Save); - - -- On Open VMS, do not pass -nostdlib to gnatlink, it will disable - -- linking with all standard library files. - - if not OpenVMS then - Add_Switch (Argv, Linker, And_Save => And_Save); - end if; + Add_Switch (Argv, Linker, And_Save => And_Save); elsif Argv (2 .. Argv'Last) = "nostdinc" then diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index d487c442599..5ce3ea6e83a 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -54,6 +54,7 @@ with Sinfo; use Sinfo; with Snames; use Snames; with Stringt; use Stringt; with Stand; use Stand; +with Style; use Style; with Targparm; use Targparm; with Tbuild; use Tbuild; with Uintp; use Uintp; @@ -3779,7 +3780,15 @@ package body Sem_Aggr is New_Assoc := First (New_Assoc_List); while Present (New_Assoc) loop Component := First (Choices (New_Assoc)); - exit when Chars (Selectr) = Chars (Component); + + if Chars (Selectr) = Chars (Component) then + if Style_Check then + Check_Identifier (Selectr, Entity (Component)); + end if; + + exit; + end if; + Next (New_Assoc); end loop; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 8d0fa4739a4..1ce76e89c25 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -2140,6 +2140,19 @@ package body Sem_Ch10 is -- Start of processing for Analyze_Subunit begin + if Style_Check then + declare + Nam : Node_Id := Name (Unit (N)); + + begin + if Nkind (Nam) = N_Selected_Component then + Nam := Selector_Name (Nam); + end if; + + Check_Identifier (Nam, Par_Unit); + end; + end if; + if not Is_Empty_List (Context_Items (N)) then -- Save current use clauses diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 51ae114d4e1..3f1ea3bc56b 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -4377,13 +4377,18 @@ package body Sem_Ch8 is return; end if; - -- Set the entity. Note that the reason we call Set_Entity here, as - -- opposed to Set_Entity_With_Style_Check is that in the overloaded - -- case, the initial call can set the wrong homonym. The call that - -- sets the right homonym is in Sem_Res and that call does use - -- Set_Entity_With_Style_Check, so we don't miss a style check. - - Set_Entity (N, E); + -- Set the entity. Note that the reason we call Set_Entity for the + -- overloadable case, as opposed to Set_Entity_With_Style_Check is + -- that in the overloaded case, the initial call can set the wrong + -- homonym. The call that sets the right homonym is in Sem_Res and + -- that call does use Set_Entity_With_Style_Check, so we don't miss + -- a style check. + + if Is_Overloadable (E) then + Set_Entity (N, E); + else + Set_Entity_With_Style_Check (N, E); + end if; if Is_Type (E) then Set_Etype (N, E); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 5f7666adffb..ca2059dba5c 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -5793,6 +5793,14 @@ package body Sem_Res is Set_Etype (N, Typ); Eval_Named_Real (N); + -- For enumeration literals, we need to make sure that a proper style + -- check is done, since such literals are overloaded, and thus we did + -- not do a style check during the first phase of analysis. + + elsif Ekind (E) = E_Enumeration_Literal then + Set_Entity_With_Style_Check (N, E); + Eval_Entity_Name (N); + -- Allow use of subtype only if it is a concurrent type where we are -- currently inside the body. This will eventually be expanded into a -- call to Self (for tasks) or _object (for protected objects). Any @@ -5847,7 +5855,6 @@ package body Sem_Res is and then not In_Spec_Expression and then not Is_Imported (E) then - if No_Initialization (Parent (E)) or else (Present (Full_View (E)) and then No_Initialization (Parent (Full_View (E)))) |