aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog14
-rw-r--r--gcc/ada/adaint.c110
-rw-r--r--gcc/ada/gnat_ugn.texi92
-rw-r--r--gcc/ada/inline.adb11
4 files changed, 204 insertions, 23 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ce73813..44f54ee 100644
--- 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 9ab2c20..e49e0f0 100644
--- 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 70022f3..14ef446 100644
--- 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 33b4372..6fe50fd 100644
--- 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;
generated by cgit v1.1 at 2025-06-05 19:39:02 +0000