procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

sem_ch3.adb: Move Has_Defaulted_Discriminants to sem_util.

Browse source 
2014-07-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb: Move Has_Defaulted_Discriminants to sem_util.
	* sem_ch4.adb (Analyze_Allocator): Defer resolution of expression
	until context type is available.
	* sem_res.adb (Resolve_Allocator): In the case of a qualified
	expression, complete resolution of expression.
	(Check_Aliased_Parameter): New procedure within Resolve_Actuals,
	to apply Ada2012 checks on aliased formals, as well as
	accesibility checks when the context of the call is an allocator
	or a qualified expression.
	* sem_util.ads, sem_util.adb (Has_Defaulted_Discriminants):
	Moved here from sem_ch3.
	(Object_Access_Level): Handle properly aliased formals and
	aggregates.
	* exp_ch6.adb (Expand_Call): Remove check on aliased parameters,
	now properly performed in sem_res (Resolve_Actuals,
	Check_Aliased_Parameter).

From-SVN: r213206
This commit is contained in:
Ed Schonberg 2014-07-29 14:56:34 +00:00 • committed by Arnaud Charlet
parent 2d180af122
commit f3691f465e
7 changed files with 122 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
gcc/ada/ChangeLog
View file

@ -1,3 +1,22 @@
2014-07-29 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb: Move Has_Defaulted_Discriminants to sem_util.
* sem_ch4.adb (Analyze_Allocator): Defer resolution of expression
until context type is available.
* sem_res.adb (Resolve_Allocator): In the case of a qualified
expression, complete resolution of expression.
(Check_Aliased_Parameter): New procedure within Resolve_Actuals,
to apply Ada2012 checks on aliased formals, as well as
accesibility checks when the context of the call is an allocator
or a qualified expression.
* sem_util.ads, sem_util.adb (Has_Defaulted_Discriminants):
Moved here from sem_ch3.
(Object_Access_Level): Handle properly aliased formals and
aggregates.
* exp_ch6.adb (Expand_Call): Remove check on aliased parameters,
now properly performed in sem_res (Resolve_Actuals,
Check_Aliased_Parameter).
2014-07-29 Yannick Moy <moy@adacore.com>
* debug.adb Enable GNATprove inlining under debug flag -gnatdQ for now.

12
gcc/ada/exp_ch6.adb
View file

@ -3138,18 +3138,6 @@ package body Exp_Ch6 is
end if;
end if;
-- For Ada 2012, if a parameter is aliased, the actual must be a
-- tagged type or an aliased view of an object.
if Is_Aliased (Formal)
and then not Is_Aliased_View (Actual)
and then not Is_Tagged_Type (Etype (Formal))
then
Error_Msg_NE
("actual for aliased formal& must be aliased object",
Actual, Formal);
end if;
-- For IN OUT and OUT parameters, ensure that subscripts are valid
-- since this is a left side reference. We only do this for calls
-- from the source program since we assume that compiler generated

18
gcc/ada/sem_ch3.adb
View file

@ -11252,24 +11252,6 @@ package body Sem_Ch3 is
Desig_Subtype : Entity_Id := Create_Itype (E_Void, Related_Nod);
Constraint_OK : Boolean := True;
function Has_Defaulted_Discriminants (Typ : Entity_Id) return Boolean;
-- Simple predicate to test for defaulted discriminants
-- Shouldn't this be in sem_util???
---------------------------------
-- Has_Defaulted_Discriminants --
---------------------------------
function Has_Defaulted_Discriminants (Typ : Entity_Id) return Boolean is
begin
return Has_Discriminants (Typ)
and then Present (First_Discriminant (Typ))
and then Present
(Discriminant_Default_Value (First_Discriminant (Typ)));
end Has_Defaulted_Discriminants;
-- Start of processing for Constrain_Access
begin
if Is_Array_Type (Desig_Type) then
Constrain_Array (Desig_Subtype, S, Related_Nod, Def_Id, 'P');

7
gcc/ada/sem_ch4.adb
View file

@ -501,8 +501,6 @@ package body Sem_Ch4 is
Type_Id := Etype (E);
Set_Directly_Designated_Type (Acc_Type, Type_Id);
Resolve (Expression (E), Type_Id);
-- Allocators generated by the build-in-place expansion mechanism
-- are explicitly marked as coming from source but do not need to be
-- checked for limited initialization. To exclude this case, ensure
@ -529,10 +527,9 @@ package body Sem_Ch4 is
-- Wrong_Type (Expression (E), Type_Id);
-- end if;
Check_Non_Static_Context (Expression (E));
-- We don't analyze the qualified expression itself because it's
-- part of the allocator
-- part of the allocator. It is fully analyzed and resolved when
-- the allocator is resolved with the context type.
Set_Etype (E, Type_Id);

71
gcc/ada/sem_res.adb
View file

@ -2976,6 +2976,10 @@ package body Sem_Res is
Prev : Node_Id := Empty;
Orig_A : Node_Id;
procedure Check_Aliased_Parameter;
-- Check rules on aliased parameters and related accessibility rules
-- in (3.10.2 (10.2-10.4)).
procedure Check_Argument_Order;
-- Performs a check for the case where the actuals are all simple
-- identifiers that correspond to the formal names, but in the wrong
@ -3012,6 +3016,70 @@ package body Sem_Res is
-- This must be determined before the actual is resolved and expanded
-- because if needed the transient scope must be introduced earlier.
------------------------------
-- Check_Aliased_Parameter --
------------------------------
procedure Check_Aliased_Parameter is
Nominal_Subt : Entity_Id;
begin
if Is_Aliased (F) then
if Is_Tagged_Type (A_Typ) then
null;
elsif Is_Aliased_View (A) then
if Is_Constr_Subt_For_U_Nominal (A_Typ) then
Nominal_Subt := Base_Type (A_Typ);
else
Nominal_Subt := A_Typ;
end if;
if Subtypes_Statically_Match (F_Typ, Nominal_Subt) then
null;
-- In a generic body assume the worst for generic formals:
-- they can have a constrained partial view (AI05-041).
elsif Has_Discriminants (F_Typ)
and then not Is_Constrained (F_Typ)
and then not Has_Constrained_Partial_View (F_Typ)
and then not Is_Generic_Type (F_Typ)
then
null;
else
Error_Msg_NE ("untagged actual does not match "
& "aliased formal&", A, F);
end if;
else
Error_Msg_NE ("actual for aliased formal& must be "
& "aliased object", A, F);
end if;
if Ekind (Nam) = E_Procedure then
null;
elsif Ekind (Etype (Nam)) = E_Anonymous_Access_Type then
if Nkind (Parent (N)) = N_Type_Conversion
and then Type_Access_Level (Etype (Parent (N)))
< Object_Access_Level (A)
then
Error_Msg_N ("aliased actual has wrong accessibility", A);
end if;
elsif Nkind (Parent (N)) = N_Qualified_Expression
and then Nkind (Parent (Parent (N))) = N_Allocator
and then Type_Access_Level (Etype (Parent (Parent (N))))
< Object_Access_Level (A)
then
Error_Msg_N
("Aliased actual in allocator has wrong accessibility", A);
end if;
end if;
end Check_Aliased_Parameter;
--------------------------
-- Check_Argument_Order --
--------------------------
@ -4213,6 +4281,8 @@ package body Sem_Res is
end if;
end if;
Check_Aliased_Parameter;
Eval_Actual (A);
-- If it is a named association, treat the selector_name as a
@ -4426,6 +4496,7 @@ package body Sem_Res is
end if;
Resolve (Expression (E), Etype (E));
Check_Non_Static_Context (Expression (E));
Check_Unset_Reference (Expression (E));
-- A qualified expression requires an exact match of the type.

28
gcc/ada/sem_util.adb
View file

@ -7337,6 +7337,18 @@ package body Sem_Util is
N_Package_Specification);
end Has_Declarations;
---------------------------------
-- Has_Defaulted_Discriminants --
---------------------------------
function Has_Defaulted_Discriminants (Typ : Entity_Id) return Boolean is
begin
return Has_Discriminants (Typ)
and then Present (First_Discriminant (Typ))
and then Present
(Discriminant_Default_Value (First_Discriminant (Typ)));
end Has_Defaulted_Discriminants;
-------------------
-- Has_Denormals --
-------------------
@ -14414,7 +14426,15 @@ package body Sem_Util is
return Type_Access_Level (Scope (E)) + 1;
else
return Scope_Depth (Enclosing_Dynamic_Scope (E));
-- Aliased formals take their access level from the point of call.
-- This is smaller than the level of the subprogram itself.
if Is_Formal (E) and then Is_Aliased (E) then
return Type_Access_Level (Etype (E));
else
return Scope_Depth (Enclosing_Dynamic_Scope (E));
end if;
end if;
elsif Nkind (Obj) = N_Selected_Component then
@ -14586,6 +14606,12 @@ package body Sem_Util is
elsif Nkind (Obj) = N_Qualified_Expression then
return Object_Access_Level (Expression (Obj));
-- Ditto for aggregates. They have the level of the temporary that
-- will hold their value.
elsif Nkind (Obj) = N_Aggregate then
return Object_Access_Level (Current_Scope);
-- Otherwise return the scope level of Standard. (If there are cases
-- that fall through to this point they will be treated as having
-- global accessibility for now. ???)

3
gcc/ada/sem_util.ads
View file

@ -884,6 +884,9 @@ package Sem_Util is
-- as an access type internally, this function tests only for access types
-- known to the programmer. See also Has_Tagged_Component.
function Has_Defaulted_Discriminants (Typ : Entity_Id) return Boolean;
-- Simple predicate to test for defaulted discriminants
type Alignment_Result is (Known_Compatible, Unknown, Known_Incompatible);
-- Result of Has_Compatible_Alignment test, description found below. Note
-- that the values are arranged in increasing order of problematicness.