[Ada] Implement -gnatd.k to suppress internal line numbers
Arnaud Charlet
charlet@adacore.com
Tue May 26 10:39:00 GMT 2015
The new debug switch -gnatd.k suppresses occurrences of line numbers
within error messages referring to a location in an internal file.
The following test normally compiles as follows (with -gnatj55)
1. with Ada.Text_IO; use Ada.Text_IO;
2. with Ada.Containers.Vectors;
3. procedure cdm is
4.
5. generic
6. type TElement is digits <>;
7. package Matrices is
8. type Matrice (<>) is tagged private;
9. function Cree_Matrice
10. (Lignes, Colonnes : Positive;
11. Valeur : TElement := 0.0)
12. return Matrice;
13. function Nb_Lignes (M : Matrice) return Natural;
14. function Nb_Colonnes (M : Matrice) return Natural;
15. function Element
16. (M : Matrice; Ligne, Colonne : Positive)
17. return TElement
18. with Pre => Ligne <= Nb_Lignes(M);
19. procedure Affiche (M : Matrice);
20. private
21. package IntMatrices is new
22. Ada.Containers.Vectors (Positive, TElement);
23. type Matrice is new IntMatrices.Vector with record
|
>>> type must be declared abstract or "copy"
overridden, "copy" has been inherited from
subprogram at a-convec.ads:180, instance
at line 21
24. Lignes, Colonnes : Natural;
25. end record;
26. function To_Vector
27. (Length : Ada.Containers.Count_Type) return Matrice;
28. function To_Vector
29. (New_Item : TElement;
30. Length : Ada.Containers.Count_Type)
31. return Matrice;
32. function "&" (Left, Right : Matrice) return Matrice;
33. function "&" (Left : Matrice; Right : TElement)
34. return Matrice;
35. function "&" (Left : TElement; Right : Matrice)
36. return Matrice;
37. function "&" (Left, Right : TElement) return Matrice;
38. end Matrices;
39.
40. package body Matrices is
41.
42. function Cree_Matrice
43. (Lignes, Colonnes : Positive;
44. Valeur : TElement := 0.0)
45. return Matrice
46. is
47. begin
48. return (IntMatrices.To_Vector
49. (Valeur,
50. Ada.Containers.Count_Type
51. (Lignes * Colonnes))
52. with Lignes, Colonnes);
53. end Cree_Matrice;
54.
55. function Nb_Lignes (M : Matrice) return Natural is
56. begin
57. return M.Lignes;
58. end Nb_Lignes;
59.
60. function Nb_Colonnes (M : Matrice) return Natural is
61. begin
62. return M.Colonnes;
63. end Nb_Colonnes;
64.
65. function Element
66. (M : Matrice; Ligne, Colonne : Positive)
67. return TElement is
68. begin
69. if Ligne > M.Lignes or Colonne > M.Colonnes then
70. raise Constraint_Error;
71. end if;
72. return Element (M, (Ligne - 1) * M.Colonnes + Colonne);
73. end Element;
74.
75. procedure Affiche (M : Matrice) is
76. begin
77. for I in 1 .. M.Lignes loop
78. for J in 1 .. M.Colonnes loop
79. Ada.Text_IO.Put (TElement'Image (Element (M, I, J))
80. end loop;
81. Ada.Text_IO.New_Line;
82. end loop;
83. Ada.Text_IO.New_Line;
84. end Affiche;
85.
86. function To_Vector
87. (Length : Ada.Containers.Count_Type)
88. return Matrice is
89. begin
90. return (IntMatrices.To_Vector (Length) with 0, 0);
91. end To_Vector;
92.
93. function To_Vector
94. (New_Item : TElement;
95. Length : Ada.Containers.Count_Type)
96. return Matrice
97. is
98. begin
99. return (IntMatrices.To_Vector
100. (New_Item, Length) with 0, 0);
101. end To_Vector;
102.
103. function "&" (Left, Right : Matrice) return Matrice is
104. begin
105. return (IntMatrices.
106. "&" (IntMatrices.Vector (Left),
107. IntMatrices.Vector (Right)) with 0, 0);
108. end "&";
109.
110. function "&" (Left : Matrice; Right : TElement)
111. return Matrice is
112. begin
113. return (IntMatrices."&"
114. (IntMatrices.Vector (Left), Right) with 0, 0);
115. end "&";
116.
117. function "&" (Left : TElement; Right : Matrice)
118. return Matrice is
119. begin
120. return (IntMatrices."&"
121. (Left, IntMatrices.Vector (Right)) with 0, 0);
122. end "&";
123.
124. function "&" (Left, Right : TElement) return Matrice is
125. begin
126. return (IntMatrices."&" (Left, Right) with 0, 0);
127. end "&";
128. end Matrices;
129.
130. package MatricesReelles is new Matrices (Float);
131. use MatricesReelles;
132. M2 : constant Matrice := Cree_Matrice (4, 4);
133. begin
134. Put_Line (Element (M2, 2, 3)'Img);
135. New_Line;
136. Affiche (M2);
137. end cdm;
with -gnatd.k, the error message is changed to:
cdm.adb:23:12: type must be declared abstract or
"copy" overridden, "copy" has been
inherited from subprogram at
a-convec.ads, instance at line 21
Tested on x86_64-pc-linux-gnu, committed on trunk
2015-05-26 Robert Dewar <dewar@adacore.com>
* debug.adb: Document -gnatd.k.
* erroutc.adb (Set_Msg_Insertion_Line_Number): Implement -gnatd.k.
-------------- next part --------------
Index: debug.adb
===================================================================
--- debug.adb (revision 223661)
+++ debug.adb (working copy)
@@ -101,7 +101,7 @@
-- d.h Minimize the creation of public internal symbols for concatenation
-- d.i Ignore Warnings pragmas
-- d.j Generate listing of frontend inlined calls
- -- d.k
+ -- d.k Kill referenced run-time library unit line numbers
-- d.l Use Ada 95 semantics for limited function returns
-- d.m For -gnatl, print full source only for main unit
-- d.n Print source file names
@@ -534,6 +534,9 @@
-- be used in particular to disable Warnings (Off) to check if any of
-- these statements are inappropriate.
+ -- d.k If an error message contains a reference to a location in an
+ -- internal unit, then suppress the line number in this reference.
+
-- d.j Generate listing of frontend inlined calls and inline calls passed
-- to the backend. This is useful to locate skipped calls that must be
-- inlined by the frontend.
Index: erroutc.adb
===================================================================
--- erroutc.adb (revision 223661)
+++ erroutc.adb (working copy)
@@ -34,6 +34,7 @@
with Csets; use Csets;
with Debug; use Debug;
with Err_Vars; use Err_Vars;
+with Fname; use Fname;
with Namet; use Namet;
with Opt; use Opt;
with Output; use Output;
@@ -1035,6 +1036,8 @@
procedure Set_Msg_Insertion_Line_Number (Loc, Flag : Source_Ptr) is
Sindex_Loc : Source_File_Index;
Sindex_Flag : Source_File_Index;
+ Fname : File_Name_Type;
+ Int_File : Boolean;
procedure Set_At;
-- Outputs "at " unless last characters in buffer are " from ". Certain
@@ -1083,22 +1086,25 @@
if Full_File_Name (Sindex_Loc) /= Full_File_Name (Sindex_Flag) then
Set_At;
- Get_Name_String
- (Reference_Name (Get_Source_File_Index (Loc)));
+ Fname := Reference_Name (Get_Source_File_Index (Loc));
+ Int_File := Is_Internal_File_Name (Fname);
+ Get_Name_String (Fname);
Set_Msg_Name_Buffer;
- Set_Msg_Char (':');
+ if not (Int_File and Debug_Flag_Dot_K) then
+ Set_Msg_Char (':');
+ Set_Msg_Int (Int (Get_Logical_Line_Number (Loc)));
+ end if;
+
-- If in current file, add text "at line "
else
Set_At;
Set_Msg_Str ("line ");
+ Int_File := False;
+ Set_Msg_Int (Int (Get_Logical_Line_Number (Loc)));
end if;
- -- Output line number for reference
-
- Set_Msg_Int (Int (Get_Logical_Line_Number (Loc)));
-
-- Deal with the instantiation case. We may have a reference to,
-- e.g. a type, that is declared within a generic template, and
-- what we are really referring to is the occurrence in an instance.
More information about the Gcc-patches
mailing list