diff --git a/ada/ast.py b/ada/ast.py index 524c2c5b2..3edd7654e 100644 --- a/ada/ast.py +++ b/ada/ast.py @@ -6002,7 +6002,13 @@ def is_view_of_type(comp_view=T.BaseTypeDecl.entity): @langkit_property(dynamic_vars=[origin], return_type=Bool) def is_array_or_rec(): - return Not(Self.is_null) & (Entity.is_array | Entity.is_record_type) + return And( + Not(Self.is_null), + (Entity.is_array | Entity.is_record_type + # Also consider container aggregates as array or rec + | (origin.is_a(T.BracketAggregate) + & Entity.has_aspect('Aggregate'))) + ) @langkit_property(public=True, return_type=Bool) def is_inherited_primitive(p=T.BasicDecl.entity): @@ -10629,7 +10635,7 @@ def xref_equation(): target = Var(Self.parent.parent.parent) return Cond( # Iterable aspect - Entity.id.name_is('Iterable'), + Entity.id.name_symbol.any_of('Aggregate', 'Iterable'), Entity.expr.cast(T.Aggregate).assocs.unpacked_params.logic_all( lambda sa: sa.assoc.expr @@ -13589,6 +13595,7 @@ def xref_equation(): Self.in_aspect('Global') | Self.in_aspect('Refined_Global') | Self.in_aspect('Depends') | Self.in_aspect('Refined_Depends') | Self.in_aspect('Test_Case') | Self.in_aspect('Refined_State') + | Self.in_aspect('Aggregate') # Careful: normal aggregates can appear inside a contract_cases # aspect's expression, so we must only special case the direct # aggregate of that aspect. @@ -13819,6 +13826,83 @@ class Aggregate(BaseAggregate): Aggregate that is not a ``null record`` aggregate (:rmlink:`4.3`). """ + @langkit_property() + def add_named_param_at(index=T.Int): + """ + Return the ``Add_Named`` subprogram parameter specified by ``index``. + This aggregate must be a container aggregate aspect specification. + """ + # `Add_Named`denotes exactly one procedure that has three parameters, + # the first an in out parameter of the container type, the second an in + # parameter of a nonlimited type (the key type of the container type), + # and the third, an in parameter of a nonlimited type that is called + # the element type of the container type (so index should be an Int + # between 0 and 2). + add_named = Var( + Entity.assocs.find( + lambda assoc: assoc.cast(T.AggregateAssoc).names.at(0) + .cast(T.Name).name_is('Add_Named') + ) + ) + add_named_params = Var( + add_named.then( + lambda an: + an.expr.cast(T.Name).referenced_decl.subp_spec_or_null.params + ) + ) + + return add_named.then( + lambda _: + add_named_params.at(index).type_expression.designated_type_decl + ) + + @langkit_property() + def element_type(): + """ + Return the element type of that Aggregate. This aggregate must be a + container aggregate aspect specification. + """ + # Position container case: `Add_Unnamed` should be specified. It + # denotes exactly one procedure that has two parameters, the first an + # in out parameter of the container type, and the second an in + # parameter of some nonlimited type, called the element type of the + # container type. + add_unnamed = Var( + Entity.assocs.find( + lambda assoc: assoc.cast(T.AggregateAssoc).names.at(0) + .cast(T.Name).name_is('Add_Unnamed') + ) + ) + unnamed_element_type = Var( + add_unnamed.then( + lambda au: au.expr.cast(T.Name).referenced_decl + .subp_spec_or_null.params.at(1).type_expression + .designated_type_decl + ) + ) + + # Named container case: `Add_Named` should be specified + named_element_type = Var(Entity.add_named_param_at(2)) + + return If( + add_unnamed.is_null, named_element_type, unnamed_element_type + ) + + @langkit_property() + def key_type(): + """ + Return the key type of that Aggregate. This aggregate must be a + container aggregate aspect specification. + """ + # Named container case: `Add_Named` should be specified + key_type = Var(Entity.add_named_param_at(1)) + + return key_type._or( + # If add_named is not specified, key_type is the universal integer + # type used for indexed aggregates. + Entity.universal_int_type + ) + class NullRecordAggregate(BaseAggregate): """ @@ -15666,6 +15750,9 @@ def xref_equation(): agg.in_aspect('Contract_Cases'), Entity.contract_cases_assoc_equation, + agg.is_a(T.BracketAggregate) & td._.has_aspect('Aggregate'), + Entity.container_aggregate_equation(td), + agg.parent.is_a(AspectClause, AspectAssoc, PragmaArgumentAssoc), LogicTrue(), @@ -15674,6 +15761,34 @@ def xref_equation(): Entity.array_assoc_equation(atd, mra) ) + @langkit_property(return_type=Equation, dynamic_vars=[env, origin]) + def container_aggregate_equation(td=BaseTypeDecl.entity): + """ + Equation for the case where this is an aggregate assoc for a + container type. This is an Ada 2022 feature (:rmlink:`4.3.5`). + """ + aggregate_aspect = Var( + td.get_aspect('Aggregate').value.cast(T.Aggregate) + ) + entity_name = Var(Entity.names._.at(0).cast(T.Name)) + element_type = Var(aggregate_aspect.element_type) + key_type = Var(aggregate_aspect.key_type) + + return And( + Bind(Entity.expr.expected_type_var, element_type), + Entity.expr.sub_equation, + Entity.expr.matches_expected_type, + If( + entity_name.is_null, + LogicTrue(), + And( + Bind(entity_name.expected_type_var, key_type), + entity_name.as_entity.sub_equation, + entity_name.matches_expected_type + ) + ) + ) + @langkit_property(return_type=Equation, dynamic_vars=[env, origin]) def record_assoc_equation(): """ @@ -15907,6 +16022,25 @@ def xref_equation(): array_type_def = Var(type_decl._.array_def) + # The iterated assoc can also be in a container aggregate + container_aggregate = Var( + type_decl.get_aspect('Aggregate').value.cast(T.Aggregate) + ) + # Get the "component" type of the array or container + comp_type = Var( + array_type_def.then( + lambda atd: atd.comp_type, + default_val=container_aggregate.element_type + ) + ) + # Get the index type of the array or container + index_type = Var( + array_type_def.then( + lambda atd: atd.index_type(root_agg.rank), + default_val=container_aggregate.key_type + ) + ) + # NOTE: we need to resolve the spec first so that the indexing variable # has a type when resolving `r_expr`. # NOTE: if the form of the iterated_component_association is @@ -15916,7 +16050,7 @@ def xref_equation(): spec_success = Var(Entity.spec.resolve_names_internal_with_eq( If(Self.spec.loop_type.is_a(IterType.alt_in), Bind(Entity.spec.iter_expr.cast(Expr).expected_type_var, - array_type_def.index_type(root_agg.rank)) + index_type) & Entity.spec.iter_expr.cast(Expr).matches_expected_type, LogicTrue()) )) @@ -15931,7 +16065,7 @@ def xref_equation(): # .. Then we want to match the component type Entity.expr.sub_equation - & Bind(Entity.expr.expected_type_var, array_type_def.comp_type) + & Bind(Entity.expr.expected_type_var, comp_type) & Entity.expr.matches_expected_type, # .. Else we're on an intermediate dimension of a diff --git a/testsuite/tests/name_resolution/container_aggregate/ai12_0212.adb b/testsuite/tests/name_resolution/container_aggregate/ai12_0212.adb new file mode 100644 index 000000000..66f707cdf --- /dev/null +++ b/testsuite/tests/name_resolution/container_aggregate/ai12_0212.adb @@ -0,0 +1,184 @@ +-- Tests derived from the AI12-0212 description + +pragma Ada_2022; + +with Ada.Containers.Indefinite_Ordered_Maps; +with Ada.Containers.Indefinite_Vectors; +with Ada.Containers.Ordered_Sets; + +procedure AI12_0212 is + + package P is + -- Set_Type is a set-like container type + type Set_Type is private + with Aggregate => (Empty => Empty_Set, + Add_Unnamed => Include); + + function Empty_Set return Set_Type; + + subtype Small_Integer is Integer range -1000..1000; + + procedure Include (S : in out Set_Type; N : Small_Integer) is null; + + -- Map_Type is a map-like container type + type Map_Type is private + with Aggregate => (Empty => Empty_Map, + Add_Named => Add_To_Map); + + procedure Add_To_Map (M : in out Map_Type; Key : Integer; Value : String); + + Empty_Map : constant Map_Type; + + -- Vector_Type is an extensible array-like container type + type Vector_Type is private + with Aggregate => (Empty => Empty_Vector, + Add_Unnamed => Append_One, + New_Indexed => New_Vector, + Assign_Indexed => Assign_Element); + + type Count_Type is new Natural; + + function Empty_Vector (Capacity : Count_Type := 0) return Vector_Type; + + procedure Append_One (V : in out Vector_Type; New_Item : String) is null; + + procedure Assign_Element (V : in out Vector_Type; Index : Positive; + Item : String) is null; + + function New_Vector (First, Last : Positive) return Vector_Type + with Pre => First = Positive'First; + private + + package Int_Sets is + new Ada.Containers.Ordered_Sets + (Element_Type => Small_Integer); + type Set_Type is new Int_Sets.Set with null record; + + Empty_S : constant Set_Type := + (Int_Sets.Empty_Set with null record); + + package Int_String_Maps is + new Ada.Containers.Indefinite_Ordered_Maps + (Key_Type => Integer, Element_Type => String); + + type Map_Type is new Int_String_Maps.Map with null record; + + procedure Add_To_Map (M : in out Map_Type; Key : Integer; Value : String) + renames Insert; + + Empty_Map : constant Map_Type := + (Int_String_Maps.Empty_Map with null record); + + package String_Vectors is + new Ada.Containers.Indefinite_Vectors + (Index_Type => Positive, Element_Type => String); + + type Vector_Type is new String_Vectors.Vector with null record; + + Empty_V : constant Vector_Type := + (String_Vectors.Empty_Vector with null record); + end P; + + package body P is + function Empty_Vector (Capacity : Count_Type := 0) return Vector_Type is + begin + return Empty_V; + end Empty_Vector; + + function New_Vector (First, Last : Positive) return Vector_Type is + begin + return Empty_V; + end New_Vector; + + function Empty_Set return Set_Type is + begin + return Empty_S; + end Empty_Set; + end P; + + use P; + + S : Set_Type; + M : Map_Type; + V : Vector_Type; + + -- Define a table of pairs + type Pair is record + Key : Integer; + Value : access constant String; + end record; + + Table : constant array(Positive range <>) of Pair := + [(Key => 33, Value => new String'("a nice string")), + (Key => 44, Value => new String'("an even better string"))]; + + -- Create an image table for an array of integers + Keys : constant array (Positive range <>) of Integer := [2, 3, 5, 7, 11]; +begin + -- Example aggregates using Set_Type + + -- Assign the empty set to S: + S := []; + pragma Test_Statement; + + -- A positional set aggregate + S := [1, 2]; + pragma Test_Statement; + + -- A set aggregate with an iterated_element_association + S := [for Item in 1 .. 5 => Item * 2]; + pragma Test_Statement; + + -- A set aggregate consisting of two iterated_element_associations + S := [for Item in 1 .. 5 => Item, + for Item in 1 .. 5 => -Item]; + pragma Test_Statement; + + -- Example aggregates using Map_Type + + -- Create an empty map + M := []; + pragma Test_Statement; + + -- A simple named map aggregate + M := [12 => "house", 14 => "beige"]; + pragma Test_Statement; + + -- A map aggregate using an iterated_element_association + -- and a key expression, built from from a table of key/value pairs: + -- M:= [for P of M use P.Key => P.Value]; + -- !!! Can't compile this example with GNAT. + + -- A map aggregate where the values produced by the + -- iterated_element_association are of the same type as the key + -- (eliminating the need for a separate key_expression): + -- M:= [for Key of Keys => Integer'Image (Key)]; + -- !!! Make GNAT crash. + + -- The above could have been written using an explicit key_expression: + -- M:= [for Key of Keys use Key => Integer'Image (Key)]; + -- This example is not supported by LAL ([use key_expression] not parsed) + -- TODO: fix LAL, see libadalang#1050. + + -- Example aggregates using Vector_Type + + -- Create an empty vector aggregate + V := []; + pragma Test_Statement; + + -- A positional vector aggregate + V := ["abc", "def"]; + pragma Test_Statement; + + -- An indexed vector aggregate + V := [1 => "this", 2 => "is", 3 => "a", 4 => "test"]; + pragma Test_Statement; + + -- A vector of images of dynamic length + V := [for I in 1 .. 5 => Integer'Image (I)]; + pragma Test_Statement; + + -- A vector made from the elements of a map + -- V:= [for Elem of M => Elem]; + -- !!! Can't compile this example with GNAT. +end AI12_0212; diff --git a/testsuite/tests/name_resolution/container_aggregate/pkg.adb b/testsuite/tests/name_resolution/container_aggregate/pkg.adb new file mode 100644 index 000000000..21e1d3688 --- /dev/null +++ b/testsuite/tests/name_resolution/container_aggregate/pkg.adb @@ -0,0 +1,20 @@ +pragma Ada_2022; + +with Ada.Containers.Ordered_Sets; + +package body Pkg is + package Int_Sets is new Ada.Containers.Ordered_Sets + (Element_Type => Integer); + subtype Set is Int_Sets.Set; + + procedure P (Arr : Arr_T) is + Set1 : Set := [for E of Arr when E < 0 => E]; + pragma Test_Statement; + Set2 : Set := [for E of Arr when E < 0 or else E > 0 => E]; + pragma Test_Statement; + Set3 : Set := [for Item in 1 .. 5 => Item * 2]; + pragma Test_Statement; + begin + null; + end P; +end Pkg; diff --git a/testsuite/tests/name_resolution/container_aggregate/pkg.ads b/testsuite/tests/name_resolution/container_aggregate/pkg.ads new file mode 100644 index 000000000..c359dc38d --- /dev/null +++ b/testsuite/tests/name_resolution/container_aggregate/pkg.ads @@ -0,0 +1,5 @@ +package Pkg is + type Arr_T is array (Positive range <>) of Integer; + + procedure P (Arr : Arr_T); +end Pkg; diff --git a/testsuite/tests/name_resolution/container_aggregate/test.adb b/testsuite/tests/name_resolution/container_aggregate/test.adb new file mode 100644 index 000000000..d875a0ded --- /dev/null +++ b/testsuite/tests/name_resolution/container_aggregate/test.adb @@ -0,0 +1,35 @@ +pragma Ada_2022; + +procedure Test is + package JSON is + type JSON_Value is private + with Integer_Literal => To_JSON_Value; + + function To_JSON_Value (Text : String) return JSON_Value; + + type JSON_Array is private + with Aggregate => (Empty => New_JSON_Array, + Add_Unnamed => Append); + pragma Test_Block; + + function New_JSON_Array return JSON_Array; + + procedure Append + (Self : in out JSON_Array; + Value : JSON_Value) is null; + + private + type JSON_Value is null record; + type JSON_Array is null record; + + function To_JSON_Value (Text : String) return JSON_Value + is (null record); + + function New_JSON_Array return JSON_Array is (null record); + end JSON; + + List : JSON.JSON_Array := [1, 2, 3]; + pragma Test_Statement; +begin + null; +end Test; diff --git a/testsuite/tests/name_resolution/container_aggregate/test.out b/testsuite/tests/name_resolution/container_aggregate/test.out new file mode 100644 index 000000000..5f045c2a2 --- /dev/null +++ b/testsuite/tests/name_resolution/container_aggregate/test.out @@ -0,0 +1,656 @@ +Analyzing test.adb +################## + +Resolving xrefs for node +*********************************************************** + +Expr: + references: None + type: None + expected type: None +Expr: + type: None + expected type: None +Expr: + references: None + type: None + expected type: None +Expr: + references: + type: None + expected type: None +Expr: + references: None + type: None + expected type: None +Expr: + references: + type: None + expected type: None + +Resolving xrefs for node +****************************************************************** + +Expr: + references: + type: None + expected type: None +Expr: + references: + type: None + expected type: None +Expr: + references: + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: + + +Analyzing test2.adb +################### + +Resolving xrefs for node +********************************************************************* + +Expr: + references: + type: None + expected type: None +Expr: + references: + type: None + expected type: None +Expr: + references: + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: + + +Analyzing test3.adb +################### + +Resolving xrefs for node +********************************************************************** + +Expr: + references: + type: None + expected type: None +Expr: + references: + type: None + expected type: None +Expr: + references: + type: None + expected type: None +Expr: + type: + expected type: +Expr: + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: + + +Analyzing pkg.adb +################# + +Resolving xrefs for node +***************************************************************** + +Expr: + references: + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: + type: + expected type: None +Expr: + type: + expected type: +Expr: + references: + type: + expected type: +Expr: + references: None + type: None + expected type: None +Expr: + references: None + type: + expected type: +Expr: + references: + type: + expected type: + +Resolving xrefs for node +***************************************************************** + +Expr: + references: + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: + type: + expected type: None +Expr: + type: + expected type: +Expr: + type: + expected type: +Expr: + references: + type: + expected type: +Expr: + references: None + type: None + expected type: None +Expr: + references: None + type: + expected type: +Expr: + references: None + type: None + expected type: None +Expr: + type: + expected type: +Expr: + references: + type: + expected type: +Expr: " pkg.adb:13:56-13:57> + references: None + type: None + expected type: None +Expr: + references: None + type: + expected type: +Expr: + references: + type: + expected type: + +Resolving xrefs for node +***************************************************************** + +Expr: + references: + type: None + expected type: None +Expr: + type: + expected type: +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: None + expected type: None +Expr: + references: None + type: + expected type: +Expr: + type: + expected type: +Expr: + references: + type: + expected type: +Expr: + references: None + type: None + expected type: None +Expr: + references: None + type: + expected type: + + +Analyzing ai12_0212.adb +####################### + +Resolving xrefs for node +**************************************************************** + +Expr: + references: + type: + expected type: None +Expr: + type: + expected type: + +Resolving xrefs for node +**************************************************************** + +Expr: + references: + type: + expected type: None +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: + +Resolving xrefs for node +**************************************************************** + +Expr: + references: + type: + expected type: None +Expr: + type: + expected type: +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: None + expected type: None +Expr: + references: None + type: + expected type: +Expr: + type: + expected type: +Expr: + references: + type: + expected type: +Expr: + references: None + type: None + expected type: None +Expr: + references: None + type: + expected type: + +Resolving xrefs for node +**************************************************************** + +Expr: + references: + type: + expected type: None +Expr: + type: + expected type: +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: None + expected type: None +Expr: + references: None + type: + expected type: +Expr: + references: + type: + expected type: +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: None + expected type: None +Expr: + references: None + type: + expected type: +Expr: + type: + expected type: +Expr: + references: None + type: None + expected type: None +Expr: + references: + type: + expected type: + +Resolving xrefs for node +**************************************************************** + +Expr: + references: + type: + expected type: None +Expr: + type: + expected type: + +Resolving xrefs for node +**************************************************************** + +Expr: + references: + type: + expected type: None +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: + +Resolving xrefs for node +**************************************************************** + +Expr: + references: + type: + expected type: None +Expr: + type: + expected type: + +Resolving xrefs for node +**************************************************************** + +Expr: + references: + type: + expected type: None +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: + +Resolving xrefs for node +**************************************************************** + +Expr: + references: + type: + expected type: None +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: + expected type: + +Resolving xrefs for node +**************************************************************** + +Expr: + references: + type: + expected type: None +Expr: + type: + expected type: +Expr: + type: + expected type: +Expr: + references: None + type: + expected type: +Expr: + references: None + type: None + expected type: None +Expr: + references: None + type: + expected type: +Expr: + references: + type: + expected type: +Expr: + references: + type: None + expected type: None +Expr: + references: + type: None + expected type: None +Expr: + references: None + type: None + expected type: None +Expr: + references: + type: + expected type: + + +Done. diff --git a/testsuite/tests/name_resolution/container_aggregate/test.yaml b/testsuite/tests/name_resolution/container_aggregate/test.yaml new file mode 100644 index 000000000..e140f1138 --- /dev/null +++ b/testsuite/tests/name_resolution/container_aggregate/test.yaml @@ -0,0 +1,2 @@ +driver: name-resolution +input_sources: [test.adb, test2.adb, test3.adb, pkg.adb, ai12_0212.adb] diff --git a/testsuite/tests/name_resolution/container_aggregate/test2.adb b/testsuite/tests/name_resolution/container_aggregate/test2.adb new file mode 100644 index 000000000..ea219eeb8 --- /dev/null +++ b/testsuite/tests/name_resolution/container_aggregate/test2.adb @@ -0,0 +1,36 @@ +pragma Ada_2022; + +procedure Test2 is + + package JSON is + type JSON_Value is private + with Integer_Literal => To_JSON_Value; + + function To_JSON_Value (Text : String) return JSON_Value; + + type JSON_Object is private + with Aggregate => (Empty => New_JSON_Object, + Add_Named => Insert); + + function New_JSON_Object return JSON_Object; + + procedure Insert + (Self : in out JSON_Object; + Key : Wide_Wide_String; + Value : JSON_Value) is null; + + private + type JSON_Value is null record; + type JSON_Object is null record; + + function To_JSON_Value (Text : String) return JSON_Value + is (null record); + + function New_JSON_Object return JSON_Object is (null record); + end JSON; + + Object : JSON.JSON_Object := ["a" => 1, "b" => 2, "c" => 3]; + pragma Test_Statement; +begin + null; +end Test2; diff --git a/testsuite/tests/name_resolution/container_aggregate/test3.adb b/testsuite/tests/name_resolution/container_aggregate/test3.adb new file mode 100644 index 000000000..44cb82d1b --- /dev/null +++ b/testsuite/tests/name_resolution/container_aggregate/test3.adb @@ -0,0 +1,74 @@ +pragma Ada_2022; + +procedure Test3 is + + package JSON is + type JSON_Value is private + with Integer_Literal => To_Value, String_Literal => To_Value; + + function To_Value (Text : String) return JSON_Value; + function To_Value (Text : Wide_Wide_String) return JSON_Value; + + type JSON_Object is private + with Aggregate => (Empty => New_JSON_Object, + Add_Named => Insert); + + function New_JSON_Object return JSON_Object; + + procedure Insert + (Self : in out JSON_Object; + Key : Wide_Wide_String; + Value : JSON_Value) is null; + + function From_Object (Self : JSON_Object) return JSON_Value; + + type JSON_Array is private + with Aggregate => (Empty => New_JSON_Array, + Add_Unnamed => Append); + + function New_JSON_Array return JSON_Array; + + procedure Append + (Self : in out JSON_Array; + Value : JSON_Value) is null; + + function From_Array (Self : JSON_Array) return JSON_Value; + + private + type JSON_Value is null record; + type JSON_Object is null record; + type JSON_Array is null record; + + function To_Value (Text : String) return JSON_Value is + (null record); + function To_Value (Text : Wide_Wide_String) return JSON_Value is + (null record); + function New_JSON_Object return JSON_Object is + (null record); + function New_JSON_Array return JSON_Array is + (null record); + function From_Object (Self : JSON_Object) return JSON_Value is + (null record); + function From_Array (Self : JSON_Array) return JSON_Value is + (null record); + end JSON; + + function "+" (X : JSON.JSON_Object) return JSON.JSON_Value + renames JSON.From_Object; + function "-" (X : JSON.JSON_Array) return JSON.JSON_Value + renames JSON.From_Array; + + Offices : JSON.JSON_Array := + [+["name" => "North American Office", + "phones" => -[1_111_222_3333, + 1_111_222_3333, + 1_111_222_3333], + "email" => "info@domain.com"], + +["name" => "European Office", + "phones" => -[33_1_11_22_33_44, + 33_1_11_22_33_44], + "email" => "info@domain.com"]]; + pragma Test_Statement; +begin + null; +end Test3; diff --git a/user_manual/changes/libadalang/1046.yaml b/user_manual/changes/libadalang/1046.yaml new file mode 100644 index 000000000..d52f48040 --- /dev/null +++ b/user_manual/changes/libadalang/1046.yaml @@ -0,0 +1,6 @@ +type: bugfix +title: Fix support for container aggregates +description: | + Libadalang now correctly handles name resolution for container aggregates. + Container aggregate is an Ada 2022 feature, see ARM 4.3.5. +date: 2023-07-26