[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

gcc/ada/ChangeLog

+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.

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 *

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);

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))) ..

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;