Patchwork [Ada] Implement Rational profile to support non-standard renaming declarations

login
register
mail settings
Submitter Arnaud Charlet
Date Feb. 6, 2013, 10:24 a.m.
Message ID <20130206102438.GA25551@adacore.com>
Download mbox | patch
Permalink /patch/218534/
State New
Headers show

Comments

Arnaud Charlet - Feb. 6, 2013, 10:24 a.m.
We introduce the profile Rational and the corresponding pragma to support
legacy Rational code that accepts subprogram renaming declarations that are
not conformant to the RM.
The following program, compiled with -gnatc, must generate the message:

   ren.ads:12:51: subprogram cannot rename itself

The program must compile quietly if the pragma is uncommented.

---
--  pragma Rational;
package Ren is
   package P is
      type T is null record;
      function F (Obj : T) return integer;
   end P;

   use P;
   type DT is new T;
   package RR renames Ren;

   function F (New_Parameter : DT) return Integer renames RR.F;
end;

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

2013-02-06  Ed Schonberg  <schonberg@adacore.com>

	* snames.ads-tmpl: Add Name_Rational and pragma Rational.
	* par-prag.adb: Recognize pragma Rational.
	* opt.ads (Rational_Profile): flag to control compatibility mode
	with Rational compiler.
	* sem_ch8.adb (Analyze_Subprogram_Renaming): When Rational profile
	is enable, accept renaming declarations where the new subprogram
	and the renamed entity have the same name.
	* sem_prag.adb (analyze_pragma): Add pragma Rational, and recognize
	Rational as a profile.

Patch

Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 195788)
+++ sem_prag.adb	(working copy)
@@ -13859,7 +13859,7 @@ 
 
          --  pragma Profile (profile_IDENTIFIER);
 
-         --  profile_IDENTIFIER => Restricted | Ravenscar
+         --  profile_IDENTIFIER => Restricted | Ravenscar | Rational
 
          when Pragma_Profile =>
             Ada_2005_Pragma;
@@ -13879,6 +13879,9 @@ 
                     (Restricted,
                      N, Warn => Treat_Restrictions_As_Warnings);
 
+               elsif Chars (Argx) = Name_Rational then
+                  Rational_Profile := True;
+
                elsif Chars (Argx) = Name_No_Implementation_Extensions then
                   Set_Profile_Restrictions
                     (No_Implementation_Extensions,
@@ -14275,6 +14278,15 @@ 
             end if;
          end;
 
+         --------------
+         -- Rational --
+         --------------
+
+         --  pragma Rational, for compatibility with foreign compiler
+
+         when Pragma_Rational =>
+            Rational_Profile := True;
+
          -----------------------
          -- Relative_Deadline --
          -----------------------
@@ -16599,6 +16611,7 @@ 
       Pragma_Pure_12                        => -1,
       Pragma_Pure_Function                  => -1,
       Pragma_Queuing_Policy                 => -1,
+      Pragma_Rational                       => -1,
       Pragma_Ravenscar                      => -1,
       Pragma_Relative_Deadline              => -1,
       Pragma_Remote_Access_Type             => -1,
Index: par-prag.adb
===================================================================
--- par-prag.adb	(revision 195784)
+++ par-prag.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -1245,6 +1245,7 @@ 
            Pragma_Remote_Call_Interface          |
            Pragma_Remote_Types                   |
            Pragma_Restricted_Run_Time            |
+           Pragma_Rational                       |
            Pragma_Ravenscar                      |
            Pragma_Reviewable                     |
            Pragma_Share_Generic                  |
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb	(revision 195784)
+++ sem_ch8.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -2804,18 +2804,25 @@ 
             end if;
          end if;
 
-         if not Is_Actual
-           and then (Old_S = New_S
-                      or else
-                        (Nkind (Nam) /= N_Expanded_Name
-                          and then Chars (Old_S) = Chars (New_S))
-                      or else
-                        (Nkind (Nam) = N_Expanded_Name
-                          and then Entity (Prefix (Nam)) = Current_Scope
-                          and then
-                            Chars (Selector_Name (Nam)) = Chars (New_S)))
+         if Is_Actual then
+            null;
+
+         --  The following is illegal, because F hides whatever other F may
+         --  be around:
+         --     function F (..)  renames F;
+
+         elsif Old_S = New_S
+           or else (Nkind (Nam) /= N_Expanded_Name
+                     and then Chars (Old_S) = Chars (New_S))
          then
             Error_Msg_N ("subprogram cannot rename itself", N);
+
+         elsif Nkind (Nam) = N_Expanded_Name
+           and then Entity (Prefix (Nam)) = Current_Scope
+           and then Chars (Selector_Name (Nam)) = Chars (New_S)
+           and then not Rational_Profile
+         then
+            Error_Msg_N ("subprogram cannot rename itself", N);
          end if;
 
          Set_Convention (New_S, Convention (Old_S));
Index: opt.ads
===================================================================
--- opt.ads	(revision 195784)
+++ opt.ads	(working copy)
@@ -1181,6 +1181,10 @@ 
    --  Set to True if the tool should not have any output if there are no
    --  errors or warnings.
 
+   Rational_Profile : Boolean := False;
+   --  GNAT
+   --  Set to True to enable compatibility mode with Rational compiler.
+
    Replace_In_Comments : Boolean := False;
    --  GNATPREP
    --  Set to True if -C switch used
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl	(revision 195784)
+++ snames.ads-tmpl	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                             T e m p l a t e                              --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2013, 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- --
@@ -422,6 +422,7 @@ 
    Name_Profile_Warnings               : constant Name_Id := N + $; -- GNAT
    Name_Propagate_Exceptions           : constant Name_Id := N + $; -- GNAT
    Name_Queuing_Policy                 : constant Name_Id := N + $;
+   Name_Rational                       : constant Name_Id := N + $; -- GNAT
    Name_Ravenscar                      : constant Name_Id := N + $; -- GNAT
    Name_Restricted_Run_Time            : constant Name_Id := N + $; -- GNAT
    Name_Restrictions                   : constant Name_Id := N + $;
@@ -1717,6 +1718,7 @@ 
       Pragma_Profile_Warnings,
       Pragma_Propagate_Exceptions,
       Pragma_Queuing_Policy,
+      Pragma_Rational,
       Pragma_Ravenscar,
       Pragma_Restricted_Run_Time,
       Pragma_Restrictions,