提交: 0640c7d139ea91870c378de96cab14d708517593 - gcc_os216 (git)

GCC with patches for OS216

Commit MetaInfo

• 修订版: 0640c7d139ea91870c378de96cab14d708517593 (tree)
• 时间: 2016-07-07 22:17:51
• 作者: Arnaud Charlet <charlet@gcc....>
• Commiter: Arnaud Charlet

Log Message

[multiple changes]

2016-07-07 Vadim Godunko <[e-mail]>

* adainit.h, adainit.c (gnat_is_read_accessible_file): New
subprogram.
(gnat_is_write_accessible_file): New subprogram.
* s-os_lib.ads, s-os_lib.adb (Is_Read_Accessible_File): New subprogram.
(Is_Write_Accessible_File): New subprogram.

2016-07-07 Justin Squirek <[e-mail]>

* sem_ch12.adb (Install_Body): Minor refactoring in the order
of local functions.
(In_Same_Scope): Change loop condition to be more expressive.

From-SVN: r238116

更改概述

• modified: gcc/ada/ChangeLog
• modified: gcc/ada/adaint.c
• modified: gcc/ada/adaint.h
• modified: gcc/ada/s-os_lib.adb
• modified: gcc/ada/s-os_lib.ads
• modified: gcc/ada/sem_ch12.adb

差异

--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
[phone]  Vadim Godunko  <[e-mail]>
+
+	* adainit.h, adainit.c (__gnat_is_read_accessible_file): New
+	subprogram.
+	(__gnat_is_write_accessible_file): New subprogram.
+	* s-os_lib.ads, s-os_lib.adb (Is_Read_Accessible_File): New subprogram.
+	(Is_Write_Accessible_File): New subprogram.
+
[phone]  Justin Squirek  <[e-mail]>
+
+	* sem_ch12.adb (Install_Body): Minor refactoring in the order
+	of local functions.
+	(In_Same_Scope): Change loop condition to be more expressive.
+
 2016-07-07  Gary Dismukes  <[e-mail]>
 
 	* sem_ch3.adb, sem_prag.adb, sem_prag.ads, prj-ext.adb, freeze.adb,

--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -1912,6 +1912,20 @@ __gnat_is_readable_file_attr (char* name, struct file_attributes* attr)
 }
 
 int
+__gnat_is_read_accessible_file (char *name)
+{
+#if defined (_WIN32)
+   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
+
+   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+
+   return !_access (wname, 4);
+#else
+   return !access (name, R_OK);
+#endif
+}
+
+int
 __gnat_is_readable_file (char *name)
 {
    struct file_attributes attr;
@@ -1962,6 +1976,20 @@ __gnat_is_writable_file (char *name)
 }
 
 int
+__gnat_is_write_accessible_file (char *name)
+{
+#if defined (_WIN32)
+   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
+
+   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+
+   return !_access (wname, 2);
+#else
+   return !access (name, W_OK);
+#endif
+}
+
+int
 __gnat_is_executable_file_attr (char* name, struct file_attributes* attr)
 {
    if (attr->executable == ATTR_UNSET)

--- a/gcc/ada/adaint.h
+++ b/gcc/ada/adaint.h
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 1992-2015, 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- *
@@ -207,6 +207,8 @@ extern int    __gnat_is_directory		      (char *);
 extern int    __gnat_is_writable_file		   (char *);
 extern int    __gnat_is_readable_file		   (char *name);
 extern int    __gnat_is_executable_file      (char *name);
+extern int    __gnat_is_write_accessible_file	(char *name);
+extern int    __gnat_is_read_accessible_file	(char *name);
 
 extern void   __gnat_reset_attributes (struct file_attributes *);
 extern int    __gnat_error_attributes (struct file_attributes *);

--- a/gcc/ada/s-os_lib.adb
+++ b/gcc/ada/s-os_lib.adb
@@ -1495,6 +1495,21 @@ package body System.OS_Lib is
       return Is_Directory (F_Name'Address);
    end Is_Directory;
 
+   -----------------------------
+   -- Is_Read_Accessible_File --
+   -----------------------------
+
+   function Is_Read_Accessible_File (Name : String) return Boolean is
+      function Is_Read_Accessible_File (Name : Address) return Integer;
+      pragma Import
+        (C, Is_Read_Accessible_File, "__gnat_is_read_accessible_file");
+      F_Name : String (1 .. Name'Length + 1);
+   begin
+      F_Name (1 .. Name'Length) := Name;
+      F_Name (F_Name'Last)      := ASCII.NUL;
+      return Is_Read_Accessible_File (F_Name'Address) /= 0;
+   end Is_Read_Accessible_File;
+
    ----------------------
    -- Is_Readable_File --
    ----------------------
@@ -1571,6 +1586,21 @@ package body System.OS_Lib is
       return Is_Symbolic_Link (F_Name'Address);
    end Is_Symbolic_Link;
 
+   ------------------------------
+   -- Is_Write_Accessible_File --
+   ------------------------------
+
+   function Is_Write_Accessible_File (Name : String) return Boolean is
+      function Is_Write_Accessible_File (Name : Address) return Integer;
+      pragma Import
+        (C, Is_Write_Accessible_File, "__gnat_is_write_accessible_file");
+      F_Name : String (1 .. Name'Length + 1);
+   begin
+      F_Name (1 .. Name'Length) := Name;
+      F_Name (F_Name'Last)      := ASCII.NUL;
+      return Is_Write_Accessible_File (F_Name'Address) /= 0;
+   end Is_Write_Accessible_File;
+
    ----------------------
    -- Is_Writable_File --
    ----------------------

--- a/gcc/ada/s-os_lib.ads
+++ b/gcc/ada/s-os_lib.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1995-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-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- --
@@ -457,6 +457,14 @@ package System.OS_Lib is
    --  not actually be writable due to some other process having exclusive
    --  access.
 
+   function Is_Read_Accessible_File (Name : String) return Boolean;
+   --  Determines if the given string, Name, is the name of an existing file
+   --  that is readable. Returns True if so, False otherwise.
+
+   function Is_Write_Accessible_File (Name : String) return Boolean;
+   --  Determines if the given string, Name, is the name of an existing file
+   --  that is writable. Returns True if so, False otherwise.
+
    function Locate_Exec_On_Path (Exec_Name : String) return String_Access;
    --  Try to locate an executable whose name is given by Exec_Name in the
    --  directories listed in the environment Path. If the Exec_Name does not

--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -713,7 +713,10 @@ package body Sem_Ch12 is
    --  body. Early instantiations can also appear if generic, instance and
    --  body are all in the declarative part of a subprogram or entry. Entities
    --  of packages that are early instantiations are delayed, and their freeze
-   --  node appears after the generic body.
+   --  node appears after the generic body. This rather complex machinery is
+   --  needed when nested instantiations are present, because the source does
+   --  not carry any indication of where the corresponding instance bodies must
+   --  be installed and frozen.
 
    procedure Install_Formal_Packages (Par : Entity_Id);
    --  Install the visible part of any formal of the parent that is a formal
@@ -8927,23 +8930,13 @@ package body Sem_Ch12 is
       Gen_Body : Node_Id;
       Gen_Decl : Node_Id)
    is
-      Act_Id    : constant Entity_Id := Corresponding_Spec (Act_Body);
-      Act_Unit  : constant Node_Id   := Unit (Cunit (Get_Source_Unit (N)));
-      Gen_Id    : constant Entity_Id := Corresponding_Spec (Gen_Body);
-      Par       : constant Entity_Id := Scope (Gen_Id);
-      Gen_Unit  : constant Node_Id   :=
-                    Unit (Cunit (Get_Source_Unit (Gen_Decl)));
-      Orig_Body : Node_Id := Gen_Body;
-      F_Node    : Node_Id;
-      Body_Unit : Node_Id;
-
-      Must_Delay : Boolean;
 
-      function In_Same_Scope (Generic_Id, Actual_Id : Node_Id) return Boolean;
-      --  Check if the generic definition's scope tree and the instantiation's
-      --  scope tree share a dependency.
+      function In_Same_Scope (Gen_Id, Act_Id : Node_Id) return Boolean;
+      --  Check if the generic definition and the instantiation come from
+      --  a common scope, in which case the instance must be frozen after
+      --  the generic body.
 
-      function True_Sloc (N : Node_Id) return Source_Ptr;
+      function True_Sloc (N, Act_Unit : Node_Id) return Source_Ptr;
       --  If the instance is nested inside a generic unit, the Sloc of the
       --  instance indicates the place of the original definition, not the
       --  point of the current enclosing instance. Pending a better usage of
@@ -8955,20 +8948,22 @@ package body Sem_Ch12 is
       -- In_Same_Scope --
       -------------------
 
-      function In_Same_Scope (Generic_Id, Actual_Id : Node_Id) return Boolean
-      is
-         Act_Scop : Entity_Id := Scope (Actual_Id);
-         Gen_Scop : Entity_Id := Scope (Generic_Id);
+      function In_Same_Scope (Gen_Id, Act_Id : Node_Id) return Boolean is
+         Act_Scop : Entity_Id := Scope (Act_Id);
+         Gen_Scop : Entity_Id := Scope (Gen_Id);
+
       begin
-         while Scope_Depth_Value (Act_Scop) > 0
-           and then Scope_Depth_Value (Gen_Scop) > 0
+         while Act_Scop /= Standard_Standard
+           and then Gen_Scop /= Standard_Standard
          loop
             if Act_Scop = Gen_Scop then
                return True;
             end if;
+
             Act_Scop := Scope (Act_Scop);
             Gen_Scop := Scope (Gen_Scop);
          end loop;
+
          return False;
       end In_Same_Scope;
 
@@ -8976,7 +8971,7 @@ package body Sem_Ch12 is
       -- True_Sloc --
       ---------------
 
-      function True_Sloc (N : Node_Id) return Source_Ptr is
+      function True_Sloc (N, Act_Unit : Node_Id) return Source_Ptr is
          Res : Source_Ptr;
          N1  : Node_Id;
 
@@ -8994,6 +8989,18 @@ package body Sem_Ch12 is
          return Res;
       end True_Sloc;
 
+      Act_Id    : constant Entity_Id := Corresponding_Spec (Act_Body);
+      Act_Unit  : constant Node_Id   := Unit (Cunit (Get_Source_Unit (N)));
+      Gen_Id    : constant Entity_Id := Corresponding_Spec (Gen_Body);
+      Par       : constant Entity_Id := Scope (Gen_Id);
+      Gen_Unit  : constant Node_Id   :=
+                    Unit (Cunit (Get_Source_Unit (Gen_Decl)));
+      Orig_Body : Node_Id := Gen_Body;
+      F_Node    : Node_Id;
+      Body_Unit : Node_Id;
+
+      Must_Delay : Boolean;
+
    --  Start of processing for Install_Body
 
    begin
@@ -9058,7 +9065,8 @@ package body Sem_Ch12 is
           and then (Nkind_In (Gen_Unit, N_Package_Declaration,
                                         N_Generic_Package_Declaration)
                      or else (Gen_Unit = Body_Unit
-                               and then True_Sloc (N) < Sloc (Orig_Body)))
+                               and then True_Sloc (N, Act_Unit)
+                                          < Sloc (Orig_Body)))
           and then Is_In_Main_Unit (Original_Node (Gen_Unit))
           and then (In_Same_Scope (Gen_Id, Act_Id)));