[Ada] Internal error on iterator for limited private discriminated type

This patch further extends the short-circuit, aka optimization, present
in the Check_Constrained_Object procedure used for renaming declarations
to all limited types, so as to prevent type mismatches downstream in
more cases.

2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* sem_ch8.adb (Check_Constrained_Object): Further extend the
	special optimization to all limited types.

gcc/testsuite/

	* gnat.dg/iter5.adb, gnat.dg/iter5_pkg.ads: New testcase.

From-SVN: r273677

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 85a0a268b2259272f95ef3d80759c48d2d682095..0081c3e90ade82047c9c1c8d3fa436dbdb37df48 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * sem_ch8.adb (Check_Constrained_Object): Further extend the
+       special optimization to all limited types.
+
 2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
 
        * exp_attr.adb (Expand_N_Attribute_Reference)

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index c9d61511af3410ff1c12b6ca0d2941f7ff6ad2ac..9caddccf1e47ec43ec9e5a3e7f152866293056b7 100644 (file)
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -809,18 +809,12 @@ package body Sem_Ch8 is
             --  in particular with record types with an access discriminant
             --  that are used in iterators. This is an optimization, but it
             --  also prevents typing anomalies when the prefix is further
-            --  expanded. This also applies to limited types with access
-            --  discriminants.
+            --  expanded.
             --  Note that we cannot just use the Is_Limited_Record flag because
             --  it does not apply to records with limited components, for which
             --  this syntactic flag is not set, but whose size is also fixed.
 
-            elsif (Is_Record_Type (Typ) and then Is_Limited_Type (Typ))
-              or else
-                (Ekind (Typ) = E_Limited_Private_Type
-                  and then Has_Discriminants (Typ)
-                  and then Is_Access_Type (Etype (First_Discriminant (Typ))))
-            then
+            elsif Is_Limited_Type (Typ) then
                null;
 
             else

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index da0bf2a89188fe43d88187260fbeadea4087c3ee..94fc5796deaef6c38dc2274e53a63945a4ad69c3 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/iter5.adb, gnat.dg/iter5_pkg.ads: New testcase.
+
 2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/enum_val1.adb: New testcase.

diff --git a/gcc/testsuite/gnat.dg/iter5.adb b/gcc/testsuite/gnat.dg/iter5.adb
new file mode 100644 (file)
index 0000000..b17b435
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/iter5.adb
@@ -0,0 +1,10 @@
+--  { dg-do compile }
+
+with Iter5_Pkg;
+
+procedure Iter5 is
+begin
+   for The_Filename of Iter5_Pkg.Iterator_For ("C:\Program_Files") loop
+      null;
+   end loop;
+end Iter5;

diff --git a/gcc/testsuite/gnat.dg/iter5_pkg.ads b/gcc/testsuite/gnat.dg/iter5_pkg.ads
new file mode 100644 (file)
index 0000000..0449f3b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/iter5_pkg.ads
@@ -0,0 +1,127 @@
+with Ada.Calendar;
+with Ada.Directories;
+
+with Ada.Iterator_Interfaces;
+
+package Iter5_Pkg is
+
+  subtype Size is Ada.Directories.File_Size;
+
+  type Folder is new String;
+
+  function Folder_Separator return Character;
+
+  function "+" (Directory : String) return Folder;
+
+  function "+" (Left, Right : String) return Folder;
+
+  function "+" (Left  : Folder;
+                Right : String) return Folder;
+
+  function Composure (Directory : Folder;
+                      Filename  : String;
+                      Extension : String) return String;
+
+  function Composure (Directory : String;
+                      Filename  : String;
+                      Extension : String) return String;
+  -- no exception
+
+  function Base_Name_Of (Name : String) return String
+    renames Ada.Directories.Base_Name;
+
+  function Extension_Of (Name : String) return String
+    renames Ada.Directories.Extension;
+
+  function Containing_Directory_Of (Name : String) return String
+    renames Ada.Directories.Containing_Directory;
+
+  function Exists (Name : String) return Boolean;
+  -- no exception
+
+  function Size_Of (Name : String) return Size renames Ada.Directories.Size;
+
+  function Directory_Exists (Name : String) return Boolean;
+  -- no exception
+
+  function Modification_Time_Of (Name : String) return Ada.Calendar.Time
+    renames Ada.Directories.Modification_Time;
+
+  function Is_Newer (The_Name  : String;
+                     Than_Name : String) return Boolean;
+
+  procedure Delete (Name : String);
+  -- no exception if no existance
+
+  procedure Create_Directory (Path : String);
+  -- creates the whole directory path
+
+  procedure Delete_Directory (Name : String); -- including contents
+  -- no exception if no existance
+
+  procedure Rename (Old_Name : String;
+                    New_Name : String) renames Ada.Directories.Rename;
+
+  procedure Copy (Source_Name   : String;
+                  Target_Name   : String;
+                  Form          : String := "")
+    renames Ada.Directories.Copy_File;
+
+  function Is_Leaf_Directory (Directory : String) return Boolean;
+
+  procedure Iterate_Over_Leaf_Directories (From_Directory : String;
+                                           Iterator : access procedure
+                                             (Leaf_Directory : String));
+
+  function Found_Directory (Simple_Name  : String;
+                            In_Directory : String) return String;
+
+  Not_Found : exception;
+
+  Name_Error : exception renames Ada.Directories.Name_Error;
+  Use_Error  : exception renames Ada.Directories.Use_Error;
+
+  ------------------------
+  -- File Iterator Loop --
+  ------------------------
+  -- Example:
+  --          for The_Filename of Iter5_Pkg.Iterator_For ("C:\Program_Files") loop
+  --            Log.Write (The_Filename);
+  --          end loop;
+
+  type Item (Name_Length : Natural) is limited private;
+
+  function Iterator_For (Name : String) return Item;
+
+private
+  type Cursor;
+
+  function Has_More (Data : Cursor) return Boolean;
+
+  package List_Iterator_Interfaces is
+    new Ada.Iterator_Interfaces (Cursor, Has_More);
+
+  function Iterate (The_Item : Item)
+    return List_Iterator_Interfaces.Forward_Iterator'class;
+
+  type Cursor_Data is record
+    Has_More : Boolean := False;
+    Position : Ada.Directories.Search_Type;
+  end record;
+
+  type Cursor is access all Cursor_Data;
+
+  function Constant_Reference (The_Item     : aliased Item;
+                               Unused_Index : Cursor) return String;
+
+  type Item (Name_Length : Natural) is tagged limited record
+    Name   : String(1..Name_Length);
+    Actual : Ada.Directories.Directory_Entry_Type;
+    Data   : aliased Cursor_Data;
+  end record
+  with
+    Constant_Indexing => Constant_Reference,
+    Default_Iterator  => Iterate,
+    Iterator_Element  => String;
+
+end Iter5_Pkg;