Package: gnat-gps
Version: 6.1.1-1
Severity: normal
Tags: patch upstream
Dear Maintainer,
While playing with GNATdoc, I identified some inaccuracies in the
generated HTML documentation for a simple Ada code:
1. The "not overriding" indicators appear as "overriding" indicators.
2. The line numbers shown for the subprogram declarations are wrong (one
unit too high) if there is an "overriding" or a "not overriding"
indicator on the previous line.
3. The rendering of the declaration of subtypes erroneously includes
preceding lines of code.
I managed to write a patch for package gnat-gps so that GNATdoc generates
an accurate documentation (for my simple Ada code at least).
The patch affects two files:
- gnatdoc/src/gnatdoc-frontend.adb
- gnatdoc/src/gnatdoc-backend-html.adb
I'm aware that the modification I made to
gnatdoc/src/gnatdoc-backend-html.adb to fix the wrong line numbers issue
is ugly but I believe it works well enough. Someone more comfortable
with the internal structures of GNATdoc could no doubt do better.
My simple Ada code, the gnat-gps patch and the generated documentation
before and after patching are available on this GitHub repository:
https://github.com/thierr26/gnatdoc_test
-- System Information:
Debian Release: 9.0
APT prefers unstable
APT policy: (500, 'unstable')
Architecture: amd64
(x86_64)
Kernel: Linux 4.9.0-2-amd64 (SMP w/2 CPU cores)
Locale: LANG=en_US.UTF-8, LC_CTYPE=en_US.UTF-8 (charmap=UTF-8)
Shell: /bin/sh linked to /bin/dash
Init: systemd (via /run/systemd/system)
Versions of packages gnat-gps depends on:
ii gnat-gps-common 6.1.1-1
ii gprbuild 2015-6
ii libc6 2.24-10
ii libcairo2 1.14.8-1
ii libgcc1 1:6.3.0-14
ii libgdk-pixbuf2.0-0 2.36.5-2
ii libglib2.0-0 2.50.3-2
ii libgnat-6 6.3.0-14
ii libgnatcoll-gtk1.7 1.7gpl2015-2+b3
ii libgnatcoll-iconv1.7 1.7gpl2015-2+b3
ii libgnatcoll-python1.7 1.7gpl2015-2+b3
ii libgnatcoll-sqlite-bin 1.7gpl2015-2+b3
ii libgnatcoll-sqlite1.7 1.7gpl2015-2+b3
ii libgnatcoll1.7 1.7gpl2015-2+b3
ii libgnatprj6 6.3.0-14
ii libgnatvsn6 6.3.0-14
ii libgtk-3-0 3.22.12-1
ii libgtkada3.8.3 3.8.3-1+b3
ii libpango-1.0-0 1.40.5-1
ii libtemplates-parser11.10.1 11.10-4
ii libxmlada-dom4.5.2015 4.5.2015-8+b2
ii libxmlada-input-sources4.5.2015 4.5.2015-8+b2
ii libxmlada-sax4.5.2015 4.5.2015-8+b2
ii libxmlada-unicode4.5.2015 4.5.2015-8+b2
ii python-gi 3.22.0-2
Versions of packages gnat-gps recommends:
ii gdb-minimal 7.12-6
ii gnat 6.1
ii gnat-gps-doc 6.1.1-1
ii python-jedi 0.10.0~git1+f05c071-1
ii python-pep8 1.7.0-4
gnat-gps suggests no packages.
-- no debconf information
--- a/gnatdoc/src/gnatdoc-backend-html.adb
+++ b/gnatdoc/src/gnatdoc-backend-html.adb
@@ -938,12 +938,45 @@
declare
Buffer : aliased String := To_String (Get_Src (E));
Code : JSON_Value;
+ Line : Positive := LL.Get_Location (E).Line;
+ Start_Col : Positive;
begin
+ if Buffer'Length > 0
+ and then (Get_Kind (E) = E_Procedure
+ or else Get_Kind (E) = E_Function
+ or else Get_Kind (E) = E_Entry) then
+ Start_Col := Buffer'First;
+ while (Buffer (Start_Col) = ' '
+ or else Buffer (Start_Col) = ASCII.HT)
+ and then Start_Col < Buffer'Last loop
+ Start_Col := Start_Col + 1;
+ end loop;
+ if Buffer (Start_Col) /= ' '
+ and then Buffer (Start_Col) /= ASCII.HT
+ and then Buffer'Last >= Start_Col + 11
+ and then (Buffer (Start_Col + 10) = ASCII.LF
+ or else Buffer (Start_Col + 11) = ASCII.LF) then
+ if Buffer (Start_Col .. Start_Col + 9)
+ = "overriding" then
+ Line := Line - 1;
+ end if;
+ end if;
+ if Buffer (Start_Col) /= ' '
+ and then Buffer (Start_Col) /= ASCII.HT
+ and then Buffer'Last >= Start_Col + 15
+ and then (Buffer (Start_Col + 14) = ASCII.LF
+ or else Buffer (Start_Col + 15) = ASCII.LF) then
+ if Buffer (Start_Col .. Start_Col + 13)
+ = "not overriding" then
+ Line := Line - 1;
+ end if;
+ end if;
+ end if;
Self.Print_Source_Code
(Tree.File,
Buffer'Unchecked_Access,
- LL.Get_Location (E).Line,
+ Line,
Printer,
Code);
Prepend (Description, Code);
--- a/gnatdoc/src/gnatdoc-frontend.adb
+++ b/gnatdoc/src/gnatdoc-frontend.adb
@@ -71,6 +71,7 @@
Tok_Is,
Tok_Limited,
Tok_New,
+ Tok_Not,
Tok_Null,
Tok_Overriding,
Tok_Others,
@@ -1287,6 +1288,8 @@
Cursor : Extended_Cursor.Extended_Cursor;
Last_Idx : Natural := 0;
Par_Count : Natural := 0;
+ Prev_Prev_Token : Tokens := Tok_Unknown;
+ Prev_Prev_Token_Loc : Source_Location;
Prev_Token : Tokens := Tok_Unknown;
Prev_Token_Loc : Source_Location;
Token : Tokens := Tok_Unknown;
@@ -1340,12 +1343,14 @@
procedure Clear_Parser_State is
No_Source_Location : constant Source_Location := (0, 0, 0);
begin
- Last_Idx := 0;
- Par_Count := 0;
- Prev_Token := Tok_Unknown;
- Prev_Token_Loc := No_Source_Location;
- Token := Tok_Unknown;
- Token_Loc := No_Source_Location;
+ Last_Idx := 0;
+ Par_Count := 0;
+ Prev_Prev_Token := Tok_Unknown;
+ Prev_Prev_Token_Loc := No_Source_Location;
+ Prev_Token := Tok_Unknown;
+ Prev_Token_Loc := No_Source_Location;
+ Token := Tok_Unknown;
+ Token_Loc := No_Source_Location;
Nested_Variants_Count := 0;
In_Compilation_Unit := False;
@@ -2982,7 +2987,8 @@
end if;
end;
- when Tok_Type =>
+ when Tok_Type |
+ Tok_Subtype =>
if Prev_Token = Tok_Task
or else Prev_Token = Tok_Protected
then
@@ -3002,8 +3008,13 @@
Clear_Src;
if Prev_Token = Tok_Overriding then
- Append_Src
- ("overriding", Prev_Token_Loc.Column);
+ if Prev_Prev_Token = Tok_Not then
+ Append_Src
+ ("not overriding", Prev_Prev_Token_Loc.Column);
+ else
+ Append_Src
+ ("overriding", Prev_Token_Loc.Column);
+ end if;
if Prev_Token_Loc.Line = Sloc_Start.Line then
Append_Src (" " & S);
@@ -3102,6 +3113,8 @@
procedure Update_Prev_Known_Token is
begin
if Token /= Tok_Unknown then
+ Prev_Prev_Token := Prev_Token;
+ Prev_Prev_Token_Loc := Prev_Token_Loc;
Prev_Token := Token;
Prev_Token_Loc := Token_Loc;
end if;
@@ -4242,6 +4255,8 @@
procedure Update_Prev_Known_Token is
begin
if Token /= Tok_Unknown then
+ Prev_Prev_Token := Prev_Token;
+ Prev_Prev_Token_Loc := Prev_Token_Loc;
Prev_Token := Token;
Prev_Token_Loc := Token_Loc;
end if;
