+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.
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;
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);
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;
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);
#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
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);
-- 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
(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);
when N_Package_Declaration =>
Set_Statement_Entry;
- Traverse_Package_Declaration (N);
+ Traverse_Package_Declaration (N, Current_Dominant);
-- Generic package declaration
-- 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;
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) *
(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;
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;
-----------
-- 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
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.
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
-- 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,
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);
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;
-- 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).
projects / gcc.git / commitdiff