Skip to content

Commit bf4f1e3

Browse files
JicquelJicquel
committed
Merge branch 'mr/jicquel/#56.block_logger_traces' into 'master'
Display entity and location with Block_Logger traces as additional info See merge request eng/toolchain/gnatcoll-core!100
2 parents 89bdf16 + ee6f217 commit bf4f1e3

File tree

11 files changed

+128
-11
lines changed

11 files changed

+128
-11
lines changed

‎src/gnatcoll-traces.adb‎

Lines changed: 26 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1278,7 +1278,7 @@ package body GNATCOLL.Traces is
12781278
end if;
12791279

12801280
if Global.Location.Active then
1281-
Msg.Append ("(loc: ");
1281+
Msg.Append ("(loc:");
12821282
Msg.Append (Location);
12831283
Msg.Append (')');
12841284
end if;
@@ -2178,15 +2178,23 @@ package body GNATCOLL.Traces is
21782178
if Active (Handle) then
21792179
Result.Me := Handle;
21802180
Result.Style := Style;
2181-
Result.Loc := new String'(Entity & ':' & Location);
2181+
Result.Location := new String'(Location);
2182+
Result.Entity := new String'(Entity);
2183+
2184+
-- To ensure consistency between all traces, location and entity
2185+
-- are also displayed in the loc and entity fields of the message,
2186+
-- despite this piece of information already being contained in
2187+
-- the first part of the message.
2188+
21822189
if Message /= "" then
21832190
Increase_Indent
2184-
(Handle, "Entering " & Result.Loc.all & ' ' & Message,
2185-
Style => Style, Location => "", Entity => "");
2191+
(Handle,
2192+
"Entering " & Entity & ':' & Location & ' ' & Message,
2193+
Style => Style, Location => Location, Entity => Entity);
21862194
else
21872195
Increase_Indent
2188-
(Handle, "Entering " & Result.Loc.all,
2189-
Style => Style, Location => "", Entity => "");
2196+
(Handle, "Entering " & Entity & ':' & Location,
2197+
Style => Style, Location => Location, Entity => Entity);
21902198
end if;
21912199
end if;
21922200
end return;
@@ -2200,13 +2208,21 @@ package body GNATCOLL.Traces is
22002208
begin
22012209
-- If we were active when Create was called
22022210
if Self.Me /= null then
2211+
2212+
-- To ensure consistency between all traces, location and entity
2213+
-- are also displayed in the loc and entity fields of the message,
2214+
-- despite this piece of information already being contained in
2215+
-- the first part of the message.
2216+
22032217
Decrease_Indent
2204-
(Self.Me, "Leaving " & Self.Loc.all,
2218+
(Self.Me, "Leaving " & Self.Entity.all & ':' & Self.Location.all,
22052219
Style => Self.Style,
2206-
Location => "", -- avoid duplicate info in the output
2207-
Entity => "");
2220+
Location => Self.Location.all,
2221+
Entity => Self.Entity.all);
22082222
end if;
2209-
Free (Self.Loc);
2223+
2224+
Free (Self.Location);
2225+
Free (Self.Entity);
22102226
end Finalize;
22112227

22122228
end GNATCOLL.Traces;

‎src/gnatcoll-traces.ads‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -900,7 +900,8 @@ private
900900
type Block_Trace_Handle is new Ada.Finalization.Limited_Controlled with
901901
record
902902
Me : Logger;
903-
Loc : GNAT.Strings.String_Access;
903+
Location : GNAT.Strings.String_Access;
904+
Entity : GNAT.Strings.String_Access;
904905
Style : Message_Style;
905906
end record;
906907
overriding procedure Finalize (Self : in out Block_Logger);

‎testsuite/tests/traces/debug_config_parsing/.gnatdebug_enclosing_entity_no‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
PKG=yes
2+
DEBUG.ENCLOSING_ENTITY=no

‎testsuite/tests/traces/debug_config_parsing/.gnatdebug_enclosing_entity_yes‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
PKG=yes
2+
DEBUG.ENCLOSING_ENTITY=yes

‎testsuite/tests/traces/debug_config_parsing/.gnatdebug_location_no‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
PKG=yes
2+
DEBUG.LOCATION=no

‎testsuite/tests/traces/debug_config_parsing/.gnatdebug_location_yes‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
PKG=yes
2+
DEBUG.LOCATION=yes

‎testsuite/tests/traces/debug_config_parsing/test.adb‎

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
with GNATCOLL.Traces; use GNATCOLL.Traces;
2+
with Ada.Command_Line;
3+
4+
procedure Test is
5+
6+
Log : constant Logger := Create ("PKG");
7+
8+
procedure Foo (A : Integer);
9+
-- Recursive function that decrement A and that traces its value
10+
-- until it reaches 1 (included).
11+
12+
procedure Foo (A : Integer) is
13+
Block_Log : constant Block_Logger := Create (Log);
14+
begin
15+
Trace (Log, "A =" & A'Img);
16+
if A > 1 then
17+
Foo (A - 1);
18+
end if;
19+
end Foo;
20+
21+
begin
22+
Parse_Config_File (Ada.Command_Line.Argument (1));
23+
Foo (3);
24+
end Test;

‎testsuite/tests/traces/debug_config_parsing/test.gpr‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
with "gnatcoll";
2+
3+
project Test is
4+
for Object_Dir use "obj";
5+
for Exec_Dir use ".";
6+
for Main use ("test.adb");
7+
end Test;

‎testsuite/tests/traces/debug_config_parsing/test.out‎

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
== DEBUG.LOCATION=yes
2+
[PKG] Entering Test.Foo:test.adb:13 (loc:test.adb:13)
3+
[PKG] A = 3 (loc:test.adb:15)
4+
[PKG] Entering Test.Foo:test.adb:13 (loc:test.adb:13)
5+
[PKG] A = 2 (loc:test.adb:15)
6+
[PKG] Entering Test.Foo:test.adb:13 (loc:test.adb:13)
7+
[PKG] A = 1 (loc:test.adb:15)
8+
[PKG] Leaving Test.Foo:test.adb:13 (loc:test.adb:13)
9+
[PKG] Leaving Test.Foo:test.adb:13 (loc:test.adb:13)
10+
[PKG] Leaving Test.Foo:test.adb:13 (loc:test.adb:13)
11+
12+
== DEBUG.LOCATION=no
13+
[PKG] Entering Test.Foo:test.adb:13
14+
[PKG] A = 3
15+
[PKG] Entering Test.Foo:test.adb:13
16+
[PKG] A = 2
17+
[PKG] Entering Test.Foo:test.adb:13
18+
[PKG] A = 1
19+
[PKG] Leaving Test.Foo:test.adb:13
20+
[PKG] Leaving Test.Foo:test.adb:13
21+
[PKG] Leaving Test.Foo:test.adb:13
22+
23+
== DEBUG.ENCLOSING_ENTITY=yes
24+
[PKG] Entering Test.Foo:test.adb:13 (entity:Test.Foo)
25+
[PKG] A = 3 (entity:Test.Foo)
26+
[PKG] Entering Test.Foo:test.adb:13 (entity:Test.Foo)
27+
[PKG] A = 2 (entity:Test.Foo)
28+
[PKG] Entering Test.Foo:test.adb:13 (entity:Test.Foo)
29+
[PKG] A = 1 (entity:Test.Foo)
30+
[PKG] Leaving Test.Foo:test.adb:13 (entity:Test.Foo)
31+
[PKG] Leaving Test.Foo:test.adb:13 (entity:Test.Foo)
32+
[PKG] Leaving Test.Foo:test.adb:13 (entity:Test.Foo)
33+
34+
== DEBUG.ENCLOSING_ENTITY=no
35+
[PKG] Entering Test.Foo:test.adb:13
36+
[PKG] A = 3
37+
[PKG] Entering Test.Foo:test.adb:13
38+
[PKG] A = 2
39+
[PKG] Entering Test.Foo:test.adb:13
40+
[PKG] A = 1
41+
[PKG] Leaving Test.Foo:test.adb:13
42+
[PKG] Leaving Test.Foo:test.adb:13
43+
[PKG] Leaving Test.Foo:test.adb:13

‎testsuite/tests/traces/debug_config_parsing/test.sh‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
echo "== DEBUG.LOCATION=yes"
2+
./test .gnatdebug_location_yes
3+
4+
echo ""
5+
echo "== DEBUG.LOCATION=no"
6+
./test .gnatdebug_location_no
7+
8+
echo ""
9+
echo "== DEBUG.ENCLOSING_ENTITY=yes"
10+
./test .gnatdebug_enclosing_entity_yes
11+
12+
echo ""
13+
echo "== DEBUG.ENCLOSING_ENTITY=no"
14+
./test .gnatdebug_enclosing_entity_no

0 commit comments

Comments
 (0)