+2014-07-16 Robert Dewar <dewar@adacore.com>
+
+ * 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 <schonberg@adacore.com>
+
+ * 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 <dewar@adacore.com>
+
+ * 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 <kirtchev@adacore.com>
* exp_ch7.adb (Process_Declarations): Reinstate the check on
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;
with Ttypes; use Ttypes;
with Uintp; use Uintp;
with Urealp; use Urealp;
+with Warnsw; use Warnsw;
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
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
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
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
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;
-- --
-- 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- --
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;
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)
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;
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;
-- 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))
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;
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;
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;
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
-- 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));
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)
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.
-- 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
-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
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");
"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
"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.
-- MISSING_PARENS
-- OVERLAPPING_ACTUALS
-- REVERSE_BIT_ORDER
+ -- SIZE_ALIGNMENT
-- SUSPICIOUS_CONTRACT
-- SUSPICIOUS_MODULUS
-- UNCHECKED_CONVERSIONS
-- 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
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;
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 :=
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 :=
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");
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;
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;
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 --
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;
projects / platform / upstream / gcc.git / commitdiff