[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

7 files changed, 170 insertions, 112 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ff2e306..bce6871 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,22 @@
+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.
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index dd36bac..59d615b 100644
--- a/gcc/ada/adaint.c
+++ b/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;
     }
diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h
index 46c1f2f..a5243f1 100644
--- a/gcc/ada/adaint.h
+++ b/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 *);
diff --git a/gcc/ada/cstreams.c b/gcc/ada/cstreams.c
index 09c3b9d..2177fdc 100644
--- a/gcc/ada/cstreams.c
+++ b/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));
 }
 
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index d936e23..0fda13b 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/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
diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb
index 9e335d1..3f5bb6d 100644
--- a/gcc/ada/gnatcmd.adb
+++ b/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;
+            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,28 +430,23 @@ procedure GNATCmd is
                      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;
 
@@ -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,39 +486,33 @@ procedure GNATCmd is
                --  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;
@@ -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
+                      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,17 +597,17 @@ procedure GNATCmd is
                         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;
 
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 9a0f878..239742a 100644
--- a/gcc/ada/sem_disp.adb
+++ b/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.