From 8a8d9086939dd4b8742748f2b5315e681f0017ff Mon Sep 17 00:00:00 2001 From: charlet Date: Tue, 26 Oct 2010 10:51:36 +0000 Subject: [PATCH] 2010-10-26 Ed Schonberg * sem_ch5.adb (Analyze_Iteration_Scheme): Diagnose attempt to use thew form "for X in A" when A is an array object. This form is only intended for containers. * sem_eval.adb: Fix reference to non-existing field of type conversion node. * sem_case.adb (Check_Choices): Improve error reporting for overlapping choices in case statements. 2010-10-26 Gary Dismukes * exp_disp.adb (Expand_Interface_Actuals): When expanding an actual for a class-wide interface formal that involves applying a displacement conversion to the actual, check for the case of calling a build-in-place function and handle generation of the implicit BIP parameters (call Make_Build_In_Place_Call_In_Anonymous_Context). Add with and use of Exp_Ch6. 2010-10-26 Robert Dewar * sem_prag.adb, sem_cat.ads: Minor reformatting. 2010-10-26 Sergey Rybin * vms_data.ads: Define VMS qualifier for gnatelim '--ignore' option 2010-10-26 Thomas Quinot * sem_util.adb (Has_Preelaborable_Initialization.Check_Components): For a discriminant, use Discriminant_Default_Value rather than Expression (Declaration_Node (D)). 2010-10-26 Geert Bosch * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Parameterized expressions don't need a spec, even when style checks require subprograms to have one. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165941 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 39 +++++++++++++++++++++++++++++++++++++++ gcc/ada/exp_disp.adb | 14 ++++++++++++++ gcc/ada/sem_case.adb | 10 +++++++++- gcc/ada/sem_cat.ads | 10 +++++----- gcc/ada/sem_ch5.adb | 6 +++++- gcc/ada/sem_ch6.adb | 2 ++ gcc/ada/sem_eval.adb | 4 ++-- gcc/ada/sem_prag.adb | 1 + gcc/ada/sem_util.adb | 52 +++++++++++++++++++++++++++++++++------------------- gcc/ada/vms_data.ads | 7 +++++++ 10 files changed, 117 insertions(+), 28 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index abcb823..72642c1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,42 @@ +2010-10-26 Ed Schonberg + + * sem_ch5.adb (Analyze_Iteration_Scheme): Diagnose attempt to use thew + form "for X in A" when A is an array object. This form is only intended + for containers. + * sem_eval.adb: Fix reference to non-existing field of type conversion + node. + * sem_case.adb (Check_Choices): Improve error reporting for overlapping + choices in case statements. + +2010-10-26 Gary Dismukes + + * exp_disp.adb (Expand_Interface_Actuals): When expanding an actual for + a class-wide interface formal that involves applying a displacement + conversion to the actual, check for the case of calling a build-in-place + function and handle generation of the implicit BIP parameters (call + Make_Build_In_Place_Call_In_Anonymous_Context). + Add with and use of Exp_Ch6. + +2010-10-26 Robert Dewar + + * sem_prag.adb, sem_cat.ads: Minor reformatting. + +2010-10-26 Sergey Rybin + + * vms_data.ads: Define VMS qualifier for gnatelim '--ignore' option + +2010-10-26 Thomas Quinot + + * sem_util.adb (Has_Preelaborable_Initialization.Check_Components): + For a discriminant, use Discriminant_Default_Value rather than + Expression (Declaration_Node (D)). + +2010-10-26 Geert Bosch + + * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Parameterized + expressions don't need a spec, even when style checks require + subprograms to have one. + 2010-10-26 Arnaud Charlet * gnatvsn.ads: Update comments. diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 651734f..a4eccd6 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -30,6 +30,7 @@ with Einfo; use Einfo; with Elists; use Elists; with Errout; use Errout; with Exp_Atag; use Exp_Atag; +with Exp_Ch6; use Exp_Ch6; with Exp_Ch7; use Exp_Ch7; with Exp_CG; use Exp_CG; with Exp_Dbug; use Exp_Dbug; @@ -1437,6 +1438,19 @@ package body Exp_Disp is -- the displacement of the pointer. else + -- Normally, expansion of actuals for calls to build-in-place + -- functions happens as part of Expand_Actuals, but in this + -- case the call will be wrapped in a conversion and soon after + -- expanded further to handle the displacement for a class-wide + -- interface conversion, so if this is a BIP call then we need + -- to handle it now. + + if Ada_Version >= Ada_2005 + and then Is_Build_In_Place_Function_Call (Actual) + then + Make_Build_In_Place_Call_In_Anonymous_Context (Actual); + end if; + Conversion := Convert_To (Formal_Typ, Relocate_Node (Actual)); Rewrite (Actual, Conversion); Analyze_And_Resolve (Actual, Formal_Typ); diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index fd601c5..ead21f4 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -313,9 +313,17 @@ package body Sem_Case is Hi := Expr_Value (Choice_Table (J).Hi); if Lo <= Prev_Hi then - Prev_Choice := Choice_Table (J - 1).Node; Choice := Choice_Table (J).Node; + -- Find first previous choice that overlaps. + + for K in 1 .. J - 1 loop + if Lo <= Expr_Value (Choice_Table (K).Hi) then + Prev_Choice := Choice_Table (K).Node; + exit; + end if; + end loop; + if Sloc (Prev_Choice) <= Sloc (Choice) then Error_Msg_Sloc := Sloc (Prev_Choice); Error_Msg_N ("duplication of choice value#", Choice); diff --git a/gcc/ada/sem_cat.ads b/gcc/ada/sem_cat.ads index cc667aa..1c7f572 100644 --- a/gcc/ada/sem_cat.ads +++ b/gcc/ada/sem_cat.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -143,10 +143,10 @@ package Sem_Cat is -- T is the entity of the declared type. procedure Validate_Static_Object_Name (N : Node_Id); - -- In the elaboration code of a preelaborated library unit, check - -- that we do not have the evaluation of a primary that is a name of - -- an object, unless the name is a static expression (RM 10.2.1(8)). - -- Non-static constant and variable are the targets, generic parameters + -- In the elaboration code of a preelaborated library unit, check that we + -- do not have the evaluation of a primary that is a name of an object, + -- unless the name is a static expression (RM 10.2.1(8)). Non-static + -- constant and variable are the targets, generic parameters are not -- are not included because the generic declaration and body are -- preelaborable. diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index b009852..e7091cd 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1725,7 +1725,9 @@ package body Sem_Ch5 is -- Start of processing for Analyze_Iteration_Scheme begin - -- Why is following check needed ??? + -- If this is a rewritten quantified expression, the iteration + -- scheme has been analyzed already. Do no repeat analysis because + -- the loop variable is already declared. if Analyzed (N) then return; @@ -2008,6 +2010,8 @@ package body Sem_Ch5 is if Of_Present (N) then Set_Etype (Def_Id, Component_Type (Typ)); else + Error_Msg_N + ("to iterate over the elements of an array, use 'O'F", N); Set_Etype (Def_Id, Etype (First_Index (Typ))); end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index f6a0db9..534f323 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2330,6 +2330,8 @@ package body Sem_Ch6 is and then Comes_From_Source (Body_Id) and then not Suppress_Style_Checks (Body_Id) and then not In_Instance + and then Nkind (Original_Node (Body_Id)) + /= N_Parameterized_Expression then Style.Body_With_No_Spec (N); end if; diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 0de491d..84ca9ac 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -5432,8 +5432,8 @@ package body Sem_Eval is when N_Type_Conversion => Why_Not_Static (Expression (N)); - if not Is_Scalar_Type (Etype (Prefix (N))) - or else not Is_Static_Subtype (Etype (Prefix (N))) + if not Is_Scalar_Type (Entity (Subtype_Mark (N))) + or else not Is_Static_Subtype (Entity (Subtype_Mark (N))) then Error_Msg_N ("static conversion requires static scalar subtype result " & diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 2172f98..5cf92e1 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -2920,6 +2920,7 @@ package body Sem_Prag is -- C_Pass_By_Copy is treated as a synonym for convention C (this is -- tested again below to set the critical flag). + if Cname = Name_C_Pass_By_Copy then C := Convention_C; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 603a230..1ec671f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -5121,36 +5121,50 @@ package body Sem_Util is -- We are interested only in components and discriminants - if Ekind_In (Ent, E_Component, E_Discriminant) then + Exp := Empty; + case Ekind (Ent) is + when E_Component => - -- Get default expression if any. If there is no declaration - -- node, it means we have an internal entity. The parent and - -- tag fields are examples of such entities. For these cases, - -- we just test the type of the entity. + -- Get default expression if any. If there is no declaration + -- node, it means we have an internal entity. The parent and + -- tag fields are examples of such entities. For such cases, + -- we just test the type of the entity. - if Present (Declaration_Node (Ent)) then - Exp := Expression (Declaration_Node (Ent)); - else - Exp := Empty; - end if; + if Present (Declaration_Node (Ent)) then + Exp := Expression (Declaration_Node (Ent)); + end if; - -- A component has PI if it has no default expression and the - -- component type has PI. + when E_Discriminant => - if No (Exp) then - if not Has_Preelaborable_Initialization (Etype (Ent)) then - Has_PE := False; - exit; - end if; + -- Note: for a renamed discriminant, the Declaration_Node + -- may point to the one from the ancestor, and have a + -- different expression, so use the proper attribute to + -- retrieve the expression from the derived constraint. + + Exp := Discriminant_Default_Value (Ent); - -- Require the default expression to be preelaborable + when others => + goto Check_Next_Entity; - elsif not Is_Preelaborable_Expression (Exp) then + end case; + + -- A component has PI if it has no default expression and the + -- component type has PI. + + if No (Exp) then + if not Has_Preelaborable_Initialization (Etype (Ent)) then Has_PE := False; exit; end if; + + -- Require the default expression to be preelaborable + + elsif not Is_Preelaborable_Expression (Exp) then + Has_PE := False; + exit; end if; + <> Next_Entity (Ent); end loop; end Check_Components; diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index 8df60aa..7b48282 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -3701,6 +3701,13 @@ package VMS_Data is -- -- Do not generate pragmas for dispatching operations. + S_Elim_Ignore : aliased constant S := "/IGNORE=@" & + "--ignore=@"; + -- /IGNORE=filename + -- + -- Do not generate pragmas for subprograms declared in the sources + -- listed in a specified file + S_Elim_Project : aliased constant S := "/PROJECT_FILE=<" & "-P>"; -- /PROJECT_FILE=filename -- 2.7.4