From 9a1bc6d57f1df18a55ada1bd312699396ca8deb4 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 10 Sep 2010 16:57:08 +0200 Subject: [multiple changes] 2010-09-10 Robert Dewar * 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 * sem_ch6.adb: Update comment. From-SVN: r164186 --- gcc/ada/ChangeLog | 15 ++++ gcc/ada/gnat_ugn.texi | 17 +++++ gcc/ada/sem_ch13.adb | 196 ++++++++++++++++++++++++++++++++++++++++++++++++-- gcc/ada/sem_ch6.adb | 19 ++--- gcc/ada/sem_warn.adb | 8 +++ gcc/ada/sem_warn.ads | 16 ++++- gcc/ada/ug_words | 2 + gcc/ada/usage.adb | 2 + gcc/ada/vms_data.ads | 4 ++ 9 files changed, 264 insertions(+), 15 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d093901..454478f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2010-09-10 Robert Dewar + + * 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 + + * sem_ch6.adb: Update comment. + 2010-09-10 Ed Schonberg * sem_ch3.adb (Build_Derived_Private_Type): Mark generated declaration diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index e22ac66..694c598 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -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}) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 45453e65..c24a344 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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 diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 95ee36f..6ffb7d8 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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)) diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 953229c..2a42dec 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -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; diff --git a/gcc/ada/sem_warn.ads b/gcc/ada/sem_warn.ads index e74e144..259a470 100644 --- a/gcc/ada/sem_warn.ads +++ b/gcc/ada/sem_warn.ads @@ -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 -- ------------------------ diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words index 5f694b9..6090e8f 100644 --- a/gcc/ada/ug_words +++ b/gcc/ada/ug_words @@ -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 diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index c0b7ce6..7df5eb0 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -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"); diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index aab456c..06ae3db 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -2951,6 +2951,10 @@ package VMS_Data is "-gnatwh " & "NOHIDING " & "-gnatwH " & + "AVOIDGAPS " & + "-gnatw.h " & + "NOAVOIDGAPS " & + "-gnatw.H " & "IMPLEMENTATION " & "-gnatwi " & "NOIMPLEMENTATION " & -- cgit v1.1