Skip to content

R
riscv-gcc-1
Commit 835d23b2 by Robert Dewar Committed by Arnaud Charlet
Options

uintp.adb, [...]: Minor reformatting. 

2007-08-14  Robert Dewar  <dewar@adacore.com>

	* uintp.adb, a-ztedit.adb, s-wchcon.adb, xnmake.adb, s-wchcon.adb,
	par-ch5.adb, par-ch10.adb, get_targ.adb, a-wtedit.adb, a-teioed.adb,
	s-osinte-solaris.adb, s-osinte-solaris.ads,
	s-osinte-freebsd.ads, s-osinte-freebsd.adb: Minor reformatting.

	* styleg.adb, styleg.ads, stylesw.adb, stylesw.ads: implement style
	switch -gnatyS. Enable -gnatyS in GNAT style check mode

From-SVN: r127409
parent 4a9b6b95
Showing with 244 additions and 67 deletions
gcc/ada/a-teioed.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- 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- --
......@@ -933,7 +933,9 @@ package body Ada.Text_IO.Editing is
Pic.Contents.Picture.Expanded;
begin
for J in Temp'Range loop
if Temp (J) = 'b' then Temp (J) := 'B'; end if;
if Temp (J) = 'b' then
Temp (J) := 'B';
end if;
end loop;
return Temp;
......@@ -2448,9 +2450,10 @@ package body Ada.Text_IO.Editing is
procedure Set_State (L : Legality) is
begin
if Debug then Ada.Text_IO.Put_Line
(" Set state from " & Legality'Image (State) &
" to " & Legality'Image (L));
if Debug then
Ada.Text_IO.Put_Line
(" Set state from " & Legality'Image (State)
& " to " & Legality'Image (L));
end if;
State := L;
......@@ -2462,8 +2465,8 @@ package body Ada.Text_IO.Editing is
procedure Skip is
begin
if Debug then Ada.Text_IO.Put_Line
(" Skip " & Pic.Picture.Expanded (Index));
if Debug then
Ada.Text_IO.Put_Line (" Skip " & Pic.Picture.Expanded (Index));
end if;
Index := Index + 1;
......
gcc/ada/a-wtedit.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- 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- --
......@@ -1100,7 +1100,9 @@ package body Ada.Wide_Text_IO.Editing is
Pic.Contents.Picture.Expanded;
begin
for J in Temp'Range loop
if Temp (J) = 'b' then Temp (J) := 'B'; end if;
if Temp (J) = 'b' then
Temp (J) := 'B';
end if;
end loop;
return Temp;
......
gcc/ada/a-ztedit.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- 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- --
......@@ -1102,7 +1102,9 @@ package body Ada.Wide_Wide_Text_IO.Editing is
Pic.Contents.Picture.Expanded;
begin
for J in Temp'Range loop
if Temp (J) = 'b' then Temp (J) := 'B'; end if;
if Temp (J) = 'b' then
Temp (J) := 'B';
end if;
end loop;
return Temp;
......
gcc/ada/get_targ.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- 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- --
......@@ -32,11 +32,16 @@ package body Get_Targ is
function Digits_From_Size (Size : Pos) return Pos is
begin
if Size = 32 then return 6;
elsif Size = 48 then return 9;
elsif Size = 64 then return 15;
elsif Size = 96 then return 18;
elsif Size = 128 then return 18;
if Size = 32 then
return 6;
elsif Size = 48 then
return 9;
elsif Size = 64 then
return 15;
elsif Size = 96 then
return 18;
elsif Size = 128 then
return 18;
else
raise Program_Error;
end if;
......@@ -57,10 +62,14 @@ package body Get_Targ is
function Width_From_Size (Size : Pos) return Pos is
begin
if Size = 8 then return 4;
elsif Size = 16 then return 6;
elsif Size = 32 then return 11;
elsif Size = 64 then return 21;
if Size = 8 then
return 4;
elsif Size = 16 then
return 6;
elsif Size = 32 then
return 11;
elsif Size = 64 then
return 21;
else
raise Program_Error;
end if;
......
gcc/ada/par-ch10.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- 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- --
......@@ -244,7 +244,9 @@ package body Ch10 is
if Token = Tok_Private then
Private_Sloc := Token_Ptr;
Set_Keyword_Casing (Current_Source_File, Determine_Token_Casing);
if Style_Check then Style.Check_Indentation; end if;
if Style_Check then
Style.Check_Indentation;
end if;
Save_Scan_State (Scan_State); -- at PRIVATE
Scan; -- past PRIVATE
......@@ -320,7 +322,9 @@ package body Ch10 is
-- it hasn't already been done on seeing a WITH or PRIVATE.
Set_Keyword_Casing (Current_Source_File, Determine_Token_Casing);
if Style_Check then Style.Check_Indentation; end if;
if Style_Check then
Style.Check_Indentation;
end if;
-- Remaining processing depends on particular type of compilation unit
......@@ -807,7 +811,9 @@ package body Ch10 is
-- Loop through context items
loop
if Style_Check then Style.Check_Indentation; end if;
if Style_Check then
Style.Check_Indentation;
end if;
-- Gather any pragmas appearing in the context clause
......
gcc/ada/par-ch5.adb
......@@ -210,7 +210,9 @@ package body Ch5 is
end loop;
begin
if Style_Check then Style.Check_Indentation; end if;
if Style_Check then
Style.Check_Indentation;
end if;
-- Deal with reserved identifier (in assignment or call)
......@@ -1121,7 +1123,10 @@ package body Ch5 is
begin
if Token_Is_At_Start_Of_Line and then Token = Tok_Then then
Check_If_Column;
if Style_Check then Style.Check_Then (Loc); end if;
if Style_Check then
Style.Check_Then (Loc);
end if;
end if;
end Check_Then_Column;
......@@ -1397,7 +1402,10 @@ package body Ch5 is
Case_Alt_Node : Node_Id;
begin
if Style_Check then Style.Check_Indentation; end if;
if Style_Check then
Style.Check_Indentation;
end if;
Case_Alt_Node := New_Node (N_Case_Statement_Alternative, Token_Ptr);
T_When; -- past WHEN (or give error in OTHERS case)
Set_Discrete_Choices (Case_Alt_Node, P_Discrete_Choice_List);
......@@ -2069,7 +2077,9 @@ package body Ch5 is
Set_Declarations (Parent, Decls);
if Token = Tok_Begin then
if Style_Check then Style.Check_Indentation; end if;
if Style_Check then
Style.Check_Indentation;
end if;
Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
......
gcc/ada/s-osinte-freebsd.adb
......@@ -38,21 +38,34 @@ with Interfaces.C; use Interfaces.C;
package body System.OS_Interface is
-----------
-- Errno --
-----------
function Errno return int is
type int_ptr is access all int;
function internal_errno return int_ptr;
pragma Import (C, internal_errno, "__error");
begin
return (internal_errno.all);
end Errno;
--------------------
-- Get_Stack_Base --
--------------------
function Get_Stack_Base (thread : pthread_t) return Address is
pragma Unreferenced (thread);
begin
return (0);
end Get_Stack_Base;
------------------
-- pthread_init --
------------------
procedure pthread_init is
begin
null;
......@@ -85,15 +98,20 @@ package body System.OS_Interface is
function To_Timespec (D : Duration) return timespec is
S : time_t;
F : Duration;
begin
S := time_t (Long_Long_Integer (D));
F := D - Duration (S);
-- If F has negative value due to a round-up, adjust for positive F
-- value.
if F < 0.0 then S := S - 1; F := F + 1.0; end if;
if F < 0.0 then
S := S - 1;
F := F + 1.0;
end if;
return timespec'(ts_sec => S,
ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
end To_Timespec;
end System.OS_Interface;
gcc/ada/s-osinte-freebsd.ads
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -235,7 +235,7 @@ package System.OS_Interface is
function To_Target_Priority
(Prio : System.Any_Priority) return Interfaces.C.int;
-- Maps System.Any_Priority to a POSIX priority.
-- Maps System.Any_Priority to a POSIX priority
-------------
-- Process --
......
gcc/ada/s-osinte-solaris.adb
......@@ -7,7 +7,7 @@
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2005, AdaCore --
-- Copyright (C) 1995-2007, AdaCore --
-- --
-- GNARL 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- --
......@@ -32,7 +32,7 @@
-- --
------------------------------------------------------------------------------
-- This is a Solaris version of this package.
-- This is a Solaris version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
......@@ -42,6 +42,7 @@ pragma Polling (Off);
-- tasking operations. It causes infinite loops and other problems.
with Interfaces.C; use Interfaces.C;
package body System.OS_Interface is
-----------------
......@@ -60,38 +61,60 @@ package body System.OS_Interface is
function To_Timespec (D : Duration) return timespec is
S : time_t;
F : Duration;
begin
S := time_t (Long_Long_Integer (D));
F := D - Duration (S);
-- If F has negative value due to a round-up, adjust for positive F
-- value.
if F < 0.0 then S := S - 1; F := F + 1.0; end if;
if F < 0.0 then
S := S - 1;
F := F + 1.0;
end if;
return timespec'(tv_sec => S,
tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
end To_Timespec;
-----------------
-- To_Duration --
-----------------
function To_Duration (TV : struct_timeval) return Duration is
begin
return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
end To_Duration;
----------------
-- To_Timeval --
----------------
function To_Timeval (D : Duration) return struct_timeval is
S : long;
F : Duration;
begin
S := long (Long_Long_Integer (D));
F := D - Duration (S);
-- If F has negative value due to a round-up, adjust for positive F
-- value.
if F < 0.0 then S := S - 1; F := F + 1.0; end if;
if F < 0.0 then
S := S - 1;
F := F + 1.0;
end if;
return
struct_timeval'
(tv_sec => S,
tv_usec => long (Long_Long_Integer (F * 10#1#E6)));
end To_Timeval;
------------------
-- pthread_init --
------------------
procedure pthread_init is
begin
null;
......
gcc/ada/s-osinte-solaris.ads
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2007, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -126,7 +126,7 @@ package System.OS_Interface is
Unmasked : constant Signal_Set := (SIGTRAP, SIGLWP, SIGPROF);
-- Following signals should not be disturbed.
-- See c-posix-signals.c in FLORIST
-- See c-posix-signals.c in FLORIST.
Reserved : constant Signal_Set :=
(SIGKILL, SIGSTOP, SIGWAITING, SIGCANCEL, SIGTRAP, SIGSEGV);
......@@ -451,7 +451,7 @@ package System.OS_Interface is
type id_t is new long;
P_MYID : constant := -1;
-- the specified LWP or process is the current one.
-- The specified LWP or process is the current one
type struct_pcinfo is record
pc_cid : id_t;
......@@ -485,21 +485,21 @@ package System.OS_Interface is
-- Constants for function processor_bind
PBIND_QUERY : constant processorid_t := -2;
-- the processor bindings are not changed.
-- The processor bindings are not changed
PBIND_NONE : constant processorid_t := -1;
-- the processor bindings of the specified LWPs are cleared.
-- The processor bindings of the specified LWPs are cleared
-- Flags for function p_online
PR_OFFLINE : constant int := 1;
-- processor is offline, as quiet as possible
-- Processor is offline, as quiet as possible
PR_ONLINE : constant int := 2;
-- processor online
-- Processor online
PR_STATUS : constant int := 3;
-- value passed to p_online to request status
-- Value passed to p_online to request status
function p_online (processorid : processorid_t; flag : int) return int;
pragma Import (C, p_online, "p_online");
......@@ -512,7 +512,7 @@ package System.OS_Interface is
pragma Import (C, processor_bind, "processor_bind");
procedure pthread_init;
-- dummy procedure to share s-intman.adb with other Solaris targets.
-- Dummy procedure to share s-intman.adb with other Solaris targets
private
......
gcc/ada/s-wchcon.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2005-2006, Free Software Foundation, Inc. --
-- Copyright (C) 2005-2007, Free Software Foundation, Inc. --
-- --
-- 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- --
......@@ -50,12 +50,18 @@ package body System.WCh_Con is
function Get_WC_Encoding_Method (S : String) return WC_Encoding_Method is
begin
if S = "hex" then return WCEM_Hex;
elsif S = "upper" then return WCEM_Upper;
elsif S = "shift_jis" then return WCEM_Shift_JIS;
elsif S = "euc" then return WCEM_EUC;
elsif S = "utf8" then return WCEM_UTF8;
elsif S = "brackets" then return WCEM_Brackets;
if S = "hex" then
return WCEM_Hex;
elsif S = "upper" then
return WCEM_Upper;
elsif S = "shift_jis" then
return WCEM_Shift_JIS;
elsif S = "euc" then
return WCEM_EUC;
elsif S = "utf8" then
return WCEM_UTF8;
elsif S = "brackets" then
return WCEM_Brackets;
else
raise Constraint_Error;
end if;
......
gcc/ada/styleg.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- 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- --
......@@ -63,7 +63,11 @@ package body Styleg is
-- Check that token is first token on line, or else is not preceded
-- by white space. Signal error of space not allowed if not.
procedure Check_Separate_Stmt_Lines_Cont;
-- Non-inlined continuation of Check_Separate_Stmt_Lines
function Determine_Token_Casing return Casing_Type;
-- Determine casing of current token
procedure Error_Space_Not_Allowed (S : Source_Ptr);
-- Posts an error message indicating that a space is not allowed
......@@ -699,6 +703,82 @@ package body Styleg is
end if;
end Check_Semicolon;
-------------------------------
-- Check_Separate_Stmt_Lines --
-------------------------------
procedure Check_Separate_Stmt_Lines is
begin
if Style_Check_Separate_Stmt_Lines then
Check_Separate_Stmt_Lines_Cont;
end if;
end Check_Separate_Stmt_Lines;
------------------------------------
-- Check_Separate_Stmt_Lines_Cont --
------------------------------------
procedure Check_Separate_Stmt_Lines_Cont is
S : Source_Ptr;
begin
-- Skip past white space
S := Scan_Ptr;
while Is_White_Space (Source (S)) loop
S := S + 1;
end loop;
-- Line terminator is OK
if Source (S) in Line_Terminator then
return;
-- Comment is OK
elsif Source (S) = '-' and then Source (S + 1) = '-' then
return;
-- ABORT keyword is OK after THEN (THEN ABORT case)
elsif Token = Tok_Then
and then (Source (S + 0) = 'a' or else Source (S + 0) = 'A')
and then (Source (S + 1) = 'b' or else Source (S + 1) = 'B')
and then (Source (S + 2) = 'o' or else Source (S + 2) = 'O')
and then (Source (S + 3) = 'r' or else Source (S + 3) = 'R')
and then (Source (S + 4) = 't' or else Source (S + 4) = 'T')
and then (Source (S + 5) in Line_Terminator
or else Is_White_Space (Source (S + 5)))
then
return;
-- PRAGMA keyword is OK after ELSE
elsif Token = Tok_Else
and then (Source (S + 0) = 'p' or else Source (S + 0) = 'P')
and then (Source (S + 1) = 'r' or else Source (S + 1) = 'R')
and then (Source (S + 2) = 'a' or else Source (S + 2) = 'A')
and then (Source (S + 3) = 'g' or else Source (S + 3) = 'G')
and then (Source (S + 4) = 'm' or else Source (S + 4) = 'M')
and then (Source (S + 5) = 'a' or else Source (S + 5) = 'A')
and then (Source (S + 6) in Line_Terminator
or else Is_White_Space (Source (S + 6)))
then
return;
-- Otherwise we have the style violation we are looking for
else
if Token = Tok_Then then
Error_Msg
("(style) no statements may follow THEN on same line", S);
else
Error_Msg
("(style) no statements may follow ELSE on same line", S);
end if;
end if;
end Check_Separate_Stmt_Lines_Cont;
----------------
-- Check_Then --
----------------
......
gcc/ada/styleg.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- 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- --
......@@ -133,6 +133,13 @@ package Styleg is
-- procedure is called only if THEN appears at the start of a line with
-- Token_Ptr pointing to the THEN keyword.
procedure Check_Separate_Stmt_Lines;
pragma Inline (Check_Separate_Stmt_Lines);
-- Called after scanning THEN (not preceded by AND) or ELSE (not preceded
-- by OR). Used to check that no tokens follow on the same line (which
-- would intefere with coverage testing). Handles case of THEN ABORT as
-- an exception, as well as PRAGMA after ELSE.
procedure Check_Unary_Plus_Or_Minus;
-- Called after scanning a unary plus or minus to check spacing
......
gcc/ada/stylesw.adb
......@@ -54,6 +54,7 @@ package body Stylesw is
Style_Check_Order_Subprograms := False;
Style_Check_Pragma_Casing := False;
Style_Check_References := False;
Style_Check_Separate_Stmt_Lines := False;
Style_Check_Specs := False;
Style_Check_Standard := False;
Style_Check_Tokens := False;
......@@ -65,7 +66,7 @@ package body Stylesw is
------------------------------
procedure Save_Style_Check_Options (Options : out Style_Check_Options) is
P : Natural := 0;
P : Natural := 0;
procedure Add (C : Character; S : Boolean);
-- Add given character C to string if switch S is true
......@@ -126,6 +127,7 @@ package body Stylesw is
Add ('p', Style_Check_Pragma_Casing);
Add ('r', Style_Check_References);
Add ('s', Style_Check_Specs);
Add ('S', Style_Check_Separate_Stmt_Lines);
Add ('t', Style_Check_Tokens);
Add ('u', Style_Check_Blank_Lines);
Add ('x', Style_Check_Xtra_Parens);
......@@ -167,7 +169,7 @@ package body Stylesw is
procedure Set_GNAT_Style_Check_Options is
begin
Reset_Style_Check_Options;
Set_Style_Check_Options ("3aAbcdefhiklmnprstux");
Set_Style_Check_Options ("3aAbcdefhiklmnprsStux");
end Set_GNAT_Style_Check_Options;
-----------------------------
......@@ -359,6 +361,9 @@ package body Stylesw is
when 's' =>
Style_Check_Specs := True;
when 'S' =>
Style_Check_Separate_Stmt_Lines := True;
when 't' =>
Style_Check_Tokens := True;
......
gcc/ada/xnmake.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- 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- --
......@@ -372,12 +372,18 @@ begin
then
Match (Field, Get_Field);
if Field = "Str" then Field := V_String_Id;
elsif Field = "Node" then Field := V_Node_Id;
elsif Field = "Name" then Field := V_Name_Id;
elsif Field = "List" then Field := V_List_Id;
elsif Field = "Elist" then Field := V_Elist_Id;
elsif Field = "Flag" then Field := V_Boolean;
if Field = "Str" then
Field := V_String_Id;
elsif Field = "Node" then
Field := V_Node_Id;
elsif Field = "Name" then
Field := V_Name_Id;
elsif Field = "List" then
Field := V_List_Id;
elsif Field = "Elist" then
Field := V_Elist_Id;
elsif Field = "Flag" then
Field := V_Boolean;
end if;
if Field = "Boolean" then
......
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