OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2013-01-02  Robert Dewar  <dewar@adacore.com>

	* gnat1drv.adb, targparm.adb, targparm.ads: Minor name change: add
	On_Target to Atomic_Sync_Default.

2013-01-02  Robert Dewar  <dewar@adacore.com>

	* sem_warn.adb (Warn_On_Known_Condition): Suppress warning for
	comparison of attribute result with constant
	* a-ststio.adb, s-direio.adb, s-rannum.adb: Remove unnecessary pragma
	Warnings (Off, "..");

2013-01-02  Yannick Moy  <moy@adacore.com>

	* sem_prag.ads: Minor correction of comment.

2013-01-02  Thomas Quinot  <quinot@adacore.com>

	* par_sco.adb (Traverse_Package_Declaration): The first
	declaration in a nested package is dominated by the preceding
	declaration in the enclosing scope.

2013-01-02  Pascal Obry  <obry@adacore.com>

	* adaint.c, adaint.h (__gnat_get_module_name): Return the actual
	module containing a given address.

From-SVN: r194798
This commit is contained in:
Arnaud Charlet 2013-01-02 12:06:15 +01:00
parent e9f8061256
commit ef7c5fa919
12 changed files with 96 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
gcc/ada/ChangeLog
View File

@ -1,3 +1,30 @@
2013-01-02 Robert Dewar <dewar@adacore.com>
* gnat1drv.adb, targparm.adb, targparm.ads: Minor name change: add
On_Target to Atomic_Sync_Default.
2013-01-02 Robert Dewar <dewar@adacore.com>
* sem_warn.adb (Warn_On_Known_Condition): Suppress warning for
comparison of attribute result with constant
* a-ststio.adb, s-direio.adb, s-rannum.adb: Remove unnecessary pragma
Warnings (Off, "..");
2013-01-02 Yannick Moy <moy@adacore.com>
* sem_prag.ads: Minor correction of comment.
2013-01-02 Thomas Quinot <quinot@adacore.com>
* par_sco.adb (Traverse_Package_Declaration): The first
declaration in a nested package is dominated by the preceding
declaration in the enclosing scope.
2013-01-02 Pascal Obry <obry@adacore.com>
* adaint.c, adaint.h (__gnat_get_module_name): Return the actual
module containing a given address.
2013-01-02 Thomas Quinot <quinot@adacore.com>
* sem_ch3.adb: Minor reformatting.

6
gcc/ada/a-ststio.adb
View File

@ -367,13 +367,11 @@ package body Ada.Streams.Stream_IO is
FIO.Append_Set (AP (File));
if File.Mode = FCB.Append_File then
pragma Warnings (Off, "*condition is always*");
if Standard'Address_Size = 64 then
File.Index := Count (ftell64 (File.Stream)) + 1;
else
File.Index := Count (ftell (File.Stream)) + 1;
end if;
pragma Warnings (On, "*condition is always*");
end if;
File.Last_Op := Op_Other;
@ -388,7 +386,6 @@ package body Ada.Streams.Stream_IO is
use type System.CRTL.ssize_t;
R : int;
begin
pragma Warnings (Off, "*condition is always*");
if Standard'Address_Size = 64 then
R := fseek64 (File.Stream,
System.CRTL.ssize_t (File.Index) - 1, SEEK_SET);
@ -396,7 +393,6 @@ package body Ada.Streams.Stream_IO is
R := fseek (File.Stream,
System.CRTL.long (File.Index) - 1, SEEK_SET);
end if;
pragma Warnings (On, "*condition is always*");
if R /= 0 then
raise Use_Error;
@ -418,13 +414,11 @@ package body Ada.Streams.Stream_IO is
raise Device_Error;
end if;
pragma Warnings (Off, "*condition is always*");
if Standard'Address_Size = 64 then
File.File_Size := Stream_Element_Offset (ftell64 (File.Stream));
else
File.File_Size := Stream_Element_Offset (ftell (File.Stream));
end if;
pragma Warnings (On, "*condition is always*");
end if;
return Count (File.File_Size);

39
gcc/ada/adaint.c
View File

@ -2960,6 +2960,45 @@ __gnat_locate_exec_on_path (char *exec_name)
#endif
}
/* __gnat_get_module_name returns the module name (executable or shared
library) in which the code at addr is. This is used to properly
report the symbolic tracebacks. If the module cannot be located
it returns the empty string. The returned value must not be freed. */
char *__gnat_get_module_name (void *addr ATTRIBUTE_UNUSED)
{
extern char **gnat_argv;
#ifdef _WIN32
static char lpFilename[MAX_PATH];
HMODULE hModule;
lpFilename[0] = '\0';
/* Get the module handle in which the code running at the specified
address is contained. */
if (GetModuleHandleEx
(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS, addr, &hModule) == FALSE)
return __gnat_locate_exec_on_path (gnat_argv[0]);
/* Get the corresponding module full path name. We really want the
standard ASCII version of this routine as the name is passed to
the BFD library. */
if (GetModuleFileNameA (hModule, lpFilename, MAX_PATH) == 0)
return __gnat_locate_exec_on_path (gnat_argv[0]);
return lpFilename;
#else
/* On all other platforms we just return the full path name of the
main executable. */
return __gnat_locate_exec_on_path (gnat_argv[0]);
#endif
}
#ifdef VMS
/* These functions are used to translate to and from VMS and Unix syntax

1
gcc/ada/adaint.h
View File

@ -186,6 +186,7 @@ extern int __gnat_portable_wait (int *);
extern char *__gnat_locate_exec (char *, char *);
extern char *__gnat_locate_exec_on_path (char *);
extern char *__gnat_locate_regular_file (char *, char *);
extern char *__gnat_get_module_name (void *);
extern void __gnat_maybe_glob_args (int *, char ***);
extern void __gnat_os_exit (int);
extern char *__gnat_get_libraries_from_registry (void);

2
gcc/ada/gnat1drv.adb
View File

@ -518,7 +518,7 @@ procedure Gnat1drv is
-- off. Note Atomic Synchronization is implemented as check.
Suppress_Options.Suppress (Atomic_Synchronization) :=
not Atomic_Sync_Default;
not Atomic_Sync_Default_On_Target;
-- Set switch indicating if we can use N_Expression_With_Actions

15
gcc/ada/par_sco.adb
View File

@ -174,7 +174,9 @@ package body Par_SCO is
(N : Node_Id;
D : Dominant_Info := No_Dominant);
procedure Traverse_Package_Body (N : Node_Id);
procedure Traverse_Package_Declaration (N : Node_Id);
procedure Traverse_Package_Declaration
(N : Node_Id;
D : Dominant_Info := No_Dominant);
procedure Traverse_Subprogram_Or_Task_Body
(N : Node_Id;
D : Dominant_Info := No_Dominant);
@ -1522,7 +1524,7 @@ package body Par_SCO is
when N_Package_Declaration =>
Set_Statement_Entry;
Traverse_Package_Declaration (N);
Traverse_Package_Declaration (N, Current_Dominant);
-- Generic package declaration
@ -2162,14 +2164,19 @@ package body Par_SCO is
-- Traverse_Package_Declaration --
----------------------------------
procedure Traverse_Package_Declaration (N : Node_Id) is
procedure Traverse_Package_Declaration
(N : Node_Id;
D : Dominant_Info := No_Dominant)
is
Spec : constant Node_Id := Specification (N);
Dom : Dominant_Info;
begin
Dom := Traverse_Declarations_Or_Statements
(Visible_Declarations (Spec), D);
-- The first private declaration is dominated by the last visible
-- declaration.
Dom := Traverse_Declarations_Or_Statements (Visible_Declarations (Spec));
Traverse_Declarations_Or_Statements (Private_Declarations (Spec), Dom);
end Traverse_Package_Declaration;

4
gcc/ada/s-direio.adb
View File

@ -283,7 +283,6 @@ package body System.Direct_IO is
use type System.CRTL.ssize_t;
R : int;
begin
pragma Warnings (Off, "*condition is always*");
if Standard'Address_Size = 64 then
R := fseek64
(File.Stream, ssize_t (File.Bytes) *
@ -293,7 +292,6 @@ package body System.Direct_IO is
(File.Stream, long (File.Bytes) *
long (File.Index - 1), SEEK_SET);
end if;
pragma Warnings (On, "*condition is always*");
if R /= 0 then
raise Use_Error;
@ -314,13 +312,11 @@ package body System.Direct_IO is
raise Device_Error;
end if;
pragma Warnings (Off, "*condition is always*");
if Standard'Address_Size = 64 then
return Count (ftell64 (File.Stream) / ssize_t (File.Bytes));
else
return Count (ftell (File.Stream) / long (File.Bytes));
end if;
pragma Warnings (On, "*condition is always*");
end Size;
-----------

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

@ -406,7 +406,7 @@ package body System.Random_Numbers is
-- Ignore different-size warnings here since GNAT's handling
-- is correct.
pragma Warnings ("Z"); -- better to use msg string! ???
pragma Warnings ("Z");
function Conv_To_Unsigned is
new Unchecked_Conversion (Result_Subtype'Base, Unsigned_64);
function Conv_To_Result is
@ -496,7 +496,6 @@ package body System.Random_Numbers is
procedure Reset (Gen : Generator; Initiator : Integer) is
begin
pragma Warnings (Off, "condition is always *");
-- This is probably an unnecessary precaution against future change, but
-- since the test is a static expression, no extra code is involved.
@ -515,8 +514,6 @@ package body System.Random_Numbers is
Reset (Gen, Initialization_Vector'(Init0, Init1));
end;
end if;
pragma Warnings (On, "condition is always *");
end Reset;
procedure Reset (Gen : Generator; Initiator : Initialization_Vector) is

3
gcc/ada/sem_prag.ads
View File

@ -58,7 +58,8 @@ package Sem_Prag is
-- This function is used in connection with pragmas Assertion, Check,
-- Precondition, and Postcondition, to determine if Check pragmas (or
-- corresponding Assert, Precondition, or Postcondition pragmas) are
-- currently disabled (as set by a Policy pragma with the Disabled
-- currently disabled (as set by a Check_Policy or Assertion_Policy pragma
-- with the Disable argument).
function Check_Enabled (Nam : Name_Id) return Boolean;
-- This function is used in connection with pragmas Assertion, Check,

13
gcc/ada/sem_warn.adb
View File

@ -3175,9 +3175,20 @@ package body Sem_Warn is
if Constant_Condition_Warnings
and then Is_Known_Branch
and then Comes_From_Source (Original_Node (C))
and then Comes_From_Source (Orig)
and then not In_Instance
then
-- Don't warn if comparison of result of attribute against a constant
-- value, since this is likely legitimate conditional compilation.
if Nkind (Orig) in N_Op_Compare
and then Compile_Time_Known_Value (Right_Opnd (Orig))
and then Nkind (Original_Node (Left_Opnd (Orig))) =
N_Attribute_Reference
then
return;
end if;
-- See if this is in a statement or a declaration
P := Parent (C);

2
gcc/ada/targparm.adb
View File

@ -554,7 +554,7 @@ package body Targparm is
case K is
when AAM => AAMP_On_Target := Result;
when ACR => Always_Compatible_Rep_On_Target := Result;
when ASD => Atomic_Sync_Default := Result;
when ASD => Atomic_Sync_Default_On_Target := Result;
when BDC => Backend_Divide_Checks_On_Target := Result;
when BOC => Backend_Overflow_Checks_On_Target := Result;
when CLA => Command_Line_Args_On_Target := Result;

2
gcc/ada/targparm.ads
View File

@ -388,7 +388,7 @@ package Targparm is
-- used at the source level, and the corresponding flag is false, then an
-- error message will be issued saying the feature is not supported.
Atomic_Sync_Default : Boolean := True;
Atomic_Sync_Default_On_Target : Boolean := True;
-- Access to atomic variables requires memory barrier synchronization in
-- the general case to ensure proper behavior when such accesses are used
-- on a multi-processor to synchronize tasks (e.g. by using spin locks).