[Ada] New style check for overriding indicators.
Arnaud Charlet
charlet@adacore.com
Wed Aug 20 15:58:00 GMT 2008
A new style check has been introduced. When it is enabled, the compiler flags
the declarations or bodies of overriding operations, to enforce the rule that
the constructs should carry an explicit overriding indicator.
Compiling package Pack as follows:
gcc -c -gnat05 -gnatyO pack.adb
must yield the following:
pack.adb:6:14: (style)
missing "overriding" indicator in body of "Set_Up"
pack.adb:12:13: (style)
missing "overriding" indicator in body of "+"
pack.ads:8:14: (style)
missing "overriding" indicator in declaration of "Set_Up"
pack.ads:9:14: (style)
missing "overriding" indicator in declaration of "Initiate"
pack.ads:11:14: (style)
missing "overriding" indicator in declaration of "Try"
pack.ads:14:13: (style)
missing "overriding" indicator in declaration of "+"
---
package Pack is
type T1 is tagged null record;
procedure Set_Up (Obj : in out T1);
procedure Try (Obj : T1);
procedure Initiate (Obj : T1);
type T2 is new T1 with null record;
procedure Set_Up (Obj : in out T2); -- ERROR
procedure Initiate (Obj : T2); -- ERROR
procedure Attempt (Obj : T2);
procedure Try (Obj : T2) renames Attempt; -- ERROR
type Int is range -100 .. 100;
function "+" (X, Y : Int) return Int;
end; -- Pack;
---
package body Pack is
procedure Set_Up (Obj : in out T1) is begin null; end Set_Up;
procedure Initiate (Obj : T1) is begin null; end Initiate;
procedure Try (Obj : T1) is begin null; end Try;
procedure Set_Up (Obj : in out T2) is begin null; end Set_Up; -- ERROR
overriding
procedure Initiate (Obj : T2) is begin null; end Initiate; -- OK
procedure Attempt (Obj : T2) is begin null; end Attempt; -- OK
function "+" (X, Y : Int) return Int is
begin
return X;
end;
end Pack;
Tested on i686-pc-linux-gnu, committed on trunk
2008-08-20 Ed Schonberg <schonberg@adacore.com>
* styleg-c.ads, styleg-c.adb (Missing_Overriding): new procedure to
implement style check that overriding operations are explicitly marked
at such.
* style.ads (Missing_Overriding): new procedure that provides interface
to previous one.
* stylesw.ads, stylesw.adb: New style switch -gnatyO, to enable check
that the declaration or body of overriding operations carries an
explicit overriding indicator.
* sem_ch8.adb
(Analyze_Subprogram_Renaming): if operation is overriding, check whether
explicit indicator should be present.
* sem_ch6.adb (Verify_Overriding_Indicator,
Check_Overriding_Indicator): If operation is overriding, check whether
declaration and/or body of subprogram should be present
-------------- next part --------------
Index: style.ads
===================================================================
--- style.ads (revision 139262)
+++ style.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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- --
@@ -187,6 +187,11 @@ package Style is
-- Called after scanning a conditional expression that has at least one
-- level of parentheses around the entire expression.
+ procedure Missing_Overriding (N : Node_Id; E : Entity_Id)
+ renames Style_C_Inst.Missing_Overriding;
+ -- Called where N is the declaration or body of an overriding operation of
+ -- a tagged type, and does not have an overriding_indicator.
+
function Mode_In_Check return Boolean
renames Style_Inst.Mode_In_Check;
-- Determines whether style checking is active and the Mode_In_Check is
Index: stylesw.adb
===================================================================
--- stylesw.adb (revision 139262)
+++ stylesw.adb (working copy)
@@ -49,6 +49,7 @@ package body Stylesw is
Style_Check_Layout := False;
Style_Check_Max_Line_Length := False;
Style_Check_Max_Nesting_Level := False;
+ Style_Check_Missing_Overriding := False;
Style_Check_Mode_In := False;
Style_Check_Order_Subprograms := False;
Style_Check_Pragma_Casing := False;
@@ -123,6 +124,7 @@ package body Stylesw is
Add ('l', Style_Check_Layout);
Add ('n', Style_Check_Standard);
Add ('o', Style_Check_Order_Subprograms);
+ Add ('O', Style_Check_Missing_Overriding);
Add ('p', Style_Check_Pragma_Casing);
Add ('r', Style_Check_References);
Add ('s', Style_Check_Specs);
@@ -370,6 +372,9 @@ package body Stylesw is
when 'o' =>
Style_Check_Order_Subprograms := True;
+ when 'O' =>
+ Style_Check_Missing_Overriding := True;
+
when 'p' =>
Style_Check_Pragma_Casing := True;
Index: stylesw.ads
===================================================================
--- stylesw.ads (revision 139262)
+++ stylesw.ads (working copy)
@@ -156,8 +156,8 @@ package Stylesw is
-- with the IF keyword.
Style_Check_Max_Line_Length : Boolean := False;
- -- This can be set True by using the -gnatg or -gnatym/M switches. If
- -- it is True, it activates checking for a maximum line length of
+ -- This can be set True by using the -gnatg or -gnatym/M switches. If it is
+ -- True, it activates checking for a maximum line length of
-- Style_Max_Line_Length characters.
Style_Check_Max_Nesting_Level : Boolean := False;
@@ -165,6 +165,11 @@ package Stylesw is
-- (a value of zero resets it to False). If True, it activates checking
-- the maximum nesting level against Style_Max_Nesting_Level.
+ Style_Check_Missing_Overriding : Boolean := False;
+ -- This can be set True by using the -gnatyO switch. If it is True, then
+ -- "[not] overriding" is required in subprogram declarations and bodies
+ -- where appropriate.
+
Style_Check_Mode_In : Boolean := False;
-- This can be set True by using -gnatyI. If True, it activates checking
-- that mode IN is not used on its own (since it is the default).
Index: styleg-c.adb
===================================================================
--- styleg-c.adb (revision 139262)
+++ styleg-c.adb (working copy)
@@ -230,6 +230,23 @@ package body Styleg.C is
end if;
end Check_Identifier;
+ ------------------------
+ -- Missing_Overriding --
+ ------------------------
+
+ procedure Missing_Overriding (N : Node_Id; E : Entity_Id) is
+ begin
+ if Style_Check_Missing_Overriding and then Comes_From_Source (N) then
+ if Nkind (N) = N_Subprogram_Body then
+ Error_Msg_N
+ ("(style) missing OVERRIDING indicator in body of&", E);
+ else
+ Error_Msg_N
+ ("(style) missing OVERRIDING indicator in declaration of&", E);
+ end if;
+ end if;
+ end Missing_Overriding;
+
-----------------------------------
-- Subprogram_Not_In_Alpha_Order --
-----------------------------------
Index: styleg-c.ads
===================================================================
--- styleg-c.ads (revision 139262)
+++ styleg-c.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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- --
@@ -53,6 +53,10 @@ package Styleg.C is
-- spelling is to be checked against the Chars spelling in identifier node
-- Def (which may be either an N_Identifier, or N_Defining_Identifier node)
+ procedure Missing_Overriding (N : Node_Id; E : Entity_Id);
+ -- Called where N is the declaration or body of an overriding operation,
+ -- and the node does not have an overriding_indicator.
+
procedure Subprogram_Not_In_Alpha_Order (Name : Node_Id);
-- Called if Name is the name of a subprogram body in a package body
-- that is not in alphabetical order.
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 139262)
+++ sem_ch6.adb (working copy)
@@ -1724,6 +1724,12 @@ package body Sem_Ch6 is
"if subprogram is primitive",
Body_Spec);
end if;
+
+ elsif Style_Check
+ and then Is_Overriding_Operation (Spec_Id)
+ then
+ pragma Assert (Unit_Declaration_Node (Body_Id) = N);
+ Style.Missing_Overriding (N, Body_Id);
end if;
end Verify_Overriding_Indicator;
@@ -4167,6 +4173,10 @@ package body Sem_Ch6 is
Set_Is_Overriding_Operation (Subp);
end if;
+ if Style_Check and then not Must_Override (Spec) then
+ Style.Missing_Overriding (Decl, Subp);
+ end if;
+
-- If Subp is an operator, it may override a predefined operation.
-- In that case overridden_subp is empty because of our implicit
-- representation for predefined operators. We have to check whether the
@@ -4190,16 +4200,23 @@ package body Sem_Ch6 is
("subprogram & overrides predefined operator ", Spec, Subp);
end if;
- elsif Is_Overriding_Operation (Subp) then
- null;
-
elsif Must_Override (Spec) then
- if not Operator_Matches_Spec (Subp, Subp) then
- Error_Msg_NE ("subprogram & is not overriding", Spec, Subp);
-
- else
+ if Is_Overriding_Operation (Subp) then
Set_Is_Overriding_Operation (Subp);
+
+ elsif not Operator_Matches_Spec (Subp, Subp) then
+ Error_Msg_NE ("subprogram & is not overriding", Spec, Subp);
end if;
+
+ elsif not Error_Posted (Subp)
+ and then Style_Check
+ and then Operator_Matches_Spec (Subp, Subp)
+ and then
+ not Is_Predefined_File_Name
+ (Unit_File_Name (Get_Source_Unit (Subp)))
+ then
+ Set_Is_Overriding_Operation (Subp);
+ Style.Missing_Overriding (Decl, Subp);
end if;
elsif Must_Override (Spec) then
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb (revision 139290)
+++ sem_ch8.adb (working copy)
@@ -1822,16 +1822,19 @@ package body Sem_Ch8 is
-- Ada 2005: check overriding indicator
- if Must_Override (Specification (N))
- and then not Is_Overriding_Operation (Rename_Spec)
- then
- Error_Msg_NE ("subprogram& is not overriding", N, Rename_Spec);
+ if Is_Overriding_Operation (Rename_Spec) then
+ if Must_Not_Override (Specification (N)) then
+ Error_Msg_NE
+ ("subprogram& overrides inherited operation",
+ N, Rename_Spec);
+ elsif
+ Style_Check and then not Must_Override (Specification (N))
+ then
+ Style.Missing_Overriding (N, Rename_Spec);
+ end if;
- elsif Must_Not_Override (Specification (N))
- and then Is_Overriding_Operation (Rename_Spec)
- then
- Error_Msg_NE
- ("subprogram& overrides inherited operation", N, Rename_Spec);
+ elsif Must_Override (Specification (N)) then
+ Error_Msg_NE ("subprogram& is not overriding", N, Rename_Spec);
end if;
-- Normal subprogram renaming (not renaming as body)
More information about the Gcc-patches
mailing list