Patchwork [Ada] Checking for eliminated subprograms

login
register
mail settings
Submitter Arnaud Charlet
Date June 14, 2012, 10:56 a.m.
Message ID <20120614105649.GA24113@adacore.com>
Download mbox | patch
Permalink /patch/164914/
State New
Headers show

Comments

Arnaud Charlet - June 14, 2012, 10:56 a.m.
A reference to a subprogram that appears in a pragma Eliminate is not an error
if it appears within a default expression: the enclosing subprogram may itself
be eliminated. Previous to this patch, the check for default expressions was
performed when resolving a call, but not for attribute references.

Given the following gnat.adc file:

   pragma Eliminate (Elim, Default_Dispatch, Source_Location => "elim.ads:6");
   pragma Eliminate (Elim, G_Source_Type_New, Source_Location => "elim.ads:8");

the following must compile quietly:

   gnatmake -q -f a

---
with Elim;
procedure A is
begin
   null;
end;
---
package Elim is
   type Source_Dispatch_Func is access
     function return Boolean;

   function Default_Dispatch return Boolean;

   function G_Source_Type_New
     (Dispatch : Source_Dispatch_Func := Default_Dispatch'Access)
   return Boolean;

end Elim;
---
package body Elim is

   function Default_Dispatch return Boolean is
   begin
      return True;
   end Default_Dispatch;

   function G_Source_Type_New
     (Dispatch : Source_Dispatch_Func := Default_Dispatch'Access)
      return Boolean
   is
   begin
      return True;
   end G_Source_Type_New;
end Elim;

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

2012-06-14  Ed Schonberg  <schonberg@adacore.com>

	* sem_elim.adb (Check_For_Eliminated_Subprogram): Do not check within
	a default expression.
	* sem_res.adb (Resolve_Call): simplify code.

Patch

Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 188605)
+++ sem_res.adb	(working copy)
@@ -5839,14 +5839,11 @@ 
          Check_Restriction (No_Relative_Delay, N);
       end if;
 
-      --  Issue an error for a call to an eliminated subprogram. We skip this
-      --  in a spec expression, e.g. a call in a default parameter value, since
-      --  we are not really doing a call at this time. That's important because
-      --  the spec expression may itself belong to an eliminated subprogram.
+      --  Issue an error for a call to an eliminated subprogram.
+      --  The routine will not perform the check if the call appears within
+      --  a default expression.
 
-      if not In_Spec_Expression then
-         Check_For_Eliminated_Subprogram (Subp, Nam);
-      end if;
+      Check_For_Eliminated_Subprogram (Subp, Nam);
 
       --  In formal mode, the primitive operations of a tagged type or type
       --  extension do not include functions that return the tagged type.
Index: sem_elim.adb
===================================================================
--- sem_elim.adb	(revision 188605)
+++ sem_elim.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-2012, 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- --
@@ -724,6 +724,14 @@ 
       Enclosing_Subp : Entity_Id;
 
    begin
+      --  No check needed within a default expression for a formal, since this
+      --  is not really a use, and the expression (a call or attribute) may
+      --  never be used if the enclosing subprogram is itself eliminated.
+
+      if In_Spec_Expression then
+         return;
+      end if;
+
       if Is_Eliminated (Ultimate_Subp)
         and then not Inside_A_Generic
         and then not Is_Generic_Unit (Cunit_Entity (Current_Sem_Unit))
@@ -823,10 +831,10 @@ 
       Arg_Uname : Node_Id;
 
       function OK_Selected_Component (N : Node_Id) return Boolean;
-      --  Test if N is a selected component with all identifiers, or a
-      --  selected component whose selector is an operator symbol. As a
-      --  side effect if result is True, sets Num_Names to the number
-      --  of names present (identifiers and operator if any).
+      --  Test if N is a selected component with all identifiers, or a selected
+      --  component whose selector is an operator symbol. As a side effect if
+      --  result is True, sets Num_Names to the number of names present
+      --  (identifiers, and operator if any).
 
       ---------------------------
       -- OK_Selected_Component --