From 6c994759f3581d979a57ce31cfab10cd5329bb44 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 22 Jun 2010 10:49:11 +0200 Subject: [multiple changes] 2010-06-22 Robert Dewar * 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 * s-intman-vxworks.ads: Code clean up. 2010-06-22 Thomas Quinot * 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 * ali-util.adb, ali-util.ads, gnatbind.adb (Read_ALI): Rename to Read_Withed_ALIs, which is more descriptive. 2010-06-22 Pascal Obry * 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 --- gcc/ada/ChangeLog | 29 ++++++++++++++++ gcc/ada/ali-util.adb | 14 ++++---- gcc/ada/ali-util.ads | 18 +++++----- gcc/ada/g-socthi-mingw.adb | 81 ++++++++------------------------------------ gcc/ada/g-sothco.ads | 22 ++++++------ gcc/ada/gnatbind.adb | 2 +- gcc/ada/s-intman-vxworks.ads | 7 ++-- gcc/ada/sem_ch4.adb | 10 +++++- gcc/ada/sem_res.adb | 1 + gcc/ada/sprint.adb | 14 +++++--- 10 files changed, 95 insertions(+), 103 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c33f44c..01b0076 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2010-06-22 Robert Dewar + + * 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 + + * s-intman-vxworks.ads: Code clean up. + +2010-06-22 Thomas Quinot + + * 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 + + * ali-util.adb, ali-util.ads, gnatbind.adb (Read_ALI): Rename to + Read_Withed_ALIs, which is more descriptive. + +2010-06-22 Pascal Obry + + * 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 * uintp.adb: Fix scope error in operator call. diff --git a/gcc/ada/ali-util.adb b/gcc/ada/ali-util.adb index 3443fe3..001d654 100644 --- a/gcc/ada/ali-util.adb +++ b/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 -- diff --git a/gcc/ada/ali-util.ads b/gcc/ada/ali-util.ads index d28ad40..3f4f6eb 100644 --- a/gcc/ada/ali-util.ads +++ b/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 diff --git a/gcc/ada/g-socthi-mingw.adb b/gcc/ada/g-socthi-mingw.adb index 6cf0058..6d7ca23 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-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; diff --git a/gcc/ada/g-sothco.ads b/gcc/ada/g-sothco.ads index 63a6a22..6ffd066 100644 --- a/gcc/ada/g-sothco.ads +++ b/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 -- diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index 9d7ac41..bdd9702 100644 --- a/gcc/ada/gnatbind.adb +++ b/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 diff --git a/gcc/ada/s-intman-vxworks.ads b/gcc/ada/s-intman-vxworks.ads index be1165d..5614553 100644 --- a/gcc/ada/s-intman-vxworks.ads +++ b/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; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 6a8c994..c330830 100644 --- a/gcc/ada/sem_ch4.adb +++ b/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; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index c9f3c57..3ab997b 100644 --- a/gcc/ada/sem_res.adb +++ b/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 diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index b5e240c..4fff3f4 100644 --- a/gcc/ada/sprint.adb +++ b/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; -- cgit v1.1