+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.
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);
-- 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);
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;
-- 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
-- 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
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;
-- --
-- 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- --
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
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;
-- 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
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,
-- involve secondary stack expansion.
else
- Dnam :=
- Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
+ Dnam := Make_Temporary (Loc, 'D');
Dbody :=
Make_Subprogram_Body (Loc,
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
(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
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;
-----------
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;
-- 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;
--------------
-- 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
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;
-- 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;
--------------
with GNAT.Sockets.Thin_Common;
with System;
+with System.CRTL;
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
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;
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;
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;
GNAT_Msg := Msghdr (VMS_Msg);
- return ssize_t (Res);
+ return System.CRTL.ssize_t (Res);
end C_Recvmsg;
---------------
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;
GNAT_Msg := Msghdr (VMS_Msg);
- return ssize_t (Res);
+ return System.CRTL.ssize_t (Res);
end C_Sendmsg;
--------------
with GNAT.Sockets.Thin_Common;
with System;
+with System.CRTL;
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
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;
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;
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;
delay Quantum;
end loop;
- return ssize_t (Res);
+ return System.CRTL.ssize_t (Res);
end C_Recvmsg;
---------------
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;
delay Quantum;
end loop;
- return ssize_t (Res);
+ return System.CRTL.ssize_t (Res);
end C_Sendmsg;
--------------
with GNAT.Sockets.Thin_Common;
with System;
+with System.CRTL;
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
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;
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;
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
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;
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;
with GNAT.Sockets.Thin_Common;
with System;
+with System.CRTL;
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
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;
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;
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
@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).
for Y'Address use X'Address;>>
@end smallexample
-
@sp 1
@cartouche
An implementation need not support a specification for the @code{Size}
@code{Character} and @code{String}.
@end table
-
-
@node The Implementation of Standard I/O
@chapter The Implementation of Standard I/O
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
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
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
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;
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
-- 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
-- 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
-- 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
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;
-- 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
-- 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;
(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;
-- 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 :=
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;
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.
-- 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;
-------------------------------
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;
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;
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
-- 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
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;
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);
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;
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;
-----------------
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;
-----------
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;
when 'x' =>
External_Unit_Compilation_Allowed := True;
+ Use_Include_Path_File := True;
-- Processing for z switch
projects / platform / upstream / gcc.git / commitdiff