2016-07-06 Hristian Kirtchev <kirtchev@adacore.com>

	* exp_attr.adb, sem_attr.adb, sem_ch13.adb: Minor reformatting.

2016-07-06  Arnaud Charlet  <charlet@adacore.com>

	* lib.adb (Check_Same_Extended_Unit): Prevent looping forever.
	* gnatbind.adb: Disable some consistency checks in codepeer mode,
	which are not needed.

2016-07-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Check_Fixed_Point_Actual): Add a warning when
	a formal fixed point type is instantiated with a type that has
	a user-defined arithmetic operations, but the generic has no
	corresponding formal functions. This is worth a warning because
	of the special semantics of fixed-point operators.



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

7 files changed, 117 insertions, 28 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9a16f81a4ba..c52781752d1 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2016-07-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_attr.adb, sem_attr.adb, sem_ch13.adb: Minor reformatting.
+
+2016-07-06  Arnaud Charlet  <charlet@adacore.com>
+
+	* lib.adb (Check_Same_Extended_Unit): Prevent looping forever.
+	* gnatbind.adb: Disable some consistency checks in codepeer mode,
+	which are not needed.
+
+2016-07-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb (Check_Fixed_Point_Actual): Add a warning when
+	a formal fixed point type is instantiated with a type that has
+	a user-defined arithmetic operations, but the generic has no
+	corresponding formal functions. This is worth a warning because
+	of the special semantics of fixed-point operators.
+
 2016-07-06  Bob Duff  <duff@adacore.com>
 
 	* sem_attr.adb (Analyze_Attribute): Allow any expression of
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 47cee2b6af2..04929b5aa57 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -3009,9 +3009,10 @@ package body Exp_Attr is
 
       when Attribute_Enum_Rep => Enum_Rep : declare
          Expr : Node_Id;
+
       begin
-         --  Get the expression, which is X for Enum_Type'Enum_Rep (X)
-         --  or X'Enum_Rep.
+         --  Get the expression, which is X for Enum_Type'Enum_Rep (X) or
+         --  X'Enum_Rep.
 
          if Is_Non_Empty_List (Exprs) then
             Expr := First (Exprs);
@@ -3019,8 +3020,8 @@ package body Exp_Attr is
             Expr := Pref;
          end if;
 
-         --  If the expression is an enumeration literal, it is
-         --  replaced by the literal value.
+         --  If the expression is an enumeration literal, it is replaced by the
+         --  literal value.
 
          if Nkind (Expr) in N_Has_Entity
            and then Ekind (Entity (Expr)) = E_Enumeration_Literal
@@ -3029,8 +3030,8 @@ package body Exp_Attr is
               Make_Integer_Literal (Loc, Enumeration_Rep (Entity (Expr))));
 
          --  If this is a renaming of a literal, recover the representation
-         --  of the original. If it renames an expression there is nothing
-         --  to fold.
+         --  of the original. If it renames an expression there is nothing to
+         --  fold.
 
          elsif Nkind (Expr) in N_Has_Entity
            and then Ekind (Entity (Expr)) = E_Constant
@@ -3056,8 +3057,7 @@ package body Exp_Attr is
          --  might be an illegal conversion.
 
          else
-            Rewrite (N,
-              OK_Convert_To (Typ, Relocate_Node (Expr)));
+            Rewrite (N, OK_Convert_To (Typ, Relocate_Node (Expr)));
          end if;
 
          Set_Etype (N, Typ);
diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb
index 85f670716bd..51353773822 100644
--- a/gcc/ada/gnatbind.adb
+++ b/gcc/ada/gnatbind.adb
@@ -855,12 +855,15 @@ begin
          end;
       end if;
 
-      --  Perform consistency and correctness checks
-
-      Check_Duplicated_Subunits;
-      Check_Versions;
-      Check_Consistency;
-      Check_Configuration_Consistency;
+      --  Perform consistency and correctness checks. Disable these in CodePeer
+      --  mode where we want to be more flexible.
+
+      if not CodePeer_Mode then
+         Check_Duplicated_Subunits;
+         Check_Versions;
+         Check_Consistency;
+         Check_Configuration_Consistency;
+      end if;
 
       --  List restrictions that could be applied to this partition
 
diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb
index b711c21f592..c4edc7f1ebb 100644
--- a/gcc/ada/lib.adb
+++ b/gcc/ada/lib.adb
@@ -38,6 +38,7 @@ with Csets;    use Csets;
 with Einfo;    use Einfo;
 with Fname;    use Fname;
 with Nlists;   use Nlists;
+with Opt;      use Opt;
 with Output;   use Output;
 with Sinfo;    use Sinfo;
 with Sinput;   use Sinput;
@@ -259,18 +260,22 @@ package body Lib is
    ------------------------------
 
    function Check_Same_Extended_Unit (S1, S2 : Source_Ptr) return SEU_Result is
-      Sloc1  : Source_Ptr;
-      Sloc2  : Source_Ptr;
-      Sind1  : Source_File_Index;
-      Sind2  : Source_File_Index;
-      Inst1  : Source_Ptr;
-      Inst2  : Source_Ptr;
-      Unum1  : Unit_Number_Type;
-      Unum2  : Unit_Number_Type;
-      Unit1  : Node_Id;
-      Unit2  : Node_Id;
-      Depth1 : Nat;
-      Depth2 : Nat;
+      Max_Iterations : constant Nat := Maximum_Instantiations * 2;
+      --  Limit to prevent a potential infinite loop
+
+      Counter : Nat := 0;
+      Depth1  : Nat;
+      Depth2  : Nat;
+      Inst1   : Source_Ptr;
+      Inst2   : Source_Ptr;
+      Sind1   : Source_File_Index;
+      Sind2   : Source_File_Index;
+      Sloc1   : Source_Ptr;
+      Sloc2   : Source_Ptr;
+      Unit1   : Node_Id;
+      Unit2   : Node_Id;
+      Unum1   : Unit_Number_Type;
+      Unum2   : Unit_Number_Type;
 
    begin
       if S1 = No_Location or else S2 = No_Location then
@@ -435,7 +440,13 @@ package body Lib is
          return No;
 
          <<Continue>>
-            null;
+         Counter := Counter + 1;
+
+         --  Prevent looping forever
+
+         if Counter > Max_Iterations then
+            raise Program_Error;
+         end if;
       end loop;
    end Check_Same_Extended_Unit;
 
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index a05ad7e5532..3dec30ab0ed 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -3742,6 +3742,7 @@ package body Sem_Attr is
             Check_E1;
             Check_Discrete_Type;
             Resolve (E1, P_Base_Type);
+
          elsif not Is_Discrete_Type (Etype (P)) then
             Error_Attr_P ("prefix of % attribute must be of discrete type");
          end if;
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index f21ebc52ba0..d600d277e21 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -1105,6 +1105,12 @@ package body Sem_Ch12 is
       --  In Ada 2005, indicates partial parameterization of a formal
       --  package. As usual an other association must be last in the list.
 
+      procedure Check_Fixed_Point_Actual (Actual : Node_Id);
+      --  Warn if an actual fixed-point type has user-defined arithmetic
+      --  operations, but there is no corresponding formal in the generic,
+      --  in which case the predefined operations will be used. This merits
+      --  a warning because of the special semantics of fixed point ops.
+
       procedure Check_Overloaded_Formal_Subprogram (Formal : Entity_Id);
       --  Apply RM 12.3(9): if a formal subprogram is overloaded, the instance
       --  cannot have a named association for it. AI05-0025 extends this rule
@@ -1187,6 +1193,52 @@ package body Sem_Ch12 is
       end Check_Overloaded_Formal_Subprogram;
 
       -------------------------------
+      --  Check_Fixed_Point_Actual --
+      -------------------------------
+
+      procedure Check_Fixed_Point_Actual (Actual : Node_Id) is
+         Typ    : constant Entity_Id := Entity (Actual);
+         Prims  : constant Elist_Id  := Collect_Primitive_Operations (Typ);
+         Elem   : Elmt_Id;
+         Formal : Node_Id;
+
+      begin
+         --  Locate primitive operations of the type that are arithmetic
+         --  operations.
+
+         Elem := First_Elmt (Prims);
+         while Present (Elem) loop
+            if Nkind (Node (Elem)) = N_Defining_Operator_Symbol then
+
+               --  Check whether the generic unit has a formal subprogram of
+               --  the same name. This does not check types but is good enough
+               --  to justify a warning.
+
+               Formal := First_Non_Pragma (Formals);
+               while Present (Formal) loop
+                  if Nkind (Formal) = N_Formal_Concrete_Subprogram_Declaration
+                    and then Chars (Defining_Entity (Formal)) =
+                               Chars (Node (Elem))
+                  then
+                     exit;
+                  end if;
+
+                  Next (Formal);
+               end loop;
+
+               if No (Formal) then
+                  Error_Msg_Sloc := Sloc (Node (Elem));
+                  Error_Msg_NE
+                    ("?instance does not use primitive operation&#",
+                      Actual, Node (Elem));
+               end if;
+            end if;
+
+            Next_Elmt (Elem);
+         end loop;
+      end Check_Fixed_Point_Actual;
+
+      -------------------------------
       -- Has_Fully_Defined_Profile --
       -------------------------------
 
@@ -1613,6 +1665,10 @@ package body Sem_Ch12 is
                           (Formal, Match, Analyzed_Formal, Assoc),
                         Assoc);
 
+                     if Is_Fixed_Point_Type (Entity (Match)) then
+                        Check_Fixed_Point_Actual (Match);
+                     end if;
+
                      --  An instantiation is a freeze point for the actuals,
                      --  unless this is a rewritten formal package, or the
                      --  formal is an Ada 2012 formal incomplete type.
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index fc9c4c494bf..ccb323325f3 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1937,7 +1937,7 @@ package body Sem_Ch13 is
             if not Implementation_Defined_Aspect (A_Id) then
                Error_Msg_Name_1 := Nam;
 
-               --  Not allowed for renaming declarations. Examine original
+               --  Not allowed for renaming declarations. Examine the original
                --  node because a subprogram renaming may have been rewritten
                --  as a body.