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 <schonb...@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.
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,
