diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2019-07-22 13:57:09 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-07-22 13:57:09 +0000 |
commit | e7f4682af254be73f91ddbb543bc0bc3fcd27659 (patch) | |
tree | 2941b1fc84b3f7262d5c60e646621c1d9818cbd7 | |
parent | fd90c808628cead705bb4521d9b8beea0edcf2bf (diff) | |
download | gcc-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/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/ada/sem_ch8.adb | 10 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/iter5.adb | 10 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/iter5_pkg.ads | 127 |
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; |