[multiple changes]

2016-04-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb, freeze.adb, sem_util.adb: Minor reformatting.

2016-04-20  Ed Schonberg  <schonberg@adacore.com>

	* exp_unst.adb (Check_Static_Type): For a private type, check
	full view.

2016-04-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Check_Type): Reject an attribute reference in
	an aspect expression, when the prefix of the reference is the
	current instance of the type to which the aspect applies.

From-SVN: r235267
This commit is contained in:
Arnaud Charlet 2016-04-20 12:51:01 +02:00
parent 51b42ffa5e
commit 268aeaa902
6 changed files with 70 additions and 10 deletions

View file

@ -1,3 +1,18 @@
2016-04-20 Hristian Kirtchev <kirtchev@adacore.com>
* exp_util.adb, freeze.adb, sem_util.adb: Minor reformatting.
2016-04-20 Ed Schonberg <schonberg@adacore.com>
* exp_unst.adb (Check_Static_Type): For a private type, check
full view.
2016-04-20 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb (Check_Type): Reject an attribute reference in
an aspect expression, when the prefix of the reference is the
current instance of the type to which the aspect applies.
2016-04-20 Bob Duff <duff@adacore.com>
* sem_ch6.adb (Enter_Overloaded_Entity): Do not warn about

View file

@ -448,6 +448,15 @@ package body Exp_Unst is
end loop;
end;
-- For private type, examine whether full view is static
elsif Is_Private_Type (T) and then Present (Full_View (T)) then
Check_Static_Type (Full_View (T), DT);
if Is_Static_Type (Full_View (T)) then
Set_Is_Static_Type (T);
end if;
-- For now, ignore other types
else

View file

@ -924,8 +924,8 @@ package body Exp_Util is
--------------------------
procedure Build_Procedure_Form (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Subp : constant Entity_Id := Defining_Entity (N);
Loc : constant Source_Ptr := Sloc (N);
Subp : constant Entity_Id := Defining_Entity (N);
Func_Formal : Entity_Id;
Proc_Formals : List_Id;
@ -941,7 +941,6 @@ package body Exp_Util is
Append_To (Proc_Formals,
Make_Parameter_Specification (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Chars (Func_Formal)),
Parameter_Type =>
New_Occurrence_Of (Etype (Func_Formal), Loc)));

View file

@ -7902,7 +7902,6 @@ package body Freeze is
then
Build_Procedure_Form (Unit_Declaration_Node (E));
end if;
end Freeze_Subprogram;
----------------------

View file

@ -1408,10 +1408,41 @@ package body Sem_Attr is
--------------------------------
procedure Check_Array_Or_Scalar_Type is
function In_Aspect_Specification return Boolean;
-- A current instance of a type in an aspect specification is an
-- object and not a type, and therefore cannot be of a scalar type
-- in the prefix of one of the array attributes if the attribute
-- reference is part of an aspect expression.
-----------------------------
-- In_Aspect_Specification --
-----------------------------
function In_Aspect_Specification return Boolean is
P : Node_Id;
begin
P := Parent (N);
while Present (P) loop
if Nkind (P) = N_Aspect_Specification then
return P_Type = Entity (P);
elsif Nkind (P) in N_Declaration then
return False;
end if;
P := Parent (P);
end loop;
return False;
end In_Aspect_Specification;
-- Local variables
Dims : Int;
Index : Entity_Id;
D : Int;
-- Dimension number for array attributes
-- Start of processing for Check_Array_Or_Scalar_Type
begin
-- Case of string literal or string literal subtype. These cases
@ -1431,6 +1462,12 @@ package body Sem_Attr is
if Present (E1) then
Error_Attr ("invalid argument in % attribute", E1);
elsif In_Aspect_Specification then
Error_Attr
("prefix of % attribute cannot be the current instance of a "
& "scalar type", P);
else
Set_Etype (N, P_Base_Type);
return;
@ -1466,9 +1503,9 @@ package body Sem_Attr is
Set_Etype (N, Base_Type (Etype (Index)));
else
D := UI_To_Int (Intval (E1));
Dims := UI_To_Int (Intval (E1));
for J in 1 .. D - 1 loop
for J in 1 .. Dims - 1 loop
Next_Index (Index);
end loop;

View file

@ -14360,8 +14360,9 @@ package body Sem_Util is
and then Is_Predefined_File_Name
(Unit_File_Name (Get_Source_Unit (Par)));
else
return Present (Alias (Id))
and then Is_Unchecked_Conversion_Instance (Alias (Id));
return
Present (Alias (Id))
and then Is_Unchecked_Conversion_Instance (Alias (Id));
end if;
end if;
end if;