Fix positional_generic_parameter rule

The rule was failing in case a generic instantiation with only one
parameter refered to a generic renaming declaration.

This change also fixes how generic formal parameters are counted.

Author: thvnx

lkql_checker/share/lkql/positional_generic_parameters.lkql

@@ -1,14 +1,21 @@
+fun follow_renamings(gen_decl) =
+    |" If gen_decl is a renaming declaration, return the renamed generic
+    |" declaration, gen_decl otherwise.
+    match gen_decl
+    | r@GenericRenamingDecl => r.f_renames.p_referenced_decl()
+    | *                     => gen_decl
+
 fun check_generic(n) =
     |" Return true if the generic decl corresponding to n contains more than 1
     |" formal parameter.
-    [
+    reduce([
         (
             match x.f_decl
             | d@(ObjectDecl | NumberDecl) => d.f_ids.children_count
-            | *                            => 1
+            | *                           => 1
         )
-        for x in from n.p_referenced_decl().f_formal_part.f_decls select GenericFormal
-    ].length > 1
+        for x in from follow_renamings(n).f_formal_part.f_decls select GenericFormal
+    ], (acc, cur) => acc + cur, 0) > 1
 
 fun add_param_name(param, ctx) =
     ctx.set_child(
@@ -48,6 +55,5 @@ fun positional_generic_parameters(node) =
     )
     when l.children_count > 1
     or match g
-    | p@GenericSubpInstantiation    => check_generic(p.f_generic_subp_name)
-    | p@GenericPackageInstantiation => check_generic(p.f_generic_pkg_name)
-    | *                             => false
+    | g@GenericInstantiation => check_generic(g.p_designated_generic_decl())
+    | *                      => false

testsuite/tests/checks/positional_generic_parameters/pos.adb

@@ -10,6 +10,38 @@ procedure Pos (I : in out Integer) is
      (My_Int, Integer);                                --  FLAG (2)
 
    package My_Int_IO is new Ada.Text_IO.Integer_IO (My_Int);  --  NOFLAG
+
+   generic
+      A, B, C : Integer;
+   package G is
+   end G;
+
+   package I_G_1 is new G (1, 2, 3);  -- FLAG (3)
+   package I_G_2 is new G (1, 2, C => 3);  -- FLAG (2)
+   package I_G_3 is new G (1, C =>  2, B => 3);  -- FLAG (1)
+
+   generic package R_G renames G;
+
+   package I_RG is new R_G (1, 2, 3); -- FLAG (3)
+
+   generic
+      A : Integer;
+   package H is
+   end H;
+
+   package I_H is new H (1);  -- NOFLAG
+
+   generic package R_H renames H;
+
+   package I_RH is new R_H (1); -- NOFLAG
+
+   generic
+      A, B, C : Integer := 0;
+   package D is
+   end D;
+
+   package I_D is new D (1);  -- FLAG
+
 begin
    null;
 end Pos;

testsuite/tests/checks/positional_generic_parameters/test.out

@@ -6,6 +6,46 @@ pos.adb:10:15: rule violation: positional generic association
 10 |      (My_Int, Integer);                                --  FLAG (2)
    |               ^^^^^^^
 
+pos.adb:19:28: rule violation: positional generic association
+19 |    package I_G_1 is new G (1, 2, 3);  -- FLAG (3)
+   |                            ^
+
+pos.adb:19:31: rule violation: positional generic association
+19 |    package I_G_1 is new G (1, 2, 3);  -- FLAG (3)
+   |                               ^
+
+pos.adb:19:34: rule violation: positional generic association
+19 |    package I_G_1 is new G (1, 2, 3);  -- FLAG (3)
+   |                                  ^
+
+pos.adb:20:28: rule violation: positional generic association
+20 |    package I_G_2 is new G (1, 2, C => 3);  -- FLAG (2)
+   |                            ^
+
+pos.adb:20:31: rule violation: positional generic association
+20 |    package I_G_2 is new G (1, 2, C => 3);  -- FLAG (2)
+   |                               ^
+
+pos.adb:21:28: rule violation: positional generic association
+21 |    package I_G_3 is new G (1, C =>  2, B => 3);  -- FLAG (1)
+   |                            ^
+
+pos.adb:25:29: rule violation: positional generic association
+25 |    package I_RG is new R_G (1, 2, 3); -- FLAG (3)
+   |                             ^
+
+pos.adb:25:32: rule violation: positional generic association
+25 |    package I_RG is new R_G (1, 2, 3); -- FLAG (3)
+   |                                ^
+
+pos.adb:25:35: rule violation: positional generic association
+25 |    package I_RG is new R_G (1, 2, 3); -- FLAG (3)
+   |                                   ^
+
+pos.adb:43:26: rule violation: positional generic association
+43 |    package I_D is new D (1);  -- FLAG
+   |                          ^
+
 Patched "pos.adb":
 ==================
 
@@ -21,6 +61,38 @@ procedure Pos (I : in out Integer) is
      (Source=>My_Int, Target=>Integer);                                --  FLAG (2)
 
    package My_Int_IO is new Ada.Text_IO.Integer_IO (My_Int);  --  NOFLAG
+
+   generic
+      A, B, C : Integer;
+   package G is
+   end G;
+
+   package I_G_1 is new G (A=>1, B=>2, C=>3);  -- FLAG (3)
+   package I_G_2 is new G (A=>1, B=>2, C => 3);  -- FLAG (2)
+   package I_G_3 is new G (A=>1, C =>  2, B => 3);  -- FLAG (1)
+
+   generic package R_G renames G;
+
+   package I_RG is new R_G (A=>1, B=>2, C=>3); -- FLAG (3)
+
+   generic
+      A : Integer;
+   package H is
+   end H;
+
+   package I_H is new H (1);  -- NOFLAG
+
+   generic package R_H renames H;
+
+   package I_RH is new R_H (1); -- NOFLAG
+
+   generic
+      A, B, C : Integer := 0;
+   package D is
+   end D;
+
+   package I_D is new D (A=>1);  -- FLAG
+
 begin
    null;
 end Pos;