diff --git a/ada/ast.py b/ada/ast.py index 0a9fdb9d7..a42071559 100644 --- a/ada/ast.py +++ b/ada/ast.py @@ -1099,6 +1099,24 @@ def is_keyword(token=T.Token, language_version=T.Symbol): Static method. Return the standard Wide_Wide_Character type. """ ) + std_string_type = Property( + Self.std_entity('String').cast(T.BaseTypeDecl), public=True, + doc=""" + Static method. Return the standard String type. + """ + ) + std_wide_string_type = Property( + Self.std_entity('Wide_String').cast(T.BaseTypeDecl), public=True, + doc=""" + Static method. Return the standard Wide_String type. + """ + ) + std_wide_wide_string_type = Property( + Self.std_entity('Wide_Wide_String').cast(T.BaseTypeDecl), + public=True, doc=""" + Static method. Return the standard Wide_Wide_String type. + """ + ) std_root_types = Property( Self.std_entity('root_types_').cast(T.PackageDecl)._.children_env, @@ -2055,6 +2073,15 @@ class Aspect(Struct): """) +class UserDefinedFunctionSubpSpec(Struct): + """ + Structure to hold an expected subprogram specification (parameters and + return types only) denoted by an user defined function. + """ + subp_params_types = UserField(T.BaseTypeDecl.entity.array) + subp_return_type = UserField(T.BaseTypeDecl.entity) + + @abstract class BasicDecl(AdaNode): """ @@ -8660,6 +8687,48 @@ def variable_indexing_fns(): ) ) + @langkit_property(return_type=T.BasicDecl.entity.array) + def user_defined_literal_fns(aspect=T.Symbol): + """ + Return the functions detoned by the user defined literal aspect + ``aspect`` for this type. + """ + # User-defined literal aspects denote a function with a result type of + # ``Entity`` and one parameter that is of type ``String`` (or + # ``Wide_Wide_String`` for ``String_Literal``). + expected_spec = Var(UserDefinedFunctionSubpSpec.new( + subp_params_types=If( + aspect == 'String_Literal', + Self.std_wide_wide_string_type, + Self.std_string_type + ).singleton, + subp_return_type=Entity + )) + # ``Real_Literal`` detoned function can be overrode by a function with + # a result type of ``Entity`` and two parameters that are of type + # ``String``. + expected_specs = Var(If( + aspect == 'Real_Literal', + UserDefinedFunctionSubpSpec.new( + subp_params_types=[Self.std_string_type, Self.std_string_type], + subp_return_type=Entity + ), + No(T.UserDefinedFunctionSubpSpec) + ).singleton.concat(expected_spec.singleton)) + + return Entity.get_aspect_spec_expr(aspect).then( + lambda a: a.cast_or_raise(T.Name) + .all_env_elements_internal(seq=False).filtermap( + lambda e: e.cast(T.BasicDecl), + lambda env_el: + env_el.cast_or_raise(T.BasicDecl).subp_spec_or_null.then( + lambda ss: expected_specs.any( + lambda es: ss.match_expected_user_defined_function(es) + ) + ) + ) + ) + class ConcreteTypeDecl(TypeDecl): """ @@ -10764,7 +10833,7 @@ def xref_equation(): & expr.expect_bool_derived_type ) & Entity.args.at(1)._.assoc_expr.then( lambda msg: - Bind(msg.expected_type_var, Self.std_entity('String')) + Bind(msg.expected_type_var, Self.std_string_type) & msg.sub_equation & msg.matches_expected_type, default_val=LogicTrue() @@ -10798,7 +10867,7 @@ def xref_equation(): expr.sub_equation ), - Bind(expr.expected_type_var, Self.std_entity("String")) + Bind(expr.expected_type_var, Self.std_string_type) & expr.sub_equation & expr.matches_expected_type ), @@ -11388,6 +11457,11 @@ def xref_equation(): Entity.id.name_is('Stable_Properties'), Entity.stable_properties_assoc_equation, + Entity.id.name_symbol.any_of( + 'Integer_Literal', 'Real_Literal', 'String_Literal' + ), + Entity.user_defined_literals_equation(target.cast(T.TypeDecl)), + # Constant_Indexing and Variable_Indexing aspects name expression # can denotes one or more functions. Since name resolution can set # only one reference for a name, only keep the first function @@ -11452,6 +11526,22 @@ def stable_properties_assoc_equation(): ) ) + @langkit_property(return_type=Equation, dynamic_vars=[env, origin]) + def user_defined_literals_equation(target=T.TypeDecl): + """ + Equation for the case where this is an aspect assoc for a + user-defined literal. + """ + return Bind( + Entity.expr.cast_or_raise(T.Identifier).ref_var, + target.as_entity.user_defined_literal_fns( + Entity.id.name_symbol + ).at( + # First result in the list is the last override if any + 0 + ) + ) + @langkit_property(return_type=T.String) def aspect_name(n=T.Name.entity): """ @@ -19395,6 +19485,26 @@ def match_other(other=T.BaseFormalParamHolder.entity, other.cast_or_raise(BaseSubpSpec), match_names ) + @langkit_property(return_type=Bool) + def match_expected_user_defined_function(fn=T.UserDefinedFunctionSubpSpec): + """ + Return whether UserDefinedFunctionSubpSpec's signature matches Self's. + """ + return And( + Entity.return_type.matching_type(fn.subp_return_type), + Entity.unpacked_formal_params.then( + lambda params: And( + params.length == fn.subp_params_types.length, + params.filter( + lambda i, p: + Not(p.formal_decl.formal_type.matching_type( + fn.subp_params_types.at(i) + )) + ).is_null + ) + ) + ) + @langkit_property(return_type=LexicalEnv, dynamic_vars=[origin]) def defining_env(): """ @@ -20428,13 +20538,13 @@ def xref_equation(): Entity.access_equation, rel_name == 'Image', - Entity.image_equation(Self.std_entity('String')), + Entity.image_equation(Self.std_string_type), rel_name == 'Wide_Image', - Entity.image_equation(Self.std_entity('Wide_String')), + Entity.image_equation(Self.std_wide_string_type), rel_name == 'Wide_Wide_Image', - Entity.image_equation(Self.std_entity('Wide_Wide_String')), + Entity.image_equation(Self.std_wide_wide_string_type), rel_name == 'Enum_Rep', Entity.enum_rep_equation, @@ -20453,7 +20563,7 @@ def xref_equation(): Entity.universal_real_equation, rel_name == 'Img', - Entity.img_equation(Self.std_entity('String')), + Entity.img_equation(Self.std_string_type), rel_name == 'Tag', Entity.tag_attr_equation, @@ -20498,10 +20608,10 @@ def xref_equation(): rel_name.any_of('External_Tag', 'Type_Key'), Entity.prefix.sub_equation - & Bind(Self.type_var, Self.std_entity('String')), + & Bind(Self.type_var, Self.std_string_type), rel_name == 'Target_Name', - Bind(Self.type_var, Self.std_entity('String')), + Bind(Self.type_var, Self.std_string_type), rel_name == 'Storage_Pool', Entity.storage_pool_equation, @@ -21073,7 +21183,7 @@ def xref_equation(): lambda er: And( # The expected type of that error message is always String, # according to RM 11.3 - 3.1/2. - Bind(er.expected_type_var, Self.std_entity('String')), + Bind(er.expected_type_var, Self.std_string_type), er.sub_equation ), default_val=LogicTrue() @@ -22492,7 +22602,7 @@ def xref_equation(): lambda er: And( # The expected type of that error message is always String, # according to RM 11.3 - 3.1/2. - Bind(er.expected_type_var, Self.std_entity('String')), + Bind(er.expected_type_var, Self.std_string_type), er.sub_equation ), default_val=LogicTrue() diff --git a/testsuite/tests/name_resolution/user_defined_int_lit/test.adb b/testsuite/tests/name_resolution/user_defined_int_lit/test.adb index d06ee76b4..d23358efe 100644 --- a/testsuite/tests/name_resolution/user_defined_int_lit/test.adb +++ b/testsuite/tests/name_resolution/user_defined_int_lit/test.adb @@ -2,8 +2,12 @@ procedure Test is package Big_Ints is type Big_Int is private with Integer_Literal => To_Big_Int; + pragma Test_Block; + function To_Big_Int (X : Boolean) return Big_Int; function To_Big_Int (X : String) return Big_Int; + function To_Big_Int (X, Y : String) return Big_Int; + function To_Big_Int (X : String) return Integer; private type Big_Int is record diff --git a/testsuite/tests/name_resolution/user_defined_int_lit/test.out b/testsuite/tests/name_resolution/user_defined_int_lit/test.out index 6b290b5e9..ed74f7dc4 100644 --- a/testsuite/tests/name_resolution/user_defined_int_lit/test.out +++ b/testsuite/tests/name_resolution/user_defined_int_lit/test.out @@ -1,75 +1,87 @@ Analyzing test.adb ################## -Resolving xrefs for node +Resolving xrefs for node +********************************************************* + +Expr: + references: None + type: None + expected type: None +Expr: + references: + type: None + expected type: None + +Resolving xrefs for node *************************************************************** -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: None type: expected type: -Resolving xrefs for node +Resolving xrefs for node *************************************************************** -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: - references: +Expr: + references: type: expected type: -Resolving xrefs for node +Resolving xrefs for node *************************************************************** -Expr: - references: +Expr: + references: type: None expected type: None -Expr: +Expr: references: None type: - expected type: + expected type: -Resolving xrefs for node +Resolving xrefs for node **************************************************************** -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: - references: +Expr: + references: type: expected type: diff --git a/testsuite/tests/name_resolution/user_defined_real_lit/test.adb b/testsuite/tests/name_resolution/user_defined_real_lit/test.adb index aaf26a10b..2d415bc5d 100644 --- a/testsuite/tests/name_resolution/user_defined_real_lit/test.adb +++ b/testsuite/tests/name_resolution/user_defined_real_lit/test.adb @@ -2,6 +2,7 @@ procedure Test is package Big_Reals is type Big_Real is private with Real_Literal => To_Big_Real; + pragma Test_Block; function To_Big_Real (X : String) return Big_Real; function To_Big_Real (X, Y : String) return Big_Real; diff --git a/testsuite/tests/name_resolution/user_defined_real_lit/test.out b/testsuite/tests/name_resolution/user_defined_real_lit/test.out index 279692c79..2f668d15f 100644 --- a/testsuite/tests/name_resolution/user_defined_real_lit/test.out +++ b/testsuite/tests/name_resolution/user_defined_real_lit/test.out @@ -1,57 +1,69 @@ Analyzing test.adb ################## -Resolving xrefs for node +Resolving xrefs for node +********************************************************* + +Expr: + references: None + type: None + expected type: None +Expr: + references: + type: None + expected type: None + +Resolving xrefs for node *************************************************************** -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: None type: expected type: -Resolving xrefs for node +Resolving xrefs for node *************************************************************** -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: - references: +Expr: + references: type: expected type: -Resolving xrefs for node +Resolving xrefs for node *************************************************************** -Expr: - references: +Expr: + references: type: None expected type: None -Expr: +Expr: references: None type: - expected type: + expected type: Done. diff --git a/testsuite/tests/name_resolution/user_defined_str_lit/test.adb b/testsuite/tests/name_resolution/user_defined_str_lit/test.adb index 223752c55..d34df8d60 100644 --- a/testsuite/tests/name_resolution/user_defined_str_lit/test.adb +++ b/testsuite/tests/name_resolution/user_defined_str_lit/test.adb @@ -2,9 +2,11 @@ procedure Test is package Pkg is type Str is null record with String_Literal => To_Str; + pragma Test_Block; function To_Str (X : Wide_Wide_String) return Str is (null record); + function To_Str (X : String) return Str is (null record); end Pkg; X : Pkg.Str := "Helloooo"; diff --git a/testsuite/tests/name_resolution/user_defined_str_lit/test.out b/testsuite/tests/name_resolution/user_defined_str_lit/test.out index 885b2e54e..88e171c36 100644 --- a/testsuite/tests/name_resolution/user_defined_str_lit/test.out +++ b/testsuite/tests/name_resolution/user_defined_str_lit/test.out @@ -1,22 +1,34 @@ Analyzing test.adb ################## -Resolving xrefs for node +Resolving xrefs for node +********************************************************* + +Expr: + references: None + type: None + expected type: None +Expr: + references: + type: None + expected type: None + +Resolving xrefs for node *************************************************************** -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: type: None expected type: None -Expr: +Expr: references: None type: expected type: