diff mbox

[Ada] Warning on fixed-point actual types with user-defined operators

Message ID 20160706123457.GA26416@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet July 6, 2016, 12:34 p.m. UTC
This patch adds aa 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, in particular multiplying operators.

Compiling procfix.adb must yield:

   procfix.adb:23:28: warning:
       instance does not use primitive operation "*" at line 5

The warning disappears if a formal subprogram declaration is added to the
generic:

   with function "*" (X, Y :Fix) return Fix is <>;

---
with Text_IO; use Text_IO;
procedure Procfix is
  package P is
     type T is delta 0.1 range -10.0 .. 10.0;
     function "*" (X, Y: T) return T;
  end P;
  use P;

  package body P is
     function "*" (X, Y: T) return T is
     begin
        return  (X + Y) / 2.0;
     end;
  end P;

  generic
     type Fix is delta <>;
  package Try is
     X : Fix := 3.0;
     Y : Fix := X * X;
  end;

  package Inst is new Try (T);
  use Inst;

begin
  Put_Line (T'Image (Inst.Y));
end;

Tested on x86_64-pc-linux-gnu, committed on trunk

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.
diff mbox

Patch

Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb	(revision 238040)
+++ sem_ch12.adb	(working copy)
@@ -1105,6 +1105,12 @@ 
       --  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 @@ 
       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 @@ 
                           (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.