[multiple changes]

2009-04-17  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb: Minor reformatting

2009-04-17  Pascal Obry  <obry@adacore.com>

	* adaint.c: Add __gnat_use_acl global variable to control use of ACL.

From-SVN: r146269

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f13a1f0..bf655e8 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2009-04-17  Robert Dewar  <dewar@adacore.com>
+
+       * sem_ch3.adb: Minor reformatting
+
+2009-04-17  Pascal Obry  <obry@adacore.com>
+
+       * adaint.c: Add __gnat_use_acl global variable to control use of ACL.
+
 2009-04-17  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_ch3.adb (Build_Derived_Enumeration_Type): Diagnose properly

diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 3ac773d..9ab2c20 100644 (file)
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -331,6 +331,10 @@ const int __gnat_vmsp = 0;
 int __gnat_max_path_len = GNAT_MAX_PATH_LEN;
 int max_path_len = GNAT_MAX_PATH_LEN;
 
+/* Control whether we can use ACL on Windows.  */
+
+int __gnat_use_acl = 1;
+
 /* The following macro HAVE_READDIR_R should be defined if the
    system provides the routine readdir_r.  */
 #undef HAVE_READDIR_R
@@ -667,7 +671,7 @@ __gnat_os_filename (char *filename, char *w_filename ATTRIBUTE_UNUSED,
                    char *encoding ATTRIBUTE_UNUSED, int *e_length)
 {
 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
-  WS2SC (os_name, (TCHAR *)w_filename, o_length);
+  WS2SC (os_name, (TCHAR *)w_filename, (DWORD)o_length);
   *o_length = strlen (os_name);
   strcpy (encoding, "encoding=utf8");
   *e_length = strlen (encoding);
@@ -1609,7 +1613,7 @@ __gnat_get_libraries_from_registry (void)
   for (index = 0; res == ERROR_SUCCESS; index++)
     {
       value_size = name_size = 256;
-      res = RegEnumValueA (reg_key, index, (TCHAR*)name, &name_size, 0,
+      res = RegEnumValueA (reg_key, index, name, &name_size, 0,
                            &type, (LPBYTE)value, &value_size);
 
       if (res == ERROR_SUCCESS && type == REG_SZ)
@@ -1661,7 +1665,7 @@ __gnat_stat (char *name, struct stat *statbuf)
   if (name_len == 2 && wname[1] == _T(':'))
     _tcscat (wname, _T("\\"));
 
-  return _tstat (wname, statbuf);
+  return _tstat (wname, (struct _stat *)statbuf);
 
 #else
   return stat (name, statbuf);
@@ -1861,12 +1865,18 @@ __gnat_is_readable_file (char *name)
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
   GENERIC_MAPPING GenericMapping;
 
-  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+  if (__gnat_use_acl)
+    {
+      S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
-  GenericMapping.GenericRead = GENERIC_READ;
+      ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
+      GenericMapping.GenericRead = GENERIC_READ;
+
+      return __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
+    }
+  else
+    return 1;
 
-  return __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
 #else
   int ret;
   int mode;
@@ -1887,12 +1897,18 @@ __gnat_is_writable_file (char *name)
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
-  GenericMapping.GenericWrite = GENERIC_WRITE;
+  if (__gnat_use_acl)
+    {
+      ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
+      GenericMapping.GenericWrite = GENERIC_WRITE;
+
+      return __gnat_check_OWNER_ACL
+       (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
+       && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
+    }
+  else
+    return !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
 
-  return __gnat_check_OWNER_ACL
-    (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
-    && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
 #else
   int ret;
   int mode;
@@ -1913,10 +1929,17 @@ __gnat_is_executable_file (char *name)
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
-  GenericMapping.GenericExecute = GENERIC_EXECUTE;
+  if (__gnat_use_acl)
+    {
+      ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
+      GenericMapping.GenericExecute = GENERIC_EXECUTE;
+
+      return __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
+    }
+  else
+    return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
+      && _tcsstr (wname, _T(".exe")) - wname == (_tcslen (wname) - 4);
 
-  return __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
 #else
   int ret;
   int mode;
@@ -1936,7 +1959,9 @@ __gnat_set_writable (char *name)
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_WRITE);
+  if (__gnat_use_acl)
+    __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_WRITE);
+
   SetFileAttributes
     (wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY);
 #elif ! defined (__vxworks) && ! defined(__nucleus__)
@@ -1956,9 +1981,12 @@ __gnat_set_executable (char *name)
 #if defined (_WIN32) && !defined (RTX)
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
-  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+  if (__gnat_use_acl)
+    {
+      S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
+      __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
+    }
 #elif ! defined (__vxworks) && ! defined(__nucleus__)
   struct stat statbuf;
 
@@ -1978,10 +2006,12 @@ __gnat_set_non_writable (char *name)
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  __gnat_set_OWNER_ACL
-    (wname, DENY_ACCESS,
-     FILE_WRITE_DATA | FILE_APPEND_DATA |
-     FILE_WRITE_EA | FILE_WRITE_ATTRIBUTES);
+  if (__gnat_use_acl)
+    __gnat_set_OWNER_ACL
+      (wname, DENY_ACCESS,
+       FILE_WRITE_DATA | FILE_APPEND_DATA |
+       FILE_WRITE_EA | FILE_WRITE_ATTRIBUTES);
+
   SetFileAttributes
     (wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY);
 #elif ! defined (__vxworks) && ! defined(__nucleus__)
@@ -2001,9 +2031,12 @@ __gnat_set_readable (char *name)
 #if defined (_WIN32) && !defined (RTX)
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
-  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+  if (__gnat_use_acl)
+    {
+      S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
+      __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
+    }
 #elif ! defined (__vxworks) && ! defined(__nucleus__)
   struct stat statbuf;
 
@@ -2020,9 +2053,12 @@ __gnat_set_non_readable (char *name)
 #if defined (_WIN32) && !defined (RTX)
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
-  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+  if (__gnat_use_acl)
+    {
+      S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  __gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
+      __gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
+    }
 #elif ! defined (__vxworks) && ! defined(__nucleus__)
   struct stat statbuf;
 

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 7374b97..0497529 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4033,6 +4033,7 @@ package body Sem_Ch3 is
          --  pre-allocate a freeze node, and set the proper link to the first
          --  subtype. Freeze_Entity will use this preallocated freeze node when
          --  it freezes the entity.
+
          --  This does not apply if the base type is a generic type, whose
          --  declaration is independent of the current derived definition.
 
@@ -5063,27 +5064,26 @@ package body Sem_Ch3 is
                Lo :=
                   Make_Attribute_Reference (Loc,
                     Attribute_Name => Name_First,
-                    Prefix => New_Reference_To (Derived_Type, Loc));
+                    Prefix         => New_Reference_To (Derived_Type, Loc));
                Set_Etype (Lo, Derived_Type);
 
                Hi :=
                   Make_Attribute_Reference (Loc,
                     Attribute_Name => Name_Last,
-                    Prefix => New_Reference_To (Derived_Type, Loc));
+                    Prefix         => New_Reference_To (Derived_Type, Loc));
                Set_Etype (Hi, Derived_Type);
 
                Set_Scalar_Range (Derived_Type,
                   Make_Range (Loc,
-                    Low_Bound => Lo,
+                    Low_Bound  => Lo,
                     High_Bound => Hi));
             else
 
                --   Analyze subtype indication and verify compatibility
                --   with parent type.
 
-               if
-                  Base_Type
-                    (Process_Subtype (Indic, N)) /= Base_Type (Parent_Type)
+               if Base_Type (Process_Subtype (Indic, N)) /=
+                  Base_Type (Parent_Type)
                then
                   Error_Msg_N
                     ("illegal constraint for formal discrete type", N);
@@ -13607,7 +13607,7 @@ package body Sem_Ch3 is
                     "full declaration of } must be a record extension",
                     Prev, Id);
 
-                  --  Set some attributes to produce a usable full view.
+                  --  Set some attributes to produce a usable full view
 
                   Set_Is_Tagged_Type (Id);
                   Set_Primitive_Operations (Id, New_Elmt_List);