From ac882695198def8d4af1f91e7f499394e6a04f7f Mon Sep 17 00:00:00 2001 From: Hugo Guerrier Date: Wed, 3 Jul 2024 12:06:21 +0200 Subject: [PATCH] Modify the 'USE_Clauses' rule to take a list of allowed packages Also remove the behavior of considering that empty packages are op only packages. --- .../doc/gnatcheck_rm/predefined_rules.rst | 16 ++++- lkql_checker/share/lkql/use_clauses.lkql | 64 +++++++++++++------ lkql_checker/src/gnatcheck-rules.adb | 28 +++++++- testsuite/tests/checks/use_clauses/pack2.ads | 5 ++ testsuite/tests/checks/use_clauses/test.out | 4 ++ testsuite/tests/checks/use_clauses/test.yaml | 1 + 6 files changed, 95 insertions(+), 23 deletions(-) diff --git a/lkql_checker/doc/gnatcheck_rm/predefined_rules.rst b/lkql_checker/doc/gnatcheck_rm/predefined_rules.rst index d960f7495..e1df6860d 100644 --- a/lkql_checker/doc/gnatcheck_rm/predefined_rules.rst +++ b/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 diff --git a/lkql_checker/share/lkql/use_clauses.lkql b/lkql_checker/share/lkql/use_clauses.lkql index 2c5a846a7..c549938ec 100644 --- a/lkql_checker/share/lkql/use_clauses.lkql +++ b/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) + ] + } diff --git a/lkql_checker/src/gnatcheck-rules.adb b/lkql_checker/src/gnatcheck-rules.adb index 874cb1fd9..d23b92925 100644 --- a/lkql_checker/src/gnatcheck-rules.adb +++ b/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; diff --git a/testsuite/tests/checks/use_clauses/pack2.ads b/testsuite/tests/checks/use_clauses/pack2.ads index 46d0b0cd5..431d54335 100644 --- a/testsuite/tests/checks/use_clauses/pack2.ads +++ b/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; diff --git a/testsuite/tests/checks/use_clauses/test.out b/testsuite/tests/checks/use_clauses/test.out index 6fd2142db..0f826ced8 100644 --- a/testsuite/tests/checks/use_clauses/test.out +++ b/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 + | ^^^^^^^^^^^^^^^^^^^^^^^^^^ + diff --git a/testsuite/tests/checks/use_clauses/test.yaml b/testsuite/tests/checks/use_clauses/test.yaml index 8ce16556c..90baeafe4 100644 --- a/testsuite/tests/checks/use_clauses/test.yaml +++ b/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"]'