From: charlet Date: Thu, 17 Jul 2014 07:06:05 +0000 (+0000) Subject: 2014-07-17 Bob Duff X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=ed4adc99e36bfdc0aaeab0937995a3bb22959cce;p=thirdparty%2Fgcc.git 2014-07-17 Bob Duff * gnat_ugn.texi: Improve documentation of Unrestricted_Access. 2014-07-17 Robert Dewar * sem_ch13.adb (Build_Invariant_Procedure): Add variable Nam (Add_Invariants): Set Nam to Name_Type_Invariant if from aspect. 2014-07-17 Thomas Quinot * exp_pakd.adb (Create_Packed_Array_Type.Install_PAT): For a non-bit-packed array, propagate Reverse_Storage_Order to the packed array type. 2014-07-17 Javier Miranda * exp_disp.adb: Fix comment. * exp_pakd.adb: Minor reformatting. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@212736 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b3f3ce6385e0..3102148e4af7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2014-07-17 Bob Duff + + * gnat_ugn.texi: Improve documentation of Unrestricted_Access. + +2014-07-17 Robert Dewar + + * sem_ch13.adb (Build_Invariant_Procedure): Add variable Nam + (Add_Invariants): Set Nam to Name_Type_Invariant if from aspect. + +2014-07-17 Thomas Quinot + + * exp_pakd.adb (Create_Packed_Array_Type.Install_PAT): For a + non-bit-packed array, propagate Reverse_Storage_Order to the + packed array type. + +2014-07-17 Javier Miranda + + * exp_disp.adb: Fix comment. + * exp_pakd.adb: Minor reformatting. + 2014-07-17 Robert Dewar * bindgen.adb (Gen_Elab_Calls): Skip reference to elab diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 8da934f3d340..34db31231207 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -7171,11 +7171,8 @@ package body Exp_Disp is Set_Ekind (DT_Ptr, E_Variable); Set_Related_Type (DT_Ptr, Typ); - -- Ensure that entities Prim_Ptr and Predef_Prims_Table_Ptr have - -- the decoration required by the backend. - - -- Odd comment, the back end cannot require anything not properly - -- documented in einfo. ??? + -- Notify the back end that the types are associated with a dispatch + -- table Set_Is_Dispatch_Table_Entity (RTE (RE_Prim_Ptr)); Set_Is_Dispatch_Table_Entity (RTE (RE_Predef_Prims_Table_Ptr)); diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index 9569979960ac..35d310be0f20 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -846,13 +846,12 @@ package body Exp_Pakd is -- the resulting type as an Itype in the packed array type field of -- the original type, so that no explicit declaration is required. - -- Note: the packed type is created in the scope of its parent - -- type. There are at least some cases where the current scope - -- is deeper, and so when this is the case, we temporarily reset - -- the scope for the definition. This is clearly safe, since the - -- first use of the packed array type will be the implicit - -- reference from the corresponding unpacked type when it is - -- elaborated. + -- Note: the packed type is created in the scope of its parent type. + -- There are at least some cases where the current scope is deeper, + -- and so when this is the case, we temporarily reset the scope + -- for the definition. This is clearly safe, since the first use + -- of the packed array type will be the implicit reference from + -- the corresponding unpacked type when it is elaborated. if Is_Itype (Typ) then Set_Parent (Decl, Associated_Node_For_Itype (Typ)); @@ -895,10 +894,18 @@ package body Exp_Pakd is Set_Is_Packed_Array_Type (PAT, True); Set_Original_Array_Type (PAT, Typ); + -- For a non-bit-packed array, propagate reverse storage order + -- flag from original base type to packed array base type. + + if not Is_Bit_Packed_Array (Typ) then + Set_Reverse_Storage_Order + (Etype (PAT), Reverse_Storage_Order (Base_Type (Typ))); + end if; + -- We definitely do not want to delay freezing for packed array - -- types. This is of particular importance for the itypes that - -- are generated for record components depending on discriminants - -- where there is no place to put the freeze node. + -- types. This is of particular importance for the itypes that are + -- generated for record components depending on discriminants where + -- there is no place to put the freeze node. Set_Has_Delayed_Freeze (PAT, False); Set_Has_Delayed_Freeze (Etype (PAT), False); @@ -1000,6 +1007,10 @@ package body Exp_Pakd is -- Natural range Enum_Type'Pos (Enum_Type'First) .. -- Enum_Type'Pos (Enum_Type'Last); + -- Note that tttP is created even if no index subtype is a non + -- standard enumeration, because we still need to remove padding + -- normally inserted for component alignment. + PAT := Make_Defining_Identifier (Loc, Chars => New_External_Name (Chars (Typ), 'P')); @@ -1098,7 +1109,7 @@ package body Exp_Pakd is Decl := Make_Full_Type_Declaration (Loc, Defining_Identifier => PAT, - Type_Definition => Typedef); + Type_Definition => Typedef); end; -- Set type as packed array type and install it diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 3fd1c59621d7..b0b3907cc388 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -9588,28 +9588,64 @@ end; @noindent The @code{Unrestricted_Access} attribute is similar to @code{Access} except that all accessibility and aliased view checks are omitted. This -is a user-beware attribute. It is similar to -@code{Address}, for which it is a desirable replacement where the value -desired is an access type. In other words, its effect is similar to -first applying the @code{Address} attribute and then doing an unchecked -conversion to a desired access type. In GNAT, but not necessarily in -other implementations, the use of static chains for inner level -subprograms means that @code{Unrestricted_Access} applied to a -subprogram yields a value that can be called as long as the subprogram -is in scope (normal Ada accessibility rules restrict this usage). - -It is possible to use @code{Unrestricted_Access} for any type, but care -must be exercised if it is used to create pointers to unconstrained array -objects. In this case, the resulting pointer has the same scope as the -context of the attribute, and may not be returned to some enclosing -scope. For instance, a function cannot use @code{Unrestricted_Access} -to create a unconstrained pointer and then return that value to the -caller. In addition, it is only valid to create pointers to unconstrained -arrays using this attribute if the pointer has the normal default ``fat'' -representation where a pointer has two components, one points to the array -and one points to the bounds. If a size clause is used to force ``thin'' -representation for a pointer to unconstrained where there is only space for -a single pointer, then the resulting pointer is not usable. +is a user-beware attribute. + +For objects, it is similar to @code{Address}, for which it is a +desirable replacement where the value desired is an access type. +In other words, its effect is similar to first applying the +@code{Address} attribute and then doing an unchecked conversion to a +desired access type. + +For subprograms, @code{P'Unrestricted_Access} may be used where +@code{P'Access} would be illegal, to construct a value of a +less-nested named access type that designates a more-nested +subprogram. This value may be used in indirect calls, so long as the +more-nested subprogram still exists; once the subprogram containing it +has returned, such calls are erroneous. For example: + +@smallexample @c ada +package body P is + + type Less_Nested is not null access procedure; + Global : Less_Nested; + + procedure P1 is + begin + Global.all; + end P1; + + procedure P2 is + Local_Var : Integer; + + procedure More_Nested is + begin + ... Local_Var ... + end More_Nested; + begin + Global := More_Nested'Unrestricted_Access; + P1; + end P2; + +end P; +@end smallexample + +When P1 is called from P2, the call via Global is OK, but if P1 were +called after P2 returns, it would be an erroneous use of a dangling +pointer. + +For objects, it is possible to use @code{Unrestricted_Access} for any +type, but care must be exercised if it is used to create pointers to +unconstrained array objects. In this case, the resulting pointer has +the same scope as the context of the attribute, and may not be +returned to some enclosing scope. For instance, a function cannot use +@code{Unrestricted_Access} to create a pointer to unconstrained and +then return that value to the caller. In addition, it is only valid +to create pointers to unconstrained arrays using this attribute if the +pointer has the normal default ``fat'' representation where a pointer +has two components, one points to the array and one points to the +bounds. If a size clause is used to force ``thin'' representation for +a pointer to unconstrained where there is only space for a single +pointer, then the resulting pointer is not usable. In the simple case where a direct use of Unrestricted_Access attempts to make a thin pointer for a non-aliased object, the compiler will @@ -9686,17 +9722,17 @@ bounds before the string. If the size clause for type @code{A} were not present, then the pointer would be a fat pointer, where one component is a pointer to the bounds, and all would be well. But with the size clause present, the conversion from -fat pointer to thin pointer in the call looses the bounds, and so this -program raises a @code{Program_Error} exception if executed. +fat pointer to thin pointer in the call loses the bounds, and so this +is erroneous, and the program likely raises a @code{Program_Error} exception. In general, it is advisable to completely avoid mixing the use of thin pointers and the use of @code{Unrestricted_Access} where the designated type is an unconstrained array. The use of thin pointers should be restricted to -cases of porting legacy code which implicitly assumes the size of pointers, +cases of porting legacy code that implicitly assumes the size of pointers, and such code should not in any case be using this attribute. -Another erroroneous situation arises if the attribute is +Another erroneous situation arises if the attribute is applied to a constant. The resulting pointer can be used to access the constant, but the effect of trying to modify a constant in this manner is not well-defined. Consider this example: diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 2381f5c7d746..be28f94a1d83 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -6218,6 +6218,11 @@ package body Sem_Ch13 is PDecl : Node_Id; PBody : Node_Id; + Nam : Name_Id; + -- Name for Check pragma, usually Invariant, but might be Type_Invariant + -- if we come from a Type_Invariant aspect, we make sure to build the + -- Check pragma with the right name, so that Check_Policy works right. + Visible_Decls : constant List_Id := Visible_Declarations (N); Private_Decls : constant List_Id := Private_Declarations (N); @@ -6372,6 +6377,10 @@ package body Sem_Ch13 is -- Loop to find corresponding aspect, note that this -- must be present given the pragma is marked delayed. + -- Note: in practice Next_Rep_Item (Ritem) is Empty so + -- this loop does nothing. Furthermore, why isn't this + -- simply Corresponding_Aspect ??? + Aitem := Next_Rep_Item (Ritem); while Present (Aitem) loop if Nkind (Aitem) = N_Aspect_Specification @@ -6399,7 +6408,7 @@ package body Sem_Ch13 is -- analyze the original expression in the aspect specification -- because it is part of the original tree. - if ASIS_Mode then + if ASIS_Mode and then From_Aspect_Specification (Ritem) then declare Inv : constant Node_Id := Expression (Corresponding_Aspect (Ritem)); @@ -6409,13 +6418,22 @@ package body Sem_Ch13 is end; end if; + -- Get name to be used for Check pragma + + if not From_Aspect_Specification (Ritem) then + Nam := Name_Invariant; + else + Nam := Chars (Identifier (Corresponding_Aspect (Ritem))); + end if; + -- Build first two arguments for Check pragma - Assoc := New_List ( - Make_Pragma_Argument_Association (Loc, - Expression => Make_Identifier (Loc, Name_Invariant)), - Make_Pragma_Argument_Association (Loc, - Expression => Exp)); + Assoc := + New_List ( + Make_Pragma_Argument_Association (Loc, + Expression => Make_Identifier (Loc, Chars => Nam)), + Make_Pragma_Argument_Association (Loc, + Expression => Exp)); -- Add message if present in Invariant pragma