Commit 7a1f094d by Arnaud Charlet

[multiple changes]

2013-04-12  Doug Rupp  <rupp@adacore.com>

	* s-fileio.adb: Minor reformatting.

2013-04-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_warn.adb (Check_Infinite_Loop_Warning): Do not warn if
	the last statement in the analyzed loop is an unconditional
	exit statement.

From-SVN: r197903
parent 7f18b29a
2013-04-12 Doug Rupp <rupp@adacore.com>
* s-fileio.adb: Minor reformatting.
2013-04-12 Ed Schonberg <schonberg@adacore.com>
* sem_warn.adb (Check_Infinite_Loop_Warning): Do not warn if
the last statement in the analyzed loop is an unconditional
exit statement.
2013-04-12 Robert Dewar <dewar@adacore.com> 2013-04-12 Robert Dewar <dewar@adacore.com>
* opt.ads (Style_Check_Main): New switch. * opt.ads (Style_Check_Main): New switch.
......
...@@ -29,15 +29,15 @@ ...@@ -29,15 +29,15 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
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 Interfaces.C; with Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings; 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.Runtime; with System.CRTL.Runtime;
with System.Case_Util; use System.Case_Util; with System.Case_Util; use System.Case_Util;
with System.OS_Lib; with System.OS_Lib;
with System.Soft_Links; with System.Soft_Links;
...@@ -54,6 +54,7 @@ package body System.File_IO is ...@@ -54,6 +54,7 @@ package body System.File_IO is
subtype String_Access is System.OS_Lib.String_Access; subtype String_Access is System.OS_Lib.String_Access;
procedure Free (X : in out String_Access) renames System.OS_Lib.Free; procedure Free (X : in out String_Access) renames System.OS_Lib.Free;
function "=" (X, Y : String_Access) return Boolean function "=" (X, Y : String_Access) return Boolean
renames System.OS_Lib."="; renames System.OS_Lib."=";
...@@ -104,7 +105,7 @@ package body System.File_IO is ...@@ -104,7 +105,7 @@ package body System.File_IO is
-- If true, add appropriate suffix to control string for Open -- If true, add appropriate suffix to control string for Open
VMS_Formstr : String_Access := null; VMS_Formstr : String_Access := null;
-- For special VMS RMS keywords and values. -- For special VMS RMS keywords and values
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --
...@@ -147,12 +148,12 @@ package body System.File_IO is ...@@ -147,12 +148,12 @@ package body System.File_IO is
-- message providing errno information. -- message providing errno information.
procedure Form_VMS_RMS_Keys (Form : String; VMS_Form : out String_Access); procedure Form_VMS_RMS_Keys (Form : String; VMS_Form : out String_Access);
-- Parse the RMS Keys -- Parse the RMS Keys
function Form_RMS_Context_Key function Form_RMS_Context_Key
(Form : String; (Form : String;
VMS_Form : String_Access) return Natural; VMS_Form : String_Access) return Natural;
-- Parse the RMS Context Key -- Parse the RMS Context Key
---------------- ----------------
-- Append_Set -- -- Append_Set --
...@@ -531,7 +532,6 @@ package body System.File_IO is ...@@ -531,7 +532,6 @@ package body System.File_IO is
Fopstr (1) := (if Creat then 'w' else 'r'); Fopstr (1) := (if Creat then 'w' else 'r');
Fopstr (2) := '+'; Fopstr (2) := '+';
Fptr := 3; Fptr := 3;
end case; end case;
-- If text_translation_required is true then we need to append either a -- If text_translation_required is true then we need to append either a
...@@ -575,13 +575,10 @@ package body System.File_IO is ...@@ -575,13 +575,10 @@ package body System.File_IO is
if V1 = 0 then if V1 = 0 then
return Default; return Default;
elsif Form (V1) = 'y' then elsif Form (V1) = 'y' then
return True; return True;
elsif Form (V1) = 'n' then elsif Form (V1) = 'n' then
return False; return False;
else else
raise Use_Error with "invalid Form"; raise Use_Error with "invalid Form";
end if; end if;
...@@ -668,7 +665,7 @@ package body System.File_IO is ...@@ -668,7 +665,7 @@ package body System.File_IO is
type Context_Parms is type Context_Parms is
(Binary_Data, Convert_Fortran_Carriage_Control, Force_Record_Mode, (Binary_Data, Convert_Fortran_Carriage_Control, Force_Record_Mode,
Force_Stream_Mode, Explicit_Write); Force_Stream_Mode, Explicit_Write);
-- Ada-fied list of all possible Context keyword values. -- Ada-fied list of all possible Context keyword values
Pos : Natural := 0; Pos : Natural := 0;
Klen : Natural := 0; Klen : Natural := 0;
...@@ -746,9 +743,8 @@ package body System.File_IO is ...@@ -746,9 +743,8 @@ package body System.File_IO is
Klen : Natural := VMS_RMS_Keys_Token'Length; Klen : Natural := VMS_RMS_Keys_Token'Length;
Index : Natural; Index : Natural;
-- Ada-fied list of all RMS keywords, translated from the -- Ada-fied list of all RMS keywords, translated from the HP C Run-Time
-- HP C Run-Time Library Reference Manual, Table REF-3: -- Library Reference Manual, Table REF-3: RMS Valid Keywords and Values.
-- RMS Valid Keywords and Values
type RMS_Keys is type RMS_Keys is
(Access_Callback, Allocation_Quantity, Block_Size, Context, (Access_Callback, Allocation_Quantity, Block_Size, Context,
...@@ -788,12 +784,13 @@ package body System.File_IO is ...@@ -788,12 +784,13 @@ package body System.File_IO is
for Key in RMS_Keys loop for Key in RMS_Keys loop
declare declare
KImage : String := RMS_Keys'Image (Key); KImage : String := RMS_Keys'Image (Key);
begin begin
Klen := KImage'Length; Klen := KImage'Length;
To_Lower (KImage); To_Lower (KImage);
if Form (Index .. Index + Klen - 1) = KImage then if Form (Index .. Index + Klen - 1) = KImage then
case Key is case Key is
when Context => when Context =>
Index := Form_RMS_Context_Key Index := Form_RMS_Context_Key
(Form (Index + Klen .. Form'Last), (Form (Index + Klen .. Form'Last),
...@@ -810,8 +807,7 @@ package body System.File_IO is ...@@ -810,8 +807,7 @@ package body System.File_IO is
if Form (Index) = ')' then if Form (Index) = ')' then
-- Done, erase the unneeded trailing comma and -- Done, erase the unneeded trailing comma and return
-- return.
for J in reverse VMS_Form'First .. VMS_Form'Last loop for J in reverse VMS_Form'First .. VMS_Form'Last loop
if VMS_Form (J) = ',' then if VMS_Form (J) = ',' then
...@@ -821,15 +817,19 @@ package body System.File_IO is ...@@ -821,15 +817,19 @@ package body System.File_IO is
end loop; end loop;
-- Shouldn't be possible to get here -- Shouldn't be possible to get here
raise Use_Error; raise Use_Error;
elsif Form (Index) = ',' then elsif Form (Index) = ',' then
-- Another key ahead, exit inner loop -- Another key ahead, exit inner loop
null; null;
else else
-- Keyword value not terminated correctly -- Keyword value not terminated correctly
raise Use_Error with "malformed VMS RMS Form"; raise Use_Error with "malformed VMS RMS Form";
end if; end if;
end loop; end loop;
...@@ -837,6 +837,7 @@ package body System.File_IO is ...@@ -837,6 +837,7 @@ package body System.File_IO is
end if; end if;
-- Found the keyword, but not followed by correct syntax -- Found the keyword, but not followed by correct syntax
raise Use_Error with "malformed VMS RMS Form"; raise Use_Error with "malformed VMS RMS Form";
end if; end if;
end loop; end loop;
...@@ -1024,13 +1025,10 @@ package body System.File_IO is ...@@ -1024,13 +1025,10 @@ package body System.File_IO is
if V1 = 0 then if V1 = 0 then
Shared := None; Shared := None;
elsif Formstr (V1 .. V2) = "yes" then elsif Formstr (V1 .. V2) = "yes" then
Shared := Yes; Shared := Yes;
elsif Formstr (V1 .. V2) = "no" then elsif Formstr (V1 .. V2) = "no" then
Shared := No; Shared := No;
else else
raise Use_Error with "invalid Form"; raise Use_Error with "invalid Form";
end if; end if;
...@@ -1046,13 +1044,10 @@ package body System.File_IO is ...@@ -1046,13 +1044,10 @@ package body System.File_IO is
if V1 = 0 then if V1 = 0 then
Encoding := CRTL.Unspecified; Encoding := CRTL.Unspecified;
elsif Formstr (V1 .. V2) = "utf8" then elsif Formstr (V1 .. V2) = "utf8" then
Encoding := CRTL.UTF8; Encoding := CRTL.UTF8;
elsif Formstr (V1 .. V2) = "8bits" then elsif Formstr (V1 .. V2) = "8bits" then
Encoding := CRTL.ASCII_8bits; Encoding := CRTL.ASCII_8bits;
else else
raise Use_Error with "invalid Form"; raise Use_Error with "invalid Form";
end if; end if;
...@@ -1314,7 +1309,8 @@ package body System.File_IO is ...@@ -1314,7 +1309,8 @@ package body System.File_IO is
------------------------ ------------------------
procedure Raise_Device_Error procedure Raise_Device_Error
(File : AFCB_Ptr; Errno : Integer := OS_Lib.Errno) (File : AFCB_Ptr;
Errno : Integer := OS_Lib.Errno)
is is
begin begin
-- Clear error status so that the same error is not reported twice -- Clear error status so that the same error is not reported twice
...@@ -1348,7 +1344,6 @@ package body System.File_IO is ...@@ -1348,7 +1344,6 @@ package body System.File_IO is
else -- 0 < Nread < Siz else -- 0 < Nread < Siz
raise Data_Error with "not enough data read"; raise Data_Error with "not enough data read";
end if; end if;
end Read_Buf; end Read_Buf;
procedure Read_Buf procedure Read_Buf
...@@ -1440,7 +1435,6 @@ package body System.File_IO is ...@@ -1440,7 +1435,6 @@ package body System.File_IO is
if File.Stream = NULL_Stream then if File.Stream = NULL_Stream then
Close (File_Ptr); Close (File_Ptr);
raise Use_Error; raise Use_Error;
else else
File.Mode := Mode; File.Mode := Mode;
Append_Set (File); Append_Set (File);
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1999-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1999-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -643,6 +643,13 @@ package body Sem_Warn is ...@@ -643,6 +643,13 @@ package body Sem_Warn is
else else
Expression := Condition (Exit_Stmt); Expression := Condition (Exit_Stmt);
end if; end if;
-- If an unconditional exit statement is the last statement in the
-- loop assume that no warning is needed. without any attempt at
-- checking whether the exit is reachable.
elsif Exit_Stmt = Last (Statements (Loop_Statement)) then
return;
end if; end if;
Exit_Stmt := Next_Exit_Statement (Exit_Stmt); Exit_Stmt := Next_Exit_Statement (Exit_Stmt);
......
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