Commit 6c994759 by Arnaud Charlet

[multiple changes]

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.

From-SVN: r161148
parent 88b17d45
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> 2010-06-22 Ed Schonberg <schonberg@adacore.com>
* uintp.adb: Fix scope error in operator call. * uintp.adb: Fix scope error in operator call.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -220,11 +220,11 @@ package body ALI.Util is ...@@ -220,11 +220,11 @@ package body ALI.Util is
null; null;
end Post_Scan; 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; Afile : File_Name_Type;
Text : Text_Buffer_Ptr; Text : Text_Buffer_Ptr;
Idread : ALI_Id; Idread : ALI_Id;
...@@ -298,7 +298,7 @@ package body ALI.Util is ...@@ -298,7 +298,7 @@ package body ALI.Util is
else else
-- Otherwise, recurse to get new dependents -- Otherwise, recurse to get new dependents
Read_ALI (Idread); Read_Withed_ALIs (Idread);
end if; end if;
-- If the ALI file has already been processed and is an interface, -- If the ALI file has already been processed and is an interface,
...@@ -309,7 +309,7 @@ package body ALI.Util is ...@@ -309,7 +309,7 @@ package body ALI.Util is
end if; end if;
end loop; end loop;
end loop; end loop;
end Read_ALI; end Read_Withed_ALIs;
---------------------- ----------------------
-- Set_Source_Table -- -- Set_Source_Table --
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -32,9 +32,9 @@ package ALI.Util is ...@@ -32,9 +32,9 @@ package ALI.Util is
-- Source File Table -- -- Source File Table --
----------------------- -----------------------
-- A source file table entry is built for every source file that is -- A source file table entry is built for every source file that is in the
-- in the source dependency table of any of the ALI files that make -- source dependency table of any of the ALI files that make up the current
-- up the current program. -- program.
No_Source_Id : constant Source_Id := Source_Id'First; No_Source_Id : constant Source_Id := Source_Id'First;
-- Special value indicating no Source table entry -- Special value indicating no Source table entry
...@@ -101,11 +101,11 @@ package ALI.Util is ...@@ -101,11 +101,11 @@ package ALI.Util is
-- Subprograms for Manipulating ALI Information -- -- Subprograms for Manipulating ALI Information --
-------------------------------------------------- --------------------------------------------------
procedure Read_ALI (Id : ALI_Id); procedure Read_Withed_ALIs (Id : ALI_Id);
-- Process an ALI file which has been read and scanned by looping -- Process an ALI file which has been read and scanned by looping through
-- through all withed units in the ALI file, checking if they have -- all withed units in the ALI file, checking if they have been processed.
-- been processed. Each unit that has not yet been processed will -- Each unit that has not yet been processed will be read, scanned, and
-- be read, scanned, and processed recursively. -- processed recursively.
procedure Set_Source_Table (A : ALI_Id); procedure Set_Source_Table (A : ALI_Id);
-- Build source table entry corresponding to the ALI file whose id is A -- Build source table entry corresponding to the ALI file whose id is A
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -43,8 +43,6 @@ with Interfaces.C.Strings; use Interfaces.C.Strings; ...@@ -43,8 +43,6 @@ with Interfaces.C.Strings; use Interfaces.C.Strings;
with System; use System; with System; use System;
with System.Storage_Elements; use System.Storage_Elements; with System.Storage_Elements; use System.Storage_Elements;
with GNAT.Task_Lock;
package body GNAT.Sockets.Thin is package body GNAT.Sockets.Thin is
use type C.unsigned; use type C.unsigned;
...@@ -278,10 +276,8 @@ package body GNAT.Sockets.Thin is ...@@ -278,10 +276,8 @@ package body GNAT.Sockets.Thin is
is is
use type C.size_t; use type C.size_t;
Res : C.int; Res : C.int;
Count : C.int := 0; Count : C.int := 0;
Locked : Boolean := False;
-- Set to false when the lock is activated
MH : Msghdr; MH : Msghdr;
for MH'Address use Msg; for MH'Address use Msg;
...@@ -302,33 +298,8 @@ package body GNAT.Sockets.Thin is ...@@ -302,33 +298,8 @@ package body GNAT.Sockets.Thin is
begin begin
-- Windows does not provide an implementation of recvmsg(). The spec for -- Windows does not provide an implementation of recvmsg(). The spec for
-- WSARecvMsg() is incompatible with the data types we define, and is -- WSARecvMsg() is incompatible with the data types we define, and is
-- not available in all versions of Windows. So, we use C_Recv instead. -- available starting with Windows Vista and Server 2008 only. 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;
-- Check how much data are available -- Check how much data are available
...@@ -354,7 +325,6 @@ package body GNAT.Sockets.Thin is ...@@ -354,7 +325,6 @@ package body GNAT.Sockets.Thin is
Flags); Flags);
if Res < 0 then if Res < 0 then
Task_Lock.Unlock;
return System.CRTL.ssize_t (Res); return System.CRTL.ssize_t (Res);
elsif Res = 0 then elsif Res = 0 then
...@@ -370,25 +340,15 @@ package body GNAT.Sockets.Thin is ...@@ -370,25 +340,15 @@ package body GNAT.Sockets.Thin is
To_Access (Current_Iovec.Base.all'Address To_Access (Current_Iovec.Base.all'Address
+ Storage_Offset (Res)); + Storage_Offset (Res));
-- If we have read all the data that was initially available, -- If all the data that was initially available read, do not
-- do not attempt to receive more, since this might block, or -- attempt to receive more, since this might block, or merge data
-- merge data from successive datagrams in case of a datagram- -- from successive datagrams for a datagram-oriented socket.
-- oriented socket.
exit when Natural (Count) >= Req.Size; exit when Natural (Count) >= Req.Size;
end if; end if;
end loop; end loop;
Task_Lock.Unlock;
return System.CRTL.ssize_t (Count); return System.CRTL.ssize_t (Count);
exception
when others =>
if Locked then
Task_Lock.Unlock;
end if;
raise;
end C_Recvmsg; end C_Recvmsg;
-------------- --------------
...@@ -411,8 +371,8 @@ package body GNAT.Sockets.Thin is ...@@ -411,8 +371,8 @@ package body GNAT.Sockets.Thin is
Last : aliased C.int; Last : aliased C.int;
begin begin
-- Asynchronous connection failures are notified in the exception fd set -- Asynchronous connection failures are notified in the exception fd
-- instead of the write fd set. To ensure POSIX compatibility, copy -- set instead of the write fd set. To ensure POSIX compatibility, copy
-- write fd set into exception fd set. Once select() returns, check any -- write fd set into exception fd set. Once select() returns, check any
-- socket present in the exception fd set and peek at incoming -- 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 -- out-of-band data. If the test is not successful, and the socket is
...@@ -511,13 +471,10 @@ package body GNAT.Sockets.Thin is ...@@ -511,13 +471,10 @@ package body GNAT.Sockets.Thin is
begin begin
-- Windows does not provide an implementation of sendmsg(). The spec for -- Windows does not provide an implementation of sendmsg(). The spec for
-- WSASendMsg() is incompatible with the data types we define, and is -- WSASendMsg() is incompatible with the data types we define, and is
-- not available in all versions of Windows. So, we'll use C_Sendto -- available starting with Windows Vista and Server 2008 only. So
-- instead. -- use C_Sendto instead.
Task_Lock.Lock;
for J in Iovec'Range loop for J in Iovec'Range loop
Res := Res :=
C_Sendto C_Sendto
(S, (S,
...@@ -528,20 +485,13 @@ package body GNAT.Sockets.Thin is ...@@ -528,20 +485,13 @@ package body GNAT.Sockets.Thin is
Tolen => C.int (MH.Msg_Namelen)); Tolen => C.int (MH.Msg_Namelen));
if Res < 0 then if Res < 0 then
Task_Lock.Unlock;
return System.CRTL.ssize_t (Res); return System.CRTL.ssize_t (Res);
else else
Count := Count + Res; Count := Count + Res;
end if; end if;
end loop; end loop;
Task_Lock.Unlock;
return System.CRTL.ssize_t (Count); return System.CRTL.ssize_t (Count);
exception
when others =>
Task_Lock.Unlock;
raise;
end C_Sendmsg; end C_Sendmsg;
-------------- --------------
...@@ -563,13 +513,12 @@ package body GNAT.Sockets.Thin is ...@@ -563,13 +513,12 @@ package body GNAT.Sockets.Thin is
package body Host_Error_Messages is package body Host_Error_Messages is
-- On Windows, socket and host errors share the same code space, and -- On Windows, socket and host errors share the same code space, and
-- error messages are provided by Socket_Error_Message. The default -- error messages are provided by Socket_Error_Message, so the default
-- separate body for Host_Error_Messages is therefore not used in -- separate body for Host_Error_Messages is not used in this case.
-- this case.
function Host_Error_Message function Host_Error_Message
(H_Errno : Integer) return C.Strings.chars_ptr (H_Errno : Integer) return C.Strings.chars_ptr
renames Socket_Error_Message; renames Socket_Error_Message;
end Host_Error_Messages; end Host_Error_Messages;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -294,18 +294,18 @@ package GNAT.Sockets.Thin_Common is ...@@ -294,18 +294,18 @@ package GNAT.Sockets.Thin_Common is
H_Errnop : not null access C.int) return C.int; H_Errnop : not null access C.int) return C.int;
function C_Getservbyname function C_Getservbyname
(Name : C.char_array; (Name : C.char_array;
Proto : C.char_array; Proto : C.char_array;
Ret : not null access Servent; Ret : not null access Servent;
Buf : System.Address; Buf : System.Address;
Buflen : C.int) return C.int; Buflen : C.int) return C.int;
function C_Getservbyport function C_Getservbyport
(Port : C.int; (Port : C.int;
Proto : C.char_array; Proto : C.char_array;
Ret : not null access Servent; Ret : not null access Servent;
Buf : System.Address; Buf : System.Address;
Buflen : C.int) return C.int; Buflen : C.int) return C.int;
------------------------------------ ------------------------------------
-- Scatter/gather vector handling -- -- Scatter/gather vector handling --
......
...@@ -741,7 +741,7 @@ begin ...@@ -741,7 +741,7 @@ begin
-- Acquire all information in ALI files that have been read in -- Acquire all information in ALI files that have been read in
for Index in ALIs.First .. ALIs.Last loop for Index in ALIs.First .. ALIs.Last loop
Read_ALI (Index); Read_Withed_ALIs (Index);
end loop; end loop;
-- Quit if some file needs compiling -- Quit if some file needs compiling
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -59,8 +59,7 @@ package System.Interrupt_Management is ...@@ -59,8 +59,7 @@ package System.Interrupt_Management is
type Interrupt_Set is array (Interrupt_ID) of Boolean; type Interrupt_Set is array (Interrupt_ID) of Boolean;
subtype Signal_ID is Interrupt_ID subtype Signal_ID is Interrupt_ID range 0 .. System.OS_Interface.NSIG - 1;
range 0 .. Interfaces.C."-" (System.OS_Interface.NSIG, 1);
type Signal_Set is array (Signal_ID) of Boolean; type Signal_Set is array (Signal_ID) of Boolean;
...@@ -74,7 +73,7 @@ package System.Interrupt_Management is ...@@ -74,7 +73,7 @@ package System.Interrupt_Management is
-- convention that ID zero is not used for any "real" signals, and SIGRARE -- 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 -- = 0 when SIGRARE is not one of the locally supported signals, we can
-- write: -- write:
-- Reserved (SIGRARE) := true; -- Reserved (SIGRARE) := True;
-- and the initialization code will be portable. -- and the initialization code will be portable.
Abort_Task_Interrupt : Signal_ID; Abort_Task_Interrupt : Signal_ID;
......
...@@ -1385,9 +1385,17 @@ package body Sem_Ch4 is ...@@ -1385,9 +1385,17 @@ package body Sem_Ch4 is
procedure Analyze_Conditional_Expression (N : Node_Id) is procedure Analyze_Conditional_Expression (N : Node_Id) is
Condition : constant Node_Id := First (Expressions (N)); Condition : constant Node_Id := First (Expressions (N));
Then_Expr : constant Node_Id := Next (Condition); Then_Expr : constant Node_Id := Next (Condition);
Else_Expr : constant Node_Id := Next (Then_Expr); Else_Expr : Node_Id;
begin 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 if Comes_From_Source (N) then
Check_Compiler_Unit (N); Check_Compiler_Unit (N);
end if; end if;
......
...@@ -8105,6 +8105,7 @@ package body Sem_Res is ...@@ -8105,6 +8105,7 @@ package body Sem_Res is
end if; end if;
elsif Is_Entity_Name (Name) elsif Is_Entity_Name (Name)
or else Nkind (Name) = N_Explicit_Dereference
or else (Nkind (Name) = N_Function_Call or else (Nkind (Name) = N_Function_Call
and then not Is_Constrained (Etype (Name))) and then not Is_Constrained (Etype (Name)))
then then
......
...@@ -1251,14 +1251,20 @@ package body Sprint is ...@@ -1251,14 +1251,20 @@ package body Sprint is
declare declare
Condition : constant Node_Id := First (Expressions (Node)); Condition : constant Node_Id := First (Expressions (Node));
Then_Expr : constant Node_Id := Next (Condition); Then_Expr : constant Node_Id := Next (Condition);
Else_Expr : constant Node_Id := Next (Then_Expr);
begin begin
Write_Str_With_Col_Check_Sloc ("(if "); Write_Str_With_Col_Check_Sloc ("(if ");
Sprint_Node (Condition); Sprint_Node (Condition);
Write_Str_With_Col_Check (" then "); Write_Str_With_Col_Check (" then ");
Sprint_Node (Then_Expr);
Write_Str_With_Col_Check (" else "); -- Defense against junk here!
Sprint_Node (Else_Expr);
if Present (Then_Expr) then
Sprint_Node (Then_Expr);
Write_Str_With_Col_Check (" else ");
Sprint_Node (Next (Then_Expr));
end if;
Write_Char (')'); Write_Char (')');
end; end;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment