From: Arnaud Charlet Date: Fri, 5 Aug 2011 13:46:16 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=97ed5872c6629a96fcc4b4ff4ccaca41950ae26c;p=gcc.git [multiple changes] 2011-08-05 Ed Schonberg * sem_ch3.adb: (Check_Private_Overriding): better error message, suggested by AI95-0068. 2011-08-05 Hristian Kirtchev * exp_ch7.adb (Find_Last_Init): Use Next_Suitable_Statement to retrieve the two potential initialization calls. This accounts for any access-before-elaboration checks which may precede the initialization calls. (Next_Suitable_Statement): New routine. Returns the next real statement after the input node while skipping generated checks. * sem_elab.adb (Check_A_Call): New formal parameter In_Init_Proc along with comment on usage. Do not generate Elaborate_All when the trigger is a finalization call coming from a type init proc. (Check_Elab_Call): Propagate the initialization procedure context to subsequent calls to Check_A_Call. (Check_Internal_Call_Continue): Propagate the initialization procedure context to subsequent calls to Check_Elab_Call. (Is_Finalization_Procedure): New routine. Returns True if the input entity denotes a [Deep_]Finalize routine. * sem_elab.ads (Check_Elab_Call): New formal parameter In_Init_Proc along with comment on usage. 2011-08-05 Vadim Godunko * s-atocou.ads: Add list of supported platforms. 2011-08-05 Yannick Moy * sem_prag.adb, restrict.adb: Correct style for or'ing Boolean variables * opt.ads (Disable_ALI_File): new Boolean flag * lib-writ.adb (Write_ALI): when Disable_ALI_File is set, do nothing 2011-08-05 Ed Falis * env.c (__gnat_environ): Fix includes for RTPs and VTHREADS so that environ is properly defined. 2011-08-05 Vincent Celier * make.adb (Compilation_Phase): Exit immediately when all objects have been found up to date, to avoid multiple exit messages. * prj-nmsc.adb (Add_Source): Allow duplicate source file names in the same project for languages with no compiler. * gnat_ugn.texi: Document compiler switch -gnateI and gnatmake switch -eI. From-SVN: r177434 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 82d1301481b..2ee55914517 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,53 @@ +2011-08-05 Ed Schonberg + + * sem_ch3.adb: (Check_Private_Overriding): better error message, + suggested by AI95-0068. + +2011-08-05 Hristian Kirtchev + + * exp_ch7.adb (Find_Last_Init): Use Next_Suitable_Statement to retrieve + the two potential initialization calls. This accounts for any + access-before-elaboration checks which may precede the initialization + calls. + (Next_Suitable_Statement): New routine. Returns the next real statement + after the input node while skipping generated checks. + * sem_elab.adb (Check_A_Call): New formal parameter In_Init_Proc along + with comment on usage. + Do not generate Elaborate_All when the trigger is a finalization call + coming from a type init proc. + (Check_Elab_Call): Propagate the initialization procedure context to + subsequent calls to Check_A_Call. + (Check_Internal_Call_Continue): Propagate the initialization procedure + context to subsequent calls to Check_Elab_Call. + (Is_Finalization_Procedure): New routine. Returns True if the input + entity denotes a [Deep_]Finalize routine. + * sem_elab.ads (Check_Elab_Call): New formal parameter In_Init_Proc + along with comment on usage. + +2011-08-05 Vadim Godunko + + * s-atocou.ads: Add list of supported platforms. + +2011-08-05 Yannick Moy + + * sem_prag.adb, restrict.adb: Correct style for or'ing Boolean variables + + * opt.ads (Disable_ALI_File): new Boolean flag + * lib-writ.adb (Write_ALI): when Disable_ALI_File is set, do nothing + +2011-08-05 Ed Falis + + * env.c (__gnat_environ): Fix includes for RTPs and VTHREADS so that + environ is properly defined. + +2011-08-05 Vincent Celier + + * make.adb (Compilation_Phase): Exit immediately when all objects have + been found up to date, to avoid multiple exit messages. + * prj-nmsc.adb (Add_Source): Allow duplicate source file names in the + same project for languages with no compiler. + * gnat_ugn.texi: Document compiler switch -gnateI and gnatmake switch + -eI. 2011-08-05 Robert Dewar * exp_ch7.ads, sem_type.adb, make.adb, sem_prag.adb, sem_util.adb, diff --git a/gcc/ada/env.c b/gcc/ada/env.c index c58139a2d68..9d7301f1828 100644 --- a/gcc/ada/env.c +++ b/gcc/ada/env.c @@ -56,10 +56,25 @@ extern "C" { #include #endif -#if defined (__vxworks) \ - && ! (defined (__RTP__) || defined (__COREOS__) || defined (__VXWORKSMILS__)) -#include "envLib.h" -extern char** ppGlobalEnviron; +#if defined (__vxworks) + #if defined (__RTP__) + /* On VxWorks 6 Real-Time process mode, environ is defined in unistd.h. */ + #include + #elif defined (VTHREADS) + /* VTHREADS mode applies to both VxWorks 653 and VxWorks MILS. The + inclusion of vThreadsData.h is necessary to workaround a bug with + envLib.h on VxWorks MILS. */ + #include + #include + #else + /* This should work for kernel mode on both VxWorks 5 and VxWorks 6. */ + #include + + /* In that mode environ is a macro which reference the following symbol. + As the symbol is not defined in any VxWorks include files we declare + it as extern. */ + extern char** ppGlobalEnviron; + #endif #endif /* We don't have libiberty, so use malloc. */ @@ -200,8 +215,7 @@ __gnat_setenv (char *name, char *value) char ** __gnat_environ (void) { -#if defined (VMS) || defined (RTX) \ - || (defined (VTHREADS) && ! defined (__VXWORKSMILS__)) +#if defined (VMS) || defined (RTX) /* Not implemented */ return NULL; #elif defined (__APPLE__) @@ -212,14 +226,10 @@ __gnat_environ (void) #elif defined (sun) extern char **_environ; return _environ; -#else -#if ! (defined (__vxworks) \ - && ! (defined (__RTP__) || defined (__COREOS__) \ - || defined (__VXWORKSMILS__))) - /* in VxWorks kernel mode environ is macro and not a variable */ - /* same thing on 653 in the CoreOS and for VxWorks MILS vThreads */ +#elif ! (defined (__vxworks)) extern char **environ; -#endif + return environ; +#else return environ; #endif } diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 443c6ff812a..735f86576a0 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -2270,6 +2270,10 @@ package body Exp_Ch7 is -- call and if it is, try to match the name of the call with the -- [Deep_]Initialize proc of Typ. + function Next_Suitable_Statement (Stmt : Node_Id) return Node_Id; + -- Given a statement which is part of a list, return the next + -- real statement while skipping over generated checks. + ------------------ -- Is_Init_Call -- ------------------ @@ -2310,6 +2314,25 @@ package body Exp_Ch7 is return False; end Is_Init_Call; + ----------------------------- + -- Next_Suitable_Statement -- + ----------------------------- + + function Next_Suitable_Statement (Stmt : Node_Id) return Node_Id is + Result : Node_Id := Next (Stmt); + + begin + -- Skip over access-before-elaboration checks + + if Dynamic_Elaboration_Checks + and then Nkind (Result) = N_Raise_Program_Error + then + Result := Next (Result); + end if; + + return Result; + end Next_Suitable_Statement; + -- Start of processing for Find_Last_Init begin @@ -2338,9 +2361,9 @@ package body Exp_Ch7 is -- where the user-defined initialize may be optional or may appear -- inside a block when abort deferral is needed. - Nod_1 := Next (Decl); + Nod_1 := Next_Suitable_Statement (Decl); if Present (Nod_1) then - Nod_2 := Next (Nod_1); + Nod_2 := Next_Suitable_Statement (Nod_1); -- The statement following an object declaration is always a -- call to the type init proc. diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 3e689938cdd..c256b488d2d 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -4130,6 +4130,12 @@ Display full source path name in brief error messages. @cindex @option{-gnateG} (@command{gcc}) Save result of preprocessing in a text file. +@item -gnateInnn +@cindex @option{-gnateI} (@command{gcc}) +Indicates that the source is a multi-unit source and that the index of the +unit to compile is nnn. nnn needs to be a positive number and need to +be a valid index in the multi-unit source. + @item -gnatem=@var{path} @cindex @option{-gnatem} (@command{gcc}) Specify a mapping file @@ -9500,6 +9506,13 @@ and ALI files go in the current working directory. This switch cannot be used when using a project file. +@item -eInnn +@cindex @option{-eI} (@command{gnatmake}) +Indicates that the main source is a multi-unit source and the rank of the unit +in the source file is nnn. nnn needs to be a positive number and a valid +index in the source. This switch cannot be used when @command{gnatmake} is +invoked for several mains. + @ifclear vms @item -eL @cindex @option{-eL} (@command{gnatmake}) diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index cf24265a2b9..64ec01166b1 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -870,6 +870,13 @@ package body Lib.Writ is return; end if; + -- Generation of ALI files may be disabled, e.g. for formal verification + -- back-end. + + if Disable_ALI_File then + return; + end if; + -- Build sorted source dependency table. We do this right away, because -- it is referenced by Up_To_Date_ALI_File_Exists. diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index b25c220aa8d..a725b9ab75d 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -4843,6 +4843,8 @@ package body Make is and then Osint.Number_Of_Files = 1 then Inform (Msg => "objects up to date."); + Stop_Compile := True; + return; elsif Do_Not_Execute and then First_Compiled_File /= No_File then Write_Name (First_Compiled_File); diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 55e57c4c5e4..84f8a2a633f 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -602,6 +602,10 @@ package Opt is -- Force generation of ALI file even if errors are encountered. -- Also forces generation of tree file if -gnatt is also set. + Disable_ALI_File : Boolean := False; + -- GNAT2WHY + -- Disable generation of ALI file + Force_Checking_Of_Elaboration_Flags : Boolean := False; -- GNATBIND -- True if binding with forced checking of the elaboration flags diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index a75ebfb8fdc..52cbdac9fa0 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -673,7 +673,8 @@ package body Prj.Nmsc is end if; -- Duplication of file/unit in same project is allowed if order of - -- source directories is known. + -- source directories is known, or if there is no compiler for the + -- language. if Add_Src = False then Add_Src := True; @@ -683,6 +684,9 @@ package body Prj.Nmsc is if Data.Flags.Allow_Duplicate_Basenames then Add_Src := True; + elsif Lang_Id.Config.Compiler_Driver = Empty_File then + Add_Src := True; + elsif Source_Dir_Rank /= Source.Source_Dir_Rank then Add_Src := False; diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index a8dcff6fd71..acb1cf1260b 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -380,7 +380,7 @@ package body Restrict is -- set in gnat1drv.adb so that we have consistency between each -- compilation. - if CodePeer_Mode or else ALFA_Mode then + if CodePeer_Mode or ALFA_Mode then return; end if; diff --git a/gcc/ada/s-atocou.ads b/gcc/ada/s-atocou.ads index 5efcb354847..a78c4fd26cd 100644 --- a/gcc/ada/s-atocou.ads +++ b/gcc/ada/s-atocou.ads @@ -30,7 +30,12 @@ ------------------------------------------------------------------------------ -- This package provides atomic counter on platforms where it is supported: --- ??? Please provide a list of such platforms +-- - all Alpha platforms +-- - all ia64 platforms +-- - all PowerPC platforms +-- - all SPARC V9 platforms +-- - all x86 platforms +-- - all x86_64 platforms -- Why isn't this package available to application programs??? diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 127d93d99bb..fad454e5ec3 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -9118,9 +9118,21 @@ package body Sem_Ch3 is end loop; Error_Msg_Sloc := Sloc (E); - Error_Msg_NE - ("\& has been inherited from subprogram #", + + -- AI05-0068: report if there is an overriding + -- non-abstract subprogram that is invisible. + if Is_Hidden (E) + and then not Is_Abstract_Subprogram (E) + then + Error_Msg_NE + ("\& subprogram# is not visible", T, Subp); + + else + Error_Msg_NE + ("\& has been inherited from subprogram #", + T, Subp); + end if; end; end if; end if; diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index f96fbb950a1..a5130c15936 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -177,7 +177,8 @@ package body Sem_Elab is E : Entity_Id; Outer_Scope : Entity_Id; Inter_Unit_Only : Boolean; - Generate_Warnings : Boolean := True); + Generate_Warnings : Boolean := True; + In_Init_Proc : Boolean := False); -- This is the internal recursive routine that is called to check for a -- possible elaboration error. The argument N is a subprogram call or -- generic instantiation to be checked, and E is the entity of the called @@ -186,7 +187,8 @@ package body Sem_Elab is -- call is only to be checked in the case where it is to another unit (and -- skipped if within a unit). Generate_Warnings is set to False to suppress -- warning messages about missing pragma Elaborate_All's. These messages - -- are not wanted for inner calls in the dynamic model. + -- are not wanted for inner calls in the dynamic model. Flag In_Init_Proc + -- should be set whenever the current context is a type init proc. procedure Check_Bad_Instantiation (N : Node_Id); -- N is a node for an instantiation (if called with any other node kind, @@ -229,29 +231,6 @@ package body Sem_Elab is -- Check_Internal_Call. Outer_Scope is the outer level scope for the -- original call. - procedure Set_Elaboration_Constraint - (Call : Node_Id; - Subp : Entity_Id; - Scop : Entity_Id); - -- The current unit U may depend semantically on some unit P which is not - -- in the current context. If there is an elaboration call that reaches P, - -- we need to indicate that P requires an Elaborate_All, but this is not - -- effective in U's ali file, if there is no with_clause for P. In this - -- case we add the Elaborate_All on the unit Q that directly or indirectly - -- makes P available. This can happen in two cases: - -- - -- a) Q declares a subtype of a type declared in P, and the call is an - -- initialization call for an object of that subtype. - -- - -- b) Q declares an object of some tagged type whose root type is - -- declared in P, and the initialization call uses object notation on - -- that object to reach a primitive operation or a classwide operation - -- declared in P. - -- - -- If P appears in the context of U, the current processing is correct. - -- Otherwise we must identify these two cases to retrieve Q and place the - -- Elaborate_All_Desirable on it. - function Has_Generic_Body (N : Node_Id) return Boolean; -- N is a generic package instantiation node, and this routine determines -- if this package spec does in fact have a generic body. If so, then @@ -273,6 +252,9 @@ package body Sem_Elab is -- or instantiation node for which the check code is required. C is the -- test whose failure triggers the raise. + function Is_Finalization_Procedure (Id : Entity_Id) return Boolean; + -- Determine whether entity Id denotes a [Deep_]Finalize procedure + procedure Output_Calls (N : Node_Id); -- Outputs chain of calls stored in the Elab_Call table. The caller has -- already generated the main warning message, so the warnings generated @@ -287,6 +269,29 @@ package body Sem_Elab is -- On entry C_Scope is set to some scope. On return, C_Scope is reset -- to be the enclosing compilation unit of this scope. + procedure Set_Elaboration_Constraint + (Call : Node_Id; + Subp : Entity_Id; + Scop : Entity_Id); + -- The current unit U may depend semantically on some unit P which is not + -- in the current context. If there is an elaboration call that reaches P, + -- we need to indicate that P requires an Elaborate_All, but this is not + -- effective in U's ali file, if there is no with_clause for P. In this + -- case we add the Elaborate_All on the unit Q that directly or indirectly + -- makes P available. This can happen in two cases: + -- + -- a) Q declares a subtype of a type declared in P, and the call is an + -- initialization call for an object of that subtype. + -- + -- b) Q declares an object of some tagged type whose root type is + -- declared in P, and the initialization call uses object notation on + -- that object to reach a primitive operation or a classwide operation + -- declared in P. + -- + -- If P appears in the context of U, the current processing is correct. + -- Otherwise we must identify these two cases to retrieve Q and place the + -- Elaborate_All_Desirable on it. + function Spec_Entity (E : Entity_Id) return Entity_Id; -- Given a compilation unit entity, if it is a spec entity, it is returned -- unchanged. If it is a body entity, then the spec for the corresponding @@ -472,7 +477,8 @@ package body Sem_Elab is E : Entity_Id; Outer_Scope : Entity_Id; Inter_Unit_Only : Boolean; - Generate_Warnings : Boolean := True) + Generate_Warnings : Boolean := True; + In_Init_Proc : Boolean := False) is Loc : constant Source_Ptr := Sloc (N); Ent : Entity_Id; @@ -965,6 +971,14 @@ package body Sem_Elab is then null; + -- Do not generate an Elaborate_All for finalization routines + -- which perform partial clean up as part of initialization. + + elsif In_Init_Proc + and then Is_Finalization_Procedure (Ent) + then + null; + -- Here we need to generate an implicit elaborate all else @@ -1104,8 +1118,9 @@ package body Sem_Elab is --------------------- procedure Check_Elab_Call - (N : Node_Id; - Outer_Scope : Entity_Id := Empty) + (N : Node_Id; + Outer_Scope : Entity_Id := Empty; + In_Init_Proc : Boolean := False) is Ent : Entity_Id; P : Node_Id; @@ -1414,14 +1429,19 @@ package body Sem_Elab is C_Scope := Current_Scope; - -- If not outer level call, then we follow it if it is within - -- the original scope of the outer call. + -- If not outer level call, then we follow it if it is within the + -- original scope of the outer call. if Present (Outer_Scope) and then Within (Scope (Ent), Outer_Scope) then Set_C_Scope; - Check_A_Call (N, Ent, Outer_Scope, Inter_Unit_Only => False); + Check_A_Call + (N => N, + E => Ent, + Outer_Scope => Outer_Scope, + Inter_Unit_Only => False, + In_Init_Proc => In_Init_Proc); elsif Elaboration_Checks_Suppressed (Current_Scope) then null; @@ -1446,7 +1466,7 @@ package body Sem_Elab is (N, Ent, Standard_Standard, - Inter_Unit_Only => True, + Inter_Unit_Only => True, Generate_Warnings => False); -- Otherwise nothing to do @@ -1978,7 +1998,7 @@ package body Sem_Elab is -- arguments that are assignments (OUT or IN OUT mode formals). elsif Nkind (N) = N_Procedure_Call_Statement then - Check_Elab_Call (N, Outer_Scope); + Check_Elab_Call (N, Outer_Scope, In_Init_Proc => Is_Init_Proc (E)); Actual := First_Actual (N); while Present (Actual) loop @@ -2912,6 +2932,21 @@ package body Sem_Elab is end if; end Insert_Elab_Check; + ------------------------------- + -- Is_Finalization_Procedure -- + ------------------------------- + + function Is_Finalization_Procedure (Id : Entity_Id) return Boolean is + begin + return + Ekind (Id) = E_Procedure + and then + (Chars (Id) = Name_Finalize + or else Is_TSS (Id, TSS_Deep_Finalize)) + and then Present (First_Formal (Id)) + and then Needs_Finalization (Etype (First_Formal (Id))); + end Is_Finalization_Procedure; + ------------------ -- Output_Calls -- ------------------ diff --git a/gcc/ada/sem_elab.ads b/gcc/ada/sem_elab.ads index 7b85b6f886f..f7a52466a30 100644 --- a/gcc/ada/sem_elab.ads +++ b/gcc/ada/sem_elab.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1997-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2011, 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- -- @@ -118,12 +118,16 @@ package Sem_Elab is -- the resulting code does not contain subprogram specs with no -- corresponding bodies. - procedure Check_Elab_Call (N : Node_Id; Outer_Scope : Entity_Id := Empty); + procedure Check_Elab_Call + (N : Node_Id; + Outer_Scope : Entity_Id := Empty; + In_Init_Proc : Boolean := False); -- Check a call for possible elaboration problems. The node N is either -- an N_Function_Call or N_Procedure_Call_Statement node. The Outer_Scope -- argument indicates whether this is an outer level call from Sem_Res -- (Outer_Scope set to Empty), or an internal recursive call (Outer_Scope - -- set to entity of outermost call, see body). + -- set to entity of outermost call, see body). Flag In_Init_Proc should be + -- set whenever the current context is a type init proc. procedure Check_Elab_Calls; -- Not all the processing for Check_Elab_Call can be done at the time diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index e338b4b70e3..32d38d8f8d2 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5287,7 +5287,7 @@ package body Sem_Prag is -- user code: we want to generate checks for analysis purposes, as -- set respectively by -gnatC and -gnatd.F - if (CodePeer_Mode or else ALFA_Mode) + if (CodePeer_Mode or ALFA_Mode) and then Comes_From_Source (N) then return; @@ -9452,7 +9452,7 @@ package body Sem_Prag is -- in these modes. if not Restriction_Active (No_Initialize_Scalars) - and then not (CodePeer_Mode or else ALFA_Mode) + and then not (CodePeer_Mode or ALFA_Mode) then Init_Or_Norm_Scalars := True; Initialize_Scalars := True; @@ -9482,7 +9482,7 @@ package body Sem_Prag is -- Pragma always active unless in CodePeer or ALFA mode, since -- this causes walk order issues. - if not (CodePeer_Mode or else ALFA_Mode) then + if not (CodePeer_Mode or ALFA_Mode) then Process_Inline (True); end if; @@ -10925,7 +10925,7 @@ package body Sem_Prag is -- incorrect negative results in ALFA mode, so ignore this pragma -- in these modes. - if not (CodePeer_Mode or else ALFA_Mode) then + if not (CodePeer_Mode or ALFA_Mode) then Normalize_Scalars := True; Init_Or_Norm_Scalars := True; end if; @@ -11294,7 +11294,7 @@ package body Sem_Prag is -- complex front-end expansions related to pragma Pack, -- so disable handling of pragma Pack in these cases. - if CodePeer_Mode or else ALFA_Mode then + if CodePeer_Mode or ALFA_Mode then null; -- Don't attempt any packing for VM targets. We possibly