Skip to content

Commit

Permalink
Merge branch 'topic/use_clauses' into 'master'
Browse files Browse the repository at this point in the history
Modify the 'USE_Clauses' rule to take a list of allowed packages

Closes #298

See merge request eng/libadalang/langkit-query-language!263
  • Loading branch information
HugoGGuerrier committed Oct 7, 2024
2 parents 815255d + ac88269 commit d42dc54
Show file tree
Hide file tree
Showing 6 changed files with 95 additions and 23 deletions.
16 changes: 14 additions & 2 deletions lkql_checker/doc/gnatcheck_rm/predefined_rules.rst
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
64 changes: 44 additions & 20 deletions lkql_checker/share/lkql/use_clauses.lkql
Original file line number Diff line number Diff line change
@@ -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)
]
}
28 changes: 27 additions & 1 deletion lkql_checker/src/gnatcheck-rules.adb
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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;
Expand Down
5 changes: 5 additions & 0 deletions testsuite/tests/checks/use_clauses/pack2.ads
Original file line number Diff line number Diff line change
Expand Up @@ -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;
4 changes: 4 additions & 0 deletions testsuite/tests/checks/use_clauses/test.out
Original file line number Diff line number Diff line change
Expand Up @@ -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
| ^^^^^^^^^^^^^^^^^^^^^^^^^^

1 change: 1 addition & 0 deletions testsuite/tests/checks/use_clauses/test.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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"]'

0 comments on commit d42dc54

Please sign in to comment.