+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>
* bindgen.adb (Gen_Elab_Calls): Skip reference to elab
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));
-- 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));
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);
-- 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'));
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
@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
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:
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);
-- 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
-- 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));
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