ada/gnatdoc
0
0
Fork 0
mirror of https://github.com/AdaCore/gnatdoc.git synced 2026-02-12 13:11:07 -08:00
Code Issues Packages Projects Releases Wiki Activity

Test backend and switch to output list of project files.

Browse Source
This commit is contained in:
Vadim Godunko
2024-10-02 12:52:28 +04:00
parent 31c10e3e66
commit cb9be27e7f
5 changed files with 183 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
source/backend/gnatdoc-backend-registry.adb
View File

@@ -17,6 +17,7 @@
with GNATdoc.Backend.HTML;
with GNATdoc.Backend.RST.PT;
with GNATdoc.Backend.Test;
package body GNATdoc.Backend.Registry is
@@ -38,6 +39,9 @@ package body GNATdoc.Backend.Registry is
elsif Name = "rstpt" then
return new GNATdoc.Backend.RST.PT.PT_RST_Backend;
elsif Name = "test" then
return new GNATdoc.Backend.Test.Test_Backend;
end if;
return null;

79
source/backend/gnatdoc-backend-test.adb Normal file
View File

@@ -0,0 +1,79 @@
------------------------------------------------------------------------------
-- GNAT Documentation Generation Tool --
-- --
-- Copyright (C) 2024, 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. --
------------------------------------------------------------------------------
with GNATdoc.Projects;
package body GNATdoc.Backend.Test is
Dump_Projects_Option : constant VSS.Command_Line.Binary_Option :=
(Short_Name => <>,
Long_Name => "test-dump-projects",
Description => "Dump list of projects to be processed/excluded");
------------------------------
-- Add_Command_Line_Options --
------------------------------
overriding procedure Add_Command_Line_Options
(Self : Test_Backend;
Parser : in out VSS.Command_Line.Parsers.Command_Line_Parser'Class) is
begin
Parser.Add_Option (Dump_Projects_Option);
end Add_Command_Line_Options;
--------------
-- Generate --
--------------
overriding procedure Generate (Self : in out Test_Backend) is
begin
if Self.Dump_Projects then
GNATdoc.Projects.Test_Dump_Projects;
end if;
end Generate;
----------------
-- Initialize --
----------------
overriding procedure Initialize (Self : in out Test_Backend) is
begin
Abstract_Backend (Self).Initialize;
end Initialize;
----------
-- Name --
----------
overriding function Name
(Self : in out Test_Backend) return VSS.Strings.Virtual_String is
begin
return "test";
end Name;
----------------------------------
-- Process_Command_Line_Options --
----------------------------------
overriding procedure Process_Command_Line_Options
(Self : in out Test_Backend;
Parser : VSS.Command_Line.Parsers.Command_Line_Parser'Class) is
begin
Self.Dump_Projects := Parser.Is_Specified (Dump_Projects_Option);
end Process_Command_Line_Options;
end GNATdoc.Backend.Test;

43
source/backend/gnatdoc-backend-test.ads Normal file
View File

@@ -0,0 +1,43 @@
------------------------------------------------------------------------------
-- GNAT Documentation Generation Tool --
-- --
-- Copyright (C) 2024, 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. --
------------------------------------------------------------------------------
package GNATdoc.Backend.Test is
type Test_Backend is new Abstract_Backend with private;
private
type Test_Backend is new Abstract_Backend with record
Dump_Projects : Boolean := False;
end record;
overriding function Name
(Self : in out Test_Backend) return VSS.Strings.Virtual_String;
overriding procedure Add_Command_Line_Options
(Self : Test_Backend;
Parser : in out VSS.Command_Line.Parsers.Command_Line_Parser'Class);
overriding procedure Process_Command_Line_Options
(Self : in out Test_Backend;
Parser : VSS.Command_Line.Parsers.Command_Line_Parser'Class);
overriding procedure Initialize (Self : in out Test_Backend);
overriding procedure Generate (Self : in out Test_Backend);
end GNATdoc.Backend.Test;

52
source/gnatdoc/gnatdoc-projects.adb
View File

@@ -47,11 +47,13 @@ with GPR2.Build.Source.Sets;
with VSS.Application;
with VSS.Command_Line;
with VSS.Regular_Expressions;
with VSS.String_Vectors;
with VSS.Strings.Conversions;
with VSS.Strings.Formatters.Integers;
with VSS.Strings.Formatters.Strings;
with VSS.Strings.Formatters.Virtual_Files;
with VSS.Strings.Templates;
with VSS.Text_Streams.Standards;
with GNATdoc.Command_Line;
with GNATdoc.Messages;
@@ -288,6 +290,7 @@ package body GNATdoc.Projects is
(Base_Name => GNATCOLL.VFS.Filesystem_String (Item.Text),
Base_Dir =>
Project_Tree.Root_Project.Dir_Name.Filesystem_String);
if not Project_Names.Contains (This_File) then
Report_Error_On_Attribute
("unable to resolve project file path specified in "
@@ -514,6 +517,55 @@ package body GNATdoc.Projects is
"used by the root project.");
end Register_Attributes;
------------------------
-- Test_Dump_Projects --
------------------------
procedure Test_Dump_Projects is
Output : VSS.Text_Streams.Output_Text_Stream'Class
renames VSS.Text_Streams.Standards.Standard_Output;
Template : VSS.Strings.Templates.Virtual_String_Template :=
"{}{}";
Success : Boolean := True;
begin
for View of Project_Tree loop
declare
File : constant GNATCOLL.VFS.Virtual_File :=
View.Path_Name.Virtual_File;
List : VSS.String_Vectors.Virtual_String_Vector;
Image : VSS.Strings.Virtual_String;
begin
if View.Is_Externally_Built then
List.Append ("externally build");
end if;
if Exclude_Project_Files.Contains (File) then
List.Append ("exclude list");
end if;
if not List.Is_Empty then
Image := " [";
Image.Append (List.First_Element);
for J in List.First_Index + 1 .. List.Last_Index loop
Image.Append (", ");
Image.Append (List (J));
end loop;
Image.Append (']');
end if;
Output.Put_Line
(Template.Format
(VSS.Strings.Formatters.Virtual_Files.Image (File),
VSS.Strings.Formatters.Strings.Image (Image)),
Success);
end;
end loop;
end Test_Dump_Projects;
-----------------------------
-- Unit_Requested_Callback --
-----------------------------

5
source/gnatdoc/gnatdoc-projects.ads
View File

@@ -49,4 +49,9 @@ package GNATdoc.Projects is
return GNATCOLL.VFS.Virtual_File;
-- Return custom resources directory if specified.
procedure Test_Dump_Projects;
-- Dump projects to be processed.
--
-- This subprogram is intended to be used for testing purpose.
end GNATdoc.Projects;