Skip to content

R
riscv-gcc-1
Commit 4a214958 by Arnaud Charlet
Options

[multiple changes] 

2010-06-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (End_Use_Type): Before indicating that an operator is not
	use-visible, check whether it is a primitive for more than one type.

2010-06-14  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb (Copy_And_Swap): Copy Has_Pragma_Unmodified flag.

	* sem_ch7.adb (Preserve_Full_Attributes): Preserve
	Has_Pragma_Unmodified flag.

2010-06-14  Thomas Quinot  <quinot@adacore.com>

	* g-sttsne-locking.adb, g-sttsne-locking.ads, g-sttsne.ads,
	g-sttsne-vxworks.adb, g-sttsne-dummy.ads: Removed. Mutual exclusion is
	now done in GNAT.Sockets if necessary.
	* gsocket.h, g-socket.adb, g-sothco.ads (GNAT.Sockets.Get_XXX_By_YYY):
	Ensure mutual exclusion for netdb operations if the target platform
	requires it.
	(GNAT.Sockets.Thin_Common): New binding for getXXXbyYYY, treating struct
	hostent as an opaque type to improve portability.
	* s-oscons-tmplt.c, socket.c: For the case of Vxworks, emulate
	gethostbyYYY using proprietary VxWorks API so that a uniform interface
	is available for the Ada side.
	* gcc-interface/Makefile.in: Remove g-sttsne-*
	* gcc-interface/Make-lang.in: Update dependencies.

2010-06-14  Vincent Celier  <celier@adacore.com>

	* gnatcmd.adb (Mapping_File): New function.

From-SVN: r160731
parent 5bca794b
Showing with 587 additions and 735 deletions
gcc/ada/ChangeLog
2010-06-14 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (End_Use_Type): Before indicating that an operator is not
use-visible, check whether it is a primitive for more than one type.
2010-06-14 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb (Copy_And_Swap): Copy Has_Pragma_Unmodified flag.
* sem_ch7.adb (Preserve_Full_Attributes): Preserve
Has_Pragma_Unmodified flag.
2010-06-14 Thomas Quinot <quinot@adacore.com>
* g-sttsne-locking.adb, g-sttsne-locking.ads, g-sttsne.ads,
g-sttsne-vxworks.adb, g-sttsne-dummy.ads: Removed. Mutual exclusion is
now done in GNAT.Sockets if necessary.
* gsocket.h, g-socket.adb, g-sothco.ads (GNAT.Sockets.Get_XXX_By_YYY):
Ensure mutual exclusion for netdb operations if the target platform
requires it.
(GNAT.Sockets.Thin_Common): New binding for getXXXbyYYY, treating struct
hostent as an opaque type to improve portability.
* s-oscons-tmplt.c, socket.c: For the case of Vxworks, emulate
gethostbyYYY using proprietary VxWorks API so that a uniform interface
is available for the Ada side.
* gcc-interface/Makefile.in: Remove g-sttsne-*
* gcc-interface/Make-lang.in: Update dependencies.
2010-06-14 Vincent Celier <celier@adacore.com>
* gnatcmd.adb (Mapping_File): New function.
2010-06-14 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Derive_Subprograms): Remove over-restrictive assertion.
......
gcc/ada/g-sothco.ads
......@@ -200,18 +200,40 @@ package GNAT.Sockets.Thin_Common is
pragma Inline (Set_Address);
-- Set Sin.Sin_Addr to Address
------------------
-- Host entries --
------------------
type Hostent is new
System.Storage_Elements.Storage_Array (1 .. SOSC.SIZEOF_struct_hostent);
for Hostent'Alignment use 8;
-- Host entry. This is an opaque type used only via the following
-- accessor functions, because 'struct hostent' has different layouts on
-- different platforms.
type Hostent_Access is access all Hostent;
pragma Convention (C, Hostent_Access);
-- Access to host entry
function Hostent_H_Name
(E : Hostent_Access) return C.Strings.chars_ptr;
function Hostent_H_Alias
(E : Hostent_Access; I : C.int) return C.Strings.chars_ptr;
function Hostent_H_Addrtype
(E : Hostent_Access) return C.int;
function Hostent_H_Length
(E : Hostent_Access) return C.int;
function Hostent_H_Addr
(E : Hostent_Access; Index : C.int) return C.Strings.chars_ptr;
---------------------
-- Service entries --
---------------------
type Chars_Ptr_Array is array (C.size_t range <>) of
aliased C.Strings.chars_ptr;
package Chars_Ptr_Pointers is
new C.Pointers (C.size_t, C.Strings.chars_ptr, Chars_Ptr_Array,
C.Strings.Null_Ptr);
-- Arrays of C (char *)
type Servent is new
System.Storage_Elements.Storage_Array (1 .. SOSC.SIZEOF_struct_servent);
for Servent'Alignment use 8;
......@@ -226,48 +248,60 @@ package GNAT.Sockets.Thin_Common is
function Servent_S_Name
(E : Servent_Access) return C.Strings.chars_ptr;
function Servent_S_Aliases
(E : Servent_Access) return Chars_Ptr_Pointers.Pointer;
function Servent_S_Alias
(E : Servent_Access; Index : C.int) return C.Strings.chars_ptr;
function Servent_S_Port
(E : Servent_Access) return C.int;
(E : Servent_Access) return C.unsigned_short;
function Servent_S_Proto
(E : Servent_Access) return C.Strings.chars_ptr;
procedure Servent_Set_S_Name
(E : Servent_Access;
S_Name : C.Strings.chars_ptr);
procedure Servent_Set_S_Aliases
(E : Servent_Access;
S_Aliases : Chars_Ptr_Pointers.Pointer);
procedure Servent_Set_S_Port
(E : Servent_Access;
S_Port : C.int);
procedure Servent_Set_S_Proto
(E : Servent_Access;
S_Proto : C.Strings.chars_ptr);
------------------
-- Host entries --
-- NetDB access --
------------------
type Hostent is record
H_Name : C.Strings.chars_ptr;
H_Aliases : Chars_Ptr_Pointers.Pointer;
H_Addrtype : SOSC.H_Addrtype_T;
H_Length : SOSC.H_Length_T;
H_Addr_List : In_Addr_Access_Pointers.Pointer;
end record;
pragma Convention (C, Hostent);
-- Host entry
type Hostent_Access is access all Hostent;
pragma Convention (C, Hostent_Access);
-- Access to host entry
-- There are three possible situations for the following NetDB access
-- functions:
-- - inherently thread safe (case of data returned in a thread specific
-- buffer);
-- - thread safe using user-provided buffer;
-- - thread unsafe.
--
-- In the first and third cases, the Buf and Buflen are ignored. In the
-- second case, the caller must provide a buffer large enough to accomodate
-- the returned data. In the third case, the caller must ensure that these
-- functions are called within a critical section.
function C_Gethostbyname
(Name : C.char_array;
Ret : not null access Hostent;
Buf : System.Address;
Buflen : C.int;
H_Errnop : not null access C.int) return C.int;
function C_Gethostbyaddr
(Addr : System.Address;
Addr_Len : C.int;
Addr_Type : C.int;
Ret : not null access Hostent;
Buf : System.Address;
Buflen : C.int;
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;
function C_Getservbyport
(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 --
......@@ -362,12 +396,20 @@ private
pragma Import (C, C_Ioctl, "__gnat_socket_ioctl");
pragma Import (C, Inet_Pton, SOSC.Inet_Pton_Linkname);
pragma Import (C, Servent_S_Name, "__gnat_servent_s_name");
pragma Import (C, Servent_S_Aliases, "__gnat_servent_s_aliases");
pragma Import (C, Servent_S_Port, "__gnat_servent_s_port");
pragma Import (C, C_Gethostbyname, "__gnat_gethostbyname");
pragma Import (C, C_Gethostbyaddr, "__gnat_gethostbyaddr");
pragma Import (C, C_Getservbyname, "__gnat_getservbyname");
pragma Import (C, C_Getservbyport, "__gnat_getservbyport");
pragma Import (C, Servent_S_Name, "__gnat_servent_s_name");
pragma Import (C, Servent_S_Alias, "__gnat_servent_s_alias");
pragma Import (C, Servent_S_Port, "__gnat_servent_s_port");
pragma Import (C, Servent_S_Proto, "__gnat_servent_s_proto");
pragma Import (C, Servent_Set_S_Name, "__gnat_servent_set_s_name");
pragma Import (C, Servent_Set_S_Aliases, "__gnat_servent_set_s_aliases");
pragma Import (C, Servent_Set_S_Port, "__gnat_servent_set_s_port");
pragma Import (C, Servent_Set_S_Proto, "__gnat_servent_set_s_proto");
pragma Import (C, Hostent_H_Name, "__gnat_hostent_h_name");
pragma Import (C, Hostent_H_Alias, "__gnat_hostent_h_alias");
pragma Import (C, Hostent_H_Addrtype, "__gnat_hostent_h_addrtype");
pragma Import (C, Hostent_H_Length, "__gnat_hostent_h_length");
pragma Import (C, Hostent_H_Addr, "__gnat_hostent_h_addr");
end GNAT.Sockets.Thin_Common;
gcc/ada/g-sttsne-dummy.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
-- --
-- S p e c --
-- --
-- Copyright (C) 2007-2008, 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package is a placeholder for the sockets binding for platforms where
-- it is not implemented.
package GNAT.Sockets.Thin.Task_Safe_NetDB is
pragma Unimplemented_Unit;
end GNAT.Sockets.Thin.Task_Safe_NetDB;
gcc/ada/g-sttsne-locking.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
-- --
-- S p e c --
-- --
-- Copyright (C) 2007, 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This version is used on VMS, LynxOS, and VxWorks. There are two versions of
-- the body: one for VMS and LynxOS, the other for VxWorks.
-- This package should not be directly with'ed by an application
package GNAT.Sockets.Thin.Task_Safe_NetDB is
----------------------------------------
-- Reentrant network databases access --
----------------------------------------
function Safe_Gethostbyname
(Name : C.char_array;
Ret : not null access Hostent;
Buf : System.Address;
Buflen : C.int;
H_Errnop : not null access C.int) return C.int;
function Safe_Gethostbyaddr
(Addr : System.Address;
Addr_Len : C.int;
Addr_Type : C.int;
Ret : not null access Hostent;
Buf : System.Address;
Buflen : C.int;
H_Errnop : not null access C.int) return C.int;
function Safe_Getservbyname
(Name : C.char_array;
Proto : C.char_array;
Ret : not null access Servent;
Buf : System.Address;
Buflen : C.int) return C.int;
function Safe_Getservbyport
(Port : C.int;
Proto : C.char_array;
Ret : not null access Servent;
Buf : System.Address;
Buflen : C.int) return C.int;
end GNAT.Sockets.Thin.Task_Safe_NetDB;
gcc/ada/g-sttsne-vxworks.adb deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
-- --
-- B o d y --
-- --
-- Copyright (C) 2007-2008, 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This version is used on VxWorks. Note that the corresponding spec is in
-- g-sttsne-locking.ads.
with Ada.Unchecked_Conversion;
with Interfaces.C; use Interfaces.C;
package body GNAT.Sockets.Thin.Task_Safe_NetDB is
-- The following additional data is returned by Safe_Gethostbyname
-- and Safe_Getostbyaddr in the user provided buffer.
type Netdb_Host_Data (Name_Length : C.size_t) is record
Address : aliased In_Addr;
Addr_List : aliased In_Addr_Access_Array (0 .. 1);
Name : aliased C.char_array (0 .. Name_Length);
end record;
Alias_Access : constant Chars_Ptr_Pointers.Pointer :=
new C.Strings.chars_ptr'(C.Strings.Null_Ptr);
-- Constant used to create a Hostent record manually
------------------------
-- Safe_Gethostbyaddr --
------------------------
function Safe_Gethostbyaddr
(Addr : System.Address;
Addr_Len : C.int;
Addr_Type : C.int;
Ret : not null access Hostent;
Buf : System.Address;
Buflen : C.int;
H_Errnop : not null access C.int) return C.int
is
type int_Access is access int;
function To_Pointer is
new Ada.Unchecked_Conversion (System.Address, int_Access);
function VxWorks_hostGetByAddr
(Addr : C.int; Buf : System.Address) return C.int;
pragma Import (C, VxWorks_hostGetByAddr, "hostGetByAddr");
Netdb_Data : Netdb_Host_Data (Name_Length => Max_Name_Length);
pragma Import (Ada, Netdb_Data);
for Netdb_Data'Address use Buf;
begin
pragma Assert (Addr_Type = SOSC.AF_INET);
pragma Assert (Addr_Len = In_Addr'Size / 8);
-- Check that provided buffer is sufficiently large to hold the
-- data we want to return.
if Netdb_Data'Size / 8 > Buflen then
H_Errnop.all := SOSC.ERANGE;
return -1;
end if;
if VxWorks_hostGetByAddr (To_Pointer (Addr).all,
Netdb_Data.Name'Address)
/= SOSC.OK
then
H_Errnop.all := C.int (Host_Errno);
return -1;
end if;
Netdb_Data.Address := To_In_Addr (To_Pointer (Addr).all);
Netdb_Data.Addr_List :=
(0 => Netdb_Data.Address'Unchecked_Access,
1 => null);
Ret.H_Name := C.Strings.To_Chars_Ptr
(Netdb_Data.Name'Unrestricted_Access);
Ret.H_Aliases := Alias_Access;
Ret.H_Addrtype := SOSC.AF_INET;
Ret.H_Length := 4;
Ret.H_Addr_List :=
Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access;
return 0;
end Safe_Gethostbyaddr;
------------------------
-- Safe_Gethostbyname --
------------------------
function Safe_Gethostbyname
(Name : C.char_array;
Ret : not null access Hostent;
Buf : System.Address;
Buflen : C.int;
H_Errnop : not null access C.int) return C.int
is
function VxWorks_hostGetByName
(Name : C.char_array) return C.int;
pragma Import (C, VxWorks_hostGetByName, "hostGetByName");
Addr : C.int;
begin
Addr := VxWorks_hostGetByName (Name);
if Addr = SOSC.ERROR then
H_Errnop.all := C.int (Host_Errno);
return -1;
end if;
declare
Netdb_Data : Netdb_Host_Data (Name_Length => Name'Length);
pragma Import (Ada, Netdb_Data);
for Netdb_Data'Address use Buf;
begin
-- Check that provided buffer is sufficiently large to hold the
-- data we want to return.
if Netdb_Data'Size / 8 > Buflen then
H_Errnop.all := SOSC.ERANGE;
return -1;
end if;
Netdb_Data.Address := To_In_Addr (Addr);
Netdb_Data.Addr_List :=
(0 => Netdb_Data.Address'Unchecked_Access,
1 => null);
Netdb_Data.Name (Netdb_Data.Name'First .. Name'Length - 1) := Name;
Ret.H_Name := C.Strings.To_Chars_Ptr
(Netdb_Data.Name'Unrestricted_Access);
Ret.H_Aliases := Alias_Access;
Ret.H_Addrtype := SOSC.AF_INET;
Ret.H_Length := 4;
Ret.H_Addr_List :=
Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access;
end;
return 0;
end Safe_Gethostbyname;
------------------------
-- Safe_Getservbyname --
------------------------
function Safe_Getservbyname
(Name : C.char_array;
Proto : C.char_array;
Ret : not null access Servent;
Buf : System.Address;
Buflen : C.int) return C.int
is
pragma Unreferenced (Name, Proto, Ret, Buf, Buflen);
begin
-- Not available under VxWorks
return -1;
end Safe_Getservbyname;
------------------------
-- Safe_Getservbyport --
------------------------
function Safe_Getservbyport
(Port : C.int;
Proto : C.char_array;
Ret : not null access Servent;
Buf : System.Address;
Buflen : C.int) return C.int
is
pragma Unreferenced (Port, Proto, Ret, Buf, Buflen);
begin
-- Not available under VxWorks
return -1;
end Safe_Getservbyport;
end GNAT.Sockets.Thin.Task_Safe_NetDB;
gcc/ada/g-sttsne.ads deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
-- --
-- S p e c --
-- --
-- Copyright (C) 2007, 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- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package exports reentrant NetDB subprograms. This is the default
-- version, used on most platforms. The routines are implemented by importing
-- from C; see gsocket.h for details. Different versions are provided on
-- platforms where this functionality is implemented in Ada.
-- This package should not be directly with'ed by an application
package GNAT.Sockets.Thin.Task_Safe_NetDB is
----------------------------------------
-- Reentrant network databases access --
----------------------------------------
function Safe_Gethostbyname
(Name : C.char_array;
Ret : not null access Hostent;
Buf : System.Address;
Buflen : C.int;
H_Errnop : not null access C.int) return C.int;
function Safe_Gethostbyaddr
(Addr : System.Address;
Addr_Len : C.int;
Addr_Type : C.int;
Ret : not null access Hostent;
Buf : System.Address;
Buflen : C.int;
H_Errnop : not null access C.int) return C.int;
function Safe_Getservbyname
(Name : C.char_array;
Proto : C.char_array;
Ret : not null access Servent;
Buf : System.Address;
Buflen : C.int) return C.int;
function Safe_Getservbyport
(Port : C.int;
Proto : C.char_array;
Ret : not null access Servent;
Buf : System.Address;
Buflen : C.int) return C.int;
private
pragma Import (C, Safe_Gethostbyname, "__gnat_safe_gethostbyname");
pragma Import (C, Safe_Gethostbyaddr, "__gnat_safe_gethostbyaddr");
pragma Import (C, Safe_Getservbyname, "__gnat_safe_getservbyname");
pragma Import (C, Safe_Getservbyport, "__gnat_safe_getservbyport");
end GNAT.Sockets.Thin.Task_Safe_NetDB;
gcc/ada/gcc-interface/Make-lang.in
......@@ -3385,18 +3385,19 @@ ada/sem_ch12.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/sem_elab.ads ada/sem_elim.ads ada/sem_eval.ads ada/sem_res.ads \
ada/sem_scil.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads \
ada/sinput.ads ada/sinput-l.ads ada/snames.ads ada/stand.ads \
ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
ada/s-exctab.adb ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads \
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
ada/s-stoele.ads ada/s-stoele.adb ada/s-strhas.ads ada/s-string.ads \
ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads \
ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/widechar.ads
ada/sinput.ads ada/sinput.adb ada/sinput-l.ads ada/snames.ads \
ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \
ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-crc32.ads \
ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-htable.adb \
ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-strhas.ads \
ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
ada/widechar.ads
ada/sem_ch13.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
......
gcc/ada/gcc-interface/Makefile.in
......@@ -380,7 +380,7 @@ MLIB_TGT = mlib-tgt
# to LIBGNAT_TARGET_PAIRS.
GNATRTL_SOCKETS_OBJS = g-soccon$(objext) g-socket$(objext) g-socthi$(objext) \
g-soliop$(objext) g-sothco$(objext) g-sttsne$(objext)
g-soliop$(objext) g-sothco$(objext)
DUMMY_SOCKETS_TARGET_PAIRS = \
g-socket.adb<g-socket-dummy.adb \
......@@ -388,8 +388,7 @@ DUMMY_SOCKETS_TARGET_PAIRS = \
g-socthi.adb<g-socthi-dummy.adb \
g-socthi.ads<g-socthi-dummy.ads \
g-sothco.adb<g-sothco-dummy.adb \
g-sothco.ads<g-sothco-dummy.ads \
g-sttsne.ads<g-sttsne-dummy.ads
g-sothco.ads<g-sothco-dummy.ads
# On platform where atomic increment/decrement operations are supported
# special version of Ada.Strings.Unbounded package can be used.
......@@ -440,8 +439,6 @@ ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),)
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
g-sttsne.adb<g-sttsne-vxworks.adb \
g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-m68k.ads
......@@ -485,8 +482,6 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
g-sttsne.adb<g-sttsne-vxworks.adb \
g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
$(ATOMICS_TARGET_PAIRS)
......@@ -606,9 +601,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
LIBGNAT_TARGET_PAIRS += \
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
g-sttsne.adb<g-sttsne-vxworks.adb \
g-sttsne.ads<g-sttsne-locking.ads
g-stsifd.adb<g-stsifd-sockets.adb
endif
ifeq ($(strip $(filter-out yes,$(TRACE))),)
......@@ -724,9 +717,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(targ))),)
LIBGNAT_TARGET_PAIRS += \
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
g-sttsne.adb<g-sttsne-vxworks.adb \
g-sttsne.ads<g-sttsne-locking.ads
g-stsifd.adb<g-stsifd-sockets.adb
endif
ifeq ($(strip $(filter-out yes,$(TRACE))),)
......@@ -762,8 +753,6 @@ ifeq ($(strip $(filter-out sparc% wrs vx%,$(targ))),)
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
g-sttsne.adb<g-sttsne-vxworks.adb \
g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-sparcv9.ads \
......@@ -803,8 +792,6 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
g-sttsne.adb<g-sttsne-vxworks.adb \
g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb
......@@ -896,8 +883,6 @@ ifeq ($(strip $(filter-out arm% coff wrs vx%,$(targ))),)
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
g-sttsne.adb<g-sttsne-vxworks.adb \
g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-arm.ads
......@@ -936,8 +921,6 @@ ifeq ($(strip $(filter-out mips% wrs vx%,$(targ))),)
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
g-sttsne.adb<g-sttsne-vxworks.adb \
g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-mips.ads
......@@ -1398,8 +1381,6 @@ ifeq ($(strip $(filter-out lynxos,$(osys))),)
a-numaux.ads<a-numaux-x86.ads \
a-intnam.ads<a-intnam-lynxos.ads \
g-bytswa.adb<g-bytswa-x86.adb \
g-sttsne.adb<g-sttsne-locking.adb \
g-sttsne.ads<g-sttsne-locking.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
s-osinte.adb<s-osinte-lynxos.adb \
......@@ -1416,8 +1397,6 @@ ifeq ($(strip $(filter-out lynxos,$(osys))),)
else
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-lynxos.ads \
g-sttsne.adb<g-sttsne-locking.adb \
g-sttsne.ads<g-sttsne-locking.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
s-osinte.adb<s-osinte-lynxos.adb \
......@@ -1543,8 +1522,6 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ)))
g-socthi.ads<g-socthi-vms.ads \
g-socthi.adb<g-socthi-vms.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
g-sttsne.adb<g-sttsne-locking.adb \
g-sttsne.ads<g-sttsne-locking.ads \
i-c.ads<i-c-vms_64.ads \
i-cstrin.ads<i-cstrin-vms_64.ads \
i-cstrin.adb<i-cstrin-vms_64.adb \
......
gcc/ada/gnatcmd.adb
......@@ -232,6 +232,11 @@ procedure GNATCmd is
-- STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric (GNAT
-- METRIC).
function Mapping_File return Path_Name_Type;
-- Create and return the path name of a mapping file. Used for gnatstub
-- (GNAT STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric
-- (GNAT METRIC).
procedure Delete_Temp_Config_Files;
-- Delete all temporary config files. The caller is responsible for
-- ensuring that Keep_Temporary_Files is False.
......@@ -890,6 +895,22 @@ procedure GNATCmd is
end Index;
------------------
-- Mapping_File --
------------------
function Mapping_File return Path_Name_Type is
Result : Path_Name_Type;
begin
Prj.Env.Create_Mapping_File
(Project => Project,
Language => Name_Ada,
In_Tree => Project_Tree,
Name => Result);
return Result;
end Mapping_File;
------------------
-- Process_Link --
------------------
......@@ -2156,6 +2177,7 @@ begin
declare
CP_File : constant Path_Name_Type := Configuration_Pragmas_File;
M_File : constant Path_Name_Type := Mapping_File;
begin
if CP_File /= No_Path then
......@@ -2169,6 +2191,11 @@ begin
(new String'("-gnatec=" & Get_Name_String (CP_File)));
end if;
end if;
if M_File /= No_Path then
Add_To_Carg_Switches
(new String'("-gnatem=" & Get_Name_String (M_File)));
end if;
end;
end if;
......
gcc/ada/gsocket.h
......@@ -194,34 +194,37 @@
#include <netdb.h>
#endif
/*
* Handling of gethostbyname, gethostbyaddr, getservbyname and getservbyport
* =========================================================================
*
* The default implementation of GNAT.Sockets.Thin requires that these
* operations be either thread safe, or that a reentrant version getXXXbyYYY_r
* be provided. In both cases, socket.c provides a __gnat_safe_getXXXbyYYY
* function with the same signature as getXXXbyYYY_r. If the operating
* system version of getXXXbyYYY is thread safe, the provided auxiliary
* buffer argument is unused and ignored.
*
* Target specific versions of GNAT.Sockets.Thin for platforms that can't
* fulfill these requirements must provide their own protection mechanism
* in Safe_GetXXXbyYYY, and if they require GNAT.Sockets to provide a buffer
* to this effect, then we need to set Need_Netdb_Buffer here (case of
* VxWorks and VMS).
*/
#if defined (_AIX) || defined (__FreeBSD__) || defined (__hpux__) || defined (__osf__) || defined (_WIN32) || defined (__APPLE__)
#if defined (_AIX) || defined (__FreeBSD__) || defined (__hpux__) || \
defined (__osf__) || defined (_WIN32) || defined (__APPLE__)
# define HAVE_THREAD_SAFE_GETxxxBYyyy 1
#elif defined (sgi) || defined (linux) || defined (__GLIBC__) || (defined (sun) && defined (__SVR4) && !defined (__vxworks)) || defined(__rtems__)
#elif defined (sgi) || defined (linux) || defined (__GLIBC__) || \
(defined (sun) && defined (__SVR4) && !defined (__vxworks)) || \
defined(__rtems__)
# define HAVE_GETxxxBYyyy_R 1
#endif
#if defined (HAVE_GETxxxBYyyy_R) || !defined (HAVE_THREAD_SAFE_GETxxxBYyyy)
/*
* Properties of the unerlying NetDB library:
* Need_Netdb_Buffer __gnat_getXXXbyYYY expects a caller-supplied buffer
* Need_Netdb_Lock __gnat_getXXXbyYYY expects the caller to ensure
* mutual exclusion
*
* See "Handling of gethostbyname, gethostbyaddr, getservbyname and
* getservbyport" in socket.c for details.
*/
#if defined (HAVE_GETxxxBYyyy_R)
# define Need_Netdb_Buffer 1
# define Need_Netdb_Lock 0
#else
# define Need_Netdb_Buffer 0
# if !defined (HAVE_THREAD_SAFE_GETxxxBYyyy)
# define Need_Netdb_Lock 1
# else
# define Need_Netdb_Lock 0
# endif
#endif
#if defined (__FreeBSD__) || defined (__vxworks) || defined(__rtems__)
......
gcc/ada/s-oscons-tmplt.c
......@@ -1231,26 +1231,13 @@ CND(SIZEOF_sockaddr_in6, "struct sockaddr_in6")
#define SIZEOF_fd_set (sizeof (fd_set))
CND(SIZEOF_fd_set, "fd_set");
#define SIZEOF_struct_hostent (sizeof (struct hostent))
CND(SIZEOF_struct_hostent, "struct hostent");
#define SIZEOF_struct_servent (sizeof (struct servent))
CND(SIZEOF_struct_servent, "struct servent");
/*
-- Fields of struct hostent
*/
#ifdef __MINGW32__
# define h_addrtype_t "short"
# define h_length_t "short"
#else
# define h_addrtype_t "int"
# define h_length_t "int"
#endif
TXT(" subtype H_Addrtype_T is Interfaces.C." h_addrtype_t ";")
TXT(" subtype H_Length_T is Interfaces.C." h_length_t ";")
/*
-- Fields of struct msghdr
*/
......@@ -1271,6 +1258,7 @@ TXT(" subtype Msg_Iovlen_T is Interfaces.C." msg_iovlen_t ";")
*/
CND(Need_Netdb_Buffer, "Need buffer for Netdb ops")
CND(Need_Netdb_Lock, "Need lock for Netdb ops")
CND(Has_Sockaddr_Len, "Sockaddr has sa_len field")
/**
......
gcc/ada/sem_ch3.adb
......@@ -11283,6 +11283,7 @@ package body Sem_Ch3 is
Set_Is_Public (Full, Is_Public (Priv));
Set_Is_Pure (Full, Is_Pure (Priv));
Set_Is_Tagged_Type (Full, Is_Tagged_Type (Priv));
Set_Has_Pragma_Unmodified (Full, Has_Pragma_Unmodified (Priv));
Set_Has_Pragma_Unreferenced (Full, Has_Pragma_Unreferenced (Priv));
Set_Has_Pragma_Unreferenced_Objects
(Full, Has_Pragma_Unreferenced_Objects
......@@ -11318,10 +11319,10 @@ package body Sem_Ch3 is
Access_Types_To_Process (Freeze_Node (Priv)));
end if;
-- Swap the two entities. Now Privat is the full type entity and
-- Full is the private one. They will be swapped back at the end
-- of the private part. This swapping ensures that the entity that
-- is visible in the private part is the full declaration.
-- Swap the two entities. Now Privat is the full type entity and Full is
-- the private one. They will be swapped back at the end of the private
-- part. This swapping ensures that the entity that is visible in the
-- private part is the full declaration.
Exchange_Entities (Priv, Full);
Append_Entity (Full, Scope (Full));
......@@ -12810,13 +12811,12 @@ package body Sem_Ch3 is
if Need_Search
or else
(Present (Generic_Actual)
and then Present (Act_Subp)
and then not Primitive_Names_Match (Subp, Act_Subp))
and then Present (Act_Subp)
and then not Primitive_Names_Match (Subp, Act_Subp))
then
pragma Assert (not Is_Ancestor (Parent_Base, Generic_Actual));
-- Remember that we need searching for all the pending
-- primitives
-- Remember that we need searching for all pending primitives
Need_Search := True;
......@@ -12840,8 +12840,9 @@ package body Sem_Ch3 is
Act_Subp := Node (Act_Elmt);
exit when Primitive_Names_Match (Subp, Act_Subp)
and then Type_Conformant (Subp, Act_Subp,
Skip_Controlling_Formals => True)
and then Type_Conformant
(Subp, Act_Subp,
Skip_Controlling_Formals => True)
and then No (Interface_Alias (Act_Subp));
Next_Elmt (Act_Elmt);
......@@ -12870,7 +12871,7 @@ package body Sem_Ch3 is
and then Is_Interface (Find_Dispatching_Type (Alias_Subp))
and then not
(Nkind (Parent (Alias_Subp)) = N_Procedure_Specification
and then Null_Present (Parent (Alias_Subp)))
and then Null_Present (Parent (Alias_Subp)))
then
Derive_Subprogram
(New_Subp => New_Subp,
......
gcc/ada/sem_ch7.adb
......@@ -1954,6 +1954,7 @@ package body Sem_Ch7 is
Set_Is_Volatile (Priv, Is_Volatile (Full));
Set_Treat_As_Volatile (Priv, Treat_As_Volatile (Full));
Set_Is_Ada_2005_Only (Priv, Is_Ada_2005_Only (Full));
Set_Has_Pragma_Unmodified (Priv, Has_Pragma_Unmodified (Full));
Set_Has_Pragma_Unreferenced (Priv, Has_Pragma_Unreferenced (Full));
Set_Has_Pragma_Unreferenced_Objects
(Priv, Has_Pragma_Unreferenced_Objects
......@@ -2032,6 +2033,7 @@ package body Sem_Ch7 is
end if;
Set_Has_Discriminants (Priv, Has_Discriminants (Full));
if Has_Discriminants (Full) then
Set_Discriminant_Constraint (Priv,
Discriminant_Constraint (Full));
......
gcc/ada/sem_ch8.adb
......@@ -3426,33 +3426,47 @@ package body Sem_Ch8 is
------------------
procedure End_Use_Type (N : Node_Id) is
Elmt : Elmt_Id;
Id : Entity_Id;
Op_List : Elist_Id;
Elmt : Elmt_Id;
Op : Entity_Id;
T : Entity_Id;
function May_Be_Used_Primitive_Of (T : Entity_Id) return Boolean;
-- An operator may be primitive in several types, if they are declared
-- in the same scope as the operator. To determine the use-visiblity of
-- the operator in such cases we must examine all types in the profile.
------------------------------
-- May_Be_Used_Primitive_Of --
------------------------------
function May_Be_Used_Primitive_Of (T : Entity_Id) return Boolean is
begin
return Scope (Op) = Scope (T)
and then (In_Use (T) or else Is_Potentially_Use_Visible (T));
end May_Be_Used_Primitive_Of;
-- Start of processing for End_Use_Type
begin
Id := First (Subtype_Marks (N));
while Present (Id) loop
-- A call to rtsfind may occur while analyzing a use_type clause,
-- A call to Rtsfind may occur while analyzing a use_type clause,
-- in which case the type marks are not resolved yet, and there is
-- nothing to remove.
if not Is_Entity_Name (Id)
or else No (Entity (Id))
then
if not Is_Entity_Name (Id) or else No (Entity (Id)) then
goto Continue;
end if;
T := Entity (Id);
if T = Any_Type
or else From_With_Type (T)
then
if T = Any_Type or else From_With_Type (T) then
null;
-- Note that the use_Type clause may mention a subtype of the type
-- Note that the use_type clause may mention a subtype of the type
-- whose primitive operations have been made visible. Here as
-- elsewhere, it is the base type that matters for visibility.
......@@ -3468,8 +3482,30 @@ package body Sem_Ch8 is
Elmt := First_Elmt (Op_List);
while Present (Elmt) loop
if Nkind (Node (Elmt)) = N_Defining_Operator_Symbol then
Set_Is_Potentially_Use_Visible (Node (Elmt), False);
Op := Node (Elmt);
if Nkind (Op) = N_Defining_Operator_Symbol then
declare
T_First : constant Entity_Id :=
Base_Type (Etype (First_Formal (Op)));
T_Res : constant Entity_Id := Base_Type (Etype (Op));
T_Next : Entity_Id;
begin
if Present (Next_Formal (First_Formal (Op))) then
T_Next :=
Base_Type (Etype (Next_Formal (First_Formal (Op))));
else
T_Next := T_First;
end if;
if not May_Be_Used_Primitive_Of (T_First)
and then not May_Be_Used_Primitive_Of (T_Next)
and then not May_Be_Used_Primitive_Of (T_Res)
then
Set_Is_Potentially_Use_Visible (Op, False);
end if;
end;
end if;
Next_Elmt (Elmt);
......
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