gnatcoverage/tools/gnatcov/command_line.adb at master · AdaCore/gnatcoverage · GitHub

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
------------------------------------------------------------------------------
--                                                                          --
--                               GNATcoverage                               --
--                                                                          --
--                     Copyright (C) 2015-2024, AdaCore                     --
--                                                                          --
-- GNATcoverage is free software; you can redistribute it and/or modify it  --
-- under terms of the GNU General Public License as published by the  Free  --
-- Software  Foundation;  either version 3,  or (at your option) any later  --
-- version. 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 Strings; use Strings;

package body Command_Line is

   -------------------
   -- Bool_Callback --
   -------------------

   procedure Bool_Callback
     (Result : in out Parsed_Arguments; Option : Bool_Options) is
   begin
      case Option is
         when Opt_Compiler_Prefix =>

            --  Passing --compiler-prefix overrides previously passed --prefix
            --  arguments.

            Result.String_Args (Opt_Prefix) := (Present => False);

         when Opt_Include         =>
            Result.Remaining_Args.Append (+"--include");

         when Opt_Exclude         =>
            Result.Remaining_Args.Append (+"--exclude");

         when Opt_Quiet           =>

            --  "--quiet" cancels all the previous requests to enable logs
            --  ("--log") and cancels any previuos request for full verbosity
            --  ("--verbose").

            Result.Bool_Args (Opt_Verbose) := False;
            Result.String_List_Args (Opt_Log).Clear;

         when Opt_Verbose         =>

            --  "--verbose" cancels any previous request for quiet verbosity
            --  ("--quiet").

            Result.Bool_Args (Opt_Quiet) := False;

         when others              =>
            null;
      end case;
   end Bool_Callback;

   ---------------------
   -- String_Callback --
   ---------------------

   procedure String_Callback
     (Result : in out Parsed_Arguments;
      Option : String_Options;
      Value  : String)
   is
      pragma Unreferenced (Value);
   begin
      case Option is
         when Opt_Prefix =>

            --  Passing --prefix overrides previously passed --compiler-prefix
            --  arguments.

            Result.Bool_Args (Opt_Compiler_Prefix) := False;

         when others     =>
            null;
      end case;
   end String_Callback;

   --------------------------
   -- String_List_Callback --
   --------------------------

   procedure String_List_Callback
     (Result : in out Parsed_Arguments;
      Option : String_List_Options;
      Value  : String) is
   begin
      case Option is
         when Opt_Exec =>
            declare
               Item : constant Unbounded_String := +(ASCII.NUL & Value);
            begin
               Result.String_List_Args (Opt_Trace).Append (Item);
            end;

         when others   =>
            null;
      end case;
   end String_List_Callback;

   ------------------
   -- Arg_Callback --
   ------------------

   procedure Arg_Callback (Result : in out Parsed_Arguments; Value : String) is
   begin
      case Result.Command is
         when Cmd_Coverage
            | Cmd_Dump_Trace
            | Cmd_Dump_Trace_Raw
            | Cmd_Dump_Trace_Base
            | Cmd_Dump_Src_Trace =>

            --  For these commands, remaining arguments are trace files:
            --  transfer them to Opt_Trace to unify traces handling.

            Result.String_List_Args (Opt_Trace).Append (+Value);

         when Cmd_Dump_Trace_Asm =>

            --  This one is particular: the first argument is an executable
            --  file and the other ones are trace files.

            if Result.String_List_Args (Opt_Exec).Is_Empty then
               Result.String_List_Args (Opt_Exec).Append (+Value);
            else
               Result.String_List_Args (Opt_Trace).Append (+Value);
            end if;

         when others             =>
            null;
      end case;
   end Arg_Callback;

end Command_Line;