[multiple changes]

2016-05-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_prag.adb, comperr.adb: Minor reformatting.

2016-05-02  Ed Schonberg  <schonberg@adacore.com>

	* exp_pakd.adb (Rj_Unchecked_Convert_To): Do not perform an
	unchecked conversion if the source size is 0 (indicating that
	its RM size is unknown). This will happen with packed arrays of
	non-discrete types, in which case the component type is known
	to match.

2016-05-02  Arnaud Charlet  <charlet@adacore.com>

	* debug.adb: Reserve -gnatd.V.

2016-05-02  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Process_Full_View): Remove from visibility
	wrappers of synchronized types to avoid spurious errors with
	their wrapped entity.
	* exp_ch9.adb (Build_Wrapper_Spec): Do not generate the wrapper
	if no interface primitive is covered by the subprogram and this is
	not a primitive declared between two views; see Process_Full_View.
	(Build_Protected_Sub_Specification): Link the dispatching
	subprogram with its original non-dispatching protected subprogram
	since their names differ.
	(Expand_N_Protected_Type_Declaration):
	If a protected subprogram overrides an interface primitive then
	do not build a wrapper if it was already built.
	* einfo.ads, einfo.adb (Original_Protected_Subprogram): New attribute.
	* sem_ch4.adb (Names_Match): New subprogram.
	* sem_ch6.adb (Check_Synchronized_Overriding): Moved
	to library level and defined in the public part of the
	package to invoke it from Exp_Ch9.Build_Wrapper_Spec
	(Has_Matching_Entry_Or_Subprogram): New subprogram.
	(Report_Conflict): New subprogram.

From-SVN: r235739

gcc/ada/ChangeLog

+2016-05-02  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_prag.adb, comperr.adb: Minor reformatting.
+
+2016-05-02  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_pakd.adb (Rj_Unchecked_Convert_To): Do not perform an
+	unchecked conversion if the source size is 0 (indicating that
+	its RM size is unknown). This will happen with packed arrays of
+	non-discrete types, in which case the component type is known
+	to match.
+
+2016-05-02  Arnaud Charlet  <charlet@adacore.com>
+
+	* debug.adb: Reserve -gnatd.V.
+
+2016-05-02  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch3.adb (Process_Full_View): Remove from visibility
+	wrappers of synchronized types to avoid spurious errors with
+	their wrapped entity.
+	* exp_ch9.adb (Build_Wrapper_Spec): Do not generate the wrapper
+	if no interface primitive is covered by the subprogram and this is
+	not a primitive declared between two views; see Process_Full_View.
+	(Build_Protected_Sub_Specification): Link the dispatching
+	subprogram with its original non-dispatching protected subprogram
+	since their names differ.
+	(Expand_N_Protected_Type_Declaration):
+	If a protected subprogram overrides an interface primitive then
+	do not build a wrapper if it was already built.
+	* einfo.ads, einfo.adb (Original_Protected_Subprogram): New attribute.
+	* sem_ch4.adb (Names_Match): New subprogram.
+	* sem_ch6.adb (Check_Synchronized_Overriding): Moved
+	to library level and defined in the public part of the
+	package to invoke it from Exp_Ch9.Build_Wrapper_Spec
+	(Has_Matching_Entry_Or_Subprogram): New subprogram.
+	(Report_Conflict): New subprogram.
+
 2016-05-02  Jerome Lambourg  <lambourg@adacore.com>
 
 	* s-unstyp.ads: Code cleanups.

gcc/ada/comperr.adb

@@ -467,8 +467,9 @@ package body Comperr is
       Main := Unit (Cunit (Main_Unit));
 
       case Nkind (Main) is
-         when N_Subprogram_Declaration | N_Subprogram_Body |
-              N_Package_Declaration =>
+         when N_Package_Declaration    |
+              N_Subprogram_Body        |
+              N_Subprogram_Declaration =>
             Unit_Name := Defining_Unit_Name (Specification (Main));
 
          when N_Package_Body =>

gcc/ada/debug.adb

@@ -139,7 +139,7 @@ package body Debug is
    --  d.S  Force Optimize_Alignment (Space)
    --  d.T  Force Optimize_Alignment (Time)
    --  d.U  Ignore indirect calls for static elaboration
-   --  d.V
+   --  d.V  Do not verify validity of SCIL files (CodePeer mode)
    --  d.W  Print out debugging information for Walk_Library_Items
    --  d.X  Old treatment of indexing aspects
    --  d.Y
@@ -686,6 +686,12 @@ package body Debug is
    --       reverts to the behavior of earlier compilers, which ignored
    --       indirect calls.
 
+   --  d.V  Do not verify the validity of SCIL files (CodePeer mode). When
+   --       generating SCIL files for CodePeer, by default we verify that the
+   --       SCIL is well formed before saving it on disk. This switch can be
+   --       used to disable this checking, either to improve speed or to shut
+   --       down a false positive detected during the verification.
+
    --  d.W  Print out debugging information for Walk_Library_Items, including
    --       the order in which units are walked. This is primarily for use in
    --       debugging CodePeer mode.

gcc/ada/einfo.adb

@@ -274,6 +274,7 @@ package body Einfo is
 
    --    SPARK_Pragma                    Node40
 
+   --    Original_Protected_Subprogram   Node41
    --    SPARK_Aux_Pragma                Node41
 
    ---------------------------------------------
@@ -2837,6 +2838,11 @@ package body Einfo is
       return Node21 (Id);
    end Original_Array_Type;
 
+   function Original_Protected_Subprogram (Id : E) return N is
+   begin
+      return Node41 (Id);
+   end Original_Protected_Subprogram;
+
    function Original_Record_Component (Id : E) return E is
    begin
       pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant));
@@ -5900,6 +5906,12 @@ package body Einfo is
       Set_Node21 (Id, V);
    end Set_Original_Array_Type;
 
+   procedure Set_Original_Protected_Subprogram (Id : E; V : N) is
+   begin
+      pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
+      Set_Node41 (Id, V);
+   end Set_Original_Protected_Subprogram;
+
    procedure Set_Original_Record_Component (Id : E; V : E) is
    begin
       pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant));
@@ -10483,6 +10495,10 @@ package body Einfo is
               E_Task_Type                                  =>
             Write_Str ("SPARK_Aux_Pragma");
 
+         when E_Function                                   |
+              E_Procedure                                  =>
+            Write_Str ("Original_Protected_Subprogram");
+
          when others                                       =>
             Write_Str ("Field41??");
       end case;

gcc/ada/einfo.ads

@@ -3647,6 +3647,11 @@ package Einfo is
 --       points to the original array type for which this is the packed
 --       array implementation type.
 
+--    Original_Protected_Subprogram (Node41)
+--       Defined in functions and procedures. Set only on internally built
+--       dispatching subprograms of protected types to reference their original
+--       non-dispatching protected subprogram since their names differ.
+
 --    Original_Record_Component (Node22)
 --       Defined in components, including discriminants. The usage depends
 --       on whether the record is a base type and whether it is tagged.
@@ -5923,6 +5928,7 @@ package Einfo is
    --    Class_Wide_Preconds                 (List38)
    --    Class_Wide_Postconds                (List39)
    --    SPARK_Pragma                        (Node40)
+   --    Original_Protected_Subprogram       (Node41)
    --    Body_Needed_For_SAL                 (Flag40)
    --    Contains_Ignored_Ghost_Code         (Flag279)
    --    Default_Expressions_Processed       (Flag108)
@@ -6234,6 +6240,7 @@ package Einfo is
    --    Class_Wide_Preconds                 (List38)
    --    Class_Wide_Postconds                (List39)
    --    SPARK_Pragma                        (Node40)
+   --    Original_Protected_Subprogram       (Node41)
    --    Body_Needed_For_SAL                 (Flag40)
    --    Contains_Ignored_Ghost_Code         (Flag279)
    --    Delay_Cleanups                      (Flag114)
@@ -7127,6 +7134,7 @@ package Einfo is
    function Optimize_Alignment_Time             (Id : E) return B;
    function Original_Access_Type                (Id : E) return E;
    function Original_Array_Type                 (Id : E) return E;
+   function Original_Protected_Subprogram       (Id : E) return N;
    function Original_Record_Component           (Id : E) return E;
    function Overlays_Constant                   (Id : E) return B;
    function Overridden_Operation                (Id : E) return E;
@@ -7801,6 +7809,7 @@ package Einfo is
    procedure Set_Optimize_Alignment_Time         (Id : E; V : B := True);
    procedure Set_Original_Access_Type            (Id : E; V : E);
    procedure Set_Original_Array_Type             (Id : E; V : E);
+   procedure Set_Original_Protected_Subprogram   (Id : E; V : N);
    procedure Set_Original_Record_Component       (Id : E; V : E);
    procedure Set_Overlays_Constant               (Id : E; V : B := True);
    procedure Set_Overridden_Operation            (Id : E; V : E);
@@ -8628,6 +8637,7 @@ package Einfo is
    pragma Inline (Optimize_Alignment_Time);
    pragma Inline (Original_Access_Type);
    pragma Inline (Original_Array_Type);
+   pragma Inline (Original_Protected_Subprogram);
    pragma Inline (Original_Record_Component);
    pragma Inline (Overlays_Constant);
    pragma Inline (Overridden_Operation);
@@ -9093,6 +9103,7 @@ package Einfo is
    pragma Inline (Set_Optimize_Alignment_Time);
    pragma Inline (Set_Original_Access_Type);
    pragma Inline (Set_Original_Array_Type);
+   pragma Inline (Set_Original_Protected_Subprogram);
    pragma Inline (Set_Original_Record_Component);
    pragma Inline (Set_Overlays_Constant);
    pragma Inline (Set_Overridden_Operation);

gcc/ada/exp_ch9.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -2443,13 +2443,6 @@ package body Exp_Ch9 is
       Obj_Typ : Entity_Id;
       Formals : List_Id) return Node_Id
    is
-      Loc           : constant Source_Ptr := Sloc (Subp_Id);
-      First_Param   : Node_Id;
-      Iface         : Entity_Id;
-      Iface_Elmt    : Elmt_Id;
-      Iface_Op      : Entity_Id;
-      Iface_Op_Elmt : Elmt_Id;
-
       function Overriding_Possible
         (Iface_Op : Entity_Id;
          Wrapper  : Entity_Id) return Boolean;
@@ -2631,6 +2624,16 @@ package body Exp_Ch9 is
          return New_Formals;
       end Replicate_Formals;
 
+      --  Local variables
+
+      Loc             : constant Source_Ptr := Sloc (Subp_Id);
+      First_Param     : Node_Id := Empty;
+      Iface           : Entity_Id;
+      Iface_Elmt      : Elmt_Id;
+      Iface_Op        : Entity_Id;
+      Iface_Op_Elmt   : Elmt_Id;
+      Overridden_Subp : Entity_Id;
+
    --  Start of processing for Build_Wrapper_Spec
 
    begin
@@ -2638,17 +2641,24 @@ package body Exp_Ch9 is
 
       pragma Assert (Is_Tagged_Type (Obj_Typ));
 
+      --  Check if this subprogram has a profile that matches some interface
+      --  primitive
+
+      Check_Synchronized_Overriding (Subp_Id, Overridden_Subp);
+
+      if Present (Overridden_Subp) then
+         First_Param :=
+           First (Parameter_Specifications (Parent (Overridden_Subp)));
+
       --  An entry or a protected procedure can override a routine where the
       --  controlling formal is either IN OUT, OUT or is of access-to-variable
       --  type. Since the wrapper must have the exact same signature as that of
       --  the overridden subprogram, we try to find the overriding candidate
       --  and use its controlling formal.
 
-      First_Param := Empty;
-
       --  Check every implemented interface
 
-      if Present (Interfaces (Obj_Typ)) then
+      elsif Present (Interfaces (Obj_Typ)) then
          Iface_Elmt := First_Elmt (Interfaces (Obj_Typ));
          Search : while Present (Iface_Elmt) loop
             Iface := Node (Iface_Elmt);
@@ -2684,40 +2694,14 @@ package body Exp_Ch9 is
          end loop Search;
       end if;
 
-      --  Ada 2012 (AI05-0090-1): If no interface primitive is covered by
-      --  this subprogram and this is not a primitive declared between two
-      --  views then force the generation of a wrapper. As an optimization,
-      --  previous versions of the frontend avoid generating the wrapper;
-      --  however, the wrapper facilitates locating and reporting an error
-      --  when a duplicate declaration is found later. See example in
-      --  AI05-0090-1.
+      --  Do not generate the wrapper if no interface primitive is covered by
+      --  the subprogram and it is not a primitive declared declared between
+      --  two views (see Process_Full_View).
 
       if No (First_Param)
         and then not Is_Private_Primitive_Subprogram (Subp_Id)
       then
-         if Is_Task_Type
-              (Corresponding_Concurrent_Type (Obj_Typ))
-         then
-            First_Param :=
-              Make_Parameter_Specification (Loc,
-                Defining_Identifier => Make_Defining_Identifier (Loc, Name_uO),
-                In_Present          => True,
-                Out_Present         => False,
-                Parameter_Type      => New_Occurrence_Of (Obj_Typ, Loc));
-
-         --  For entries and procedures of protected types the mode of
-         --  the controlling argument must be in-out.
-
-         else
-            First_Param :=
-              Make_Parameter_Specification (Loc,
-                Defining_Identifier =>
-                  Make_Defining_Identifier (Loc,
-                    Chars => Name_uO),
-                In_Present     => True,
-                Out_Present    => (Ekind (Subp_Id) /= E_Function),
-                Parameter_Type => New_Occurrence_Of (Obj_Typ, Loc));
-         end if;
+         return Empty;
       end if;
 
       declare
@@ -4229,6 +4213,15 @@ package body Exp_Ch9 is
         Make_Defining_Identifier (Loc,
           Chars => Build_Selected_Name (Prot_Typ, Def_Id, Append_Chr (Mode)));
 
+      --  Reference the original non-dispatching subprogram since the analysis
+      --  of the object.operation notation may need its original name (see
+      --  Sem_Ch4.Names_Match).
+
+      if Mode = Dispatching_Mode then
+         Set_Ekind (New_Id, Ekind (Def_Id));
+         Set_Original_Protected_Subprogram (New_Id, Def_Id);
+      end if;
+
       --  The unprotected operation carries the user code, and debugging
       --  information must be generated for it, even though this spec does
       --  not come from source. It is also convenient to allow gdb to step
@@ -9653,22 +9646,50 @@ package body Exp_Ch9 is
             Current_Node := Sub;
 
             --  Generate an overriding primitive operation specification for
-            --  this subprogram if the protected type implements an interface.
+            --  this subprogram if the protected type implements an interface
+            --  and Build_Wrapper_Spec did not not generate its wrapper.
 
             if Ada_Version >= Ada_2005
               and then
                 Present (Interfaces (Corresponding_Record_Type (Prot_Typ)))
             then
-               Sub :=
-                 Make_Subprogram_Declaration (Loc,
-                   Specification =>
-                     Build_Protected_Sub_Specification
-                       (Comp, Prot_Typ, Dispatching_Mode));
+               declare
+                  Prim_Elmt : Elmt_Id;
+                  Prim_Op   : Node_Id;
+                  Found     : Boolean := False;
 
-               Insert_After (Current_Node, Sub);
-               Analyze (Sub);
+               begin
+                  Prim_Elmt :=
+                    First_Elmt
+                      (Primitive_Operations
+                         (Corresponding_Record_Type (Prot_Typ)));
 
-               Current_Node := Sub;
+                  while Present (Prim_Elmt) loop
+                     Prim_Op := Node (Prim_Elmt);
+
+                     if Is_Primitive_Wrapper (Prim_Op)
+                       and then (Wrapped_Entity (Prim_Op))
+                                   = Defining_Entity (Specification (Comp))
+                     then
+                        Found := True;
+                        exit;
+                     end if;
+
+                     Next_Elmt (Prim_Elmt);
+                  end loop;
+
+                  if not Found then
+                     Sub :=
+                       Make_Subprogram_Declaration (Loc,
+                         Specification =>
+                           Build_Protected_Sub_Specification
+                             (Comp, Prot_Typ, Dispatching_Mode));
+                     Insert_After (Current_Node, Sub);
+                     Analyze (Sub);
+
+                     Current_Node := Sub;
+                  end if;
+               end;
             end if;
 
             --  If a pragma Interrupt_Handler applies, build and add a call to

gcc/ada/exp_pakd.adb

@@ -2298,9 +2298,12 @@ package body Exp_Pakd is
       --  convert to a modular type of the source length, since otherwise, on
       --  a big-endian machine, we get left-justification. We do it for little-
       --  endian machines as well, because there might be junk bits that are
-      --  not cleared if the type is not numeric.
+      --  not cleared if the type is not numeric. This can be done only if the
+      --  source siz is different from 0 (i.e. known), otherwise we must trust
+      --  the type declarations (case of non-discrete components).
 
-      if Source_Siz /= Target_Siz
+      if Source_Siz /= 0
+        and then Source_Siz /= Target_Siz
         and then not Is_Discrete_Type (Source_Typ)
       then
          Src := Unchecked_Convert_To (RTE (Bits_Id (Source_Siz)), Src);

gcc/ada/exp_prag.adb

@@ -884,8 +884,8 @@ package body Exp_Prag is
                   Set_Expression (Decl, Pref);
                   Analyze (Decl);
 
-                  --  Otherwise add an assignment  statement to temporary
-                  --  using prefix as RHS.
+               --  Otherwise add an assignment statement to temporary using
+               --  prefix as RHS.
 
                else
                   Analyze (Decl);

gcc/ada/sem_ch3.adb

@@ -19835,6 +19835,13 @@ package body Sem_Ch3 is
                            Curr_Nod := Wrap_Spec;
 
                            Analyze (Wrap_Spec);
+
+                           --  Remove the wrapper from visibility to avoid
+                           --  spurious conflict with the wrapped entity.
+
+                           Set_Is_Immediately_Visible
+                             (Defining_Entity (Specification (Wrap_Spec)),
+                              False);
                         end if;
 
                         Next_Elmt (Prim_Elmt);

gcc/ada/sem_ch4.adb

@@ -8817,6 +8817,15 @@ package body Sem_Ch4 is
          --  is visible a direct call to it will dispatch to the private one,
          --  which is therefore a valid candidate.
 
+         function Names_Match
+           (Obj_Type : Entity_Id;
+            Prim_Op  : Entity_Id;
+            Subprog  : Entity_Id) return Boolean;
+         --  Return True if the names of Prim_Op and Subprog match. If Obj_Type
+         --  is a protected type then compare also the original name of Prim_Op
+         --  with the name of Subprog (since the expander may have added a
+         --  prefix to its original name --see Exp_Ch9.Build_Selected_Name).
+
          function Valid_First_Argument_Of (Op : Entity_Id) return Boolean;
          --  Verify that the prefix, dereferenced if need be, is a valid
          --  controlling argument in a call to Op. The remaining actuals
@@ -8993,6 +9002,34 @@ package body Sem_Ch4 is
               and then not Is_Hidden (Visible_Op);
          end Is_Private_Overriding;
 
+         -----------------
+         -- Names_Match --
+         -----------------
+
+         function Names_Match
+           (Obj_Type : Entity_Id;
+            Prim_Op  : Entity_Id;
+            Subprog  : Entity_Id) return Boolean is
+         begin
+            --  Common case: exact match
+
+            if Chars (Prim_Op) = Chars (Subprog) then
+               return True;
+
+            --  For protected type primitives the expander may have built the
+            --  name of the dispatching primitive prepending the type name to
+            --  avoid conflicts with the name of the protected subprogram (see
+            --  Exp_Ch9.Build_Selected_Name).
+
+            elsif Is_Protected_Type (Obj_Type) then
+               return Present (Original_Protected_Subprogram (Prim_Op))
+                 and then Chars (Original_Protected_Subprogram (Prim_Op))
+                            = Chars (Subprog);
+            end if;
+
+            return False;
+         end Names_Match;
+
          -----------------------------
          -- Valid_First_Argument_Of --
          -----------------------------
@@ -9059,7 +9096,7 @@ package body Sem_Ch4 is
          while Present (Elmt) loop
             Prim_Op := Node (Elmt);
 
-            if Chars (Prim_Op) = Chars (Subprog)
+            if Names_Match (Obj_Type, Prim_Op, Subprog)
               and then Present (First_Formal (Prim_Op))
               and then Valid_First_Argument_Of (Prim_Op)
               and then

gcc/ada/sem_ch6.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -122,6 +122,15 @@ package Sem_Ch6 is
    --  formal access-to-subprogram type, indicating that mapping of types
    --  is needed.
 
+   procedure Check_Synchronized_Overriding
+     (Def_Id          : Entity_Id;
+      Overridden_Subp : out Entity_Id);
+   --  First determine if Def_Id is an entry or a subprogram either defined
+   --  in the scope of a task or protected type, or is a primitive of such
+   --  a type. Check whether Def_Id overrides a subprogram of an interface
+   --  implemented by the synchronized type, return the overridden entity
+   --  or Empty.
+
    procedure Check_Type_Conformant
      (New_Id  : Entity_Id;
       Old_Id  : Entity_Id;