+2011-08-05 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb: (Check_Private_Overriding): better error message,
+ suggested by AI95-0068.
+
+2011-08-05 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * 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 <godunko@adacore.com>
+
+ * s-atocou.ads: Add list of supported platforms.
+
+2011-08-05 Yannick Moy <moy@adacore.com>
+
+ * 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 <falis@adacore.com>
+
+ * env.c (__gnat_environ): Fix includes for RTPs and VTHREADS so that
+ environ is properly defined.
+
+2011-08-05 Vincent Celier <celier@adacore.com>
+
+ * 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 <dewar@adacore.com>
* exp_ch7.ads, sem_type.adb, make.adb, sem_prag.adb, sem_util.adb,
#include <stdlib.h>
#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 <unistd.h>
+ #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 <vThreadsData.h>
+ #include <envLib.h>
+ #else
+ /* This should work for kernel mode on both VxWorks 5 and VxWorks 6. */
+ #include <envLib.h>
+
+ /* 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. */
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__)
#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
}
-- 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 --
------------------
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
-- 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.
@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
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})
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.
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);
-- 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
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;
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;
-- 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;
------------------------------------------------------------------------------
-- 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???
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;
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
-- 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,
-- 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
-- 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
-- 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
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;
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
---------------------
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;
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;
(N,
Ent,
Standard_Standard,
- Inter_Unit_Only => True,
+ Inter_Unit_Only => True,
Generate_Warnings => False);
-- Otherwise nothing to do
-- 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
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 --
------------------
-- --
-- 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- --
-- 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
-- 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;
-- 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;
-- 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;
-- 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;
-- 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
projects / gcc.git / commitdiff