Aspect/pragma [Type_]Invariant may be placed illegally on a public type or
a private type without public declaration. This patch gives a different error
message for each case. Now, compiling the following code generates 4 different
messages:
$ gcc -c -gnat12 inv.ads
inv.ads:5:11: aspect "Type_Invariant" only allowed for private type
inv.ads:9:11: aspect "Invariant" only allowed for private type
inv.ads:14:11: aspect "Type_Invariant" only allowed for private type declared
in visible part
inv.ads:18:11: aspect "Invariant" only allowed for private type declared in
visible part
---
1 package Inv is
2 type Wrap is record
3 X : Integer;
4 end record
5 with Type_Invariant => X mod 2 = 1;
6 type Wrap2 is record
7 X : Integer;
8 end record
9 with Invariant => X mod 2 = 1;
10 private
11 type Wrap3 is record
12 X : Integer;
13 end record
14 with Type_Invariant => X mod 2 = 1;
15 type Wrap4 is record
16 X : Integer;
17 end record
18 with Invariant => X mod 2 = 1;
19 end Inv;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-06 Yannick Moy <m...@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specifications, case
Aspect_Invariant): Do not issue error at this point on illegal
pragma placement, as this is checked later on when analyzing
the corresponding pragma.
* sem_prag.adb (Error_Pragma_Arg_Alternate_Name): New procedure
similar to Error_Pragma_Arg, except the source name of the
aspect/pragma to use in warnings may be equal to parameter
Alt_Name (Analyze_Pragma, case Pragma_Invariant): refine error
message to distinguish source name of pragma/aspect, and whether
the illegality resides in the type being public, or being private
without a public declaration
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 178579)
+++ sem_prag.adb (working copy)
@@ -29,63 +29,65 @@
-- to complete the syntax checks. Certain pragmas are handled partially or
-- completely by the parser (see Par.Prag for further details).
-with Atree; use Atree;
-with Casing; use Casing;
-with Checks; use Checks;
-with Csets; use Csets;
-with Debug; use Debug;
-with Einfo; use Einfo;
-with Elists; use Elists;
-with Errout; use Errout;
-with Exp_Dist; use Exp_Dist;
-with Exp_Util; use Exp_Util;
-with Freeze; use Freeze;
-with Lib; use Lib;
-with Lib.Writ; use Lib.Writ;
-with Lib.Xref; use Lib.Xref;
-with Namet.Sp; use Namet.Sp;
-with Nlists; use Nlists;
-with Nmake; use Nmake;
-with Opt; use Opt;
-with Output; use Output;
-with Par_SCO; use Par_SCO;
-with Restrict; use Restrict;
-with Rident; use Rident;
-with Rtsfind; use Rtsfind;
-with Sem; use Sem;
-with Sem_Aux; use Sem_Aux;
-with Sem_Ch3; use Sem_Ch3;
-with Sem_Ch6; use Sem_Ch6;
-with Sem_Ch8; use Sem_Ch8;
-with Sem_Ch12; use Sem_Ch12;
-with Sem_Ch13; use Sem_Ch13;
-with Sem_Disp; use Sem_Disp;
-with Sem_Dist; use Sem_Dist;
-with Sem_Elim; use Sem_Elim;
-with Sem_Eval; use Sem_Eval;
-with Sem_Intr; use Sem_Intr;
-with Sem_Mech; use Sem_Mech;
-with Sem_Res; use Sem_Res;
-with Sem_Type; use Sem_Type;
-with Sem_Util; use Sem_Util;
-with Sem_VFpt; use Sem_VFpt;
-with Sem_Warn; use Sem_Warn;
-with Stand; use Stand;
-with Sinfo; use Sinfo;
-with Sinfo.CN; use Sinfo.CN;
-with Sinput; use Sinput;
-with Snames; use Snames;
-with Stringt; use Stringt;
-with Stylesw; use Stylesw;
+with System.Case_Util;
+
+with Atree; use Atree;
+with Casing; use Casing;
+with Checks; use Checks;
+with Csets; use Csets;
+with Debug; use Debug;
+with Einfo; use Einfo;
+with Elists; use Elists;
+with Errout; use Errout;
+with Exp_Dist; use Exp_Dist;
+with Exp_Util; use Exp_Util;
+with Freeze; use Freeze;
+with Lib; use Lib;
+with Lib.Writ; use Lib.Writ;
+with Lib.Xref; use Lib.Xref;
+with Namet.Sp; use Namet.Sp;
+with Nlists; use Nlists;
+with Nmake; use Nmake;
+with Opt; use Opt;
+with Output; use Output;
+with Par_SCO; use Par_SCO;
+with Restrict; use Restrict;
+with Rident; use Rident;
+with Rtsfind; use Rtsfind;
+with Sem; use Sem;
+with Sem_Aux; use Sem_Aux;
+with Sem_Ch3; use Sem_Ch3;
+with Sem_Ch6; use Sem_Ch6;
+with Sem_Ch8; use Sem_Ch8;
+with Sem_Ch12; use Sem_Ch12;
+with Sem_Ch13; use Sem_Ch13;
+with Sem_Disp; use Sem_Disp;
+with Sem_Dist; use Sem_Dist;
+with Sem_Elim; use Sem_Elim;
+with Sem_Eval; use Sem_Eval;
+with Sem_Intr; use Sem_Intr;
+with Sem_Mech; use Sem_Mech;
+with Sem_Res; use Sem_Res;
+with Sem_Type; use Sem_Type;
+with Sem_Util; use Sem_Util;
+with Sem_VFpt; use Sem_VFpt;
+with Sem_Warn; use Sem_Warn;
+with Stand; use Stand;
+with Sinfo; use Sinfo;
+with Sinfo.CN; use Sinfo.CN;
+with Sinput; use Sinput;
+with Snames; use Snames;
+with Stringt; use Stringt;
+with Stylesw; use Stylesw;
with Table;
-with Targparm; use Targparm;
-with Tbuild; use Tbuild;
+with Targparm; use Targparm;
+with Tbuild; use Tbuild;
with Ttypes;
-with Uintp; use Uintp;
-with Uname; use Uname;
-with Urealp; use Urealp;
-with Validsw; use Validsw;
-with Warnsw; use Warnsw;
+with Uintp; use Uintp;
+with Uname; use Uname;
+with Urealp; use Urealp;
+with Validsw; use Validsw;
+with Warnsw; use Warnsw;
package body Sem_Prag is
@@ -646,6 +648,17 @@
-- Similar to above form of Error_Pragma_Arg except that two messages
-- are provided, the second is a continuation comment starting with \.
+ procedure Error_Pragma_Arg_Alternate_Name
+ (Msg : String;
+ Arg : Node_Id;
+ Alt_Name : Name_Id);
+ pragma No_Return (Error_Pragma_Arg_Alternate_Name);
+ -- Outputs error message for current pragma, similar to
+ -- Error_Pragma_Arg, except the source name of the aspect/pragma to use
+ -- in warnings may be equal to Alt_Name (which should be equivalent to
+ -- the name used in pragma). The location for the source name should be
+ -- pointed to by Arg.
+
procedure Error_Pragma_Arg_Ident (Msg : String; Arg : Node_Id);
pragma No_Return (Error_Pragma_Arg_Ident);
-- Outputs error message for current pragma. The message may contain
@@ -2427,6 +2440,34 @@
Error_Pragma_Arg (Msg2, Arg);
end Error_Pragma_Arg;
+ -------------------------------------
+ -- Error_Pragma_Arg_Alternate_Name --
+ -------------------------------------
+
+ procedure Error_Pragma_Arg_Alternate_Name
+ (Msg : String;
+ Arg : Node_Id;
+ Alt_Name : Name_Id)
+ is
+ MsgF : String := Msg;
+ Source_Name : String := Exact_Source_Name (Sloc (Arg));
+ Alter_Name : String := Get_Name_String (Alt_Name);
+
+ begin
+ System.Case_Util.To_Lower (Source_Name);
+ System.Case_Util.To_Lower (Alter_Name);
+
+ if Source_Name = Alter_Name then
+ Error_Msg_Name_1 := Alt_Name;
+ else
+ Error_Msg_Name_1 := Pname;
+ end if;
+
+ Fix_Error (MsgF);
+ Error_Msg_N (MsgF, Get_Pragma_Arg (Arg));
+ raise Pragma_Exit;
+ end Error_Pragma_Arg_Alternate_Name;
+
----------------------------
-- Error_Pragma_Arg_Ident --
----------------------------
@@ -10140,9 +10181,16 @@
then
null;
+ elsif In_Private_Part (Current_Scope) then
+ Error_Pragma_Arg_Alternate_Name
+ ("pragma% only allowed for private type " &
+ "declared in visible part", Arg1,
+ Alt_Name => Name_Type_Invariant);
+
else
- Error_Pragma_Arg
- ("pragma% only allowed for private type", Arg1);
+ Error_Pragma_Arg_Alternate_Name
+ ("pragma% only allowed for private type", Arg1,
+ Alt_Name => Name_Type_Invariant);
end if;
-- Note that the type has at least one invariant, and also that
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 178578)
+++ sem_ch13.adb (working copy)
@@ -1289,26 +1289,10 @@
when Aspect_Invariant |
Aspect_Type_Invariant =>
- -- Check placement legality: An invariant must apply to a
- -- private type, or appear in the private part of a spec.
- -- Analysis of the pragma will verify that in the private
- -- part it applies to a completion.
+ -- Analysis of the pragma will verify placement legality:
+ -- an invariant must apply to a private type, or appear in
+ -- the private part of a spec and apply to a completion.
- if Nkind_In (N, N_Private_Type_Declaration,
- N_Private_Extension_Declaration)
- then
- null;
-
- elsif Nkind (N) = N_Full_Type_Declaration
- and then In_Private_Part (Current_Scope)
- then
- null;
-
- else
- Error_Msg_N
- ("invariant aspect must apply to a private type", N);
- end if;
-
-- Construct the pragma
Aitem :=
