[multiple changes]

2016-04-18  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch13.adb (Has_Good_Profile): Improvement
	of error message. Now indicates subtype_mark of formal parameter
	rather than the formal's name, plus minor rewording.

2016-04-18  Pascal Obry  <obry@adacore.com>

	* adaint.c, adaint.h, s-os_lib.ads: Add new routine Current_Process_Id.

From-SVN: r235128

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b5ed10086ff58830460d60d4c81c6559b4d5763c..a8a6f5c7e0d56a30f14857b2057cf476da850e71 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2016-04-18  Gary Dismukes  <dismukes@adacore.com>
+
+       * sem_ch13.adb (Has_Good_Profile): Improvement
+       of error message. Now indicates subtype_mark of formal parameter
+       rather than the formal's name, plus minor rewording.
+
+2016-04-18  Pascal Obry  <obry@adacore.com>
+
+       * adaint.c, adaint.h, s-os_lib.ads: Add new routine Current_Process_Id.
+
 2016-04-18  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * stringt.adb, exp_ch6.adb, sem_ch13.adb: Minor reformatting.

diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 3053c69f504c4a09faa12a7be679ec51a807d595..a9a5b684df8b81c0f3ddd39e8768707f8bef580a 100644 (file)
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -2613,6 +2613,22 @@ __gnat_os_exit (int status)
   exit (status);
 }
 
+int
+__gnat_current_process_id (void)
+{
+#if defined (__vxworks) || defined (__PikeOS__)
+  return -1;
+
+#elif defined (_WIN32)
+
+  return (int)GetCurrentProcessId();
+
+#else
+
+  return (int)getpid();
+#endif
+}
+
 /* Locate file on path, that matches a predicate */
 
 char *

diff --git a/gcc/ada/adaint.h b/gcc/ada/adaint.h
index 09fc83c5da1fc0d7def5200b2cdbbbfe8feceeb1..5df192677c57f2f98ff4b7412b4aa49b64e47513 100644 (file)
--- a/gcc/ada/adaint.h
+++ b/gcc/ada/adaint.h
@@ -206,8 +206,9 @@ extern int    __gnat_is_symbolic_link                  (char *name);
 extern int    __gnat_portable_spawn                (char *[]);
 extern int    __gnat_portable_no_block_spawn       (char *[]);
 extern int    __gnat_portable_wait                 (int *);
+extern int    __gnat_current_process_id            (void);
 extern char  *__gnat_locate_exec                   (char *, char *);
-extern char  *__gnat_locate_exec_on_path          (char *);
+extern char  *__gnat_locate_exec_on_path           (char *);
 extern char  *__gnat_locate_regular_file           (char *, char *);
 extern void   __gnat_maybe_glob_args               (int *, char ***);
 extern void   __gnat_os_exit                      (int);

diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads
index 985f492ebef304e26665e92544c904d4d2289f0c..f53c2ec1a583191b3abb144062438dcc47b80fc3 100644 (file)
--- a/gcc/ada/s-os_lib.ads
+++ b/gcc/ada/s-os_lib.ads
@@ -723,6 +723,10 @@ package System.OS_Lib is
    Invalid_Pid : constant Process_Id;
    --  A special value used to indicate errors, as described below
 
+   function Current_Process_Id return Process_Id;
+   --  Returns the current process id or Invalid_Pid if not supported by the
+   --  runtime.
+
    function Argument_String_To_List
      (Arg_String : String) return Argument_List_Access;
    --  Take a string that is a program and its arguments and parse it into an
@@ -1060,6 +1064,7 @@ private
    pragma Import (C, Path_Separator, "__gnat_path_separator");
    pragma Import (C, Directory_Separator, "__gnat_dir_separator");
    pragma Import (C, Current_Time, "__gnat_current_time");
+   pragma Import (C, Current_Process_Id, "__gnat_current_process_id");
 
    type OS_Time is
      range -(2 ** (Standard'Address_Size - Integer'(1))) ..

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index b168a9e1010c1e5e6e5a5951592837b485c065f1..01760a2ba5e6d95bdd0fb451891349abda4f7444 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -3752,14 +3752,14 @@ package body Sem_Ch13 is
          Pnam : Entity_Id;
 
          Is_Read : constant Boolean := (TSS_Nam = TSS_Stream_Read);
-         --  True for Read attribute, false for other attributes
+         --  True for Read attribute, False for other attributes
 
          function Has_Good_Profile
            (Subp   : Entity_Id;
             Report : Boolean := False) return Boolean;
          --  Return true if the entity is a subprogram with an appropriate
-         --  profile for the attribute being defined. If result is false and
-         --  Report is True function emits appropriate error.
+         --  profile for the attribute being defined. If result is False and
+         --  Report is True, function emits appropriate error.
 
          ----------------------
          -- Has_Good_Profile --
@@ -3844,7 +3844,8 @@ package body Sem_Ch13 is
             then
                if Report and not Is_First_Subtype (Typ) then
                   Error_Msg_N
-                    ("formal of stream operation must be a first subtype", F);
+                    ("subtype of formal in stream operation must be a first "
+                     & "subtype", Parameter_Type (Parent (F)));
                end if;
 
                return False;