===================================================================
@@ -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.
===================================================================
@@ -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.
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.