X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Fada%2Fstyleg.adb;h=bf72722cc883c2796f88165a768c1d25c1ee46ec;hb=17052c8f8f63239deccec6d06ff1d9a9ebfc4640;hp=0a38249563b23066c14755bb76697b07ef575f14;hpb=b7c799aac4dc8c85fffec5f949f0f122eefd287c;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/ada/styleg.adb b/gcc/ada/styleg.adb index 0a38249563b..bf72722cc88 100644 --- a/gcc/ada/styleg.adb +++ b/gcc/ada/styleg.adb @@ -6,18 +6,17 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- --- ware Foundation; either version 2, or (at your option) any later ver- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING. If not, write -- --- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- --- MA 02111-1307, USA. -- +-- Public License distributed with GNAT; see file COPYING3. If not, go to -- +-- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- @@ -28,11 +27,14 @@ -- checking rules. For documentation of these rules, see comments on the -- individual procedures. +with Atree; use Atree; with Casing; use Casing; with Csets; use Csets; +with Einfo; use Einfo; with Err_Vars; use Err_Vars; with Opt; use Opt; with Scans; use Scans; +with Sinfo; use Sinfo; with Sinput; use Sinput; with Stylesw; use Stylesw; @@ -63,7 +65,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 @@ -142,7 +148,8 @@ package body Styleg is begin if Style_Check_Attribute_Casing then if Determine_Token_Casing /= Mixed_Case then - Error_Msg_SC ("(style) bad capitalization, mixed case required"); + Error_Msg_SC -- CODEFIX + ("(style) bad capitalization, mixed case required"); end if; end if; end Check_Attribute_Name; @@ -162,6 +169,84 @@ package body Styleg is end if; end Check_Binary_Operator; + ---------------------------- + -- Check_Boolean_Operator -- + ---------------------------- + + procedure Check_Boolean_Operator (Node : Node_Id) is + + function OK_Boolean_Operand (N : Node_Id) return Boolean; + -- Returns True for simple variable, or "not X1" or "X1 and X2" or + -- "X1 or X2" where X1, X2 are recursively OK_Boolean_Operand's. + + ------------------------ + -- OK_Boolean_Operand -- + ------------------------ + + function OK_Boolean_Operand (N : Node_Id) return Boolean is + begin + if Nkind_In (N, N_Identifier, N_Expanded_Name) then + return True; + + elsif Nkind (N) = N_Op_Not then + return OK_Boolean_Operand (Original_Node (Right_Opnd (N))); + + elsif Nkind_In (N, N_Op_And, N_Op_Or) then + return OK_Boolean_Operand (Original_Node (Left_Opnd (N))) + and then + OK_Boolean_Operand (Original_Node (Right_Opnd (N))); + + else + return False; + end if; + end OK_Boolean_Operand; + + -- Start of processig for Check_Boolean_Operator + begin + if Style_Check_Boolean_And_Or + and then Comes_From_Source (Node) + then + declare + Orig : constant Node_Id := Original_Node (Node); + + begin + if Nkind_In (Orig, N_Op_And, N_Op_Or) then + declare + L : constant Node_Id := Original_Node (Left_Opnd (Orig)); + R : constant Node_Id := Original_Node (Right_Opnd (Orig)); + + begin + -- First OK case, simple boolean constants/identifiers + + if OK_Boolean_Operand (L) + and then + OK_Boolean_Operand (R) + then + return; + + -- Second OK case, modular types + + elsif Is_Modular_Integer_Type (Etype (Node)) then + return; + + -- Third OK case, array types + + elsif Is_Array_Type (Etype (Node)) then + return; + + -- Otherwise we have an error + + elsif Nkind (Orig) = N_Op_And then + Error_Msg ("(style) `AND THEN` required", Sloc (Orig)); + else + Error_Msg ("(style) `OR ELSE` required", Sloc (Orig)); + end if; + end; + end if; + end; + end if; + end Check_Boolean_Operator; + --------------- -- Check_Box -- --------------- @@ -235,7 +320,8 @@ package body Styleg is -- 1. Any comment that is not at the start of a line, i.e. where the -- initial minuses are not the first non-blank characters on the - -- line must have at least one blank after the second minus. + -- line must have at least one blank after the second minus or a + -- special character as defined in rule 5. -- 2. A row of all minuses of any length is permitted (see procedure -- box above in the source of this routine). @@ -253,11 +339,16 @@ package body Styleg is -- range 16#21#..16#2F# or 16#3A#..16#3F#. This allows special -- comments, such as those generated by gnatprep, or those that -- appear in the SPARK annotation language to be accepted. - -- + -- Note: for GNAT internal files (-gnatg switch set on for the -- compilation), the only special sequence recognized and allowed -- is --! as generated by gnatprep. + -- 6. In addition, the comment must be properly indented if comment + -- indentation checking is active (Style_Check_Indentation non-zero). + -- Either the start column must be a multiple of this indentation, + -- or the indentation must match that of the next non-blank line. + procedure Check_Comment is S : Source_Ptr; C : Character; @@ -266,6 +357,14 @@ package body Styleg is -- Returns True if the last two characters on the line are -- which -- characterizes a box comment (as for example follows this spec). + function Is_Special_Character (C : Character) return Boolean; + -- Determines if C is a special character (see rule 5 above) + + function Same_Column_As_Next_Non_Blank_Line return Boolean; + -- Called for a full line comment. If the indentation of this comment + -- matches that of the next non-blank line in the source, then True is + -- returned, otherwise False. + -------------------- -- Is_Box_Comment -- -------------------- @@ -284,6 +383,48 @@ package body Styleg is return Source (S - 1) = '-' and then Source (S - 2) = '-'; end Is_Box_Comment; + -------------------------- + -- Is_Special_Character -- + -------------------------- + + function Is_Special_Character (C : Character) return Boolean is + begin + if GNAT_Mode then + return C = '!'; + else + return + Character'Pos (C) in 16#21# .. 16#2F# + or else + Character'Pos (C) in 16#3A# .. 16#3F#; + end if; + end Is_Special_Character; + + ---------------------------------------- + -- Same_Column_As_Next_Non_Blank_Line -- + ---------------------------------------- + + function Same_Column_As_Next_Non_Blank_Line return Boolean is + P : Source_Ptr; + + begin + -- Step to end of line + + P := Scan_Ptr + 2; + while Source (P) not in Line_Terminator loop + P := P + 1; + end loop; + + -- Step past blanks, and line terminators (UTF_32 case???) + + while Source (P) <= ' ' and then Source (P) /= EOF loop + P := P + 1; + end loop; + + -- Compare columns + + return Get_Column_Number (Scan_Ptr) = Get_Column_Number (P); + end Same_Column_As_Next_Non_Blank_Line; + -- Start of processing for Check_Comment begin @@ -299,11 +440,13 @@ package body Styleg is -- For a comment that is not at the start of the line, the only -- requirement is that we cannot have a non-blank character after - -- the second minus sign. + -- the second minus sign or a special character. if Scan_Ptr /= First_Non_Blank_Location then if Style_Check_Comments then - if Source (Scan_Ptr + 2) > ' ' then + if Source (Scan_Ptr + 2) > ' ' + and then not Is_Special_Character (Source (Scan_Ptr + 2)) + then Error_Msg ("(style) space required", Scan_Ptr + 2); end if; end if; @@ -317,12 +460,16 @@ package body Styleg is if Style_Check_Indentation /= 0 then if Start_Column rem Style_Check_Indentation /= 0 then - Error_Msg_S ("(style) bad column"); + if not Same_Column_As_Next_Non_Blank_Line then + Error_Msg_S -- CODEFIX + ("(style) bad column"); + end if; + return; end if; end if; - -- If we are not checking comments, nothing to do + -- If we are not checking comments, nothing more to do if not Style_Check_Comments then return; @@ -344,18 +491,8 @@ package body Styleg is -- This is not permitted in internal GNAT implementation units -- except for the case of --! as used by gnatprep output. - if GNAT_Mode then - if C = '!' then - return; - end if; - - else - if Character'Pos (C) in 16#21# .. 16#2F# - or else - Character'Pos (C) in 16#3A# .. 16#3F# - then - return; - end if; + if Is_Special_Character (C) then + return; end if; -- The only other case in which we allow a character after @@ -463,7 +600,7 @@ package body Styleg is -- In check indentation mode (-gnatyn for n a digit), a new statement or -- declaration is required to start in a column that is a multiple of the - -- indentiation amount. + -- indentation amount. procedure Check_Indentation is begin @@ -551,16 +688,20 @@ package body Styleg is end if; end if; - -- Check DOS line terminator (ignore EOF, since we only get called - -- with an EOF if it is the last character in the buffer, and was - -- therefore not present in the sources + -- Check DOS line terminator if Style_Check_DOS_Line_Terminator then + + -- Ignore EOF, since we only get called with an EOF if it is the last + -- character in the buffer (and was therefore not in the source file), + -- since the terminating EOF is added to stop the scan. + if Source (Scan_Ptr) = EOF then null; - elsif Source (Scan_Ptr) /= LF - or else Source (Scan_Ptr + 1) = CR - then + + -- Bad terminator if we don't have an LF + + elsif Source (Scan_Ptr) /= LF then Error_Msg_S ("(style) incorrect line terminator"); end if; end if; @@ -598,7 +739,7 @@ package body Styleg is else if Style_Check_Blank_Lines and then Blank_Lines > 1 then - Error_Msg + Error_Msg -- CODEFIX ("(style) multiple blank lines", Blank_Line_Location); end if; @@ -662,7 +803,8 @@ package body Styleg is begin if Style_Check_Pragma_Casing then if Determine_Token_Casing /= Mixed_Case then - Error_Msg_SC ("(style) bad capitalization, mixed case required"); + Error_Msg_SC -- CODEFIX + ("(style) bad capitalization, mixed case required"); end if; end if; end Check_Pragma_Name; @@ -671,12 +813,17 @@ package body Styleg is -- 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. procedure Check_Right_Paren is begin 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; end if; end Check_Right_Paren; @@ -699,6 +846,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 -- ---------------- @@ -723,7 +946,7 @@ package body Styleg is -- Check_Unary_Plus_Or_Minus -- ------------------------------- - -- In check tokem mode (-gnatyt), unary plus or minus must not be + -- In check token mode (-gnatyt), unary plus or minus must not be -- followed by a space. procedure Check_Unary_Plus_Or_Minus is @@ -794,6 +1017,15 @@ package body Styleg is return C = ' ' or else C = HT; end Is_White_Space; + ------------------- + -- Mode_In_Check -- + ------------------- + + function Mode_In_Check return Boolean is + begin + return Style_Check and Style_Check_Mode_In; + end Mode_In_Check; + ----------------- -- No_End_Name -- ----------------- @@ -828,14 +1060,15 @@ package body Styleg is -- Non_Lower_Case_Keyword -- ---------------------------- - -- In check casing mode (-gnatyk), reserved keywords must be be spelled + -- In check casing mode (-gnatyk), reserved keywords must be spelled -- in all lower case (excluding keywords range, access, delta and digits -- used as attribute designators). procedure Non_Lower_Case_Keyword is begin if Style_Check_Keyword_Casing then - Error_Msg_SC ("(style) reserved words must be all lower case"); + Error_Msg_SC -- CODEIX + ("(style) reserved words must be all lower case"); end if; end Non_Lower_Case_Keyword; @@ -863,13 +1096,4 @@ package body Styleg is end if; end Require_Preceding_Space; - --------------------- - -- RM_Column_Check -- - --------------------- - - function RM_Column_Check return Boolean is - begin - return Style_Check and Style_Check_Layout; - end RM_Column_Check; - end Styleg;