From aa0a69abb127974bd64b206be9529f49910d7f82 Mon Sep 17 00:00:00 2001 From: charlet Date: Thu, 31 Jul 2014 10:09:08 +0000 Subject: [PATCH] 2014-07-31 Robert Dewar * frontend.adb: Minor reformatting. * sem.adb: Minor reformatting. * sem_ch6.adb (Analyze_Null_Procedure): Set proper sloc for identifiers on rewrite. * par.adb: Minor comment updates. * a-ngelfu.adb (Cos): Minor simplification. * par-ch13.adb (Get_Aspect_Specifications): Improve messages and recovery for bad aspect. * exp_ch3.adb: Code clean up. * sem_util.ads: Minor comment correction. * sem_ch13.adb (Check_Array_Type): Properly handle large types. * sem_ch3.adb: Code clean up. * binderr.ads: Minor comment correction. 2014-07-31 Ed Schonberg * exp_disp.adb (Expand_Interface_Conversion): A call whose prefix is a static conversion to an interface type that is not class-wide is not dispatching. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@213338 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 22 ++++++++ gcc/ada/a-ngelfu.adb | 8 +-- gcc/ada/binderr.ads | 4 +- gcc/ada/exp_ch3.adb | 4 +- gcc/ada/exp_disp.adb | 13 +++++ gcc/ada/frontend.adb | 8 +-- gcc/ada/par-ch13.adb | 139 +++++++++++++++++++++++++++------------------------ gcc/ada/par.adb | 15 +++--- gcc/ada/sem.adb | 1 - gcc/ada/sem_ch13.adb | 15 +++++- gcc/ada/sem_ch3.adb | 12 ++++- gcc/ada/sem_ch6.adb | 10 ++-- gcc/ada/sem_util.ads | 4 +- 13 files changed, 159 insertions(+), 96 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ed63217..dbfad40 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,27 @@ 2014-07-31 Robert Dewar + * frontend.adb: Minor reformatting. + * sem.adb: Minor reformatting. + * sem_ch6.adb (Analyze_Null_Procedure): Set proper sloc for + identifiers on rewrite. + * par.adb: Minor comment updates. + * a-ngelfu.adb (Cos): Minor simplification. + * par-ch13.adb (Get_Aspect_Specifications): Improve messages + and recovery for bad aspect. + * exp_ch3.adb: Code clean up. + * sem_util.ads: Minor comment correction. + * sem_ch13.adb (Check_Array_Type): Properly handle large types. + * sem_ch3.adb: Code clean up. + * binderr.ads: Minor comment correction. + +2014-07-31 Ed Schonberg + + * exp_disp.adb (Expand_Interface_Conversion): A call whose + prefix is a static conversion to an interface type that is not + class-wide is not dispatching. + +2014-07-31 Robert Dewar + * inline.adb, s-traceb.adb, s-traceb-hpux.adb, memtrack.adb, s-traceb-mastop.adb: Minor reformatting. diff --git a/gcc/ada/a-ngelfu.adb b/gcc/ada/a-ngelfu.adb index 796f574..f31f685 100644 --- a/gcc/ada/a-ngelfu.adb +++ b/gcc/ada/a-ngelfu.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -509,12 +509,8 @@ package body Ada.Numerics.Generic_Elementary_Functions is function Cos (X : Float_Type'Base) return Float_Type'Base is begin - if X = 0.0 then - return 1.0; - - elsif abs X < Sqrt_Epsilon then + if abs X < Sqrt_Epsilon then return 1.0; - end if; return Float_Type'Base (Aux.Cos (Double (X))); diff --git a/gcc/ada/binderr.ads b/gcc/ada/binderr.ads index 3a419d5..46b1846 100644 --- a/gcc/ada/binderr.ads +++ b/gcc/ada/binderr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -59,7 +59,7 @@ package Binderr is -- specified by the File_Name_Type value stored in Error_Msg_File_2. -- Insertion character $ (Dollar: insert unit name from Names table) - -- The character & is replaced by the text for the unit name specified + -- The character $ is replaced by the text for the unit name specified -- by the Name_Id value stored in Error_Msg_Unit_1. The name is always -- enclosed in quotes. A second $ may appear in a single message in -- which case it is similarly replaced by the name which is specified diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index d404d37..5d5edf3 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -4589,9 +4589,9 @@ package body Exp_Ch3 is -- Expand_Record_Extension is called directly from the semantics, so -- we must check to see whether expansion is active before proceeding -- Because this affects the visibility of selected components in bodies - -- of instances, it must also be called in ASIS mode. + -- of instances. - if not (Expander_Active or ASIS_Mode) then + if not Expander_Active then return; end if; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 1b50185..69feaa7 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -1191,6 +1191,19 @@ package body Exp_Disp is end if; return; + + -- A static conversion to an interface type that is not classwide is + -- curious but legal if the interface operation is a null procedure. + -- If the operation is abstract it will be rejected later. + + elsif Is_Static + and then Is_Interface (Etype (N)) + and then not Is_Class_Wide_Type (Etype (N)) + and then Comes_From_Source (N) + then + Rewrite (N, Unchecked_Convert_To (Etype (N), N)); + Analyze (N); + return; end if; if not Is_Static then diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index 688f8cc..e1c785d 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -147,10 +147,10 @@ begin Temp_File : Boolean; begin - -- We always analyze config files with style checks off, since - -- we don't want a miscellaneous gnat.adc that is around to - -- discombobulate intended -gnatg or -gnaty compilations. We - -- also disconnect checking for maximum line length. + -- We always analyze config files with style checks off, since we + -- don't want a miscellaneous gnat.adc that is around to discombobulate + -- intended -gnatg or -gnaty compilations. We also disconnect checking + -- for maximum line length. Opt.Style_Check := False; Style_Check := False; diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb index 2932c540..44193d6 100644 --- a/gcc/ada/par-ch13.adb +++ b/gcc/ada/par-ch13.adb @@ -197,7 +197,7 @@ package body Ch13 is -- The aspect mark is not recognized if A_Id = No_Aspect then - Error_Msg_SC ("aspect identifier expected"); + Error_Msg_N ("& is not a valid aspect identifier", Token_Node); OK := False; -- Check bad spelling @@ -205,8 +205,8 @@ package body Ch13 is for J in Aspect_Id_Exclude_No_Aspect loop if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then Error_Msg_Name_1 := Aspect_Names (J); - Error_Msg_SC -- CODEFIX - ("\possible misspelling of%"); + Error_Msg_N -- CODEFIX + ("\possible misspelling of%", Token_Node); exit; end if; end loop; @@ -225,9 +225,13 @@ package body Ch13 is Scan; -- past arrow Set_Expression (Aspect, P_Expression); - -- The aspect may behave as a boolean aspect + -- If we have a correct terminator (comma or semicolon, or a + -- reasonable likely missing comma), then just proceed. - elsif Token = Tok_Comma then + elsif Token = Tok_Comma or else + Token = Tok_Semicolon or else + Token = Tok_Identifier + then null; -- Otherwise the aspect contains a junk definition @@ -480,89 +484,92 @@ package body Ch13 is if OK then Append (Aspect, Aspects); end if; + end if; - -- The aspect specification list contains more than one aspect + -- Merge here after good or bad aspect (we should be at a comma + -- or a semicolon, but there might be other possible errors). - if Token = Tok_Comma then - Scan; -- past comma - goto Continue; + -- The aspect specification list contains more than one aspect - -- Check for a missing comma between two aspects. Emit an error - -- and proceed to the next aspect. + if Token = Tok_Comma then + Scan; -- past comma + goto Continue; - elsif Token = Tok_Identifier - and then Get_Aspect_Id (Token_Name) /= No_Aspect - then - declare - Scan_State : Saved_Scan_State; + -- Check for a missing comma between two aspects. Emit an error + -- and proceed to the next aspect. - begin - Save_Scan_State (Scan_State); - Scan; -- past identifier + elsif Token = Tok_Identifier + and then Get_Aspect_Id (Token_Name) /= No_Aspect + then + declare + Scan_State : Saved_Scan_State; - -- Attempt to detect ' or => following a potential aspect - -- mark. + begin + Save_Scan_State (Scan_State); + Scan; -- past identifier - if Token = Tok_Apostrophe or else Token = Tok_Arrow then - Restore_Scan_State (Scan_State); - Error_Msg_AP -- CODEFIX - ("|missing "","""); - goto Continue; + -- Attempt to detect ' or => following a potential aspect + -- mark. - -- The construct following the current aspect is not an - -- aspect. + if Token = Tok_Apostrophe or else Token = Tok_Arrow then + Restore_Scan_State (Scan_State); + Error_Msg_AP -- CODEFIX + ("|missing "","""); + goto Continue; - else - Restore_Scan_State (Scan_State); - end if; - end; + -- The construct following the current aspect is not an + -- aspect. - -- Check for a mistyped semicolon in place of a comma between two - -- aspects. Emit an error and proceed to the next aspect. + else + Restore_Scan_State (Scan_State); + end if; + end; - elsif Token = Tok_Semicolon then - declare - Scan_State : Saved_Scan_State; + -- Check for a mistyped semicolon in place of a comma between two + -- aspects. Emit an error and proceed to the next aspect. - begin - Save_Scan_State (Scan_State); - Scan; -- past semicolon + elsif Token = Tok_Semicolon then + declare + Scan_State : Saved_Scan_State; - if Token = Tok_Identifier - and then Get_Aspect_Id (Token_Name) /= No_Aspect - then - Scan; -- past identifier + begin + Save_Scan_State (Scan_State); + Scan; -- past semicolon - -- Attempt to detect ' or => following a potential aspect - -- mark. + if Token = Tok_Identifier + and then Get_Aspect_Id (Token_Name) /= No_Aspect + then + Scan; -- past identifier - if Token = Tok_Apostrophe or else Token = Tok_Arrow then - Restore_Scan_State (Scan_State); - Error_Msg_SC -- CODEFIX - ("|"";"" should be "","""); - Scan; -- past semicolon - goto Continue; - end if; + -- Attempt to detect ' or => following a potential aspect + -- mark. + + if Token = Tok_Apostrophe or else Token = Tok_Arrow then + Restore_Scan_State (Scan_State); + Error_Msg_SC -- CODEFIX + ("|"";"" should be "","""); + Scan; -- past semicolon + goto Continue; end if; + end if; - -- The construct following the current aspect is not an - -- aspect. + -- The construct following the current aspect is not an + -- aspect. - Restore_Scan_State (Scan_State); - end; - end if; + Restore_Scan_State (Scan_State); + end; + end if; - -- Must be terminator character + -- Must be terminator character - if Semicolon then - T_Semicolon; - end if; + if Semicolon then + T_Semicolon; + end if; - exit; + exit; - <> - null; - end if; + <> + null; end loop; return Aspects; diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 88720db..c1363ed 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -947,12 +947,6 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- for aspects so it does not matter whether the aspect specifications -- are terminated by semicolon or some other character. - function Get_Aspect_Specifications - (Semicolon : Boolean := True) return List_Id; - -- Parse a list of aspects but do not attach them to a declaration node. - -- Subsidiary to the following procedure. Used when parsing a subprogram - -- specification that may be a declaration or a body. - procedure P_Aspect_Specifications (Decl : Node_Id; Semicolon : Boolean := True); @@ -977,6 +971,13 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- are also ignored, but no error message is given (this is used when -- the caller has already taken care of the error message). + function Get_Aspect_Specifications + (Semicolon : Boolean := True) return List_Id; + -- Parse a list of aspects but do not attach them to a declaration node. + -- Subsidiary to P_Aspect_Specifications procedure. Used when parsing + -- a subprogram specification that may be a declaration or a body. + -- Semicolon has the same meaning as for P_Aspect_Specifications above. + function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id; -- Function to parse a code statement. The caller has scanned out -- the name to be used as the subtype mark (but has not checked that diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index b1368f4..0da096e 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1268,7 +1268,6 @@ package body Sem is Next => Suppress_Stack_Entries); Suppress_Stack_Entries := Global_Suppress_Stack_Top; return; - end Push_Global_Suppress_Stack_Entry; ------------------------------------- diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 2ae6ef9..2ef89b6 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -12067,11 +12067,24 @@ package body Sem_Ch13 is return; end if; + -- Case of component size is greater than or equal to 64 and the + -- alignment of the array is at least as large as the alignment + -- of the component. We are definitely OK in this situation. + + if Known_Component_Size (Atyp) + and then Component_Size (Atyp) >= 64 + and then Known_Alignment (Atyp) + and then Known_Alignment (Ctyp) + and then Alignment (Atyp) >= Alignment (Ctyp) + then + return; + end if; + -- Check actual component size if not Known_Component_Size (Atyp) or else not (Addressable (Component_Size (Atyp)) - and then Component_Size (Atyp) < 64) + and then Component_Size (Atyp) < 64) or else Component_Size (Atyp) mod Esize (Ctyp) /= 0 then No_Independence; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 6d5827e..b5df709 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3503,6 +3503,7 @@ package body Sem_Ch3 is and then Nkind (E) = N_Aggregate then Set_Etype (E, T); + else Resolve (E, T); end if; @@ -8407,9 +8408,16 @@ package body Sem_Ch3 is elsif not Private_Extension then - -- Add the _parent field in the derived type + -- Add the _parent field in the derived type. In ASIS mode there is + -- not enough semantic information for full expansion, but set the + -- parent subtype to allow resolution of selected components in + -- instance bodies. - Expand_Record_Extension (Derived_Type, Type_Def); + if ASIS_Mode then + Set_Parent_Subtype (Derived_Type, Parent_Type); + else + Expand_Record_Extension (Derived_Type, Type_Def); + end if; -- Ada 2005 (AI-251): Addition of the Tag corresponding to all the -- implemented interfaces if we are in expansion mode diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 51cebd6..35c59e21 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -106,7 +106,7 @@ package body Sem_Ch6 is procedure Analyze_Null_Procedure (N : Node_Id; Is_Completion : out Boolean); - -- A null procedure can be a declaration or (Ada 2012) a completion. + -- A null procedure can be a declaration or (Ada 2012) a completion procedure Analyze_Return_Statement (N : Node_Id); -- Common processing for simple and extended return statements @@ -1310,12 +1310,16 @@ package body Sem_Ch6 is -- Create new entities for body and formals Set_Defining_Unit_Name (Specification (Null_Body), - Make_Defining_Identifier (Loc, Chars (Defining_Entity (N)))); + Make_Defining_Identifier + (Sloc (Defining_Entity (N)), + Chars (Defining_Entity (N)))); Form := First (Parameter_Specifications (Specification (Null_Body))); while Present (Form) loop Set_Defining_Identifier (Form, - Make_Defining_Identifier (Loc, Chars (Defining_Identifier (Form)))); + Make_Defining_Identifier + (Sloc (Defining_Identifier (Form)), + Chars (Defining_Identifier (Form)))); Next (Form); end loop; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index d088e3e..cac0fec 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -88,8 +88,8 @@ package Sem_Util is function Addressable (V : Uint) return Boolean; function Addressable (V : Int) return Boolean; pragma Inline (Addressable); - -- Returns True if the value of V is the word size of an addressable - -- factor of the word size (typically 8, 16, 32 or 64). + -- Returns True if the value of V is the word size or an addressable factor + -- of the word size (typically 8, 16, 32 or 64). procedure Aggregate_Constraint_Checks (Exp : Node_Id; -- 2.7.4