Commit 6ccdd977 by Arnaud Charlet

[multiple changes]

2014-07-17  Bob Duff  <duff@adacore.com>

	* gnat_ugn.texi: Improve documentation of Unrestricted_Access.

2014-07-17  Robert Dewar  <dewar@adacore.com>

	* 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  <quinot@adacore.com>

	* 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  <miranda@adacore.com>

	* exp_disp.adb: Fix comment.
	* exp_pakd.adb: Minor reformatting.

From-SVN: r212736
parent d8941160
2014-07-17 Bob Duff <duff@adacore.com>
* gnat_ugn.texi: Improve documentation of Unrestricted_Access.
2014-07-17 Robert Dewar <dewar@adacore.com>
* 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 <quinot@adacore.com>
* 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 <miranda@adacore.com>
* exp_disp.adb: Fix comment.
* exp_pakd.adb: Minor reformatting.
2014-07-17 Robert Dewar <dewar@adacore.com> 2014-07-17 Robert Dewar <dewar@adacore.com>
* bindgen.adb (Gen_Elab_Calls): Skip reference to elab * bindgen.adb (Gen_Elab_Calls): Skip reference to elab
......
...@@ -7171,11 +7171,8 @@ package body Exp_Disp is ...@@ -7171,11 +7171,8 @@ package body Exp_Disp is
Set_Ekind (DT_Ptr, E_Variable); Set_Ekind (DT_Ptr, E_Variable);
Set_Related_Type (DT_Ptr, Typ); Set_Related_Type (DT_Ptr, Typ);
-- Ensure that entities Prim_Ptr and Predef_Prims_Table_Ptr have -- Notify the back end that the types are associated with a dispatch
-- the decoration required by the backend. -- table
-- Odd comment, the back end cannot require anything not properly
-- documented in einfo. ???
Set_Is_Dispatch_Table_Entity (RTE (RE_Prim_Ptr)); Set_Is_Dispatch_Table_Entity (RTE (RE_Prim_Ptr));
Set_Is_Dispatch_Table_Entity (RTE (RE_Predef_Prims_Table_Ptr)); Set_Is_Dispatch_Table_Entity (RTE (RE_Predef_Prims_Table_Ptr));
......
...@@ -846,13 +846,12 @@ package body Exp_Pakd is ...@@ -846,13 +846,12 @@ package body Exp_Pakd is
-- the resulting type as an Itype in the packed array type field of -- the resulting type as an Itype in the packed array type field of
-- the original type, so that no explicit declaration is required. -- the original type, so that no explicit declaration is required.
-- Note: the packed type is created in the scope of its parent -- Note: the packed type is created in the scope of its parent type.
-- type. There are at least some cases where the current scope -- There are at least some cases where the current scope is deeper,
-- is deeper, and so when this is the case, we temporarily reset -- and so when this is the case, we temporarily reset the scope
-- the scope for the definition. This is clearly safe, since the -- for the definition. This is clearly safe, since the first use
-- first use of the packed array type will be the implicit -- of the packed array type will be the implicit reference from
-- reference from the corresponding unpacked type when it is -- the corresponding unpacked type when it is elaborated.
-- elaborated.
if Is_Itype (Typ) then if Is_Itype (Typ) then
Set_Parent (Decl, Associated_Node_For_Itype (Typ)); Set_Parent (Decl, Associated_Node_For_Itype (Typ));
...@@ -895,10 +894,18 @@ package body Exp_Pakd is ...@@ -895,10 +894,18 @@ package body Exp_Pakd is
Set_Is_Packed_Array_Type (PAT, True); Set_Is_Packed_Array_Type (PAT, True);
Set_Original_Array_Type (PAT, Typ); 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 -- We definitely do not want to delay freezing for packed array
-- types. This is of particular importance for the itypes that -- types. This is of particular importance for the itypes that are
-- are generated for record components depending on discriminants -- generated for record components depending on discriminants where
-- where there is no place to put the freeze node. -- there is no place to put the freeze node.
Set_Has_Delayed_Freeze (PAT, False); Set_Has_Delayed_Freeze (PAT, False);
Set_Has_Delayed_Freeze (Etype (PAT), False); Set_Has_Delayed_Freeze (Etype (PAT), False);
...@@ -1000,6 +1007,10 @@ package body Exp_Pakd is ...@@ -1000,6 +1007,10 @@ package body Exp_Pakd is
-- Natural range Enum_Type'Pos (Enum_Type'First) .. -- Natural range Enum_Type'Pos (Enum_Type'First) ..
-- Enum_Type'Pos (Enum_Type'Last); -- 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 := PAT :=
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), 'P')); Chars => New_External_Name (Chars (Typ), 'P'));
...@@ -1098,7 +1109,7 @@ package body Exp_Pakd is ...@@ -1098,7 +1109,7 @@ package body Exp_Pakd is
Decl := Decl :=
Make_Full_Type_Declaration (Loc, Make_Full_Type_Declaration (Loc,
Defining_Identifier => PAT, Defining_Identifier => PAT,
Type_Definition => Typedef); Type_Definition => Typedef);
end; end;
-- Set type as packed array type and install it -- Set type as packed array type and install it
......
...@@ -9588,28 +9588,64 @@ end; ...@@ -9588,28 +9588,64 @@ end;
@noindent @noindent
The @code{Unrestricted_Access} attribute is similar to @code{Access} The @code{Unrestricted_Access} attribute is similar to @code{Access}
except that all accessibility and aliased view checks are omitted. This except that all accessibility and aliased view checks are omitted. This
is a user-beware attribute. It is similar to is a user-beware attribute.
@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 For objects, it is similar to @code{Address}, for which it is a
first applying the @code{Address} attribute and then doing an unchecked desirable replacement where the value desired is an access type.
conversion to a desired access type. In GNAT, but not necessarily in In other words, its effect is similar to first applying the
other implementations, the use of static chains for inner level @code{Address} attribute and then doing an unchecked conversion to a
subprograms means that @code{Unrestricted_Access} applied to a desired access type.
subprogram yields a value that can be called as long as the subprogram
is in scope (normal Ada accessibility rules restrict this usage). For subprograms, @code{P'Unrestricted_Access} may be used where
@code{P'Access} would be illegal, to construct a value of a
It is possible to use @code{Unrestricted_Access} for any type, but care less-nested named access type that designates a more-nested
must be exercised if it is used to create pointers to unconstrained array subprogram. This value may be used in indirect calls, so long as the
objects. In this case, the resulting pointer has the same scope as the more-nested subprogram still exists; once the subprogram containing it
context of the attribute, and may not be returned to some enclosing has returned, such calls are erroneous. For example:
scope. For instance, a function cannot use @code{Unrestricted_Access}
to create a unconstrained pointer and then return that value to the @smallexample @c ada
caller. In addition, it is only valid to create pointers to unconstrained package body P is
arrays using this attribute if the pointer has the normal default ``fat''
representation where a pointer has two components, one points to the array type Less_Nested is not null access procedure;
and one points to the bounds. If a size clause is used to force ``thin'' Global : Less_Nested;
representation for a pointer to unconstrained where there is only space for
a single pointer, then the resulting pointer is not usable. 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 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 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} ...@@ -9686,17 +9722,17 @@ bounds before the string. If the size clause for type @code{A}
were not present, then the pointer were not present, then the pointer
would be a fat pointer, where one component is a pointer to the bounds, 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 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 fat pointer to thin pointer in the call loses the bounds, and so this
program raises a @code{Program_Error} exception if executed. is erroneous, and the program likely raises a @code{Program_Error} exception.
In general, it is advisable to completely In general, it is advisable to completely
avoid mixing the use of thin pointers and the use of avoid mixing the use of thin pointers and the use of
@code{Unrestricted_Access} where the designated type is an @code{Unrestricted_Access} where the designated type is an
unconstrained array. The use of thin pointers should be restricted to 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. 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 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 constant, but the effect of trying to modify a constant in this manner
is not well-defined. Consider this example: is not well-defined. Consider this example:
......
...@@ -6218,6 +6218,11 @@ package body Sem_Ch13 is ...@@ -6218,6 +6218,11 @@ package body Sem_Ch13 is
PDecl : Node_Id; PDecl : Node_Id;
PBody : 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); Visible_Decls : constant List_Id := Visible_Declarations (N);
Private_Decls : constant List_Id := Private_Declarations (N); Private_Decls : constant List_Id := Private_Declarations (N);
...@@ -6372,6 +6377,10 @@ package body Sem_Ch13 is ...@@ -6372,6 +6377,10 @@ package body Sem_Ch13 is
-- Loop to find corresponding aspect, note that this -- Loop to find corresponding aspect, note that this
-- must be present given the pragma is marked delayed. -- 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); Aitem := Next_Rep_Item (Ritem);
while Present (Aitem) loop while Present (Aitem) loop
if Nkind (Aitem) = N_Aspect_Specification if Nkind (Aitem) = N_Aspect_Specification
...@@ -6399,7 +6408,7 @@ package body Sem_Ch13 is ...@@ -6399,7 +6408,7 @@ package body Sem_Ch13 is
-- analyze the original expression in the aspect specification -- analyze the original expression in the aspect specification
-- because it is part of the original tree. -- because it is part of the original tree.
if ASIS_Mode then if ASIS_Mode and then From_Aspect_Specification (Ritem) then
declare declare
Inv : constant Node_Id := Inv : constant Node_Id :=
Expression (Corresponding_Aspect (Ritem)); Expression (Corresponding_Aspect (Ritem));
...@@ -6409,13 +6418,22 @@ package body Sem_Ch13 is ...@@ -6409,13 +6418,22 @@ package body Sem_Ch13 is
end; end;
end if; 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 -- Build first two arguments for Check pragma
Assoc := New_List ( Assoc :=
Make_Pragma_Argument_Association (Loc, New_List (
Expression => Make_Identifier (Loc, Name_Invariant)), Make_Pragma_Argument_Association (Loc,
Make_Pragma_Argument_Association (Loc, Expression => Make_Identifier (Loc, Chars => Nam)),
Expression => Exp)); Make_Pragma_Argument_Association (Loc,
Expression => Exp));
-- Add message if present in Invariant pragma -- Add message if present in Invariant pragma
......
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