[multiple changes]

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

12 files changed, 96 insertions, 23 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f595d49..87ed68d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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.
diff --git a/gcc/ada/a-ststio.adb b/gcc/ada/a-ststio.adb
index 91e1ef2..ef8af62 100644
--- a/gcc/ada/a-ststio.adb
+++ b/gcc/ada/a-ststio.adb
@@ -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);
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 4b8ce53..e67c4df 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -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
diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h
index 7956e27..217ce6c 100644
--- a/gcc/ada/adaint.h
+++ b/gcc/ada/adaint.h
@@ -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);
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 6e90c2b..4cfc339 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -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
 
diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb
index e46f242..6253be1 100644
--- a/gcc/ada/par_sco.adb
+++ b/gcc/ada/par_sco.adb
@@ -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;
 
diff --git a/gcc/ada/s-direio.adb b/gcc/ada/s-direio.adb
index f7db2e2..99f8ddf7 100644
--- a/gcc/ada/s-direio.adb
+++ b/gcc/ada/s-direio.adb
@@ -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;
 
    -----------
diff --git a/gcc/ada/s-rannum.adb b/gcc/ada/s-rannum.adb
index 21d8799..bfcea55 100644
--- a/gcc/ada/s-rannum.adb
+++ b/gcc/ada/s-rannum.adb
@@ -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
diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads
index 9971154..9df7d5a 100644
--- a/gcc/ada/sem_prag.ads
+++ b/gcc/ada/sem_prag.ads
@@ -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,
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index e794039..e24e729 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -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);
diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb
index ae80155..5ed8408 100644
--- a/gcc/ada/targparm.adb
+++ b/gcc/ada/targparm.adb
@@ -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;
diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads
index e3210c9..5869f0c 100644
--- a/gcc/ada/targparm.ads
+++ b/gcc/ada/targparm.ads
@@ -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).