+2016-04-18 Gary Dismukes <dismukes@adacore.com>
+
+ * lib-xref-spark_specific.adb, par-ch2.adb, errout.ads,
+ exp_intr.adb: Minor reformatting and typo corrections.
+
+2016-04-18 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch6.adb: Code cleanup.
+
+2016-04-18 Thomas Quinot <quinot@adacore.com>
+
+ * sem_ch13.adb: Minor reformatting and error message tweaking
+ (remove extraneous spaces).
+
+2016-04-18 Johannes Kanig <kanig@adacore.com>
+
+ * gnat1drv.adb (Gnat1drv): Force loading of System unit for SPARK.
+
+2016-04-18 Bob Duff <duff@adacore.com>
+
+ * 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 <kirtchev@adacore.com>
+
+ * 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 <kirtchev@adacore.com>
* par-ch2.adb (P_Expression_Or_Reserved_Word): New routine.
#include <stdio.h>
#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
#ifdef _AIX
/* needed to avoid conflicting declarations */
}
#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
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;
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.
-----------
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
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'
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);
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
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
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.
-- 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;
-- 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
-- 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;
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 =>
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;
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
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
(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
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
& "(component is little-endian)?V?", CLC);
end if;
- -- Do not allow non-contiguous field
+ -- Do not allow non-contiguous field
else
Error_Msg_N
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
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
projects / gcc.git / commitdiff