Skip to content

Commit

Permalink
Merge branch 'topic/kp19198' into 'master'
Browse files Browse the repository at this point in the history
Add kp detector for kp 19198

Closes #251

See merge request eng/libadalang/langkit-query-language!204
  • Loading branch information
raph-amiard committed Apr 30, 2024
2 parents a11826c + 3950026 commit dcd95bf
Show file tree
Hide file tree
Showing 5 changed files with 91 additions and 0 deletions.
8 changes: 8 additions & 0 deletions lkql_checker/share/lkql/kp/KP-19198.lkql
@@ -0,0 +1,8 @@
@check(help="possible occurrence of KP 19198", message="possible occurrence of KP 19198", impact="24.*")
fun kp_19198(node) =
|" Flag occurences of KP 19198
node is ObjectDecl(
f_type_expr: *(p_is_definite_subtype(): true),
f_default_expr: Aggregate,
p_has_aspect("address"): true
)
62 changes: 62 additions & 0 deletions testsuite/tests/checks/KP-19198/main.adb
@@ -0,0 +1,62 @@
with System;
procedure Bad_Agg_Init_With_Address_Clause is
pragma Assertion_Policy (Check);

Buff : aliased String (1 .. 100);
function Ident (A : System.Address) return System.Address is (A);
Addr : constant System.Address := Ident (Buff'Address);

function Four return Integer is (4);
function Falz return Boolean is (False);

type Ints is array (1 .. 5) of Integer;
type Drec_Type (D : Boolean) is record Int : Integer; end record;

procedure Array_With_Statically_Known_Constraint_Violation is
X : constant Ints := (1 .. 4 => 123) with Address => Addr; -- FLAG
begin
pragma Assert (False);
end Array_With_Statically_Known_Constraint_Violation;

procedure Array_With_Statically_Unknown_Constraint_Violation is
X : constant Ints := (1 .. Four => 123) with Address => Addr; -- FLAG
begin
pragma Assert (False);
end Array_With_Statically_Unknown_Constraint_Violation;

procedure Record_With_Statically_Known_Constraint_Violation is
subtype False_Drec is Drec_Type (False);
X : constant False_Drec := (True, 123) with Address => Addr; -- FLAG
begin
pragma Assert (False);
end Record_With_Statically_Known_Constraint_Violation;

procedure Record_With_Statically_Unknown_Constraint_Violation is
subtype False_Drec is Drec_Type (Falz);
X : constant False_Drec := (True, 123) with Address => Addr; -- FLAG
begin
pragma Assert (False);
end Record_With_Statically_Unknown_Constraint_Violation;

begin
begin
Array_With_Statically_Known_Constraint_Violation;
exception
when Constraint_Error => null;
end;
begin
Array_With_Statically_Unknown_Constraint_Violation;
exception
when Constraint_Error => null;
end;
begin
Record_With_Statically_Known_Constraint_Violation;
exception
when Constraint_Error => null;
end;
begin
Record_With_Statically_Unknown_Constraint_Violation;
exception
when Constraint_Error => null;
end;
end Bad_Agg_Init_With_Address_Clause;
2 changes: 2 additions & 0 deletions testsuite/tests/checks/KP-19198/prj.gpr
@@ -0,0 +1,2 @@
project Prj is
end Prj;
16 changes: 16 additions & 0 deletions testsuite/tests/checks/KP-19198/test.out
@@ -0,0 +1,16 @@
main.adb:16:7: rule violation: possible occurrence of KP 19198
16 | X : constant Ints := (1 .. 4 => 123) with Address => Addr; -- FLAG
| ^

main.adb:22:7: rule violation: possible occurrence of KP 19198
22 | X : constant Ints := (1 .. Four => 123) with Address => Addr; -- FLAG
| ^

main.adb:29:7: rule violation: possible occurrence of KP 19198
29 | X : constant False_Drec := (True, 123) with Address => Addr; -- FLAG
| ^

main.adb:36:7: rule violation: possible occurrence of KP 19198
36 | X : constant False_Drec := (True, 123) with Address => Addr; -- FLAG
| ^

3 changes: 3 additions & 0 deletions testsuite/tests/checks/KP-19198/test.yaml
@@ -0,0 +1,3 @@
driver: 'checker'
rule_name: KP_19198
project: 'prj.gpr'

0 comments on commit dcd95bf

Please sign in to comment.