+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.
{
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);
#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
}
__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);
}
__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);
}
}
return (OS_Time) ret;
#else
- struct stat statbuf;
+ STRUCT_STAT statbuf;
if (__gnat_stat (name, &statbuf) != 0) {
return (OS_Time)-1;
} else {
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
}
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
return _tstat (wname, (struct _stat *)statbuf);
#else
- return stat (name, statbuf);
+ return STAT (name, statbuf);
#endif
}
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
__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));
__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));
#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
#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
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
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);
__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);
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);
__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);
}
__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));
}
#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
return 0;
#else
- struct stat fbuf;
+ STRUCT_STAT fbuf;
struct utimbuf tbuf;
- if (stat (from, &fbuf) == -1)
+ if (STAT (from, &fbuf) == -1)
{
return -1;
}
#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;
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 *);
__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
__gnat_init_float();
#endif
- ret = fstat (fd, &statbuf);
+ ret = FSTAT (fd, &statbuf);
return (!ret && S_ISREG (statbuf.st_mode));
}
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.
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
-- 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;
+ 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'
then
Subunit := False;
- if
- Unit_Data.File_Names (Specification).Name = No_File
- or else
- Unit_Data.File_Names
- (Specification).Path.Name = Slash
+ 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
-- this is a subunit, because gnatls will complain
-- about subunits.
declare
- Src_Ind : Source_File_Index;
-
+ Src_Ind : constant Source_File_Index :=
+ Sinput.P.Load_Project_File
+ (Get_Name_String
+ (Unit_Data.File_Names
+ (Body_Part).Path.Name));
begin
- Src_Ind := Sinput.P.Load_Project_File
- (Get_Name_String
- (Unit_Data.File_Names
- (Body_Part).Path.Name));
-
Subunit :=
- Sinput.P.Source_File_Is_Subunit
- (Src_Ind);
+ Sinput.P.Source_File_Is_Subunit (Src_Ind);
end;
end if;
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
-- but not the subunits.
elsif The_Command = Stack then
- if
- Unit_Data.File_Names (Body_Part).Name /= No_File
- and then
- Unit_Data.File_Names (Body_Part).Path.Name /= Slash
+ 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
- (Specification).Path.Name = Slash
+ 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 this is a subunit, because .ci files are not
-- generated for subunits.
declare
- Src_Ind : Source_File_Index;
-
+ Src_Ind : constant Source_File_Index :=
+ Sinput.P.Load_Project_File
+ (Get_Name_String
+ (Unit_Data.File_Names
+ (Body_Part).Path.Name));
begin
- Src_Ind := Sinput.P.Load_Project_File
- (Get_Name_String
- (Unit_Data.File_Names
- (Body_Part).Path.Name));
-
Subunit :=
Sinput.P.Source_File_Is_Subunit (Src_Ind);
end;
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
+ 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
end if;
end if;
end loop;
-
- if FD /= Invalid_FD then
- Close (FD, Success);
-
- if not Success then
- Osint.Fail ("disk full");
- end if;
- end if;
end if;
end loop;
end;
+
+ if FD /= Invalid_FD then
+ Close (FD, Success);
+
+ if not Success then
+ Osint.Fail ("disk full");
+ end if;
+ end if;
end if;
end Check_Files;
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.
projects / gcc.git / commitdiff