[Ada] Crash on misplaced First operation for GNAT iterable type

[Pierre-Marie de Rodat]

This patch improves the handling of an improper declaaration of aspect
First for a GNAT-defined iterable type,

Tested on x86_64-pc-linux-gnu, committed on trunk

2018-12-11  Ed Schonberg  <schonb...@adacore.com>

gcc/ada/

        * sem_util.adb (Get_Actual_Subtype): Function can return type
        mark.
        (Get_Cursor_Type): Improve recovery and error message on a
        misplaced First aspect for an iterable type.

gcc/testsuite/

        * gnat.dg/iter4.adb: New testcase.
--- gcc/ada/sem_util.adb
+++ gcc/ada/sem_util.adb
@@ -9049,6 +9049,13 @@ package body Sem_Util is
 
          else
             Decl := Build_Actual_Subtype (Typ, N);
+
+            --  The call may yield a declaration, or just return the entity
+
+            if Decl = Typ then
+               return Typ;
+            end if;
+
             Atyp := Defining_Identifier (Decl);
 
             --  If Build_Actual_Subtype generated a new declaration then use it
@@ -9162,6 +9169,9 @@ package body Sem_Util is
       if First_Op = Any_Id then
          Error_Msg_N ("aspect Iterable must specify First operation", Aspect);
          return Any_Type;
+
+      elsif not Analyzed (First_Op) then
+         Analyze (First_Op);
       end if;
 
       Cursor := Any_Type;
@@ -9195,7 +9205,8 @@ package body Sem_Util is
 
       if Cursor = Any_Type then
          Error_Msg_N
-           ("No legal primitive operation First for Iterable type", Aspect);
+           ("primitive operation for Iterable type must appear "
+             & "in the same list of declarations as the type", Aspect);
       end if;
 
       return Cursor;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/iter4.adb
@@ -0,0 +1,36 @@
+--  { dg-do compile }
+
+procedure Iter4 is
+   package Root is
+      type Result is tagged record
+         B : Boolean;
+      end record;
+
+      type T is tagged record
+         I : Integer;
+      end record
+      with Iterable => (First       => Pkg.First, --  { dg-error "primitive operation for Iterable type must appear in the same list of declarations as the type" }
+                        Next        => Pkg.Next,
+                        Has_Element => Pkg.Has_Element,
+                        Element     => Pkg.Element);
+
+      package Pkg is
+         function First (Dummy : T) return Natural is (0);
+         function Next (Dummy : T; Cursor : Natural) return Natural is
+           (Cursor + 1);
+         function Has_Element (Value : T; Cursor : Natural) return Boolean is
+           (Cursor <= Value.I);
+         function Element (Dummy : T; Cursor : Natural) return Result is
+           ((B => Cursor mod 2 = 0));
+      end Pkg;
+   end Root;
+
+   package Derived is
+      type T is new Root.T with record
+         C : Character;
+      end record;
+   end Derived;
+
+begin
+   null;
+end;