From 876f16240d138e8efdb47939f906d4fcfa234fdb Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 18 Apr 2016 12:52:05 +0200 Subject: [PATCH] [multiple changes] 2016-04-18 Gary Dismukes * 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 * adaint.c, adaint.h, s-os_lib.ads: Add new routine Current_Process_Id. From-SVN: r235128 --- gcc/ada/ChangeLog | 10 ++++++++++ gcc/ada/adaint.c | 16 ++++++++++++++++ gcc/ada/adaint.h | 3 ++- gcc/ada/s-os_lib.ads | 5 +++++ gcc/ada/sem_ch13.adb | 9 +++++---- 5 files changed, 38 insertions(+), 5 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b5ed10086ff..a8a6f5c7e0d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2016-04-18 Gary Dismukes + + * 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 + + * adaint.c, adaint.h, s-os_lib.ads: Add new routine Current_Process_Id. + 2016-04-18 Hristian Kirtchev * stringt.adb, exp_ch6.adb, sem_ch13.adb: Minor reformatting. diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 3053c69f504..a9a5b684df8 100644 --- 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 09fc83c5da1..5df192677c5 100644 --- 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 985f492ebef..f53c2ec1a58 100644 --- 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 b168a9e1010..01760a2ba5e 100644 --- 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; -- 2.30.2