Fix the 'unconstrained_array_returns' rule to handle derived and subtypes

Author: HugoGGuerrier

lkql_checker/share/lkql/unconstrained_array_returns.lkql

@@ -1,28 +1,12 @@
 import stdlib
 
-fun unconstrained_array_type(type, except_string) =
-    match type
-    | SubtypeDecl => (
-        type.f_subtype.f_constraint is not Constraint and
-        unconstrained_array_type(type.p_canonical_type(), except_string)
-    )
-    | TypeDecl(f_type_def: def@DerivedTypeDef) => (
-        def.f_subtype_indication.f_constraint is not Constraint and
-        unconstrained_array_type(type.p_base_type(), except_string)
-    )
-    | TypeDecl(
-        p_is_array_type(): true,
-        f_type_def: ArrayTypeDef(f_indices: UnconstrainedArrayIndices)
-    ) => if except_string then type.p_root_type().p_fully_qualified_name().to_lower_case != "standard.string"
-
 @check(message="function returns unconstrained array",
        follow_generic_instantiations=true, category="Feature")
 fun unconstrained_array_returns(node, except_string = false) =
     |" Flag each function returning an unconstrained array. Function declarations,
     |" function bodies (and body stubs) having no separate specifications,
     |" and generic function instantiations are flagged.
-    |" Function calls and function renamings are
-    |" not flagged.
+    |" Function calls and function renamings are not flagged.
     |"
     |" Generic function declarations, and function declarations in generic
     |" packages, are not flagged.  Instead, this rule flags the results of
@@ -46,13 +30,31 @@ fun unconstrained_array_returns(node, except_string = false) =
     |"
     |"    function F1 (I : Integer) return Arr;      --  FLAG
     |"    function F2 (I : Integer) return Arr_S;
-    node is (AbstractSubpDecl | SubpDecl | GenericSubpInternal |
-             BaseSubpBody(p_previous_part(): null) |
-             SubpBodyStub(p_previous_part(): null))
-
-    when (not stdlib.in_generic_template(node))
+    {
+        fun is_unconstrained_array(type_decl) =
+            |" Get whether the provided TypeDecl is declaring an unconstrained array type.
+            |" If `type_decl` designate the "standard.string" type and `except_string` is
+            |" `true`, the result of this function is `false`.
+            type_decl is TypeDecl(
+                p_is_array_type(): true,
+                f_type_def: ArrayTypeDef(f_indices: UnconstrainedArrayIndices)
+            ) when (
+                if except_string
+                then type_decl.p_fully_qualified_name().to_lower_case != "standard.string"
+            );
 
-     and node.f_subp_spec is SubpSpec(f_subp_returns:
-         TypeExpr(p_designated_type_decl():
-                  t@BaseTypeDecl
-                  when unconstrained_array_type(t, except_string)))
+        node is (
+            AbstractSubpDecl |
+            SubpDecl |
+            GenericSubpInternal |
+            BaseSubpBody(p_previous_part(): null) |
+            SubpBodyStub(p_previous_part(): null)
+        )
+        and (not stdlib.in_generic_template(node))
+        and node.f_subp_spec is SubpSpec(
+            f_subp_returns: TypeExpr(
+                p_is_definite_subtype(): false,
+                p_designated_type_decl(): t@BaseTypeDecl when is_unconstrained_array(t.p_root_type())
+            )
+        )
+    }

testsuite/tests/checks/unconstrained_array_returns/derived.ads

@@ -0,0 +1,15 @@
+package Derived is
+
+   type Constrained is new String (1 .. 6);
+   type D_Constrained is new Constrained;
+
+   type Unconstrained is new String;
+   type D_Unconstrained is new Unconstrained;
+
+   function Get_Constrained return Constrained is ("123456");      --  NOFLAG
+   function Get_D_Constrained return D_Constrained is ("123456");  --  NOFLAG
+
+   function Get_Unconstrained return Unconstrained is ("");        --  FLAG
+   function Get_D_Unconstrained return D_Unconstrained is ("");    --  FLAG
+
+end Derived;

testsuite/tests/checks/unconstrained_array_returns/subtypes.ads

@@ -0,0 +1,15 @@
+package Subtypes is
+
+   subtype Constrained is String (1 .. 6);
+   subtype S_Constrained is Constrained;
+
+   subtype Unconstrained is String;
+   subtype S_Unconstrained is Unconstrained;
+
+   function Get_Constrained return Constrained is ("123456");      --  NOFLAG
+   function Get_S_Constrained return S_Constrained is ("123456");  --  NOFLAG
+
+   function Get_Unconstrained return Unconstrained is ("");        --  FLAG
+   function Get_S_Unconstrained return S_Unconstrained is ("");    --  FLAG
+
+end Subtypes;

testsuite/tests/checks/unconstrained_array_returns/test.out

@@ -1,3 +1,11 @@
+derived.ads:12:13: rule violation: function returns unconstrained array
+12 |    function Get_Unconstrained return Unconstrained is ("");        --  FLAG
+   |             ^^^^^^^^^^^^^^^^^
+
+derived.ads:13:13: rule violation: function returns unconstrained array
+13 |    function Get_D_Unconstrained return D_Unconstrained is ("");    --  FLAG
+   |             ^^^^^^^^^^^^^^^^^^^
+
 generics.ads:6:13: rule violation: function returns unconstrained array
 6 |    function Image (X : Integer) return String;   --  FLAG 
   |             ^^^^^
@@ -38,3 +46,11 @@ stub.adb:8:13: rule violation: function returns unconstrained array
 8 |    function Subp2 (I : Integer) return String is separate; --  FLAG
   |             ^^^^^
 
+subtypes.ads:12:13: rule violation: function returns unconstrained array
+12 |    function Get_Unconstrained return Unconstrained is ("");        --  FLAG
+   |             ^^^^^^^^^^^^^^^^^
+
+subtypes.ads:13:13: rule violation: function returns unconstrained array
+13 |    function Get_S_Unconstrained return S_Unconstrained is ("");    --  FLAG
+   |             ^^^^^^^^^^^^^^^^^^^
+