Commit 9a1bc6d5 by Arnaud Charlet

[multiple changes]

2010-09-10  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.adb (Check_Record_Representation_Clause): Implement record
	gap warnings.
	* sem_warn.ads, sem_warn.adb (Warn_On_Record_Holes): New warning flag.
	* usage.adb: Add lines for -gnatw.h/H
	* gnat_ugn.texi: Add documentation for J519-010
	Warn on record holes/gaps
	* ug_words: Add entries for -gnatw.h/-gnatw.H
	* vms_data.ads: Add entries for [NO]AVOIDGAPS

2010-09-10  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch6.adb: Update comment.

From-SVN: r164186
parent f4b049db
2010-09-10 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb (Check_Record_Representation_Clause): Implement record
gap warnings.
* sem_warn.ads, sem_warn.adb (Warn_On_Record_Holes): New warning flag.
* usage.adb: Add lines for -gnatw.h/H
* gnat_ugn.texi: Add documentation for J519-010
Warn on record holes/gaps
* ug_words: Add entries for -gnatw.h/-gnatw.H
* vms_data.ads: Add entries for [NO]AVOIDGAPS
2010-09-10 Gary Dismukes <dismukes@adacore.com>
* sem_ch6.adb: Update comment.
2010-09-10 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Build_Derived_Private_Type): Mark generated declaration
......
......@@ -5056,6 +5056,7 @@ individually controlled. The warnings that are not turned on by this
switch are
@option{-gnatwd} (implicit dereferencing),
@option{-gnatwh} (hiding),
@option{-gnatw.h} (holes (gaps) in record layouts)
@option{-gnatwl} (elaboration warnings),
@option{-gnatw.o} (warn on values set by out parameters ignored)
and @option{-gnatwt} (tracking of deleted conditional code).
......@@ -5258,6 +5259,22 @@ Note that @option{-gnatwa} does not affect the setting of this warning option.
@cindex @option{-gnatwH} (@command{gcc})
This switch suppresses warnings on hiding declarations.
@item -gnatw.h
@emph{Activate warnings on holes/gaps in records.}
@cindex @option{-gnatw.h} (@command{gcc})
@cindex Record Representation (gaps)
This switch activates warnings on component clauses in record
representation clauses that leave holes (gaps) in the record layout.
If this warning option is active, then record representation clauses
should specify a contiguous layout, adding unused fill fields if needed.
Note that @option{-gnatwa} does not affect the setting of this warning option.
@item -gnatw.H
@emph{Suppress warnings on holes/gaps in records.}
@cindex @option{-gnatw.H} (@command{gcc})
This switch suppresses warnings on component clauses in record
representation clauses that leave holes (haps) in the record layout.
@item -gnatwi
@emph{Activate warnings on implementation units.}
@cindex @option{-gnatwi} (@command{gcc})
......
......@@ -1535,9 +1535,11 @@ package body Sem_Ch13 is
elsif Size /= No_Uint then
if VM_Target /= No_VM and then not GNAT_Mode then
-- Size clause is not handled properly on VM targets.
-- Display a warning unless we are in GNAT mode, in which
-- case this is useless.
Error_Msg_N
("?size clauses are ignored in this configuration", N);
end if;
......@@ -3255,6 +3257,9 @@ package body Sem_Ch13 is
Overlap_Check_Required : Boolean;
-- Used to keep track of whether or not an overlap check is required
Overlap_Detected : Boolean := False;
-- Set True if an overlap is detected
Ccount : Natural := 0;
-- Number of component clauses in record rep clause
......@@ -3278,6 +3283,7 @@ package body Sem_Ch13 is
procedure Check_Component_Overlap (C1_Ent, C2_Ent : Entity_Id) is
CC1 : constant Node_Id := Component_Clause (C1_Ent);
CC2 : constant Node_Id := Component_Clause (C2_Ent);
begin
if Present (CC1) and then Present (CC2) then
......@@ -3309,6 +3315,7 @@ package body Sem_Ch13 is
Error_Msg_Node_1 := Component_Name (CC1);
Error_Msg_N
("component& overlaps & #", Component_Name (CC1));
Overlap_Detected := True;
end if;
end;
end if;
......@@ -3481,12 +3488,14 @@ package body Sem_Ch13 is
if Present (Comp) then
Ccount := Ccount + 1;
-- We need a full overlap check if record positions non-monotonic
if Fbit <= Max_Bit_So_Far then
Overlap_Check_Required := True;
else
Max_Bit_So_Far := Lbit;
end if;
Max_Bit_So_Far := Lbit;
-- Check bit position out of range of specified size
if Has_Size_Clause (Rectype)
......@@ -3505,6 +3514,7 @@ package body Sem_Ch13 is
Error_Msg_NE
("component overlaps tag field of&",
Component_Name (CC), Rectype);
Overlap_Detected := True;
end if;
if Hbit < Lbit then
......@@ -3654,8 +3664,8 @@ package body Sem_Ch13 is
-- Skip overlap check if entity has no declaration node. This
-- happens with discriminants in constrained derived types.
-- Probably we are missing some checks as a result, but that
-- does not seem terribly serious ???
-- Possibly we are missing some checks as a result, but that
-- does not seem terribly serious.
if No (Declaration_Node (C1_Ent)) then
goto Continue_Main_Component_Loop;
......@@ -3699,7 +3709,6 @@ package body Sem_Ch13 is
else
Citem := First (Component_Items (Clist));
while Present (Citem) loop
if Nkind (Citem) = N_Component_Declaration then
C2_Ent := Defining_Identifier (Citem);
......@@ -3745,6 +3754,183 @@ package body Sem_Ch13 is
end Overlap_Check2;
end if;
-- The following circuit deals with warning on record holes (gaps). We
-- skip this check if overlap was detected, since it makes sense for the
-- programmer to fix this illegality before worrying about warnings.
if not Overlap_Detected and Warn_On_Record_Holes then
Record_Hole_Check : declare
Decl : constant Node_Id := Declaration_Node (Base_Type (Rectype));
-- Full declaration of record type
procedure Check_Component_List
(CL : Node_Id;
Sbit : Uint;
DS : List_Id);
-- Check component list CL for holes. The starting bit should be
-- Sbit. which is zero for the main record component list and set
-- appropriately for recursive calls for variants. DS is set to
-- a list of discriminant specifications to be included in the
-- consideration of components. It is No_List if none to consider.
--------------------------
-- Check_Component_List --
--------------------------
procedure Check_Component_List
(CL : Node_Id;
Sbit : Uint;
DS : List_Id)
is
Compl : Integer;
begin
Compl := Integer (List_Length (Component_Items (CL)));
if DS /= No_List then
Compl := Compl + Integer (List_Length (DS));
end if;
declare
Comps : array (Natural range 0 .. Compl) of Entity_Id;
-- Gather components (zero entry is for sort routine)
Ncomps : Natural := 0;
-- Number of entries stored in Comps (starting at Comps (1))
Citem : Node_Id;
-- One component item or discriminant specification
Nbit : Uint;
-- Starting bit for next component
CEnt : Entity_Id;
-- Component entity
Variant : Node_Id;
-- One variant
function Lt (Op1, Op2 : Natural) return Boolean;
-- Compare routine for Sort
procedure Move (From : Natural; To : Natural);
-- Move routine for Sort
package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
--------
-- Lt --
--------
function Lt (Op1, Op2 : Natural) return Boolean is
begin
return Component_Bit_Offset (Comps (Op1))
<
Component_Bit_Offset (Comps (Op2));
end Lt;
----------
-- Move --
----------
procedure Move (From : Natural; To : Natural) is
begin
Comps (To) := Comps (From);
end Move;
begin
-- Gather discriminants into Comp
if DS /= No_List then
Citem := First (DS);
while Present (Citem) loop
if Nkind (Citem) = N_Discriminant_Specification then
declare
Ent : constant Entity_Id :=
Defining_Identifier (Citem);
begin
if Ekind (Ent) = E_Discriminant then
Ncomps := Ncomps + 1;
Comps (Ncomps) := Ent;
end if;
end;
end if;
Next (Citem);
end loop;
end if;
-- Gather component entities into Comp
Citem := First (Component_Items (CL));
while Present (Citem) loop
if Nkind (Citem) = N_Component_Declaration then
Ncomps := Ncomps + 1;
Comps (Ncomps) := Defining_Identifier (Citem);
end if;
Next (Citem);
end loop;
-- Now sort the component entities based on the first bit.
-- Note we already know there are no overlapping components.
Sorting.Sort (Ncomps);
-- Loop through entries checking for holes
Nbit := Sbit;
for J in 1 .. Ncomps loop
CEnt := Comps (J);
Error_Msg_Uint_1 := Component_Bit_Offset (CEnt) - Nbit;
if Error_Msg_Uint_1 > 0 then
Error_Msg_NE
("?^-bit gap before component&",
Component_Name (Component_Clause (CEnt)), CEnt);
end if;
Nbit := Component_Bit_Offset (CEnt) + Esize (CEnt);
end loop;
-- Process variant parts recursively if present
if Present (Variant_Part (CL)) then
Variant := First (Variants (Variant_Part (CL)));
while Present (Variant) loop
Check_Component_List
(Component_List (Variant), Nbit, No_List);
Next (Variant);
end loop;
end if;
end;
end Check_Component_List;
-- Start of processing for Record_Hole_Check
begin
declare
Sbit : Uint;
begin
if Is_Tagged_Type (Rectype) then
Sbit := UI_From_Int (System_Address_Size);
else
Sbit := Uint_0;
end if;
if Nkind (Decl) = N_Full_Type_Declaration
and then Nkind (Type_Definition (Decl)) = N_Record_Definition
then
Check_Component_List
(Component_List (Type_Definition (Decl)),
Sbit,
Discriminant_Specifications (Decl));
end if;
end;
end Record_Hole_Check;
end if;
-- For records that have component clauses for all components, and whose
-- size is less than or equal to 32, we need to know the size in the
-- front end to activate possible packed array processing where the
......
......@@ -5632,15 +5632,16 @@ package body Sem_Ch6 is
begin
-- In the case of functions with unconstrained result subtypes,
-- add a 3-state formal indicating whether the return object is
-- allocated by the caller (0), or should be allocated by the
-- callee on the secondary stack (1) or in the global heap (2).
-- For the moment we just use Natural for the type of this formal.
-- Note that this formal isn't usually needed in the case where
-- the result subtype is constrained, but it is needed when the
-- function has a tagged result, because generally such functions
-- can be called in a dispatching context and such calls must be
-- handled like calls to a class-wide function.
-- add a 4-state formal indicating whether the return object is
-- allocated by the caller (1), or should be allocated by the
-- callee on the secondary stack (2), in the global heap (3), or
-- in a user-defined storage pool (4). For the moment we just use
-- Natural for the type of this formal. Note that this formal
-- isn't usually needed in the case where the result subtype is
-- constrained, but it is needed when the function has a tagged
-- result, because generally such functions can be called in a
-- dispatching context and such calls must be handled like calls
-- to a class-wide function.
if not Is_Constrained (Underlying_Type (Result_Subt))
or else Is_Tagged_Type (Underlying_Type (Result_Subt))
......
......@@ -3087,6 +3087,7 @@ package body Sem_Warn is
Warn_On_Overlap := True;
Warn_On_Parameter_Order := True;
Warn_On_Questionable_Missing_Parens := True;
Warn_On_Record_Holes := True;
Warn_On_Redundant_Constructs := True;
Warn_On_Reverse_Bit_Order := True;
Warn_On_Unchecked_Conversion := True;
......@@ -3098,6 +3099,12 @@ package body Sem_Warn is
when 'g' =>
Set_GNAT_Mode_Warnings;
when 'h' =>
Warn_On_Record_Holes := True;
when 'H' =>
Warn_On_Record_Holes := False;
when 'i' =>
Warn_On_Overlap := True;
......@@ -3262,6 +3269,7 @@ package body Sem_Warn is
Warn_On_Obsolescent_Feature := False;
Warn_On_Overlap := False;
Warn_On_Parameter_Order := False;
Warn_On_Record_Holes := False;
Warn_On_Questionable_Missing_Parens := False;
Warn_On_Redundant_Constructs := False;
Warn_On_Reverse_Bit_Order := False;
......
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1999-2010, 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- --
......@@ -33,6 +33,20 @@ with Types; use Types;
package Sem_Warn is
-------------------
-- Warning Flags --
-------------------
-- These flags are activated or deactivated by -gnatw switches and control
-- whether warnings of a given class will be generated or not.
-- Note: most of these flags are still in opt, but the plan is to move them
-- here as time goes by.
Warn_On_Record_Holes : Boolean := False;
-- Warn when explicit record component clauses leave uncovered holes (gaps)
-- in a record layout. Off by default, set by -gnatw.h (but not -gnatwa).
------------------------
-- Warnings Off Table --
------------------------
......
......@@ -138,6 +138,8 @@ gcc -c ^ GNAT COMPILE
-gnatwG ^ /WARNINGS=NOUNRECOGNIZED_PRAGMAS
-gnatwh ^ /WARNINGS=HIDING
-gnatwH ^ /WARNINGS=NOHIDING
-gnatw.h ^ /WARNINGS=AVOIDGAPS
-gnatw.H ^ /WARNINGS=NOAVOIDGAPS
-gnatwi ^ /WARNINGS=IMPLEMENTATION
-gnatwI ^ /WARNINGS=NOIMPLEMENTATION
-gnatwj ^ /WARNINGS=OBSOLESCENT
......
......@@ -422,6 +422,8 @@ begin
Write_Line (" G turn off warnings for unrecognized pragma");
Write_Line (" h turn on warnings for hiding variable");
Write_Line (" H* turn off warnings for hiding variable");
Write_Line (" .h turn on warnings for holes in records");
Write_Line (" .H* turn off warnings for holes in records");
Write_Line (" i*+ turn on warnings for implementation unit");
Write_Line (" I turn off warnings for implementation unit");
Write_Line (" .i turn on warnings for overlapping actuals");
......
......@@ -2951,6 +2951,10 @@ package VMS_Data is
"-gnatwh " &
"NOHIDING " &
"-gnatwH " &
"AVOIDGAPS " &
"-gnatw.h " &
"NOAVOIDGAPS " &
"-gnatw.H " &
"IMPLEMENTATION " &
"-gnatwi " &
"NOIMPLEMENTATION " &
......
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