From e0666fc62f436b35e9ad3b806cb081d95f2f66c6 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 25 Apr 2017 15:58:36 +0200 Subject: [PATCH] [multiple changes] 2017-04-25 Gary Dismukes * exp_util.adb, exp_ch4.adb: Minor reformatting. 2017-04-25 Hristian Kirtchev * checks.adb: Code clean up in various routines. (Generate_Range_Check): Do not generate a range check when the expander is not active or when index/range checks are suppressed on the target type. (Insert_List_After_And_Analyze, Insert_List_Before_And_Analyze): Remove variants that include a Supress parameter. These routines are never used, and were introduced before the current scope-based check suppression method. 2017-04-25 Vasiliy Fofanov * prj-part.adb, cstreams.c, osint.adb, osint.ads: Remove VMS specific code and some subprogram calls that are now noop. From-SVN: r247242 --- gcc/ada/ChangeLog | 20 ++++++++ gcc/ada/checks.adb | 56 ++++++++++++-------- gcc/ada/cstreams.c | 23 +-------- gcc/ada/exp_ch4.adb | 9 ++-- gcc/ada/exp_util.adb | 8 +-- gcc/ada/osint.adb | 120 +------------------------------------------ gcc/ada/osint.ads | 20 +------- gcc/ada/prj-part.adb | 12 +---- gcc/ada/sem.adb | 52 ------------------- gcc/ada/sem.ads | 14 ++--- 10 files changed, 74 insertions(+), 260 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index da75bbb00f5..c93ddcbe9b1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2017-04-25 Gary Dismukes + + * exp_util.adb, exp_ch4.adb: Minor reformatting. + +2017-04-25 Hristian Kirtchev + + * checks.adb: Code clean up in various routines. + (Generate_Range_Check): Do not generate a range check when the + expander is not active or when index/range checks are suppressed + on the target type. + (Insert_List_After_And_Analyze, Insert_List_Before_And_Analyze): + Remove variants that include a Supress parameter. These routines + are never used, and were introduced before the current scope-based + check suppression method. + +2017-04-25 Vasiliy Fofanov + + * prj-part.adb, cstreams.c, osint.adb, osint.ads: Remove VMS specific + code and some subprogram calls that are now noop. + 2017-04-25 Arnaud Charlet * exp_ch4.adb (Expand_N_Case_Expression): Take diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 2bcd059219d..6f0dace3f9c 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -489,17 +489,18 @@ package body Checks is Static_Sloc : Source_Ptr; Flag_Node : Node_Id) is + Checks_On : constant Boolean := + not Index_Checks_Suppressed (Suppress_Typ) + or else + not Range_Checks_Suppressed (Suppress_Typ); + Internal_Flag_Node : constant Node_Id := Flag_Node; Internal_Static_Sloc : constant Source_Ptr := Static_Sloc; - Checks_On : constant Boolean := - (not Index_Checks_Suppressed (Suppress_Typ)) - or else (not Range_Checks_Suppressed (Suppress_Typ)); - begin - -- For now we just return if Checks_On is false, however this should - -- be enhanced to check for an always True value in the condition - -- and to generate a compilation warning??? + -- For now we just return if Checks_On is false, however this should be + -- enhanced to check for an always True value in the condition and to + -- generate a compilation warning??? if not Checks_On then return; @@ -3116,14 +3117,16 @@ package body Checks is Source_Typ : Entity_Id; Do_Static : Boolean) is + Checks_On : constant Boolean := + not Index_Checks_Suppressed (Target_Typ) + or else + not Length_Checks_Suppressed (Target_Typ); + + Loc : constant Source_Ptr := Sloc (Ck_Node); + Cond : Node_Id; - R_Result : Check_Result; R_Cno : Node_Id; - - Loc : constant Source_Ptr := Sloc (Ck_Node); - Checks_On : constant Boolean := - (not Index_Checks_Suppressed (Target_Typ)) - or else (not Length_Checks_Suppressed (Target_Typ)); + R_Result : Check_Result; begin -- Only apply checks when generating code @@ -3228,12 +3231,13 @@ package body Checks is Source_Typ : Entity_Id; Do_Static : Boolean) is - Loc : constant Source_Ptr := Sloc (Ck_Node); Checks_On : constant Boolean := not Index_Checks_Suppressed (Target_Typ) or else not Range_Checks_Suppressed (Target_Typ); + Loc : constant Source_Ptr := Sloc (Ck_Node); + Cond : Node_Id; R_Cno : Node_Id; R_Result : Check_Result; @@ -6693,9 +6697,20 @@ package body Checks is Set_Etype (N, Target_Base_Type); end Convert_And_Check_Range; + -- Local variables + + Checks_On : constant Boolean := + not Index_Checks_Suppressed (Target_Type) + or else + not Range_Checks_Suppressed (Target_Type); + -- Start of processing for Generate_Range_Check begin + if not Expander_Active or not Checks_On then + return; + end if; + -- First special case, if the source type is already within the range -- of the target type, then no check is needed (probably we should have -- stopped Do_Range_Check from being set in the first place, but better @@ -7155,14 +7170,15 @@ package body Checks is Flag_Node : Node_Id := Empty; Do_Before : Boolean := False) is + Checks_On : constant Boolean := + not Index_Checks_Suppressed (Suppress_Typ) + or else + not Range_Checks_Suppressed (Suppress_Typ); + + Check_Node : Node_Id; Internal_Flag_Node : Node_Id := Flag_Node; Internal_Static_Sloc : Source_Ptr := Static_Sloc; - Check_Node : Node_Id; - Checks_On : constant Boolean := - (not Index_Checks_Suppressed (Suppress_Typ)) - or else (not Range_Checks_Suppressed (Suppress_Typ)); - begin -- For now we just return if Checks_On is false, however this should be -- enhanced to check for an always True value in the condition and to diff --git a/gcc/ada/cstreams.c b/gcc/ada/cstreams.c index f0f826685b8..e4e614744b3 100644 --- a/gcc/ada/cstreams.c +++ b/gcc/ada/cstreams.c @@ -6,7 +6,7 @@ * * * Auxiliary C functions for Interfaces.C.Streams * * * - * Copyright (C) 1992-2015, Free Software Foundation, Inc. * + * Copyright (C) 1992-2017, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -67,10 +67,6 @@ extern "C" { #endif -#ifdef VMS -#include -#endif - #ifdef __linux__ /* Don't use macros on GNU/Linux since they cause incompatible changes between glibc 2.0 and 2.1 */ @@ -202,23 +198,6 @@ __gnat_full_name (char *nam, char *buffer) getcwd approach instead. */ realpath (nam, buffer); -#elif defined (VMS) - strncpy (buffer, __gnat_to_canonical_file_spec (nam), __gnat_max_path_len); - - if (buffer[0] == '/' || strchr (buffer, '!')) /* '!' means decnet node */ - strncpy (buffer, __gnat_to_host_file_spec (buffer), __gnat_max_path_len); - else - { - char *nambuffer = alloca (__gnat_max_path_len); - - strncpy (nambuffer, buffer, __gnat_max_path_len); - strncpy - (buffer, getcwd (buffer, __gnat_max_path_len, 0), __gnat_max_path_len); - strncat (buffer, "/", __gnat_max_path_len); - strncat (buffer, nambuffer, __gnat_max_path_len); - strncpy (buffer, __gnat_to_host_file_spec (buffer), __gnat_max_path_len); - } - #elif defined (__vxworks) /* On VxWorks systems, an absolute path can be represented (depending on diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index dfbdfd28197..f54779956fa 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -4718,6 +4718,7 @@ package body Exp_Ch4 is ------------------------------ procedure Expand_N_Case_Expression (N : Node_Id) is + function Is_Copy_Type (Typ : Entity_Id) return Boolean; -- Return True if we can copy objects of this type when expanding a case -- expression. @@ -4728,7 +4729,7 @@ package body Exp_Ch4 is function Is_Copy_Type (Typ : Entity_Id) return Boolean is begin - -- if Minimize_Expression_With_Actions is True, we can afford to copy + -- If Minimize_Expression_With_Actions is True, we can afford to copy -- large objects, as long as they are constrained and not limited. return @@ -4818,7 +4819,7 @@ package body Exp_Ch4 is -- This approach avoids extra copies of potentially large objects. It -- also allows handling of values of limited or unconstrained types. - -- Note that we do the copy also for constrained, non limited types + -- Note that we do the copy also for constrained, nonlimited types -- when minimizing expressions with actions (e.g. when generating C -- code) since it allows us to do the optimization below in more cases. @@ -4852,7 +4853,7 @@ package body Exp_Ch4 is Target_Typ := Typ; -- ??? Do not perform the optimization when the return statement is - -- within a predicate function as this causes spurious errors. Could + -- within a predicate function, as this causes spurious errors. Could -- this be a possible mismatch in handling this case somewhere else -- in semantic analysis? @@ -5479,7 +5480,7 @@ package body Exp_Ch4 is end if; -- Fall through here for either the limited expansion, or the case of - -- inserting actions for non-limited types. In both these cases, we must + -- inserting actions for nonlimited types. In both these cases, we must -- move the SLOC of the parent If statement to the newly created one and -- change it to the SLOC of the expression which, after expansion, will -- correspond to what is being evaluated. diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 1217468272e..88c1ea67d09 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -5199,7 +5199,7 @@ package body Exp_Util is Calls_OK : Boolean := False; -- This flag is set to True when expression Expr contains at least one - -- call to a non-dispatching primitive function of Typ. + -- call to a nondispatching primitive function of Typ. function Search_Primitive_Calls (N : Node_Id) return Traverse_Result; -- Search for nondispatching calls to primitive functions of type Typ @@ -5213,7 +5213,7 @@ package body Exp_Util is Subp : Entity_Id; begin - -- Detect a function call which could denote a non-dispatching + -- Detect a function call that could denote a nondispatching -- primitive of the input type. if Nkind (N) = N_Function_Call @@ -5221,7 +5221,7 @@ package body Exp_Util is then Subp := Entity (Name (N)); - -- Do not consider function calls with a controlling argument as + -- Do not consider function calls with a controlling argument, as -- those are always dispatching calls. if Is_Dispatching_Operation (Subp) @@ -5237,7 +5237,7 @@ package body Exp_Util is then Calls_OK := True; - -- There is no need to continue the traversal as one such + -- There is no need to continue the traversal, as one such -- call suffices. return Abandon; diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 2a3b1c3dbca..7dbb84cfb2d 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -474,16 +474,9 @@ package body Osint is if Additional_Source_Dir then Search_Path := Getenv (Ada_Include_Path); - if Search_Path'Length > 0 then - Search_Path := To_Canonical_Path_Spec (Search_Path.all); - end if; - else Search_Path := Getenv (Ada_Objects_Path); - if Search_Path'Length > 0 then - Search_Path := To_Canonical_Path_Spec (Search_Path.all); - end if; end if; Get_Next_Dir_In_Path_Init (Search_Path); @@ -1524,7 +1517,7 @@ package body Osint is Default_Suffix_Dir := new String'("adalib"); end if; - Norm_Search_Dir := To_Canonical_Path_Spec (Local_Search_Dir.all); + Norm_Search_Dir := Local_Search_Dir; if Is_Absolute_Path (Norm_Search_Dir.all) then @@ -2920,47 +2913,6 @@ package body Osint is return Name; end Strip_Suffix; - --------------------------- - -- To_Canonical_Dir_Spec -- - --------------------------- - - function To_Canonical_Dir_Spec - (Host_Dir : String; - Prefix_Style : Boolean) return String_Access - is - function To_Canonical_Dir_Spec - (Host_Dir : Address; - Prefix_Flag : Integer) return Address; - pragma Import (C, To_Canonical_Dir_Spec, "__gnat_to_canonical_dir_spec"); - - C_Host_Dir : String (1 .. Host_Dir'Length + 1); - Canonical_Dir_Addr : Address; - Canonical_Dir_Len : CRTL.size_t; - - begin - C_Host_Dir (1 .. Host_Dir'Length) := Host_Dir; - C_Host_Dir (C_Host_Dir'Last) := ASCII.NUL; - - if Prefix_Style then - Canonical_Dir_Addr := To_Canonical_Dir_Spec (C_Host_Dir'Address, 1); - else - Canonical_Dir_Addr := To_Canonical_Dir_Spec (C_Host_Dir'Address, 0); - end if; - - Canonical_Dir_Len := C_String_Length (Canonical_Dir_Addr); - - if Canonical_Dir_Len = 0 then - return null; - else - return To_Path_String_Access (Canonical_Dir_Addr, Canonical_Dir_Len); - end if; - - exception - when others => - Fail ("invalid directory spec: " & Host_Dir); - return null; - end To_Canonical_Dir_Spec; - --------------------------- -- To_Canonical_File_List -- --------------------------- @@ -3019,74 +2971,6 @@ package body Osint is end; end To_Canonical_File_List; - ---------------------------- - -- To_Canonical_File_Spec -- - ---------------------------- - - function To_Canonical_File_Spec - (Host_File : String) return String_Access - is - function To_Canonical_File_Spec (Host_File : Address) return Address; - pragma Import - (C, To_Canonical_File_Spec, "__gnat_to_canonical_file_spec"); - - C_Host_File : String (1 .. Host_File'Length + 1); - Canonical_File_Addr : Address; - Canonical_File_Len : CRTL.size_t; - - begin - C_Host_File (1 .. Host_File'Length) := Host_File; - C_Host_File (C_Host_File'Last) := ASCII.NUL; - - Canonical_File_Addr := To_Canonical_File_Spec (C_Host_File'Address); - Canonical_File_Len := C_String_Length (Canonical_File_Addr); - - if Canonical_File_Len = 0 then - return null; - else - return To_Path_String_Access - (Canonical_File_Addr, Canonical_File_Len); - end if; - - exception - when others => - Fail ("invalid file spec: " & Host_File); - return null; - end To_Canonical_File_Spec; - - ---------------------------- - -- To_Canonical_Path_Spec -- - ---------------------------- - - function To_Canonical_Path_Spec - (Host_Path : String) return String_Access - is - function To_Canonical_Path_Spec (Host_Path : Address) return Address; - pragma Import - (C, To_Canonical_Path_Spec, "__gnat_to_canonical_path_spec"); - - C_Host_Path : String (1 .. Host_Path'Length + 1); - Canonical_Path_Addr : Address; - Canonical_Path_Len : CRTL.size_t; - - begin - C_Host_Path (1 .. Host_Path'Length) := Host_Path; - C_Host_Path (C_Host_Path'Last) := ASCII.NUL; - - Canonical_Path_Addr := To_Canonical_Path_Spec (C_Host_Path'Address); - Canonical_Path_Len := C_String_Length (Canonical_Path_Addr); - - -- Return a null string (vice a null) for zero length paths, for - -- compatibility with getenv(). - - return To_Path_String_Access (Canonical_Path_Addr, Canonical_Path_Len); - - exception - when others => - Fail ("invalid path spec: " & Host_Path); - return null; - end To_Canonical_Path_Spec; - ---------------------- -- To_Host_Dir_Spec -- ---------------------- diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index a96e83ea8e7..056b88f51b9 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -214,24 +214,6 @@ package Osint is -- a list of valid Unix syntax file or directory specs. If Only_Dirs is -- True, then only return directories. - function To_Canonical_Dir_Spec - (Host_Dir : String; - Prefix_Style : Boolean) return String_Access; - -- Convert a host syntax directory specification to canonical (Unix) - -- syntax. If Prefix_Style then make it a valid file specification prefix. - -- A file specification prefix is a directory specification that can be - -- appended with a simple file specification to yield a valid absolute - -- or relative path to a file. On a conversion to Unix syntax this simply - -- means the spec has a trailing slash ("/"). - - function To_Canonical_File_Spec - (Host_File : String) return String_Access; - -- Convert a host syntax file specification to canonical (Unix) syntax - - function To_Canonical_Path_Spec - (Host_Path : String) return String_Access; - -- Convert a host syntax Path specification to canonical (Unix) syntax - function To_Host_Dir_Spec (Canonical_Dir : String; Prefix_Style : Boolean) return String_Access; diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index c4cf2da8c88..7afe8c0a3d0 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -546,9 +546,6 @@ package body Prj.Part is Dummy : Boolean; pragma Warnings (Off, Dummy); - Real_Project_File_Name : String_Access := - Osint.To_Canonical_File_Spec - (Project_File_Name); Path_Name_Id : Path_Name_Type; begin @@ -561,17 +558,12 @@ package body Prj.Part is (Env.Project_Path, Target_Name); end if; - if Real_Project_File_Name = null then - Real_Project_File_Name := new String'(Project_File_Name); - end if; - Project := Empty_Node; Find_Project (Env.Project_Path, - Project_File_Name => Real_Project_File_Name.all, + Project_File_Name => Project_File_Name, Directory => Current_Directory, Path => Path_Name_Id); - Free (Real_Project_File_Name); if Errout_Handling /= Never_Finalize then Prj.Err.Initialize; diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index eb6c8c41164..7ad34ee3182 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1181,32 +1181,6 @@ package body Sem is end if; end Insert_List_After_And_Analyze; - -- Version with check(s) suppressed - - procedure Insert_List_After_And_Analyze - (N : Node_Id; L : List_Id; Suppress : Check_Id) - is - begin - if Suppress = All_Checks then - declare - Svs : constant Suppress_Array := Scope_Suppress.Suppress; - begin - Scope_Suppress.Suppress := (others => True); - Insert_List_After_And_Analyze (N, L); - Scope_Suppress.Suppress := Svs; - end; - - else - declare - Svg : constant Boolean := Scope_Suppress.Suppress (Suppress); - begin - Scope_Suppress.Suppress (Suppress) := True; - Insert_List_After_And_Analyze (N, L); - Scope_Suppress.Suppress (Suppress) := Svg; - end; - end if; - end Insert_List_After_And_Analyze; - ------------------------------------ -- Insert_List_Before_And_Analyze -- ------------------------------------ @@ -1239,32 +1213,6 @@ package body Sem is end if; end Insert_List_Before_And_Analyze; - -- Version with check(s) suppressed - - procedure Insert_List_Before_And_Analyze - (N : Node_Id; L : List_Id; Suppress : Check_Id) - is - begin - if Suppress = All_Checks then - declare - Svs : constant Suppress_Array := Scope_Suppress.Suppress; - begin - Scope_Suppress.Suppress := (others => True); - Insert_List_Before_And_Analyze (N, L); - Scope_Suppress.Suppress := Svs; - end; - - else - declare - Svg : constant Boolean := Scope_Suppress.Suppress (Suppress); - begin - Scope_Suppress.Suppress (Suppress) := True; - Insert_List_Before_And_Analyze (N, L); - Scope_Suppress.Suppress (Suppress) := Svg; - end; - end if; - end Insert_List_Before_And_Analyze; - ---------- -- Lock -- ---------- diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads index be5bc33245b..fca920a8a00 100644 --- a/gcc/ada/sem.ads +++ b/gcc/ada/sem.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -628,25 +628,17 @@ package Sem is procedure Insert_List_After_And_Analyze (N : Node_Id; L : List_Id); - procedure Insert_List_After_And_Analyze - (N : Node_Id; L : List_Id; Suppress : Check_Id); -- Inserts list L after node N using Nlists.Insert_List_After, and then, -- after this insertion is complete, analyzes all the nodes in the list, -- including any additional nodes generated by this analysis. If the list - -- is empty or No_List, the call has no effect. If the Suppress argument is - -- present, then the analysis is done with the specified check suppressed - -- (can be All_Checks to suppress all checks). + -- is empty or No_List, the call has no effect. procedure Insert_List_Before_And_Analyze (N : Node_Id; L : List_Id); - procedure Insert_List_Before_And_Analyze - (N : Node_Id; L : List_Id; Suppress : Check_Id); -- Inserts list L before node N using Nlists.Insert_List_Before, and then, -- after this insertion is complete, analyzes all the nodes in the list, -- including any additional nodes generated by this analysis. If the list - -- is empty or No_List, the call has no effect. If the Suppress argument is - -- present, then the analysis is done with the specified check suppressed - -- (can be All_Checks to suppress all checks). + -- is empty or No_List, the call has no effect. procedure Insert_After_And_Analyze (N : Node_Id; M : Node_Id); -- 2.30.2