Skip to content

Commit d42dc54

Browse files
HugoGGuerrierHugoGGuerrier
committed
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
2 parents 815255d + ac88269 commit d42dc54

File tree

6 files changed

+95
-23
lines changed

6 files changed

+95
-23
lines changed

‎lkql_checker/doc/gnatcheck_rm/predefined_rules.rst‎

Lines changed: 14 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5235,6 +5235,18 @@ LKQL rule options files:
52355235
If ``true``, do not flag a package name in a package use clause if it refers
52365236
to a package that only declares operators in its visible part.
52375237

5238+
.. note::
5239+
This rule has another parameter, only available when using an LKQL rule
5240+
options file: ``allowed``. It is a list of Ada names describing packages
5241+
to exempt from begin flagged when used in "use" clauses. Strings in this
5242+
list are case insensitive. Example:
5243+
5244+
.. code-block:: lkql
5245+
5246+
val rules = @{
5247+
Use_Clauses: {Allowed: ["Ada.Strings.Unbounded", "Other.Package"]}
5248+
}
5249+
52385250
.. rubric:: Example
52395251

52405252
.. code-block:: ada
@@ -5249,8 +5261,8 @@ LKQL rule options files:
52495261
end Operator_Pack;
52505262
52515263
with Pack, Operator_Pack;
5252-
use Pack; -- FLAG
5253-
use Operator_Pack; -- FLAG only if Exempt_Operator_Packages is not set
5264+
use Pack; -- FLAG if "Pack" is not in Allowed
5265+
use Operator_Pack; -- FLAG only if Exempt_Operator_Packages is false
52545266
52555267
52565268

‎lkql_checker/share/lkql/use_clauses.lkql‎

Lines changed: 44 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -1,28 +1,52 @@
1-
# Flag names mentioned in use clauses. Use type clauses and names mentioned in
2-
# them are not flagged.
3-
# This rule has an optional parameter Exempt_Operator_Packages: do not flag a
4-
# package name in a package use clause if it refers to a package that only
5-
# declares operators in its visible part.
1+
import stdlib
62

73
fun is_operator(s) =
4+
|" Whether given subprogram declaration of body node represents an
5+
|" operator.
86
s is (BasicSubpDecl | BaseSubpBody)
97
when s.p_defining_name().p_is_operator_name()
108

119
fun decls_not_only_operator(pkg) =
12-
[s for s in match pkg.p_referenced_decl()
13-
| p@BasePackageDecl => p.f_public_part.f_decls.children
14-
| p@PackageRenamingDecl => p.p_final_renamed_package()
15-
.f_public_part.f_decls.children
16-
| p@GenericPackageInstantiation => p.p_designated_generic_decl()
17-
.f_package_decl.f_public_part
18-
.f_decls.children
19-
| * => []
20-
if not is_operator(s)]
10+
|" Whether the given package name identifies a package that defines other
11+
|" symbols than operators.
12+
{
13+
val decls = match pkg.p_referenced_decl()
14+
| p@BasePackageDecl => p.f_public_part.f_decls.children
15+
| p@PackageRenamingDecl => p.p_final_renamed_package()
16+
.f_public_part.f_decls.children
17+
| p@GenericPackageInstantiation => p.p_designated_generic_decl()
18+
.f_package_decl.f_public_part
19+
.f_decls.children
20+
| * => [];
21+
not decls or
22+
stdlib.any([s for s in decls if not is_operator(s)])
23+
}
2124

2225
@unit_check(help="use clause", category="Feature")
23-
fun use_clauses(unit, exempt_operator_packages=false) = [
24-
{message: "use clause", loc: p}
25-
for p in concat([use.f_packages.children
26-
for use in from unit.root select UsePackageClause].to_list)
27-
if (not exempt_operator_packages) or decls_not_only_operator(p)
28-
]
26+
fun use_clauses(unit, exempt_operator_packages=false, allowed=[]) =
27+
|" Flag names mentioned in use clauses. Use type clauses and names mentioned in
28+
|" them are not flagged.
29+
|" This rule has two optional parameter:
30+
|" * exempt_operator_packages: If true, do not flag a package name in a
31+
|" package use clause if it refers to a package that only declares operators
32+
|" in its visible part.
33+
|" * allowed: List of fully qualified names to describe packages allowed in
34+
|" "use" clauses. If the "all_operator_packages" value is present in this
35+
|" list, all packages declaring only operators in their visible part are
36+
|" allowed.
37+
{
38+
val canonical_allowed = [s.to_lower_case for s in allowed].to_list;
39+
[
40+
{message: "use clause", loc: p}
41+
for p in concat(
42+
[
43+
[
44+
c for c in use.f_packages.children
45+
if not c.p_referenced_decl()?.p_canonical_fully_qualified_name?() in canonical_allowed
46+
].to_list
47+
for use in from unit.root select UsePackageClause
48+
].to_list
49+
)
50+
if not exempt_operator_packages or decls_not_only_operator(p)
51+
]
52+
}

‎lkql_checker/src/gnatcheck-rules.adb‎

Lines changed: 27 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2319,6 +2319,7 @@ package body Gnatcheck.Rules is
23192319
Get_Or_Create_Instance (Rule, Instance_Name);
23202320
Tagged_Instance : Custom_Instance renames
23212321
Custom_Instance (Instance.all);
2322+
R_Name : constant String := Rule_Name (Rule);
23222323
First_Equal : Natural;
23232324
Found : Boolean := False;
23242325
begin
@@ -2332,6 +2333,27 @@ package body Gnatcheck.Rules is
23322333
-- Else, the parameter is not empty. If the command line is enabling the
23332334
-- instance then process the parameter.
23342335
elsif Enable then
2336+
-- Special case for the "USE_Clauses" rule
2337+
if R_Name = "use_clauses" then
2338+
if To_Lower (Param) = "exempt_operator_packages" then
2339+
if Arg.Check_Redefinition.Get
2340+
and then not Tagged_Instance.Arguments.Is_Empty
2341+
then
2342+
Emit_Redefining (Instance, Param, Defined_At);
2343+
else
2344+
Instance.Defined_At := To_Unbounded_String (Defined_At);
2345+
Tagged_Instance.Arguments.Append
2346+
(Rule_Argument'
2347+
(To_Unbounded_Text ("exempt_operator_packages"),
2348+
To_Unbounded_Text ("true")));
2349+
end if;
2350+
else
2351+
Emit_Wrong_Parameter (Instance, Param);
2352+
Turn_Instance_Off (Instance);
2353+
end if;
2354+
return;
2355+
end if;
2356+
23352357
Instance.Defined_At := To_Unbounded_String (Defined_At);
23362358

23372359
-- Get the first "=" index, if this index is 0 then there is an error
@@ -2745,7 +2767,11 @@ package body Gnatcheck.Rules is
27452767
Res.Process_Rule_Parameter := Forbidden_Param_Process'Access;
27462768

27472769
else
2748-
Res.XML_Rule_Help := No_Param_XML_Help'Access;
2770+
if Rule_Name = "use_clauses" then
2771+
Res.XML_Rule_Help := Bool_Param_XML_Help'Access;
2772+
else
2773+
Res.XML_Rule_Help := No_Param_XML_Help'Access;
2774+
end if;
27492775
Res.Create_Instance := Create_Custom_Instance'Access;
27502776
Res.Process_Rule_Parameter := Custom_Param_Process'Access;
27512777
end if;

‎testsuite/tests/checks/use_clauses/pack2.ads‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,5 +2,10 @@ with Pack, Operator_Pack;
22
use Pack, Pack; -- FLAG (2)
33
use Operator_Pack; -- NOFLAG because Exempt_Operator_Packages is set
44

5+
with Ada.Text_IO; use Ada.Text_IO; -- NOFLAG because allowed by the rule param
6+
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; -- NOFLAG
7+
8+
with Ada.Strings.Wide_Unbounded; use Ada.Strings.Wide_Unbounded; -- FLAG
9+
510
package Pack2 is
611
end Pack2;

‎testsuite/tests/checks/use_clauses/test.out‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,3 +6,7 @@ pack2.ads:2:11: rule violation: use clause
66
2 | use Pack, Pack; -- FLAG (2)
77
| ^^^^
88

9+
pack2.ads:8:38: rule violation: use clause
10+
8 | with Ada.Strings.Wide_Unbounded; use Ada.Strings.Wide_Unbounded; -- FLAG
11+
| ^^^^^^^^^^^^^^^^^^^^^^^^^^
12+

‎testsuite/tests/checks/use_clauses/test.yaml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,4 +3,5 @@ rule_name: Use_Clauses
33
input_sources: ['operator_pack.ads', 'pack2.ads', 'pack.ads']
44
rule_arguments:
55
use_clauses.exempt_operator_packages: "true"
6+
use_clauses.allowed: '["Ada.Text_IO", "ADA.STRINGS.UNBOUNDED"]'
67

0 commit comments

Comments
 (0)