Merge branch 'topic/490' into 'master'

Fix preprocessor handling during exemption pragma/comment detection

Closes #490

See merge request eng/libadalang/langkit-query-language!462

Author: thvnx

lkql_checker/src/gnatcheck-projects.adb

@@ -50,7 +50,6 @@ with GPR2.Project.Registry.Attribute;
 with GPR2.Project.Registry.Attribute.Description;
 with GPR2.Project.Registry.Pack;
 with GPR2.Project.Registry.Pack.Description;
-with GPR2.Project.View;
 with GPR2.Reporter.Console;
 
 with GNATCOLL.Opt_Parse; use GNATCOLL.Opt_Parse;

lkql_checker/src/gnatcheck-projects.ads

@@ -93,6 +93,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
 
 with GPR2.Containers;
 with GPR2.Project.Tree;
+with GPR2.Project.View;
 
 package Gnatcheck.Projects is
 
@@ -168,6 +169,10 @@ package Gnatcheck.Projects is
      (My_Project : Arg_Project_Type) return GPR2.Project.Tree.Object;
    --  Returns access to project tree object
 
+   function View
+     (My_Project : Arg_Project_Type) return GPR2.Project.View.Object;
+   --  Returns access to project view object
+
    procedure Store_Project_Source
      (My_Project : in out Arg_Project_Type; Project_File_Name : String);
    --  If Project_File_Name ends with ".gpr", it is taken to be the name of
@@ -344,6 +349,7 @@ private
 
    type Arg_Project_Type is tagged record
       Tree        : aliased GPR2.Project.Tree.Object;
+      View        : aliased GPR2.Project.View.Object;
       Source_Prj  : String_Access;
       Source_CGPR : String_Access;
    end record;
@@ -352,4 +358,8 @@ private
      (My_Project : Arg_Project_Type) return GPR2.Project.Tree.Object
    is (My_Project.Tree);
 
+   function View
+     (My_Project : Arg_Project_Type) return GPR2.Project.View.Object
+   is (My_Project.View);
+
 end Gnatcheck.Projects;

lkql_checker/src/gnatcheck-source_table.adb

@@ -25,9 +25,11 @@ with GPR2.Path_Name;
 with GPR2.Project.Tree;
 with GPR2.Project.View;
 
+with Langkit_Support.File_Readers; use Langkit_Support.File_Readers;
 with Langkit_Support.Generic_API.Introspection;
 
 with Libadalang.Analysis;         use Libadalang.Analysis;
+with Libadalang.Preprocessing;    use Libadalang.Preprocessing;
 with Libadalang.Project_Provider; use Libadalang.Project_Provider;
 with Libadalang.Iterators;
 with Libadalang.Generic_API;      use Libadalang.Generic_API;
@@ -1475,8 +1477,11 @@ package body Gnatcheck.Source_Table is
    Partition : GPR2_Provider_And_Projects_Array_Access;
 
    function Create_Context return Checker_App.Lkql_Context is
-      Charset : constant String := To_String (Arg.Charset.Get);
-      Ctx     : Checker_App.Lkql_Context;
+      Charset        : constant String := To_String (Arg.Charset.Get);
+      Ctx            : Checker_App.Lkql_Context;
+      File_Reader    : File_Reader_Reference;
+      Default_Config : File_Config;
+      File_Configs   : File_Config_Maps.Map;
    begin
       --  Use a project unit provider, even with the implicit project
       if not In_Aggregate_Project then
@@ -1487,11 +1492,21 @@ package body Gnatcheck.Source_Table is
          --  We can ignore multiple partitions: this will only occur with
          --  aggregate projects, which are handled specially in lalcheck.adb
 
+         --  Setup the file reader with preprocessing support
+         Extract_Preprocessor_Data_From_Project
+           (Gnatcheck_Prj.Tree,
+            Gnatcheck_Prj.View,
+            Default_Config,
+            File_Configs);
+
+         File_Reader := Create_Preprocessor (Default_Config, File_Configs);
+
          Ctx.Analysis_Ctx :=
            Create_Context
              (Charset       => Charset,
               Unit_Provider => Partition (Partition'First).Provider,
-              Event_Handler => EHR_Object);
+              Event_Handler => EHR_Object,
+              File_Reader   => File_Reader);
 
          --  Setup the configuration pragma mapping by reading the
          --  configuration file given by the project.

testsuite/tests/gnatcheck/exemptions/preprocessor/prj.gpr

@@ -0,0 +1,8 @@
+project Prj is
+   for Source_Dirs use (".");
+   for main use ("test.adb");
+
+   package Compiler is
+      for Switches ("Ada") use ("-gnateG", "-gnateDX=Y");
+   end Compiler;
+end Prj;

testsuite/tests/gnatcheck/exemptions/preprocessor/rules.lkql

@@ -0,0 +1 @@
+val rules = @{ Predefined_Numeric_Types }

testsuite/tests/gnatcheck/exemptions/preprocessor/test.adb

@@ -0,0 +1,22 @@
+procedure Test is
+
+   Last_Char_0 : Positive;  -- FLAG
+
+   #if Z'Defined then
+   pragma Annotate
+     (Gnatcheck,
+      Exempt_On,
+      "Predefined_Numeric_Types",
+      "Exemption justification");
+   Last_Char_1 : Positive;
+   pragma Annotate (Gnatcheck, Exempt_Off, "Predefined_Numeric_Types");
+
+   Last_Char_2 : Positive; --## rule line off Predefined_Numeric_Types ## Exemption justification
+
+   --## rule off Predefined_Numeric_Types ## Exemption justification
+   Last_Char_3 : Positive;
+   --## rule on Predefined_Numeric_Types
+   #end if;
+begin
+   null;
+end;

testsuite/tests/gnatcheck/exemptions/preprocessor/test.out

@@ -0,0 +1,35 @@
+1. Summary
+
+   fully compliant sources               : 0
+   sources with exempted violations only : 0
+   sources with non-exempted violations  : 1
+   unverified sources                    : 0
+   total sources                         : 1
+   ignored sources                       : 0
+
+   non-exempted violations               : 1
+   rule exemption warnings               : 0
+   compilation errors                    : 0
+   exempted violations                   : 0
+   internal errors                       : 0
+
+2. Exempted Coding Standard Violations
+
+   no exempted violations detected
+
+3. Non-exempted Coding Standard Violations
+
+test.adb:3:18: rule violation: explicit reference to predefined numeric subtype [predefined_numeric_types]
+
+4. Rule exemption problems
+
+   no rule exemption problems detected
+
+5. Language violations
+
+   no language violations detected
+
+6. Gnatcheck internal errors
+
+   no internal error detected
+

testsuite/tests/gnatcheck/exemptions/preprocessor/test.yaml

@@ -0,0 +1,7 @@
+description: |
+  This test checks that no rule exemption is processed when exemption pragma or
+  comment is included in code ignored by the preprocessor.
+driver: gnatcheck
+show_rule: True
+project: prj.gpr
+lkql_rule_file: rules.lkql