[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Thu, 19 Jan 2017 11:42:31 +0000 (12:42 +0100)
committerArnaud Charlet <charlet@gcc.gnu.org>
Thu, 19 Jan 2017 11:42:31 +0000 (12:42 +0100)
2017-01-19  Javier Miranda  <miranda@adacore.com>

* sem_util.ads, sem_util.adb (Expression_Of_Expression_Function): New
subprogram.
(Is_Inlinable_Expression_Function): New subprogram.
* exp_ch6.ads, exp_ch6.adb (Expression_Of_Expression_Function): Moved
to Sem_Util.
(Is_Inlinable_Expression_Function): Moved to Sem_Util.

2017-01-19  Ed Schonberg  <schonberg@adacore.com>

* sem_ch4.adb (Diagnose_Call): Improve error message when a
selected component has a prefix that might be interpreted
as a parameterless function call, but none of the candidate
interpretations is parameterless, and there is a hidden homonym
of the prefix that is a package.
* sem_ch8.adb (Find_Selected_Component): If the prefix might be
interpreted as a parameterless function call and its analysis
fails, do not call Analyze_Selected_Component.

From-SVN: r244618

gcc/ada/ChangeLog
gcc/ada/exp_ch6.adb
gcc/ada/exp_ch6.ads
gcc/ada/sem_ch4.adb
gcc/ada/sem_ch8.adb
gcc/ada/sem_util.adb
gcc/ada/sem_util.ads

index 55f5b1f2d1dcd0648df7a243c38779ee68ac6188..64d929b09d0cb65411a026e80d059f4edd04cb22 100644 (file)
@@ -1,3 +1,23 @@
+2017-01-19  Javier Miranda  <miranda@adacore.com>
+
+       * sem_util.ads, sem_util.adb (Expression_Of_Expression_Function): New
+       subprogram.
+       (Is_Inlinable_Expression_Function): New subprogram.
+       * exp_ch6.ads, exp_ch6.adb (Expression_Of_Expression_Function): Moved
+       to Sem_Util.
+       (Is_Inlinable_Expression_Function): Moved to Sem_Util.
+
+2017-01-19  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch4.adb (Diagnose_Call): Improve error message when a
+       selected component has a prefix that might be interpreted
+       as a parameterless function call, but none of the candidate
+       interpretations is parameterless, and there is a hidden homonym
+       of the prefix that is a package.
+       * sem_ch8.adb (Find_Selected_Component): If the prefix might be
+       interpreted as a parameterless function call and its analysis
+       fails, do not call Analyze_Selected_Component.
+
 2017-01-19  Steve Baird  <baird@adacore.com>
 
        * sem_util.ads: Add new Use_Full_View Boolean parameter to
index 4e03bd10df59a294805d4a37539ea77705598479..22caddd659029d141e4d531ef38a93c4d4beae46 100644 (file)
@@ -223,10 +223,6 @@ package body Exp_Ch6 is
    --  Expand simple return from function. In the case where we are returning
    --  from a function body this is called by Expand_N_Simple_Return_Statement.
 
-   function Expression_Of_Expression_Function
-     (Subp : Entity_Id) return Node_Id;
-   --  Return the expression of expression function Subp
-
    function Has_Unconstrained_Access_Discriminants
      (Subtyp : Entity_Id) return Boolean;
    --  Returns True if the given subtype is unconstrained and has one or more
@@ -6964,36 +6960,6 @@ package body Exp_Ch6 is
       end if;
    end Expand_Simple_Function_Return;
 
-   ---------------------------------------
-   -- Expression_Of_Expression_Function --
-   ---------------------------------------
-
-   function Expression_Of_Expression_Function
-     (Subp : Entity_Id) return Node_Id
-   is
-      Expr_Func : Node_Id;
-
-   begin
-      pragma Assert (Is_Expression_Function_Or_Completion (Subp));
-
-      if Nkind (Original_Node (Subprogram_Spec (Subp))) =
-           N_Expression_Function
-      then
-         Expr_Func := Original_Node (Subprogram_Spec (Subp));
-
-      elsif Nkind (Original_Node (Subprogram_Body (Subp))) =
-              N_Expression_Function
-      then
-         Expr_Func := Original_Node (Subprogram_Body (Subp));
-
-      else
-         pragma Assert (False);
-         null;
-      end if;
-
-      return Original_Node (Expression (Expr_Func));
-   end Expression_Of_Expression_Function;
-
    --------------------------------------------
    -- Has_Unconstrained_Access_Discriminants --
    --------------------------------------------
@@ -7323,41 +7289,6 @@ package body Exp_Ch6 is
       end if;
    end Freeze_Subprogram;
 
-   --------------------------------------
-   -- Is_Inlinable_Expression_Function --
-   --------------------------------------
-
-   function Is_Inlinable_Expression_Function
-     (Subp : Entity_Id) return Boolean
-   is
-      Return_Expr : Node_Id;
-
-   begin
-      if Is_Expression_Function_Or_Completion (Subp)
-        and then Has_Pragma_Inline_Always (Subp)
-        and then Needs_No_Actuals (Subp)
-        and then No (Contract (Subp))
-        and then not Is_Dispatching_Operation (Subp)
-        and then Needs_Finalization (Etype (Subp))
-        and then not Is_Class_Wide_Type (Etype (Subp))
-        and then not (Has_Invariants (Etype (Subp)))
-        and then Present (Subprogram_Body (Subp))
-        and then Was_Expression_Function (Subprogram_Body (Subp))
-      then
-         Return_Expr := Expression_Of_Expression_Function (Subp);
-
-         --  The returned object must not have a qualified expression and its
-         --  nominal subtype must be statically compatible with the result
-         --  subtype of the expression function.
-
-         return
-           Nkind (Return_Expr) = N_Identifier
-             and then Etype (Return_Expr) = Etype (Subp);
-      end if;
-
-      return False;
-   end Is_Inlinable_Expression_Function;
-
    -----------------------
    -- Is_Null_Procedure --
    -----------------------
index 1facf76ed6a31618c8428d3f9903c4e67e691e5b..249bf14a10b5c007c3626803361f79ccb008a773 100644 (file)
@@ -137,20 +137,6 @@ package Exp_Ch6 is
    --  that requires handling as a build-in-place call or is a qualified
    --  expression applied to such a call; otherwise returns False.
 
-   function Is_Inlinable_Expression_Function (Subp : Entity_Id) return Boolean;
-   --  Return True if Subp is an expression function that fulfills all the
-   --  following requirements for inlining:
-   --     1. pragma/aspect Inline_Always
-   --     2. No formals
-   --     3. No contracts
-   --     4. No dispatching primitive
-   --     5. Result subtype controlled (or with controlled components)
-   --     6. Result subtype not subject to type-invariant checks
-   --     7. Result subtype not a class-wide type
-   --     8. Return expression naming an object global to the function
-   --     9. Nominal subtype of the returned object statically compatible
-   --        with the result subtype of the expression function.
-
    function Is_Null_Procedure (Subp : Entity_Id) return Boolean;
    --  Predicate to recognize stubbed procedures and null procedures, which
    --  can be inlined unconditionally in all cases.
index d2fa0a4d899541196c4164565591334de91ffbf6..8fd886fdb7e81f4927a4d722ff386e4e52e706fe 100644 (file)
@@ -5881,6 +5881,38 @@ package body Sem_Ch4 is
          end loop;
       end if;
 
+      --  Before listing the possible candidates, check whether this
+      --  a prefix of a selected component that has been rewritten as
+      --  a parameterless function call because there is a callable
+      --  candidate interpretation. If there is a hidden package in
+      --  the list of homonyms of the function name (bad programming
+      --  style in any case) suggest that this is the intended entity.
+
+      if No (Parameter_Associations (N))
+        and then Nkind (Parent (N)) = N_Selected_Component
+        and then Nkind (Parent (Parent (N))) in N_Declaration
+        and then Is_Overloaded (Nam)
+      then
+         declare
+            Ent : Entity_Id;
+
+         begin
+            Ent := Current_Entity (Nam);
+            while Present (Ent) loop
+               if Ekind (Ent) = E_Package then
+                  Error_Msg_N
+                    ("no legal interpretations as function call,!", Nam);
+                  Error_Msg_NE ("\package& is not visible", N, Ent);
+                  Rewrite (Parent (N),
+                    New_Occurrence_Of (Any_Type, Sloc (N)));
+                  return;
+               end if;
+
+               Ent := Homonym (Ent);
+            end loop;
+         end;
+      end if;
+
       --   Analyze each candidate call again, with full error reporting
       --   for each.
 
index 10233500398fd72c7f4058f13f1d7071770ee318..abe5bea3709fa32d9ff1aee51a794162f43bc844 100644 (file)
@@ -7048,7 +7048,18 @@ package body Sem_Ch8 is
                   --  Now analyze the reformatted node
 
                   Analyze_Call (P);
-                  Analyze_Selected_Component (N);
+
+                  --  If the prefix is illegal after this transformation,
+                  --  there may be visibility errors on the prefix. The
+                  --  safest is to treat the selected component as an error.
+
+                  if Error_Posted (P) then
+                     Set_Etype (N, Any_Type);
+                     return;
+
+                  else
+                     Analyze_Selected_Component (N);
+                  end if;
                end if;
             end if;
 
index 56171e27e3a11cc4fa20dc06125a137d2a1fc36a..f83d9ee3fea01159e34f4013de0d565a7a66a801 100644 (file)
@@ -6691,6 +6691,36 @@ package body Sem_Util is
       end if;
    end Explain_Limited_Type;
 
+   ---------------------------------------
+   -- Expression_Of_Expression_Function --
+   ---------------------------------------
+
+   function Expression_Of_Expression_Function
+     (Subp : Entity_Id) return Node_Id
+   is
+      Expr_Func : Node_Id;
+
+   begin
+      pragma Assert (Is_Expression_Function_Or_Completion (Subp));
+
+      if Nkind (Original_Node (Subprogram_Spec (Subp))) =
+           N_Expression_Function
+      then
+         Expr_Func := Original_Node (Subprogram_Spec (Subp));
+
+      elsif Nkind (Original_Node (Subprogram_Body (Subp))) =
+              N_Expression_Function
+      then
+         Expr_Func := Original_Node (Subprogram_Body (Subp));
+
+      else
+         pragma Assert (False);
+         null;
+      end if;
+
+      return Original_Node (Expression (Expr_Func));
+   end Expression_Of_Expression_Function;
+
    -------------------------------
    -- Extensions_Visible_Status --
    -------------------------------
@@ -13073,6 +13103,41 @@ package body Sem_Util is
         and then Defining_Identifier (Parent (E)) = Typ;
    end Is_Inherited_Operation_For_Type;
 
+   --------------------------------------
+   -- Is_Inlinable_Expression_Function --
+   --------------------------------------
+
+   function Is_Inlinable_Expression_Function
+     (Subp : Entity_Id) return Boolean
+   is
+      Return_Expr : Node_Id;
+
+   begin
+      if Is_Expression_Function_Or_Completion (Subp)
+        and then Has_Pragma_Inline_Always (Subp)
+        and then Needs_No_Actuals (Subp)
+        and then No (Contract (Subp))
+        and then not Is_Dispatching_Operation (Subp)
+        and then Needs_Finalization (Etype (Subp))
+        and then not Is_Class_Wide_Type (Etype (Subp))
+        and then not (Has_Invariants (Etype (Subp)))
+        and then Present (Subprogram_Body (Subp))
+        and then Was_Expression_Function (Subprogram_Body (Subp))
+      then
+         Return_Expr := Expression_Of_Expression_Function (Subp);
+
+         --  The returned object must not have a qualified expression and its
+         --  nominal subtype must be statically compatible with the result
+         --  subtype of the expression function.
+
+         return
+           Nkind (Return_Expr) = N_Identifier
+             and then Etype (Return_Expr) = Etype (Subp);
+      end if;
+
+      return False;
+   end Is_Inlinable_Expression_Function;
+
    -----------------
    -- Is_Iterator --
    -----------------
index 5b661c97e8bdac6acfe00b6a7d9675a6b3d59921..826334042a4803543f553e6a61c4cf322553f6ed 100644 (file)
@@ -615,6 +615,10 @@ package Sem_Util is
    --  continuation lines to the message explaining why type T is limited.
    --  Messages are placed at node N.
 
+   function Expression_Of_Expression_Function
+     (Subp : Entity_Id) return Node_Id;
+   --  Return the expression of expression function Subp
+
    type Extensions_Visible_Mode is
      (Extensions_Visible_None,
       --  Extensions_Visible does not yield a mode when SPARK_Mode is off. This
@@ -1489,6 +1493,20 @@ package Sem_Util is
    --  E is a subprogram. Return True is E is an implicit operation inherited
    --  by the derived type declaration for type Typ.
 
+   function Is_Inlinable_Expression_Function (Subp : Entity_Id) return Boolean;
+   --  Return True if Subp is an expression function that fulfills all the
+   --  following requirements for inlining:
+   --     1. pragma/aspect Inline_Always
+   --     2. No formals
+   --     3. No contracts
+   --     4. No dispatching primitive
+   --     5. Result subtype controlled (or with controlled components)
+   --     6. Result subtype not subject to type-invariant checks
+   --     7. Result subtype not a class-wide type
+   --     8. Return expression naming an object global to the function
+   --     9. Nominal subtype of the returned object statically compatible
+   --        with the result subtype of the expression function.
+
    function Is_Iterator (Typ : Entity_Id) return Boolean;
    --  AI05-0139-2: Check whether Typ is one of the predefined interfaces in
    --  Ada.Iterator_Interfaces, or it is derived from one.