Merge branch 'dev/kp-18701' into 'master'

Add KP detector for eng/toolchain/gnat#26

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

lkql_checker/share/lkql/kp/KP-18701.lkql

@@ -0,0 +1,19 @@
+# Flag aggregates whose type is an immutably limited discriminated type
+# with default discriminant(s).
+
+import stdlib
+
+@check(message="possible occurrence of KP 18701", impact="23.*")
+fun kp_18701(node) =
+    node is Aggregate
+    when node.p_expression_type() is BaseTypeDecl(
+         p_canonical_type() is type@ConcreteTypeDecl
+         # Type has discriminants
+         when type.f_discriminants is KnownDiscriminantPart
+         # with default values
+          and [d for d in type.f_discriminants.f_discr_specs.children
+                          if d.f_default_expr != null]
+         # and is limited or has limited components
+          and (type.f_type_def.f_has_limited.p_as_bool() or
+               type is *(any stdlib.component_types is t@TypeDecl
+                         when t.f_type_def.f_has_limited.p_as_bool())))

testsuite/tests/checks/KP-18701/main.adb

@@ -0,0 +1,22 @@
+procedure Main is
+
+  type Something (Discriminate : Boolean := False) is limited null record;
+
+  type Something2 (Discriminate : Boolean := False) is record
+     Field : Something;
+  end record;
+
+  type Op is record -- implicitly limited because of limited element
+    Element : Something;
+  end record;
+
+  type Op2 is record -- implicitly limited because of limited element
+    Element : Something2;
+  end record;
+
+  Con  : constant Op  := (Element => (Discriminate => True));               --  FLAG
+  Con2 : constant Op2 := (Element => (Discriminate => True, Field => <>));  --  FLAG
+
+begin
+  null;
+end Main;

testsuite/tests/checks/KP-18701/prj.gpr

@@ -0,0 +1,2 @@
+project Prj is
+end Prj;

testsuite/tests/checks/KP-18701/test.out

@@ -0,0 +1,8 @@
+main.adb:17:38: rule violation: possible occurrence of KP 18701
+17 |   Con  : constant Op  := (Element => (Discriminate => True));               --  FLAG
+   |                                      ^^^^^^^^^^^^^^^^^^^^^^
+
+main.adb:18:38: rule violation: possible occurrence of KP 18701
+18 |   Con2 : constant Op2 := (Element => (Discriminate => True, Field => <>));  --  FLAG
+   |                                      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+

testsuite/tests/checks/KP-18701/test.yaml

@@ -0,0 +1,3 @@
+driver: 'checker'
+rule_name: KP_18701
+project: 'prj.gpr'