diff options
Diffstat (limited to 'gcc')
| -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; |