Commit 4afcf3a5 by Arnaud Charlet

[multiple changes]

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.

From-SVN: r235135
parent 58ba2415
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.
......
......@@ -39,6 +39,8 @@
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <unistd.h>
#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
......@@ -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;
......
......@@ -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'
......
......@@ -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);
......
......@@ -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
......
......@@ -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.
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment