[multiple changes]

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.

From-SVN: r212656
This commit is contained in:
Arnaud Charlet 2014-07-16 16:33:11 +02:00
parent b07b7acecf
commit 3f1bc2cf46
17 changed files with 253 additions and 25 deletions

View File

@ -1,3 +1,31 @@
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

View File

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

View File

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

View File

@ -4797,6 +4797,9 @@ Out-of-range values being assigned
@item
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
@ -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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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