[Ada] Improve detection of illegal Iterable aspects

Handling of aspect Iterable was lacking guards against illegal code, so
the compiler either crashed or emitted cryptic errors while expanding
loops that rely on this aspect.

gcc/ada/

	* doc/gnat_rm/implementation_defined_aspects.rst
	(Aspect Iterable): Include Last and Previous primitives in
	syntactic and semantic description.
	* exp_attr.adb
	(Expand_N_Attribute_Reference): Don't expect attributes like
	Iterable that can only appear in attribute definition clauses.
	* sem_ch13.adb
	(Analyze_Attribute_Definition_Clause): Prevent crash on
	non-aggregate Iterable attribute; improve basic diagnosis of
	attribute values.
	(Resolve_Iterable_Operation): Improve checks for illegal
	primitives in aspect Iterable, e.g. with wrong number of formal
	parameters.
	(Validate_Iterable_Aspect): Prevent crashes on syntactically
	illegal aspect expression.
	* sem_util.adb
	(Get_Cursor_Type): Fix style.
	* gnat_ugn.texi, gnat_rm.texi: Regenerate.

diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst b/gcc/ada/doc/gnat_rm/implementation_defined_aspects.rst
index 6ef00c25ab61a13671436d234ef96525ef28ce78..4541f2bc70b23f391d3015b968f449353d7682a0 100644 (file)
--- 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 52d47d98ae66687411fbdab9b42fc4f3fd688ce6..d28bb0864150550bfa021aeb8031eed8b2b0ad7c 100644 (file)
--- 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 fe2f434ca4df0de5d8aef956e25423d1d67da560..e63c757ac0ff1f210af91e4aeb032bced7d8a043 100644 (file)
--- 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 e1a4192a9589b78755f0fabfbc5431cfdcc7ad7b..9865ef64fc1cd03726359cc290e1875414f03537 100644 (file)
--- 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 4d1644be0492cb5d5940f2d7b24ab54369418471..940379812306f2b96eb9a95381cba74442eff914 100644 (file)
--- 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 ecfb49a06a857a94a3fabe8c5d3086333f988d19..d0a4a0720da6e374f8e806fda825f615113357bd 100644 (file)
--- 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);