Skip to content

R
riscv-gcc-1
Commit 6c994759 by Arnaud Charlet
Options

[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
Showing with 95 additions and 103 deletions
gcc/ada/ChangeLog
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.
......
gcc/ada/ali-util.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -220,11 +220,11 @@ package body ALI.Util is
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;
......@@ -298,7 +298,7 @@ package body ALI.Util is
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,
......@@ -309,7 +309,7 @@ package body ALI.Util is
end if;
end loop;
end loop;
end Read_ALI;
end Read_Withed_ALIs;
----------------------
-- Set_Source_Table --
......
gcc/ada/ali-util.ads
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -32,9 +32,9 @@ package ALI.Util is
-- 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
......@@ -101,11 +101,11 @@ package ALI.Util is
-- 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
......
gcc/ada/g-socthi-mingw.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -43,8 +43,6 @@ 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
use type C.unsigned;
......@@ -278,10 +276,8 @@ package body GNAT.Sockets.Thin is
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;
......@@ -302,33 +298,8 @@ package body GNAT.Sockets.Thin is
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
......@@ -354,7 +325,6 @@ package body GNAT.Sockets.Thin is
Flags);
if Res < 0 then
Task_Lock.Unlock;
return System.CRTL.ssize_t (Res);
elsif Res = 0 then
......@@ -370,25 +340,15 @@ package body GNAT.Sockets.Thin is
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;
--------------
......@@ -411,8 +371,8 @@ package body GNAT.Sockets.Thin is
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
......@@ -511,13 +471,10 @@ package body GNAT.Sockets.Thin 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,
......@@ -528,20 +485,13 @@ 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;
--------------
......@@ -563,13 +513,12 @@ package body GNAT.Sockets.Thin is
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;
......
gcc/ada/g-sothco.ads
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -294,18 +294,18 @@ package GNAT.Sockets.Thin_Common is
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 --
......
gcc/ada/gnatbind.adb
......@@ -741,7 +741,7 @@ begin
-- 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
......
gcc/ada/s-intman-vxworks.ads
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -59,8 +59,7 @@ package System.Interrupt_Management is
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;
......@@ -74,7 +73,7 @@ package System.Interrupt_Management is
-- 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;
......
gcc/ada/sem_ch4.adb
......@@ -1385,9 +1385,17 @@ package body Sem_Ch4 is
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;
......
gcc/ada/sem_res.adb
......@@ -8105,6 +8105,7 @@ package body Sem_Res is
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
......
gcc/ada/sprint.adb
......@@ -1251,14 +1251,20 @@ package body Sprint is
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;
......
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