From ef7c5fa919b358f10946c832007a488c22753bb9 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 2 Jan 2013 12:06:15 +0100 Subject: [PATCH] [multiple changes] 2013-01-02 Robert Dewar * gnat1drv.adb, targparm.adb, targparm.ads: Minor name change: add On_Target to Atomic_Sync_Default. 2013-01-02 Robert Dewar * 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 * sem_prag.ads: Minor correction of comment. 2013-01-02 Thomas Quinot * 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 * adaint.c, adaint.h (__gnat_get_module_name): Return the actual module containing a given address. From-SVN: r194798 --- gcc/ada/ChangeLog | 27 +++++++++++++++++++++++++++ gcc/ada/a-ststio.adb | 6 ------ gcc/ada/adaint.c | 39 +++++++++++++++++++++++++++++++++++++++ gcc/ada/adaint.h | 1 + gcc/ada/gnat1drv.adb | 2 +- gcc/ada/par_sco.adb | 15 +++++++++++---- gcc/ada/s-direio.adb | 4 ---- gcc/ada/s-rannum.adb | 5 +---- gcc/ada/sem_prag.ads | 3 ++- gcc/ada/sem_warn.adb | 13 ++++++++++++- gcc/ada/targparm.adb | 2 +- gcc/ada/targparm.ads | 2 +- 12 files changed, 96 insertions(+), 23 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f595d4949e3..87ed68df6ca 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2013-01-02 Robert Dewar + + * gnat1drv.adb, targparm.adb, targparm.ads: Minor name change: add + On_Target to Atomic_Sync_Default. + +2013-01-02 Robert Dewar + + * 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 + + * sem_prag.ads: Minor correction of comment. + +2013-01-02 Thomas Quinot + + * 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 + + * adaint.c, adaint.h (__gnat_get_module_name): Return the actual + module containing a given address. + 2013-01-02 Thomas Quinot * sem_ch3.adb: Minor reformatting. diff --git a/gcc/ada/a-ststio.adb b/gcc/ada/a-ststio.adb index 91e1ef249e0..ef8af62d206 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 4b8ce5341ef..e67c4df2ecd 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 7956e27a709..217ce6c48e1 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 6e90c2b6d05..4cfc3392f24 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 e46f2422c48..6253be19134 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 f7db2e2b262..99f8ddf7722 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 21d879923a3..bfcea556944 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 99711546cb5..9df7d5ab711 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 e79403995e7..e24e72901dd 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 ae801555d0b..5ed84083a8a 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 e3210c93664..5869f0c1013 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).