[multiple changes]

2009-04-20  Ed Schonberg  <schonberg@adacore.com>

	* inline.adb (Add_Inlined_Subprogram): Do not place on the back-end
	list a caller of an inlined subprogram, if the caller itself is not
	called.

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

	* adaint.c: Disable use of ACL on network drives.

2009-04-20  Arnaud Charlet  <charlet@adacore.com>

	* gnat_ugn.texi: Add examples.

From-SVN: r146374

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ce73813cf748bd9e3332a2bc665dab1391cefc74..44f54ee4d21902d44653e35fde8b2bebdba1553d 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+2009-04-20  Ed Schonberg  <schonberg@adacore.com>
+
+       * inline.adb (Add_Inlined_Subprogram): Do not place on the back-end
+       list a caller of an inlined subprogram, if the caller itself is not
+       called.
+
+2009-04-20  Pascal Obry  <obry@adacore.com>
+
+       * adaint.c: Disable use of ACL on network drives.
+
+2009-04-20  Arnaud Charlet  <charlet@adacore.com>
+
+       * gnat_ugn.texi: Add examples.
+
 2009-04-20  Thomas Quinot  <quinot@adacore.com>
 
        * g-socket.ads (Abort_Selector): Clarify documentation.

diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 9ab2c201970df260d4447784b072bf2553b5bc0e..e49e0f05cc443753398446fb7b971a0670e0123e 100644 (file)
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -1746,6 +1746,65 @@ __gnat_is_directory (char *name)
 }
 
 #if defined (_WIN32) && !defined (RTX)
+
+/* Returns the same constant as GetDriveType but takes a pathname as
+   argument. */
+
+static UINT
+GetDriveTypeFromPath (TCHAR *wfullpath)
+{
+  TCHAR wdrv[MAX_PATH];
+  TCHAR wpath[MAX_PATH];
+  TCHAR wfilename[MAX_PATH];
+  TCHAR wext[MAX_PATH];
+
+  _tsplitpath (wfullpath, wdrv, wpath, wfilename, wext);
+
+  if (_tcslen (wdrv) != 0)
+    {
+      /* we have a drive specified. */
+      _tcscat (wdrv, _T("\\"));
+      return GetDriveType (wdrv);
+    }
+  else
+    {
+      /* No drive specified. */
+
+      /* Is this a relative path, if so get current drive type. */
+      if (wpath[0] != _T('\\') ||
+         (_tcslen (wpath) > 2 && wpath[0] == _T('\\') && wpath[1] != _T('\\')))
+       return GetDriveType (NULL);
+
+      UINT result = GetDriveType (wpath);
+
+      /* Cannot guess the drive type, is this \\.\ ? */
+
+      if (result == DRIVE_NO_ROOT_DIR &&
+        _tcslen (wpath) >= 4 && wpath[0] == _T('\\') && wpath[1] == _T('\\')
+         && wpath[2] == _T('.') && wpath[3] == _T('\\'))
+       {
+         if (_tcslen (wpath) == 4)
+           _tcscat (wpath, wfilename);
+
+         LPTSTR p = &wpath[4];
+         LPTSTR b = _tcschr (p, _T('\\'));
+
+         if (b != NULL)
+           { /* logical drive \\.\c\dir\file */
+             *b++ = _T(':');
+             *b++ = _T('\\');
+             *b = _T('\0');
+           }
+         else
+           _tcscat (p, _T(":\\"));
+
+         return GetDriveType (p);
+       }
+
+      return result;
+    }
+}
+
 /*  This MingW section contains code to work with ACL. */
 static int
 __gnat_check_OWNER_ACL
@@ -1856,6 +1915,16 @@ __gnat_set_OWNER_ACL
   LocalFree (pSD);
   LocalFree (pNewDACL);
 }
+
+/* Check if it is possible to use ACL for wname, the file must not be on a
+   network drive. */
+
+static int
+__gnat_can_use_acl (TCHAR *wname)
+{
+  return __gnat_use_acl && GetDriveTypeFromPath (wname) != DRIVE_REMOTE;
+}
+
 #endif /* defined (_WIN32) && !defined (RTX) */
 
 int
@@ -1865,10 +1934,10 @@ __gnat_is_readable_file (char *name)
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
   GENERIC_MAPPING GenericMapping;
 
-  if (__gnat_use_acl)
-    {
-      S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
+  if (__gnat_can_use_acl (wname))
+    {
       ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
       GenericMapping.GenericRead = GENERIC_READ;
 
@@ -1897,7 +1966,7 @@ __gnat_is_writable_file (char *name)
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  if (__gnat_use_acl)
+  if (__gnat_can_use_acl (wname))
     {
       ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
       GenericMapping.GenericWrite = GENERIC_WRITE;
@@ -1929,7 +1998,7 @@ __gnat_is_executable_file (char *name)
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  if (__gnat_use_acl)
+  if (__gnat_can_use_acl (wname))
     {
       ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
       GenericMapping.GenericExecute = GENERIC_EXECUTE;
@@ -1959,7 +2028,7 @@ __gnat_set_writable (char *name)
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  if (__gnat_use_acl)
+  if (__gnat_can_use_acl (wname))
     __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_WRITE);
 
   SetFileAttributes
@@ -1981,12 +2050,11 @@ __gnat_set_executable (char *name)
 #if defined (_WIN32) && !defined (RTX)
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
-  if (__gnat_use_acl)
-    {
-      S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+
+  if (__gnat_can_use_acl (wname))
+    __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;
 
@@ -2006,7 +2074,7 @@ __gnat_set_non_writable (char *name)
 
   S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
 
-  if (__gnat_use_acl)
+  if (__gnat_can_use_acl (wname))
     __gnat_set_OWNER_ACL
       (wname, DENY_ACCESS,
        FILE_WRITE_DATA | FILE_APPEND_DATA |
@@ -2031,12 +2099,11 @@ __gnat_set_readable (char *name)
 #if defined (_WIN32) && !defined (RTX)
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
-  if (__gnat_use_acl)
-    {
-      S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+
+  if (__gnat_can_use_acl (wname))
+    __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;
 
@@ -2053,12 +2120,11 @@ __gnat_set_non_readable (char *name)
 #if defined (_WIN32) && !defined (RTX)
   TCHAR wname [GNAT_MAX_PATH_LEN + 2];
 
-  if (__gnat_use_acl)
-    {
-      S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+  S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
+
+  if (__gnat_can_use_acl (wname))
+    __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/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 70022f30c6e70c0bb1fdda6d6191557e4be01eeb..14ef44656289e837bcc1e570463223d8b9e1f34c 100644 (file)
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -22375,6 +22375,98 @@ multiple inheritance of abstract classes will be mapped to Ada interfaces
 (@xref{Interfacing to C++,,,gnat_rm, GNAT Reference Manual}, for additional
 information on interfacing to C++).
 
+For example, given the following C++ header file:
+
+@smallexample
+@group
+@cartouche
+class Carnivore @{
+public:
+   virtual int Number_Of_Teeth () = 0;
+@};
+
+class Domestic @{
+public:
+   virtual void Set_Owner (char* Name) = 0;
+@};
+
+class Animal @{
+public:
+  int Age_Count;
+  virtual void Set_Age (int New_Age);
+@};
+
+class Dog : Animal, Carnivore, Domestic @{
+ public:
+  int  Tooth_Count;
+  char *Owner;
+
+  virtual int  Number_Of_Teeth ();
+  virtual void Set_Owner (char* Name);
+
+  Dog();
+@};
+@end cartouche
+@end group
+@end smallexample
+
+The corresponding Ada code is generated:
+
+@smallexample @c ada
+@group
+@cartouche
+  package Class_Carnivore is
+    type Carnivore is limited interface;
+    pragma Import (CPP, Carnivore);
+
+    function Number_Of_Teeth (this : access Carnivore) return int is abstract;
+  end;
+  use Class_Carnivore;
+
+  package Class_Domestic is
+    type Domestic is limited interface;
+    pragma Import (CPP, Domestic);
+
+    procedure Set_Owner
+      (this : access Domestic;
+       Name : Interfaces.C.Strings.chars_ptr) is abstract;
+  end;
+  use Class_Domestic;
+
+  package Class_Animal is
+    type Animal is tagged limited record
+      Age_Count : aliased int;
+    end record;
+    pragma Import (CPP, Animal);
+
+    procedure Set_Age (this : access Animal; New_Age : int);
+    pragma Import (CPP, Set_Age, "_ZN6Animal7Set_AgeEi");
+  end;
+  use Class_Animal;
+
+  package Class_Dog is
+    type Dog is new Animal and Carnivore and Domestic with record
+      Tooth_Count : aliased int;
+      Owner : Interfaces.C.Strings.chars_ptr;
+    end record;
+    pragma Import (CPP, Dog);
+
+    function Number_Of_Teeth (this : access Dog) return int;
+    pragma Import (CPP, Number_Of_Teeth, "_ZN3Dog15Number_Of_TeethEv");
+
+    procedure Set_Owner
+      (this : access Dog; Name : Interfaces.C.Strings.chars_ptr);
+    pragma Import (CPP, Set_Owner, "_ZN3Dog9Set_OwnerEPc");
+
+    function New_Dog return Dog'Class;
+    pragma CPP_Constructor (New_Dog);
+    pragma Import (CPP, New_Dog, "_ZN3DogC1Ev");
+  end;
+  use Class_Dog;
+@end cartouche
+@end group
+@end smallexample
+
 @node Switches
 @section Switches
 

diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 33b4372ed6ed02ff5e977a3207493fecf8f33940..6fe50fd37d43f65924a7b13cfa4a7ea2233c8c21 100644 (file)
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -500,12 +500,21 @@ package body Inline is
 
       Inlined.Table (Index).Listed := True;
 
+      --  Now add to the list those callers of the current subprogram that
+      --  are themselves called. They may appear on the graph as callers
+      --  of the current one, even if they are themselves not called, and
+      --  there is no point in including them in the list for the backend.
+      --  Furthermore, they might not even be public, in which case the
+      --  back-end cannot handle them at all.
+
       Succ := Inlined.Table (Index).First_Succ;
       while Succ /= No_Succ loop
          Subp := Successors.Table (Succ).Subp;
          Inlined.Table (Subp).Count := Inlined.Table (Subp).Count - 1;
 
-         if Inlined.Table (Subp).Count = 0 then
+         if Inlined.Table (Subp).Count = 0
+           and then Is_Called (Inlined.Table (Subp).Name)
+         then
             Add_Inlined_Subprogram (Subp);
          end if;