2015-05-28 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 28 May 2015 08:19:18 +0000 (08:19 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 28 May 2015 08:19:18 +0000 (08:19 +0000)
* sem_ch13.adb, sem_disp.ads: Minor reformatting.

2015-05-28  Ed Schonberg  <schonberg@adacore.com>

* sem_util.adb (Set_Debug_Info_Needed): For a private type
whose full view is itself a derived private type, set flag on
underlying full view as well, for proper gdb display.

2015-05-28  Bob Duff  <duff@adacore.com>

* exp_tss.ads: Minor comment fix.
* exp_ch3.adb (Build_Array_Init_Proc, Build_Record_Init_Proc):
Inline init_procs when the type has controlled parts. Remove
obsolete comments about those init_procs -- init_procs for
such types are no longer complex. A typical init_proc just
initializes the 'Tag field, and calls the parent init_proc
(e.g. for Limited_Controlled), which calls the grandparent
(for Root_Controlled), which does nothing. This all boils down
to one instruction when inlined.
* exp_ch7.adb (Create_Finalizer): Inline the finalizer.

2015-05-28  Ed Schonberg  <schonberg@adacore.com>

* sem_ch4.adb (Analyze_Selected_Component): If the type to use
is a derived type and is a generic actual, the selected component
appears within an instance body, and the check over the type
has failed, examine ancestor types for the desired component.
(Find_Component_In_Instance): If record type is a derived type,
examine all ancestors in order to locate desired component.

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

gcc/ada/ChangeLog
gcc/ada/exp_ch3.adb
gcc/ada/exp_ch7.adb
gcc/ada/exp_tss.ads
gcc/ada/sem_ch13.adb
gcc/ada/sem_ch4.adb
gcc/ada/sem_disp.ads
gcc/ada/sem_util.adb

index aa4aa18..c9f142f 100644 (file)
@@ -1,3 +1,35 @@
+2015-05-28  Robert Dewar  <dewar@adacore.com>
+
+       * sem_ch13.adb, sem_disp.ads: Minor reformatting.
+
+2015-05-28  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_util.adb (Set_Debug_Info_Needed): For a private type
+       whose full view is itself a derived private type, set flag on
+       underlying full view as well, for proper gdb display.
+
+2015-05-28  Bob Duff  <duff@adacore.com>
+
+       * exp_tss.ads: Minor comment fix.
+       * exp_ch3.adb (Build_Array_Init_Proc, Build_Record_Init_Proc):
+       Inline init_procs when the type has controlled parts. Remove
+       obsolete comments about those init_procs -- init_procs for
+       such types are no longer complex. A typical init_proc just
+       initializes the 'Tag field, and calls the parent init_proc
+       (e.g. for Limited_Controlled), which calls the grandparent
+       (for Root_Controlled), which does nothing. This all boils down
+       to one instruction when inlined.
+       * exp_ch7.adb (Create_Finalizer): Inline the finalizer.
+
+2015-05-28  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch4.adb (Analyze_Selected_Component): If the type to use
+       is a derived type and is a generic actual, the selected component
+       appears within an instance body, and the check over the type
+       has failed, examine ancestor types for the desired component.
+       (Find_Component_In_Instance): If record type is a derived type,
+       examine all ancestors in order to locate desired component.
+
 2015-05-27  H.J. Lu  <hongjiu.lu@intel.com>
 
        * gcc-interface/Makefile.in (TOOLS_LIBS): Add @NO_PIE_FLAG@.
index d6783d6..885e63a 100644 (file)
@@ -311,7 +311,7 @@ package body Exp_Ch3 is
    --  Predefined_Primitive_Bodies.
 
    function Has_New_Non_Standard_Rep (T : Entity_Id) return Boolean;
-   --  returns True if there are representation clauses for type T that are not
+   --  Returns True if there are representation clauses for type T that are not
    --  inherited. If the result is false, the init_proc and the discriminant
    --  checking functions of the parent can be reused by a derived type.
 
@@ -761,14 +761,12 @@ package body Exp_Ch3 is
             Set_Debug_Info_Off (Proc_Id);
          end if;
 
-         --  Set inlined unless controlled stuff or tasks around, in which
-         --  case we do not want to inline, because nested stuff may cause
-         --  difficulties in inter-unit inlining, and furthermore there is
-         --  in any case no point in inlining such complex init procs.
+         --  Set inlined unless tasks are around, in which case we do not
+         --  want to inline, because nested stuff may cause difficulties in
+         --  inter-unit inlining, and furthermore there is in any case no
+         --  point in inlining such complex init procs.
 
-         if not Has_Task (Proc_Id)
-           and then not Needs_Finalization (Proc_Id)
-         then
+         if not Has_Task (Proc_Id) then
             Set_Is_Inlined (Proc_Id);
          end if;
 
@@ -3619,14 +3617,10 @@ package body Exp_Ch3 is
          --  The initialization of protected records is not worth inlining.
          --  In addition, when compiled for another unit for inlining purposes,
          --  it may make reference to entities that have not been elaborated
-         --  yet. The initialization of controlled records contains a nested
-         --  clean-up procedure that makes it impractical to inline as well,
-         --  and leads to undefined symbols if inlined in a different unit.
-         --  Similar considerations apply to task types.
+         --  yet. Similar considerations apply to task types.
 
          if not Is_Concurrent_Type (Rec_Type)
            and then not Has_Task (Rec_Type)
-           and then not Needs_Finalization (Rec_Type)
          then
             Set_Is_Inlined  (Proc_Id);
          end if;
index 74854ba..23d97d5 100644 (file)
@@ -1440,6 +1440,13 @@ package body Exp_Ch7 is
             --  resides, there is no need for elaboration checks.
 
             Set_Kill_Elaboration_Checks (Fin_Id);
+
+            --  Inlining the finalizer produces a substantial speedup at -O2.
+            --  It is inlined by default at -O3. Either way, it is called
+            --  exactly twice (once on the normal path, and once for
+            --  exceptions/abort), so this won't bloat the code too much.
+
+            Set_Is_Inlined  (Fin_Id);
          end if;
 
          --  Step 2: Creation of the finalizer specification
index 0fd967e..a66e41d 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -213,7 +213,7 @@ package Exp_Tss is
    --  case arises for concurrent types. Such types do not themselves have an
    --  init proc TSS, but initialization is required. The init proc used is
    --  the one for the corresponding record type (see Base_Init_Proc). If
-   --  Ref is present it is call to a subprogram whose profile matches the
+   --  Ref is present it is call to a subprogram whose profile matches the
    --  profile of the required constructor (this argument is used to handle
    --  non-default CPP constructors).
 
index 8e1501a..5494d33 100644 (file)
@@ -6496,7 +6496,7 @@ package body Sem_Ch13 is
          return;
       end if;
 
-      --  We know we have a first subtype, now possibly go the anonymous
+      --  We know we have a first subtype, now possibly go to the anonymous
       --  base type to determine whether Rectype is a record extension.
 
       Recdef := Type_Definition (Declaration_Node (Base_Type (Rectype)));
index bbfe118..80f0234 100644 (file)
@@ -4102,7 +4102,8 @@ package body Sem_Ch4 is
       --  searches have failed. If a match is found, the Etype of both N and
       --  Sel are set from this component, and the entity of Sel is set to
       --  reference this component. If no match is found, Entity (Sel) remains
-      --  unset.
+      --  unset. For a derived type that is an actual of the instance, the
+      --  desired component may be found in any ancestor.
 
       function Has_Mode_Conformant_Spec (Comp : Entity_Id) return Boolean;
       --  It is known that the parent of N denotes a subprogram call. Comp
@@ -4117,18 +4118,36 @@ package body Sem_Ch4 is
 
       procedure Find_Component_In_Instance (Rec : Entity_Id) is
          Comp : Entity_Id;
+         Typ  : Entity_Id;
 
       begin
-         Comp := First_Component (Rec);
-         while Present (Comp) loop
-            if Chars (Comp) = Chars (Sel) then
-               Set_Entity_With_Checks (Sel, Comp);
-               Set_Etype (Sel, Etype (Comp));
-               Set_Etype (N,   Etype (Comp));
+         Typ := Rec;
+         while Present (Typ) loop
+            Comp := First_Component (Typ);
+            while Present (Comp) loop
+               if Chars (Comp) = Chars (Sel) then
+                  Set_Entity_With_Checks (Sel, Comp);
+                  Set_Etype (Sel, Etype (Comp));
+                  Set_Etype (N,   Etype (Comp));
+                  return;
+               end if;
+
+               Next_Component (Comp);
+            end loop;
+
+            --  If not found, the component may be declared in the parent
+            --  type or its full view, if any.
+
+            if Is_Derived_Type (Typ) then
+               Typ := Etype (Typ);
+
+               if Is_Private_Type (Typ) then
+                  Typ := Full_View (Typ);
+               end if;
+
+            else
                return;
             end if;
-
-            Next_Component (Comp);
          end loop;
 
          --  If we fall through, no match, so no changes made
@@ -4789,6 +4808,18 @@ package body Sem_Ch4 is
                      Par := Etype (Par);
                   end loop;
 
+               --  Another special case: the type is an extension of a private
+               --  type T, is an actual in an instance, and we are in the body
+               --  of the instance, so the generic body had a full view of the
+               --  type declaration for T or of some ancestor that defines the
+               --  component in question.
+
+               elsif Is_Derived_Type (Type_To_Use)
+                 and then Used_As_Generic_Actual (Type_To_Use)
+                 and then In_Instance_Body
+               then
+                  Find_Component_In_Instance (Parent_Subtype (Type_To_Use));
+
                --  In ASIS mode the generic parent type may be absent. Examine
                --  the parent type directly for a component that may have been
                --  visible in a parent generic unit.
index 8f91c02..6100afc 100644 (file)
@@ -48,11 +48,11 @@ package Sem_Disp is
    --  primitive operations (new primitives are only defined in package spec,
    --  overridden operation can be defined in any scope). If Old_Subp is not
    --  Empty we are in the overriding case. If the tagged type associated with
-   --  Subp is a concurrent type (case that occurs when the type is declared in
-   --  a generic because the analysis of generics disables generation of the
-   --  corresponding record) then this routine does not add Subp to the
-   --  list of primitive operations but leaves Subp decorated as dispatching
-   --  operation to enable checks associated with the Object.Operation notation
+   --  Subp is a concurrent type (case that occurs when the type is declared
+   --  in a generic because the analysis of generics disables generation of the
+   --  corresponding record) then this routine does not add Subp to the list of
+   --  primitive operations but leaves Subp decorated as dispatching operation
+   --  to enable checks associated with the Object.Operation notation.
 
    procedure Check_Operation_From_Incomplete_Type
      (Subp : Entity_Id;
index 1a3b411..d749ea1 100644 (file)
@@ -17704,7 +17704,22 @@ package body Sem_Util is
             Set_Debug_Info_Needed_If_Not_Set (Directly_Designated_Type (T));
 
          elsif Is_Private_Type (T) then
-            Set_Debug_Info_Needed_If_Not_Set (Full_View (T));
+            declare
+               FV : constant Entity_Id := Full_View (T);
+
+            begin
+               Set_Debug_Info_Needed_If_Not_Set (FV);
+
+               --  If the full view is itself a derived private type, we need
+               --  debug information on its underlying type.
+
+               if Present (FV)
+                 and then Is_Private_Type (FV)
+                 and then Present (Underlying_Full_View (FV))
+               then
+                  Set_Needs_Debug_Info (Underlying_Full_View (FV));
+               end if;
+            end;
 
          elsif Is_Protected_Type (T) then
             Set_Debug_Info_Needed_If_Not_Set (Corresponding_Record_Type (T));