[multiple changes]

2017-04-25  Bob Duff  <duff@adacore.com>

	* sem_util.ads, sem_util.adb (Should_Ignore_Pragma): New function
	that returns True when appropriate.
	* par-prag.adb, exp_prag.adb, sem_prag.adb: Do not ignore pragmas
	when compiling predefined files.
	* fname.ads, fname.adb (Is_Predefined_File_Name): Fix bug:
	"gnat.adc" should not be considered a predefined file name.
	That required (or at least encouraged) a lot of cleanup of global
	variable usage. We shouldn't be communicating information via
	the global name buffer.
	* bindgen.adb, errout.adb, fname-uf.adb, lib-load.adb, make.adb,
	* restrict.adb, sem_ch10.adb, sem_ch6.adb, sem_ch8.adb: Changes
	required by the above-mentioned cleanup.

2017-04-25  Ed Schonberg  <schonberg@adacore.com>

	* osint.adb (Find_File): Handle properly a request for a
	configuration file whose name is a directory.

From-SVN: r247151

gcc/ada/ChangeLog

+2017-04-25  Bob Duff  <duff@adacore.com>
+
+	* sem_util.ads, sem_util.adb (Should_Ignore_Pragma): New function
+	that returns True when appropriate.
+	* par-prag.adb, exp_prag.adb, sem_prag.adb: Do not ignore pragmas
+	when compiling predefined files.
+	* fname.ads, fname.adb (Is_Predefined_File_Name): Fix bug:
+	"gnat.adc" should not be considered a predefined file name.
+	That required (or at least encouraged) a lot of cleanup of global
+	variable usage. We shouldn't be communicating information via
+	the global name buffer.
+	* bindgen.adb, errout.adb, fname-uf.adb, lib-load.adb, make.adb,
+	* restrict.adb, sem_ch10.adb, sem_ch6.adb, sem_ch8.adb: Changes
+	required by the above-mentioned cleanup.
+
+2017-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+	* osint.adb (Find_File): Handle properly a request for a
+	configuration file whose name is a directory.
+
 2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_attr.adb, sem_ch5.adb: Minor reformatting.

gcc/ada/bindgen.adb

@@ -1275,6 +1275,7 @@ package body Bindgen is
                 (No_Run_Time_Mode
                   and then Is_Predefined_File_Name (U.Sfile))
             then
+               Get_Name_String (U.Sfile);
                Set_String ("   ");
                Set_String ("E");
                Set_Unit_Number (Unum);

gcc/ada/errout.adb

@@ -2734,6 +2734,7 @@ package body Errout is
           not Is_Predefined_File_Name
                 (Unit_File_Name (Get_Source_Unit (Error_Msg_Node_1)))
       then
+         Get_Name_String (Unit_File_Name (Get_Source_Unit (Error_Msg_Node_1)));
          Set_Msg_Str (" defined");
          Set_Msg_Insertion_Line_Number (Sloc (Error_Msg_Node_1), Flag);
 

gcc/ada/exp_prag.adb

@@ -168,7 +168,7 @@ package body Exp_Prag is
       --  the back end or the expander here does not get overenthusiastic and
       --  start processing such a pragma!
 
-      if Get_Name_Table_Boolean3 (Pname) then
+      if Should_Ignore_Pragma (Pname) then
          Rewrite (N, Make_Null_Statement (Sloc (N)));
          return;
       end if;

gcc/ada/fname-uf.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -302,10 +302,9 @@ package body Fname.UF is
 
                   --  Determine if we have a predefined file name
 
-                  Name_Len := Uname'Length;
-                  Name_Buffer (1 .. Name_Len) := Uname;
                   Is_Predef :=
-                    Is_Predefined_File_Name (Renamings_Included => True);
+                    Is_Predefined_File_Name
+                      (Uname, Renamings_Included => True);
 
                   --  Found a match, execute the pattern
 

gcc/ada/fname.adb

@@ -57,122 +57,147 @@ package body Fname is
      Table_Increment      => Alloc.SFN_Table_Increment,
      Table_Name           => "Fname_Dummy_Table");
 
+   function Has_Prefix (X, Prefix : String) return Boolean;
+   --  True if Prefix is at the beginning of X. For example,
+   --  Has_Prefix("a-filename.ads", Prefix => "a-") is True.
+
+   function Has_Suffix (X, Suffix : String) return Boolean;
+   --  True if Suffix is at the end of X
+
+   function Has_Internal_Extension (Fname : String) return Boolean;
+   --  True if the extension is ".ads" or ".adb", as is always the case for
+   --  internal/predefined units.
+
+   ----------------------------
+   -- Has_Internal_Extension --
+   ----------------------------
+
+   function Has_Internal_Extension (Fname : String) return Boolean is
+   begin
+      return Has_Suffix (Fname, Suffix => ".ads")
+        or else Has_Suffix (Fname, Suffix => ".adb");
+   end Has_Internal_Extension;
+
+   ----------------
+   -- Has_Prefix --
+   ----------------
+
+   function Has_Prefix (X, Prefix : String) return Boolean is
+   begin
+      if X'Length >= Prefix'Length then
+         declare
+            Slice : String renames
+              X (X'First .. X'First + Prefix'Length - 1);
+         begin
+            return Slice = Prefix;
+         end;
+      end if;
+      return False;
+   end Has_Prefix;
+
+   ----------------
+   -- Has_Suffix --
+   ----------------
+
+   function Has_Suffix (X, Suffix : String) return Boolean is
+   begin
+      if X'Length >= Suffix'Length then
+         declare
+            Slice : String renames
+              X (X'Last - Suffix'Length + 1 .. X'Last);
+         begin
+            return Slice = Suffix;
+         end;
+      end if;
+      return False;
+   end Has_Suffix;
+
    ---------------------------
    -- Is_Internal_File_Name --
    ---------------------------
 
    function Is_Internal_File_Name
-     (Fname              : File_Name_Type;
-      Renamings_Included : Boolean := True) return Boolean
-   is
+     (Fname              : String;
+      Renamings_Included : Boolean := True) return Boolean is
    begin
-      if Is_Predefined_File_Name (Fname, Renamings_Included) then
-         return True;
-
-      --  Once Is_Predefined_File_Name has been called and returns False,
-      --  Name_Buffer contains Fname and Name_Len is set to 8.
+      --  Check for internal extensions first, so we don't think (e.g.)
+      --  "gnat.adc" is internal.
 
-      elsif Name_Buffer (1 .. 2) = "g-"
-        or else Name_Buffer (1 .. 8) = "gnat    "
-      then
-         return True;
-
-      else
+      if not Has_Internal_Extension (Fname) then
          return False;
       end if;
-   end Is_Internal_File_Name;
-
-   -----------------------------
-   -- Is_Predefined_File_Name --
-   -----------------------------
 
-   --  This should really be a test of unit name, given the possibility of
-   --  pragma Source_File_Name setting arbitrary file names for any files???
-
-   --  Once Is_Predefined_File_Name has been called and returns False,
-   --  Name_Buffer contains Fname and Name_Len is set to 8. This is used
-   --  only by Is_Internal_File_Name, and is not part of the official
-   --  external interface of this function.
+      return Is_Predefined_File_Name (Fname, Renamings_Included)
+        or else Has_Prefix (Fname, Prefix => "g-")
+        or else Has_Prefix (Fname, Prefix => "gnat.ad");
+   end Is_Internal_File_Name;
 
-   function Is_Predefined_File_Name
+   function Is_Internal_File_Name
      (Fname              : File_Name_Type;
       Renamings_Included : Boolean := True) return Boolean
    is
    begin
-      Get_Name_String (Fname);
-      return Is_Predefined_File_Name (Renamings_Included);
-   end Is_Predefined_File_Name;
-
-   function Is_Predefined_File_Name
-     (Renamings_Included : Boolean := True) return Boolean
-   is
-      subtype Str8 is String (1 .. 8);
-
-      Predef_Names : constant array (1 .. 11) of Str8 :=
-        ("ada     ",       -- Ada
-         "interfac",       -- Interfaces
-         "system  ",       -- System
-
-         --  Remaining entries are only considered if Renamings_Included true
-
-         "calendar",       -- Calendar
-         "machcode",       -- Machine_Code
-         "unchconv",       -- Unchecked_Conversion
-         "unchdeal",       -- Unchecked_Deallocation
-         "directio",       -- Direct_IO
-         "ioexcept",       -- IO_Exceptions
-         "sequenio",       -- Sequential_IO
-         "text_io ");      -- Text_IO
+      return Is_Internal_File_Name
+        (Get_Name_String (Fname), Renamings_Included);
+   end Is_Internal_File_Name;
 
-         Num_Entries : constant Natural :=
-                         3 + 8 * Boolean'Pos (Renamings_Included);
+   -----------------------------
+   -- Is_Predefined_File_Name --
+   -----------------------------
 
+   function Is_Predefined_File_Name
+     (Fname              : String;
+      Renamings_Included : Boolean := True) return Boolean is
    begin
-      --  Remove extension (if present)
-
-      if Name_Len > 4 and then Name_Buffer (Name_Len - 3) = '.' then
-         Name_Len := Name_Len - 4;
+      if not Has_Internal_Extension (Fname) then
+         return False;
       end if;
 
-      --  Definitely predefined if prefix is a- i- or s- followed by letter
-
-      if Name_Len >=  3
-        and then Name_Buffer (2) = '-'
-        and then (Name_Buffer (1) = 'a'
-                    or else
-                  Name_Buffer (1) = 'i'
-                    or else
-                  Name_Buffer (1) = 's')
-        and then (Name_Buffer (3) in 'a' .. 'z'
-                    or else
-                  Name_Buffer (3) in 'A' .. 'Z')
+      if Has_Prefix (Fname, "a-")
+        or else Has_Prefix (Fname, "i-")
+        or else Has_Prefix (Fname, "s-")
       then
          return True;
+      end if;
 
       --  Definitely false if longer than 12 characters (8.3)
 
-      elsif Name_Len > 8 then
+      if Fname'Length > 12 then
          return False;
       end if;
 
-      --  Otherwise check against special list, first padding to 8 characters
-
-      while Name_Len < 8 loop
-         Name_Len := Name_Len + 1;
-         Name_Buffer (Name_Len) := ' ';
-      end loop;
+      if Has_Prefix (Fname, Prefix => "ada.ad") -- Ada
+        or else Has_Prefix (Fname, Prefix => "interfac.ad") -- Interfaces
+        or else Has_Prefix (Fname, Prefix => "system.ad") -- System
+      then
+         return True;
+      end if;
 
-      for J in 1 .. Num_Entries loop
-         if Name_Buffer (1 .. 8) = Predef_Names (J) then
-            return True;
-         end if;
-      end loop;
+      if not Renamings_Included then
+         return False;
+      end if;
 
-      --  Note: when we return False here, the Name_Buffer contains the
-      --  padded file name. This is not defined for clients of the package,
-      --  but is used by Is_Internal_File_Name.
+      --  The following are the predefined renamings
+
+      return Has_Prefix (Fname, Prefix => "calendar.ad") -- Calendar
+        or else Has_Prefix (Fname, Prefix => "machcode.ad") -- Machine_Code
+        or else Has_Prefix (Fname, Prefix => "unchconv.ad")
+         --  Unchecked_Conversion
+        or else Has_Prefix (Fname, Prefix => "unchdeal.ad")
+         --  Unchecked_Deallocation
+        or else Has_Prefix (Fname, Prefix => "directio.ad") -- Direct_IO
+        or else Has_Prefix (Fname, Prefix => "ioexcept.ad") -- IO_Exceptions
+        or else Has_Prefix (Fname, Prefix => "sequenio.ad") -- Sequential_IO
+        or else Has_Prefix (Fname, Prefix => "text_io.ad"); -- Text_IO
+   end Is_Predefined_File_Name;
 
-      return False;
+   function Is_Predefined_File_Name
+     (Fname              : File_Name_Type;
+      Renamings_Included : Boolean := True) return Boolean
+   is
+   begin
+      return Is_Predefined_File_Name
+        (Get_Name_String (Fname), Renamings_Included);
    end Is_Predefined_File_Name;
 
    ---------------

gcc/ada/fname.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -63,27 +63,29 @@ package Fname is
    -----------------
 
    function Is_Predefined_File_Name
-     (Fname              : File_Name_Type;
+     (Fname              : String;
       Renamings_Included : Boolean := True) return Boolean;
-   --  This function determines if the given file name (which must be a simple
-   --  file name with no directory information) is the file name for one of the
-   --  predefined library units (i.e. part of the Ada, System, or Interface
-   --  hierarchies). Note that units in the GNAT hierarchy are not considered
-   --  predefined (see Is_Internal_File_Name below). On return, Name_Buffer
-   --  contains the file name. The Renamings_Included parameter indicates
-   --  whether annex J renamings such as Text_IO are to be considered as
-   --  predefined. If Renamings_Included is True, then Text_IO will return
-   --  True, otherwise only children of Ada, Interfaces and System return True.
-
    function Is_Predefined_File_Name
-     (Renamings_Included : Boolean := True) return Boolean;
-   --  This version is called with the file name already in Name_Buffer
+     (Fname              : File_Name_Type;
+      Renamings_Included : Boolean := True) return Boolean;
+   --  These functions determine if the given file name (which must be a
+   --  simple file name with no directory information) is the file name for
+   --  one of the predefined library units (i.e. part of the Ada, System, or
+   --  Interface hierarchies). Note that units in the GNAT hierarchy are not
+   --  considered predefined (see Is_Internal_File_Name below). The
+   --  Renamings_Included parameter indicates whether annex J renamings such as
+   --  Text_IO are to be considered as predefined. If Renamings_Included is
+   --  True, then Text_IO will return True, otherwise only children of Ada,
+   --  Interfaces and System return True.
 
    function Is_Internal_File_Name
+     (Fname              : String;
+      Renamings_Included : Boolean := True) return Boolean;
+   function Is_Internal_File_Name
      (Fname              : File_Name_Type;
       Renamings_Included : Boolean := True) return Boolean;
-   --  Similar to Is_Predefined_File_Name. The internal file set is a superset
-   --  of the predefined file set including children of GNAT.
+   --  Same as Is_Predefined_File_Name, except units in the GNAT hierarchy are
+   --  included.
 
    procedure Tree_Read;
    --  Dummy procedure (reads dummy table values from tree file)

gcc/ada/lib-load.adb

@@ -582,6 +582,8 @@ package body Lib.Load is
                end if;
 
                if Present (Error_Node) then
+                  Get_Name_String (Fname);
+
                   if Is_Predefined_File_Name (Fname) then
                      Error_Msg_Unit_1 := Uname_Actual;
                      Error_Msg
@@ -785,6 +787,8 @@ package body Lib.Load is
             --  Generate message if unit required
 
             if Required then
+               Get_Name_String (Fname);
+
                if Is_Predefined_File_Name (Fname) then
 
                   --  This is a predefined library unit which is not present

gcc/ada/make.adb

@@ -2944,7 +2944,9 @@ package body Make is
             Fname : constant File_Name_Type := Strip_Directory (S);
 
          begin
-            if Is_Predefined_File_Name (Fname, False) then
+            if Is_Predefined_File_Name
+              (Fname, Renamings_Included => False)
+            then
                if Check_Readonly_Files or else Must_Compile then
                   Comp_Args (Comp_Args'First + 2 .. Comp_Last + 1) :=
                     Comp_Args (Comp_Args'First + 1 .. Comp_Last);

gcc/ada/osint.adb

@@ -1189,16 +1189,25 @@ package body Osint is
             Found := N;
             Attr.all  := Unknown_Attributes;
 
-            if T = Config and then Full_Name then
-               declare
-                  Full_Path : constant String :=
-                                Normalize_Pathname (Get_Name_String (N));
-                  Full_Size : constant Natural := Full_Path'Length;
-               begin
-                  Name_Buffer (1 .. Full_Size) := Full_Path;
-                  Name_Len := Full_Size;
-                  Found := Name_Find;
-               end;
+            if T = Config then
+               if Full_Name then
+                  declare
+                     Full_Path : constant String :=
+                                   Normalize_Pathname (Get_Name_String (N));
+                     Full_Size : constant Natural := Full_Path'Length;
+
+                  begin
+                     Name_Buffer (1 .. Full_Size) := Full_Path;
+                     Name_Len := Full_Size;
+                     Found := Name_Find;
+                  end;
+               end if;
+
+               --  Check that it is a file, not a directory
+
+               if not Is_Regular_File (Get_Name_String (Found)) then
+                  Found := No_File;
+               end if;
             end if;
 
             return;

gcc/ada/par-prag.adb

@@ -294,7 +294,7 @@ begin
 
    --  Ignore pragma previously flagged by Ignore_Pragma
 
-   if Get_Name_Table_Boolean3 (Prag_Name) then
+   if Should_Ignore_Pragma (Prag_Name) then
       return Pragma_Node;
    end if;
 

gcc/ada/sem_ch6.adb

@@ -6101,6 +6101,8 @@ package body Sem_Ch6 is
              Is_Predefined_File_Name
                (Unit_File_Name (Get_Source_Unit (Alias (Overridden_Subp))))
          then
+            Get_Name_String
+              (Unit_File_Name (Get_Source_Unit (Alias (Overridden_Subp))));
             Error_Msg_NE ("subprogram & is not overriding", Spec, Subp);
 
          elsif Is_Subprogram (Subp) then

gcc/ada/sem_ch8.adb

@@ -3631,7 +3631,8 @@ package body Sem_Ch8 is
       --  children of Ada.Numerics, which are never loaded by Rtsfind).
 
       if Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
-        and then Name_Buffer (1 .. 3) /= "a-n"
+        and then Get_Name_String
+          (Unit_File_Name (Current_Sem_Unit)) (1 .. 3) /= "a-n"
         and then
           Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Declaration
       then

gcc/ada/sem_prag.adb

@@ -10352,7 +10352,7 @@ package body Sem_Prag is
 
       --  Ignore pragma if Ignore_Pragma applies
 
-      if Get_Name_Table_Boolean3 (Pname) then
+      if Should_Ignore_Pragma (Pname) then
          return;
       end if;
 

gcc/ada/sem_util.adb

@@ -20499,6 +20499,16 @@ package body Sem_Util is
       Set_Alignment                 (T1, Alignment                 (T2));
    end Set_Size_Info;
 
+   --------------------------
+   -- Should_Ignore_Pragma --
+   --------------------------
+
+   function Should_Ignore_Pragma (Prag_Name : Name_Id) return Boolean is
+   begin
+      return not Is_Internal_File_Name (File_Name (Current_Source_File))
+        and then Get_Name_Table_Boolean3 (Prag_Name);
+   end Should_Ignore_Pragma;
+
    --------------------
    -- Static_Boolean --
    --------------------

gcc/ada/sem_util.ads

@@ -2335,6 +2335,11 @@ package Sem_Util is
    function Scope_Is_Transient return Boolean;
    --  True if the current scope is transient
 
+   function Should_Ignore_Pragma (Prag_Name : Name_Id) return Boolean;
+   --  True if we should ignore pragmas with the specified name. In particular,
+   --  this returns True if pragma Ignore_Pragma applies, and we are not in a
+   --  predefined unit.
+
    function Static_Boolean (N : Node_Id) return Uint;
    --  This function analyzes the given expression node and then resolves it
    --  as Standard.Boolean. If the result is static, then Uint_1 or Uint_0 is