1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196 | ------------------------------------------------------------------------------
-- GNAT Documentation Generation Tool --
-- --
-- Copyright (C) 2022-2023, AdaCore --
-- --
-- This is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. This software is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
-- License for more details. You should have received a copy of the GNU --
-- General Public License distributed with this software; see file --
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
-- of the license. --
------------------------------------------------------------------------------
-- Test driver to run documentation extractor on all supported nodes of the
-- unit tree and dump content of the extracted documentation.
with Ada.Text_IO;
with Ada.Wide_Wide_Text_IO; use Ada.Wide_Wide_Text_IO;
with VSS.Application; use VSS.Application;
with VSS.JSON.Pull_Readers.Simple;
with VSS.JSON.Streams;
with VSS.Regular_Expressions;
with VSS.Strings; use VSS.Strings;
with VSS.Strings.Conversions; use VSS.Strings.Conversions;
with VSS.Text_Streams.File_Input;
with Libadalang.Analysis; use Libadalang.Analysis;
with Libadalang.Common; use Libadalang.Common;
with GNATdoc.Comments.Debug;
with GNATdoc.Comments.Extractor;
with GNATdoc.Comments.Options;
procedure Test_Extractor is
procedure Load_Options;
function Process (Node : Ada_Node'Class) return Visit_Status;
Options : GNATdoc.Comments.Options.Extractor_Options;
------------------
-- Load_Options --
------------------
procedure Load_Options is
use all type VSS.JSON.Streams.JSON_Stream_Element_Kind;
Stream : aliased VSS.Text_Streams.File_Input.File_Input_Text_Stream;
Reader : VSS.JSON.Pull_Readers.Simple.JSON_Simple_Pull_Reader;
Key : Virtual_String;
begin
Stream.Open (Arguments.Element (1), "utf-8");
Reader.Set_Stream (Stream'Unchecked_Access);
while not Reader.At_End loop
case Reader.Read_Next is
when Start_Document | End_Document | Start_Object | End_Object =>
null;
when Key_Name =>
Key := Reader.Key_Name;
when String_Value =>
if Key = "style" then
Options.Style :=
GNATdoc.Comments.Options.Documentation_Style'
Wide_Wide_Value
(To_Wide_Wide_String (Reader.String_Value));
elsif Key = "documentation_pattern" then
if not Reader.String_Value.Is_Empty then
Options.Pattern :=
VSS.Regular_Expressions.To_Regular_Expression
(Reader.String_Value);
if not Options.Pattern.Is_Valid then
raise Program_Error;
end if;
end if;
else
raise Program_Error;
end if;
when others =>
raise Program_Error
with VSS.JSON.Streams.JSON_Stream_Element_Kind'Image
(Reader.Element_Kind);
end case;
end loop;
end Load_Options;
-------------
-- Process --
-------------
function Process (Node : Ada_Node'Class) return Visit_Status is
procedure Extract_And_Dump;
-- Extract documentation and dump structured comment.
----------------------
-- Extract_And_Dump --
----------------------
procedure Extract_And_Dump is
begin
Put_Line ("**************************");
declare
Comment : GNATdoc.Comments.Structured_Comment_Access;
begin
Comment :=
GNATdoc.Comments.Extractor.Extract
(Node.As_Basic_Decl, Options);
GNATdoc.Comments.Debug.Dump (Comment.all);
GNATdoc.Comments.Free (Comment);
end;
Put_Line ("**************************");
end Extract_And_Dump;
begin
Ada.Text_IO.Put_Line (Node.Image);
case Node.Kind is
when Ada_Package_Decl =>
Extract_And_Dump;
return Into;
when Ada_Subp_Decl | Ada_Null_Subp_Decl | Ada_Abstract_Subp_Decl
| Ada_Expr_Function | Ada_Subp_Body
| Ada_Concrete_Type_Decl
| Ada_Exception_Decl
| Ada_Entry_Decl
| Ada_Entry_Body
=>
Extract_And_Dump;
return Over;
when Ada_Generic_Package_Decl | Ada_Generic_Subp_Decl =>
Extract_And_Dump;
return Into;
when Ada_Record_Rep_Clause =>
-- These nodes doesn't have own documentation, ignore them.
return Over;
when Ada_Single_Task_Decl | Ada_Task_Type_Decl
| Ada_Single_Protected_Decl | Ada_Protected_Type_Decl
| Ada_Protected_Body
=>
Extract_And_Dump;
return Into;
when Ada_Generic_Formal_Part =>
-- Formal part of the generic is processed in generic
-- declaration processing.
return Over;
when others =>
return Into;
end case;
end Process;
Context : Analysis_Context := Create_Context;
Unit : Analysis_Unit :=
Context.Get_From_File (To_UTF_8_String (Arguments.Element (2)));
begin
if Unit.Has_Diagnostics then
for D of Unit.Diagnostics loop
Ada.Text_IO.Put_Line (Unit.Format_GNU_Diagnostic (D));
end loop;
return;
end if;
Load_Options;
Unit.Root.Traverse (Process'Access);
end Test_Extractor;
|