Commit 268aeaa9 by Arnaud Charlet

[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
parent 51b42ffa
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
......
......@@ -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
......
......@@ -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)));
......
......@@ -7902,7 +7902,6 @@ package body Freeze is
then
Build_Procedure_Form (Unit_Declaration_Node (E));
end if;
end Freeze_Subprogram;
----------------------
......
......@@ -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;
......
......@@ -14360,7 +14360,8 @@ package body Sem_Util is
and then Is_Predefined_File_Name
(Unit_File_Name (Get_Source_Unit (Par)));
else
return Present (Alias (Id))
return
Present (Alias (Id))
and then Is_Unchecked_Conversion_Instance (Alias (Id));
end if;
end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment