+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.
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;
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;
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;
-- 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
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
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);
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
-- 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 --
-------------------------
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,
----------------------
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);
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;
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 --
----------------------------
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.
-- --
-- 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- --
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);
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.
projects / thirdparty / gcc.git / commitdiff
