Commit 4f73f89c by Robert Dewar Committed by Arnaud Charlet

par-ch6.adb, [...]: Implement -gnatyI switch (MODE_IN)

2006-02-13  Robert Dewar  <dewar@adacore.com>

	* par-ch6.adb, style.ads, styleg.adb, styleg.ads, stylesw.adb,
	stylesw.ads, usage.adb, vms_data.ads: Implement -gnatyI switch
	(MODE_IN)

From-SVN: r111081
parent 76346895
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2006, 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- --
...@@ -1227,6 +1227,10 @@ package body Ch6 is ...@@ -1227,6 +1227,10 @@ package body Ch6 is
if Token = Tok_In then if Token = Tok_In then
Scan; -- past IN Scan; -- past IN
Set_In_Present (Node, True); Set_In_Present (Node, True);
if Style.Mode_In_Check and then Token /= Tok_Out then
Error_Msg_SP ("(style) IN should be omitted");
end if;
end if; end if;
if Token = Tok_Out then if Token = Tok_Out then
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2006, 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- --
...@@ -25,14 +25,14 @@ ...@@ -25,14 +25,14 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- This package collects all the routines used for style checking, as -- This package collects all the routines used for style checking, as
-- activated by the relevant command line option. These are gathered in -- activated by the relevant command line option. These are gathered in a
-- a separate package so that they can more easily be customized. Calls -- separate package so that they can more easily be customized. Calls to
-- to these subprograms are only made if Opt.Style_Check is set True. -- these subprograms are only made if Opt.Style_Check is set True.
with Errout; with Errout;
with Styleg; with Styleg;
with Styleg.C; with Styleg.C;
with Types; use Types; with Types; use Types;
package Style is package Style is
...@@ -71,10 +71,10 @@ package Style is ...@@ -71,10 +71,10 @@ package Style is
procedure Check_Attribute_Name (Reserved : Boolean) procedure Check_Attribute_Name (Reserved : Boolean)
renames Style_Inst.Check_Attribute_Name; renames Style_Inst.Check_Attribute_Name;
-- The current token is an attribute designator. Check that it -- The current token is an attribute designator. Check that it is
-- is capitalized in an appropriate manner. Reserved is set if -- capitalized in an appropriate manner. Reserved is set if the attribute
-- the attribute designator is a reserved word (access, digits, -- designator is a reserved word (access, digits, delta or range) to allow
-- delta or range) to allow differing rules for the two cases. -- differing rules for the two cases.
procedure Check_Box procedure Check_Box
renames Style_Inst.Check_Box; renames Style_Inst.Check_Box;
...@@ -136,14 +136,14 @@ package Style is ...@@ -136,14 +136,14 @@ package Style is
procedure Check_Left_Paren procedure Check_Left_Paren
renames Style_Inst.Check_Left_Paren; renames Style_Inst.Check_Left_Paren;
-- Called after scanning out a left parenthesis to check spacing. -- Called after scanning out a left parenthesis to check spacing
procedure Check_Line_Terminator (Len : Int) procedure Check_Line_Terminator (Len : Int)
renames Style_Inst.Check_Line_Terminator; renames Style_Inst.Check_Line_Terminator;
-- Called with Scan_Ptr pointing to the first line terminator terminating -- Called with Scan_Ptr pointing to the first line terminator terminating
-- the current line, used to check for appropriate line terminator and -- the current line, used to check for appropriate line terminator and to
-- to check the line length (Len is the length of the current line). -- check the line length (Len is the length of the current line). Note that
-- Note that the terminator may be the EOF character. -- the terminator may be the EOF character.
procedure Check_Pragma_Name procedure Check_Pragma_Name
renames Style_Inst.Check_Pragma_Name; renames Style_Inst.Check_Pragma_Name;
...@@ -152,7 +152,7 @@ package Style is ...@@ -152,7 +152,7 @@ package Style is
procedure Check_Right_Paren procedure Check_Right_Paren
renames Style_Inst.Check_Right_Paren; renames Style_Inst.Check_Right_Paren;
-- Called after scanning out a right parenthesis to check spacing. -- Called after scanning out a right parenthesis to check spacing
procedure Check_Semicolon procedure Check_Semicolon
renames Style_Inst.Check_Semicolon; renames Style_Inst.Check_Semicolon;
...@@ -178,6 +178,11 @@ package Style is ...@@ -178,6 +178,11 @@ package Style is
-- Called after scanning a conditional expression that has at least one -- Called after scanning a conditional expression that has at least one
-- level of parentheses around the entire expression. -- level of parentheses around the entire expression.
function Mode_In_Check return Boolean
renames Style_Inst.Mode_In_Check;
-- Determines whether style checking is active and the Mode_In_Check is
-- set, forbidding the explicit use of mode IN.
procedure No_End_Name (Name : Node_Id) procedure No_End_Name (Name : Node_Id)
renames Style_Inst.No_End_Name; renames Style_Inst.No_End_Name;
-- Called if an END is encountered where a name is allowed but not present. -- Called if an END is encountered where a name is allowed but not present.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2006, 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- --
...@@ -794,6 +794,15 @@ package body Styleg is ...@@ -794,6 +794,15 @@ package body Styleg is
return C = ' ' or else C = HT; return C = ' ' or else C = HT;
end Is_White_Space; 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 -- -- No_End_Name --
----------------- -----------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2006, 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- --
...@@ -143,6 +143,11 @@ package Styleg is ...@@ -143,6 +143,11 @@ package Styleg is
-- Called after scanning a conditional expression that has at least one -- Called after scanning a conditional expression that has at least one
-- level of parentheses around the entire expression. -- level of parentheses around the entire expression.
function Mode_In_Check return Boolean;
pragma Inline (Mode_In_Check);
-- Determines whether style checking is active and the Mode_In_Check is
-- set, forbidding the explicit use of mode IN.
procedure No_End_Name (Name : Node_Id); procedure No_End_Name (Name : Node_Id);
-- Called if an END is encountered where a name is allowed but not present. -- Called if an END is encountered where a name is allowed but not present.
-- The parameter is the node whose name is the name that is permitted in -- The parameter is the node whose name is the name that is permitted in
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2006, 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- --
...@@ -49,6 +49,7 @@ package body Stylesw is ...@@ -49,6 +49,7 @@ package body Stylesw is
Style_Check_Layout := False; Style_Check_Layout := False;
Style_Check_Max_Line_Length := False; Style_Check_Max_Line_Length := False;
Style_Check_Max_Nesting_Level := False; Style_Check_Max_Nesting_Level := False;
Style_Check_Mode_In := False;
Style_Check_Order_Subprograms := False; Style_Check_Order_Subprograms := False;
Style_Check_Pragma_Casing := False; Style_Check_Pragma_Casing := False;
Style_Check_References := False; Style_Check_References := False;
...@@ -115,6 +116,7 @@ package body Stylesw is ...@@ -115,6 +116,7 @@ package body Stylesw is
Add ('f', Style_Check_Form_Feeds); Add ('f', Style_Check_Form_Feeds);
Add ('h', Style_Check_Horizontal_Tabs); Add ('h', Style_Check_Horizontal_Tabs);
Add ('i', Style_Check_If_Then_Layout); Add ('i', Style_Check_If_Then_Layout);
Add ('I', Style_Check_Mode_In);
Add ('k', Style_Check_Keyword_Casing); Add ('k', Style_Check_Keyword_Casing);
Add ('l', Style_Check_Layout); Add ('l', Style_Check_Layout);
Add ('n', Style_Check_Standard); Add ('n', Style_Check_Standard);
...@@ -249,6 +251,9 @@ package body Stylesw is ...@@ -249,6 +251,9 @@ package body Stylesw is
when 'i' => when 'i' =>
Style_Check_If_Then_Layout := True; Style_Check_If_Then_Layout := True;
when 'I' =>
Style_Check_Mode_In := True;
when 'k' => when 'k' =>
Style_Check_Keyword_Casing := True; Style_Check_Keyword_Casing := True;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2006, 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- --
...@@ -155,6 +155,10 @@ package Stylesw is ...@@ -155,6 +155,10 @@ package Stylesw is
-- zero (a value of zero resets it to False). If True, it activates -- zero (a value of zero resets it to False). If True, it activates
-- checking the maximum nesting level against Style_Max_Nesting_Level. -- checking the maximum nesting level against Style_Max_Nesting_Level.
Style_Check_Mode_In : Boolean := False;
-- This can be set True by using -gnatyI. If True, it activates checking
-- that mode IN is not used on its own (since it is the default).
Style_Check_Order_Subprograms : Boolean := False; Style_Check_Order_Subprograms : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyo switch. If it -- This can be set True by using the -gnatg or -gnatyo switch. If it
-- is True, then names of subprogram bodies must be in alphabetical -- is True, then names of subprogram bodies must be in alphabetical
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2006, 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- --
...@@ -436,6 +436,7 @@ begin ...@@ -436,6 +436,7 @@ begin
Write_Line (" f check no form feeds/vertical tabs in source"); Write_Line (" f check no form feeds/vertical tabs in source");
Write_Line (" h check no horizontal tabs in source"); Write_Line (" h check no horizontal tabs in source");
Write_Line (" i check if-then layout"); Write_Line (" i check if-then layout");
Write_Line (" I check mode in");
Write_Line (" k check casing rules for keywords"); Write_Line (" k check casing rules for keywords");
Write_Line (" l check reference manual layout"); Write_Line (" l check reference manual layout");
Write_Line (" Lnn check max nest level < nn "); Write_Line (" Lnn check max nest level < nn ");
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1996-2005, Free Software Foundation, Inc. -- -- Copyright (C) 1996-2006, 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- --
...@@ -1957,6 +1957,8 @@ package VMS_Data is ...@@ -1957,6 +1957,8 @@ package VMS_Data is
"-gnatyl " & "-gnatyl " &
"LINE_LENGTH " & "LINE_LENGTH " &
"-gnatym " & "-gnatym " &
"MODE_IN " &
"-gnatyI " &
"NONE " & "NONE " &
"-gnatyN " & "-gnatyN " &
"STANDARD_CASING " & "STANDARD_CASING " &
......
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