Commit a9a5b8ac by Robert Dewar Committed by Arnaud Charlet

sem_ch13.ads, [...] (Adjust_Record_For_Reverse_Bit_Order): Use First/Next_Component_Or_Discriminant

2007-04-06  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.ads, sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order):
	Use First/Next_Component_Or_Discriminant
	(Analyze_Record_Representation_Clause):
	Use First/Next_Component_Or_Discriminant
	(Check_Component_Overlap): Use First/Next_Component_Or_Discriminant
	(Analyze_Attribute_Definition_Clause, case Value_Size): Reject
	definition if type is unconstrained.
	(Adjust_Record_For_Reverse_Bit_Order): New procedure
	(Analyze_Attribute_Definition_Clause): Split Is_Abstract flag into
	Is_Abstract_Subprogram and Is_Abstract_Type.
	(Adjust_Record_For_Reverse_Bit_Order): New procedure

	* repinfo.adb (List_Record_Info): Use First/
	Next_Component_Or_Discriminant.

	* style.ads, styleg-c.adb, styleg-c.ads (Check_Array_Attribute_Index):
	New procedure.

	* stylesw.ads, stylesw.adb: Recognize new -gnatyA style switch
	Include -gnatyA in default switches

	* opt.ads: (Warn_On_Non_Local_Exception): New flag
	(Warn_On_Reverse_Bit_Order): New flag
	(Extensions_Allowed): Update the documentation.
	(Warn_On_Questionable_Missing_Parens): Now on by default

	* usage.adb: Add documentation of -gnatw.x/X switches
	Document new -gnatyA style switch
	-gnatq warnings are on by default

From-SVN: r123590
parent 2f41ec1a
......@@ -430,7 +430,8 @@ package Opt is
Extensions_Allowed : Boolean := False;
-- GNAT
-- Set to True by switch -gnatX if GNAT specific language extensions
-- are allowed. For example, "limited with" is a GNAT extension.
-- are allowed. For example, the use of 'Constrained with objects of
-- generic types is a GNAT extension.
type External_Casing_Type is (
As_Is, -- External names cased as they appear in the Ada source
......@@ -1163,12 +1164,19 @@ package Opt is
-- variable that is at least partially uninitialized. Set to false to
-- suppress such warnings. The default is that such warnings are enabled.
Warn_On_Non_Local_Exception : Boolean := True;
-- GNAT
-- Set to True to generate warnings for non-local exception raises and also
-- handlers that can never handle a local raise. This warning is only ever
-- generated if pragma Restrictions (No_Exception_Propagation) is set. The
-- default is to generate the warnings if the restriction is set.
Warn_On_Obsolescent_Feature : Boolean := False;
-- GNAT
-- Set to True to generate warnings on use of any feature in Annex or if a
-- subprogram is called for which a pragma Obsolescent applies.
Warn_On_Questionable_Missing_Parens : Boolean := False;
Warn_On_Questionable_Missing_Parens : Boolean := True;
-- GNAT
-- Set to True to generate warnings for cases where parenthese are missing
-- and the usage is questionable, because the intent is unclear.
......@@ -1178,6 +1186,12 @@ package Opt is
-- Set to True to generate warnings for redundant constructs (e.g. useless
-- assignments/conversions). The default is that this warning is disabled.
Warn_On_Reverse_Bit_Order : Boolean := True;
-- GNAT
-- Set to True to generate warning (informational) messages for component
-- clauses that are affected by non-standard bit-order. The default is
-- that this warning is enabled.
Warn_On_Unchecked_Conversion : Boolean := True;
-- GNAT
-- Set to True to generate warnings for unchecked conversions that may have
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -35,6 +35,13 @@ package Sem_Ch13 is
procedure Analyze_Record_Representation_Clause (N : Node_Id);
procedure Analyze_Code_Statement (N : Node_Id);
procedure Adjust_Record_For_Reverse_Bit_Order (R : Entity_Id);
-- Called from Freeze where R is a record entity for which reverse bit
-- order is specified and there is at least one component clause. Adjusts
-- component positions according to Ada 2005 AI-133. Note that this is only
-- called in Ada 2005 mode. The Ada 95 handling for bit order is entirely
-- contained in Freeze.
procedure Initialize;
-- Initialize internal tables for new compilation
......
......@@ -65,6 +65,16 @@ package Style is
renames Style_Inst.Check_Apostrophe;
-- Called after scanning an apostrophe to check spacing
procedure Check_Array_Attribute_Index
(N : Node_Id;
E1 : Node_Id;
D : Int)
renames Style_C_Inst.Check_Array_Attribute_Index;
-- Called for an array attribute specifying an index number. N is the
-- node for the attribute, and E1 is the index expression (Empty if none
-- present). If E1 is present, it is known to be a static integer. D is
-- the number of dimensions of the array.
procedure Check_Arrow
renames Style_Inst.Check_Arrow;
-- Called after scanning out an arrow to check spacing
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -67,6 +67,29 @@ package body Styleg.C is
end if;
end Body_With_No_Spec;
---------------------------------
-- Check_Array_Attribute_Index --
---------------------------------
procedure Check_Array_Attribute_Index
(N : Node_Id;
E1 : Node_Id;
D : Int)
is
begin
if Style_Check_Array_Attribute_Index then
if D = 1 and then Present (E1) then
Error_Msg_N
("(style) index number not allowed for one dimensional array",
E1);
elsif D > 1 and then No (E1) then
Error_Msg_N
("(style) index number required for multi-dimensional array",
N);
end if;
end if;
end Check_Array_Attribute_Index;
----------------------
-- Check_Identifier --
----------------------
......
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -38,6 +38,15 @@ package Styleg.C is
-- Called where N is a subprogram body node for a subprogram body
-- for which no spec was given, i.e. a body acting as its own spec.
procedure Check_Array_Attribute_Index
(N : Node_Id;
E1 : Node_Id;
D : Int);
-- Called for an array attribute specifying an index number. N is the
-- node for the attribute, and E1 is the index expression (Empty if none
-- present). If E1 is present, it is known to be a static integer. D is
-- the number of dimensions of the array.
procedure Check_Identifier
(Ref : Node_Or_Entity_Id;
Def : Node_Or_Entity_Id);
......
......@@ -35,28 +35,29 @@ package body Stylesw is
procedure Reset_Style_Check_Options is
begin
Style_Check_Indentation := 0;
Style_Check_Attribute_Casing := False;
Style_Check_Blanks_At_End := False;
Style_Check_Blank_Lines := False;
Style_Check_Comments := False;
Style_Check_DOS_Line_Terminator := False;
Style_Check_End_Labels := False;
Style_Check_Form_Feeds := False;
Style_Check_Horizontal_Tabs := False;
Style_Check_If_Then_Layout := False;
Style_Check_Keyword_Casing := False;
Style_Check_Layout := False;
Style_Check_Max_Line_Length := False;
Style_Check_Max_Nesting_Level := False;
Style_Check_Mode_In := False;
Style_Check_Order_Subprograms := False;
Style_Check_Pragma_Casing := False;
Style_Check_References := False;
Style_Check_Specs := False;
Style_Check_Standard := False;
Style_Check_Tokens := False;
Style_Check_Xtra_Parens := False;
Style_Check_Indentation := 0;
Style_Check_Array_Attribute_Index := False;
Style_Check_Attribute_Casing := False;
Style_Check_Blanks_At_End := False;
Style_Check_Blank_Lines := False;
Style_Check_Comments := False;
Style_Check_DOS_Line_Terminator := False;
Style_Check_End_Labels := False;
Style_Check_Form_Feeds := False;
Style_Check_Horizontal_Tabs := False;
Style_Check_If_Then_Layout := False;
Style_Check_Keyword_Casing := False;
Style_Check_Layout := False;
Style_Check_Max_Line_Length := False;
Style_Check_Max_Nesting_Level := False;
Style_Check_Mode_In := False;
Style_Check_Order_Subprograms := False;
Style_Check_Pragma_Casing := False;
Style_Check_References := False;
Style_Check_Specs := False;
Style_Check_Standard := False;
Style_Check_Tokens := False;
Style_Check_Xtra_Parens := False;
end Reset_Style_Check_Options;
------------------------------
......@@ -64,7 +65,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
......@@ -109,6 +110,7 @@ package body Stylesw is
Style_Check_Indentation /= 0);
Add ('a', Style_Check_Attribute_Casing);
Add ('A', Style_Check_Array_Attribute_Index);
Add ('b', Style_Check_Blanks_At_End);
Add ('c', Style_Check_Comments);
Add ('d', Style_Check_DOS_Line_Terminator);
......@@ -155,7 +157,7 @@ package body Stylesw is
procedure Set_Default_Style_Check_Options is
begin
Reset_Style_Check_Options;
Set_Style_Check_Options ("3abcefhiklmnprst");
Set_Style_Check_Options ("3aAbcefhiklmnprst");
end Set_Default_Style_Check_Options;
-----------------------------
......@@ -228,37 +230,40 @@ package body Stylesw is
Character'Pos (C) - Character'Pos ('0');
when 'a' =>
Style_Check_Attribute_Casing := True;
Style_Check_Attribute_Casing := True;
when 'A' =>
Style_Check_Array_Attribute_Index := True;
when 'b' =>
Style_Check_Blanks_At_End := True;
Style_Check_Blanks_At_End := True;
when 'c' =>
Style_Check_Comments := True;
Style_Check_Comments := True;
when 'd' =>
Style_Check_DOS_Line_Terminator := True;
Style_Check_DOS_Line_Terminator := True;
when 'e' =>
Style_Check_End_Labels := True;
Style_Check_End_Labels := True;
when 'f' =>
Style_Check_Form_Feeds := True;
Style_Check_Form_Feeds := True;
when 'h' =>
Style_Check_Horizontal_Tabs := True;
Style_Check_Horizontal_Tabs := True;
when 'i' =>
Style_Check_If_Then_Layout := True;
Style_Check_If_Then_Layout := True;
when 'I' =>
Style_Check_Mode_In := True;
Style_Check_Mode_In := True;
when 'k' =>
Style_Check_Keyword_Casing := True;
Style_Check_Keyword_Casing := True;
when 'l' =>
Style_Check_Layout := True;
Style_Check_Layout := True;
when 'L' =>
Style_Max_Nesting_Level := 0;
......@@ -289,11 +294,11 @@ package body Stylesw is
Style_Check_Max_Nesting_Level := Style_Max_Nesting_Level /= 0;
when 'm' =>
Style_Check_Max_Line_Length := True;
Style_Max_Line_Length := 79;
Style_Check_Max_Line_Length := True;
Style_Max_Line_Length := 79;
when 'M' =>
Style_Max_Line_Length := 0;
Style_Max_Line_Length := 0;
if Err_Col > Options'Last
or else Options (Err_Col) not in '0' .. '9'
......@@ -321,34 +326,34 @@ package body Stylesw is
or else Options (Err_Col) not in '0' .. '9';
end loop;
Style_Check_Max_Line_Length := Style_Max_Line_Length /= 0;
Style_Check_Max_Line_Length := Style_Max_Line_Length /= 0;
when 'n' =>
Style_Check_Standard := True;
Style_Check_Standard := True;
when 'N' =>
Reset_Style_Check_Options;
when 'o' =>
Style_Check_Order_Subprograms := True;
Style_Check_Order_Subprograms := True;
when 'p' =>
Style_Check_Pragma_Casing := True;
Style_Check_Pragma_Casing := True;
when 'r' =>
Style_Check_References := True;
Style_Check_References := True;
when 's' =>
Style_Check_Specs := True;
Style_Check_Specs := True;
when 't' =>
Style_Check_Tokens := True;
Style_Check_Tokens := True;
when 'u' =>
Style_Check_Blank_Lines := True;
Style_Check_Blank_Lines := True;
when 'x' =>
Style_Check_Xtra_Parens := True;
Style_Check_Xtra_Parens := True;
when ' ' =>
null;
......
......@@ -47,6 +47,12 @@ package Stylesw is
-- through a call to Set_Default_Style_Check_Options. They should
-- not be set directly in any other manner.
Style_Check_Array_Attribute_Index : Boolean := False;
-- This can be set True by using -gnatg or -gnatyA switches. If it is True
-- then index numbers for array attributes (like Length) are required to
-- be absent for one-dimensional arrays and present for multi-dimensional
-- array attribute references.
Style_Check_Attribute_Casing : Boolean := False;
-- This can be set True by using the -gnatg or -gnatya switches. If
-- it is True, then attribute names (including keywords such as
......
......@@ -391,10 +391,10 @@ begin
Write_Line (" O turn off warnings for address clause overlay");
Write_Line (" p turn on warnings for ineffective pragma Inline");
Write_Line (" P* turn off warnings for ineffective pragma Inline");
Write_Line (" q turn on warnings for questionable " &
"missing paretheses");
Write_Line (" Q* turn off warnings for questionable " &
"missing paretheses");
Write_Line (" q* turn on warnings for questionable " &
"missing parentheses");
Write_Line (" Q turn off warnings for questionable " &
"missing parentheses");
Write_Line (" r turn on warnings for redundant construct");
Write_Line (" R* turn off warnings for redundant construct");
Write_Line (" s suppress all warnings");
......@@ -409,6 +409,8 @@ begin
"assumption");
Write_Line (" x* turn on warnings for export/import");
Write_Line (" X turn off warnings for export/import");
Write_Line (" .x* turn on warnings for non-local exceptions");
Write_Line (" .X turn off warnings for non-local exceptions");
Write_Line (" y* turn on warnings for Ada 2005 incompatibility");
Write_Line (" Y turn off warnings for Ada 2005 incompatibility");
Write_Line (" z* turn on size/align warnings for " &
......@@ -452,6 +454,7 @@ begin
Write_Line ("Enable selected style checks xx = list of parameters:");
Write_Line (" 1-9 check indentation");
Write_Line (" a check attribute casing");
Write_Line (" A check array attribute indexes");
Write_Line (" b check no blanks at end of lines");
Write_Line (" c check comment format");
Write_Line (" d check no DOS line terminators");
......@@ -472,7 +475,7 @@ begin
Write_Line (" s check separate subprogram specs present");
Write_Line (" t check token separation rules");
Write_Line (" u check no unnecessary blank lines");
Write_Line (" x check extra parens around conditionals");
Write_Line (" x check extra parentheses around conditionals");
-- Lines for -gnatyN switch
......
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