mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-21 15:50:50 +08:00
Code Issues Packages Projects Releases Wiki Activity

[Ada] Bad Valid_Scalars result if signed int component type signed has partial view.

Browse Source 
For an object X of a composite type, the attribute X'Valid_Scalars should
return False if and only if there exists at least one invalid scalar
subcomponent of X. The validity test for a scalar part may include a
range test. In some cases involving a private type that is implemented as
a signed integer type, this range test was incorrectly implemented using
unsigned comparisons. For an enclosing object X, this could result in
X'Valid_Scalars yielding the wrong Boolean result. Such an incorrect
result would almost always be False, although an incorrect True result is
theoretically possible (this would require that both bounds of the
component subtype are negative and that the invalid component has a positive
value).

gcc/ada/

	* exp_attr.adb
	(Make_Range_Test): In determining which subtype's First and Last
	attributes are to be queried as part of a range test, call
	Validated_View in order to get a scalar (as opposed to private)
	subtype.
	(Attribute_Valid): In determining whether to perform a signed or
	unsigned comparison for a range test, call Validated_View in order
	to get a scalar (as opposed to private) type. Also correct a typo
	which, by itself, is the source of the problem reported for this
	ticket.
This commit is contained in:
Steve Baird 2022-08-01 17:04:20 -07:00 committed by Marc Poulhiès
parent 152f968e86
commit ed7bc348b3
1 changed files with 24 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
gcc/ada/exp_attr.adb
View File

@ -7103,7 +7103,8 @@ package body Exp_Attr is
-- See separate sections below for the generated code in each case.
when Attribute_Valid => Valid : declare
PBtyp : Entity_Id := Base_Type (Ptyp);
PBtyp : Entity_Id := Base_Type (Validated_View (Ptyp));
-- The scalar base type, looking through private types
Save_Validity_Checks_On : constant Boolean := Validity_Checks_On;
-- Save the validity checking mode. We always turn off validity
@ -7150,21 +7151,27 @@ package body Exp_Attr is
Temp := Duplicate_Subexpr (Pref);
end if;
return
Make_In (Loc,
Left_Opnd => Unchecked_Convert_To (PBtyp, Temp),
Right_Opnd =>
Make_Range (Loc,
Low_Bound =>
Unchecked_Convert_To (PBtyp,
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Ptyp, Loc),
Attribute_Name => Name_First)),
High_Bound =>
Unchecked_Convert_To (PBtyp,
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Ptyp, Loc),
Attribute_Name => Name_Last))));
declare
Val_Typ : constant Entity_Id := Validated_View (Ptyp);
begin
return
Make_In (Loc,
Left_Opnd => Unchecked_Convert_To (PBtyp, Temp),
Right_Opnd =>
Make_Range (Loc,
Low_Bound =>
Unchecked_Convert_To (PBtyp,
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Val_Typ, Loc),
Attribute_Name => Name_First)),
High_Bound =>
Unchecked_Convert_To (PBtyp,
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Val_Typ, Loc),
Attribute_Name => Name_Last))));
end;
end Make_Range_Test;
-- Local variables
@ -7186,13 +7193,6 @@ package body Exp_Attr is
Validity_Checks_On := False;
-- Retrieve the base type. Handle the case where the base type is a
-- private enumeration type.
if Is_Private_Type (PBtyp) and then Present (Full_View (PBtyp)) then
PBtyp := Full_View (PBtyp);
end if;
-- Floating-point case. This case is handled by the Valid attribute
-- code in the floating-point attribute run-time library.
@ -7462,7 +7462,7 @@ package body Exp_Attr is
Uns : constant Boolean :=
Is_Unsigned_Type (Ptyp)
or else (Is_Private_Type (Ptyp)
and then Is_Unsigned_Type (Btyp));
and then Is_Unsigned_Type (PBtyp));
Size : Uint;
P : Node_Id := Pref;