2013-04-24 Ed Schonberg <schonberg@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 24 Apr 2013 13:01:09 +0000 (13:01 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 24 Apr 2013 13:01:09 +0000 (13:01 +0000)
* sem_ch3.adb: Create packed array only when expander is
active.

2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>

* sem_prag.adb (Analyze_Depends_In_Decl_Part): Install the formals only
when the context warrants it.
(Analyze_Global_In_Decl_List): Install the formals only when
the context warrants it.
(Requires_Profile_Installation): New routine.

2013-04-24  Ed Schonberg  <schonberg@adacore.com>

* exp_ch6.adb (Expand_N_Simple_Return_Statement): When the return
type is a discriminated private type that does not require use
of the secondary stack, a constrained subtype of the underlying
type is created to convey the proper object size to the backend.
If the return type is originally a private type, the return
expression is wrapped in an unchecked_conversion. If the return
expression is used subsequently in a call to the postcondition
function, this conversion must be undone to prevent a spurious
error on the analysis of that call.

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

gcc/ada/ChangeLog
gcc/ada/exp_ch6.adb
gcc/ada/sem_ch3.adb
gcc/ada/sem_prag.adb

index 0e2a7e9..44f42f3 100644 (file)
@@ -1,3 +1,28 @@
+2013-04-24  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch3.adb: Create packed array only when expander is
+       active.
+
+2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * sem_prag.adb (Analyze_Depends_In_Decl_Part): Install the formals only
+       when the context warrants it.
+       (Analyze_Global_In_Decl_List): Install the formals only when
+       the context warrants it.
+       (Requires_Profile_Installation): New routine.
+
+2013-04-24  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_ch6.adb (Expand_N_Simple_Return_Statement): When the return
+       type is a discriminated private type that does not require use
+       of the secondary stack, a constrained subtype of the underlying
+       type is created to convey the proper object size to the backend.
+       If the return type is originally a private type, the return
+       expression is wrapped in an unchecked_conversion. If the return
+       expression is used subsequently in a call to the postcondition
+       function, this conversion must be undone to prevent a spurious
+       error on the analysis of that call.
+
 2013-04-23  Kai Tietz  <ktietz@redhat.com>
 
        PR target/55445
index b097779..dc43046 100644 (file)
@@ -7902,10 +7902,23 @@ package body Exp_Ch6 is
 
          else
             declare
-               ExpR : constant Node_Id   := Relocate_Node (Exp);
+               ExpR : Node_Id            := Relocate_Node (Exp);
                Tnn  : constant Entity_Id := Make_Temporary (Loc, 'T', ExpR);
 
             begin
+               --  In the case of discriminated objects, we have created a
+               --  constrained subtype above, and used the underlying type.
+               --  This transformation is post-analysis and harmless, except
+               --  that now the call to the post-condition will be analyzed and
+               --  type kinds have to match.
+
+               if Nkind (ExpR) = N_Unchecked_Type_Conversion
+                 and then
+                   Is_Private_Type (R_Type) /= Is_Private_Type (Etype (ExpR))
+               then
+                  ExpR := Expression (ExpR);
+               end if;
+
                --  For a complex expression of an elementary type, capture
                --  value in the temporary and use it as the reference.
 
index e09facd..079c0ec 100644 (file)
@@ -11532,7 +11532,10 @@ package body Sem_Ch3 is
          --  itself will not be frozen, and the packed array type for it must
          --  be constructed explicitly.
 
-         if Is_Packed (Compon_Type) and then Is_Frozen (Current_Scope) then
+         if Expander_Active
+           and then Is_Packed (Compon_Type)
+           and then Is_Frozen (Current_Scope)
+         then
             Create_Packed_Array_Type (Array_Comp);
          end if;
 
index a29f526..59d0858 100644 (file)
@@ -213,6 +213,11 @@ package body Sem_Prag is
    --  pragma in the source program, a breakpoint on rv catches this place in
    --  the source, allowing convenient stepping to the point of interest.
 
+   function Requires_Profile_Installation (Subp : Node_Id) return Boolean;
+   --  Subsidiary routine to the analysis of pragma Depends and pragma Global.
+   --  Determine whether the profile of subprogram Subp must be installed into
+   --  visibility to access its formals.
+
    procedure Set_Unit_Name (N : Node_Id; With_Item : Node_Id);
    --  Place semantic information on the argument of an Elaborate/Elaborate_All
    --  pragma. Entity name for unit and its parents is taken from item in
@@ -1352,7 +1357,7 @@ package body Sem_Prag is
          --  to subprogram declarations. Skip the installation for subprogram
          --  bodies because the formals are already visible.
 
-         if Nkind (Subp_Decl) = N_Subprogram_Declaration then
+         if Requires_Profile_Installation (Subp_Decl) then
             Push_Scope (Subp_Id);
             Install_Formals (Subp_Id);
          end if;
@@ -1383,7 +1388,7 @@ package body Sem_Prag is
             Next (Clause);
          end loop;
 
-         if Nkind (Subp_Decl) = N_Subprogram_Declaration then
+         if Requires_Profile_Installation (Subp_Decl) then
             End_Scope;
          end if;
 
@@ -1702,20 +1707,21 @@ package body Sem_Prag is
       --  of these may be malformed in which case the analysis emits error
       --  messages.
 
-      elsif Nkind (Subp_Decl) = N_Subprogram_Body then
-         Analyze_Global_List (List);
-
-      --  Ensure that the formal parameters are visible when processing an
-      --  item. This falls out of the general rule of aspects pertaining to
-      --  subprogram declarations.
-
       else
-         Push_Scope (Subp_Id);
-         Install_Formals (Subp_Id);
+         --  Ensure that the formal parameters are visible when processing an
+         --  item. This falls out of the general rule of aspects pertaining to
+         --  subprogram declarations.
+
+         if Requires_Profile_Installation (Subp_Decl) then
+            Push_Scope (Subp_Id);
+            Install_Formals (Subp_Id);
+         end if;
 
          Analyze_Global_List (List);
 
-         End_Scope;
+         if Requires_Profile_Installation (Subp_Decl) then
+            End_Scope;
+         end if;
       end if;
    end Analyze_Global_In_Decl_Part;
 
@@ -18828,6 +18834,38 @@ package body Sem_Prag is
       null;
    end rv;
 
+   -----------------------------------
+   -- Requires_Profile_Installation --
+   -----------------------------------
+
+   function Requires_Profile_Installation (Subp : Node_Id) return Boolean is
+   begin
+      --  When aspects Depends and Global are associated with a subprogram
+      --  declaration, their corresponding pragmas are analyzed at the end of
+      --  the declarative part. This is done out of context, therefore the
+      --  formals must be installed in visibility.
+
+      if Nkind (Subp) = N_Subprogram_Declaration then
+         return True;
+
+      --  When aspects Depends and Global are associated with a subprogram body
+      --  which is also a compilation unit, their corresponding pragmas appear
+      --  in the Pragmas_After list. The Pragmas_After collection is analyzed
+      --  out of context and the formals must be installed in visibility.
+
+      elsif Nkind (Subp) = N_Subprogram_Body
+        and then Nkind (Parent (Subp)) = N_Compilation_Unit
+      then
+         return True;
+
+      --  In all other cases the two corresponding pragmas are analyzed in
+      --  context and the formals are already visibile.
+
+      else
+         return False;
+      end if;
+   end Requires_Profile_Installation;
+
    --------------------------------
    -- Set_Encoded_Interface_Name --
    --------------------------------