From 75a957f5dba310b73a1d040da70f6e4077379af4 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 20 Apr 2016 12:45:55 +0200 Subject: [PATCH] [multiple changes] 2016-04-20 Hristian Kirtchev * einfo.adb Flag286 is now used as Is_Exception_Handler. (Is_Exception_Handler): New routine. (Set_Is_Exception_Handler): New routine. (Write_Entity_Flags): Output the status of Is_Exception_Handler. * einfo.ads New attribute Is_Exception_Handler along with occurrences in entities. (Is_Exception_Handler): New routine along with pragma Inline. (Set_Is_Exception_Handler): New routine along with pragma Inline. * exp_ch7.adb (Make_Transient_Block): Ignore blocks generated for exception handlers with a choice parameter. * sem_ch11.adb (Analyze_Exception_Handlers): Mark the scope generated for a choice parameter as an exception handler. 2016-04-20 Ed Schonberg * sem_ch3.adb (Build_Derived_Access_Type): Remove dead code. (Constrain_Discriminated_Type): In an instance, if the type has unknown discriminants, use its full view. (Process_Subtype): Check that the base type is private before adding subtype to Private_Dependents list. 2016-04-20 Bob Duff * sem_ch13.adb: Minor comment fix. From-SVN: r235264 --- gcc/ada/ChangeLog | 27 +++++++++++++++++++++++++++ gcc/ada/einfo.adb | 27 ++++++++++++++++++++------- gcc/ada/einfo.ads | 10 ++++++++++ gcc/ada/exp_ch7.adb | 20 ++++++++++++++------ gcc/ada/sem_ch11.adb | 13 +++++++------ gcc/ada/sem_ch13.adb | 8 ++++---- gcc/ada/sem_ch3.adb | 31 ++++++++++++++++++++----------- 7 files changed, 102 insertions(+), 34 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1409c795e35..b187ef1d04b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2016-04-20 Hristian Kirtchev + + * einfo.adb Flag286 is now used as Is_Exception_Handler. + (Is_Exception_Handler): New routine. + (Set_Is_Exception_Handler): New routine. + (Write_Entity_Flags): Output the status of Is_Exception_Handler. + * einfo.ads New attribute Is_Exception_Handler along with + occurrences in entities. + (Is_Exception_Handler): New routine along with pragma Inline. + (Set_Is_Exception_Handler): New routine along with pragma Inline. + * exp_ch7.adb (Make_Transient_Block): Ignore blocks generated + for exception handlers with a choice parameter. + * sem_ch11.adb (Analyze_Exception_Handlers): Mark the scope + generated for a choice parameter as an exception handler. + +2016-04-20 Ed Schonberg + + * sem_ch3.adb (Build_Derived_Access_Type): Remove dead code. + (Constrain_Discriminated_Type): In an instance, if the type has + unknown discriminants, use its full view. + (Process_Subtype): Check that the base type is private before + adding subtype to Private_Dependents list. + +2016-04-20 Bob Duff + + * sem_ch13.adb: Minor comment fix. + 2016-04-20 Yannick Moy * sem_ch4.adb: Fix typos in comments. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 99e52d3b2b8..5586ea7a268 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -597,7 +597,7 @@ package body Einfo is -- Is_Uplevel_Referenced_Entity Flag283 -- Is_Unimplemented Flag284 -- Is_Volatile_Full_Access Flag285 - -- (unused) Flag286 + -- Is_Exception_Handler Flag286 -- Rewritten_For_C Flag287 -- (unused) Flag288 @@ -1976,12 +1976,6 @@ package body Einfo is return Flag146 (Id); end Is_Abstract_Type; - function Is_Local_Anonymous_Access (Id : E) return B is - begin - pragma Assert (Is_Access_Type (Id)); - return Flag194 (Id); - end Is_Local_Anonymous_Access; - function Is_Access_Constant (Id : E) return B is begin pragma Assert (Is_Access_Type (Id)); @@ -2137,6 +2131,12 @@ package body Einfo is return Flag52 (Id); end Is_Entry_Formal; + function Is_Exception_Handler (Id : E) return B is + begin + pragma Assert (Ekind (Id) = E_Block); + return Flag286 (Id); + end Is_Exception_Handler; + function Is_Exported (Id : E) return B is begin return Flag99 (Id); @@ -2307,6 +2307,12 @@ package body Einfo is return Flag25 (Id); end Is_Limited_Record; + function Is_Local_Anonymous_Access (Id : E) return B is + begin + pragma Assert (Is_Access_Type (Id)); + return Flag194 (Id); + end Is_Local_Anonymous_Access; + function Is_Machine_Code_Subprogram (Id : E) return B is begin pragma Assert (Is_Subprogram (Id)); @@ -5146,6 +5152,12 @@ package body Einfo is Set_Flag52 (Id, V); end Set_Is_Entry_Formal; + procedure Set_Is_Exception_Handler (Id : E; V : B := True) is + begin + pragma Assert (Ekind (Id) = E_Block); + Set_Flag286 (Id, V); + end Set_Is_Exception_Handler; + procedure Set_Is_Exported (Id : E; V : B := True) is begin Set_Flag99 (Id, V); @@ -8956,6 +8968,7 @@ package body Einfo is W ("Is_Dispatching_Operation", Flag6 (Id)); W ("Is_Eliminated", Flag124 (Id)); W ("Is_Entry_Formal", Flag52 (Id)); + W ("Is_Exception_Handler", Flag286 (Id)); W ("Is_Exported", Flag99 (Id)); W ("Is_First_Subtype", Flag70 (Id)); W ("Is_For_Access_Subtype", Flag118 (Id)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index e55c6762bb2..535fa39fc74 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2428,6 +2428,11 @@ package Einfo is -- Is_Enumeration_Type (synthesized) -- Defined in all entities, true for enumeration types and subtypes +-- Is_Exception_Handler (Flag286) +-- Defined in blocks. Set if the block serves only as a scope of an +-- exception handler with a choice parameter. Such a block does not +-- physically appear in the tree. + -- Is_Exported (Flag99) -- Defined in all entities. Set if the entity is exported. For now we -- only allow the export of constants, exceptions, functions, procedures @@ -5621,6 +5626,7 @@ package Einfo is -- Discard_Names (Flag88) -- Has_Master_Entity (Flag21) -- Has_Nested_Block_With_Handler (Flag101) + -- Is_Exception_Handler (Flag286) -- Sec_Stack_Needed_For_Return (Flag167) -- Uses_Sec_Stack (Flag95) -- Scope_Depth (synth) @@ -6971,6 +6977,7 @@ package Einfo is function Is_Dispatching_Operation (Id : E) return B; function Is_Eliminated (Id : E) return B; function Is_Entry_Formal (Id : E) return B; + function Is_Exception_Handler (Id : E) return B; function Is_Exported (Id : E) return B; function Is_First_Subtype (Id : E) return B; function Is_For_Access_Subtype (Id : E) return B; @@ -7634,6 +7641,7 @@ package Einfo is procedure Set_Is_Dispatching_Operation (Id : E; V : B := True); procedure Set_Is_Eliminated (Id : E; V : B := True); procedure Set_Is_Entry_Formal (Id : E; V : B := True); + procedure Set_Is_Exception_Handler (Id : E; V : B := True); procedure Set_Is_Exported (Id : E; V : B := True); procedure Set_Is_First_Subtype (Id : E; V : B := True); procedure Set_Is_For_Access_Subtype (Id : E; V : B := True); @@ -8434,6 +8442,7 @@ package Einfo is pragma Inline (Is_Entry); pragma Inline (Is_Entry_Formal); pragma Inline (Is_Enumeration_Type); + pragma Inline (Is_Exception_Handler); pragma Inline (Is_Exported); pragma Inline (Is_First_Subtype); pragma Inline (Is_Fixed_Point_Type); @@ -8923,6 +8932,7 @@ package Einfo is pragma Inline (Set_Is_Dispatching_Operation); pragma Inline (Set_Is_Eliminated); pragma Inline (Set_Is_Entry_Formal); + pragma Inline (Set_Is_Exception_Handler); pragma Inline (Set_Is_Exported); pragma Inline (Set_Is_First_Subtype); pragma Inline (Set_Is_For_Access_Subtype); diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 60ea45b97d3..04b60b5c59d 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -7993,14 +7993,22 @@ package body Exp_Ch7 is elsif Ekind_In (S, E_Entry, E_Loop) then exit; - -- In a procedure or a block, we release on exit of the - -- procedure or block. ??? memory leak can be created by - -- recursive calls. - - elsif Ekind_In (S, E_Block, E_Procedure) then + -- In a procedure or a block, release the sec stack on exit + -- from the construct. Note that an exception handler with a + -- choice parameter requires a declarative region in the form + -- of a block. The block does not physically manifest in the + -- tree as it only serves as a scope. Do not consider such a + -- block because it will never release the sec stack. + + -- ??? Memory leak can be created by recursive calls + + elsif Ekind (S) = E_Procedure + or else (Ekind (S) = E_Block + and then not Is_Exception_Handler (S)) + then + Set_Uses_Sec_Stack (Current_Scope, False); Set_Uses_Sec_Stack (S, True); Check_Restriction (No_Secondary_Stack, Action); - Set_Uses_Sec_Stack (Current_Scope, False); exit; else diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index 0b9f8ef829d..e03ec1cb4ea 100644 --- a/gcc/ada/sem_ch11.adb +++ b/gcc/ada/sem_ch11.adb @@ -214,6 +214,7 @@ package body Sem_Ch11 is H_Scope := New_Internal_Entity (E_Block, Current_Scope, Sloc (Choice), 'E'); + Set_Is_Exception_Handler (H_Scope); end if; Push_Scope (H_Scope); @@ -318,11 +319,11 @@ package body Sem_Ch11 is N_Formal_Package_Declaration then Error_Msg_NE - ("exception& is declared in " & - "generic formal package", Id, Ent); + ("exception& is declared in generic formal " + & "package", Id, Ent); Error_Msg_N - ("\and therefore cannot appear in " & - "handler (RM 11.2(8))", Id); + ("\and therefore cannot appear in handler " + & "(RM 11.2(8))", Id); exit; -- If the exception is declared in an inner @@ -362,8 +363,8 @@ package body Sem_Ch11 is Analyze_Statements (Statements (Handler)); - -- If a choice was present, we created a special scope for it, - -- so this is where we pop that special scope to get rid of it. + -- If a choice was present, we created a special scope for it, so + -- this is where we pop that special scope to get rid of it. if Present (Choice) then End_Scope; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 77909a6f542..859e67e3c67 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -10847,10 +10847,10 @@ package body Sem_Ch13 is -- After all forms of overriding have been resolved, a tagged type may -- be left with a set of implicitly declared and possibly erroneous -- abstract subprograms, null procedures and subprograms that require - -- overriding. If this set contains fully conformat homographs, then one - -- is chosen arbitrarily (already done during resolution), otherwise all - -- remaining non-fully conformant homographs are hidden from visibility - -- (Ada RM 8.3 12.3/2). + -- overriding. If this set contains fully conformant homographs, then + -- one is chosen arbitrarily (already done during resolution), otherwise + -- all remaining non-fully conformant homographs are hidden from + -- visibility (Ada RM 8.3 12.3/2). if Is_Tagged_Type (E) then Hide_Non_Overridden_Subprograms (E); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index f2e111536cd..cc82e710795 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -5962,16 +5962,6 @@ package body Sem_Ch3 is if Null_Exclusion_Present (Type_Definition (N)) then Set_Can_Never_Be_Null (Derived_Type); - -- What is with the "AND THEN FALSE" here ??? - - if Can_Never_Be_Null (Parent_Type) - and then False - then - Error_Msg_NE - ("`NOT NULL` not allowed (& already excludes null)", - N, Parent_Type); - end if; - elsif Can_Never_Be_Null (Parent_Type) then Set_Can_Never_Be_Null (Derived_Type); end if; @@ -5983,6 +5973,7 @@ package body Sem_Ch3 is -- ??? THIS CODE SHOULD NOT BE HERE REALLY. Desig_Type := Designated_Type (Derived_Type); + if Is_Composite_Type (Desig_Type) and then (not Is_Array_Type (Desig_Type)) and then Has_Discriminants (Desig_Type) @@ -13048,6 +13039,18 @@ package body Sem_Ch3 is T := Designated_Type (T); end if; + -- In an instance it may be necessary to retrieve the full view of a + -- type with unknown discriminants. In other contexts the constraint + -- is illegal. + + if In_Instance + and then Is_Private_Type (T) + and then Has_Unknown_Discriminants (T) + and then Present (Full_View (T)) + then + T := Full_View (T); + end if; + -- Ada 2005 (AI-412): Constrained incomplete subtypes are illegal. -- Avoid generating an error for access-to-incomplete subtypes. @@ -20745,7 +20748,13 @@ package body Sem_Ch3 is when Private_Kind => Constrain_Discriminated_Type (Def_Id, S, Related_Nod); - Set_Private_Dependents (Def_Id, New_Elmt_List); + + -- The base type may be private but Def_Id may be a full view + -- in an instance. + + if Is_Private_Type (Def_Id) then + Set_Private_Dependents (Def_Id, New_Elmt_List); + end if; -- In case of an invalid constraint prevent further processing -- since the type constructed is missing expected fields. -- 2.30.2