mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-22 22:51:32 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Robert Dewar 2007-04-06 11:25:29 +02:00 committed by Arnaud Charlet
parent 2f41ec1a8f
commit a9a5b8acd2
10 changed files with 550 additions and 230 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/ada/opt.ads
View File

@ -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

263
gcc/ada/repinfo.adb
View File

@ -784,172 +784,165 @@ package body Repinfo is
Max_Name_Length := 0;
Max_Suni_Length := 0;
Comp := First_Entity (Ent);
Comp := First_Component_Or_Discriminant (Ent);
while Present (Comp) loop
if Ekind (Comp) = E_Component
or else Ekind (Comp) = E_Discriminant
then
Get_Decoded_Name_String (Chars (Comp));
Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len);
Get_Decoded_Name_String (Chars (Comp));
Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len);
Cfbit := Component_Bit_Offset (Comp);
Cfbit := Component_Bit_Offset (Comp);
if Rep_Not_Constant (Cfbit) then
UI_Image_Length := 2;
if Rep_Not_Constant (Cfbit) then
UI_Image_Length := 2;
else
-- Complete annotation in case not done
else
-- Complete annotation in case not done
Set_Normalized_Position (Comp, Cfbit / SSU);
Set_Normalized_First_Bit (Comp, Cfbit mod SSU);
Set_Normalized_Position (Comp, Cfbit / SSU);
Set_Normalized_First_Bit (Comp, Cfbit mod SSU);
Sunit := Cfbit / SSU;
UI_Image (Sunit);
end if;
-- If the record is not packed, then we know that all fields whose
-- position is not specified have a starting normalized bit
-- position of zero
if Unknown_Normalized_First_Bit (Comp)
and then not Is_Packed (Ent)
then
Set_Normalized_First_Bit (Comp, Uint_0);
end if;
Max_Suni_Length :=
Natural'Max (Max_Suni_Length, UI_Image_Length);
Sunit := Cfbit / SSU;
UI_Image (Sunit);
end if;
Comp := Next_Entity (Comp);
-- If the record is not packed, then we know that all fields whose
-- position is not specified have a starting normalized bit position
-- of zero.
if Unknown_Normalized_First_Bit (Comp)
and then not Is_Packed (Ent)
then
Set_Normalized_First_Bit (Comp, Uint_0);
end if;
Max_Suni_Length :=
Natural'Max (Max_Suni_Length, UI_Image_Length);
Next_Component_Or_Discriminant (Comp);
end loop;
-- Second loop does actual output based on those values
Comp := First_Entity (Ent);
Comp := First_Component_Or_Discriminant (Ent);
while Present (Comp) loop
if Ekind (Comp) = E_Component
or else Ekind (Comp) = E_Discriminant
then
declare
Esiz : constant Uint := Esize (Comp);
Bofs : constant Uint := Component_Bit_Offset (Comp);
Npos : constant Uint := Normalized_Position (Comp);
Fbit : constant Uint := Normalized_First_Bit (Comp);
Lbit : Uint;
declare
Esiz : constant Uint := Esize (Comp);
Bofs : constant Uint := Component_Bit_Offset (Comp);
Npos : constant Uint := Normalized_Position (Comp);
Fbit : constant Uint := Normalized_First_Bit (Comp);
Lbit : Uint;
begin
Write_Str (" ");
Get_Decoded_Name_String (Chars (Comp));
Set_Casing (Unit_Casing);
Write_Str (Name_Buffer (1 .. Name_Len));
begin
Write_Str (" ");
Get_Decoded_Name_String (Chars (Comp));
Set_Casing (Unit_Casing);
Write_Str (Name_Buffer (1 .. Name_Len));
for J in 1 .. Max_Name_Length - Name_Len loop
Write_Char (' ');
end loop;
for J in 1 .. Max_Name_Length - Name_Len loop
Write_Char (' ');
end loop;
Write_Str (" at ");
Write_Str (" at ");
if Known_Static_Normalized_Position (Comp) then
UI_Image (Npos);
Spaces (Max_Suni_Length - UI_Image_Length);
Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
if Known_Static_Normalized_Position (Comp) then
UI_Image (Npos);
Spaces (Max_Suni_Length - UI_Image_Length);
Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
elsif Known_Component_Bit_Offset (Comp)
and then List_Representation_Info = 3
then
Spaces (Max_Suni_Length - 2);
Write_Str ("bit offset");
Write_Val (Bofs, Paren => True);
Write_Str (" size in bits = ");
Write_Val (Esiz, Paren => True);
Write_Eol;
elsif Known_Component_Bit_Offset (Comp)
and then List_Representation_Info = 3
then
Spaces (Max_Suni_Length - 2);
Write_Str ("bit offset");
Write_Val (Bofs, Paren => True);
Write_Str (" size in bits = ");
Write_Val (Esiz, Paren => True);
Write_Eol;
goto Continue;
elsif Known_Normalized_Position (Comp)
and then List_Representation_Info = 3
then
Spaces (Max_Suni_Length - 2);
Write_Val (Npos);
else
-- For the packed case, we don't know the bit positions if we
-- don't know the starting position!
if Is_Packed (Ent) then
Write_Line ("?? range ? .. ??;");
goto Continue;
elsif Known_Normalized_Position (Comp)
and then List_Representation_Info = 3
then
Spaces (Max_Suni_Length - 2);
Write_Val (Npos);
-- Otherwise we can continue
else
-- For the packed case, we don't know the bit positions
-- if we don't know the starting position!
if Is_Packed (Ent) then
Write_Line ("?? range ? .. ??;");
goto Continue;
-- Otherwise we can continue
else
Write_Str ("??");
end if;
end if;
Write_Str (" range ");
UI_Write (Fbit);
Write_Str (" .. ");
-- Allowing Uint_0 here is a kludge, really this should be a
-- fine Esize value but currently it means unknown, except that
-- we know after gigi has back annotated that a size of zero is
-- real, since otherwise gigi back annotates using No_Uint as
-- the value to indicate unknown).
if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp))
and then Known_Static_Normalized_First_Bit (Comp)
then
Lbit := Fbit + Esiz - 1;
if Lbit < 10 then
Write_Char (' ');
end if;
UI_Write (Lbit);
-- The test for Esize (Comp) not being Uint_0 here is a kludge.
-- Officially a value of zero for Esize means unknown, but here
-- we use the fact that we know that gigi annotates Esize with
-- No_Uint, not Uint_0. Really everyone should use No_Uint???
elsif List_Representation_Info < 3
or else (Esize (Comp) /= Uint_0 and then Unknown_Esize (Comp))
then
Write_Str ("??");
end if;
end if;
else -- List_Representation >= 3 and Known_Esize (Comp)
Write_Str (" range ");
UI_Write (Fbit);
Write_Str (" .. ");
Write_Val (Esiz, Paren => True);
-- Allowing Uint_0 here is a kludge, really this should be a
-- fine Esize value but currently it means unknown, except that
-- we know after gigi has back annotated that a size of zero is
-- real, since otherwise gigi back annotates using No_Uint as
-- the value to indicate unknown).
-- If in front end layout mode, then dynamic size is stored
-- in storage units, so renormalize for output
if (Esize (Comp) = Uint_0 or else Known_Static_Esize (Comp))
and then Known_Static_Normalized_First_Bit (Comp)
then
Lbit := Fbit + Esiz - 1;
if not Back_End_Layout then
Write_Str (" * ");
Write_Int (SSU);
end if;
-- Add appropriate first bit offset
if Fbit = 0 then
Write_Str (" - 1");
elsif Fbit = 1 then
null;
else
Write_Str (" + ");
Write_Int (UI_To_Int (Fbit) - 1);
end if;
if Lbit < 10 then
Write_Char (' ');
end if;
Write_Line (";");
end;
end if;
UI_Write (Lbit);
-- The test for Esize (Comp) not being Uint_0 here is a kludge.
-- Officially a value of zero for Esize means unknown, but here
-- we use the fact that we know that gigi annotates Esize with
-- No_Uint, not Uint_0. Really everyone should use No_Uint???
elsif List_Representation_Info < 3
or else (Esize (Comp) /= Uint_0 and then Unknown_Esize (Comp))
then
Write_Str ("??");
-- List_Representation >= 3 and Known_Esize (Comp)
else
Write_Val (Esiz, Paren => True);
-- If in front end layout mode, then dynamic size is stored
-- in storage units, so renormalize for output
if not Back_End_Layout then
Write_Str (" * ");
Write_Int (SSU);
end if;
-- Add appropriate first bit offset
if Fbit = 0 then
Write_Str (" - 1");
elsif Fbit = 1 then
null;
else
Write_Str (" + ");
Write_Int (UI_To_Int (Fbit) - 1);
end if;
end if;
Write_Line (";");
end;
<<Continue>>
Comp := Next_Entity (Comp);
Next_Component_Or_Discriminant (Comp);
end loop;
Write_Line ("end record;");

326
gcc/ada/sem_ch13.adb
View File

@ -166,6 +166,265 @@ package body Sem_Ch13 is
return Empty;
end Address_Aliased_Entity;
-----------------------------------------
-- Adjust_Record_For_Reverse_Bit_Order --
-----------------------------------------
procedure Adjust_Record_For_Reverse_Bit_Order (R : Entity_Id) is
Max_Machine_Scalar_Size : constant Uint :=
UI_From_Int
(Standard_Long_Long_Integer_Size);
-- We use this as the maximum machine scalar size in the sense of AI-133
Num_CC : Natural;
Comp : Entity_Id;
SSU : constant Uint := UI_From_Int (System_Storage_Unit);
begin
-- This first loop through components does two things. First it deals
-- with the case of components with component clauses whose length is
-- greater than the maximum machine scalar size (either accepting them
-- or rejecting as needed). Second, it counts the number of components
-- with component clauses whose length does not exceed this maximum for
-- later processing.
Num_CC := 0;
Comp := First_Component_Or_Discriminant (R);
while Present (Comp) loop
declare
CC : constant Node_Id := Component_Clause (Comp);
Fbit : constant Uint := Static_Integer (First_Bit (CC));
begin
if Present (CC) then
-- Case of component with size > max machine scalar
if Esize (Comp) > Max_Machine_Scalar_Size then
-- Must begin on byte boundary
if Fbit mod SSU /= 0 then
Error_Msg_N
("illegal first bit value for reverse bit order",
First_Bit (CC));
Error_Msg_Uint_1 := SSU;
Error_Msg_Uint_2 := Max_Machine_Scalar_Size;
Error_Msg_N
("\must be a multiple of ^ if size greater than ^",
First_Bit (CC));
-- Must end on byte boundary
elsif Esize (Comp) mod SSU /= 0 then
Error_Msg_N
("illegal last bit value for reverse bit order",
Last_Bit (CC));
Error_Msg_Uint_1 := SSU;
Error_Msg_Uint_2 := Max_Machine_Scalar_Size;
Error_Msg_N
("\must be a multiple of ^ if size greater than ^",
Last_Bit (CC));
-- OK, give warning if enabled
elsif Warn_On_Reverse_Bit_Order then
Error_Msg_N
("multi-byte field specified with non-standard"
& " Bit_Order?", CC);
if Bytes_Big_Endian then
Error_Msg_N
("\bytes are not reversed "
& "(component is big-endian)?", CC);
else
Error_Msg_N
("\bytes are not reversed "
& "(component is little-endian)?", CC);
end if;
end if;
-- Case where size is not greater than max machine scalar.
-- For now, we just count these.
else
Num_CC := Num_CC + 1;
end if;
end if;
end;
Next_Component_Or_Discriminant (Comp);
end loop;
-- We need to sort the component clauses on the basis of the Position
-- values in the clause, so we can group clauses with the same Position
-- together to determine the relevant machine scalar size.
declare
Comps : array (0 .. Num_CC) of Entity_Id;
-- Array to collect component and discrimninant entities. The data
-- starts at index 1, the 0'th entry is for GNAT.Heap_Sort_A.
function CP_Lt (Op1, Op2 : Natural) return Boolean;
-- Compare routine for Sort (See GNAT.Heap_Sort_A)
procedure CP_Move (From : Natural; To : Natural);
-- Move routine for Sort (see GNAT.Heap_Sort_A)
Start : Natural;
Stop : Natural;
-- Start and stop positions in component list of set of components
-- with the same starting position (that constitute components in
-- a single machine scalar).
MaxL : Uint;
-- Maximum last bit value of any component in this set
MSS : Uint;
-- Corresponding machine scalar size
-----------
-- CP_Lt --
-----------
function CP_Lt (Op1, Op2 : Natural) return Boolean is
begin
return Position (Component_Clause (Comps (Op1))) <
Position (Component_Clause (Comps (Op2)));
end CP_Lt;
-------------
-- CP_Move --
-------------
procedure CP_Move (From : Natural; To : Natural) is
begin
Comps (To) := Comps (From);
end CP_Move;
begin
-- Collect the component clauses
Num_CC := 0;
Comp := First_Component_Or_Discriminant (R);
while Present (Comp) loop
if Present (Component_Clause (Comp))
and then Esize (Comp) <= Max_Machine_Scalar_Size
then
Num_CC := Num_CC + 1;
Comps (Num_CC) := Comp;
end if;
Next_Component_Or_Discriminant (Comp);
end loop;
-- Sort by ascending position number
Sort (Num_CC, CP_Move'Unrestricted_Access, CP_Lt'Unrestricted_Access);
-- We now have all the components whose size does not exceed the max
-- machine scalar value, sorted by starting position. In this loop
-- we gather groups of clauses starting at the same position, to
-- process them in accordance with Ada 2005 AI-133.
Stop := 0;
while Stop < Num_CC loop
Start := Stop + 1;
Stop := Start;
MaxL :=
Static_Integer (Last_Bit (Component_Clause (Comps (Start))));
while Stop < Num_CC loop
if Static_Integer
(Position (Component_Clause (Comps (Stop + 1)))) =
Static_Integer
(Position (Component_Clause (Comps (Stop))))
then
Stop := Stop + 1;
MaxL :=
UI_Max
(MaxL,
Static_Integer
(Last_Bit (Component_Clause (Comps (Stop)))));
else
exit;
end if;
end loop;
-- Now we have a group of component clauses from Start to Stop
-- whose positions are identical, and MaxL is the maximum last bit
-- value of any of these components.
-- We need to determine the corresponding machine scalar size.
-- This loop assumes that machine scalar sizes are even, and that
-- each possible machine scalar has twice as many bits as the
-- next smaller one.
MSS := Max_Machine_Scalar_Size;
while MSS mod 2 = 0
and then (MSS / 2) >= SSU
and then (MSS / 2) > MaxL
loop
MSS := MSS / 2;
end loop;
-- Here is where we fix up the Component_Bit_Offset value to
-- account for the reverse bit order. Some examples of what needs
-- to be done for the case of a machine scalar size of 8 are:
-- First_Bit .. Last_Bit Component_Bit_Offset
-- old new old new
-- 0 .. 0 7 .. 7 0 7
-- 0 .. 1 6 .. 7 0 6
-- 0 .. 2 5 .. 7 0 5
-- 0 .. 7 0 .. 7 0 4
-- 1 .. 1 6 .. 6 1 6
-- 1 .. 4 3 .. 6 1 3
-- 4 .. 7 0 .. 3 4 0
-- The general rule is that the first bit is is obtained by
-- subtracting the old ending bit from machine scalar size - 1.
for C in Start .. Stop loop
declare
Comp : constant Entity_Id := Comps (C);
CC : constant Node_Id := Component_Clause (Comp);
LB : constant Uint := Static_Integer (Last_Bit (CC));
NFB : constant Uint := MSS - Uint_1 - LB;
NLB : constant Uint := NFB + Esize (Comp) - 1;
Pos : constant Uint := Static_Integer (Position (CC));
begin
if Warn_On_Reverse_Bit_Order then
Error_Msg_Uint_1 := MSS;
Error_Msg_N
("?reverse bit order in machine " &
"scalar of length^", First_Bit (CC));
Error_Msg_Uint_1 := NFB;
Error_Msg_Uint_2 := NLB;
if Bytes_Big_Endian then
Error_Msg_NE
("?\big-endian range for component & is ^ .. ^",
First_Bit (CC), Comp);
else
Error_Msg_NE
("?\little-endian range for component & is ^ .. ^",
First_Bit (CC), Comp);
end if;
end if;
Set_Component_Bit_Offset (Comp, Pos * SSU + NFB);
Set_Normalized_First_Bit (Comp, NFB mod SSU);
end;
end loop;
end loop;
end;
end Adjust_Record_For_Reverse_Bit_Order;
--------------------------------------
-- Alignment_Check_For_Esize_Change --
--------------------------------------
@ -355,7 +614,7 @@ package body Sem_Ch13 is
end if;
if Present (Subp) then
if Is_Abstract (Subp) then
if Is_Abstract_Subprogram (Subp) then
Error_Msg_N ("stream subprogram must not be abstract", Expr);
return;
end if;
@ -926,12 +1185,12 @@ package body Sem_Ch13 is
Etyp := Etype (U_Ent);
end if;
-- Check size, note that Gigi is in charge of checking
-- that the size of an array or record type is OK. Also
-- we do not check the size in the ordinary fixed-point
-- case, since it is too early to do so (there may be a
-- subsequent small clause that affects the size). We can
-- check the size if a small clause has already been given.
-- Check size, note that Gigi is in charge of checking that the
-- size of an array or record type is OK. Also we do not check
-- the size in the ordinary fixed-point case, since it is too
-- early to do so (there may be subsequent small clause that
-- affects the size). We can check the size if a small clause
-- has already been given.
if not Is_Ordinary_Fixed_Point_Type (U_Ent)
or else Has_Small_Clause (U_Ent)
@ -945,9 +1204,9 @@ package body Sem_Ch13 is
if Is_Type (U_Ent) then
Set_RM_Size (U_Ent, Size);
-- For scalar types, increase Object_Size to power of 2,
-- but not less than a storage unit in any case (i.e.,
-- normally this means it will be byte addressable).
-- For scalar types, increase Object_Size to power of 2, but
-- not less than a storage unit in any case (i.e., normally
-- this means it will be byte addressable).
if Is_Scalar_Type (U_Ent) then
if Size <= System_Storage_Unit then
@ -1294,6 +1553,12 @@ package body Sem_Ch13 is
then
Error_Msg_N ("Value_Size already given for &", Nam);
elsif Is_Array_Type (U_Ent)
and then not Is_Constrained (U_Ent)
then
Error_Msg_N
("Value_Size cannot be given for unconstrained array", Nam);
else
if Is_Elementary_Type (U_Ent) then
Check_Size (Expr, U_Ent, Size, Biased);
@ -1837,17 +2102,10 @@ package body Sem_Ch13 is
-- Clear any existing component clauses for the type (this happens
-- with derived types, where we are now overriding the original)
Fent := First_Entity (Rectype);
Comp := Fent;
Comp := First_Component_Or_Discriminant (Rectype);
while Present (Comp) loop
if Ekind (Comp) = E_Component
or else Ekind (Comp) = E_Discriminant
then
Set_Component_Clause (Comp, Empty);
end if;
Next_Entity (Comp);
Set_Component_Clause (Comp, Empty);
Next_Component_Or_Discriminant (Comp);
end loop;
-- All done if no component clauses
@ -1862,6 +2120,8 @@ package body Sem_Ch13 is
-- it at the start of the record (otherwise gigi may place it after
-- other fields that have rep clauses).
Fent := First_Entity (Rectype);
if Nkind (Fent) = N_Defining_Identifier
and then Chars (Fent) = Name_uTag
then
@ -2284,15 +2544,10 @@ package body Sem_Ch13 is
then
-- Nothing to do if at least one component with no component clause
Comp := First_Entity (Rectype);
Comp := First_Component_Or_Discriminant (Rectype);
while Present (Comp) loop
if Ekind (Comp) = E_Component
or else Ekind (Comp) = E_Discriminant
then
exit when No (Component_Clause (Comp));
end if;
Next_Entity (Comp);
exit when No (Component_Clause (Comp));
Next_Component_Or_Discriminant (Comp);
end loop;
-- If we fall out of loop, all components have component clauses
@ -2306,19 +2561,14 @@ package body Sem_Ch13 is
-- Check missing components if Complete_Representation pragma appeared
if Present (CR_Pragma) then
Comp := First_Entity (Rectype);
Comp := First_Component_Or_Discriminant (Rectype);
while Present (Comp) loop
if Ekind (Comp) = E_Component
or else
Ekind (Comp) = E_Discriminant
then
if No (Component_Clause (Comp)) then
Error_Msg_NE
("missing component clause for &", CR_Pragma, Comp);
end if;
if No (Component_Clause (Comp)) then
Error_Msg_NE
("missing component clause for &", CR_Pragma, Comp);
end if;
Next_Entity (Comp);
Next_Component_Or_Discriminant (Comp);
end loop;
end if;
end Analyze_Record_Representation_Clause;

9
gcc/ada/sem_ch13.ads
View File

@ -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

10
gcc/ada/style.ads
View File

@ -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

25
gcc/ada/styleg-c.adb
View File

@ -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 --
----------------------

11
gcc/ada/styleg-c.ads
View File

@ -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);

99
gcc/ada/stylesw.adb
View File

@ -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;

6
gcc/ada/stylesw.ads
View File

@ -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

13
gcc/ada/usage.adb
View File

@ -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