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> 2016-04-20 Bob Duff <duff@adacore.com>
* sem_ch6.adb (Enter_Overloaded_Entity): Do not warn about * sem_ch6.adb (Enter_Overloaded_Entity): Do not warn about
......
...@@ -448,6 +448,15 @@ package body Exp_Unst is ...@@ -448,6 +448,15 @@ package body Exp_Unst is
end loop; end loop;
end; 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 -- For now, ignore other types
else else
......
...@@ -924,8 +924,8 @@ package body Exp_Util is ...@@ -924,8 +924,8 @@ package body Exp_Util is
-------------------------- --------------------------
procedure Build_Procedure_Form (N : Node_Id) is procedure Build_Procedure_Form (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Subp : constant Entity_Id := Defining_Entity (N); Subp : constant Entity_Id := Defining_Entity (N);
Func_Formal : Entity_Id; Func_Formal : Entity_Id;
Proc_Formals : List_Id; Proc_Formals : List_Id;
...@@ -941,7 +941,6 @@ package body Exp_Util is ...@@ -941,7 +941,6 @@ package body Exp_Util is
Append_To (Proc_Formals, Append_To (Proc_Formals,
Make_Parameter_Specification (Loc, Make_Parameter_Specification (Loc,
Defining_Identifier => Defining_Identifier =>
Make_Defining_Identifier (Loc, Chars (Func_Formal)), Make_Defining_Identifier (Loc, Chars (Func_Formal)),
Parameter_Type => Parameter_Type =>
New_Occurrence_Of (Etype (Func_Formal), Loc))); New_Occurrence_Of (Etype (Func_Formal), Loc)));
......
...@@ -7902,7 +7902,6 @@ package body Freeze is ...@@ -7902,7 +7902,6 @@ package body Freeze is
then then
Build_Procedure_Form (Unit_Declaration_Node (E)); Build_Procedure_Form (Unit_Declaration_Node (E));
end if; end if;
end Freeze_Subprogram; end Freeze_Subprogram;
---------------------- ----------------------
......
...@@ -1408,10 +1408,41 @@ package body Sem_Attr is ...@@ -1408,10 +1408,41 @@ package body Sem_Attr is
-------------------------------- --------------------------------
procedure Check_Array_Or_Scalar_Type 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; Index : Entity_Id;
D : Int; -- Start of processing for Check_Array_Or_Scalar_Type
-- Dimension number for array attributes
begin begin
-- Case of string literal or string literal subtype. These cases -- Case of string literal or string literal subtype. These cases
...@@ -1431,6 +1462,12 @@ package body Sem_Attr is ...@@ -1431,6 +1462,12 @@ package body Sem_Attr is
if Present (E1) then if Present (E1) then
Error_Attr ("invalid argument in % attribute", E1); 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 else
Set_Etype (N, P_Base_Type); Set_Etype (N, P_Base_Type);
return; return;
...@@ -1466,9 +1503,9 @@ package body Sem_Attr is ...@@ -1466,9 +1503,9 @@ package body Sem_Attr is
Set_Etype (N, Base_Type (Etype (Index))); Set_Etype (N, Base_Type (Etype (Index)));
else 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); Next_Index (Index);
end loop; end loop;
......
...@@ -14360,8 +14360,9 @@ package body Sem_Util is ...@@ -14360,8 +14360,9 @@ package body Sem_Util is
and then Is_Predefined_File_Name and then Is_Predefined_File_Name
(Unit_File_Name (Get_Source_Unit (Par))); (Unit_File_Name (Get_Source_Unit (Par)));
else else
return Present (Alias (Id)) return
and then Is_Unchecked_Conversion_Instance (Alias (Id)); Present (Alias (Id))
and then Is_Unchecked_Conversion_Instance (Alias (Id));
end if; end if;
end if; end if;
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