[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:
parent
51b42ffa5e
commit
268aeaa902
6 changed files with 70 additions and 10 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)));
|
||||
|
|
|
@ -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,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;
|
||||
|
|
Loading…
Add table
Reference in a new issue