aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst16
-rw-r--r--gcc/ada/exp_attr.adb5
-rw-r--r--gcc/ada/gnat_rm.texi16
-rw-r--r--gcc/ada/gnat_ugn.texi2
-rw-r--r--gcc/ada/sem_ch13.adb71
-rw-r--r--gcc/ada/sem_util.adb2
6 files changed, 71 insertions, 41 deletions
diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst b/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst
index 6ef00c2..4541f2b 100644
--- a/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst
@@ -317,23 +317,27 @@ The following is a typical example of use:
type List is private with
Iterable => (First => First_Cursor,
Next => Advance,
- Has_Element => Cursor_Has_Element,
- [Element => Get_Element]);
+ Has_Element => Cursor_Has_Element
+ [,Element => Get_Element]
+ [,Last => Last_Cursor]
+ [,Previous => Retreat]);
-* The value denoted by ``First`` must denote a primitive operation of the
- container type that returns a ``Cursor``, which must a be a type declared in
+* The values of ``First`` and ``Last`` are primitive operations of the
+ container type that return a ``Cursor``, which must be a type declared in
the container package or visible from it. For example:
.. code-block:: ada
function First_Cursor (Cont : Container) return Cursor;
+ function Last_Cursor (Cont : Container) return Cursor;
-* The value of ``Next`` is a primitive operation of the container type that takes
- both a container and a cursor and yields a cursor. For example:
+* The values of ``Next`` and ``Previous`` are primitive operations of the container type that take
+ both a container and a cursor and yield a cursor. For example:
.. code-block:: ada
function Advance (Cont : Container; Position : Cursor) return Cursor;
+ function Retreat (Cont : Container; Position : Cursor) return Cursor;
* The value of ``Has_Element`` is a primitive operation of the container type
that takes both a container and a cursor and yields a boolean. For example:
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 52d47d9..d28bb08 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -2079,7 +2079,8 @@ package body Exp_Attr is
case Id is
- -- Attributes related to Ada 2012 iterators
+ -- Attributes related to Ada 2012 iterators. They are only allowed in
+ -- attribute definition clauses and should never be expanded.
when Attribute_Constant_Indexing
| Attribute_Default_Iterator
@@ -2088,7 +2089,7 @@ package body Exp_Attr is
| Attribute_Iterator_Element
| Attribute_Variable_Indexing
=>
- null;
+ raise Program_Error;
-- Internal attributes used to deal with Ada 2012 delayed aspects. These
-- were already rejected by the parser. Thus they shouldn't appear here.
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index fe2f434..e63c757 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -9774,33 +9774,37 @@ The following is a typical example of use:
type List is private with
Iterable => (First => First_Cursor,
Next => Advance,
- Has_Element => Cursor_Has_Element,
- [Element => Get_Element]);
+ Has_Element => Cursor_Has_Element
+ [,Element => Get_Element]
+ [,Last => Last_Cursor]
+ [,Previous => Retreat]);
@end example
@itemize *
@item
-The value denoted by @code{First} must denote a primitive operation of the
-container type that returns a @code{Cursor}, which must a be a type declared in
+The values of @code{First} and @code{Last} are primitive operations of the
+container type that return a @code{Cursor}, which must be a type declared in
the container package or visible from it. For example:
@end itemize
@example
function First_Cursor (Cont : Container) return Cursor;
+function Last_Cursor (Cont : Container) return Cursor;
@end example
@itemize *
@item
-The value of @code{Next} is a primitive operation of the container type that takes
-both a container and a cursor and yields a cursor. For example:
+The values of @code{Next} and @code{Previous} are primitive operations of the container type that take
+both a container and a cursor and yield a cursor. For example:
@end itemize
@example
function Advance (Cont : Container; Position : Cursor) return Cursor;
+function Retreat (Cont : Container; Position : Cursor) return Cursor;
@end example
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index e1a4192a..9865ef6 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -29308,8 +29308,8 @@ to permit their use in free software.
@printindex ge
-@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ }
@anchor{cf}@w{ }
+@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{ }
@c %**end of body
@bye
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 4d1644b..9403798 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -6959,6 +6959,7 @@ package body Sem_Ch13 is
if Nkind (Expr) /= N_Aggregate then
Error_Msg_N ("aspect Iterable must be an aggregate", Expr);
+ return;
end if;
declare
@@ -6969,7 +6970,9 @@ package body Sem_Ch13 is
while Present (Assoc) loop
Analyze (Expression (Assoc));
- if not Is_Entity_Name (Expression (Assoc)) then
+ if not Is_Entity_Name (Expression (Assoc))
+ or else Ekind (Entity (Expression (Assoc))) /= E_Function
+ then
Error_Msg_N ("value must be a function", Assoc);
end if;
@@ -15875,22 +15878,34 @@ package body Sem_Ch13 is
Ent := Entity (N);
F1 := First_Formal (Ent);
+ F2 := Next_Formal (F1);
- if Nam in Name_First | Name_Last then
+ if Nam = Name_First then
- -- First or Last (Container) => Cursor
+ -- First (Container) => Cursor
if Etype (Ent) /= Cursor then
Error_Msg_N ("primitive for First must yield a cursor", N);
+ elsif Present (F2) then
+ Error_Msg_N ("no match for First iterable primitive", N);
+ end if;
+
+ elsif Nam = Name_Last then
+
+ -- Last (Container) => Cursor
+
+ if Etype (Ent) /= Cursor then
+ Error_Msg_N ("primitive for Last must yield a cursor", N);
+ elsif Present (F2) then
+ Error_Msg_N ("no match for Last iterable primitive", N);
end if;
elsif Nam = Name_Next then
-- Next (Container, Cursor) => Cursor
- F2 := Next_Formal (F1);
-
- if Etype (F2) /= Cursor
+ if No (F2)
+ or else Etype (F2) /= Cursor
or else Etype (Ent) /= Cursor
or else Present (Next_Formal (F2))
then
@@ -15901,9 +15916,8 @@ package body Sem_Ch13 is
-- Previous (Container, Cursor) => Cursor
- F2 := Next_Formal (F1);
-
- if Etype (F2) /= Cursor
+ if No (F2)
+ or else Etype (F2) /= Cursor
or else Etype (Ent) /= Cursor
or else Present (Next_Formal (F2))
then
@@ -15914,9 +15928,8 @@ package body Sem_Ch13 is
-- Has_Element (Container, Cursor) => Boolean
- F2 := Next_Formal (F1);
-
- if Etype (F2) /= Cursor
+ if No (F2)
+ or else Etype (F2) /= Cursor
or else Etype (Ent) /= Standard_Boolean
or else Present (Next_Formal (F2))
then
@@ -15924,7 +15937,8 @@ package body Sem_Ch13 is
end if;
elsif Nam = Name_Element then
- F2 := Next_Formal (F1);
+
+ -- Element (Container, Cursor) => Element_Type;
if No (F2)
or else Etype (F2) /= Cursor
@@ -17084,34 +17098,41 @@ package body Sem_Ch13 is
------------------------------
procedure Validate_Iterable_Aspect (Typ : Entity_Id; ASN : Node_Id) is
+ Aggr : constant Node_Id := Expression (ASN);
Assoc : Node_Id;
Expr : Node_Id;
Prim : Node_Id;
- Cursor : constant Entity_Id := Get_Cursor_Type (ASN, Typ);
+ Cursor : Entity_Id;
- First_Id : Entity_Id;
- Last_Id : Entity_Id;
- Next_Id : Entity_Id;
- Has_Element_Id : Entity_Id;
- Element_Id : Entity_Id;
+ First_Id : Entity_Id := Empty;
+ Last_Id : Entity_Id := Empty;
+ Next_Id : Entity_Id := Empty;
+ Has_Element_Id : Entity_Id := Empty;
+ Element_Id : Entity_Id := Empty;
begin
+ if Nkind (Aggr) /= N_Aggregate then
+ Error_Msg_N ("aspect Iterable must be an aggregate", Aggr);
+ return;
+ end if;
+
+ Cursor := Get_Cursor_Type (ASN, Typ);
+
-- If previous error aspect is unusable
if Cursor = Any_Type then
return;
end if;
- First_Id := Empty;
- Last_Id := Empty;
- Next_Id := Empty;
- Has_Element_Id := Empty;
- Element_Id := Empty;
+ if not Is_Empty_List (Expressions (Aggr)) then
+ Error_Msg_N
+ ("illegal positional association", First (Expressions (Aggr)));
+ end if;
-- Each expression must resolve to a function with the proper signature
- Assoc := First (Component_Associations (Expression (ASN)));
+ Assoc := First (Component_Associations (Aggr));
while Present (Assoc) loop
Expr := Expression (Assoc);
Analyze (Expr);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index ecfb49a..d0a4a07 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10894,7 +10894,7 @@ package body Sem_Util is
-- First.
Assoc := First (Component_Associations (Expression (Aspect)));
- First_Op := Any_Id;
+ First_Op := Any_Id;
while Present (Assoc) loop
if Chars (First (Choices (Assoc))) = Name_First then
First_Op := Expression (Assoc);
generated by cgit v1.1 at 2024-07-18 13:29:25 +0000