diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 79 | ||||
| -rw-r--r-- | gcc/ada/exp_ch11.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/exp_disp.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/exp_smem.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/g-sercom-linux.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/g-socthi-mingw.adb | 48 | ||||
| -rw-r--r-- | gcc/ada/g-socthi-mingw.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/g-socthi-vms.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/g-socthi-vms.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/g-socthi-vxworks.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/g-socthi-vxworks.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/g-socthi.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/g-socthi.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/gnat_rm.texi | 10 | ||||
| -rw-r--r-- | gcc/ada/layout.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/prj-env.adb | 57 | ||||
| -rw-r--r-- | gcc/ada/prj-env.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/prj-proc.adb | 65 | ||||
| -rw-r--r-- | gcc/ada/s-crtl.ads | 7 | ||||
| -rwxr-xr-x | gcc/ada/s-os_lib.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/s-tasdeb.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/switch-m.adb | 1 |
28 files changed, 266 insertions, 194 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index edf856f..9a028fd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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. diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 0c54478..fb458a6 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -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); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 5272f06..5c2ee82 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -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); diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 46eb51e..49a0a0f 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -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 diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 9957514..66ab813 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -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; diff --git a/gcc/ada/exp_smem.adb b/gcc/ada/exp_smem.adb index 6cbca26..f2cbfd0 100644 --- a/gcc/ada/exp_smem.adb +++ b/gcc/ada/exp_smem.adb @@ -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 diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 5a11220..07771c8 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -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 diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 0f126cf..553a80a 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -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, diff --git a/gcc/ada/g-sercom-linux.adb b/gcc/ada/g-sercom-linux.adb index a89b09b..3432f86 100644 --- a/gcc/ada/g-sercom-linux.adb +++ b/gcc/ada/g-sercom-linux.adb @@ -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; ----------- diff --git a/gcc/ada/g-socthi-mingw.adb b/gcc/ada/g-socthi-mingw.adb index 49df163..ba4a3de 100644 --- a/gcc/ada/g-socthi-mingw.adb +++ b/gcc/ada/g-socthi-mingw.adb @@ -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; -------------- diff --git a/gcc/ada/g-socthi-mingw.ads b/gcc/ada/g-socthi-mingw.ads index 6d851e1..bc1f256 100644 --- a/gcc/ada/g-socthi-mingw.ads +++ b/gcc/ada/g-socthi-mingw.ads @@ -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; diff --git a/gcc/ada/g-socthi-vms.adb b/gcc/ada/g-socthi-vms.adb index b9e23ec..1331821 100644 --- a/gcc/ada/g-socthi-vms.adb +++ b/gcc/ada/g-socthi-vms.adb @@ -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; -------------- diff --git a/gcc/ada/g-socthi-vms.ads b/gcc/ada/g-socthi-vms.ads index a1bb487..3a443ac 100644 --- a/gcc/ada/g-socthi-vms.ads +++ b/gcc/ada/g-socthi-vms.ads @@ -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; diff --git a/gcc/ada/g-socthi-vxworks.adb b/gcc/ada/g-socthi-vxworks.adb index e6a8ee6..8c11966 100644 --- a/gcc/ada/g-socthi-vxworks.adb +++ b/gcc/ada/g-socthi-vxworks.adb @@ -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; -------------- diff --git a/gcc/ada/g-socthi-vxworks.ads b/gcc/ada/g-socthi-vxworks.ads index 4f92b3a..64cc876 100644 --- a/gcc/ada/g-socthi-vxworks.ads +++ b/gcc/ada/g-socthi-vxworks.ads @@ -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; diff --git a/gcc/ada/g-socthi.adb b/gcc/ada/g-socthi.adb index ca79763..301d8be 100644 --- a/gcc/ada/g-socthi.adb +++ b/gcc/ada/g-socthi.adb @@ -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; diff --git a/gcc/ada/g-socthi.ads b/gcc/ada/g-socthi.ads index 1f103e8..32013c3 100644 --- a/gcc/ada/g-socthi.ads +++ b/gcc/ada/g-socthi.ads @@ -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; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 7f7e179..99811c7 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -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 diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index c850ab0..6ccef51 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -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; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 0e3c857..82d4e9f 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -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 diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 90b4459..562e6ab 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -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 diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index f7fc668..39bda01 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -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; diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 27259c2..9dcde32 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -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. diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 57bfe51..5859a8a 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -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; diff --git a/gcc/ada/s-crtl.ads b/gcc/ada/s-crtl.ads index 7d5f110..345e9a5 100644 --- a/gcc/ada/s-crtl.ads +++ b/gcc/ada/s-crtl.ads @@ -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; diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index f734136..c7ca149 100755 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -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; diff --git a/gcc/ada/s-tasdeb.adb b/gcc/ada/s-tasdeb.adb index 9fb0cd6..ccc81d9 100644 --- a/gcc/ada/s-tasdeb.adb +++ b/gcc/ada/s-tasdeb.adb @@ -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; diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb index a7a8d19..49c624a 100644 --- a/gcc/ada/switch-m.adb +++ b/gcc/ada/switch-m.adb @@ -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 |