mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 23:41:08 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2010-06-17  Robert Dewar  <dewar@adacore.com>

	* exp_ch3.adb, exp_ch6.adb, exp_smem.adb, exp_util.adb: Use Ekind_In.
	* layout.adb, freeze.adb: Use Make_Temporary.

2010-06-17  Jerome Lambourg  <lambourg@adacore.com>

	* exp_ch11.adb (Expand_N_Raise_Statement): Expand raise statements in
	.NET/JVM normally as this is now perfectly supported by the backend.

2010-06-17  Pascal Obry  <obry@adacore.com>

	* gnat_rm.texi: Fix minor typo, remove duplicate blank lines.

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

	* make.adb (Collect_Arguments_And_Compile): Create include path file
	only when -x is specified.
	(Gnatmake): Ditto
	* opt.ads (Use_Include_Path_File): New Boolean flag, initialized to
	False.
	* prj-env.adb (Set_Ada_Paths): New Boolean parameters Include_Path and
	Objects_Path, defaulted to True. Only create include path file if
	Include_Path is True, only create objects path file if Objects_Path is
	True.
	* prj-env.ads (Set_Ada_Paths): New Boolean parameters Include_Path and
	Objects_Path, defaulted to True.
	* switch-m.adb (Scan_Make_Switches): Set Use_Include_Path_File to True
	when -x is used.

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

	* exp_disp.adb (Build_Interface_Thunk): Use base type of formal to
	determine whether it has the controlling type, when the formal is an
	access parameter.

2010-06-17  Eric Botcazou  <ebotcazou@adacore.com>

	* s-crtl.ads (ssize_t): New type.
	(read): Fix signature.
	(write): Likewise.
	* g-socthi.ads: Add 'with System.CRTL' clause.  Remove ssize_t and
	'use type' directive for C.size_t, add one for System.CRTL.ssize_t.
	(C_Recvmsg): Replace ssize_t with System.CRTL.ssize_t.
	(C_Sendmsg): Likewise.
	* g-socthi.adb (Syscall_Recvmsg): Likewise.
	(Syscall_Sendmsg): Likewise.
	(C_Recvmsg): Likewise.
	(C_Sendmsg): Likewise.
	* g-socthi-mingw.ads: Add 'with System.CRTL' clause.  Remove ssize_t
	and 'use type' directive for C.size_t, add one for System.CRTL.ssize_t.
	(C_Recvmsg): Replace ssize_t with System.CRTL.ssize_t.
	(C_Sendmsg): Likewise.
	* g-socthi-mingw.adb (C_Recvmsg): Likewise.
	(C_Sendmsg): Likewise.
	* g-socthi-vms.ads: Add 'with System.CRTL' clause.  Remove ssize_t and
	'use type' directive for C.size_t, add one for System.CRTL.ssize_t.
	(C_Recvmsg): Replace ssize_t with System.CRTL.ssize_t.
	(C_Sendmsg): Likewise.
	* g-socthi-vms.adb (C_Recvmsg): Likewise.
	(C_Sendmsg): Likewise.
	* g-socthi-vxworks.ads Add 'with System.CRTL' clause.  Remove ssize_t
	and 'use type' directive for C.size_t, add one for System.CRTL.ssize_t.
	(C_Recvmsg): Replace ssize_t with System.CRTL.ssize_t.
	(C_Sendmsg): Likewise.
	* g-socthi-vxworks.adb (C_Recvmsg): Likewise.
	(C_Sendmsg): Likewise.
	* g-sercom-linux.adb (Read): Use correct types to call 'read'.
	(Write): Likewise to call 'write'.
	* s-os_lib.adb (Read): Use correct type to call System.CRTL.read.
	(Write): Use correct type to call System.CRTL.write.
	* s-tasdeb.adb (Write): Likewise.

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

	* prj-proc.adb (Copy_Package_Declarations): Change argument name
	Naming_Restricted to Restricted. If Restricted is True, do not copy the
	value of attribute Linker_Options.

From-SVN: r160905
This commit is contained in:
Arnaud Charlet 2010-06-17 14:26:10 +02:00
parent bd2e63a1c4
commit b29def532d
28 changed files with 266 additions and 194 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
gcc/ada/ChangeLog
View File

@ -1,3 +1,82 @@
2010-06-17 Robert Dewar <dewar@adacore.com>
* exp_ch3.adb, exp_ch6.adb, exp_smem.adb, exp_util.adb: Use Ekind_In.
* layout.adb, freeze.adb: Use Make_Temporary.
2010-06-17 Jerome Lambourg <lambourg@adacore.com>
* exp_ch11.adb (Expand_N_Raise_Statement): Expand raise statements in
.NET/JVM normally as this is now perfectly supported by the backend.
2010-06-17 Pascal Obry <obry@adacore.com>
* gnat_rm.texi: Fix minor typo, remove duplicate blank lines.
2010-06-17 Vincent Celier <celier@adacore.com>
* make.adb (Collect_Arguments_And_Compile): Create include path file
only when -x is specified.
(Gnatmake): Ditto
* opt.ads (Use_Include_Path_File): New Boolean flag, initialized to
False.
* prj-env.adb (Set_Ada_Paths): New Boolean parameters Include_Path and
Objects_Path, defaulted to True. Only create include path file if
Include_Path is True, only create objects path file if Objects_Path is
True.
* prj-env.ads (Set_Ada_Paths): New Boolean parameters Include_Path and
Objects_Path, defaulted to True.
* switch-m.adb (Scan_Make_Switches): Set Use_Include_Path_File to True
when -x is used.
2010-06-17 Ed Schonberg <schonberg@adacore.com>
* exp_disp.adb (Build_Interface_Thunk): Use base type of formal to
determine whether it has the controlling type, when the formal is an
access parameter.
2010-06-17 Eric Botcazou <ebotcazou@adacore.com>
* s-crtl.ads (ssize_t): New type.
(read): Fix signature.
(write): Likewise.
* g-socthi.ads: Add 'with System.CRTL' clause. Remove ssize_t and
'use type' directive for C.size_t, add one for System.CRTL.ssize_t.
(C_Recvmsg): Replace ssize_t with System.CRTL.ssize_t.
(C_Sendmsg): Likewise.
* g-socthi.adb (Syscall_Recvmsg): Likewise.
(Syscall_Sendmsg): Likewise.
(C_Recvmsg): Likewise.
(C_Sendmsg): Likewise.
* g-socthi-mingw.ads: Add 'with System.CRTL' clause. Remove ssize_t
and 'use type' directive for C.size_t, add one for System.CRTL.ssize_t.
(C_Recvmsg): Replace ssize_t with System.CRTL.ssize_t.
(C_Sendmsg): Likewise.
* g-socthi-mingw.adb (C_Recvmsg): Likewise.
(C_Sendmsg): Likewise.
* g-socthi-vms.ads: Add 'with System.CRTL' clause. Remove ssize_t and
'use type' directive for C.size_t, add one for System.CRTL.ssize_t.
(C_Recvmsg): Replace ssize_t with System.CRTL.ssize_t.
(C_Sendmsg): Likewise.
* g-socthi-vms.adb (C_Recvmsg): Likewise.
(C_Sendmsg): Likewise.
* g-socthi-vxworks.ads Add 'with System.CRTL' clause. Remove ssize_t
and 'use type' directive for C.size_t, add one for System.CRTL.ssize_t.
(C_Recvmsg): Replace ssize_t with System.CRTL.ssize_t.
(C_Sendmsg): Likewise.
* g-socthi-vxworks.adb (C_Recvmsg): Likewise.
(C_Sendmsg): Likewise.
* g-sercom-linux.adb (Read): Use correct types to call 'read'.
(Write): Likewise to call 'write'.
* s-os_lib.adb (Read): Use correct type to call System.CRTL.read.
(Write): Use correct type to call System.CRTL.write.
* s-tasdeb.adb (Write): Likewise.
2010-06-17 Vincent Celier <celier@adacore.com>
* prj-proc.adb (Copy_Package_Declarations): Change argument name
Naming_Restricted to Restricted. If Restricted is True, do not copy the
value of attribute Linker_Options.
2010-06-17 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (push_stack, pop_stack): Delete.

11
gcc/ada/exp_ch11.adb
View File

@ -1551,17 +1551,6 @@ package body Exp_Ch11 is
end if;
end if;
-- There is no expansion needed for statement "raise <exception>;" when
-- compiling for the JVM since the JVM has a built-in exception
-- mechanism. However we need to keep the expansion for "raise;"
-- statements. See 4jexcept.ads for details.
-- What is .NET status, either code or comment is wrong here ???
if Present (Name (N)) and then VM_Target /= No_VM then
return;
end if;
-- Case of name present, in this case we expand raise name to
-- Raise_Exception (name'Identity, location_string);

4
gcc/ada/exp_ch3.adb
View File

@ -6221,9 +6221,7 @@ package body Exp_Ch3 is
-- See GNAT Pool packages in the Run-Time for more details
elsif Ekind (Def_Id) = E_Access_Type
or else Ekind (Def_Id) = E_General_Access_Type
then
elsif Ekind_In (Def_Id, E_Access_Type, E_General_Access_Type) then
declare
Loc : constant Source_Ptr := Sloc (N);
Desig_Type : constant Entity_Id := Designated_Type (Def_Id);

12
gcc/ada/exp_ch6.adb
View File

@ -2941,9 +2941,8 @@ package body Exp_Ch6 is
return;
end if;
if Ekind (Subp) = E_Function
or else Ekind (Subp) = E_Procedure
then
if Ekind_In (Subp, E_Function, E_Procedure) then
-- We perform two simple optimization on calls:
-- a) replace calls to null procedures unconditionally;
@ -4338,9 +4337,7 @@ package body Exp_Ch6 is
-- For a procedure, we add a return for all possible syntactic ends of
-- the subprogram.
if Ekind (Spec_Id) = E_Procedure
or else Ekind (Spec_Id) = E_Generic_Procedure
then
if Ekind_In (Spec_Id, E_Procedure, E_Generic_Procedure) then
Add_Return (Statements (H));
if Present (Exception_Handlers (H)) then
@ -4707,8 +4704,7 @@ package body Exp_Ch6 is
-- foreign convention or whose result type has a foreign convention
-- never qualify.
if Ekind (E) = E_Function
or else Ekind (E) = E_Generic_Function
if Ekind_In (E, E_Function, E_Generic_Function)
or else (Ekind (E) = E_Subprogram_Type
and then Etype (E) /= Standard_Void_Type)
then

14
gcc/ada/exp_disp.adb
View File

@ -1533,20 +1533,22 @@ package body Exp_Disp is
Formal := First (Formals);
while Present (Formal) loop
-- Handle concurrent types
-- If the parent is a constrained discriminated type, then the
-- primitive operation will have been defined on a first subtype.
-- For proper matching with controlling type, use base type.
if Ekind (Target_Formal) = E_In_Parameter
and then Ekind (Etype (Target_Formal)) = E_Anonymous_Access_Type
then
Ftyp := Directly_Designated_Type (Etype (Target_Formal));
Ftyp :=
Base_Type (Directly_Designated_Type (Etype (Target_Formal)));
else
-- If the parent is a constrained discriminated type, then the
-- primitive operation will have been defined on a first subtype.
-- For proper matching with controlling type, use base type.
Ftyp := Base_Type (Etype (Target_Formal));
end if;
-- For concurrent types, the relevant info is on the corresponding_
-- record type.
if Is_Concurrent_Type (Ftyp) then
Ftyp := Corresponding_Record_Type (Ftyp);
end if;

7
gcc/ada/exp_smem.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1998-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- --
@ -270,10 +270,7 @@ package body Exp_Smem is
return False;
else
if Ekind (Formal) = E_Out_Parameter
or else
Ekind (Formal) = E_In_Out_Parameter
then
if Ekind_In (Formal, E_Out_Parameter, E_In_Out_Parameter) then
Insert_Node := Call;
return True;
else

8
gcc/ada/exp_util.adb
View File

@ -2107,9 +2107,7 @@ package body Exp_Util is
begin
-- Only consider record types
if Ekind (Typ) /= E_Record_Type
and then Ekind (Typ) /= E_Record_Subtype
then
if not Ekind_In (Typ, E_Record_Type, E_Record_Subtype) then
return False;
end if;
@ -4406,9 +4404,7 @@ package body Exp_Util is
-- already rewritten a variable node with a constant as
-- a result of an earlier Force_Evaluation call.
if Ekind (Entity (N)) = E_Constant
or else Ekind (Entity (N)) = E_In_Parameter
then
if Ekind_In (Entity (N), E_Constant, E_In_Parameter) then
return True;
-- Functions are not side effect free

8
gcc/ada/freeze.adb
View File

@ -1145,10 +1145,7 @@ package body Freeze is
if Nkind_In (Par, N_Object_Declaration, N_Assignment_Statement)
and then Comes_From_Source (Par)
then
Temp :=
Make_Defining_Identifier (Loc,
New_Internal_Name ('T'));
Temp := Make_Temporary (Loc, 'T', E);
New_N :=
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
@ -5419,8 +5416,7 @@ package body Freeze is
-- involve secondary stack expansion.
else
Dnam :=
Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
Dnam := Make_Temporary (Loc, 'D');
Dbody :=
Make_Subprogram_Body (Loc,

11
gcc/ada/g-sercom-linux.adb
View File

@ -158,8 +158,8 @@ package body GNAT.Serial_Communications is
Buffer : out Stream_Element_Array;
Last : out Stream_Element_Offset)
is
Len : constant int := Buffer'Length;
Res : int;
Len : constant size_t := Buffer'Length;
Res : ssize_t;
begin
if Port.H = null then
@ -264,8 +264,8 @@ package body GNAT.Serial_Communications is
(Port : in out Serial_Port;
Buffer : Stream_Element_Array)
is
Len : constant int := Buffer'Length;
Res : int;
Len : constant size_t := Buffer'Length;
Res : ssize_t;
begin
if Port.H = null then
@ -273,11 +273,12 @@ package body GNAT.Serial_Communications is
end if;
Res := write (int (Port.H.all), Buffer'Address, Len);
pragma Assert (Res = Len);
if Res = -1 then
Raise_Error ("write failed");
end if;
pragma Assert (size_t (Res) = Len);
end Write;
-----------

48
gcc/ada/g-socthi-mingw.adb
View File

@ -269,7 +269,7 @@ package body GNAT.Sockets.Thin is
function C_Recvmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t
Flags : C.int) return System.CRTL.ssize_t
is
Res : C.int;
Count : C.int := 0;
@ -287,19 +287,20 @@ package body GNAT.Sockets.Thin is
-- not available in all versions of Windows. So, we use C_Recv instead.
for J in Iovec'Range loop
Res := C_Recv
(S,
Iovec (J).Base.all'Address,
C.int (Iovec (J).Length),
Flags);
Res :=
C_Recv
(S,
Iovec (J).Base.all'Address,
C.int (Iovec (J).Length),
Flags);
if Res < 0 then
return ssize_t (Res);
return System.CRTL.ssize_t (Res);
else
Count := Count + Res;
end if;
end loop;
return ssize_t (Count);
return System.CRTL.ssize_t (Count);
end C_Recvmsg;
--------------
@ -369,10 +370,11 @@ package body GNAT.Sockets.Thin is
-- Check out-of-band data
Length := C_Recvfrom
(S, Buffer'Address, 1, Flag,
From => System.Null_Address,
Fromlen => Fromlen'Unchecked_Access);
Length :=
C_Recvfrom
(S, Buffer'Address, 1, Flag,
From => System.Null_Address,
Fromlen => Fromlen'Unchecked_Access);
-- Is Fromlen necessary if From is Null_Address???
-- If the signal is not an out-of-band data, then it
@ -404,7 +406,7 @@ package body GNAT.Sockets.Thin is
function C_Sendmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t
Flags : C.int) return System.CRTL.ssize_t
is
Res : C.int;
Count : C.int := 0;
@ -423,21 +425,23 @@ package body GNAT.Sockets.Thin is
-- instead.
for J in Iovec'Range loop
Res := C_Sendto
(S,
Iovec (J).Base.all'Address,
C.int (Iovec (J).Length),
Flags => Flags,
To => MH.Msg_Name,
Tolen => C.int (MH.Msg_Namelen));
Res :=
C_Sendto
(S,
Iovec (J).Base.all'Address,
C.int (Iovec (J).Length),
Flags => Flags,
To => MH.Msg_Name,
Tolen => C.int (MH.Msg_Namelen));
if Res < 0 then
return ssize_t (Res);
return System.CRTL.ssize_t (Res);
else
Count := Count + Res;
end if;
end loop;
return ssize_t (Count);
return System.CRTL.ssize_t (Count);
end C_Sendmsg;
--------------

10
gcc/ada/g-socthi-mingw.ads
View File

@ -42,6 +42,7 @@ with Interfaces.C.Strings;
with GNAT.Sockets.Thin_Common;
with System;
with System.CRTL;
package GNAT.Sockets.Thin is
@ -49,10 +50,7 @@ package GNAT.Sockets.Thin is
package C renames Interfaces.C;
use type C.size_t;
type ssize_t is range -(2 ** (C.size_t'Size - 1))
.. +(2 ** (C.size_t'Size - 1) - 1);
-- Signed type of the same size as size_t
use type System.CRTL.ssize_t;
function Socket_Errno return Integer;
-- Returns last socket error number
@ -146,7 +144,7 @@ package GNAT.Sockets.Thin is
function C_Recvmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t;
Flags : C.int) return System.CRTL.ssize_t;
function C_Select
(Nfds : C.int;
@ -158,7 +156,7 @@ package GNAT.Sockets.Thin is
function C_Sendmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t;
Flags : C.int) return System.CRTL.ssize_t;
function C_Sendto
(S : C.int;

8
gcc/ada/g-socthi-vms.adb
View File

@ -292,7 +292,7 @@ package body GNAT.Sockets.Thin is
function C_Recvmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t
Flags : C.int) return System.CRTL.ssize_t
is
Res : C.int;
@ -314,7 +314,7 @@ package body GNAT.Sockets.Thin is
GNAT_Msg := Msghdr (VMS_Msg);
return ssize_t (Res);
return System.CRTL.ssize_t (Res);
end C_Recvmsg;
---------------
@ -324,7 +324,7 @@ package body GNAT.Sockets.Thin is
function C_Sendmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t
Flags : C.int) return System.CRTL.ssize_t
is
Res : C.int;
@ -346,7 +346,7 @@ package body GNAT.Sockets.Thin is
GNAT_Msg := Msghdr (VMS_Msg);
return ssize_t (Res);
return System.CRTL.ssize_t (Res);
end C_Sendmsg;
--------------

10
gcc/ada/g-socthi-vms.ads
View File

@ -43,6 +43,7 @@ with GNAT.OS_Lib;
with GNAT.Sockets.Thin_Common;
with System;
with System.CRTL;
package GNAT.Sockets.Thin is
@ -52,10 +53,7 @@ package GNAT.Sockets.Thin is
package C renames Interfaces.C;
use type C.size_t;
type ssize_t is range -(2 ** (C.size_t'Size - 1))
.. +(2 ** (C.size_t'Size - 1) - 1);
-- Signed type of the same size as size_t
use type System.CRTL.ssize_t;
function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
-- Returns last socket error number
@ -149,7 +147,7 @@ package GNAT.Sockets.Thin is
function C_Recvmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t;
Flags : C.int) return System.CRTL.ssize_t;
function C_Select
(Nfds : C.int;
@ -161,7 +159,7 @@ package GNAT.Sockets.Thin is
function C_Sendmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t;
Flags : C.int) return System.CRTL.ssize_t;
function C_Sendto
(S : C.int;

8
gcc/ada/g-socthi-vxworks.adb
View File

@ -309,7 +309,7 @@ package body GNAT.Sockets.Thin is
function C_Recvmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t
Flags : C.int) return System.CRTL.ssize_t
is
Res : C.int;
@ -323,7 +323,7 @@ package body GNAT.Sockets.Thin is
delay Quantum;
end loop;
return ssize_t (Res);
return System.CRTL.ssize_t (Res);
end C_Recvmsg;
---------------
@ -333,7 +333,7 @@ package body GNAT.Sockets.Thin is
function C_Sendmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t
Flags : C.int) return System.CRTL.ssize_t
is
Res : C.int;
@ -347,7 +347,7 @@ package body GNAT.Sockets.Thin is
delay Quantum;
end loop;
return ssize_t (Res);
return System.CRTL.ssize_t (Res);
end C_Sendmsg;
--------------

10
gcc/ada/g-socthi-vxworks.ads
View File

@ -43,6 +43,7 @@ with GNAT.OS_Lib;
with GNAT.Sockets.Thin_Common;
with System;
with System.CRTL;
package GNAT.Sockets.Thin is
@ -50,10 +51,7 @@ package GNAT.Sockets.Thin is
package C renames Interfaces.C;
use type C.size_t;
type ssize_t is range -(2 ** (C.size_t'Size - 1))
.. +(2 ** (C.size_t'Size - 1) - 1);
-- Signed type of the same size as size_t
use type System.CRTL.ssize_t;
function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
-- Returns last socket error number
@ -147,7 +145,7 @@ package GNAT.Sockets.Thin is
function C_Recvmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t;
Flags : C.int) return System.CRTL.ssize_t;
function C_Select
(Nfds : C.int;
@ -159,7 +157,7 @@ package GNAT.Sockets.Thin is
function C_Sendmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t;
Flags : C.int) return System.CRTL.ssize_t;
function C_Sendto
(S : C.int;

16
gcc/ada/g-socthi.adb
View File

@ -95,13 +95,13 @@ package body GNAT.Sockets.Thin is
function Syscall_Recvmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t;
Flags : C.int) return System.CRTL.ssize_t;
pragma Import (C, Syscall_Recvmsg, "recvmsg");
function Syscall_Sendmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t;
Flags : C.int) return System.CRTL.ssize_t;
pragma Import (C, Syscall_Sendmsg, "sendmsg");
function Syscall_Sendto
@ -307,15 +307,15 @@ package body GNAT.Sockets.Thin is
function C_Recvmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t
Flags : C.int) return System.CRTL.ssize_t
is
Res : ssize_t;
Res : System.CRTL.ssize_t;
begin
loop
Res := Syscall_Recvmsg (S, Msg, Flags);
exit when SOSC.Thread_Blocking_IO
or else Res /= ssize_t (Failure)
or else Res /= System.CRTL.ssize_t (Failure)
or else Non_Blocking_Socket (S)
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;
@ -331,15 +331,15 @@ package body GNAT.Sockets.Thin is
function C_Sendmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t
Flags : C.int) return System.CRTL.ssize_t
is
Res : ssize_t;
Res : System.CRTL.ssize_t;
begin
loop
Res := Syscall_Sendmsg (S, Msg, Flags);
exit when SOSC.Thread_Blocking_IO
or else Res /= ssize_t (Failure)
or else Res /= System.CRTL.ssize_t (Failure)
or else Non_Blocking_Socket (S)
or else Errno /= SOSC.EWOULDBLOCK;
delay Quantum;

10
gcc/ada/g-socthi.ads
View File

@ -43,6 +43,7 @@ with GNAT.OS_Lib;
with GNAT.Sockets.Thin_Common;
with System;
with System.CRTL;
package GNAT.Sockets.Thin is
@ -54,10 +55,7 @@ package GNAT.Sockets.Thin is
package C renames Interfaces.C;
use type C.size_t;
type ssize_t is range -(2 ** (C.size_t'Size - 1))
.. +(2 ** (C.size_t'Size - 1) - 1);
-- Signed type of the same size as size_t
use type System.CRTL.ssize_t;
function Socket_Errno return Integer renames GNAT.OS_Lib.Errno;
-- Returns last socket error number
@ -148,7 +146,7 @@ package GNAT.Sockets.Thin is
function C_Recvmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t;
Flags : C.int) return System.CRTL.ssize_t;
function C_Select
(Nfds : C.int;
@ -160,7 +158,7 @@ package GNAT.Sockets.Thin is
function C_Sendmsg
(S : C.int;
Msg : System.Address;
Flags : C.int) return ssize_t;
Flags : C.int) return System.CRTL.ssize_t;
function C_Sendto
(S : C.int;

10
gcc/ada/gnat_rm.texi
View File

@ -3967,8 +3967,6 @@ inlining (-gnatN option set) are accepted and legality-checked
by the compiler, but are ignored at run-time even if postcondition
checking is enabled.
@node Pragma Profile (Ravenscar)
@unnumberedsec Pragma Profile (Ravenscar)
@findex Ravenscar
@ -5946,7 +5944,7 @@ end record;
@end smallexample
@noindent
will have a size of 40 (that is @code{Rec'Size} will be 40. The
will have a size of 40 (that is @code{Rec'Size} will be 40). The
alignment will be 4, because of the
integer field, and so the default size of record objects for this type
will be 64 (8 bytes).
@ -6575,7 +6573,6 @@ For example:
for Y'Address use X'Address;>>
@end smallexample
@sp 1
@cartouche
An implementation need not support a specification for the @code{Size}
@ -12225,8 +12222,6 @@ types are @code{Wide_Character} and @code{Wide_String} instead of
@code{Character} and @code{String}.
@end table
@node The Implementation of Standard I/O
@chapter The Implementation of Standard I/O
@ -15822,7 +15817,6 @@ If any of these conditions are violated, the aggregate will be built in
a temporary (created either by the front-end or the code generator) and then
that temporary will be copied onto the target.
@node The Size of Discriminated Records with Default Discriminants
@section The Size of Discriminated Records with Default Discriminants
@ -15939,7 +15933,6 @@ machines that are not fully compliant with this standard, such as Alpha, the
behavior (although at the cost of a significant performance penalty), so
infinite and and NaN values are properly generated.
@node Project File Reference
@chapter Project File Reference
@ -16647,7 +16640,6 @@ value is a path name that designates a file that contains configuration pragmas
to be used in every build of an executable. If both local and global
configuration pragmas are specified, a compilation makes use of both sets.
@item Executable
This is an associative array attribute. Its domain is
a set of main source file names. Its range is a simple string that specifies

6
gcc/ada/layout.adb
View File

@ -3119,11 +3119,7 @@ package body Layout is
Make_Func : Boolean := False) return Dynamic_SO_Ref
is
Loc : constant Source_Ptr := Sloc (Ins_Type);
K : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('K'));
K : constant Entity_Id := Make_Temporary (Loc, 'K');
Decl : Node_Id;
Vtype_Primary_View : Entity_Id;

12
gcc/ada/make.adb
View File

@ -2723,7 +2723,8 @@ package body Make is
Prj.Env.Set_Ada_Paths
(Arguments_Project,
Project_Tree,
Including_Libraries => True);
Including_Libraries => True,
Include_Path => Use_Include_Path_File);
if not Unique_Compile
and then MLib.Tgt.Support_For_Libraries /= Prj.None
@ -6026,7 +6027,8 @@ package body Make is
-- and all the object directories in ADA_OBJECTS_PATH,
-- except those of library projects.
Prj.Env.Set_Ada_Paths (Main_Project, Project_Tree, False);
Prj.Env.Set_Ada_Paths
(Main_Project, Project_Tree, Use_Include_Path_File);
-- If switch -C was specified, create a binder mapping file
@ -6253,7 +6255,11 @@ package body Make is
-- Put the object directories in ADA_OBJECTS_PATH
Prj.Env.Set_Ada_Paths (Main_Project, Project_Tree, False);
Prj.Env.Set_Ada_Paths
(Main_Project,
Project_Tree,
Including_Libraries => False,
Include_Path => False);
-- Check for attributes Linker'Linker_Options in projects
-- other than the main project

5
gcc/ada/opt.ads
View File

@ -1229,6 +1229,11 @@ package Opt is
-- set True, and upper half characters in the source indicate the start of
-- a wide character sequence. Set by -gnatW or -W switches.
Use_Include_Path_File : Boolean := False;
-- GNATMAKE, GPRBUILD
-- When True, create a source search path file, even when a mapping file
-- is used.
Usage_Requested : Boolean := False;
-- GNAT, GNATBIND, GNATMAKE
-- Set to True if -h (-gnath for the compiler) switch encountered

57
gcc/ada/prj-env.adb
View File

@ -1498,7 +1498,9 @@ package body Prj.Env is
procedure Set_Ada_Paths
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean)
Including_Libraries : Boolean;
Include_Path : Boolean := True;
Objects_Path : Boolean := True)
is
Source_Paths : Source_Path_Table.Instance;
@ -1570,7 +1572,7 @@ package body Prj.Env is
-- If it is the first time we call this procedure for this project,
-- compute the source path and/or the object path.
if Project.Include_Path_File = No_Path then
if Include_Path and then Project.Include_Path_File = No_Path then
Source_Path_Table.Init (Source_Paths);
Process_Source_Dirs := True;
Create_New_Path_File
@ -1580,7 +1582,7 @@ package body Prj.Env is
-- For the object path, we make a distinction depending on
-- Including_Libraries.
if Including_Libraries then
if Objects_Path and Including_Libraries then
if Project.Objects_Path_File_With_Libs = No_Path then
Object_Path_Table.Init (Object_Paths);
Process_Object_Dirs := True;
@ -1588,7 +1590,7 @@ package body Prj.Env is
(In_Tree, Object_FD, Project.Objects_Path_File_With_Libs);
end if;
else
elsif Objects_Path then
if Project.Objects_Path_File_Without_Libs = No_Path then
Object_Path_Table.Init (Object_Paths);
Process_Object_Dirs := True;
@ -1662,7 +1664,8 @@ package body Prj.Env is
-- Set the env vars, if they need to be changed, and set the
-- corresponding flags.
if In_Tree.Private_Part.Current_Source_Path_File /=
if Include_Path and then
In_Tree.Private_Part.Current_Source_Path_File /=
Project.Include_Path_File
then
In_Tree.Private_Part.Current_Source_Path_File :=
@ -1672,28 +1675,30 @@ package body Prj.Env is
Get_Name_String (In_Tree.Private_Part.Current_Source_Path_File));
end if;
if Including_Libraries then
if In_Tree.Private_Part.Current_Object_Path_File /=
Project.Objects_Path_File_With_Libs
then
In_Tree.Private_Part.Current_Object_Path_File :=
Project.Objects_Path_File_With_Libs;
Set_Path_File_Var
(Project_Objects_Path_File,
Get_Name_String
(In_Tree.Private_Part.Current_Object_Path_File));
end if;
if Objects_Path then
if Including_Libraries then
if In_Tree.Private_Part.Current_Object_Path_File /=
Project.Objects_Path_File_With_Libs
then
In_Tree.Private_Part.Current_Object_Path_File :=
Project.Objects_Path_File_With_Libs;
Set_Path_File_Var
(Project_Objects_Path_File,
Get_Name_String
(In_Tree.Private_Part.Current_Object_Path_File));
end if;
else
if In_Tree.Private_Part.Current_Object_Path_File /=
Project.Objects_Path_File_Without_Libs
then
In_Tree.Private_Part.Current_Object_Path_File :=
Project.Objects_Path_File_Without_Libs;
Set_Path_File_Var
(Project_Objects_Path_File,
Get_Name_String
(In_Tree.Private_Part.Current_Object_Path_File));
else
if In_Tree.Private_Part.Current_Object_Path_File /=
Project.Objects_Path_File_Without_Libs
then
In_Tree.Private_Part.Current_Object_Path_File :=
Project.Objects_Path_File_Without_Libs;
Set_Path_File_Var
(Project_Objects_Path_File,
Get_Name_String
(In_Tree.Private_Part.Current_Object_Path_File));
end if;
end if;
end if;

4
gcc/ada/prj-env.ads
View File

@ -94,7 +94,9 @@ package Prj.Env is
procedure Set_Ada_Paths
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
Including_Libraries : Boolean);
Including_Libraries : Boolean;
Include_Path : Boolean := True;
Objects_Path : Boolean := True);
-- Set the environment variables for additional project path files, after
-- creating the path files if necessary.

65
gcc/ada/prj-proc.adb
View File

@ -87,15 +87,15 @@ package body Prj.Proc is
-- based languages)
procedure Copy_Package_Declarations
(From : Declarations;
To : in out Declarations;
New_Loc : Source_Ptr;
Naming_Restricted : Boolean;
In_Tree : Project_Tree_Ref);
(From : Declarations;
To : in out Declarations;
New_Loc : Source_Ptr;
Restricted : Boolean;
In_Tree : Project_Tree_Ref);
-- Copy a package declaration From to To for a renamed package. Change the
-- locations of all the attributes to New_Loc. When Naming_Restricted is
-- True, do not copy attributes Body, Spec, Implementation and
-- Specification.
-- locations of all the attributes to New_Loc. When Restricted is
-- True, do not copy attributes Body, Spec, Implementation, Specification
-- and Linker_Options.
function Expression
(Project : Project_Id;
@ -314,11 +314,11 @@ package body Prj.Proc is
-------------------------------
procedure Copy_Package_Declarations
(From : Declarations;
To : in out Declarations;
New_Loc : Source_Ptr;
Naming_Restricted : Boolean;
In_Tree : Project_Tree_Ref)
(From : Declarations;
To : in out Declarations;
New_Loc : Source_Ptr;
Restricted : Boolean;
In_Tree : Project_Tree_Ref)
is
V1 : Variable_Id;
V2 : Variable_Id := No_Variable;
@ -346,6 +346,12 @@ package body Prj.Proc is
Var := In_Tree.Variable_Elements.Table (V1);
V1 := Var.Next;
-- Do not copy the value of attribute inker_Options if Restricted
if Restricted and then Var.Name = Snames.Name_Linker_Options then
Var.Value.Values := Nil_String;
end if;
-- Remove the Next component
Var.Next := No_Variable;
@ -376,16 +382,16 @@ package body Prj.Proc is
Arr := In_Tree.Arrays.Table (A1);
A1 := Arr.Next;
if not Naming_Restricted or else
(Arr.Name /= Snames.Name_Body
and then Arr.Name /= Snames.Name_Spec
and then Arr.Name /= Snames.Name_Implementation
and then Arr.Name /= Snames.Name_Specification)
if not Restricted
or else
(Arr.Name /= Snames.Name_Body and then
Arr.Name /= Snames.Name_Spec and then
Arr.Name /= Snames.Name_Implementation and then
Arr.Name /= Snames.Name_Specification)
then
-- Remove the Next component
Arr.Next := No_Array;
Array_Table.Increment_Last (In_Tree.Arrays);
-- Create new Array declaration
@ -1445,15 +1451,15 @@ package body Prj.Proc is
-- renaming declaration.
Copy_Package_Declarations
(From =>
(From =>
In_Tree.Packages.Table (Renamed_Package).Decl,
To =>
To =>
In_Tree.Packages.Table (New_Pkg).Decl,
New_Loc =>
New_Loc =>
Location_Of
(Current_Item, From_Project_Node_Tree),
Naming_Restricted => False,
In_Tree => In_Tree);
Restricted => False,
In_Tree => In_Tree);
end;
-- Standard package declaration, not renaming
@ -2621,13 +2627,12 @@ package body Prj.Proc is
Next => Project.Decl.Packages);
Project.Decl.Packages := Current_Pkg;
Copy_Package_Declarations
(From => Element.Decl,
To =>
(From => Element.Decl,
To =>
In_Tree.Packages.Table (Current_Pkg).Decl,
New_Loc => No_Location,
Naming_Restricted =>
Element.Name = Snames.Name_Naming,
In_Tree => In_Tree);
New_Loc => No_Location,
Restricted => True,
In_Tree => In_Tree);
end if;
Extended_Pkg := Element.Next;

7
gcc/ada/s-crtl.ads
View File

@ -59,6 +59,9 @@ package System.CRTL is
type size_t is mod 2 ** Standard'Address_Size;
type ssize_t is range -(2 ** (Standard'Address_Size - 1))
.. +(2 ** (Standard'Address_Size - 1)) - 1;
type Filename_Encoding is (UTF8, ASCII_8bits, Unspecified);
for Filename_Encoding use (UTF8 => 0, ASCII_8bits => 1, Unspecified => 2);
pragma Convention (C, Filename_Encoding);
@ -187,10 +190,10 @@ package System.CRTL is
function close (fd : int) return int;
pragma Import (C, close, "close");
function read (fd : int; buffer : chars; nbytes : int) return int;
function read (fd : int; buffer : chars; count : size_t) return ssize_t;
pragma Import (C, read, "read");
function write (fd : int; buffer : chars; nbytes : int) return int;
function write (fd : int; buffer : chars; count : size_t) return ssize_t;
pragma Import (C, write, "write");
end System.CRTL;

14
gcc/ada/s-os_lib.adb
View File

@ -2309,8 +2309,11 @@ package body System.OS_Lib is
N : Integer) return Integer
is
begin
return Integer (System.CRTL.read
(System.CRTL.int (FD), System.CRTL.chars (A), System.CRTL.int (N)));
return
Integer (System.CRTL.read
(System.CRTL.int (FD),
System.CRTL.chars (A),
System.CRTL.size_t (N)));
end Read;
-----------------
@ -2718,8 +2721,11 @@ package body System.OS_Lib is
N : Integer) return Integer
is
begin
return Integer (System.CRTL.write
(System.CRTL.int (FD), System.CRTL.chars (A), System.CRTL.int (N)));
return
Integer (System.CRTL.write
(System.CRTL.int (FD),
System.CRTL.chars (A),
System.CRTL.size_t (N)));
end Write;
end System.OS_Lib;

5
gcc/ada/s-tasdeb.adb
View File

@ -362,10 +362,11 @@ package body System.Tasking.Debug is
-----------
procedure Write (Fd : Integer; S : String; Count : Integer) is
Discard : Integer;
Discard : System.CRTL.ssize_t;
pragma Unreferenced (Discard);
begin
Discard := System.CRTL.write (Fd, S (S'First)'Address, Count);
Discard := System.CRTL.write (Fd, S (S'First)'Address,
System.CRTL.size_t (Count));
-- Is it really right to ignore write errors here ???
end Write;

1
gcc/ada/switch-m.adb
View File

@ -839,6 +839,7 @@ package body Switch.M is
when 'x' =>
External_Unit_Compilation_Allowed := True;
Use_Include_Path_File := True;
-- Processing for z switch