diff options
author | Ed Schonberg <schonberg@adacore.com> | 2018-08-21 14:49:42 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2018-08-21 14:49:42 +0000 |
commit | 084e3bd183b1b7253f1216b5b165bde7bfbf6bf6 (patch) | |
tree | 15c1266f3c0df930ae6ce191b1a33c0e4c9831dc | |
parent | 0db1c3863d5167dd47e5a0ab4a714ace875a9202 (diff) | |
download | gcc-084e3bd183b1b7253f1216b5b165bde7bfbf6bf6.zip gcc-084e3bd183b1b7253f1216b5b165bde7bfbf6bf6.tar.gz gcc-084e3bd183b1b7253f1216b5b165bde7bfbf6bf6.tar.bz2 |
[Ada] Crash on expression function and tagged types
This patch fixes a compiler abort on an expression function whose
expression includes tagged types that have not been frozen before the
generated body of the function is analyzed, even though that body is
inserted at the end of the current declarative part.
2018-08-21 Ed Schonberg <schonberg@adacore.com>
gcc/ada/
* sem_ch6.adb (Analyze_Subprogram_Body_Helper, Mask_Type):
Refine the handling of freezing types for expression functions
that are not completions, when analyzing the generated body for
the function: the body is inserted at the end of the enclosing
declarative part, and its analysis may freeze types declared in
the same scope that have not been frozen yet.
gcc/testsuite/
* gnat.dg/expr_func7.adb, gnat.dg/expr_func7.ads: New testcase.
From-SVN: r263735
-rw-r--r-- | gcc/ada/ChangeLog | 9 | ||||
-rw-r--r-- | gcc/ada/sem_ch6.adb | 36 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/expr_func7.adb | 5 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/expr_func7.ads | 20 |
5 files changed, 58 insertions, 16 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ca38083..503aa06 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,14 @@ 2018-08-21 Ed Schonberg <schonberg@adacore.com> + * sem_ch6.adb (Analyze_Subprogram_Body_Helper, Mask_Type): + Refine the handling of freezing types for expression functions + that are not completions, when analyzing the generated body for + the function: the body is inserted at the end of the enclosing + declarative part, and its analysis may freeze types declared in + the same scope that have not been frozen yet. + +2018-08-21 Ed Schonberg <schonberg@adacore.com> + * sem_ch6.adb: Remove Freeze_Expr_Types. * freeze.ads, freeze.adb (Freeze_Expr_Types): Moved from sem_ch6.adb, and extended to handle other expressions that may diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 5548c81..3e0cae1 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -3145,8 +3145,12 @@ package body Sem_Ch6 is end if; if not Is_Frozen (Typ) then - Set_Is_Frozen (Typ); - Append_New_Elmt (Typ, Result); + if Scope (Typ) /= Current_Scope then + Set_Is_Frozen (Typ); + Append_New_Elmt (Typ, Result); + else + Freeze_Before (N, Typ); + end if; end if; end Mask_Type; @@ -3636,28 +3640,28 @@ package body Sem_Ch6 is -- They are necessary in any case to insure order of elaboration -- in gigi. - if not Is_Frozen (Spec_Id) + if Nkind (N) = N_Subprogram_Body + and then Was_Expression_Function (N) + and then not Has_Completion (Spec_Id) + and then Serious_Errors_Detected = 0 and then (Expander_Active or else ASIS_Mode - or else (Operating_Mode = Check_Semantics - and then Serious_Errors_Detected = 0)) + or else Operating_Mode = Check_Semantics) then -- The body generated for an expression function that is not a -- completion is a freeze point neither for the profile nor for -- anything else. That's why, in order to prevent any freezing -- during analysis, we need to mask types declared outside the - -- expression that are not yet frozen. + -- expression (and in an outer scope) that are not yet frozen. - if Nkind (N) = N_Subprogram_Body - and then Was_Expression_Function (N) - and then not Has_Completion (Spec_Id) - then - Set_Is_Frozen (Spec_Id); - Mask_Types := Mask_Unfrozen_Types (Spec_Id); - else - Set_Has_Delayed_Freeze (Spec_Id); - Freeze_Before (N, Spec_Id); - end if; + Set_Is_Frozen (Spec_Id); + Mask_Types := Mask_Unfrozen_Types (Spec_Id); + + elsif not Is_Frozen (Spec_Id) + and then Serious_Errors_Detected = 0 + then + Set_Has_Delayed_Freeze (Spec_Id); + Freeze_Before (N, Spec_Id); end if; end if; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 444f3e8..6a6e226 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,9 @@ 2018-08-21 Ed Schonberg <schonberg@adacore.com> + * gnat.dg/expr_func7.adb, gnat.dg/expr_func7.ads: New testcase. + +2018-08-21 Ed Schonberg <schonberg@adacore.com> + * gnat.dg/expr_func6.adb, gnat.dg/expr_func6.ads: New testcase. 2018-08-21 Javier Miranda <miranda@adacore.com> diff --git a/gcc/testsuite/gnat.dg/expr_func7.adb b/gcc/testsuite/gnat.dg/expr_func7.adb new file mode 100644 index 0000000..048af62 --- /dev/null +++ b/gcc/testsuite/gnat.dg/expr_func7.adb @@ -0,0 +1,5 @@ +-- { dg-do compile } + +package body Expr_Func7 is + procedure Dummy is null; +end Expr_Func7; diff --git a/gcc/testsuite/gnat.dg/expr_func7.ads b/gcc/testsuite/gnat.dg/expr_func7.ads new file mode 100644 index 0000000..47fc6f8 --- /dev/null +++ b/gcc/testsuite/gnat.dg/expr_func7.ads @@ -0,0 +1,20 @@ +package Expr_Func7 is + + type Abstract_Food is tagged null record; + type Abstract_Food_Access is access Abstract_Food'Class; + + type Fruit is new Abstract_Food with record + Worm : Boolean; + end record; + + type Bananas is tagged record + Inside : Abstract_Food_Access; + end record; + + function Has_Worm + (B : Bananas) return Boolean is (Fruit (B.Inside.all).Worm); + + Cool : Bananas; + + procedure Dummy; +end Expr_Func7; |