From e7f4682af254be73f91ddbb543bc0bc3fcd27659 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 22 Jul 2019 13:57:09 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 5 ++ gcc/ada/sem_ch8.adb | 10 +-- gcc/testsuite/ChangeLog | 4 + gcc/testsuite/gnat.dg/iter5.adb | 10 +++ gcc/testsuite/gnat.dg/iter5_pkg.ads | 127 ++++++++++++++++++++++++++++ 5 files changed, 148 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/iter5.adb create mode 100644 gcc/testsuite/gnat.dg/iter5_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 85a0a268b22..0081c3e90ad 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-07-22 Eric Botcazou + + * sem_ch8.adb (Check_Constrained_Object): Further extend the + special optimization to all limited types. + 2019-07-22 Eric Botcazou * exp_attr.adb (Expand_N_Attribute_Reference) diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index c9d61511af3..9caddccf1e4 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 da0bf2a8918..94fc5796dea 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-07-22 Eric Botcazou + + * gnat.dg/iter5.adb, gnat.dg/iter5_pkg.ads: New testcase. + 2019-07-22 Eric Botcazou * 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 index 00000000000..b17b43517c4 --- /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 00000000000..0449f3bd0af --- /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; -- 2.30.2