Merge branch 'topic/1380' into 'master'

Fix allows_(int|real|string)_literal predicates

Closes #1380

See merge request eng/libadalang/libadalang!1640

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(

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;

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;

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;

testsuite/tests/name_resolution/user_defined_literals/test.out

@@ -0,0 +1,205 @@
+Analyzing test.adb
+##################
+
+Resolving xrefs for node <SubpSpec test.adb:5:4-5:30>
+*****************************************************
+
+
+Resolving xrefs for node <ParamSpec ["A"] test.adb:5:17-5:29>
+*************************************************************
+
+Expr: <Id "Big_Real" test.adb:5:21-5:29>
+  references:    <DefiningName "Big_Real" a-nbnbre.ads:25:9-25:17>
+  type:          None
+  expected type: None
+
+Resolving xrefs for node <AspectAssoc test.adb:6:7-6:32>
+********************************************************
+
+Expr: <Id "Pre" test.adb:6:7-6:10>
+  references:    None
+  type:          None
+  expected type: None
+Expr: <RelationOp test.adb:6:14-6:32>
+  type:          <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
+  expected type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
+Expr: <Id "A" test.adb:6:14-6:15>
+  references:    <DefiningName "A" test.adb:5:17-5:18>
+  type:          <ConcreteTypeDecl ["Big_Real"] a-nbnbre.ads:25:4-27:32>
+  expected type: <SubtypeDecl ["Valid_Big_Real"] a-nbnbre.ads:34:4-36:52>
+Expr: <OpGt ">" test.adb:6:16-6:17>
+  references:    <DefiningName "">"" a-nbnbre.ads:75:13-75:16>
+  type:          None
+  expected type: None
+Expr: <QualExpr test.adb:6:18-6:32>
+  references:    <DefiningName "Big_Real" a-nbnbre.ads:177:9-177:17>
+  type:          <ConcreteTypeDecl ["Big_Real"] a-nbnbre.ads:177:4-179:15>
+  expected type: <SubtypeDecl ["Valid_Big_Real"] a-nbnbre.ads:34:4-36:52>
+Expr: <Id "Big_Real" test.adb:6:18-6:26>
+  references:    <DefiningName "Big_Real" a-nbnbre.ads:177:9-177:17>
+  type:          None
+  expected type: None
+Expr: <ParenExpr test.adb:6:27-6:32>
+  type:          <ConcreteTypeDecl ["Universal_Real_Type_"] __standard:117:3-117:42>
+  expected type: <ConcreteTypeDecl ["Big_Real"] a-nbnbre.ads:177:4-179:15>
+Expr: <Real test.adb:6:28-6:31>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Real_Type_"] __standard:117:3-117:42>
+  expected type: <ConcreteTypeDecl ["Big_Real"] a-nbnbre.ads:177:4-179:15>
+
+Resolving xrefs for node <SubpSpec test.adb:11:4-11:44>
+*******************************************************
+
+Expr: <Id "Boolean" test.adb:11:37-11:44>
+  references:    <DefiningName "Boolean" __standard:3:8-3:15>
+  type:          None
+  expected type: None
+
+Resolving xrefs for node <ParamSpec ["A"] test.adb:11:16-11:28>
+***************************************************************
+
+Expr: <Id "Big_Real" test.adb:11:20-11:28>
+  references:    <DefiningName "Big_Real" a-nbnbre.ads:25:9-25:17>
+  type:          None
+  expected type: None
+
+Resolving xrefs for node <ReturnStmt test.adb:13:7-13:33>
+*********************************************************
+
+Expr: <RelationOp test.adb:13:14-13:32>
+  type:          <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
+  expected type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
+Expr: <Id "A" test.adb:13:14-13:15>
+  references:    <DefiningName "A" test.adb:11:16-11:17>
+  type:          <ConcreteTypeDecl ["Big_Real"] a-nbnbre.ads:25:4-27:32>
+  expected type: <SubtypeDecl ["Valid_Big_Real"] a-nbnbre.ads:34:4-36:52>
+Expr: <OpGt ">" test.adb:13:16-13:17>
+  references:    <DefiningName "">"" a-nbnbre.ads:75:13-75:16>
+  type:          None
+  expected type: None
+Expr: <QualExpr test.adb:13:18-13:32>
+  references:    <DefiningName "Big_Real" a-nbnbre.ads:25:9-25:17>
+  type:          <ConcreteTypeDecl ["Big_Real"] a-nbnbre.ads:25:4-27:32>
+  expected type: <SubtypeDecl ["Valid_Big_Real"] a-nbnbre.ads:34:4-36:52>
+Expr: <Id "Big_Real" test.adb:13:18-13:26>
+  references:    <DefiningName "Big_Real" a-nbnbre.ads:25:9-25:17>
+  type:          None
+  expected type: None
+Expr: <ParenExpr test.adb:13:27-13:32>
+  type:          <ConcreteTypeDecl ["Universal_Real_Type_"] __standard:117:3-117:42>
+  expected type: <ConcreteTypeDecl ["Big_Real"] a-nbnbre.ads:25:4-27:32>
+Expr: <Real test.adb:13:28-13:31>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Real_Type_"] __standard:117:3-117:42>
+  expected type: <ConcreteTypeDecl ["Big_Real"] a-nbnbre.ads:25:4-27:32>
+
+Resolving xrefs for node <EndName test.adb:14:8-14:9>
+*****************************************************
+
+Expr: <EndName test.adb:14:8-14:9>
+  references:    <DefiningName "F" test.adb:11:13-11:14>
+  type:          None
+  expected type: None
+Expr: <Id "F" test.adb:14:8-14:9>
+  references:    <DefiningName "F" test.adb:11:13-11:14>
+  type:          None
+  expected type: None
+
+
+Analyzing pkg.adb
+#################
+
+Resolving xrefs for node <SubpSpec pkg.adb:6:4-6:24>
+****************************************************
+
+
+Resolving xrefs for node <ParamSpec ["A"] pkg.adb:6:18-6:23>
+************************************************************
+
+Expr: <Id "T" pkg.adb:6:22-6:23>
+  references:    <DefiningName "T" pkg.ads:13:9-13:10>
+  type:          None
+  expected type: None
+
+Resolving xrefs for node <AspectAssoc pkg.adb:7:7-7:23>
+*******************************************************
+
+Expr: <Id "Pre" pkg.adb:7:7-7:10>
+  references:    None
+  type:          None
+  expected type: None
+Expr: <RelationOp pkg.adb:7:14-7:23>
+  type:          <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
+  expected type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
+Expr: <Id "A" pkg.adb:7:14-7:15>
+  references:    <DefiningName "A" pkg.adb:6:18-6:19>
+  type:          <ConcreteTypeDecl ["T"] pkg.ads:13:4-15:15>
+  expected type: <ConcreteTypeDecl ["T"] pkg.ads:13:4-15:15>
+Expr: <OpEq "=" pkg.adb:7:16-7:17>
+  references:    None
+  type:          None
+  expected type: None
+Expr: <QualExpr pkg.adb:7:18-7:23>
+  references:    <DefiningName "T" pkg.ads:13:9-13:10>
+  type:          <ConcreteTypeDecl ["T"] pkg.ads:13:4-15:15>
+  expected type: <ConcreteTypeDecl ["T"] pkg.ads:13:4-15:15>
+Expr: <Id "T" pkg.adb:7:18-7:19>
+  references:    <DefiningName "T" pkg.ads:13:9-13:10>
+  type:          None
+  expected type: None
+Expr: <ParenExpr pkg.adb:7:20-7:23>
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <ConcreteTypeDecl ["T"] pkg.ads:13:4-15:15>
+Expr: <Int pkg.adb:7:21-7:22>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <ConcreteTypeDecl ["T"] pkg.ads:13:4-15:15>
+
+Resolving xrefs for node <SubpSpec pkg.adb:16:4-16:24>
+******************************************************
+
+
+Resolving xrefs for node <ParamSpec ["A"] pkg.adb:16:18-16:23>
+**************************************************************
+
+Expr: <Id "U" pkg.adb:16:22-16:23>
+  references:    <DefiningName "U" pkg.ads:17:9-17:10>
+  type:          None
+  expected type: None
+
+Resolving xrefs for node <AspectAssoc pkg.adb:17:7-17:23>
+*********************************************************
+
+Expr: <Id "Pre" pkg.adb:17:7-17:10>
+  references:    None
+  type:          None
+  expected type: None
+Expr: <RelationOp pkg.adb:17:14-17:23>
+  type:          <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
+  expected type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
+Expr: <Id "A" pkg.adb:17:14-17:15>
+  references:    <DefiningName "A" pkg.adb:16:18-16:19>
+  type:          <ConcreteTypeDecl ["U"] pkg.ads:17:4-17:20>
+  expected type: <ConcreteTypeDecl ["U"] pkg.ads:17:4-17:20>
+Expr: <OpEq "=" pkg.adb:17:16-17:17>
+  references:    None
+  type:          None
+  expected type: None
+Expr: <QualExpr pkg.adb:17:18-17:23>
+  references:    <DefiningName "U" pkg.ads:17:9-17:10>
+  type:          <ConcreteTypeDecl ["U"] pkg.ads:17:4-17:20>
+  expected type: <ConcreteTypeDecl ["U"] pkg.ads:17:4-17:20>
+Expr: <Id "U" pkg.adb:17:18-17:19>
+  references:    <DefiningName "U" pkg.ads:17:9-17:10>
+  type:          None
+  expected type: None
+Expr: <ParenExpr pkg.adb:17:20-17:23>
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <ConcreteTypeDecl ["U"] pkg.ads:17:4-17:20>
+Expr: <Int pkg.adb:17:21-17:22>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <ConcreteTypeDecl ["U"] pkg.ads:17:4-17:20>
+
+
+Done.

testsuite/tests/name_resolution/user_defined_literals/test.yaml

@@ -0,0 +1,2 @@
+driver: name-resolution
+input_sources: [test.adb, pkg.adb]