+2010-06-22 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch4.adb (Analyze_Conditional_Expression): Defend against
+ malformed tree.
+ * sprint.adb (Sprint_Node_Actual, case N_Conditional_Expression): Ditto.
+
+2010-06-22 Arnaud Charlet <charlet@adacore.com>
+
+ * s-intman-vxworks.ads: Code clean up.
+
+2010-06-22 Thomas Quinot <quinot@adacore.com>
+
+ * sem_res.adb (Resolve_Slice): When the prefix is an explicit
+ dereference, construct actual subtype of designated object to generate
+ proper bounds checks.
+
+2010-06-22 Thomas Quinot <quinot@adacore.com>
+
+ * ali-util.adb, ali-util.ads, gnatbind.adb (Read_ALI): Rename to
+ Read_Withed_ALIs, which is more descriptive.
+
+2010-06-22 Pascal Obry <obry@adacore.com>
+
+ * g-sothco.ads: Minor reformatting.
+ * g-socthi-mingw.adb: Remove part of work on the C_Recvmsg and
+ C_Sendmsg implementation.
+ (C_Sendmsg): Do not use lock (not needed).
+ (C_Recvmsg): Likewise and also do not wait for incoming data.
+
2010-06-22 Ed Schonberg <schonberg@adacore.com>
* uintp.adb: Fix scope error in operator call.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
null;
end Post_Scan;
- --------------
- -- Read_ALI --
- --------------
+ ----------------------
+ -- Read_Withed_ALIs --
+ ----------------------
- procedure Read_ALI (Id : ALI_Id) is
+ procedure Read_Withed_ALIs (Id : ALI_Id) is
Afile : File_Name_Type;
Text : Text_Buffer_Ptr;
Idread : ALI_Id;
else
-- Otherwise, recurse to get new dependents
- Read_ALI (Idread);
+ Read_Withed_ALIs (Idread);
end if;
-- If the ALI file has already been processed and is an interface,
end if;
end loop;
end loop;
- end Read_ALI;
+ end Read_Withed_ALIs;
----------------------
-- Set_Source_Table --
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- Source File Table --
-----------------------
- -- A source file table entry is built for every source file that is
- -- in the source dependency table of any of the ALI files that make
- -- up the current program.
+ -- A source file table entry is built for every source file that is in the
+ -- source dependency table of any of the ALI files that make up the current
+ -- program.
No_Source_Id : constant Source_Id := Source_Id'First;
-- Special value indicating no Source table entry
-- Subprograms for Manipulating ALI Information --
--------------------------------------------------
- procedure Read_ALI (Id : ALI_Id);
- -- Process an ALI file which has been read and scanned by looping
- -- through all withed units in the ALI file, checking if they have
- -- been processed. Each unit that has not yet been processed will
- -- be read, scanned, and processed recursively.
+ procedure Read_Withed_ALIs (Id : ALI_Id);
+ -- Process an ALI file which has been read and scanned by looping through
+ -- all withed units in the ALI file, checking if they have been processed.
+ -- Each unit that has not yet been processed will be read, scanned, and
+ -- processed recursively.
procedure Set_Source_Table (A : ALI_Id);
-- Build source table entry corresponding to the ALI file whose id is A
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2010, 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- --
with System; use System;
with System.Storage_Elements; use System.Storage_Elements;
-with GNAT.Task_Lock;
-
package body GNAT.Sockets.Thin is
use type C.unsigned;
is
use type C.size_t;
- Res : C.int;
- Count : C.int := 0;
- Locked : Boolean := False;
- -- Set to false when the lock is activated
+ Res : C.int;
+ Count : C.int := 0;
MH : Msghdr;
for MH'Address use Msg;
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.
-
- -- 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;
+ -- available starting with Windows Vista and Server 2008 only. So,
+ -- we use C_Recv instead.
-- Check how much data are available
Flags);
if Res < 0 then
- Task_Lock.Unlock;
return System.CRTL.ssize_t (Res);
elsif Res = 0 then
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.
+ -- If all the data that was initially available read, do not
+ -- attempt to receive more, since this might block, or merge data
+ -- from successive datagrams for 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;
--------------
Last : aliased C.int;
begin
- -- Asynchronous connection failures are notified in the exception fd set
- -- instead of the write fd set. To ensure POSIX compatibility, copy
+ -- Asynchronous connection failures are notified in the exception fd
+ -- set instead of the write fd set. To ensure POSIX compatibility, copy
-- write fd set into exception fd set. Once select() returns, check any
-- socket present in the exception fd set and peek at incoming
-- out-of-band data. If the test is not successful, and the socket is
begin
-- Windows does not provide an implementation of sendmsg(). The spec for
-- WSASendMsg() is incompatible with the data types we define, and is
- -- not available in all versions of Windows. So, we'll use C_Sendto
- -- instead.
-
- Task_Lock.Lock;
+ -- available starting with Windows Vista and Server 2008 only. So
+ -- use C_Sendto instead.
for J in Iovec'Range loop
-
Res :=
C_Sendto
(S,
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;
--------------
package body Host_Error_Messages is
-- On Windows, socket and host errors share the same code space, and
- -- error messages are provided by Socket_Error_Message. The default
- -- separate body for Host_Error_Messages is therefore not used in
- -- this case.
+ -- error messages are provided by Socket_Error_Message, so the default
+ -- separate body for Host_Error_Messages is not used in this case.
function Host_Error_Message
(H_Errno : Integer) return C.Strings.chars_ptr
- renames Socket_Error_Message;
+ renames Socket_Error_Message;
end Host_Error_Messages;
-- --
-- S p e c --
-- --
--- Copyright (C) 2008-2009, AdaCore --
+-- Copyright (C) 2008-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- --
H_Errnop : not null access C.int) return C.int;
function C_Getservbyname
- (Name : C.char_array;
- Proto : C.char_array;
- Ret : not null access Servent;
- Buf : System.Address;
- Buflen : C.int) return C.int;
+ (Name : C.char_array;
+ Proto : C.char_array;
+ Ret : not null access Servent;
+ Buf : System.Address;
+ Buflen : C.int) return C.int;
function C_Getservbyport
- (Port : C.int;
- Proto : C.char_array;
- Ret : not null access Servent;
- Buf : System.Address;
- Buflen : C.int) return C.int;
+ (Port : C.int;
+ Proto : C.char_array;
+ Ret : not null access Servent;
+ Buf : System.Address;
+ Buflen : C.int) return C.int;
------------------------------------
-- Scatter/gather vector handling --
-- Acquire all information in ALI files that have been read in
for Index in ALIs.First .. ALIs.Last loop
- Read_ALI (Index);
+ Read_Withed_ALIs (Index);
end loop;
-- Quit if some file needs compiling
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
type Interrupt_Set is array (Interrupt_ID) of Boolean;
- subtype Signal_ID is Interrupt_ID
- range 0 .. Interfaces.C."-" (System.OS_Interface.NSIG, 1);
+ subtype Signal_ID is Interrupt_ID range 0 .. System.OS_Interface.NSIG - 1;
type Signal_Set is array (Signal_ID) of Boolean;
-- convention that ID zero is not used for any "real" signals, and SIGRARE
-- = 0 when SIGRARE is not one of the locally supported signals, we can
-- write:
- -- Reserved (SIGRARE) := true;
+ -- Reserved (SIGRARE) := True;
-- and the initialization code will be portable.
Abort_Task_Interrupt : Signal_ID;
procedure Analyze_Conditional_Expression (N : Node_Id) is
Condition : constant Node_Id := First (Expressions (N));
Then_Expr : constant Node_Id := Next (Condition);
- Else_Expr : constant Node_Id := Next (Then_Expr);
+ Else_Expr : Node_Id;
begin
+ -- Defend against error of missing expressions from previous error
+
+ if No (Then_Expr) then
+ return;
+ end if;
+
+ Else_Expr := Next (Then_Expr);
+
if Comes_From_Source (N) then
Check_Compiler_Unit (N);
end if;
end if;
elsif Is_Entity_Name (Name)
+ or else Nkind (Name) = N_Explicit_Dereference
or else (Nkind (Name) = N_Function_Call
and then not Is_Constrained (Etype (Name)))
then
declare
Condition : constant Node_Id := First (Expressions (Node));
Then_Expr : constant Node_Id := Next (Condition);
- Else_Expr : constant Node_Id := Next (Then_Expr);
+
begin
Write_Str_With_Col_Check_Sloc ("(if ");
Sprint_Node (Condition);
Write_Str_With_Col_Check (" then ");
- Sprint_Node (Then_Expr);
- Write_Str_With_Col_Check (" else ");
- Sprint_Node (Else_Expr);
+
+ -- Defense against junk here!
+
+ if Present (Then_Expr) then
+ Sprint_Node (Then_Expr);
+ Write_Str_With_Col_Check (" else ");
+ Sprint_Node (Next (Then_Expr));
+ end if;
+
Write_Char (')');
end;