Skip to content

R
riscv-gcc-1
Commit 03456e44 by Arnaud Charlet
Options

[multiple changes] 

2009-06-22  Vincent Celier  <celier@adacore.com>

	* gnatcmd.adb (Check_Files): Close temporary files after all file names
	have been written into it.

2009-06-22  Matthew Gingell  <gingell@adacore.com>

	* adaint.c, adaint.h, cstreams.c: Call stat64 on platforms where it is
	available.

2009-06-22  Thomas Quinot  <quinot@adacore.com>

	* sem_disp.adb (Check_Direct_Call): Handle the case where the full
	view of the root type is visible at the point of the call.

2009-06-22  Pat Rogers  <rogers@adacore.com>

	* gnat_ugn.texi: Revised a sentence to correct a minor grammar error.

From-SVN: r148781
parent 28326880
Showing with 155 additions and 97 deletions
gcc/ada/ChangeLog
2009-06-22 Vincent Celier <celier@adacore.com>
* gnatcmd.adb (Check_Files): Close temporary files after all file names
have been written into it.
2009-06-22 Matthew Gingell <gingell@adacore.com>
* adaint.c, adaint.h, cstreams.c: Call stat64 on platforms where it is
available.
2009-06-22 Thomas Quinot <quinot@adacore.com>
* sem_disp.adb (Check_Direct_Call): Handle the case where the full
view of the root type is visible at the point of the call.
2009-06-22 Pat Rogers <rogers@adacore.com>
* gnat_ugn.texi: Revised a sentence to correct a minor grammar error.
2009-06-22 Jerome Lambourg <lambourg@adacore.com>
* freeze.adb: Add comments.
......
gcc/ada/adaint.c
......@@ -520,7 +520,7 @@ __gnat_try_lock (char *dir, char *file)
{
char full_path[256];
char temp_file[256];
struct stat stat_result;
STRUCT_STAT stat_result;
int fd;
sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
......@@ -775,15 +775,7 @@ __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED)
#elif defined (VMS)
return decc$fopen (path, mode);
#else
#if defined (__GLIBC__) || defined (sun)
/* GLIBC and Solaris provides fopen64, which allows IO on files
larger than 2GB on systems that support it. */
return fopen64 (path, mode);
#else
return fopen (path, mode);
#endif
return FOPEN (path, mode);
#endif
}
......@@ -1027,12 +1019,16 @@ long
__gnat_file_length (int fd)
{
int ret;
struct stat statbuf;
STRUCT_STAT statbuf;
ret = fstat (fd, &statbuf);
ret = FSTAT (fd, &statbuf);
if (ret || !S_ISREG (statbuf.st_mode))
return 0;
/* st_size may be 32 bits, or 64 bits which is converted to long. We
don't return a useful value for files larger than 2 gigabytes in
either case. */
return (statbuf.st_size);
}
......@@ -1042,12 +1038,16 @@ long
__gnat_named_file_length (char *name)
{
int ret;
struct stat statbuf;
STRUCT_STAT statbuf;
ret = __gnat_stat (name, &statbuf);
if (ret || !S_ISREG (statbuf.st_mode))
return 0;
/* st_size may be 32 bits, or 64 bits which is converted to long. We
don't return a useful value for files larger than 2 gigabytes in
either case. */
return (statbuf.st_size);
}
......@@ -1269,7 +1269,7 @@ __gnat_file_time_name (char *name)
}
return (OS_Time) ret;
#else
struct stat statbuf;
STRUCT_STAT statbuf;
if (__gnat_stat (name, &statbuf) != 0) {
return (OS_Time)-1;
} else {
......@@ -1361,9 +1361,9 @@ __gnat_file_time_fd (int fd)
return (OS_Time) ret;
#else
struct stat statbuf;
STRUCT_STAT statbuf;
if (fstat (fd, &statbuf) != 0) {
if (FSTAT (fd, &statbuf) != 0) {
return (OS_Time) -1;
} else {
#ifdef VMS
......@@ -1651,7 +1651,7 @@ __gnat_get_libraries_from_registry (void)
}
int
__gnat_stat (char *name, struct stat *statbuf)
__gnat_stat (char *name, STRUCT_STAT *statbuf)
{
#ifdef __MINGW32__
/* Under Windows the directory name for the stat function must not be
......@@ -1683,7 +1683,7 @@ __gnat_stat (char *name, struct stat *statbuf)
return _tstat (wname, (struct _stat *)statbuf);
#else
return stat (name, statbuf);
return STAT (name, statbuf);
#endif
}
......@@ -1699,7 +1699,7 @@ __gnat_file_exists (char *name)
S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
#else
struct stat statbuf;
STRUCT_STAT statbuf;
return !__gnat_stat (name, &statbuf);
#endif
......@@ -1744,7 +1744,7 @@ int
__gnat_is_regular_file (char *name)
{
int ret;
struct stat statbuf;
STRUCT_STAT statbuf;
ret = __gnat_stat (name, &statbuf);
return (!ret && S_ISREG (statbuf.st_mode));
......@@ -1754,7 +1754,7 @@ int
__gnat_is_directory (char *name)
{
int ret;
struct stat statbuf;
STRUCT_STAT statbuf;
ret = __gnat_stat (name, &statbuf);
return (!ret && S_ISDIR (statbuf.st_mode));
......@@ -1972,9 +1972,9 @@ __gnat_is_readable_file (char *name)
#else
int ret;
int mode;
struct stat statbuf;
STRUCT_STAT statbuf;
ret = stat (name, &statbuf);
ret = STAT (name, &statbuf);
mode = statbuf.st_mode & S_IRUSR;
return (!ret && mode);
#endif
......@@ -2004,9 +2004,9 @@ __gnat_is_writable_file (char *name)
#else
int ret;
int mode;
struct stat statbuf;
STRUCT_STAT statbuf;
ret = stat (name, &statbuf);
ret = STAT (name, &statbuf);
mode = statbuf.st_mode & S_IWUSR;
return (!ret && mode);
#endif
......@@ -2031,13 +2031,12 @@ __gnat_is_executable_file (char *name)
else
return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
&& _tcsstr (wname, _T(".exe")) - wname == (int) (_tcslen (wname) - 4);
#else
int ret;
int mode;
struct stat statbuf;
STRUCT_STAT statbuf;
ret = stat (name, &statbuf);
ret = STAT (name, &statbuf);
mode = statbuf.st_mode & S_IXUSR;
return (!ret && mode);
#endif
......@@ -2057,9 +2056,9 @@ __gnat_set_writable (char *name)
SetFileAttributes
(wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY);
#elif ! defined (__vxworks) && ! defined(__nucleus__)
struct stat statbuf;
STRUCT_STAT statbuf;
if (stat (name, &statbuf) == 0)
if (STAT (name, &statbuf) == 0)
{
statbuf.st_mode = statbuf.st_mode | S_IWUSR;
chmod (name, statbuf.st_mode);
......@@ -2079,9 +2078,9 @@ __gnat_set_executable (char *name)
__gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
#elif ! defined (__vxworks) && ! defined(__nucleus__)
struct stat statbuf;
STRUCT_STAT statbuf;
if (stat (name, &statbuf) == 0)
if (STAT (name, &statbuf) == 0)
{
statbuf.st_mode = statbuf.st_mode | S_IXUSR;
chmod (name, statbuf.st_mode);
......@@ -2106,9 +2105,9 @@ __gnat_set_non_writable (char *name)
SetFileAttributes
(wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY);
#elif ! defined (__vxworks) && ! defined(__nucleus__)
struct stat statbuf;
STRUCT_STAT statbuf;
if (stat (name, &statbuf) == 0)
if (STAT (name, &statbuf) == 0)
{
statbuf.st_mode = statbuf.st_mode & 07577;
chmod (name, statbuf.st_mode);
......@@ -2128,9 +2127,9 @@ __gnat_set_readable (char *name)
__gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
#elif ! defined (__vxworks) && ! defined(__nucleus__)
struct stat statbuf;
STRUCT_STAT statbuf;
if (stat (name, &statbuf) == 0)
if (STAT (name, &statbuf) == 0)
{
chmod (name, statbuf.st_mode | S_IREAD);
}
......@@ -2149,9 +2148,9 @@ __gnat_set_non_readable (char *name)
__gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
#elif ! defined (__vxworks) && ! defined(__nucleus__)
struct stat statbuf;
STRUCT_STAT statbuf;
if (stat (name, &statbuf) == 0)
if (STAT (name, &statbuf) == 0)
{
chmod (name, statbuf.st_mode & (~S_IREAD));
}
......@@ -2166,9 +2165,9 @@ __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
#elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
int ret;
struct stat statbuf;
STRUCT_STAT statbuf;
ret = lstat (name, &statbuf);
ret = LSTAT (name, &statbuf);
return (!ret && S_ISLNK (statbuf.st_mode));
#else
......@@ -3435,10 +3434,10 @@ __gnat_copy_attribs (char *from, char *to, int mode)
return 0;
#else
struct stat fbuf;
STRUCT_STAT fbuf;
struct utimbuf tbuf;
if (stat (from, &fbuf) == -1)
if (STAT (from, &fbuf) == -1)
{
return -1;
}
......
gcc/ada/adaint.h
......@@ -43,6 +43,24 @@
#define Encoding_8bits 1 /* Standard 8bits, CP_ACP on Windows. */
#define Encoding_Unspecified 2 /* Based on GNAT_CODE_PAGE env variable. */
/* Large file support. It is unclear what portable mechanism we can
use to determine at compile time what support the system offers for
large files. For now we just list the platforms we have manually
tested. */
#if defined (__GLIBC__) || defined (sun) || defined (__sgi)
#define FOPEN fopen64
#define STAT stat64
#define FSTAT fstat64
#define LSTAT lstat64
#define STRUCT_STAT struct stat64
#else
#define FOPEN fopen
#define STAT stat
#define FSTAT fstat
#define STRUCT_STAT struct stat
#endif
typedef long OS_Time; /* Type corresponding to GNAT.OS_Lib.OS_Time */
extern int __gnat_max_path_len;
......@@ -70,7 +88,7 @@ extern int __gnat_open_new (char *, int);
extern int __gnat_open_new_temp (char *, int);
extern int __gnat_mkdir (char *);
extern int __gnat_stat (char *,
struct stat *);
STRUCT_STAT *);
extern int __gnat_unlink (char *);
extern int __gnat_rename (char *, char *);
extern int __gnat_chdir (char *);
......
gcc/ada/cstreams.c
......@@ -96,7 +96,7 @@ int
__gnat_is_regular_file_fd (int fd)
{
int ret;
struct stat statbuf;
STRUCT_STAT statbuf;
#ifdef __EMX__
/* Programs using screen I/O may need to reset the FPU after
......@@ -107,7 +107,7 @@ __gnat_is_regular_file_fd (int fd)
__gnat_init_float();
#endif
ret = fstat (fd, &statbuf);
ret = FSTAT (fd, &statbuf);
return (!ret && S_ISREG (statbuf.st_mode));
}
......
gcc/ada/gnat_ugn.texi
......@@ -17693,8 +17693,9 @@ considered to be a class. A category consists of a library package (or
a library generic package) that defines a tagged or an interface type,
together with all its descendant (generic) packages that define tagged
or interface types. For any package counted as a class,
its body (if any) is considered
together with its spec when counting the dependencies. For dependencies
its body and subunits (if any) are considered
together with its spec when counting the dependencies, and coupling
metrics are reported for spec units only. For dependencies
between classes, the Ada semantic dependencies are considered.
For coupling metrics, only dependencies on units that are considered as
classes, are considered.
......@@ -18891,9 +18892,10 @@ units are called @emph{interface units} (@pxref{Stand-alone Ada Libraries}).
All compilation units comprising an application, including those in a library,
need to be elaborated in an order partially defined by Ada's semantics. GNAT
computes the elaboration order from the @file{ALI} files and this is why they
constitute a mandatory part of GNAT libraries. Except in the case of
@emph{stand-alone libraries}, where a specific library elaboration routine is
produced independently of the application(s) using the library.
constitute a mandatory part of GNAT libraries.
@emph{Stand-alone libraries} are the exception to this rule because a specific
library elaboration routine is produced independently of the application(s)
using the library.
@node General Ada Libraries
@section General Ada Libraries
gcc/ada/gnatcmd.adb
......@@ -330,36 +330,36 @@ procedure GNATCmd is
-- For gnatcheck, gnatpp and gnatmetric , create a temporary file and
-- put the list of sources in it.
if The_Command = Check
or else The_Command = Pretty
or else The_Command = Metric
if The_Command = Check or else
The_Command = Pretty or else
The_Command = Metric
then
Tempdir.Create_Temp_File (FD, Temp_File_Name);
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'("-files=" & Get_Name_String (Temp_File_Name));
end if;
declare
Proj : Project_List;
begin
-- Gnatstack needs to add the .ci file for the binder
-- generated files corresponding to all of the library projects
-- and main units belonging to the application.
-- Gnatstack needs to add the .ci file for the binder generated
-- files corresponding to all of the library projects and main
-- units belonging to the application.
if The_Command = Stack then
Proj := Project_Tree.Projects;
while Proj /= null loop
if Check_Project (Proj.Project, Project) then
declare
Main : String_List_Id := Proj.Project.Mains;
Main : String_List_Id;
File : String_Access;
begin
-- Include binder generated files for main programs
Main := Proj.Project.Mains;
while Main /= Nil_String loop
File :=
new String'
......@@ -430,10 +430,8 @@ procedure GNATCmd is
then
Subunit := False;
if
Unit_Data.File_Names (Specification).Name = No_File
or else
Unit_Data.File_Names
if Unit_Data.File_Names (Specification).Name = No_File
or else Unit_Data.File_Names
(Specification).Path.Name = Slash
then
-- We have a body with no spec: we need to check if
......@@ -441,17 +439,14 @@ procedure GNATCmd is
-- about subunits.
declare
Src_Ind : Source_File_Index;
begin
Src_Ind := Sinput.P.Load_Project_File
Src_Ind : constant Source_File_Index :=
Sinput.P.Load_Project_File
(Get_Name_String
(Unit_Data.File_Names
(Body_Part).Path.Name));
begin
Subunit :=
Sinput.P.Source_File_Is_Subunit
(Src_Ind);
Sinput.P.Source_File_Is_Subunit (Src_Ind);
end;
end if;
......@@ -470,7 +465,7 @@ procedure GNATCmd is
and then
Unit_Data.File_Names (Specification).Path.Name /= Slash
then
-- We have a spec with no body; check if it is for this
-- We have a spec with no body. Check if it is for this
-- project.
if All_Projects or else
......@@ -491,24 +486,20 @@ procedure GNATCmd is
-- but not the subunits.
elsif The_Command = Stack then
if
Unit_Data.File_Names (Body_Part).Name /= No_File
if Unit_Data.File_Names (Body_Part).Name /= No_File
and then
Unit_Data.File_Names (Body_Part).Path.Name /= Slash
then
-- There is a body. Check if .ci files for this project
-- must be added.
if
Check_Project
if Check_Project
(Unit_Data.File_Names (Body_Part).Project, Project)
then
Subunit := False;
if
Unit_Data.File_Names (Specification).Name = No_File
or else
Unit_Data.File_Names
if Unit_Data.File_Names (Specification).Name = No_File
or else Unit_Data.File_Names
(Specification).Path.Name = Slash
then
-- We have a body with no spec: we need to check
......@@ -516,14 +507,12 @@ procedure GNATCmd is
-- generated for subunits.
declare
Src_Ind : Source_File_Index;
begin
Src_Ind := Sinput.P.Load_Project_File
Src_Ind : constant Source_File_Index :=
Sinput.P.Load_Project_File
(Get_Name_String
(Unit_Data.File_Names
(Body_Part).Path.Name));
begin
Subunit :=
Sinput.P.Source_File_Is_Subunit (Src_Ind);
end;
......@@ -546,16 +535,14 @@ procedure GNATCmd is
end if;
end if;
elsif
Unit_Data.File_Names (Specification).Name /= No_File
elsif Unit_Data.File_Names (Specification).Name /= No_File
and then
Unit_Data.File_Names (Specification).Path.Name /= Slash
then
-- We have a spec with no body. Check if it is for this
-- project.
if
Check_Project
if Check_Project
(Unit_Data.File_Names (Specification).Project,
Project)
then
......@@ -610,6 +597,9 @@ procedure GNATCmd is
end if;
end if;
end loop;
end if;
end loop;
end;
if FD /= Invalid_FD then
Close (FD, Success);
......@@ -619,9 +609,6 @@ procedure GNATCmd is
end if;
end if;
end if;
end loop;
end;
end if;
end Check_Files;
-------------------
......
gcc/ada/sem_disp.adb
......@@ -319,20 +319,53 @@ package body Sem_Disp is
procedure Check_Direct_Call is
Typ : Entity_Id := Etype (Control);
function Is_User_Defined_Equality (Id : Entity_Id) return Boolean;
-- Determine whether an entity denotes a user-defined equality
------------------------------
-- Is_User_Defined_Equality --
------------------------------
function Is_User_Defined_Equality (Id : Entity_Id) return Boolean is
begin
return
Ekind (Id) = E_Function
and then Chars (Id) = Name_Op_Eq
and then Comes_From_Source (Id)
-- Internally generated equalities have a full type declaration
-- as their parent.
and then Nkind (Parent (Id)) = N_Function_Specification;
end Is_User_Defined_Equality;
-- Start of processing for Check_Direct_Call
begin
-- Predefined primitives do not receive wrappers since they are built
-- from scratch for the corresponding record of synchronized types.
-- Equality is in general predefined, but is excluded from the check
-- when it is user-defined.
if Is_Predefined_Dispatching_Operation (Subp_Entity)
and then not Is_User_Defined_Equality (Subp_Entity)
then
return;
end if;
if Is_Class_Wide_Type (Typ) then
Typ := Root_Type (Typ);
end if;
-- Detect whether the controlling type is a private type completed
-- by a task or protected type.
if Is_Private_Type (Typ) and then Present (Full_View (Typ)) then
Typ := Full_View (Typ);
end if;
if Is_Private_Type (Typ)
and then Present (Full_View (Typ))
and then Is_Concurrent_Type (Full_View (Typ))
and then Present (Corresponding_Record_Type (Full_View (Typ)))
if Is_Concurrent_Type (Typ)
and then
Present (Corresponding_Record_Type (Typ))
then
Typ := Corresponding_Record_Type (Full_View (Typ));
Typ := Corresponding_Record_Type (Typ);
-- The concurrent record's list of primitives should contain a
-- wrapper for the entity of the call, retrieve it.
......
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