From 6361db43b2a245e9b38cfb84d4f725e8c410812f Mon Sep 17 00:00:00 2001 From: Pierre-Marie de Rodat Date: Thu, 16 Nov 2017 09:56:46 +0000 Subject: [PATCH] [multiple changes] 2017-11-16 Ed Schonberg * sem_ch3.adb (Process_Subtype): If the subtype indication does not syntactically denote a type, return Any_Type to prevent subsequent compiler crashes or infinite loops. 2017-11-16 Steve Baird * lib-writ.adb: Fix bug which causes Program_Error to be raised in some cases when writing out a .ali file when a Rename_Pragma pragma is in effect. * lib-writ.adb (Write_Unit_Information): Replace call to Pragma_Name_Unmapped with call to Pragma_Name. 2017-11-16 Gary Dismukes * sem_elab.adb: Minor typo fixes. 2017-11-16 Justin Squirek * sem_res.adb (Resolve_Allocator): Correct warning messages and make them more explicit. From-SVN: r254803 --- gcc/ada/ChangeLog | 23 +++++++++++++++++++++++ gcc/ada/lib-writ.adb | 2 +- gcc/ada/sem_ch3.adb | 10 ++++++++++ gcc/ada/sem_elab.adb | 14 +++++++------- gcc/ada/sem_res.adb | 38 +++++++++++--------------------------- 5 files changed, 52 insertions(+), 35 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b18c46fef87..58291deed8c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2017-11-16 Ed Schonberg + + * sem_ch3.adb (Process_Subtype): If the subtype indication does not + syntactically denote a type, return Any_Type to prevent subsequent + compiler crashes or infinite loops. + +2017-11-16 Steve Baird + + * lib-writ.adb: Fix bug which causes Program_Error to be raised in some + cases when writing out a .ali file when a Rename_Pragma pragma is in + effect. + * lib-writ.adb (Write_Unit_Information): Replace call to + Pragma_Name_Unmapped with call to Pragma_Name. + +2017-11-16 Gary Dismukes + + * sem_elab.adb: Minor typo fixes. + +2017-11-16 Justin Squirek + + * sem_res.adb (Resolve_Allocator): Correct warning messages and make + them more explicit. + 2017-11-16 Hristian Kirtchev * atree.ads (Nkind_In): Add 10 and 11 parameter versions. diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index addc9a083c5..1ee329ee7f1 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -694,7 +694,7 @@ package body Lib.Writ is Write_Info_Initiate ('N'); Write_Info_Char (' '); - case Pragma_Name_Unmapped (N) is + case Pragma_Name (N) is when Name_Annotate => C := 'A'; when Name_Comment => diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 2c75337d3b1..5ff3ed12215 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -21338,6 +21338,16 @@ package body Sem_Ch3 is if Nkind (S) /= N_Subtype_Indication then Find_Type (S); + + -- No way to proceed if the subtype indication is malformed. + -- This will happen for example when the subtype indication in + -- an object declaration is missing altogether and the expression + -- is analyzed as if it were that indication. + + if not Is_Entity_Name (S) then + return Any_Type; + end if; + Check_Incomplete (S); P := Parent (S); diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 8c5611c7904..1217a2cc688 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -775,7 +775,7 @@ package body Sem_Elab is -- Obtain the hash value of entity Key Early_Call_Regions_In_Use : Boolean := False; - -- This flag flag determines whether table Early_Call_Regions contains at + -- This flag determines whether table Early_Call_Regions contains at least -- least one key/value pair. Early_Call_Regions_No_Element : constant Node_Id := Empty; @@ -953,7 +953,7 @@ package body Sem_Elab is procedure Check_SPARK_Scenario (N : Node_Id); pragma Inline (Check_SPARK_Scenario); - -- Top level dispatcher for verifying SPARK scenarios which are not always + -- Top-level dispatcher for verifying SPARK scenarios which are not always -- executable during elaboration but still need elaboration-related checks. procedure Check_SPARK_Refined_State_Pragma (N : Node_Id); @@ -1463,7 +1463,7 @@ package body Sem_Elab is -- Perform ABE checks and diagnostics for task activation call Call -- which activates task Obj_Id. Call_Attrs are the attributes of the -- activation call. Task_Attrs are the attributes of the task type. - -- The flags should be set when the processing was initated as follows: + -- The flags should be set when the processing was initiated as follows: -- -- In_Init_Cond - initial condition procedure -- In_Partial_Fin - partial finalization procedure @@ -2274,7 +2274,7 @@ package body Sem_Elab is end loop; -- Examine each SPARK scenario saved during the Recording phase which - -- isnot necessarily executable during elaboration, but still requires + -- is not necessarily executable during elaboration, but still requires -- elaboration-related checks. for Index in SPARK_Scenarios.First .. SPARK_Scenarios.Last loop @@ -2602,8 +2602,8 @@ package body Sem_Elab is -- The suggestion applies only when the subprogram body resides in a -- compilation package body, and a pragma Elaborate_Body would allow -- for the node to appear in the early call region of the subprogram - -- body. This implies that all code from the subprogram body upto the - -- node is preelaborable. + -- body. This implies that all code from the subprogram body up to + -- the node is preelaborable. if Nkind (Unt) = N_Package_Body then @@ -2618,7 +2618,7 @@ package body Sem_Elab is Assume_Elab_Body => True, Skip_Memoization => True); - -- If the node appears within the early call region assuming that + -- If the node appears within the early call region, assuming that -- the package spec carries pragma Elaborate_Body, then it is safe -- to suggest the pragma. diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 024b879fd14..84f19a7a8ed 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -5156,32 +5156,14 @@ package body Sem_Res is -- of coextensions properly so let's at least warn the user -- about it. - if Is_Controlled_Active (Desig_T) then - if Is_Controlled_Active - (Defining_Identifier - (Parent (Associated_Node_For_Itype (Typ)))) - then - Error_Msg_N - ("??coextension will not be finalized when its " - & "associated owner is finalized", N); - else - Error_Msg_N - ("??coextension will not be finalized when its " - & "associated owner is deallocated", N); - end if; + if Is_Controlled (Desig_T) then + Error_Msg_N + ("??coextension will not be finalized when its " + & "associated owner is deallocated or finalized", N); else - if Is_Controlled_Active - (Defining_Identifier - (Parent (Associated_Node_For_Itype (Typ)))) - then - Error_Msg_N - ("??coextension will not be deallocated when " - & "its associated owner is finalized", N); - else - Error_Msg_N - ("??coextension will not be deallocated when " - & "its associated owner is deallocated", N); - end if; + Error_Msg_N + ("??coextension will not be deallocated when its " + & "associated owner is deallocated", N); end if; end if; @@ -5200,8 +5182,10 @@ package body Sem_Res is and then Is_Controlled_Active (Desig_T) then Error_Msg_N - ("??anonymous access-to-controlled object will be finalized " - & "when its enclosing unit goes out of scope", N); + ("??object designated by anonymous access object might not " + & "be finalized until its enclosing library unit goes out " + & "of scope", N); + Error_Msg_N ("\use named access type instead", N); end if; end if; end if; -- 2.30.2