From: Gary Dismukes Date: Tue, 30 Aug 2011 13:16:22 +0000 (+0000) Subject: sem_ch6.adb (Check_Return_Subtype_Indication): Issue error if the return object has... X-Git-Tag: releases/gcc-4.7.0~4124 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=6cce215622c7a24991d7c90d743cc82cc1b0d76c;p=thirdparty%2Fgcc.git 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 * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1dfd423be7d7..a5892f23f73f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,49 @@ +2011-08-30 Gary Dismukes + + * 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 * s-taskin.ads: Minor comment fix. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index e3f9412393ba..e21d9d1d7911 100644 --- a/gcc/ada/exp_ch4.adb +++ b/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; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 8073ff568fd7..93d8174ea6ed 100644 --- a/gcc/ada/exp_ch6.adb +++ b/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 diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 4c196669ccf8..f7e0fa5b994e 100644 --- a/gcc/ada/sem_ch6.adb +++ b/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 diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 77f948f4f6a4..662a0e9bb5dc 100644 --- a/gcc/ada/sem_ch8.adb +++ b/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 diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 409ace4f8d27..0d03b298c6f4 100644 --- a/gcc/ada/sem_res.adb +++ b/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. diff --git a/gcc/ada/sem_res.ads b/gcc/ada/sem_res.ads index 70b534bf50c6..361b8651569c 100644 --- a/gcc/ada/sem_res.ads +++ b/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); diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 70a94234d3e2..8c2eeeef65b4 100644 --- a/gcc/ada/sem_type.adb +++ b/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.