+2014-10-23 Yannick Moy <moy@adacore.com>
+
+ * sem_prag.adb (Analyze_Pragma/Pragma_Inline & Pragma_Inline_Always):
+ Disable analysis in GNATprove mode.
+
+2014-10-23 Arnaud Charlet <charlet@adacore.com>
+
+ * mlib-prj.adb: Remove obsolete references to libdecgnat (VMS only).
+
+2014-10-23 Arnaud Charlet <charlet@adacore.com>
+
+ * gnat1drv.adb (Adjust_Global_Switches): Ignore style check
+ pragmas in codepeer mode.
+
+2014-10-23 Gary Dismukes <dismukes@adacore.com>
+
+ * gnat_rm.texi: Minor syntax fix for pragma Annotate (missing ',').
+
+2014-10-23 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch12.adb (Inline_Instance_Body): Alphabetize
+ local variables and constants. Add constants Save_SM and Save_SMP
+ to capture SPARK_Mode-related attributes. Compile the inlined
+ body with the SPARK_Mode of the enclosing context.
+
+2014-10-23 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sinfo.adb (Elaboration_Boolean): Removed.
+ (Set_Elaboration_Boolean): Removed.
+ * sinfo.ads Remove attribute Elaboration_Boolean along with its
+ occurrence in nodes.
+ (Elaboration_Boolean): Removed along with pragma Inline.
+ (Set_Elaboration_Boolean): Removed along with pragma Inline.
+
+2014-10-23 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb (Constant_Redeclaration): Make error message more
+ explicit on a deferred constant whose object_definition is an
+ anonymous array.
+
+2014-10-23 Vincent Celier <celier@adacore.com>
+
+ * gnatls.adb: Never call Targparm.Get_Target_Parameters.
+
+2014-10-23 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch6.adb (Analyze_Expression_Function): In a generic
+ context do not create a body, and only pre-analyze the expression,
+ which may include incomplete views.
+
2014-10-23 Robert Dewar <dewar@adacore.com>
* sem_type.adb: Minor code reorganization (use Nkind_In, Ekind_In).
Validity_Check_In_Out_Params := True;
Validity_Check_In_Params := True;
- -- Turn off style check options since we are not interested in any
- -- front-end warnings when we are getting CodePeer output.
+ -- Turn off style check options and ignore any style check pragmas
+ -- since we are not interested in any front-end warnings when we are
+ -- getting CodePeer output.
Reset_Style_Check_Options;
+ Ignore_Style_Checks_Pragmas := True;
-- Always perform semantics and generate ali files in CodePeer mode,
-- so that a gnatmake -c -k will proceed further when possible.
@noindent
Syntax:
@smallexample @c ada
-pragma Annotate (IDENTIFIER [,IDENTIFIER @{, ARG@}] [entity => local_NAME]);
+pragma Annotate (IDENTIFIER [, IDENTIFIER @{, ARG@}] [, entity => local_NAME]);
ARG ::= NAME | EXPRESSION
@end smallexample
with Snames;
with Stringt;
with Switch; use Switch;
-with Targparm; use Targparm;
with Types; use Types;
with Ada.Command_Line; use Ada.Command_Line;
Osint.Add_Default_Search_Dirs;
- -- Get the target parameters, but only if switch -nostdinc was not
- -- specified. May not be needed any more, but is harmless.
-
- if not Opt.No_Stdinc then
- Get_Target_Parameters;
- end if;
-
if Verbose_Mode then
Write_Eol;
Display_Version ("GNATLS", "1997");
ALIs.Append (new String'(ALI_Path));
-- Find out if for this ALI file,
- -- libgnarl or libdecgnat is
- -- necessary.
+ -- libgnarl is necessary.
Check_Libs (ALI_Path, True);
end if;
-- Ignore -static and -shared, since -shared will be used
-- in any case.
- -- Ignore -lgnat, -lgnarl and -ldecgnat as they will be added
- -- later, because they are also needed for non Stand-Alone shared
+ -- Ignore -lgnat and -lgnarl as they will be added later,
+ -- because they are also needed for non Stand-Alone shared
-- libraries.
-- Also ignore the shared libraries which are :
if Next_Line (1 .. Nlast) /= "-static" and then
Next_Line (1 .. Nlast) /= "-shared" and then
- Next_Line (1 .. Nlast) /= "-ldecgnat" and then
Next_Line (1 .. Nlast) /= "-lgnarl" and then
Next_Line (1 .. Nlast) /= "-lgnat" and then
- Next_Line
- (1 .. Natural'Min (Nlast, 10 + Library_Version'Length)) /=
- Shared_Lib ("decgnat") and then
Next_Line
(1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) /=
Shared_Lib ("gnarl") and then
Gen_Unit : Entity_Id;
Act_Decl : Node_Id)
is
- Vis : Boolean;
- Gen_Comp : constant Entity_Id :=
- Cunit_Entity (Get_Source_Unit (Gen_Unit));
- Curr_Comp : constant Node_Id := Cunit (Current_Sem_Unit);
- Curr_Scope : Entity_Id := Empty;
- Curr_Unit : constant Entity_Id := Cunit_Entity (Current_Sem_Unit);
- Removed : Boolean := False;
- Num_Scopes : Int := 0;
+ Curr_Comp : constant Node_Id := Cunit (Current_Sem_Unit);
+ Curr_Unit : constant Entity_Id := Cunit_Entity (Current_Sem_Unit);
+ Gen_Comp : constant Entity_Id :=
+ Cunit_Entity (Get_Source_Unit (Gen_Unit));
+
+ Save_SM : constant SPARK_Mode_Type := SPARK_Mode;
+ Save_SMP : constant Node_Id := SPARK_Mode_Pragma;
+ -- Save all SPARK_Mode-related attributes as removing enclosing scopes
+ -- to provide a clean environment for analysis of the inlined body will
+ -- eliminate any previously set SPARK_Mode.
Scope_Stack_Depth : constant Int :=
Scope_Stack.Last - Scope_Stack.First + 1;
Use_Clauses : array (1 .. Scope_Stack_Depth) of Node_Id;
Instances : array (1 .. Scope_Stack_Depth) of Entity_Id;
Inner_Scopes : array (1 .. Scope_Stack_Depth) of Entity_Id;
+ Curr_Scope : Entity_Id := Empty;
List : Elist_Id;
Num_Inner : Int := 0;
+ Num_Scopes : Int := 0;
N_Instances : Int := 0;
+ Removed : Boolean := False;
S : Entity_Id;
+ Vis : Boolean;
begin
-- Case of generic unit defined in another unit. We must remove the
pragma Assert (Num_Inner < Num_Scopes);
+ -- The inlined package body must be analyzed with the SPARK_Mode of
+ -- the enclosing context, otherwise the body may cause bogus errors
+ -- if a configuration SPARK_Mode pragma in in effect.
+
Push_Scope (Standard_Standard);
Scope_Stack.Table (Scope_Stack.Last).Is_Active_Stack_Base := True;
Instantiate_Package_Body
Version => Ada_Version,
Version_Pragma => Ada_Version_Pragma,
Warnings => Save_Warnings,
- SPARK_Mode => SPARK_Mode,
- SPARK_Mode_Pragma => SPARK_Mode_Pragma)),
+ SPARK_Mode => Save_SM,
+ SPARK_Mode_Pragma => Save_SMP)),
Inlined_Body => True);
Pop_Scope;
end loop;
end;
- -- If generic unit is in current unit, current context is correct
+ -- If generic unit is in current unit, current context is correct. Note
+ -- that the context is guaranteed to carry the correct SPARK_Mode as no
+ -- enclosing scopes were removed.
else
Instantiate_Package_Body
Set_Full_View (Prev, Id);
Set_Etype (Id, Any_Type);
+ -- A deferred constant whose type is an anonymous array is always
+ -- illegal (unless imported). A detailed error message might be
+ -- helpful for Ada beginners.
+
+ if Nkind (Object_Definition (Parent (Prev)))
+ = N_Constrained_Array_Definition
+ and then Nkind (Object_Definition (N))
+ = N_Constrained_Array_Definition
+ then
+ Error_Msg_N ("\each anonymous array is a distinct type", N);
+ Error_Msg_N ("a deferred constant must have a named type",
+ Object_Definition (Parent (Prev)));
+ end if;
+
elsif
Null_Exclusion_Present (Parent (Prev))
and then not Null_Exclusion_Present (N)
-- If there are previous overloadable entities with the same name,
-- check whether any of them is completed by the expression function.
+ -- In a generic context a formal subprogram has no completion.
- if Present (Prev) and then Is_Overloadable (Prev) then
+ if Present (Prev) and then Is_Overloadable (Prev)
+ and then not Is_Formal_Subprogram (Prev)
+ then
Def_Id := Analyze_Subprogram_Specification (Spec);
Prev := Find_Corresponding_Spec (N);
end if;
-- scope. The entity itself may be internally created if within a body
-- to be inlined.
- elsif Present (Prev) and then Comes_From_Source (Parent (Prev)) then
+ elsif Present (Prev) and then Comes_From_Source (Parent (Prev))
+ and then not Is_Formal_Subprogram (Prev)
+ then
Set_Has_Completion (Prev, False);
-- An expression function that is a completion freezes the
end if;
Analyze (N);
+
+ -- Within a generic we only need to analyze the expression. The body
+ -- only needs to be constructed when generating code.
+
+ if Inside_A_Generic then
+ declare
+ Id : constant Entity_Id := Defining_Entity (N);
+ Save_In_Spec_Expression : constant Boolean
+ := In_Spec_Expression;
+
+ begin
+ Set_Has_Completion (Id);
+ In_Spec_Expression := True;
+ Push_Scope (Id);
+ Install_Formals (Id);
+ Preanalyze_And_Resolve (Expr, Etype (Id));
+ End_Scope;
+ In_Spec_Expression := Save_In_Spec_Expression;
+ return;
+ end;
+ end if;
+
Set_Is_Inlined (Defining_Entity (N));
-- Establish the linkages between the spec and the body. These are
when Pragma_Inline =>
- -- Inline status is Enabled if inlining option is active
+ -- Pragma always active unless in GNATprove mode. It is disabled
+ -- in GNATprove mode because frontend inlining is applied
+ -- independently of pragmas Inline and Inline_Always for
+ -- formal verification, see Can_Be_Inlined_In_GNATprove_Mode
+ -- in inline.ads.
- if Inline_Active then
- Process_Inline (Enabled);
- else
- Process_Inline (Disabled);
+ if not GNATprove_Mode then
+
+ -- Inline status is Enabled if inlining option is active
+
+ if Inline_Active then
+ Process_Inline (Enabled);
+ else
+ Process_Inline (Disabled);
+ end if;
end if;
-------------------
when Pragma_Inline_Always =>
GNAT_Pragma;
- -- Pragma always active unless in CodePeer mode. It is disabled
- -- in CodePeer mode because inlining is not helpful, and enabling
- -- if caused walk order issues.
-
- -- Historical note: this pragma used to be disabled in GNATprove
- -- mode as well, but that was odd since walk order should not be
- -- an issue in that case.
+ -- Pragma always active unless in CodePeer mode or GNATprove
+ -- mode. It is disabled in CodePeer mode because inlining is
+ -- not helpful, and enabling it caused walk order issues. It
+ -- is disabled in GNATprove mode because frontend inlining is
+ -- applied independently of pragmas Inline and Inline_Always for
+ -- formal verification, see Can_Be_Inlined_In_GNATprove_Mode in
+ -- inline.ads.
- if not CodePeer_Mode then
+ if not CodePeer_Mode and not GNATprove_Mode then
Process_Inline (Enabled);
end if;
return Flag4 (N);
end Elaborate_Present;
- function Elaboration_Boolean
- (N : Node_Id) return Node_Id is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Function_Specification
- or else NT (N).Nkind = N_Procedure_Specification);
- return Node2 (N);
- end Elaboration_Boolean;
-
function Else_Actions
(N : Node_Id) return List_Id is
begin
Set_Flag4 (N, Val);
end Set_Elaborate_Present;
- procedure Set_Elaboration_Boolean
- (N : Node_Id; Val : Node_Id) is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Function_Specification
- or else NT (N).Nkind = N_Procedure_Specification);
- Set_Node2 (N, Val);
- end Set_Elaboration_Boolean;
-
procedure Set_Else_Actions
(N : Node_Id; Val : List_Id) is
begin
-- elaboration processing has determined that an Elaborate pragma is
-- desirable for correct elaboration for this unit.
- -- Elaboration_Boolean (Node2-Sem)
- -- This field is present in function and procedure specification nodes.
- -- If set, it points to the entity for a Boolean flag that must be tested
- -- for certain calls to check for access before elaboration. See body of
- -- Sem_Elab for further details. This field is Empty if no elaboration
- -- boolean is required.
-
-- Else_Actions (List3-Sem)
-- This field is present in if expression nodes. During code
-- expansion we use the Insert_Actions procedure (in Exp_Util) to insert
-- N_Function_Specification
-- Sloc points to FUNCTION
-- Defining_Unit_Name (Node1) (the designator)
- -- Elaboration_Boolean (Node2-Sem)
-- Parameter_Specifications (List3) (set to No_List if no formal part)
-- Null_Exclusion_Present (Flag11)
-- Result_Definition (Node4) for result subtype
-- N_Procedure_Specification
-- Sloc points to PROCEDURE
-- Defining_Unit_Name (Node1)
- -- Elaboration_Boolean (Node2-Sem)
-- Parameter_Specifications (List3) (set to No_List if no formal part)
-- Generic_Parent (Node5-Sem)
-- Null_Present (Flag13) set for null procedure case (Ada 2005 feature)
function Elaborate_Present
(N : Node_Id) return Boolean; -- Flag4
- function Elaboration_Boolean
- (N : Node_Id) return Node_Id; -- Node2
-
function Else_Actions
(N : Node_Id) return List_Id; -- List3
procedure Set_Elaborate_Present
(N : Node_Id; Val : Boolean := True); -- Flag4
- procedure Set_Elaboration_Boolean
- (N : Node_Id; Val : Node_Id); -- Node2
-
procedure Set_Else_Actions
(N : Node_Id; Val : List_Id); -- List3
N_Function_Specification =>
(1 => True, -- Defining_Unit_Name (Node1)
- 2 => False, -- Elaboration_Boolean (Node2-Sem)
+ 2 => False, -- unused
3 => True, -- Parameter_Specifications (List3)
4 => True, -- Result_Definition (Node4)
5 => False), -- Generic_Parent (Node5-Sem)
N_Procedure_Specification =>
(1 => True, -- Defining_Unit_Name (Node1)
- 2 => False, -- Elaboration_Boolean (Node2-Sem)
+ 2 => False, -- unused
3 => True, -- Parameter_Specifications (List3)
4 => False, -- unused
5 => False), -- Generic_Parent (Node5-Sem)
pragma Inline (Elaborate_All_Desirable);
pragma Inline (Elaborate_All_Present);
pragma Inline (Elaborate_Desirable);
- pragma Inline (Elaboration_Boolean);
pragma Inline (Else_Actions);
pragma Inline (Else_Statements);
pragma Inline (Elsif_Parts);
pragma Inline (Set_Elaborate_All_Present);
pragma Inline (Set_Elaborate_Desirable);
pragma Inline (Set_Elaborate_Present);
- pragma Inline (Set_Elaboration_Boolean);
pragma Inline (Set_Else_Actions);
pragma Inline (Set_Else_Statements);
pragma Inline (Set_Elsif_Parts);
projects / gcc.git / commitdiff