Merge branch 'topic/use_clauses' into 'master'

Modify the 'USE_Clauses' rule to take a list of allowed packages

Closes #298

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

lkql_checker/doc/gnatcheck_rm/predefined_rules.rst

@@ -5235,6 +5235,18 @@ LKQL rule options files:
    If ``true``, do not flag a package name in a package use clause if it refers
    to a package that only declares operators in its visible part.
 
+.. note::
+   This rule has another parameter, only available when using an LKQL rule
+   options file: ``allowed``. It is a list of Ada names describing packages
+   to exempt from begin flagged when used in "use" clauses. Strings in this
+   list are case insensitive. Example:
+
+   .. code-block:: lkql
+
+      val rules = @{
+         Use_Clauses: {Allowed: ["Ada.Strings.Unbounded", "Other.Package"]}
+      }
+
 .. rubric:: Example
 
 .. code-block:: ada
@@ -5249,8 +5261,8 @@ LKQL rule options files:
    end Operator_Pack;
 
    with Pack, Operator_Pack;
-   use Pack;                   --  FLAG
-   use Operator_Pack;          --  FLAG only if Exempt_Operator_Packages is not set
+   use Pack;                   --  FLAG if "Pack" is not in Allowed
+   use Operator_Pack;          --  FLAG only if Exempt_Operator_Packages is false
 
 
 

lkql_checker/share/lkql/use_clauses.lkql

@@ -1,28 +1,52 @@
-# Flag names mentioned in use clauses. Use type clauses and names mentioned in
-# them are not flagged.
-# This rule has an optional parameter Exempt_Operator_Packages: do not flag a
-# package name in a package use clause if it refers to a package that only
-# declares operators in its visible part.
+import stdlib
 
 fun is_operator(s) =
+    |" Whether given subprogram declaration of body node represents an
+    |" operator.
     s is (BasicSubpDecl | BaseSubpBody)
     when s.p_defining_name().p_is_operator_name()
 
 fun decls_not_only_operator(pkg) =
-    [s for s in match pkg.p_referenced_decl()
-       | p@BasePackageDecl     => p.f_public_part.f_decls.children
-       | p@PackageRenamingDecl => p.p_final_renamed_package()
-                                   .f_public_part.f_decls.children
-       | p@GenericPackageInstantiation => p.p_designated_generic_decl()
-                                           .f_package_decl.f_public_part
-                                           .f_decls.children
-       | *                     => []
-     if not is_operator(s)]
+    |" Whether the given package name identifies a package that defines other
+    |" symbols than operators.
+    {
+        val decls = match pkg.p_referenced_decl()
+            | p@BasePackageDecl     => p.f_public_part.f_decls.children
+            | p@PackageRenamingDecl => p.p_final_renamed_package()
+                                        .f_public_part.f_decls.children
+            | p@GenericPackageInstantiation => p.p_designated_generic_decl()
+                                                .f_package_decl.f_public_part
+                                                .f_decls.children
+            | *                     => [];
+        not decls or
+        stdlib.any([s for s in decls if not is_operator(s)])
+    }
 
 @unit_check(help="use clause", category="Feature")
-fun use_clauses(unit, exempt_operator_packages=false) = [
-    {message: "use clause", loc: p}
-    for p in concat([use.f_packages.children
-                     for use in from unit.root select UsePackageClause].to_list)
-    if (not exempt_operator_packages) or decls_not_only_operator(p)
-]
+fun use_clauses(unit, exempt_operator_packages=false, allowed=[]) =
+    |" Flag names mentioned in use clauses. Use type clauses and names mentioned in
+    |" them are not flagged.
+    |" This rule has two optional parameter:
+    |"   * exempt_operator_packages: If true, do not flag a package name in a
+    |"     package use clause if it refers to a package that only declares operators
+    |"     in its visible part.
+    |"   * allowed: List of fully qualified names to describe packages allowed in
+    |"     "use" clauses. If the "all_operator_packages" value is present in this
+    |"     list, all packages declaring only operators in their visible part are
+    |"     allowed.
+    {
+        val canonical_allowed = [s.to_lower_case for s in allowed].to_list;
+        [
+            {message: "use clause", loc: p}
+            for p in concat(
+                [
+                    [
+                        c for c in use.f_packages.children
+                        if not c.p_referenced_decl()?.p_canonical_fully_qualified_name?() in canonical_allowed
+                    ].to_list
+                    for use in from unit.root select UsePackageClause
+                ].to_list
+            )
+            if not exempt_operator_packages or decls_not_only_operator(p)
+        ]
+    }

lkql_checker/src/gnatcheck-rules.adb

@@ -2319,6 +2319,7 @@ package body Gnatcheck.Rules is
         Get_Or_Create_Instance (Rule, Instance_Name);
       Tagged_Instance : Custom_Instance renames
         Custom_Instance (Instance.all);
+      R_Name          : constant String := Rule_Name (Rule);
       First_Equal     : Natural;
       Found           : Boolean := False;
    begin
@@ -2332,6 +2333,27 @@ package body Gnatcheck.Rules is
       --  Else, the parameter is not empty. If the command line is enabling the
       --  instance then process the parameter.
       elsif Enable then
+         --  Special case for the "USE_Clauses" rule
+         if R_Name = "use_clauses" then
+            if To_Lower (Param) = "exempt_operator_packages" then
+               if Arg.Check_Redefinition.Get
+                 and then not Tagged_Instance.Arguments.Is_Empty
+               then
+                  Emit_Redefining (Instance, Param, Defined_At);
+               else
+                  Instance.Defined_At := To_Unbounded_String (Defined_At);
+                  Tagged_Instance.Arguments.Append
+                    (Rule_Argument'
+                       (To_Unbounded_Text ("exempt_operator_packages"),
+                        To_Unbounded_Text ("true")));
+               end if;
+            else
+               Emit_Wrong_Parameter (Instance, Param);
+               Turn_Instance_Off (Instance);
+            end if;
+            return;
+         end if;
+
          Instance.Defined_At := To_Unbounded_String (Defined_At);
 
          --  Get the first "=" index, if this index is 0 then there is an error
@@ -2745,7 +2767,11 @@ package body Gnatcheck.Rules is
                Res.Process_Rule_Parameter := Forbidden_Param_Process'Access;
 
             else
-               Res.XML_Rule_Help := No_Param_XML_Help'Access;
+               if Rule_Name = "use_clauses" then
+                  Res.XML_Rule_Help := Bool_Param_XML_Help'Access;
+               else
+                  Res.XML_Rule_Help := No_Param_XML_Help'Access;
+               end if;
                Res.Create_Instance := Create_Custom_Instance'Access;
                Res.Process_Rule_Parameter := Custom_Param_Process'Access;
             end if;

testsuite/tests/checks/use_clauses/pack2.ads

@@ -2,5 +2,10 @@ with Pack, Operator_Pack;
 use Pack, Pack;             --  FLAG (2)
 use Operator_Pack;          --  NOFLAG because Exempt_Operator_Packages is set
 
+with Ada.Text_IO; use Ada.Text_IO;  --  NOFLAG because allowed by the rule param
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;  --  NOFLAG
+
+with Ada.Strings.Wide_Unbounded; use Ada.Strings.Wide_Unbounded;  --  FLAG
+
 package Pack2 is
 end Pack2;

testsuite/tests/checks/use_clauses/test.out

@@ -6,3 +6,7 @@ pack2.ads:2:11: rule violation: use clause
 2 | use Pack, Pack;             --  FLAG (2)
   |           ^^^^
 
+pack2.ads:8:38: rule violation: use clause
+8 | with Ada.Strings.Wide_Unbounded; use Ada.Strings.Wide_Unbounded;  --  FLAG
+  |                                      ^^^^^^^^^^^^^^^^^^^^^^^^^^
+

testsuite/tests/checks/use_clauses/test.yaml

@@ -3,4 +3,5 @@ rule_name: Use_Clauses
 input_sources: ['operator_pack.ads', 'pack2.ads', 'pack.ads']
 rule_arguments:
     use_clauses.exempt_operator_packages: "true"
+    use_clauses.allowed: '["Ada.Text_IO", "ADA.STRINGS.UNBOUNDED"]'