From: Arnaud Charlet Date: Wed, 16 Jul 2014 14:33:11 +0000 (+0200) Subject: [multiple changes] X-Git-Tag: upstream/12.2.0~62012 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=3f1bc2cf467b4b05d02a51c74947f39099749cde;p=platform%2Fupstream%2Fgcc.git [multiple changes] 2014-07-16 Robert Dewar * sem_ch3.adb, sem_prag.adb, sem_util.adb, sem_res.adb, sem_ch13.adb: Minor code reorganization (use Is_Access_Type, not in Access_Kind). * exp_ch3.adb: Minor code reorganization, use Is_Access_Type, not in Access_Kind. * par-ch4.adb (At_Start_Of_Attribute): New function (P_Simple_Expression): Better msg for bad attribute prefix. * scans.ads: Minor reformatting. 2014-07-16 Ed Schonberg * sem_attr.adb (Resolve_Attribute, case 'Update): If choice is a static constant, check that in belongs to the corresponding index subtype, to produce the proer warning when expansion is disabled. 2014-07-16 Robert Dewar * freeze.adb (Freeze_Entity): Warn on incompatible size/alignment. * gnat_ugn.texi: Document -gnatw.z and -gnatw.Z. * ug_words: VMS synonyms (WARNINGS=[NO]SIZE_ALIGN) for -gnatw.z/-gnatw.Z * usage.adb: Add lines for -gnatw.z/-gnatw.Z. * vms_data.ads: VMS synonyms (WARNINGS=[NO]SIZE_ALIGN) for -gnatw.z/-gnatw.Z * warnsw.adb: Set Warn_On_Size_Alignment appropriately. * warnsw.ads (Warn_On_Size_Alignment): New flag Minor reformatting. From-SVN: r212656 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a710911..82a6662 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,31 @@ +2014-07-16 Robert Dewar + + * sem_ch3.adb, sem_prag.adb, sem_util.adb, sem_res.adb, sem_ch13.adb: + Minor code reorganization (use Is_Access_Type, not in Access_Kind). + * exp_ch3.adb: Minor code reorganization, use Is_Access_Type, + not in Access_Kind. + * par-ch4.adb (At_Start_Of_Attribute): New function + (P_Simple_Expression): Better msg for bad attribute prefix. + * scans.ads: Minor reformatting. + +2014-07-16 Ed Schonberg + + * sem_attr.adb (Resolve_Attribute, case 'Update): If choice is a + static constant, check that in belongs to the corresponding index + subtype, to produce the proer warning when expansion is disabled. + +2014-07-16 Robert Dewar + + * freeze.adb (Freeze_Entity): Warn on incompatible size/alignment. + * gnat_ugn.texi: Document -gnatw.z and -gnatw.Z. + * ug_words: VMS synonyms (WARNINGS=[NO]SIZE_ALIGN) for -gnatw.z/-gnatw.Z + * usage.adb: Add lines for -gnatw.z/-gnatw.Z. + * vms_data.ads: VMS synonyms (WARNINGS=[NO]SIZE_ALIGN) for + -gnatw.z/-gnatw.Z + * warnsw.adb: Set Warn_On_Size_Alignment appropriately. + * warnsw.ads (Warn_On_Size_Alignment): New flag Minor + reformatting. + 2014-07-16 Hristian Kirtchev * exp_ch7.adb (Process_Declarations): Reinstate the check on diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index a96f7f4..ad35335 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -3230,7 +3230,7 @@ package body Exp_Ch3 is begin T := Entity (Subtype_Mark (SI)); - if Ekind (T) in Access_Kind then + if Is_Access_Type (T) then T := Designated_Type (T); end if; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index ec944a1..fdb87f5 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -64,6 +64,7 @@ with Tbuild; use Tbuild; with Ttypes; use Ttypes; with Uintp; use Uintp; with Urealp; use Urealp; +with Warnsw; use Warnsw; package body Freeze is @@ -4554,6 +4555,55 @@ package body Freeze is Inherit_Aspects_At_Freeze_Point (E); end if; + -- Check for incompatible size and alignment for record type + + if Warn_On_Size_Alignment + and then Is_Record_Type (E) + and then Has_Size_Clause (E) and then Has_Alignment_Clause (E) + + -- If explicit Object_Size clause given assume that the programmer + -- knows what he is doing, and expects the compiler behavior. + + and then not Has_Object_Size_Clause (E) + + -- Check for size not a multiple of alignment + + and then RM_Size (E) mod (Alignment (E) * System_Storage_Unit) /= 0 + then + declare + SC : constant Node_Id := Size_Clause (E); + AC : constant Node_Id := Alignment_Clause (E); + Loc : Node_Id; + Abits : constant Uint := Alignment (E) * System_Storage_Unit; + + begin + if Present (SC) and then Present (AC) then + + -- Give a warning + + if Sloc (SC) > Sloc (AC) then + Loc := SC; + Error_Msg_NE + ("??size is not a multiple of alignment for &", Loc, E); + Error_Msg_Sloc := Sloc (AC); + Error_Msg_Uint_1 := Alignment (E); + Error_Msg_N ("\??alignment of ^ specified #", Loc); + + else + Loc := AC; + Error_Msg_NE + ("??size is not a multiple of alignment for &", Loc, E); + Error_Msg_Sloc := Sloc (SC); + Error_Msg_Uint_1 := RM_Size (E); + Error_Msg_N ("\??size of ^ specified #", Loc); + end if; + + Error_Msg_Uint_1 := ((RM_Size (E) / Abits) + 1) * Abits; + Error_Msg_N ("\??Object_Size will be increased to ^", Loc); + end if; + end; + end if; + -- Array type if Is_Array_Type (E) then diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 85b4471..137175d 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -4798,6 +4798,9 @@ Out-of-range values being assigned Possible order of elaboration problems @item +Size not a multiple of alignment for a record type + +@item Assertions (pragma Assert) that are sure to fail @item @@ -5869,6 +5872,28 @@ This switch suppresses warnings for unchecked conversions where the types are known at compile time to have different sizes or conventions. +@item -gnatw.z +@emph{Activate warnings for size not a multiple of alignment.} +@cindex @option{-gnatw.z} (@command{gcc}) +@cindex Size/Alignment warnings +This switch activates warnings for cases of record types with +specified @code{Size} and @code{Alignment} attributes where the +size is not a multiple of the alignment, resulting in an object +size that is greater than the specified size. The default +is that such warnings are generated. +This warning can also be turned on using @option{-gnatwa}. + +@item -gnatw.Z +@emph{Suppress warnings for size not a multiple of alignment.} +@cindex @option{-gnatw.Z} (@command{gcc}) +@cindex Size/Alignment warnings +This switch suppresses warnings for cases of record types with +specified @code{Size} and @code{Alignment} attributes where the +size is not a multiple of the alignment, resulting in an object +size that is greater than the specified size. +The warning can also be +suppressed by giving an explicit @code{Object_Size} value. + @item ^-Wunused^WARNINGS=UNUSED^ @cindex @option{-Wunused} The warnings controlled by the @option{-gnatw} switch are generated by diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 7926bd1..9d8feca 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -1969,6 +1969,42 @@ package body Ch4 is Node2 : Node_Id; Tokptr : Source_Ptr; + function At_Start_Of_Attribute return Boolean; + -- Tests if we have quote followed by attribute name, if so, return True + -- otherwise return False. + + --------------------------- + -- At_Start_Of_Attribute -- + --------------------------- + + function At_Start_Of_Attribute return Boolean is + begin + if Token /= Tok_Apostrophe then + return False; + + else + declare + Scan_State : Saved_Scan_State; + + begin + Save_Scan_State (Scan_State); + Scan; -- past quote + + if Token = Tok_Identifier + and then Is_Attribute_Name (Chars (Token_Node)) + then + Restore_Scan_State (Scan_State); + return True; + else + Restore_Scan_State (Scan_State); + return False; + end if; + end; + end if; + end At_Start_Of_Attribute; + + -- Start of processing for P_Simple_Expression + begin -- Check for cases starting with a name. There are two reasons for -- special casing. First speed things up by catching a common case @@ -2255,6 +2291,18 @@ package body Ch4 is if Prev_Token = Tok_Right_Paren and then Token = Tok_Left_Paren then T_Comma; + + -- And if we have a quote, we may have a bad attribute + + elsif At_Start_Of_Attribute then + Error_Msg_SC ("prefix of attribute must be a name"); + + if Ada_Version >= Ada_2012 then + Error_Msg_SC ("\qualify expression to turn it into a name"); + end if; + + -- Normal case for binary operator expected message + else Error_Msg_AP ("binary operator expected"); end if; diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads index ff05953..ae7f91d 100644 --- a/gcc/ada/scans.ads +++ b/gcc/ada/scans.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -404,7 +404,7 @@ package Scans is Token_Node : Node_Id := Empty; -- Node table Id for the current token. This is set only if the current -- token is one for which the scanner constructs a node (i.e. it is an - -- identifier, operator symbol, or literal. For other token types, + -- identifier, operator symbol, or literal). For other token types, -- Token_Node is undefined. Token_Name : Name_Id := No_Name; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 8c46dd8..2f685b6 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -10200,8 +10200,8 @@ package body Sem_Attr is if Is_Tagged_Type (Designated_Type (Typ)) then -- If the attribute is in the context of an access - -- parameter, then the prefix is allowed to be of the - -- class-wide type (by AI-127). + -- parameter, then the prefix is allowed to be of + -- the class-wide type (by AI-127). if Ekind (Typ) = E_Anonymous_Access_Type then if not Covers (Designated_Type (Typ), Nom_Subt) @@ -10810,6 +10810,44 @@ package body Sem_Attr is Assoc := First (Component_Associations (Aggr)); while Present (Assoc) loop Resolve (Expression (Assoc), Component_Type (Typ)); + + -- The choices in the association are static constants, + -- or static aggregates each of whose components belongs + -- to the proper index type. However, they must also + -- belong to the index subtype (s) of the prefix, which + -- may be a subtype (e.g. given by a slice). + + -- Choices may also be identifiers with no staticness + -- requirements, in which case rules are unclear??? + + declare + C : Node_Id; + C_E : Node_Id; + Indx : Node_Id; + + begin + C := First (Choices (Assoc)); + while Present (C) loop + Indx := First_Index (Etype (Prefix (N))); + + if Nkind (C) /= N_Aggregate then + Set_Etype (C, Etype (Indx)); + Check_Non_Static_Context (C); + + else + C_E := First (Expressions (C)); + while Present (C_E) loop + Set_Etype (C_E, Etype (Indx)); + Check_Non_Static_Context (C_E); + Next (C_E); + Next_Index (Indx); + end loop; + end if; + + Next (C); + end loop; + end; + Next (Assoc); end loop; @@ -10820,11 +10858,13 @@ package body Sem_Attr is Assoc := First (Component_Associations (Aggr)); while Present (Assoc) loop Comp := First (Choices (Assoc)); + if Nkind (Comp) /= N_Others_Choice and then not Error_Posted (Comp) then Resolve (Expression (Assoc), Etype (Entity (Comp))); end if; + Next (Assoc); end loop; end if; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index f3dd0585..111e9a6 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -12024,8 +12024,8 @@ package body Sem_Ch13 is -- If the alignment of both is specified, we can do it here. if Serious_Errors_Detected = 0 - and then Ekind (Source) in Access_Kind - and then Ekind (Target) in Access_Kind + and then Is_Access_Type (Source) + and then Is_Access_Type (Target) and then Target_Strict_Alignment and then Present (Designated_Type (Source)) and then Present (Designated_Type (Target)) diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 9dc8d12..3b68b7b 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -11400,7 +11400,7 @@ package body Sem_Ch3 is begin T := Entity (Subtype_Mark (SI)); - if Ekind (T) in Access_Kind then + if Is_Access_Type (T) then T := Designated_Type (T); end if; @@ -11950,7 +11950,7 @@ package body Sem_Ch3 is T_Val : Entity_Id; begin - if Ekind (T_Ent) in Access_Kind then + if Is_Access_Type (T_Ent) then T_Ent := Designated_Type (T_Ent); end if; @@ -12154,7 +12154,7 @@ package body Sem_Ch3 is T := Base_Type (Entity (Subtype_Mark (S))); - if Ekind (T) in Access_Kind then + if Is_Access_Type (T) then T := Designated_Type (T); end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 2c99be1..d200f37 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -16041,7 +16041,7 @@ package body Sem_Prag is end if; end if; - elsif Ekind (Etype (Def_Id)) in Access_Kind then + elsif Is_Access_Type (Etype (Def_Id)) then if not Ekind_In (Etype (Def_Id), E_Access_Type, E_General_Access_Type) or else diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 4ad60a9..6d69ab4 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -2453,8 +2453,8 @@ package body Sem_Res is -- the allocator. elsif Nkind (N) = N_Allocator - and then Ekind (Typ) in Access_Kind - and then Ekind (Etype (N)) in Access_Kind + and then Is_Access_Type (Typ) + and then Is_Access_Type (Etype (N)) and then Designated_Type (Etype (N)) = Typ then Wrong_Type (Expression (N), Designated_Type (Typ)); @@ -11800,11 +11800,11 @@ package body Sem_Res is elsif Is_Access_Subprogram_Type (Target_Type) - -- Note: this test of Ekind (Opnd_Type) is there to prevent entering - -- this branch in the case of a remote access to subprogram type, - -- which is internally represented as an E_Record_Type. + -- Note: this test of Opnd_Type is there to prevent entering this + -- branch in the case of a remote access to subprogram type, which + -- is internally represented as an E_Record_Type. - and then Ekind (Opnd_Type) in Access_Kind + and then Is_Access_Type (Opnd_Type) then if Ekind (Base_Type (Opnd_Type)) = E_Anonymous_Access_Subprogram_Type and then Is_Entity_Name (Operand) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 4aae4f8..f0d4b5b 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -9726,7 +9726,7 @@ package body Sem_Util is return True; end if; - if Ekind (T) not in Access_Kind then + if not Is_Access_Type (T) then -- A delegate is a managed pointer. If no designated type is defined -- it means that it's not a delegate. @@ -16437,7 +16437,7 @@ package body Sem_Util is -- the cases of access parameters, return objects of an anonymous access -- type, and, in Ada 95, access discriminants of limited types. - if Ekind (Btyp) in Access_Kind then + if Is_Access_Type (Btyp) then if Ekind (Btyp) = E_Anonymous_Access_Type then -- If the type is a nonlocal anonymous access type (such as for diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words index d8d7f45..053a543 100644 --- a/gcc/ada/ug_words +++ b/gcc/ada/ug_words @@ -226,6 +226,8 @@ gcc -c ^ GNAT COMPILE -gnatw.Y ^ /WARNINGS=NOWHY_SPEC_NEEDS_BODY -gnatwz ^ /WARNINGS=UNCHECKED_CONVERSIONS -gnatwZ ^ /WARNINGS=NOUNCHECKED_CONVERSIONS +-gnatw.z ^ /WARNINGS=SIZE_ALIGN +-gnatw.Z ^ /WARNINGS=NOSIZE_ALIGN -gnatW8 ^ /WIDE_CHARACTER_ENCODING=UTF8 -gnatW? ^ /WIDE_CHARACTER_ENCODING=? -gnaty ^ /STYLE_CHECKS diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 4516bb2..806675f 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -503,7 +503,7 @@ begin Write_Line (" F* turn off warnings for unreferenced formal"); Write_Line (" g*+ turn on warnings for unrecognized pragma"); Write_Line (" G turn off warnings for unrecognized pragma"); - Write_Line (" .g turn on GNAT warnings, same as Aao.sI.C.V.X"); + Write_Line (" .g turn on GNAT warnings"); Write_Line (" h turn on warnings for hiding declarations"); Write_Line (" H* turn off warnings for hiding declarations"); Write_Line (" .h turn on warnings for holes in records"); @@ -589,6 +589,10 @@ begin "unchecked conversion"); Write_Line (" Z turn off warnings for suspicious " & "unchecked conversion"); + Write_Line (" .z*+ turn on warnings for record size not a " & + "multiple of alignment"); + Write_Line (" .Z turn off warnings for record size not a " & + "multiple of alignment"); -- Line for -gnatW switch diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index ac07c62..927bdfb 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -3270,7 +3270,12 @@ package VMS_Data is "UNCHECKED_CONVERSIONS " & "-gnatwz " & "NOUNCHECKED_CONVERSIONS " & - "-gnatwZ"; + "-gnatwZ" & + "SIZE_ALIGNMENT " & + "-gnatw.z" & + "NOSIZE_ALIGNMENT " & + "-gnatw.Z"; + -- /NOWARNINGS -- -- Suppress the output of all warning messages from the GNAT front end. @@ -3300,6 +3305,7 @@ package VMS_Data is -- MISSING_PARENS -- OVERLAPPING_ACTUALS -- REVERSE_BIT_ORDER + -- SIZE_ALIGNMENT -- SUSPICIOUS_CONTRACT -- SUSPICIOUS_MODULUS -- UNCHECKED_CONVERSIONS @@ -3589,6 +3595,12 @@ package VMS_Data is -- effect of specifying reverse bit order for -- a record on individual components. -- + -- SIZE_ALIGNMENT Activates warnings for record types for which + -- (-gnatw.z) explicit size and alignment values are given, + -- where the size value is not a multiple of the + -- alignment value, resulting in an object size + -- larger than the specified size. + -- -- STANDARD_REDEFINITION Activate warnings on standard redefinition. -- (-gnatw.k) Generates a warning message if a declaration -- declares an identifier that matches one that diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb index 9691c10..36ae421 100644 --- a/gcc/ada/warnsw.adb +++ b/gcc/ada/warnsw.adb @@ -78,6 +78,7 @@ package body Warnsw is Warn_On_Record_Holes := Setting; Warn_On_Redundant_Constructs := Setting; Warn_On_Reverse_Bit_Order := Setting; + Warn_On_Size_Alignment := Setting; Warn_On_Standard_Redefinition := Setting; Warn_On_Suspicious_Contract := Setting; Warn_On_Suspicious_Modulus_Value := Setting; @@ -170,6 +171,8 @@ package body Warnsw is W.Warn_On_Redundant_Constructs; Warn_On_Reverse_Bit_Order := W.Warn_On_Reverse_Bit_Order; + Warn_On_Size_Alignment := + W.Warn_On_Size_Alignment; Warn_On_Standard_Redefinition := W.Warn_On_Standard_Redefinition; Warn_On_Suspicious_Contract := @@ -270,6 +273,8 @@ package body Warnsw is Warn_On_Redundant_Constructs; W.Warn_On_Reverse_Bit_Order := Warn_On_Reverse_Bit_Order; + W.Warn_On_Size_Alignment := + Warn_On_Size_Alignment; W.Warn_On_Standard_Redefinition := Warn_On_Standard_Redefinition; W.Warn_On_Suspicious_Contract := @@ -421,6 +426,12 @@ package body Warnsw is when 'Y' => List_Body_Required_Info := False; + when 'z' => + Warn_On_Size_Alignment := True; + + when 'Z' => + Warn_On_Size_Alignment := False; + when others => if Ignore_Unrecognized_VWY_Switches then Write_Line ("unrecognized switch -gnatw." & C & " ignored"); @@ -454,6 +465,7 @@ package body Warnsw is Warn_On_Non_Local_Exception := False; No_Warn_On_Non_Local_Exception := True; Warn_On_Reverse_Bit_Order := False; + Warn_On_Size_Alignment := False; Warn_On_Unrepped_Components := False; end Set_GNAT_Mode_Warnings; @@ -660,6 +672,7 @@ package body Warnsw is Warn_On_Questionable_Missing_Parens := True; Warn_On_Redundant_Constructs := True; Warn_On_Reverse_Bit_Order := True; + Warn_On_Size_Alignment := True; Warn_On_Suspicious_Contract := True; Warn_On_Unchecked_Conversion := True; Warn_On_Unrecognized_Pragma := True; diff --git a/gcc/ada/warnsw.ads b/gcc/ada/warnsw.ads index 89c5fb1..3e1d5c5 100644 --- a/gcc/ada/warnsw.ads +++ b/gcc/ada/warnsw.ads @@ -44,14 +44,19 @@ package Warnsw is Warn_On_Overridden_Size : Boolean := False; -- Warn when explicit record component clause or array component_size - -- clause specifies a size that overrides a size for the typen which was + -- clause specifies a size that overrides a size for the type which was -- set with an explicit size clause. Off by default, modified by use of - -- -gnatw.s/.S, but not set by -gnatwa. + -- -gnatw.s/.S (but not -gnatwa). + + Warn_On_Size_Alignment : Boolean := True; + -- Warn when explicit Size and Alignment clauses are given for a type, and + -- the size is not a multiple of the alignment. Off by default, modified + -- by use of -gnatw.z/.Z and set as part of -gnatwa. Warn_On_Standard_Redefinition : Boolean := False; -- Warn when a program defines an identifier that matches a name in - -- Standard. Off by default, modified by use of -gnatw.k/.K, but not - -- affected by -gnatwa. + -- Standard. Off by default, modified by use of -gnatw.k/.K (but not + -- by -gnatwa). ----------------------------------- -- Saving and Restoring Warnings -- @@ -98,6 +103,7 @@ package Warnsw is Warn_On_Record_Holes : Boolean; Warn_On_Redundant_Constructs : Boolean; Warn_On_Reverse_Bit_Order : Boolean; + Warn_On_Size_Alignment : Boolean; Warn_On_Standard_Redefinition : Boolean; Warn_On_Suspicious_Contract : Boolean; Warn_On_Suspicious_Modulus_Value : Boolean;