ada-libraries
/
alog
mirror of https://git.codelabs.ch/alog.git
1
0
Fork 0
Code Issues Releases Wiki Activity

Use Dst_Filter package in policy tests 

This paves the way to let the Policy_DB package only provide type
definitions required to implement identifier-based filtering.
This commit is contained in:
Adrian-Ken Rueegsegger 2019-09-25 17:20:59 +02:00
parent 60be0164f1
commit 9e11144aa6
2 changed files with 63 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

152
tests/policy_tests.adb
View File

@ -22,6 +22,7 @@
with Ahven; with Ahven;
with Alog.Dst_Filter;
with Alog.Maps; with Alog.Maps;
with Alog.Policy_DB; with Alog.Policy_DB;
@ -30,19 +31,19 @@ package body Policy_Tests is
use Ahven; use Ahven;
use Alog; use Alog;
package DB renames Alog.Policy_DB; package DF renames Alog.Dst_Filter;
------------------------------------------------------------------------- -------------------------------------------------------------------------
procedure Default_Loglevel_Handling is procedure Default_Loglevel_Handling is
Before : constant Log_Level := DB.Get_Default_Loglevel; Before : constant Log_Level := DF.Get_Default_Level;
New_Level : constant Log_Level := Critical; New_Level : constant Log_Level := Critical;
begin begin
DB.Set_Default_Loglevel (Level => New_Level); DF.Set_Default_Level (Level => New_Level);
Assert (Condition => DB.Get_Default_Loglevel = New_Level, Assert (Condition => DF.Get_Default_Level = New_Level,
Message => "Default level mismatch"); Message => "Default level mismatch");
DB.Set_Default_Loglevel (Level => Before); DF.Set_Default_Level (Level => Before);
end Default_Loglevel_Handling; end Default_Loglevel_Handling;
------------------------------------------------------------------------- -------------------------------------------------------------------------
@ -50,32 +51,32 @@ package body Policy_Tests is
procedure Finalize (T : in out Testcase) is procedure Finalize (T : in out Testcase) is
pragma Unreferenced (T); pragma Unreferenced (T);
begin begin
DB.Reset; DF.Reset;
end Finalize; end Finalize;
------------------------------------------------------------------------- -------------------------------------------------------------------------
procedure Ident_Loglevel_Handling is procedure Ident_Loglevel_Handling is
begin begin
DB.Set_Loglevel (Identifier => "Foo", DF.Set_Loglevel (Name => "Foo",
Level => Info); Level => Info);
Assert (Condition => DB.Get_Loglevel (Identifier => "Foo") = Info, Assert (Condition => DF.Get_Loglevel (Identifier => "Foo") = Info,
Message => "Ident loglevel mismatch"); Message => "Ident loglevel mismatch");
DB.Set_Loglevel (Identifier => "Foo", DF.Set_Loglevel (Name => "Foo",
Level => Error); Level => Error);
Assert (Condition => DB.Get_Loglevel (Identifier => "Foo") = Error, Assert (Condition => DF.Get_Loglevel (Identifier => "Foo") = Error,
Message => "Unable to update identifier loglevel"); Message => "Unable to update identifier loglevel");
declare declare
Level : Log_Level; Level : Log_Level;
pragma Unreferenced (Level); pragma Unreferenced (Level);
begin begin
Level := DB.Get_Loglevel (Identifier => "Bar"); Level := DF.Get_Loglevel (Identifier => "Bar");
Fail (Message => "Expected No_Ident_Loglevel"); Fail (Message => "Expected No_Ident_Loglevel");
exception exception
when DB.No_Ident_Loglevel => when Policy_DB.No_Ident_Loglevel =>
null; null;
end; end;
end Ident_Loglevel_Handling; end Ident_Loglevel_Handling;
@ -98,11 +99,8 @@ package body Policy_Tests is
(Routine => Set_Identifier_Map'Access, (Routine => Set_Identifier_Map'Access,
Name => "set identifier loglevel map"); Name => "set identifier loglevel map");
T.Add_Test_Routine T.Add_Test_Routine
(Routine => Verify_Accept_Src'Access, (Routine => Verify_Accept_ID'Access,
Name => "accept source"); Name => "accept identifier");
T.Add_Test_Routine
(Routine => Verify_Accept_Dst'Access,
Name => "accept destination");
T.Add_Test_Routine T.Add_Test_Routine
(Routine => Lookup_Ident'Access, (Routine => Lookup_Ident'Access,
Name => "lookup identifier"); Name => "lookup identifier");
@ -112,15 +110,13 @@ package body Policy_Tests is
procedure Lookup_Ident is procedure Lookup_Ident is
begin begin
DB.Set_Default_Loglevel (Level => Error); DF.Set_Default_Level (Level => Error);
DB.Set_Loglevel (Identifier => "Lookup.*", DF.Set_Loglevel (Name => "Lookup.*",
Level => Warning); Level => Warning);
Assert (Condition => DB.Lookup Assert (Condition => DF.Lookup (Name => "Lookup") = Warning,
(Identifier => "Lookup") = Warning,
Message => "Lookup mismatch"); Message => "Lookup mismatch");
Assert (Condition => DB.Lookup Assert (Condition => DF.Lookup (Name => "Nonexistent") = Error,
(Identifier => "Nonexistent") = Error,
Message => "Nonexistent mismatch"); Message => "Nonexistent mismatch");
end Lookup_Ident; end Lookup_Ident;
@ -128,24 +124,24 @@ package body Policy_Tests is
procedure Reset_Policy_DB is procedure Reset_Policy_DB is
begin begin
DB.Set_Default_Loglevel (Level => Error); DF.Set_Default_Level (Level => Error);
DB.Set_Loglevel (Identifier => "Foo", DF.Set_Loglevel (Name => "Foo",
Level => Warning); Level => Warning);
DB.Reset; DF.Reset;
Assert (Condition => DB.Get_Default_Loglevel = Log_Level'First, Assert (Condition => DF.Get_Default_Level = Log_Level'First,
Message => "Default loglevel mismatch"); Message => "Default loglevel mismatch");
declare declare
Src_Level : Log_Level; Level : Log_Level;
pragma Unreferenced (Src_Level); pragma Unreferenced (Level);
begin begin
Src_Level := DB.Get_Loglevel (Identifier => "Foo"); Level := DF.Get_Loglevel (Identifier => "Foo");
Fail (Message => "Src levels not reset"); Fail (Message => "Levels not reset");
exception exception
when DB.No_Ident_Loglevel => when Policy_DB.No_Ident_Loglevel =>
null; null;
end; end;
end Reset_Policy_DB; end Reset_Policy_DB;
@ -160,75 +156,49 @@ package body Policy_Tests is
Map.Insert (Key => "Bar", Map.Insert (Key => "Bar",
Item => Warning); Item => Warning);
DB.Set_Loglevel (Identifiers => Map); DF.Set_Loglevel (Names => Map);
Assert (Condition => DB.Get_Loglevel (Identifier => "Foo") = Notice, Assert (Condition => DF.Get_Loglevel (Identifier => "Foo") = Notice,
Message => "Foo identifier loglevel mismatch"); Message => "Foo identifier loglevel mismatch");
Assert (Condition => DB.Get_Loglevel (Identifier => "Bar") = Warning, Assert (Condition => DF.Get_Loglevel (Identifier => "Bar") = Warning,
Message => "Bar identifier loglevel mismatch"); Message => "Bar identifier loglevel mismatch");
end Set_Identifier_Map; end Set_Identifier_Map;
------------------------------------------------------------------------- -------------------------------------------------------------------------
procedure Verify_Accept_Dst is procedure Verify_Accept_ID is
begin begin
DB.Reset; DF.Reset;
Assert (Condition => DB.Accept_Dst Assert (Condition => DF.Accept_ID (Name => "", Level => Debug),
(Identifier => "Foobar", Message => "Debug not accepted by default");
Level => Log_Level'First), DF.Set_Default_Level (Level => Info);
Message => "Default not accepted");
DB.Set_Default_Loglevel (Level => Info); Assert (Condition => not DF.Accept_ID (Name => "", Level => Debug),
DB.Set_Loglevel (Identifier => "Foo.*",
Level => Error);
Assert (Condition => not DB.Accept_Dst
(Identifier => "Foo",
Level => Debug),
Message => "Dst debug accepted");
Assert (Condition => DB.Accept_Src
(Identifier => "Foo",
Level => Critical),
Message => "Dst critical not accepted");
Assert (Condition => DB.Accept_Dst
(Identifier => "Bar",
Level => Info),
Message => "Dst bar not accepted");
end Verify_Accept_Dst;
-------------------------------------------------------------------------
procedure Verify_Accept_Src is
begin
DB.Reset;
DB.Set_Default_Loglevel (Level => Info);
Assert (Condition => not DB.Accept_Src (Level => Debug),
Message => "Debug accepted"); Message => "Debug accepted");
Assert (Condition => DB.Accept_Src (Level => Warning), Assert (Condition => DF.Accept_ID (Name => "", Level => Warning),
Message => "Warning not accepted"); Message => "Warning not accepted");
DB.Set_Loglevel (Identifier => "Foo.*", DF.Set_Loglevel (Name => "Foo.*",
Level => Error); Level => Error);
Assert (Condition => not DB.Accept_Src Assert (Condition => not DF.Accept_ID
(Identifier => "Foo", (Name => "Foo",
Level => Debug), Level => Debug),
Message => "Src debug accepted"); Message => "ID debug accepted");
Assert (Condition => DB.Accept_Src Assert (Condition => DF.Accept_ID
(Identifier => "Foo", (Name => "Foo",
Level => Critical), Level => Critical),
Message => "Src critical not accepted"); Message => "ID critical not accepted");
Assert (Condition => DB.Accept_Src Assert (Condition => DF.Accept_ID
(Identifier => "Bar", (Name => "Bar",
Level => Info), Level => Info),
Message => "Src bar not accepted"); Message => "Src bar not accepted");
DB.Set_Loglevel (Identifier => "Foobar.*", DF.Set_Loglevel (Name => "Foobar.*",
Level => Debug); Level => Debug);
Assert (Condition => DB.Accept_Src Assert (Condition => DF.Accept_ID
(Identifier => "Foobar", (Name => "Foobar",
Level => Debug), Level => Debug),
Message => "Src foobar not accepted"); Message => "ID foobar not accepted");
end Verify_Accept_Src; end Verify_Accept_ID;
end Policy_Tests; end Policy_Tests;

7
tests/policy_tests.ads
View File

@ -45,11 +45,8 @@ package Policy_Tests is
procedure Set_Identifier_Map; procedure Set_Identifier_Map;
-- Test setting of identifier based loglevels with wildcard map. -- Test setting of identifier based loglevels with wildcard map.
procedure Verify_Accept_Src; procedure Verify_Accept_ID;
-- Verify accept src behavior. -- Verify accept behavior.
procedure Verify_Accept_Dst;
-- Verify accept dst behavior.
procedure Lookup_Ident; procedure Lookup_Ident;
-- Verify identifier lookup behavior. -- Verify identifier lookup behavior.