]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
2014-07-17 Bob Duff <duff@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 17 Jul 2014 07:06:05 +0000 (07:06 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 17 Jul 2014 07:06:05 +0000 (07:06 +0000)
* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@212736 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/exp_disp.adb
gcc/ada/exp_pakd.adb
gcc/ada/gnat_rm.texi
gcc/ada/sem_ch13.adb

index b3f3ce6385e042f49db27b94c5b80a79317aa762..3102148e4af7e24c095deb3a7839b1ca6c7ea319 100644 (file)
@@ -1,3 +1,23 @@
+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
index 8da934f3d3408b9d7c31c68751e0af35c35f47f6..34db31231207dc14a1650a2e11ee78d3f1b28683 100644 (file)
@@ -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));
index 9569979960acfc0adff7e6fcf9fd26f032e82997..35d310be0f204d09b0cf5072131807e1b48c2e16 100644 (file)
@@ -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
index 3fd1c59621d722b0afff325dd6e7c51723c77c87..b0b3907cc388c37b5e4020f54eff779f198ce31f 100644 (file)
@@ -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:
index 2381f5c7d746f8995847aa8962f90c28067181b4..be28f94a1d83a940bd64420cc0614f12862a25d4 100644 (file)
@@ -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