From 66fc9077d7c8c9efe4a008a3169848a5cd356123 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= Date: Thu, 16 May 2024 11:13:56 +0200 Subject: [PATCH] Fix allows_(int|real|string)_literal predicates Consider all previous parts and parent types when looking for (Integer|Real|String)_Literal aspects. --- ada/ast.py | 10 +- .../user_defined_literals/pkg.adb | 21 ++ .../user_defined_literals/pkg.ads | 21 ++ .../user_defined_literals/test.adb | 18 ++ .../user_defined_literals/test.out | 205 ++++++++++++++++++ .../user_defined_literals/test.yaml | 2 + 6 files changed, 272 insertions(+), 5 deletions(-) create mode 100644 testsuite/tests/name_resolution/user_defined_literals/pkg.adb create mode 100644 testsuite/tests/name_resolution/user_defined_literals/pkg.ads create mode 100644 testsuite/tests/name_resolution/user_defined_literals/test.adb create mode 100644 testsuite/tests/name_resolution/user_defined_literals/test.out create mode 100644 testsuite/tests/name_resolution/user_defined_literals/test.yaml diff --git a/ada/ast.py b/ada/ast.py index e3cf0f522..9e91d3f29 100644 --- a/ada/ast.py +++ b/ada/ast.py @@ -7513,7 +7513,7 @@ def allows_universal_int(): return Entity.is_int_type | Entity.base_subtype.then( # We check on the base_subtype because the aspect can only be # specified on the type's first subtype. - lambda bt: Not(bt.get_aspect_spec_expr("Integer_Literal").is_null), + lambda bt: Not(bt.get_aspect("Integer_Literal", True).is_null), default_val=False ) @@ -7527,7 +7527,7 @@ def allows_universal_real(): return Entity.is_real_type | Entity.base_subtype.then( # We check on the base_subtype because the aspect can only be # specified on the type's first subtype. - lambda bt: Not(bt.get_aspect_spec_expr("Real_Literal").is_null), + lambda bt: Not(bt.get_aspect("Real_Literal", True).is_null), default_val=False ) @@ -7548,8 +7548,7 @@ def allows_string_literal(): Entity.is_str_type | Entity.base_subtype.then( # We check on the base_subtype because the aspect can only be # specified on the type's first subtype. - lambda bt: - Not(bt.get_aspect_spec_expr("String_Literal").is_null), + lambda bt: Not(bt.get_aspect("String_Literal", True).is_null), default_val=False ) ) @@ -18634,7 +18633,8 @@ def get_aspect_on_parts(name=Symbol, inherited=Bool, # often queried during name resolution. name.any_of( 'Implicit_Dereference', 'Constant_Indexing', - 'Variable_Indexing', 'Iterable', 'Iterator_Element' + 'Variable_Indexing', 'Iterable', 'Iterator_Element', + 'Integer_Literal', 'Real_Literal', 'String_Literal' ), parts_to_check.map( diff --git a/testsuite/tests/name_resolution/user_defined_literals/pkg.adb b/testsuite/tests/name_resolution/user_defined_literals/pkg.adb new file mode 100644 index 000000000..868db7ce5 --- /dev/null +++ b/testsuite/tests/name_resolution/user_defined_literals/pkg.adb @@ -0,0 +1,21 @@ +package body Pkg is + -- Check that T'(0) resolve in aspect specification (we have visibility on + -- the private part of T here, so we should consider all previous parts of + -- T when looking for the Integer_Literal aspect). + + procedure P1 (A : T) with + Pre => A = T'(0); + pragma Test_Block; + + procedure P1 (A : T) is null; + + -- Integer_Literal aspect can be inherited (as well as for Real_Literal and + -- String_Literal, not tested here), so we should also consider parent types + -- when looking for it. + + procedure P2 (A : U) with + Pre => A = U'(0); + pragma Test_Block; + + procedure P2 (A : U) is null; +end Pkg; diff --git a/testsuite/tests/name_resolution/user_defined_literals/pkg.ads b/testsuite/tests/name_resolution/user_defined_literals/pkg.ads new file mode 100644 index 000000000..1ed65d2a1 --- /dev/null +++ b/testsuite/tests/name_resolution/user_defined_literals/pkg.ads @@ -0,0 +1,21 @@ +pragma Ada_2022; + +package Pkg is + pragma Elaborate_Body; + + type T is private with + Integer_Literal => IL; + + type U is private; + + function IL (I : String) return T; +private + type T is record + A : Integer; + end record; + + type U is new T; + + function IL (I : String) return T is + (A => (Integer'Value (I))); +end Pkg; diff --git a/testsuite/tests/name_resolution/user_defined_literals/test.adb b/testsuite/tests/name_resolution/user_defined_literals/test.adb new file mode 100644 index 000000000..c8bd9b27e --- /dev/null +++ b/testsuite/tests/name_resolution/user_defined_literals/test.adb @@ -0,0 +1,18 @@ +with Ada.Numerics.Big_Numbers.Big_Reals; +use Ada.Numerics.Big_Numbers.Big_Reals; + +procedure Test is + procedure P (A : Big_Real) with + Pre => A > Big_Real'(0.0); + pragma Test_Block; + + procedure P (A : Big_Real) is null; + + function F (A : Big_Real) return Boolean is + begin + return A > Big_Real'(0.0); + end F; + pragma Test_Block; +begin + null; +end Test; diff --git a/testsuite/tests/name_resolution/user_defined_literals/test.out b/testsuite/tests/name_resolution/user_defined_literals/test.out new file mode 100644 index 000000000..3b5d30b32 --- /dev/null +++ b/testsuite/tests/name_resolution/user_defined_literals/test.out @@ -0,0 +1,205 @@ +Analyzing test.adb +################## + +Resolving xrefs for node +***************************************************** + + +Resolving xrefs for node +************************************************************* + +Expr: + references: + type: None + expected type: None + +Resolving xrefs for node +******************************************************** + +Expr: + references: None + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: + type: + expected type: +Expr: " test.adb:6:16-6:17> + references: "" a-nbnbre.ads:75:13-75:16> + type: None + expected type: None +Expr: + references: + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: + +Resolving xrefs for node +******************************************************* + +Expr: + references: + type: None + expected type: None + +Resolving xrefs for node +*************************************************************** + +Expr: + references: + type: None + expected type: None + +Resolving xrefs for node +********************************************************* + +Expr: + type: + expected type: +Expr: + references: + type: + expected type: +Expr: " test.adb:13:16-13:17> + references: "" a-nbnbre.ads:75:13-75:16> + type: None + expected type: None +Expr: + references: + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: + +Resolving xrefs for node +***************************************************** + +Expr: + references: + type: None + expected type: None +Expr: + references: + type: None + expected type: None + + +Analyzing pkg.adb +################# + +Resolving xrefs for node +**************************************************** + + +Resolving xrefs for node +************************************************************ + +Expr: + references: + type: None + expected type: None + +Resolving xrefs for node +******************************************************* + +Expr: + references: None + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: + type: + expected type: +Expr: + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: + +Resolving xrefs for node +****************************************************** + + +Resolving xrefs for node +************************************************************** + +Expr: + references: + type: None + expected type: None + +Resolving xrefs for node +********************************************************* + +Expr: + references: None + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: + type: + expected type: +Expr: + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: + + +Done. diff --git a/testsuite/tests/name_resolution/user_defined_literals/test.yaml b/testsuite/tests/name_resolution/user_defined_literals/test.yaml new file mode 100644 index 000000000..0cb4e53c5 --- /dev/null +++ b/testsuite/tests/name_resolution/user_defined_literals/test.yaml @@ -0,0 +1,2 @@ +driver: name-resolution +input_sources: [test.adb, pkg.adb]