aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2019-07-22 13:57:09 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-07-22 13:57:09 +0000
commite7f4682af254be73f91ddbb543bc0bc3fcd27659 (patch)
tree2941b1fc84b3f7262d5c60e646621c1d9818cbd7
parentfd90c808628cead705bb4521d9b8beea0edcf2bf (diff)
downloadgcc-e7f4682af254be73f91ddbb543bc0bc3fcd27659.zip
gcc-e7f4682af254be73f91ddbb543bc0bc3fcd27659.tar.gz
gcc-e7f4682af254be73f91ddbb543bc0bc3fcd27659.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog5
-rw-r--r--gcc/ada/sem_ch8.adb10
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gnat.dg/iter5.adb10
-rw-r--r--gcc/testsuite/gnat.dg/iter5_pkg.ads127
5 files changed, 148 insertions, 8 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 85a0a26..0081c3e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,10 @@
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)
<Attribute_Enum_Val>: Set No_Truncation on the
N_Unchecked_Type_Conversion built around the argument passed to
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index c9d6151..9caddcc 100644
--- 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 da0bf2a..94fc579 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,9 @@
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.
2019-07-22 Nicolas Roche <roche@adacore.com>
diff --git a/gcc/testsuite/gnat.dg/iter5.adb b/gcc/testsuite/gnat.dg/iter5.adb
new file mode 100644
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
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;