Skip to content

R
riscv-gcc-1
Commit 6cce2156 by Gary Dismukes Committed by Arnaud Charlet
Options

sem_ch6.adb (Check_Return_Subtype_Indication): Issue error if the return object… 

sem_ch6.adb (Check_Return_Subtype_Indication): Issue error if the return object has an anonymous access type and the...

2011-08-30  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch6.adb (Check_Return_Subtype_Indication): Issue error if the
	return object has an anonymous access type and the function's type is
	a named access type.
	* sem_ch8.adb (Analyze_Object_Renaming): Suppress error about renaming
	conversions on implicit conversions, since such conversions can occur
	for anonymous access cases due to expansion. Issue error for attempt
	to rename an anonymous expression as an object of a named access type.
	* sem_res.ads (Valid_Conversion): Add defaulted parameter Report_Errs,
	to indicate whether this function should report errors on invalid
	conversions.
	* sem_res.adb (Resolve): For Ada 2012, in the case where the type of
	the expression is of an anonymous access type and the expected type is
	a named general access type, rewrite the expression as a type
	conversion, unless this is an expression of a membership test.
	(Valid_Conversion.Error_Msg_N): New procedure that conditions the
	calling of Error_Msg_N on new formal Report_Errs.
	(Valid_Conversion.Error_Msg_NE): New procedure that conditions the
	calling of Error_Msg_NE on new formal Report_Errs.
	(Valid_Conversion): Move declaration of this function to the package
	spec, to allow calls from membership test processing. For Ada 2012,
	enforce legality restrictions on implicit conversions of anonymous
	access values to general access types, disallowing such conversions in
	cases where the expression has a dynamic accessibility level (access
	parameters, stand-alone anonymous access objects, or a component of a
	dereference of one of the first two cases).
	* sem_type.adb (Covers): For Ada 2012, allow an anonymous access type
	in the context of a named general access expected type.
	* exp_ch4.adb Add with and use of Exp_Ch2.
	(Expand_N_In): Add processing for membership tests applied to
	expressions of an anonymous access type. First, Valid_Conversion is
	called to check whether the test is statically False, and then the
	conversion is expanded to test that the expression's accessibility
	level is no deeper than that of the tested type. In the case of
	anonymous access-to-tagged types, a tagged membership test is applied
	as well.
	(Tagged_Membership): Extend to handle access type cases, applying the
	test to the designated types.
	* exp_ch6.adb (Expand_Call): When creating an extra actual for an
	accessibility level, and the actual is a 'Access applied to a current
	instance, pass the accessibility level of the type of the current
	instance rather than applying Object_Access_Level to the prefix. Add a
	??? comment, since this level isn't quite right either (will eventually
	need to pass an implicit level parameter to init procs).

From-SVN: r178296
parent e12da141
Showing with 385 additions and 22 deletions
gcc/ada/ChangeLog
2011-08-30 Gary Dismukes <dismukes@adacore.com>
* sem_ch6.adb (Check_Return_Subtype_Indication): Issue error if the
return object has an anonymous access type and the function's type is
a named access type.
* sem_ch8.adb (Analyze_Object_Renaming): Suppress error about renaming
conversions on implicit conversions, since such conversions can occur
for anonymous access cases due to expansion. Issue error for attempt
to rename an anonymous expression as an object of a named access type.
* sem_res.ads (Valid_Conversion): Add defaulted parameter Report_Errs,
to indicate whether this function should report errors on invalid
conversions.
* sem_res.adb (Resolve): For Ada 2012, in the case where the type of
the expression is of an anonymous access type and the expected type is
a named general access type, rewrite the expression as a type
conversion, unless this is an expression of a membership test.
(Valid_Conversion.Error_Msg_N): New procedure that conditions the
calling of Error_Msg_N on new formal Report_Errs.
(Valid_Conversion.Error_Msg_NE): New procedure that conditions the
calling of Error_Msg_NE on new formal Report_Errs.
(Valid_Conversion): Move declaration of this function to the package
spec, to allow calls from membership test processing. For Ada 2012,
enforce legality restrictions on implicit conversions of anonymous
access values to general access types, disallowing such conversions in
cases where the expression has a dynamic accessibility level (access
parameters, stand-alone anonymous access objects, or a component of a
dereference of one of the first two cases).
* sem_type.adb (Covers): For Ada 2012, allow an anonymous access type
in the context of a named general access expected type.
* exp_ch4.adb Add with and use of Exp_Ch2.
(Expand_N_In): Add processing for membership tests applied to
expressions of an anonymous access type. First, Valid_Conversion is
called to check whether the test is statically False, and then the
conversion is expanded to test that the expression's accessibility
level is no deeper than that of the tested type. In the case of
anonymous access-to-tagged types, a tagged membership test is applied
as well.
(Tagged_Membership): Extend to handle access type cases, applying the
test to the designated types.
* exp_ch6.adb (Expand_Call): When creating an extra actual for an
accessibility level, and the actual is a 'Access applied to a current
instance, pass the accessibility level of the type of the current
instance rather than applying Object_Access_Level to the prefix. Add a
??? comment, since this level isn't quite right either (will eventually
need to pass an implicit level parameter to init procs).
2011-08-30 Bob Duff <duff@adacore.com>
* s-taskin.ads: Minor comment fix.
......
gcc/ada/exp_ch4.adb
......@@ -31,6 +31,7 @@ with Elists; use Elists;
with Errout; use Errout;
with Exp_Aggr; use Exp_Aggr;
with Exp_Atag; use Exp_Atag;
with Exp_Ch2; use Exp_Ch2;
with Exp_Ch3; use Exp_Ch3;
with Exp_Ch6; use Exp_Ch6;
with Exp_Ch7; use Exp_Ch7;
......@@ -4955,6 +4956,121 @@ package body Exp_Ch4 is
Rewrite (N, Cond);
Analyze_And_Resolve (N, Restyp);
end if;
-- Ada 2012 (AI05-0149): Handle membership tests applied to an
-- expression of an anonymous access type. This can involve an
-- accessibility test and a tagged type membership test in the
-- case of tagged designated types.
if Ada_Version >= Ada_2012
and then Is_Acc
and then Ekind (Ltyp) = E_Anonymous_Access_Type
then
declare
Expr_Entity : Entity_Id := Empty;
New_N : Node_Id;
Param_Level : Node_Id;
Type_Level : Node_Id;
begin
if Is_Entity_Name (Lop) then
Expr_Entity := Param_Entity (Lop);
if not Present (Expr_Entity) then
Expr_Entity := Entity (Lop);
end if;
end if;
-- If a conversion of the anonymous access value to the
-- tested type would be illegal, then the result is False.
if not Valid_Conversion
(Lop, Rtyp, Lop, Report_Errs => False)
then
Rewrite (N, New_Occurrence_Of (Standard_False, Loc));
Analyze_And_Resolve (N, Restyp);
-- Apply an accessibility check if the access object has an
-- associated access level and when the level of the type is
-- less deep than the level of the access parameter. This
-- only occur for access parameters and stand-alone objects
-- of an anonymous access type.
else
if Present (Expr_Entity)
and then Present (Extra_Accessibility (Expr_Entity))
and then UI_Gt
(Object_Access_Level (Lop),
Type_Access_Level (Rtyp))
then
Param_Level :=
New_Occurrence_Of
(Extra_Accessibility (Expr_Entity), Loc);
Type_Level :=
Make_Integer_Literal (Loc, Type_Access_Level (Rtyp));
-- Return True only if the accessibility level of the
-- expression entity is not deeper than the level of
-- the tested access type.
Rewrite (N,
Make_And_Then (Loc,
Left_Opnd => Relocate_Node (N),
Right_Opnd => Make_Op_Le (Loc,
Left_Opnd => Param_Level,
Right_Opnd => Type_Level)));
Analyze_And_Resolve (N);
end if;
-- If the designated type is tagged, do tagged membership
-- operation.
-- *** NOTE: we have to check not null before doing the
-- tagged membership test (but maybe that can be done
-- inside Tagged_Membership?).
if Is_Tagged_Type (Typ) then
Rewrite (N,
Make_And_Then (Loc,
Left_Opnd => Relocate_Node (N),
Right_Opnd =>
Make_Op_Ne (Loc,
Left_Opnd => Obj,
Right_Opnd => Make_Null (Loc))));
-- No expansion will be performed when VM_Target, as
-- the VM back-ends will handle the membership tests
-- directly (tags are not explicitly represented in
-- Java objects, so the normal tagged membership
-- expansion is not what we want).
if Tagged_Type_Expansion then
-- Note that we have to pass Original_Node, because
-- the membership test might already have been
-- rewritten by earlier parts of membership test.
Tagged_Membership
(Original_Node (N), SCIL_Node, New_N);
-- Update decoration of relocated node referenced
-- by the SCIL node.
if Generate_SCIL and then Present (SCIL_Node) then
Set_SCIL_Node (New_N, SCIL_Node);
end if;
Rewrite (N,
Make_And_Then (Loc,
Left_Opnd => Relocate_Node (N),
Right_Opnd => New_N));
Analyze_And_Resolve (N, Restyp);
end if;
end if;
end if;
end;
end if;
end;
end if;
......@@ -10909,6 +11025,15 @@ package body Exp_Ch4 is
Left_Type := Available_View (Etype (Left));
Right_Type := Available_View (Etype (Right));
-- In the case where the type is an access type, the test is applied
-- using the designated types (needed in Ada 2012 for implicit anonymous
-- access conversions, for AI05-0149).
if Is_Access_Type (Right_Type) then
Left_Type := Designated_Type (Left_Type);
Right_Type := Designated_Type (Right_Type);
end if;
if Is_Class_Wide_Type (Left_Type) then
Left_Type := Root_Type (Left_Type);
end if;
......
gcc/ada/exp_ch6.adb
......@@ -2436,12 +2436,39 @@ package body Exp_Ch6 is
-- For X'Access, pass on the level of the prefix X
when Attribute_Access =>
Add_Extra_Actual
(Make_Integer_Literal (Loc,
Intval =>
Object_Access_Level
(Prefix (Prev_Orig))),
Extra_Accessibility (Formal));
-- If this is an Access attribute applied to the
-- the current instance object passed to a type
-- initialization procedure, then use the level
-- of the type itself. This is not really correct,
-- as there should be an extra level parameter
-- passed in with _init formals (only in the case
-- where the type is immutably limited), but we
-- don't have an easy way currently to create such
-- an extra formal (init procs aren't ever frozen).
-- For now we just use the level of the type,
-- which may be too shallow, but that works better
-- than passing Object_Access_Level of the type,
-- which can be one level too deep in some cases.
-- ???
if Is_Entity_Name (Prefix (Prev_Orig))
and then Is_Type (Entity (Prefix (Prev_Orig)))
then
Add_Extra_Actual
(Make_Integer_Literal (Loc,
Intval =>
Type_Access_Level
(Entity (Prefix (Prev_Orig)))),
Extra_Accessibility (Formal));
else
Add_Extra_Actual
(Make_Integer_Literal (Loc,
Intval =>
Object_Access_Level
(Prefix (Prev_Orig))),
Extra_Accessibility (Formal));
end if;
-- Treat the unchecked attributes as library-level
......
gcc/ada/sem_ch6.adb
......@@ -564,6 +564,15 @@ package body Sem_Ch6 is
Error_Msg_N ("must use anonymous access type", Subtype_Ind);
end if;
-- If the return object is of an anonymous access type, then report
-- an error if the function's result type is not also anonymous.
elsif R_Stm_Type_Is_Anon_Access
and then not R_Type_Is_Anon_Access
then
Error_Msg_N ("anonymous access not allowed for function with " &
"named access result", Subtype_Ind);
-- Subtype indication case: check that the return object's type is
-- covered by the result type, and that the subtypes statically match
-- when the result subtype is constrained. Also handle record types
......
gcc/ada/sem_ch8.adb
......@@ -802,8 +802,13 @@ package body Sem_Ch8 is
T := Entity (Subtype_Mark (N));
Analyze (Nam);
-- Reject renamings of conversions unless the type is tagged, or
-- the conversion is implicit (which can occur for cases of anonymous
-- access types in Ada 2012).
if Nkind (Nam) = N_Type_Conversion
and then not Is_Tagged_Type (T)
and then Comes_From_Source (Nam)
and then not Is_Tagged_Type (T)
then
Error_Msg_N
("renaming of conversion only allowed for tagged types", Nam);
......@@ -834,6 +839,22 @@ package body Sem_Ch8 is
return;
end if;
-- Ada 2012 (AI05-149): Reject renaming of an anonymous access object
-- when renaming declaration has a named access type. The Ada 2012
-- coverage rules allow an anonymous access type in the context of
-- an expected named general access type, but the renaming rules
-- require the types to be the same. (An exception is when the type
-- of the renaming is also an anonymous access type, which can only
-- happen due to a renaming created by the expander.)
if Nkind (Nam) = N_Type_Conversion
and then not Comes_From_Source (Nam)
and then Ekind (Etype (Expression (Nam))) = E_Anonymous_Access_Type
and then Ekind (T) /= E_Anonymous_Access_Type
then
Wrong_Type (Expression (Nam), T); -- Should we give better error???
end if;
-- Check that a class-wide object is not being renamed as an object
-- of a specific type. The test for access types is needed to exclude
-- cases where the renamed object is a dynamically tagged access
......
gcc/ada/sem_res.adb
......@@ -273,15 +273,6 @@ package body Sem_Res is
-- is only one requires a search over all visible entities, and happens
-- only in very pathological cases (see 6115-006).
function Valid_Conversion
(N : Node_Id;
Target : Entity_Id;
Operand : Node_Id) return Boolean;
-- Verify legality rules given in 4.6 (8-23). Target is the target type
-- of the conversion, which may be an implicit conversion of an actual
-- parameter to an anonymous access type (in which case N denotes the
-- actual parameter and N = Operand).
-------------------------
-- Ambiguous_Character --
-------------------------
......@@ -2759,6 +2750,22 @@ package body Sem_Res is
Resolve_Unchecked_Type_Conversion (N, Ctx_Type);
end case;
-- Ada 2012 (AI05-0149): Apply an (implicit) conversion to an
-- expression of an anonymous access type that occurs in the context
-- of a named general access type, except when the expression is that
-- of a membership test. This ensures proper legality checking in
-- terms of allowed conversions (expressions that would be illegal to
-- convert implicitly are allowed in membership tests).
if Ada_Version >= Ada_2012
and then Ekind (Ctx_Type) = E_General_Access_Type
and then Ekind (Etype (N)) = E_Anonymous_Access_Type
and then Nkind (Parent (N)) not in N_Membership_Test
then
Rewrite (N, Convert_To (Ctx_Type, Relocate_Node (N)));
Analyze_And_Resolve (N, Ctx_Type);
end if;
-- If the subexpression was replaced by a non-subexpression, then
-- all we do is to expand it. The only legitimate case we know of
-- is converting procedure call statement to entry call statements,
......@@ -10097,9 +10104,10 @@ package body Sem_Res is
----------------------
function Valid_Conversion
(N : Node_Id;
Target : Entity_Id;
Operand : Node_Id) return Boolean
(N : Node_Id;
Target : Entity_Id;
Operand : Node_Id;
Report_Errs : Boolean := True) return Boolean
is
Target_Type : constant Entity_Id := Base_Type (Target);
Opnd_Type : Entity_Id := Etype (Operand);
......@@ -10109,6 +10117,15 @@ package body Sem_Res is
Msg : String) return Boolean;
-- Little routine to post Msg if Valid is False, returns Valid value
procedure Error_Msg_N (Msg : String; N : Node_Or_Entity_Id);
-- If Report_Errs, then calls Errout.Error_Msg_N with its arguments
procedure Error_Msg_NE
(Msg : String;
N : Node_Or_Entity_Id;
E : Node_Or_Entity_Id);
-- If Report_Errs, then calls Errout.Error_Msg_NE with its arguments
function Valid_Tagged_Conversion
(Target_Type : Entity_Id;
Opnd_Type : Entity_Id) return Boolean;
......@@ -10134,6 +10151,32 @@ package body Sem_Res is
return Valid;
end Conversion_Check;
-----------------
-- Error_Msg_N --
-----------------
procedure Error_Msg_N (Msg : String; N : Node_Or_Entity_Id) is
begin
if Report_Errs then
Errout.Error_Msg_N (Msg, N);
end if;
end Error_Msg_N;
------------------
-- Error_Msg_NE --
------------------
procedure Error_Msg_NE
(Msg : String;
N : Node_Or_Entity_Id;
E : Node_Or_Entity_Id)
is
begin
if Report_Errs then
Errout.Error_Msg_NE (Msg, N, E);
end if;
end Error_Msg_NE;
----------------------------
-- Valid_Array_Conversion --
----------------------------
......@@ -10588,9 +10631,76 @@ package body Sem_Res is
if Ekind (Target_Type) /= E_Anonymous_Access_Type
or else Is_Local_Anonymous_Access (Target_Type)
then
if Type_Access_Level (Opnd_Type)
> Type_Access_Level (Target_Type)
-- Ada 2012 (AI05-0149): Perform legality checking on implicit
-- conversions from an anonymous access type to a named general
-- access type. Such conversions are not allowed in the case of
-- access parameters and stand-alone objects of an anonymous
-- access type.
if Ada_Version >= Ada_2012
and then not Comes_From_Source (N)
and then Ekind (Target_Type) = E_General_Access_Type
and then Ekind (Opnd_Type) = E_Anonymous_Access_Type
then
if Is_Itype (Opnd_Type) then
-- Implicit conversions aren't allowed for objects of an
-- anonymous access type, since such objects have nonstatic
-- levels in Ada 2012.
if Nkind (Associated_Node_For_Itype (Opnd_Type)) =
N_Object_Declaration
then
Error_Msg_N
("implicit conversion of stand-alone anonymous " &
"access object not allowed", Operand);
return False;
-- Implicit conversions aren't allowed for anonymous access
-- parameters. The "not Is_Local_Anonymous_Access_Type" test
-- is done to exclude anonymous access results.
elsif not Is_Local_Anonymous_Access (Opnd_Type)
and then Nkind_In (Associated_Node_For_Itype (Opnd_Type),
N_Function_Specification,
N_Procedure_Specification)
then
Error_Msg_N
("implicit conversion of anonymous access formal " &
"not allowed", Operand);
return False;
-- This is a case where there's an enclosing object whose
-- to which the "statically deeper than" relationship does
-- not apply (such as an access discriminant selected from
-- a dereference of an access parameter).
elsif Object_Access_Level (Operand)
= Scope_Depth (Standard_Standard)
then
Error_Msg_N
("implicit conversion of anonymous access value " &
"not allowed", Operand);
return False;
-- In other cases, the level of the operand's type must be
-- statically less deep than that of the target type, else
-- implicit conversion is disallowed (by RM12-8.6(27.1/3)).
elsif Type_Access_Level (Opnd_Type)
> Type_Access_Level (Target_Type)
then
Error_Msg_N
("implicit conversion of anonymous access value " &
"violates accessibility", Operand);
return False;
end if;
end if;
elsif Type_Access_Level (Opnd_Type)
> Type_Access_Level (Target_Type)
then
-- In an instance, this is a run-time check, but one we know
-- will fail, so generate an appropriate warning. The raise
-- will be generated by Expand_N_Type_Conversion.
......
gcc/ada/sem_res.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -122,6 +122,18 @@ package Sem_Res is
procedure Preanalyze_And_Resolve (N : Node_Id);
-- Same, but use type of node because context does not impose a single type
function Valid_Conversion
(N : Node_Id;
Target : Entity_Id;
Operand : Node_Id;
Report_Errs : Boolean := True) return Boolean;
-- Verify legality rules given in 4.6 (8-23). Target is the target type
-- of the conversion, which may be an implicit conversion of an actual
-- parameter to an anonymous access type (in which case N denotes the
-- actual parameter and N = Operand). Returns a Boolean result indicating
-- whether the conversion is legal. Reports errors in the case of illegal
-- conversions, unless Report_Errs is False.
private
procedure Resolve_Implicit_Type (N : Node_Id) renames Resolve;
pragma Inline (Resolve_Implicit_Type);
......
gcc/ada/sem_type.adb
......@@ -967,6 +967,19 @@ package body Sem_Type is
then
return True;
-- Ada 2012 (AI05-0149): Allow an anonymous access type in the context
-- of a named general access type. An implicit conversion will be
-- applied. For the resolution, one designated type must cover the
-- other.
elsif Ada_Version >= Ada_2012
and then Ekind (BT1) = E_General_Access_Type
and then Ekind (BT2) = E_Anonymous_Access_Type
and then (Covers (Designated_Type (T1), Designated_Type (T2))
or else Covers (Designated_Type (T2), Designated_Type (T1)))
then
return True;
-- An Access_To_Subprogram is compatible with itself, or with an
-- anonymous type created for an attribute reference Access.
......
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