From: Arnaud Charlet Date: Mon, 18 Apr 2016 12:27:10 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=4afcf3a5a0391b309520cbcf5d4836d611bd7fd9;p=gcc.git [multiple changes] 2016-04-18 Gary Dismukes * lib-xref-spark_specific.adb, par-ch2.adb, errout.ads, exp_intr.adb: Minor reformatting and typo corrections. 2016-04-18 Ed Schonberg * sem_ch6.adb: Code cleanup. 2016-04-18 Thomas Quinot * sem_ch13.adb: Minor reformatting and error message tweaking (remove extraneous spaces). 2016-04-18 Johannes Kanig * gnat1drv.adb (Gnat1drv): Force loading of System unit for SPARK. 2016-04-18 Bob Duff * s-fileio.adb (Fopen_Mode): If Mode = Out_File, and the file exists, and it's a fifo, we use "w" as the open string instead of "r+". This is necessary to make a write to the fifo block until a reader is ready. 2016-04-18 Hristian Kirtchev * sem_attr.adb (Denote_Same_Function): Account for a special case where a primitive of a tagged type inherits a class-wide postcondition from a parent type. From-SVN: r235135 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 071966487d4..2ef1028a53e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,34 @@ +2016-04-18 Gary Dismukes + + * lib-xref-spark_specific.adb, par-ch2.adb, errout.ads, + exp_intr.adb: Minor reformatting and typo corrections. + +2016-04-18 Ed Schonberg + + * sem_ch6.adb: Code cleanup. + +2016-04-18 Thomas Quinot + + * sem_ch13.adb: Minor reformatting and error message tweaking + (remove extraneous spaces). + +2016-04-18 Johannes Kanig + + * gnat1drv.adb (Gnat1drv): Force loading of System unit for SPARK. + +2016-04-18 Bob Duff + + * s-fileio.adb (Fopen_Mode): If Mode = Out_File, and the file + exists, and it's a fifo, we use "w" as the open string instead of + "r+". This is necessary to make a write to the fifo block until + a reader is ready. + +2016-04-18 Hristian Kirtchev + + * sem_attr.adb (Denote_Same_Function): Account + for a special case where a primitive of a tagged type inherits + a class-wide postcondition from a parent type. + 2016-04-18 Hristian Kirtchev * par-ch2.adb (P_Expression_Or_Reserved_Word): New routine. diff --git a/gcc/ada/cstreams.c b/gcc/ada/cstreams.c index 915e4a3db1c..f0f826685b8 100644 --- a/gcc/ada/cstreams.c +++ b/gcc/ada/cstreams.c @@ -39,6 +39,8 @@ #include #include +#include +#include #ifdef _AIX /* needed to avoid conflicting declarations */ @@ -320,6 +322,24 @@ __gnat_fseek64 (FILE *stream, __int64 offset, int origin) } #endif +/* Returns true if the path names a fifo (i.e. a named pipe). */ +int +__gnat_is_fifo (const char* path) +{ +/* Posix defines S_ISFIFO as a macro. If the macro doesn't exist, we return + false. */ +#ifdef S_ISFIFO + struct stat buf; + const int status = stat(path, &buf); + if (status == 0) + return S_ISFIFO(buf.st_mode); +#endif + + /* S_ISFIFO is not available, or stat got an error (probably + file not found). */ + return 0; +} + #ifdef __cplusplus } #endif diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 70988b96bd9..fb41f79022d 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -907,14 +907,14 @@ package Errout is procedure Adjust_Name_Case (Buf : in out Bounded_String; Loc : Source_Ptr); - -- Given a name stored in Buf, set proper casing. Loc is an associated - -- source position, if we can find a match between the name in Buf and the - -- name at that source location, we copy the casing from the source, + -- Given a name stored in Buf, set proper casing. Loc is an associated + -- source position, and if we can find a match between the name in Buf and + -- the name at that source location, we copy the casing from the source, -- otherwise we set appropriate default casing. procedure Adjust_Name_Case (Loc : Source_Ptr); -- Uses Buf => Global_Name_Buffer. There are no calls to this in the - -- compiler, but it is called in SPARK2014. + -- compiler, but it is called in SPARK 2014. procedure Set_Identifier_Casing (Identifier_Name : System.Address; diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 63f6ccbbeb3..e4d45d5f09d 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -197,7 +197,7 @@ package body Exp_Intr is Temp : Bounded_String; procedure Inner (E : Entity_Id); - -- Inner recursive routine, keep outer routine non-recursive to ease + -- Inner recursive routine, keep outer routine nonrecursive to ease -- debugging when we get strange results from this routine. ----------- @@ -207,7 +207,7 @@ package body Exp_Intr is procedure Inner (E : Entity_Id) is begin -- If entity has an internal name, skip by it, and print its scope. - -- Note that we strip a final R from the name before the test, this + -- Note that we strip a final R from the name before the test; this -- is needed for some cases of instantiations. declare @@ -257,9 +257,9 @@ package body Exp_Intr is begin Append_Unqualified_Decoded (E_Name, Chars (E)); - -- Remove trailing upper case letters from the name (useful for + -- Remove trailing upper-case letters from the name (useful for -- dealing with some cases of internal names generated in the case - -- of references from within a generic. + -- of references from within a generic). while E_Name.Length > 1 and then E_Name.Chars (E_Name.Length) in 'A' .. 'Z' diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 29f2f942f9e..8ecababab00 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -1045,12 +1045,11 @@ begin Original_Operating_Mode := Operating_Mode; Frontend; - -- In GNATprove mode, force loading of System unit when tasking is - -- used, so that in particular System.Interrupt_Priority is available - -- to GNATprove for the generation of VCs for checking the respect of - -- Ceiling Protocol. + -- In GNATprove mode, force loading of System unit to ensure that + -- System.Interrupt_Priority is available to GNATprove for the + -- generation of VCs for related to Ceiling Priority. - if GNATprove_Mode and Opt.Tasking_Used then + if GNATprove_Mode then declare Unused_E : constant Entity_Id := Rtsfind.RTE (Rtsfind.RE_Interrupt_Priority); diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb index 67e0879ee01..f7409d9a916 100644 --- a/gcc/ada/lib-xref-spark_specific.adb +++ b/gcc/ada/lib-xref-spark_specific.adb @@ -271,10 +271,10 @@ package body SPARK_Specific is when E_Function | E_Procedure => - -- In in SPARK we need to distinguish protected functions and + -- In SPARK we need to distinguish protected functions and -- procedures from ordinary subprograms, but there are no special -- Xref letters for them. Since this distiction is only needed - -- to detect protected calls we pretent that such calls are entry + -- to detect protected calls, we pretend that such calls are entry -- calls. if Ekind (Scope (E)) = E_Protected_Type then diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb index 0e1fc34c02c..68e6275e058 100644 --- a/gcc/ada/par-ch2.adb +++ b/gcc/ada/par-ch2.adb @@ -490,7 +490,7 @@ package body Ch2 is Reserved_Words_OK : Boolean := False) is function P_Expression_Or_Reserved_Word return Node_Id; - -- Parse an expression or if the token denotes one of the following + -- Parse an expression or, if the token denotes one of the following -- reserved words, construct an identifier with proper Chars field. -- Access -- Delta @@ -644,7 +644,7 @@ package body Ch2 is if Identifier_OK then - -- Certain pragmas such as Restriction_Warninds and Restrictions + -- Certain pragmas such as Restriction_Warnings and Restrictions -- allow reserved words to appear as expressions when checking for -- prohibited uses of attributes. diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb index e9d54f84f47..99910f7423e 100644 --- a/gcc/ada/s-fileio.adb +++ b/gcc/ada/s-fileio.adb @@ -106,17 +106,18 @@ package body System.File_IO is -- Holds open string (longest is "w+b" & nul) procedure Fopen_Mode - (Mode : File_Mode; + (Namestr : String; + Mode : File_Mode; Text : Boolean; Creat : Boolean; Amethod : Character; Fopstr : out Fopen_String); -- Determines proper open mode for a file to be opened in the given Ada - -- mode. Text is true for a text file and false otherwise, and Creat is - -- true for a create call, and False for an open call. The value stored - -- in Fopstr is a nul-terminated string suitable for a call to fopen or - -- freopen. Amethod is the character designating the access method from - -- the Access_Method field of the FCB. + -- mode. Namestr is the NUL-terminated file name. Text is true for a text + -- file and false otherwise, and Creat is true for a create call, and False + -- for an open call. The value stored in Fopstr is a nul-terminated string + -- suitable for a call to fopen or freopen. Amethod is the character + -- designating the access method from the Access_Method field of the FCB. function Errno_Message (Name : String; @@ -433,10 +434,14 @@ package body System.File_IO is -- OPEN CREATE -- Append_File "r+" "w+" -- In_File "r" "w+" - -- Out_File (Direct_IO, Stream_IO) "r+" "w" + -- Out_File (Direct_IO, Stream_IO) "r+" [*] "w" -- Out_File (others) "w" "w" -- Inout_File "r+" "w+" + -- [*] Except that for Out_File, if the file exists and is a fifo (i.e. a + -- named pipe), we use "w" instead of "r+". This is necessary to make a + -- write to the fifo block until a reader is ready. + -- Note: we do not use "a" or "a+" for Append_File, since this would not -- work in the case of stream files, where even if in append file mode, -- you can reset to earlier points in the file. The caller must use the @@ -458,7 +463,8 @@ package body System.File_IO is -- to the mode, depending on the setting of Text. procedure Fopen_Mode - (Mode : File_Mode; + (Namestr : String; + Mode : File_Mode; Text : Boolean; Creat : Boolean; Amethod : Character; @@ -466,6 +472,9 @@ package body System.File_IO is is Fptr : Positive; + function is_fifo (Path : Address) return Integer; + pragma Import (C, is_fifo, "__gnat_is_fifo"); + begin case Mode is when In_File => @@ -479,7 +488,10 @@ package body System.File_IO is end if; when Out_File => - if Amethod in 'D' | 'S' and then not Creat then + if Amethod in 'D' | 'S' + and then not Creat + and then is_fifo (Namestr'Address) = 0 + then Fopstr (1) := 'r'; Fopstr (2) := '+'; Fptr := 3; @@ -1045,7 +1057,7 @@ package body System.File_IO is else Fopen_Mode - (Mode, Text_Encoding in Text_Content_Encoding, + (Namestr, Mode, Text_Encoding in Text_Content_Encoding, Creat, Amethod, Fopstr); -- A special case, if we are opening (OPEN case) a file and the @@ -1218,7 +1230,7 @@ package body System.File_IO is else Fopen_Mode - (Mode, File.Text_Encoding in Text_Content_Encoding, + (File.Name.all, Mode, File.Text_Encoding in Text_Content_Encoding, False, File.Access_Method, Fopstr); File.Stream := freopen diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 80a5aaa6bba..9089edd3303 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -5105,7 +5105,8 @@ package body Sem_Attr is (Pref_Id : Entity_Id; Spec_Id : Entity_Id) return Boolean is - Subp_Spec : constant Node_Id := Parent (Spec_Id); + Over_Id : constant Entity_Id := Overridden_Operation (Spec_Id); + Subp_Spec : constant Node_Id := Parent (Spec_Id); begin -- The prefix denotes the related subprogram @@ -5145,6 +5146,14 @@ package body Sem_Attr is then return True; end if; + + -- Account for a special case where a primitive of a tagged type + -- inherits a class-wide postcondition from a parent type. In this + -- case the prefix of attribute 'Result denotes the overriding + -- primitive. + + elsif Present (Over_Id) and then Pref_Id = Over_Id then + return True; end if; -- Otherwise the prefix does not denote the related subprogram diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 00ecfaae1d4..2d6d922f318 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -334,7 +334,7 @@ package body Sem_Ch13 is & "(component is little-endian)?V?", CLC); end if; - -- Do not allow non-contiguous field + -- Do not allow non-contiguous field else Error_Msg_N @@ -451,7 +451,7 @@ package body Sem_Ch13 is if Warn_On_Reverse_Bit_Order then Error_Msg_N ("info: multi-byte field specified with " - & " non-standard Bit_Order?V?", CC); + & "non-standard Bit_Order?V?", CC); if Bytes_Big_Endian then Error_Msg_N diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 6f086bf958a..f3686b30e37 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2619,6 +2619,11 @@ package body Sem_Ch6 is begin Set_Defining_Unit_Name (Specification (Decl), Subp); + -- To ensure proper coverage when body is inlined, indicate + -- whether the subprogram comes from source. + + Set_Comes_From_Source (Subp, Comes_From_Source (N)); + if Present (First_Formal (Body_Id)) then Plist := Copy_Parameter_List (Body_Id); Set_Parameter_Specifications