Skip to content

R
riscv-gcc-1
Commit f8b86c2d by Arnaud Charlet
Options

[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
parent efec4f2a
Showing with 204 additions and 23 deletions
gcc/ada/ChangeLog
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.
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;
......
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
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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment