Commit 68523ddb by Arnaud Charlet

[multiple changes]

2009-10-28  Bob Duff  <duff@adacore.com>

	* s-fileio.adb: Give more information in exception messages.

2009-10-28  Robert Dewar  <dewar@adacore.com>

	* gnat_ugn.texi: Document new -gnatyt requirement for space after right
	paren if next token starts with digit or letter.
	* styleg.adb (Check_Right_Paren): New rule for space after if next
	character is a letter or digit.

From-SVN: r153663
parent 66a63e0d
2009-10-28 Bob Duff <duff@adacore.com>
* s-fileio.adb: Give more information in exception messages.
2009-10-28 Robert Dewar <dewar@adacore.com>
* gnat_ugn.texi: Document new -gnatyt requirement for space after right
paren if next token starts with digit or letter.
* styleg.adb (Check_Right_Paren): New rule for space after if next
character is a letter or digit.
2009-10-28 Thomas Quinot <quinot@adacore.com> 2009-10-28 Thomas Quinot <quinot@adacore.com>
* s-crtl.ads (System.CRTL.strerror): New function. * s-crtl.ads (System.CRTL.strerror): New function.
......
...@@ -6434,6 +6434,10 @@ If the token preceding a left parenthesis ends with a letter or digit, then ...@@ -6434,6 +6434,10 @@ If the token preceding a left parenthesis ends with a letter or digit, then
a space must separate the two tokens. a space must separate the two tokens.
@item @item
if the token following a right parenthesis starts with a letter or digit, then
a space must separate the two tokens.
@item
A right parenthesis must either be the first non-blank character on A right parenthesis must either be the first non-blank character on
a line, or it must be preceded by a non-blank character. a line, or it must be preceded by a non-blank character.
...@@ -6524,8 +6528,6 @@ the exception of ORDERED_SUBPROGRAMS, UNNECESSARY_BLANK_LINES, ...@@ -6524,8 +6528,6 @@ the exception of ORDERED_SUBPROGRAMS, UNNECESSARY_BLANK_LINES,
XTRA_PARENS, and DOS_LINE_ENDINGS. In addition XTRA_PARENS, and DOS_LINE_ENDINGS. In addition
@end ifset @end ifset
The switch The switch
@ifclear vms @ifclear vms
@option{-gnatyN} @option{-gnatyN}
...@@ -31,7 +31,10 @@ ...@@ -31,7 +31,10 @@
with Ada.Finalization; use Ada.Finalization; with Ada.Finalization; use Ada.Finalization;
with Ada.IO_Exceptions; use Ada.IO_Exceptions; with Ada.IO_Exceptions; use Ada.IO_Exceptions;
with Ada.Unchecked_Conversion;
with Interfaces.C; with Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
with Interfaces.C_Streams; use Interfaces.C_Streams; with Interfaces.C_Streams; use Interfaces.C_Streams;
with System.CRTL; with System.CRTL;
...@@ -48,7 +51,7 @@ package body System.File_IO is ...@@ -48,7 +51,7 @@ package body System.File_IO is
package SSL renames System.Soft_Links; package SSL renames System.Soft_Links;
use type Interfaces.C.int; use type Interfaces.C.int;
use type System.CRTL.size_t; use type CRTL.size_t;
---------------------- ----------------------
-- Global Variables -- -- Global Variables --
...@@ -126,6 +129,23 @@ package body System.File_IO is ...@@ -126,6 +129,23 @@ package body System.File_IO is
-- call to fopen or freopen. Amethod is the character designating -- call to fopen or freopen. Amethod is the character designating
-- the access method from the Access_Method field of the FCB. -- the access method from the Access_Method field of the FCB.
function Errno_Message
(Errno : Integer := OS_Lib.Errno) return String;
function Errno_Message
(Name : String;
Errno : Integer := OS_Lib.Errno) return String;
-- Return a message suitable for "raise ... with Errno_Message (...)".
-- Errno defaults to the current errno, but should be passed explicitly if
-- there is significant code in between the call that sets errno and the
-- call to Errno_Message, in case that code also sets errno. The version
-- with Name includes that file name in the message.
procedure Raise_Device_Error
(File : AFCB_Ptr; Errno : Integer := OS_Lib.Errno);
pragma No_Return (Raise_Device_Error);
-- Clear error indication on File and raise Device_Error with an exception
-- message providing errno information.
---------------- ----------------
-- Append_Set -- -- Append_Set --
---------------- ----------------
...@@ -134,7 +154,7 @@ package body System.File_IO is ...@@ -134,7 +154,7 @@ package body System.File_IO is
begin begin
if File.Mode = Append_File then if File.Mode = Append_File then
if fseek (File.Stream, 0, SEEK_END) /= 0 then if fseek (File.Stream, 0, SEEK_END) /= 0 then
raise Device_Error; Raise_Device_Error (File);
end if; end if;
end if; end if;
end Append_Set; end Append_Set;
...@@ -174,7 +194,7 @@ package body System.File_IO is ...@@ -174,7 +194,7 @@ package body System.File_IO is
procedure Check_File_Open (File : AFCB_Ptr) is procedure Check_File_Open (File : AFCB_Ptr) is
begin begin
if File = null then if File = null then
raise Status_Error; raise Status_Error with "file not open";
end if; end if;
end Check_File_Open; end Check_File_Open;
...@@ -185,9 +205,9 @@ package body System.File_IO is ...@@ -185,9 +205,9 @@ package body System.File_IO is
procedure Check_Read_Status (File : AFCB_Ptr) is procedure Check_Read_Status (File : AFCB_Ptr) is
begin begin
if File = null then if File = null then
raise Status_Error; raise Status_Error with "file not open";
elsif File.Mode > Inout_File then elsif File.Mode > Inout_File then
raise Mode_Error; raise Mode_Error with "file not readable";
end if; end if;
end Check_Read_Status; end Check_Read_Status;
...@@ -198,9 +218,9 @@ package body System.File_IO is ...@@ -198,9 +218,9 @@ package body System.File_IO is
procedure Check_Write_Status (File : AFCB_Ptr) is procedure Check_Write_Status (File : AFCB_Ptr) is
begin begin
if File = null then if File = null then
raise Status_Error; raise Status_Error with "file not open";
elsif File.Mode = In_File then elsif File.Mode = In_File then
raise Mode_Error; raise Mode_Error with "file not writable";
end if; end if;
end Check_Write_Status; end Check_Write_Status;
...@@ -212,6 +232,7 @@ package body System.File_IO is ...@@ -212,6 +232,7 @@ package body System.File_IO is
Close_Status : int := 0; Close_Status : int := 0;
Dup_Strm : Boolean := False; Dup_Strm : Boolean := False;
File : AFCB_Ptr renames File_Ptr.all; File : AFCB_Ptr renames File_Ptr.all;
Errno : Integer;
begin begin
-- Take a task lock, to protect the global data value Open_Files -- Take a task lock, to protect the global data value Open_Files
...@@ -228,6 +249,7 @@ package body System.File_IO is ...@@ -228,6 +249,7 @@ package body System.File_IO is
-- stream value -- happens in some error situations). -- stream value -- happens in some error situations).
if not File.Is_System_File and then File.Stream /= NULL_Stream then if not File.Is_System_File and then File.Stream /= NULL_Stream then
-- Do not do an fclose if this is a shared file and there is at least -- Do not do an fclose if this is a shared file and there is at least
-- one other instance of the stream that is open. -- one other instance of the stream that is open.
...@@ -252,6 +274,10 @@ package body System.File_IO is ...@@ -252,6 +274,10 @@ package body System.File_IO is
if not Dup_Strm then if not Dup_Strm then
Close_Status := fclose (File.Stream); Close_Status := fclose (File.Stream);
if Close_Status /= 0 then
Errno := OS_Lib.Errno;
end if;
end if; end if;
end if; end if;
...@@ -280,7 +306,7 @@ package body System.File_IO is ...@@ -280,7 +306,7 @@ package body System.File_IO is
File := null; File := null;
if Close_Status /= 0 then if Close_Status /= 0 then
raise Device_Error; Raise_Device_Error (null, Errno);
end if; end if;
SSL.Unlock_Task.all; SSL.Unlock_Task.all;
...@@ -297,11 +323,12 @@ package body System.File_IO is ...@@ -297,11 +323,12 @@ package body System.File_IO is
procedure Delete (File_Ptr : access AFCB_Ptr) is procedure Delete (File_Ptr : access AFCB_Ptr) is
File : AFCB_Ptr renames File_Ptr.all; File : AFCB_Ptr renames File_Ptr.all;
begin begin
Check_File_Open (File); Check_File_Open (File);
if not File.Is_Regular_File then if not File.Is_Regular_File then
raise Use_Error; raise Use_Error with "cannot delete non-regular file";
end if; end if;
declare declare
...@@ -315,7 +342,7 @@ package body System.File_IO is ...@@ -315,7 +342,7 @@ package body System.File_IO is
-- we did the open, and we want to unlink the right file! -- we did the open, and we want to unlink the right file!
if unlink (Filename'Address) = -1 then if unlink (Filename'Address) = -1 then
raise Use_Error; raise Use_Error with Errno_Message;
end if; end if;
end; end;
end Delete; end Delete;
...@@ -343,13 +370,40 @@ package body System.File_IO is ...@@ -343,13 +370,40 @@ package body System.File_IO is
end if; end if;
end End_Of_File; end End_Of_File;
-------------------
-- Errno_Message --
-------------------
function Errno_Message (Errno : Integer := OS_Lib.Errno) return String is
function To_Chars_Ptr is
new Ada.Unchecked_Conversion (System.Address, chars_ptr);
Message : constant chars_ptr :=
To_Chars_Ptr (CRTL.strerror (Errno));
begin
if Message = Null_Ptr then
return "errno =" & Errno'Img;
else
return Value (Message);
end if;
end Errno_Message;
function Errno_Message
(Name : String;
Errno : Integer := OS_Lib.Errno) return String
is
begin
return Name & ": " & String'(Errno_Message (Errno));
end Errno_Message;
-------------- --------------
-- Finalize -- -- Finalize --
-------------- --------------
-- Note: we do not need to worry about locking against multiple task -- Note: we do not need to worry about locking against multiple task access
-- access in this routine, since it is called only from the environment -- in this routine, since it is called only from the environment task just
-- task just before terminating execution. -- before terminating execution.
procedure Finalize (V : in out File_IO_Clean_Up_Type) is procedure Finalize (V : in out File_IO_Clean_Up_Type) is
pragma Warnings (Off, V); pragma Warnings (Off, V);
...@@ -400,10 +454,8 @@ package body System.File_IO is ...@@ -400,10 +454,8 @@ package body System.File_IO is
begin begin
Check_Write_Status (File); Check_Write_Status (File);
if fflush (File.Stream) = 0 then if fflush (File.Stream) /= 0 then
return; Raise_Device_Error (File);
else
raise Device_Error;
end if; end if;
end Flush; end Flush;
...@@ -506,7 +558,7 @@ package body System.File_IO is ...@@ -506,7 +558,7 @@ package body System.File_IO is
function Form (File : AFCB_Ptr) return String is function Form (File : AFCB_Ptr) return String is
begin begin
if File = null then if File = null then
raise Status_Error; raise Status_Error with "Form: file not open";
else else
return File.Form.all (1 .. File.Form'Length - 1); return File.Form.all (1 .. File.Form'Length - 1);
end if; end if;
...@@ -537,7 +589,7 @@ package body System.File_IO is ...@@ -537,7 +589,7 @@ package body System.File_IO is
return False; return False;
else else
raise Use_Error; raise Use_Error with "invalid Form";
end if; end if;
end Form_Boolean; end Form_Boolean;
...@@ -564,13 +616,13 @@ package body System.File_IO is ...@@ -564,13 +616,13 @@ package body System.File_IO is
for J in V1 .. V2 loop for J in V1 .. V2 loop
if Form (J) not in '0' .. '9' then if Form (J) not in '0' .. '9' then
raise Use_Error; raise Use_Error with "invalid Form";
else else
V := V * 10 + Character'Pos (Form (J)) - Character'Pos ('0'); V := V * 10 + Character'Pos (Form (J)) - Character'Pos ('0');
end if; end if;
if V > 999_999 then if V > 999_999 then
raise Use_Error; raise Use_Error with "invalid Form";
end if; end if;
end loop; end loop;
...@@ -678,7 +730,7 @@ package body System.File_IO is ...@@ -678,7 +730,7 @@ package body System.File_IO is
function Mode (File : AFCB_Ptr) return File_Mode is function Mode (File : AFCB_Ptr) return File_Mode is
begin begin
if File = null then if File = null then
raise Status_Error; raise Status_Error with "Mode: file not open";
else else
return File.Mode; return File.Mode;
end if; end if;
...@@ -691,7 +743,7 @@ package body System.File_IO is ...@@ -691,7 +743,7 @@ package body System.File_IO is
function Name (File : AFCB_Ptr) return String is function Name (File : AFCB_Ptr) return String is
begin begin
if File = null then if File = null then
raise Status_Error; raise Status_Error with "Name: file not open";
else else
return File.Name.all (1 .. File.Name'Length - 1); return File.Name.all (1 .. File.Name'Length - 1);
end if; end if;
...@@ -752,12 +804,12 @@ package body System.File_IO is ...@@ -752,12 +804,12 @@ package body System.File_IO is
Full_Name_Len : Integer; Full_Name_Len : Integer;
-- Length of name actually stored in Fullname -- Length of name actually stored in Fullname
Encoding : System.CRTL.Filename_Encoding; Encoding : CRTL.Filename_Encoding;
-- Filename encoding specified into the form parameter -- Filename encoding specified into the form parameter
begin begin
if File_Ptr /= null then if File_Ptr /= null then
raise Status_Error; raise Status_Error with "file already open";
end if; end if;
-- Acquire form string, setting required NUL terminator -- Acquire form string, setting required NUL terminator
...@@ -791,7 +843,7 @@ package body System.File_IO is ...@@ -791,7 +843,7 @@ package body System.File_IO is
Shared := No; Shared := No;
else else
raise Use_Error; raise Use_Error with "invalid Form";
end if; end if;
end; end;
...@@ -804,16 +856,16 @@ package body System.File_IO is ...@@ -804,16 +856,16 @@ package body System.File_IO is
Form_Parameter (Formstr, "encoding", V1, V2); Form_Parameter (Formstr, "encoding", V1, V2);
if V1 = 0 then if V1 = 0 then
Encoding := System.CRTL.Unspecified; Encoding := CRTL.Unspecified;
elsif Formstr (V1 .. V2) = "utf8" then elsif Formstr (V1 .. V2) = "utf8" then
Encoding := System.CRTL.UTF8; Encoding := CRTL.UTF8;
elsif Formstr (V1 .. V2) = "8bits" then elsif Formstr (V1 .. V2) = "8bits" then
Encoding := System.CRTL.ASCII_8bits; Encoding := CRTL.ASCII_8bits;
else else
raise Use_Error; raise Use_Error with "invalid Form";
end if; end if;
end; end;
...@@ -845,13 +897,13 @@ package body System.File_IO is ...@@ -845,13 +897,13 @@ package body System.File_IO is
if Tempfile then if Tempfile then
if not Creat then if not Creat then
raise Name_Error; raise Name_Error with "opening temp file without creating it";
end if; end if;
Tmp_Name (Namestr'Address); Tmp_Name (Namestr'Address);
if Namestr (1) = ASCII.NUL then if Namestr (1) = ASCII.NUL then
raise Use_Error; raise Use_Error with "invalid temp file name";
end if; end if;
-- Chain to temp file list, ensuring thread safety with a lock -- Chain to temp file list, ensuring thread safety with a lock
...@@ -872,7 +924,7 @@ package body System.File_IO is ...@@ -872,7 +924,7 @@ package body System.File_IO is
else else
if Name'Length > Namelen then if Name'Length > Namelen then
raise Name_Error; raise Name_Error with "file name too long";
end if; end if;
Namestr (1 .. Name'Length) := Name; Namestr (1 .. Name'Length) := Name;
...@@ -884,7 +936,7 @@ package body System.File_IO is ...@@ -884,7 +936,7 @@ package body System.File_IO is
full_name (Namestr'Address, Fullname'Address); full_name (Namestr'Address, Fullname'Address);
if Fullname (1) = ASCII.NUL then if Fullname (1) = ASCII.NUL then
raise Use_Error; raise Use_Error with Errno_Message (Name);
end if; end if;
Full_Name_Len := 1; Full_Name_Len := 1;
...@@ -931,7 +983,7 @@ package body System.File_IO is ...@@ -931,7 +983,7 @@ package body System.File_IO is
if Shared = None if Shared = None
or else P.Shared_Status = None or else P.Shared_Status = None
then then
raise Use_Error; raise Use_Error with "reopening shared file";
-- If both files have Shared=Yes, then we acquire the -- If both files have Shared=Yes, then we acquire the
-- stream from the located file to use as our stream. -- stream from the located file to use as our stream.
...@@ -977,7 +1029,7 @@ package body System.File_IO is ...@@ -977,7 +1029,7 @@ package body System.File_IO is
if not Creat and then Fopstr (1) /= 'r' then if not Creat and then Fopstr (1) /= 'r' then
if file_exists (Namestr'Address) = 0 then if file_exists (Namestr'Address) = 0 then
raise Name_Error; raise Name_Error with Errno_Message (Name);
end if; end if;
end if; end if;
...@@ -1001,10 +1053,8 @@ package body System.File_IO is ...@@ -1001,10 +1053,8 @@ package body System.File_IO is
-- Should we raise Device_Error for ENOSPC??? -- Should we raise Device_Error for ENOSPC???
declare declare
subtype Cint is Interfaces.C.int;
function Is_File_Not_Found_Error function Is_File_Not_Found_Error
(Errno_Value : Cint) return Cint; (Errno_Value : Integer) return Integer;
-- Non-zero when the given errno value indicates a non- -- Non-zero when the given errno value indicates a non-
-- existing file. -- existing file.
...@@ -1012,13 +1062,13 @@ package body System.File_IO is ...@@ -1012,13 +1062,13 @@ package body System.File_IO is
(C, Is_File_Not_Found_Error, (C, Is_File_Not_Found_Error,
"__gnat_is_file_not_found_error"); "__gnat_is_file_not_found_error");
Errno : constant Integer := OS_Lib.Errno;
Message : constant String := Errno_Message (Name, Errno);
begin begin
if if Is_File_Not_Found_Error (Errno) /= 0 then
Is_File_Not_Found_Error (Cint (System.OS_Lib.Errno)) /= 0 raise Name_Error with Message;
then
raise Name_Error;
else else
raise Use_Error; raise Use_Error with Message;
end if; end if;
end; end;
end if; end if;
...@@ -1047,6 +1097,23 @@ package body System.File_IO is ...@@ -1047,6 +1097,23 @@ package body System.File_IO is
Append_Set (File_Ptr); Append_Set (File_Ptr);
end Open; end Open;
------------------------
-- Raise_Device_Error --
------------------------
procedure Raise_Device_Error
(File : AFCB_Ptr; Errno : Integer := OS_Lib.Errno)
is
begin
-- Clear error status so that the same error is not reported twice
if File /= null then
clearerr (File.Stream);
end if;
raise Device_Error with Errno_Message (Errno);
end Raise_Device_Error;
-------------- --------------
-- Read_Buf -- -- Read_Buf --
-------------- --------------
...@@ -1061,13 +1128,13 @@ package body System.File_IO is ...@@ -1061,13 +1128,13 @@ package body System.File_IO is
return; return;
elsif ferror (File.Stream) /= 0 then elsif ferror (File.Stream) /= 0 then
raise Device_Error; Raise_Device_Error (File);
elsif Nread = 0 then elsif Nread = 0 then
raise End_Error; raise End_Error;
else -- 0 < Nread < Siz else -- 0 < Nread < Siz
raise Data_Error; raise Data_Error with "not enough data read";
end if; end if;
end Read_Buf; end Read_Buf;
...@@ -1082,7 +1149,7 @@ package body System.File_IO is ...@@ -1082,7 +1149,7 @@ package body System.File_IO is
Count := fread (Buf, 1, Siz, File.Stream); Count := fread (Buf, 1, Siz, File.Stream);
if Count = 0 and then ferror (File.Stream) /= 0 then if Count = 0 and then ferror (File.Stream) /= 0 then
raise Device_Error; Raise_Device_Error (File);
end if; end if;
end Read_Buf; end Read_Buf;
...@@ -1114,19 +1181,23 @@ package body System.File_IO is ...@@ -1114,19 +1181,23 @@ package body System.File_IO is
-- file that is not a regular file, or for a system file. Note that we -- file that is not a regular file, or for a system file. Note that we
-- allow the "change" of mode if it is not in fact doing a change. -- allow the "change" of mode if it is not in fact doing a change.
if Mode /= File.Mode if Mode /= File.Mode then
and then (File.Shared_Status = Yes if File.Shared_Status = Yes then
or else File.Name'Length <= 1 raise Use_Error with "cannot change mode of shared file";
or else File.Is_System_File elsif File.Name'Length <= 1 then
or else not File.Is_Regular_File) raise Use_Error with "cannot change mode of temp file";
then elsif File.Is_System_File then
raise Use_Error; raise Use_Error with "cannot change mode of system file";
elsif not File.Is_Regular_File then
raise Use_Error with "cannot change mode of non-regular file";
end if;
end if;
-- For In_File or Inout_File for a regular file, we can just do a rewind -- For In_File or Inout_File for a regular file, we can just do a rewind
-- if the mode is unchanged, which is more efficient than doing a full -- if the mode is unchanged, which is more efficient than doing a full
-- reopen. -- reopen.
elsif Mode = File.Mode if Mode = File.Mode
and then Mode <= Inout_File and then Mode <= Inout_File
then then
rewind (File.Stream); rewind (File.Stream);
...@@ -1168,7 +1239,7 @@ package body System.File_IO is ...@@ -1168,7 +1239,7 @@ package body System.File_IO is
if fwrite (Buf, Siz, 1, File.Stream) /= 1 then if fwrite (Buf, Siz, 1, File.Stream) /= 1 then
if Siz /= 0 then if Siz /= 0 then
SSL.Abort_Undefer.all; SSL.Abort_Undefer.all;
raise Device_Error; Raise_Device_Error (File);
end if; end if;
end if; end if;
......
...@@ -813,12 +813,17 @@ package body Styleg is ...@@ -813,12 +813,17 @@ package body Styleg is
-- Check_Right_Paren -- -- Check_Right_Paren --
----------------------- -----------------------
-- In check tokens mode (-gnatyt), right paren must never be preceded by -- In check tokens mode (-gnatyt), right paren must not be immediately
-- followed by an identifier character, and must never be preceded by
-- a space unless it is the initial non-blank character on the line. -- a space unless it is the initial non-blank character on the line.
procedure Check_Right_Paren is procedure Check_Right_Paren is
begin begin
if Style_Check_Tokens then if Style_Check_Tokens then
if Identifier_Char (Source (Token_Ptr + 1)) then
Error_Space_Required (Token_Ptr + 1);
end if;
Check_No_Space_Before; Check_No_Space_Before;
end if; end if;
end Check_Right_Paren; end Check_Right_Paren;
......
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