Skip to content

Commit

Permalink
Use p_get_aspect in p_iterable_cursor_type
Browse files Browse the repository at this point in the history
This change makes `p_iterable_cursor_type` use `p_get_aspect` to check
out if the `Iterable` aspect is defined for the entity being
check. Since aspects can be set on any part of the entity, and that
they can be inherited, `p_iterable_cursor_type` should use
`p_get_aspect` instead of simply call `p_get_aspect_spec_expr`.
  • Loading branch information
thvnx authored and raph-amiard committed Mar 13, 2024
1 parent c5ec240 commit 73694db
Show file tree
Hide file tree
Showing 4 changed files with 105 additions and 2 deletions.
4 changes: 3 additions & 1 deletion ada/ast.py
Original file line number Diff line number Diff line change
Expand Up @@ -8509,7 +8509,9 @@ def iterable_cursor_type():
If Self is a type that is iterable (i.e.: it has the Iterable aspect
defined), return the type of the cursor in use by this iterable type.
"""
return Entity.get_aspect_spec_expr('Iterable').then(
return Entity.get_aspect(
'Iterable', previous_parts_only=True
).value.then(
lambda it: it.cast(T.Aggregate).assocs.unpacked_params.find(
lambda sa: sa.name.name_is('First')
).assoc.expr.cast_or_raise(T.Name).referenced_decl.expr_type
Expand Down
53 changes: 53 additions & 0 deletions testsuite/tests/name_resolution/iterable_aspect/private_view.adb
Original file line number Diff line number Diff line change
@@ -0,0 +1,53 @@
procedure Private_View is
package P is
type Sequence is private with
Iterable => (First => Iter_First,
Has_Element => Iter_Has_Element,
Next => Iter_Next);

function Iter_First (Container : Sequence) return Integer;
function Iter_Has_Element
(Container : Sequence;
Position : Integer) return Boolean;
function Iter_Next
(Container : Sequence;
Position : Integer) return Integer;
private

type Sequence is record
Content : String (1 .. 10);
end record;

function Iter_First (Container : Sequence) return Integer is
(Container.Content'First);
function Iter_Has_Element
(Container : Sequence;
Position : Integer) return Boolean is
(Position < Container.Content'Last);
function Iter_Next
(Container : Sequence;
Position : Integer) return Integer is (Position + 1);
end P;

package body P is
function Ident (I : Integer) return Boolean is (True);

-- Below, Sequence refers to the private view of Sequence, which has no
-- aspect Iterable. `p_iterable_cursor_type` should also look for the
-- Iterable aspect on the public part too.
function "<" (Left : Sequence; Right : Sequence) return Boolean is
(for all N in Left => Ident (N));
pragma Test_Statement;

type New_Sequence is new Sequence;

-- Below, New_Sequence refers to the type declared above, inheriting the
-- Iterable aspect from Sequence. `p_iterable_cursor_type` should also
-- look for the Iterable aspect on the parent types.
function "<" (Left : New_Sequence; Right : New_Sequence) return Boolean
is (for all N in Left => Ident (N));
pragma Test_Statement;
end P;
begin
null;
end Private_View;
48 changes: 48 additions & 0 deletions testsuite/tests/name_resolution/iterable_aspect/test.out
Original file line number Diff line number Diff line change
Expand Up @@ -154,4 +154,52 @@ Expr: <Id "Image" test.adb:76:45-76:50>
expected type: None


Analyzing private_view.adb
##########################

Resolving xrefs for node <ExprFunction [""<""] private_view.adb:38:7-39:42>
***************************************************************************

Expr: <ParenExpr private_view.adb:39:9-39:41>
type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
expected type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
Expr: <QuantifiedExpr private_view.adb:39:10-39:40>
type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
expected type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
Expr: <CallExpr private_view.adb:39:31-39:40>
references: <DefiningName "Ident" private_view.adb:33:16-33:21>
type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
expected type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
Expr: <Id "Ident" private_view.adb:39:31-39:36>
references: <DefiningName "Ident" private_view.adb:33:16-33:21>
type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
expected type: None
Expr: <Id "N" private_view.adb:39:38-39:39>
references: <DefiningName "N" private_view.adb:39:18-39:19>
type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>

Resolving xrefs for node <ExprFunction [""<""] private_view.adb:47:7-48:43>
***************************************************************************

Expr: <ParenExpr private_view.adb:48:10-48:42>
type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
expected type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
Expr: <QuantifiedExpr private_view.adb:48:11-48:41>
type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
expected type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
Expr: <CallExpr private_view.adb:48:32-48:41>
references: <DefiningName "Ident" private_view.adb:33:16-33:21>
type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
expected type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
Expr: <Id "Ident" private_view.adb:48:32-48:37>
references: <DefiningName "Ident" private_view.adb:33:16-33:21>
type: <ConcreteTypeDecl ["Boolean"] __standard:3:3-3:33>
expected type: None
Expr: <Id "N" private_view.adb:48:39-48:40>
references: <DefiningName "N" private_view.adb:48:19-48:20>
type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>
expected type: <ConcreteTypeDecl ["Integer"] __standard:4:3-4:54>


Done.
2 changes: 1 addition & 1 deletion testsuite/tests/name_resolution/iterable_aspect/test.yaml
Original file line number Diff line number Diff line change
@@ -1,2 +1,2 @@
driver: name-resolution
input_sources: [test.adb]
input_sources: [test.adb, private_view.adb]

0 comments on commit 73694db

Please sign in to comment.