[multiple changes]
2010-01-25 Bob Duff <duff@adacore.com> * sem_aggr.adb (Resolve_Array_Aggregate): Check for the case where this is an internally-generated positional aggregate, and the bounds are already correctly set. We don't want to overwrite those bounds with bounds determined by context. 2010-01-25 Robert Dewar <dewar@adacore.com> * g-sercom.ads, gnatcmd.adb, gnatlink.adb, a-ststio.adb, exp_ch6.adb, exp_ch9.adb, g-sechas.ads: Minor reformatting. 2010-01-25 Thomas Quinot <quinot@adacore.com> * s-commun.adb (Last_Index): Count must be converted to SEO (a signed integer type) before subtracting 1, otherwise the computation may wrap (because size_t is modular) and cause the conversion to fail. 2010-01-25 Ed Falis <falis@adacore.com> * sysdep.c, init.c: Adapt to support full run-time on VxWorks MILS. 2010-01-25 Vincent Celier <celier@adacore.com> * prj-attr.adb: New attribute Run_Path_Origin_Required * prj-nmsc.adb (Process_Project_Level_Simple_Attributes): Process new attribute Run_Path_Origin_Required. * prj.ads (Project_Configuration): New component Run_Path_Origin_Supported. * snames.ads-tmpl: New standard name Run_Path_Origin_Required From-SVN: r156215
This commit is contained in:
Arnaud Charlet
parent
03d838ba03
commit
3d92367153
@ -29,7 +29,7 @@
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Interfaces.C_Streams; use Interfaces.C_Streams;
|
||||
with Interfaces.C_Streams; use Interfaces.C_Streams;
|
||||
|
||||
with System; use System;
|
||||
with System.Communication; use System.Communication;
|
||||
|
||||
@ -4506,14 +4506,12 @@ package body Exp_Ch6 is
|
||||
-- Create protected operation as well. Even though the operation
|
||||
-- is only accessible within the body, it is possible to make it
|
||||
-- available outside of the protected object by using 'Access to
|
||||
-- provide a callback, so we build the protected version in all
|
||||
-- cases.
|
||||
-- provide a callback, so build protected version in all cases.
|
||||
|
||||
Prot_Decl :=
|
||||
Make_Subprogram_Declaration (Loc,
|
||||
Specification =>
|
||||
Build_Protected_Sub_Specification
|
||||
(N, Scop, Protected_Mode));
|
||||
Make_Subprogram_Declaration (Loc,
|
||||
Specification =>
|
||||
Build_Protected_Sub_Specification (N, Scop, Protected_Mode));
|
||||
Insert_Before (Prot_Bod, Prot_Decl);
|
||||
Analyze (Prot_Decl);
|
||||
|
||||
|
||||
@ -2602,13 +2602,12 @@ package body Exp_Ch9 is
|
||||
else
|
||||
New_Spec :=
|
||||
Make_Function_Specification (Loc,
|
||||
Defining_Unit_Name =>
|
||||
Make_Defining_Identifier (Sloc (Body_Id),
|
||||
Chars => Chars (Body_Id)),
|
||||
Parameter_Specifications =>
|
||||
Plist,
|
||||
Result_Definition =>
|
||||
New_Occurrence_Of (Etype (Body_Id), Loc));
|
||||
Defining_Unit_Name =>
|
||||
Make_Defining_Identifier (Sloc (Body_Id),
|
||||
Chars => Chars (Body_Id)),
|
||||
Parameter_Specifications => Plist,
|
||||
Result_Definition =>
|
||||
New_Occurrence_Of (Etype (Body_Id), Loc));
|
||||
end if;
|
||||
|
||||
Decl := Make_Subprogram_Declaration (Loc, Specification => New_Spec);
|
||||
|
||||
@ -134,11 +134,10 @@ package GNAT.Secure_Hashes is
|
||||
-- The internal processing state of the hashing function
|
||||
|
||||
function "=" (L, R : Context) return Boolean is abstract;
|
||||
-- Context is the internal, implementation defined state of an
|
||||
-- intermediate state in a hash computation, and no specific semantics
|
||||
-- can be expected on equality of context values. Only equality of
|
||||
-- final hash values (as returned by the [Wide_]Digest functions below)
|
||||
-- is meaningful.
|
||||
-- Context is the internal, implementation defined intermediate state
|
||||
-- in a hash computation, and no specific semantics can be expected on
|
||||
-- equality of context values. Only equality of final hash values (as
|
||||
-- returned by the [Wide_]Digest functions below) is meaningful.
|
||||
|
||||
Initial_Context : constant Context;
|
||||
-- Initial value of a Context object. May be used to reinitialize
|
||||
|
||||
@ -92,8 +92,8 @@ package GNAT.Serial_Communications is
|
||||
Last : out Ada.Streams.Stream_Element_Offset);
|
||||
-- Read a set of bytes, put result into Buffer and set Last accordingly.
|
||||
-- Last is set to Buffer'First - 1 if no byte has been read, unless
|
||||
-- Buffer'First = Stream_Element_Offset'First, in which case
|
||||
-- Constraint_Error raised instead.
|
||||
-- Buffer'First = Stream_Element_Offset'First, in which case the exception
|
||||
-- Constraint_Error is raised instead.
|
||||
|
||||
overriding procedure Write
|
||||
(Port : in out Serial_Port;
|
||||
|
||||
@ -579,7 +579,7 @@ procedure GNATCmd is
|
||||
Add_Char_To_Name_Buffer ('"');
|
||||
Add_Str_To_Name_Buffer
|
||||
(Get_Name_String
|
||||
(Unit.File_Names (Kind).Path.Display_Name));
|
||||
(Unit.File_Names (Kind).Path.Display_Name));
|
||||
Add_Char_To_Name_Buffer ('"');
|
||||
|
||||
if FD /= Invalid_FD then
|
||||
|
||||
@ -1166,8 +1166,11 @@ procedure Gnatlink is
|
||||
Last := Nlast;
|
||||
end if;
|
||||
|
||||
-- Given a Gnat standard library, search the
|
||||
-- library path to find the library location
|
||||
-- Given a Gnat standard library, search the library path to
|
||||
-- find the library location.
|
||||
|
||||
-- Shouldn't we abstract a proc here, we are getting awfully
|
||||
-- heavily nested ???
|
||||
|
||||
declare
|
||||
File_Path : String_Access;
|
||||
@ -1204,16 +1207,17 @@ procedure Gnatlink is
|
||||
|
||||
elsif GNAT_Shared then
|
||||
if Opt.Run_Path_Option then
|
||||
|
||||
-- If shared gnatlib desired, add the
|
||||
-- appropriate system specific switch
|
||||
-- so that it can be located at runtime.
|
||||
|
||||
if Run_Path_Opt'Length /= 0 then
|
||||
|
||||
-- Output the system specific linker command
|
||||
-- that allows the image activator to find
|
||||
-- the shared library at runtime.
|
||||
-- Also add path to find libgcc_s.so, if
|
||||
-- relevant.
|
||||
-- the shared library at runtime. Also add
|
||||
-- path to find libgcc_s.so, if relevant.
|
||||
|
||||
declare
|
||||
Path : String (1 .. File_Path'Length + 15);
|
||||
@ -1235,6 +1239,7 @@ procedure Gnatlink is
|
||||
Index (Path (1 .. Path_Last), "gcc-lib");
|
||||
|
||||
if GCC_Index /= 0 then
|
||||
|
||||
-- The shared version of libgcc is
|
||||
-- located in the parent directory.
|
||||
|
||||
@ -1282,11 +1287,11 @@ procedure Gnatlink is
|
||||
Linker_Options.Increment_Last;
|
||||
Linker_Options.Table
|
||||
(Linker_Options.Last) :=
|
||||
new String'
|
||||
(Run_Path_Opt
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length));
|
||||
new String'
|
||||
(Run_Path_Opt
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length));
|
||||
|
||||
if GCC_Index /= 0 then
|
||||
Linker_Options.Increment_Last;
|
||||
@ -1296,6 +1301,7 @@ procedure Gnatlink is
|
||||
(Run_Path_Opt
|
||||
& Path (1 .. GCC_Index));
|
||||
end if;
|
||||
|
||||
else
|
||||
for J in reverse
|
||||
1 .. Linker_Options.Last
|
||||
@ -1303,13 +1309,13 @@ procedure Gnatlink is
|
||||
if Linker_Options.Table (J) /= null
|
||||
and then
|
||||
Linker_Options.Table (J)'Length
|
||||
> Run_Path_Opt'Length
|
||||
> Run_Path_Opt'Length
|
||||
and then
|
||||
Linker_Options.Table (J)
|
||||
(1 .. Run_Path_Opt'Length) =
|
||||
Run_Path_Opt
|
||||
(1 .. Run_Path_Opt'Length) =
|
||||
Run_Path_Opt
|
||||
then
|
||||
-- We have found a already
|
||||
-- We have found an already
|
||||
-- specified run_path_option: we
|
||||
-- will add to this switch,
|
||||
-- because only one
|
||||
@ -1332,47 +1338,48 @@ procedure Gnatlink is
|
||||
if Run_Path_Opt_Index = 0 then
|
||||
Linker_Options.Table
|
||||
(Linker_Options.Last) :=
|
||||
new String'
|
||||
(Run_Path_Opt
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length));
|
||||
new String'
|
||||
(Run_Path_Opt
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length));
|
||||
|
||||
else
|
||||
Linker_Options.Table
|
||||
(Run_Path_Opt_Index) :=
|
||||
new String'
|
||||
(Linker_Options.Table
|
||||
(Run_Path_Opt_Index).all
|
||||
& Path_Separator
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length));
|
||||
new String'
|
||||
(Linker_Options.Table
|
||||
(Run_Path_Opt_Index).all
|
||||
& Path_Separator
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length));
|
||||
end if;
|
||||
|
||||
else
|
||||
if Run_Path_Opt_Index = 0 then
|
||||
Linker_Options.Table
|
||||
(Linker_Options.Last) :=
|
||||
new String'(Run_Path_Opt
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length)
|
||||
& Path_Separator
|
||||
& Path (1 .. GCC_Index));
|
||||
new String'
|
||||
(Run_Path_Opt
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length)
|
||||
& Path_Separator
|
||||
& Path (1 .. GCC_Index));
|
||||
|
||||
else
|
||||
Linker_Options.Table
|
||||
(Run_Path_Opt_Index) :=
|
||||
new String'
|
||||
(Linker_Options.Table
|
||||
(Run_Path_Opt_Index).all
|
||||
& Path_Separator
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length)
|
||||
& Path_Separator
|
||||
& Path (1 .. GCC_Index));
|
||||
new String'
|
||||
(Linker_Options.Table
|
||||
(Run_Path_Opt_Index).all
|
||||
& Path_Separator
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length)
|
||||
& Path_Separator
|
||||
& Path (1 .. GCC_Index));
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
@ -1490,10 +1497,9 @@ procedure Gnatlink is
|
||||
-- Start of processing for Gnatlink
|
||||
|
||||
begin
|
||||
-- Add the directory where gnatlink is invoked in front of the
|
||||
-- path, if gnatlink is invoked with directory information.
|
||||
-- Only do this if the platform is not VMS, where the notion of path
|
||||
-- does not really exist.
|
||||
-- Add the directory where gnatlink is invoked in front of the path, if
|
||||
-- gnatlink is invoked with directory information. Only do this if the
|
||||
-- platform is not VMS, where the notion of path does not really exist.
|
||||
|
||||
if not Hostparm.OpenVMS then
|
||||
declare
|
||||
@ -1507,10 +1513,10 @@ begin
|
||||
Normalize_Pathname
|
||||
(Command (Command'First .. Index));
|
||||
|
||||
PATH : constant String :=
|
||||
Absolute_Dir &
|
||||
Path_Separator &
|
||||
Getenv ("PATH").all;
|
||||
PATH : constant String :=
|
||||
Absolute_Dir &
|
||||
Path_Separator &
|
||||
Getenv ("PATH").all;
|
||||
|
||||
begin
|
||||
Setenv ("PATH", PATH);
|
||||
@ -1525,8 +1531,7 @@ begin
|
||||
Process_Args;
|
||||
|
||||
if Argument_Count = 0
|
||||
or else
|
||||
(Verbose_Mode and then Argument_Count = 1)
|
||||
or else (Verbose_Mode and then Argument_Count = 1)
|
||||
then
|
||||
Write_Usage;
|
||||
Exit_Program (E_Fatal);
|
||||
@ -1552,10 +1557,10 @@ begin
|
||||
Exit_With_Error (Ali_File_Name.all & " not found");
|
||||
end if;
|
||||
|
||||
-- Read the ALI file of the main subprogram if the binder generated
|
||||
-- file needs to be compiled and no --GCC= switch has been specified.
|
||||
-- Fetch the back end switches from this ALI file and use these switches
|
||||
-- to compile the binder generated file
|
||||
-- Read the ALI file of the main subprogram if the binder generated file
|
||||
-- needs to be compiled and no --GCC= switch has been specified. Fetch the
|
||||
-- back end switches from this ALI file and use these switches to compile
|
||||
-- the binder generated file
|
||||
|
||||
if Compile_Bind_File and then Standard_Gcc then
|
||||
|
||||
@ -1614,8 +1619,8 @@ begin
|
||||
:= String_Access (Arg);
|
||||
end if;
|
||||
|
||||
-- Set the RTS_*_Path_Name variables, so that the
|
||||
-- correct directories will be set when
|
||||
-- Set the RTS_*_Path_Name variables, so that
|
||||
-- the correct directories will be set when
|
||||
-- Osint.Add_Default_Search_Dirs will be called later.
|
||||
|
||||
Opt.RTS_Src_Path_Name :=
|
||||
|
||||
103
gcc/ada/init.c
103
gcc/ada/init.c
@ -310,8 +310,7 @@ __gnat_adjust_context_for_raise (int signo, void *ucontext)
|
||||
}
|
||||
|
||||
static void
|
||||
__gnat_error_handler
|
||||
(int sig, siginfo_t *sip, struct sigcontext *context)
|
||||
__gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
|
||||
{
|
||||
struct Exception_Data *exception;
|
||||
static int recurse = 0;
|
||||
@ -582,7 +581,11 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
|
||||
{
|
||||
mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
|
||||
|
||||
/* On the i386 and x86-64 architectures, stack checking is performed by
|
||||
/* On the i386 and x86-64 architectures, we specifically detect calls to
|
||||
the null address and entirely fold the not-yet-fully-established frame
|
||||
to prevent it from stopping the unwinding.
|
||||
|
||||
On the i386 and x86-64 architectures, stack checking is performed by
|
||||
means of probes with moving stack pointer, that is to say the probed
|
||||
address is always the value of the stack pointer. Upon hitting the
|
||||
guard page, the stack pointer therefore points to an inaccessible
|
||||
@ -602,13 +605,25 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
|
||||
|
||||
#if defined (i386)
|
||||
unsigned long *pc = (unsigned long *)mcontext->gregs[REG_EIP];
|
||||
/* The call insn pushes the return address onto the stack. Pop it. */
|
||||
if (pc == NULL)
|
||||
{
|
||||
mcontext->gregs[REG_EIP] = *(unsigned long *)mcontext->gregs[REG_ESP];
|
||||
mcontext->gregs[REG_ESP] += 4;
|
||||
}
|
||||
/* The pattern is "orl $0x0,(%esp)" for a probe in 32-bit mode. */
|
||||
if (signo == SIGSEGV && pc && *pc == 0x00240c83)
|
||||
else if (signo == SIGSEGV && *pc == 0x00240c83)
|
||||
mcontext->gregs[REG_ESP] += 4096 + 4 * sizeof (unsigned long);
|
||||
#elif defined (__x86_64__)
|
||||
unsigned long *pc = (unsigned long *)mcontext->gregs[REG_RIP];
|
||||
/* The call insn pushes the return address onto the stack. Pop it. */
|
||||
if (pc == NULL)
|
||||
{
|
||||
mcontext->gregs[REG_RIP] = *(unsigned long *)mcontext->gregs[REG_RSP];
|
||||
mcontext->gregs[REG_RSP] += 8;
|
||||
}
|
||||
/* The pattern is "orq $0x0,(%rsp)" for a probe in 64-bit mode. */
|
||||
if (signo == SIGSEGV && pc && (*pc & 0xffffffffff) == 0x00240c8348)
|
||||
else if (signo == SIGSEGV && (*pc & 0xffffffffff) == 0x00240c8348)
|
||||
mcontext->gregs[REG_RSP] += 4096 + 4 * sizeof (unsigned long);
|
||||
#elif defined (__ia64__)
|
||||
/* ??? The IA-64 unwinder doesn't compensate for signals. */
|
||||
@ -624,8 +639,12 @@ __gnat_error_handler (int sig,
|
||||
void *ucontext)
|
||||
{
|
||||
struct Exception_Data *exception;
|
||||
const char *msg;
|
||||
static int recurse = 0;
|
||||
const char *msg;
|
||||
|
||||
/* Adjusting is required for every fault context, so adjust for this one
|
||||
now, before we possibly trigger a recursive fault below. */
|
||||
__gnat_adjust_context_for_raise (sig, ucontext);
|
||||
|
||||
switch (sig)
|
||||
{
|
||||
@ -682,14 +701,8 @@ __gnat_error_handler (int sig,
|
||||
exception = &program_error;
|
||||
msg = "unhandled signal";
|
||||
}
|
||||
|
||||
recurse = 0;
|
||||
|
||||
/* We adjust the interrupted context here (and not in the fallback
|
||||
unwinding routine) because recent versions of the Native POSIX
|
||||
Thread Library (NPTL) are compiled with unwind information, so
|
||||
the fallback routine is never executed for signal frames. */
|
||||
__gnat_adjust_context_for_raise (sig, ucontext);
|
||||
|
||||
Raise_From_Signal_Handler (exception, msg);
|
||||
}
|
||||
|
||||
@ -997,28 +1010,55 @@ __gnat_install_handler(void)
|
||||
/* Likewise regarding how the "instruction pointer" register slot can
|
||||
be identified in signal machine contexts. We have either "REG_PC"
|
||||
or "PC" at hand, depending on the target CPU and Solaris version. */
|
||||
|
||||
#if !defined (REG_PC)
|
||||
#define REG_PC PC
|
||||
#endif
|
||||
|
||||
static void __gnat_error_handler (int, siginfo_t *, ucontext_t *);
|
||||
static void __gnat_error_handler (int, siginfo_t *, void *);
|
||||
|
||||
#define HAVE_GNAT_ADJUST_CONTEXT_FOR_RAISE
|
||||
|
||||
void
|
||||
__gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
|
||||
{
|
||||
mcontext_t *mcontext = &((ucontext_t *) ucontext)->uc_mcontext;
|
||||
unsigned long *pc = (unsigned long *)mcontext->gregs[REG_PC];
|
||||
|
||||
/* We specifically detect calls to the null address and entirely fold
|
||||
the not-yet-fully-established frame to prevent it from stopping the
|
||||
unwinding. */
|
||||
if (pc == NULL)
|
||||
#if defined (__sparc)
|
||||
/* The call insn moves the return address into %o7. Move it back. */
|
||||
mcontext->gregs[REG_PC] = mcontext->gregs[REG_O7];
|
||||
#elif defined (i386)
|
||||
{
|
||||
/* The call insn pushes the return address onto the stack. Pop it. */
|
||||
mcontext->gregs[REG_PC] = *(unsigned long *)mcontext->gregs[UESP];
|
||||
mcontext->gregs[UESP] += 4;
|
||||
}
|
||||
#elif defined (__x86_64__)
|
||||
{
|
||||
/* The call insn pushes the return address onto the stack. Pop it. */
|
||||
mcontext->gregs[REG_PC] = *(unsigned long *)mcontext->gregs[REG_RSP];
|
||||
mcontext->gregs[REG_RSP] += 8;
|
||||
}
|
||||
#else
|
||||
#error architecture not supported on Solaris
|
||||
#endif
|
||||
}
|
||||
|
||||
static void
|
||||
__gnat_error_handler (int sig, siginfo_t *sip, ucontext_t *cx ATTRIBUTE_UNUSED)
|
||||
__gnat_error_handler (int sig, siginfo_t *sip, void *ucontext)
|
||||
{
|
||||
struct Exception_Data *exception;
|
||||
static int recurse = 0;
|
||||
const char *msg;
|
||||
|
||||
/* If this was an explicit signal from a "kill", just resignal it. */
|
||||
if (SI_FROMUSER (sip))
|
||||
{
|
||||
signal (sig, SIG_DFL);
|
||||
kill (getpid(), sig);
|
||||
}
|
||||
/* Adjusting is required for every fault context, so adjust for this one
|
||||
now, before we possibly trigger a recursive fault below. */
|
||||
__gnat_adjust_context_for_raise (sig, ucontext);
|
||||
|
||||
/* Otherwise, treat it as something we handle. */
|
||||
switch (sig)
|
||||
{
|
||||
case SIGSEGV:
|
||||
@ -1030,6 +1070,7 @@ __gnat_error_handler (int sig, siginfo_t *sip, ucontext_t *cx ATTRIBUTE_UNUSED)
|
||||
much too hard to do anything else and we're just determining
|
||||
which exception to raise. */
|
||||
if (sip->si_code == SEGV_ACCERR
|
||||
|| (long) sip->si_addr == 0
|
||||
|| (((long) sip->si_addr) & 3) != 0
|
||||
|| recurse)
|
||||
{
|
||||
@ -1066,7 +1107,6 @@ __gnat_error_handler (int sig, siginfo_t *sip, ucontext_t *cx ATTRIBUTE_UNUSED)
|
||||
}
|
||||
|
||||
recurse = 0;
|
||||
|
||||
Raise_From_Signal_Handler (exception, msg);
|
||||
}
|
||||
|
||||
@ -1816,6 +1856,20 @@ __gnat_map_signal (int sig)
|
||||
msg = "SIGFPE";
|
||||
break;
|
||||
#ifdef VTHREADS
|
||||
#ifdef __VXWORKSMILS__
|
||||
case SIGILL:
|
||||
exception = &storage_error;
|
||||
msg = "SIGILL: possible stack overflow";
|
||||
break;
|
||||
case SIGSEGV:
|
||||
exception = &storage_error;
|
||||
msg = "SIGSEGV";
|
||||
break;
|
||||
case SIGBUS:
|
||||
exception = &program_error;
|
||||
msg = "SIGBUS";
|
||||
break;
|
||||
#else
|
||||
case SIGILL:
|
||||
exception = &constraint_error;
|
||||
msg = "Floating point exception or SIGILL";
|
||||
@ -1828,6 +1882,7 @@ __gnat_map_signal (int sig)
|
||||
exception = &storage_error;
|
||||
msg = "SIGBUS: possible stack overflow";
|
||||
break;
|
||||
#endif
|
||||
#elif (_WRS_VXWORKS_MAJOR == 6)
|
||||
case SIGILL:
|
||||
exception = &constraint_error;
|
||||
|
||||
@ -112,6 +112,7 @@ package body Prj.Attr is
|
||||
|
||||
"SVdefault_language#" &
|
||||
"LVrun_path_option#" &
|
||||
"SVrun_path_origin_supported#" &
|
||||
"SVseparate_run_path_options#" &
|
||||
"Satoolchain_version#" &
|
||||
"Satoolchain_description#" &
|
||||
|
||||
@ -2093,6 +2093,22 @@ package body Prj.Nmsc is
|
||||
In_Tree => Data.Tree);
|
||||
end if;
|
||||
|
||||
elsif Attribute.Name = Name_Run_Path_Origin_Supported then
|
||||
declare
|
||||
pragma Unsuppress (All_Checks);
|
||||
begin
|
||||
Project.Config.Run_Path_Origin_Supported :=
|
||||
Boolean'Value (Get_Name_String (Attribute.Value.Value));
|
||||
exception
|
||||
when Constraint_Error =>
|
||||
Error_Msg
|
||||
(Data.Flags,
|
||||
"invalid value """ &
|
||||
Get_Name_String (Attribute.Value.Value) &
|
||||
""" for Run_Path_Origin_Supported",
|
||||
Attribute.Value.Location, Project);
|
||||
end;
|
||||
|
||||
elsif Attribute.Name = Name_Separate_Run_Path_Options then
|
||||
declare
|
||||
pragma Unsuppress (All_Checks);
|
||||
|
||||
@ -906,6 +906,10 @@ package Prj is
|
||||
-- The option to use when linking to specify the path where to look for
|
||||
-- libraries.
|
||||
|
||||
Run_Path_Origin_Supported : Boolean := False;
|
||||
-- Specify if the run path option support $ORIGIN to indicate paths
|
||||
-- reative to the directory of the executable.
|
||||
|
||||
Separate_Run_Path_Options : Boolean := False;
|
||||
-- True if each directory needs to be specified in a separate run path
|
||||
-- option.
|
||||
@ -1017,6 +1021,7 @@ package Prj is
|
||||
Default_Project_Config : constant Project_Configuration :=
|
||||
(Target => No_Name,
|
||||
Run_Path_Option => No_Name_List,
|
||||
Run_Path_Origin_Supported => False,
|
||||
Separate_Run_Path_Options => False,
|
||||
Executable_Suffix => No_Name,
|
||||
Linker => No_Path,
|
||||
|
||||
@ -48,7 +48,7 @@ package body System.Communication is
|
||||
raise Constraint_Error with
|
||||
"last index out of range (no element transferred)";
|
||||
else
|
||||
return First + SEO (Count - 1);
|
||||
return First + SEO (Count) - 1;
|
||||
end if;
|
||||
end Last_Index;
|
||||
|
||||
|
||||
@ -2173,6 +2173,16 @@ package body Sem_Aggr is
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- If the aggregate already has bounds attached to it, it means this is
|
||||
-- a positional aggregate created as an optimization by
|
||||
-- Exp_Aggr.Convert_To_Positional, so we don't want to change those
|
||||
-- bounds.
|
||||
|
||||
if Present (Aggregate_Bounds (N)) and then not Others_Allowed then
|
||||
Aggr_Low := Low_Bound (Aggregate_Bounds (N));
|
||||
Aggr_High := High_Bound (Aggregate_Bounds (N));
|
||||
end if;
|
||||
|
||||
Set_Aggregate_Bounds
|
||||
(N, Make_Range (Loc, Low_Bound => Aggr_Low, High_Bound => Aggr_High));
|
||||
|
||||
|
||||
@ -1130,6 +1130,7 @@ package Snames is
|
||||
Name_Roots : constant Name_Id := N + $; -- GPR
|
||||
Name_Required_Switches : constant Name_Id := N + $;
|
||||
Name_Run_Path_Option : constant Name_Id := N + $;
|
||||
Name_Run_Path_Origin_Supported : constant Name_Id := N + $;
|
||||
Name_Separate_Run_Path_Options : constant Name_Id := N + $;
|
||||
Name_Shared_Library_Minimum_Switches : constant Name_Id := N + $;
|
||||
Name_Shared_Library_Prefix : constant Name_Id := N + $;
|
||||
|
||||
@ -34,8 +34,10 @@
|
||||
|
||||
#ifdef __vxworks
|
||||
#include "ioLib.h"
|
||||
#if ! defined (__VXWORKSMILS__)
|
||||
#include "dosFsLib.h"
|
||||
#if ! defined ( __RTP__) && ! defined (VTHREADS)
|
||||
#endif
|
||||
#if ! defined (__RTP__) && ! defined (VTHREADS)
|
||||
# include "nfsLib.h"
|
||||
#endif
|
||||
#include "selectLib.h"
|
||||
@ -985,7 +987,9 @@ __gnat_is_file_not_found_error (int errno_val) {
|
||||
/* In the case of VxWorks, we also have to take into account various
|
||||
* filesystem-specific variants of this error.
|
||||
*/
|
||||
#if ! defined (__VXWORKSMILS__)
|
||||
case S_dosFsLib_FILE_NOT_FOUND:
|
||||
#endif
|
||||
#if ! defined (__RTP__) && ! defined (VTHREADS)
|
||||
case S_nfsLib_NFSERR_NOENT:
|
||||
#endif
|
||||
|
||||
Loading…
Reference in New Issue
Block a user