Merge branch 'topic/507' into 'master'

Add detector for KP-19824

Closes #507

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

Author: thvnx

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

@@ -0,0 +1,8 @@
+import kp_v404_040_internal
+
+@check(help="possible occurrence of KP 19824",
+       message="possible occurrence of KP 19824")
+fun kp_19824(node) =
+    |" Flag 'Valid attribute applied to a floating-point component of a
+    |" composite type subject to a Scalar_Storage_Order aspect/clause.
+    kp_v404_040_internal.check(node)

lkql_checker/share/lkql/kp/KP-V404-040.lkql

@@ -1,12 +1,8 @@
 # Flag 'Valid applied to floating-point components of composite types that
 # specify a non default Scalar_Storage_Order aspect.
 
-import stdlib
+import kp_v404_040_internal
 
 @check(message="possible occurrence of KP V404-040")
 fun kp_v404_040(node) =
-    node is AttributeRef
-    when node.f_attribute.p_name_is("Valid")
-     and node.f_prefix.p_expression_type().p_is_float_type()
-     and node.f_prefix.p_referenced_decl() is c@ComponentDecl
-     when stdlib.has_non_default_sso(c.p_semantic_parent())
+    kp_v404_040_internal.check(node)

lkql_checker/share/lkql/kp/kp.json

@@ -25,6 +25,7 @@
         "kp_19747": "24.1,24.2",
         "kp_19749": "24.*,25.*",
         "kp_19753": "21.*,22.*,23.*,24.1,24.2,25.1",
+        "kp_19824": "25.*",
         "kp_ob03_009": "19.*",
         "kp_p226_024": "7.1.*,7.2.*,7.3.*,7.4.1,7.4.2,7.4.3",
         "kp_q309_014": "7.1.*,7.2.*,7.3.*,7.4.*,17.*",

lkql_checker/share/lkql/kp/kp_v404_040_internal.lkql

@@ -0,0 +1,17 @@
+import stdlib
+
+fun check(node) =
+    |" Detect 'Valid attribute applied to a floating-point component of a
+    |" composite type subject to a Scalar_Storage_Order aspect/clause.
+    node is AttributeRef
+    when node.f_attribute.p_name_is("Valid")
+     and node.f_prefix.p_expression_type().p_is_float_type()
+     and node.f_prefix.p_referenced_decl() is decl@BasicDecl
+     when match decl
+      # Only records and arrays can have the Scalar_Storage_Order aspect
+      | cd@ComponentDecl => stdlib.has_non_default_sso(cd.p_semantic_parent())
+      | od@ObjectDecl => {
+          val td = od.p_type_expression().p_designated_type_decl();
+          td.p_is_array_type() and stdlib.has_non_default_sso(td)
+        }
+      | * => false

lkql_checker/share/lkql/stdlib.lkql

@@ -446,6 +446,7 @@ fun is_composite_type(decl) =
         val v = decl.p_full_view();
         v.p_is_array_type() or
         v.p_is_record_type() or
+        v.p_is_interface_type() or
         v.p_root_type() is (TaskTypeDecl | ProtectedTypeDecl)
     }
 

testsuite/tests/checks/KP-19824/p.adb

@@ -0,0 +1,29 @@
+with System;
+
+procedure P is
+  type Angle_Type is new Float range 0.0 .. 359.99;
+  -- Derived floating point type
+
+  -- Record type with floating point elements.
+  type My_Record_Type is record
+    Az : Angle_Type;
+    El : Angle_Type;
+  end record;
+
+  -- Big endian byte order
+  for My_Record_Type'Bit_Order use System.High_Order_First;
+  for My_Record_Type'Scalar_Storage_Order use System.High_Order_First;
+
+  type My_Record_Type2 is record
+    Az : Angle_Type;
+    El : Angle_Type;
+  end record;
+
+  My_Record  : My_Record_Type := (1.1, 2.2);
+  My_Record2 : My_Record_Type2 := (1.1, 2.2);
+
+  Is_Valid  : Boolean := My_Record.Az'Valid;   --  FLAG
+
+begin
+  Is_Valid := My_Record2.Az'Valid;             --  NOFLAG
+end P;

testsuite/tests/checks/KP-19824/p2.adb

@@ -0,0 +1,22 @@
+with System;
+
+procedure P2 is
+  type Angle_Type is new Float range 0.0 .. 359.99;
+  -- Derived floating point type
+
+  -- Array type with floating point elements.
+  type My_Array_Type is array (1 .. 2) of Angle_Type;
+
+  -- Big endian byte order
+  for My_Array_Type'Scalar_Storage_Order use System.High_Order_First;
+
+  type My_Array_Type2 is array (1 .. 2) of Angle_Type;
+
+  My_Array  : My_Array_Type := (1.1, 2.2);
+  My_Array2 : My_Array_Type2 := (1.1, 2.2);
+
+  Is_Valid  : Boolean := My_Array (1)'Valid;   --  FLAG
+
+begin
+  Is_Valid := My_Array2 (1)'Valid;             --  NOFLAG
+end P2;

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

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

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

@@ -0,0 +1,8 @@
+p.adb:25:26: rule violation: possible occurrence of KP 19824
+25 |   Is_Valid  : Boolean := My_Record.Az'Valid;   --  FLAG
+   |                          ^^^^^^^^^^^^^^^^^^
+
+p2.adb:18:26: rule violation: possible occurrence of KP 19824
+18 |   Is_Valid  : Boolean := My_Array (1)'Valid;   --  FLAG
+   |                          ^^^^^^^^^^^^^^^^^^
+

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

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