[multiple changes]

2017-04-25  Gary Dismukes  <dismukes@adacore.com>

	* exp_util.adb, exp_ch4.adb: Minor reformatting.

2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* 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  <fofanov@adacore.com>

	* 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

+2017-04-25  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_util.adb, exp_ch4.adb: Minor reformatting.
+
+2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* 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  <fofanov@adacore.com>
+
+	* 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  <charlet@adacore.com>
 
 	* exp_ch4.adb (Expand_N_Case_Expression): Take

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

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 <unixlib.h>
-#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

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.

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;

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
 
@@ -2921,47 +2914,6 @@ package body Osint is
    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 --
    ----------------------

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;

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;

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 --
    ----------

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);