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 <de...@adacore.com> * debug.adb: Document -gnatd.k. * erroutc.adb (Set_Msg_Insertion_Line_Number): Implement -gnatd.k.
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.