+2014-02-06 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat_rm.texi: Small wording tweak.
+
+2014-02-06 Pascal Obry <obry@adacore.com>
+
+ * prj-attr.adb, projects.texi, snames.ads-tmpl: Add Included_Patterns
+ and Included_Artifact_Patterns attribute definitions.
+
+2014-02-06 Yannick Moy <moy@adacore.com>
+
+ * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Set
+ SPARK_Mode pragma component for all subprograms, including stubs.
+
+2014-02-06 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch10.adb (Analyze_Package_Body_Stub): Maintain
+ the configuration options of the enclosing context in a
+ stack-like fasion.
+ (Analyze_Subprogram_Body_Stub): Maintain the
+ configuration options of the enclosing context in a stack-like
+ fashion.
+
+2014-02-06 Robert Dewar <dewar@adacore.com>
+
+ * debug.adb: -gnatd.u sets Modify_Tree_For C
+ * exp_ch4.adb (Expand_N_Op_Rotate_Left): Expand out
+ if Modify_Tree_For_C (Expand_N_Op_Rotate_Right): ditto.
+ (Expand_N_Op_Arithmetic_Right_Shift): ditto.
+ * exp_intr.adb (Expand_Shift): Call expander so we do
+ Modify_Tree_For_C expansions.
+ * gnat1drv.adb (Adjust_Global_Switches): Set Modify_Tree_For_C
+ if -gnatd.u set.
+
+2014-02-06 Fedor Rybin <frybin@adacore.com>
+
+ * prj-proc.ads (Tree_Loaded_Callback): new type Callback used
+ after the phase 1 of the processing of each aggregated project
+ to get access to project trees of aggregated projects.
+ (Process_Project_Tree_Phase_1): new parameter On_New_Tree_Loaded
+ If specified, On_New_Tree_Loaded is called after each aggregated
+ project has been processed succesfully.
+ (Process): new parameter On_New_Tree_Loaded.
+ * prj-proc.adb (Process_Aggregated_Projects): On_New_Tree_Loaded
+ callback added after processing of each aggregated project.
+ (Recursive_Process): new parameter On_New_Tree_Loaded.
+ (Process): new parameter On_New_Tree_Loaded.
+ (Process_Project_Tree_Phase_1): new parameter On_New_Tree_Loaded.
+ * prj-conf.ads (Parse_Project_And_Apply_Config): new parameter
+ On_New_Tree_Loaded.
+ * prj-conf.adb (Parse_Project_And_Apply_Config): new parameter
+ On_New_Tree_Loaded.
+
+2014-02-06 Bob Duff <duff@adacore.com>
+
+ * gnat_ugn.texi: Implement --insert-blank-lines and
+ --preserve-blank-lines switches.
+
2014-02-06 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi, vms_data.ads: Add documentation of -j option for
-- d.r Enable OK_To_Reorder_Components in non-variant records
-- d.s Disable expansion of slice move, use memmove
-- d.t Disable static allocation of library level dispatch tables
- -- d.u
+ -- d.u Enable Modify_Tree_For_C (update tree for c)
-- d.v Enable OK_To_Reorder_Components in variant records
-- d.w Do not check for infinite loops
-- d.x No exception handlers
-- previous dynamic construction of tables. It is there as a possible
-- work around if we run into trouble with the new implementation.
+ -- d.u Sets Modify_Tree_For_C mode in which tree is modified to make it
+ -- easier to generate code using a C compiler.
+
-- d.v Forces the flag OK_To_Reorder_Components to be set in all record
-- base types that have at least one discriminant (v = variant).
procedure Expand_N_Op_Rotate_Left (N : Node_Id) is
begin
Binary_Op_Validity_Checks (N);
+
+ -- If we are in Modify_Tree_For_C mode, there is no rotate left in C,
+ -- so we rewrite in terms of logical shifts
+
+ -- Shift_Left (Num, Bits) or Shift_Right (num, Esize - Bits)
+
+ -- where Bits is the shift count mod Esize (the mod operation here
+ -- deals with ludicrous large shift counts, which are apparently OK).
+
+ -- What about non-binary modulus ???
+
+ declare
+ Loc : constant Source_Ptr := Sloc (N);
+ Rtp : constant Entity_Id := Etype (Right_Opnd (N));
+ Typ : constant Entity_Id := Etype (N);
+
+ begin
+ if Modify_Tree_For_C then
+ Rewrite (Right_Opnd (N),
+ Make_Op_Rem (Loc,
+ Left_Opnd => Relocate_Node (Right_Opnd (N)),
+ Right_Opnd => Make_Integer_Literal (Loc, Esize (Typ))));
+
+ Analyze_And_Resolve (Right_Opnd (N), Rtp);
+
+ Rewrite (N,
+ Make_Op_Or (Loc,
+ Left_Opnd =>
+ Make_Op_Shift_Left (Loc,
+ Left_Opnd => Left_Opnd (N),
+ Right_Opnd => Right_Opnd (N)),
+ Right_Opnd =>
+ Make_Op_Shift_Right (Loc,
+ Left_Opnd => Duplicate_Subexpr_No_Checks (Left_Opnd (N)),
+ Right_Opnd =>
+ Make_Op_Subtract (Loc,
+ Left_Opnd => Make_Integer_Literal (Loc, Esize (Typ)),
+ Right_Opnd =>
+ Duplicate_Subexpr_No_Checks (Right_Opnd (N))))));
+
+ Analyze_And_Resolve (N, Typ);
+ end if;
+ end;
end Expand_N_Op_Rotate_Left;
------------------------------
procedure Expand_N_Op_Rotate_Right (N : Node_Id) is
begin
Binary_Op_Validity_Checks (N);
+
+ -- If we are in Modify_Tree_For_C mode, there is no rotate right in C,
+ -- so we rewrite in terms of logical shifts
+
+ -- Shift_Right (Num, Bits) or Shift_Left (num, Esize - Bits)
+
+ -- where Bits is the shift count mod Esize (the mod operation here
+ -- deals with ludicrous large shift counts, which are apparently OK).
+
+ -- What about non-binary modulus ???
+
+ declare
+ Loc : constant Source_Ptr := Sloc (N);
+ Rtp : constant Entity_Id := Etype (Right_Opnd (N));
+ Typ : constant Entity_Id := Etype (N);
+
+ begin
+ Rewrite (Right_Opnd (N),
+ Make_Op_Rem (Loc,
+ Left_Opnd => Relocate_Node (Right_Opnd (N)),
+ Right_Opnd => Make_Integer_Literal (Loc, Esize (Typ))));
+
+ Analyze_And_Resolve (Right_Opnd (N), Rtp);
+
+ if Modify_Tree_For_C then
+ Rewrite (N,
+ Make_Op_Or (Loc,
+ Left_Opnd =>
+ Make_Op_Shift_Right (Loc,
+ Left_Opnd => Left_Opnd (N),
+ Right_Opnd => Right_Opnd (N)),
+ Right_Opnd =>
+ Make_Op_Shift_Left (Loc,
+ Left_Opnd => Duplicate_Subexpr_No_Checks (Left_Opnd (N)),
+ Right_Opnd =>
+ Make_Op_Subtract (Loc,
+ Left_Opnd => Make_Integer_Literal (Loc, Esize (Typ)),
+ Right_Opnd =>
+ Duplicate_Subexpr_No_Checks (Right_Opnd (N))))));
+
+ Analyze_And_Resolve (N, Typ);
+ end if;
+ end;
end Expand_N_Op_Rotate_Right;
----------------------------
procedure Expand_N_Op_Shift_Right_Arithmetic (N : Node_Id) is
begin
Binary_Op_Validity_Checks (N);
+
+ -- If we are in Modify_Tree_For_C mode, there is no shift right
+ -- arithmetic in C, so we rewrite in terms of logical shifts.
+
+ -- Shift_Right (Num, Bits) or
+ -- (if Num >= Sign
+ -- then not (Shift_Right (Mask, bits))
+ -- else 0)
+
+ -- Here Mask is all 1 bits (2**size - 1), and Sign is 2**(size - 1)
+
+ -- Note: in almost all C compilers it would work to just shift a
+ -- signed integer right, but it's undefined and we cannot rely on it.
+
+ -- What about non-binary modulus ???
+
+ declare
+ Loc : constant Source_Ptr := Sloc (N);
+ Typ : constant Entity_Id := Etype (N);
+ Sign : constant Uint := 2 ** (Esize (Typ) - 1);
+ Mask : constant Uint := (2 ** Esize (Typ)) - 1;
+ Left : constant Node_Id := Left_Opnd (N);
+ Right : constant Node_Id := Right_Opnd (N);
+ Maskx : Node_Id;
+
+ begin
+ if Modify_Tree_For_C then
+
+ -- Here if not (Shift_Right (Mask, bits)) can be computed at
+ -- compile time as a single constant.
+
+ if Compile_Time_Known_Value (Right) then
+ declare
+ Val : constant Uint := Expr_Value (Right);
+
+ begin
+ if Val >= Esize (Typ) then
+ Maskx := Make_Integer_Literal (Loc, Mask);
+
+ else
+ Maskx :=
+ Make_Integer_Literal (Loc,
+ Intval => Mask - (Mask / (2 ** Expr_Value (Right))));
+ end if;
+ end;
+
+ else
+ Maskx :=
+ Make_Op_Not (Loc,
+ Right_Opnd =>
+ Make_Op_Shift_Right (Loc,
+ Left_Opnd => Make_Integer_Literal (Loc, Mask),
+ Right_Opnd => Duplicate_Subexpr_No_Checks (Right)));
+ end if;
+
+ -- Now do the rewrite
+
+ Rewrite (N,
+ Make_Op_Or (Loc,
+ Left_Opnd =>
+ Make_Op_Shift_Right (Loc,
+ Left_Opnd => Left,
+ Right_Opnd => Right),
+ Right_Opnd =>
+ Make_If_Expression (Loc,
+ Expressions => New_List (
+ Make_Op_Ge (Loc,
+ Left_Opnd => Duplicate_Subexpr_No_Checks (Left),
+ Right_Opnd => Make_Integer_Literal (Loc, Sign)),
+ Maskx,
+ Make_Integer_Literal (Loc, 0)))));
+ Analyze_And_Resolve (N, Typ);
+ end if;
+ end;
end Expand_N_Op_Shift_Right_Arithmetic;
--------------------------
with Checks; use Checks;
with Einfo; use Einfo;
with Elists; use Elists;
+with Expander; use Expander;
with Exp_Atag; use Exp_Atag;
with Exp_Ch4; use Exp_Ch4;
with Exp_Ch7; use Exp_Ch7;
-- As a result, whenever a shift is used in the source program, it will
-- remain as a call until converted by this routine to the operator node
- -- form which Gigi is expecting to see.
+ -- form which the back end is expecting to see.
-- Note: it is possible for the expander to generate shift operator nodes
-- directly, which will be analyzed in the normal manner by calling Analyze
Rewrite (N, Snode);
Set_Analyzed (N);
- else
+ -- However, we do call the expander, so that the expansion for
+ -- rotates and shift_right_arithmetic happens if Modify_Tree_For_C
+ -- is set.
+
+ if Expander_Active then
+ Expand (N);
+ end if;
+ else
-- If the context type is not the type of the operator, it is an
-- inherited operator for a derived type. Wrap the node in a
-- conversion so that it is type-consistent for possible further
Relaxed_RM_Semantics := True;
end if;
- -- -gnatd.V enables special C expansion mode
+ -- -gnatd.V or -gnatd.u enables special C expansion mode
- if Debug_Flag_Dot_VV then
+ if Debug_Flag_Dot_VV or Debug_Flag_Dot_U then
Modify_Tree_For_C := True;
end if;
in general possible to set the alignment of such a record to one, so the
pragma is ignored in this case (with a warning).
-Specifying SPACE also disables individual alignment promotions for objects,
+Specifying SPACE also disables alignment promotions for standalone objects,
which occur when the compiler increases the alignment of a specific object
without changing the alignment of its type.
Use a separate line for a loop or block statement name, but do not use an extra
indentation level for the statement itself.
+@cindex @option{^--insert-blank-lines^/INSERT_BLANK_LINES^} (@command{gnatpp})
+@item ^--insert-blank-lines^/INSERT_BLANK_LINES^
+Insert blank lines where appropriate (between bodies and other large
+constructs).
+
+@cindex @option{^--preserve-blank-lines^/PRESERVE_BLANK_LINES^} (@command{gnatpp})
+@item ^--preserve-blank-lines^/PRESERVE_BLANK_LINES^
+Preserve blank lines in the input. By default, gnatpp will squeeze
+multiple blank lines down to one.
+
@end table
@ifclear vms
"Premote#" &
"SVroot_dir#" &
"LVexcluded_patterns#" &
+ "LVincluded_patterns#" &
+ "LVincluded_artifact_patterns#" &
-- package Stack
From_Project_Node => Config_Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Env => Env,
- Reset_Tree => False);
+ Reset_Tree => False,
+ On_New_Tree_Loaded => null);
end if;
if Config_Project_Node = Empty_Node
Target_Name : String := "";
Normalized_Hostname : String;
On_Load_Config : Config_File_Hook := null;
- Implicit_Project : Boolean := False)
+ Implicit_Project : Boolean := False;
+ On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null)
is
begin
pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
Config_File_Path => Config_File_Path,
Target_Name => Target_Name,
Normalized_Hostname => Normalized_Hostname,
- On_Load_Config => On_Load_Config);
+ On_Load_Config => On_Load_Config,
+ On_New_Tree_Loaded => On_New_Tree_Loaded);
end Parse_Project_And_Apply_Config;
--------------------------------------
Target_Name : String := "";
Normalized_Hostname : String;
On_Load_Config : Config_File_Hook := null;
- Reset_Tree : Boolean := True)
+ Reset_Tree : Boolean := True;
+ On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null)
is
Shared : constant Shared_Project_Tree_Data_Access :=
Project_Tree.Shared;
From_Project_Node => User_Project_Node,
From_Project_Node_Tree => Project_Node_Tree,
Env => Env,
- Reset_Tree => Reset_Tree);
+ Reset_Tree => Reset_Tree,
+ On_New_Tree_Loaded => On_New_Tree_Loaded);
if not Success then
Main_Project := No_Project;
-- The following package manipulates the configuration files
with Prj.Tree;
+with Prj.Proc;
package Prj.Conf is
procedure Parse_Project_And_Apply_Config
(Main_Project : out Prj.Project_Id;
User_Project_Node : out Prj.Tree.Project_Node_Id;
- Config_File_Name : String := "";
+ Config_File_Name : String := "";
Autoconf_Specified : Boolean;
Project_File_Name : String;
Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Packages_To_Check : String_List_Access;
- Allow_Automatic_Generation : Boolean := True;
+ Allow_Automatic_Generation : Boolean := True;
Automatically_Generated : out Boolean;
Config_File_Path : out String_Access;
- Target_Name : String := "";
+ Target_Name : String := "";
Normalized_Hostname : String;
- On_Load_Config : Config_File_Hook := null;
- Implicit_Project : Boolean := False);
+ On_Load_Config : Config_File_Hook := null;
+ Implicit_Project : Boolean := False;
+ On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null);
-- Find the main configuration project and parse the project tree rooted at
-- this configuration project.
--
-- invoked without a project file and is using an implicit project file
-- that is virtually in the current working directory, but is physically
-- in another directory.
+ --
+ -- If specified, On_New_Tree_Loaded is called after each aggregated project
+ -- has been processed succesfully.
procedure Process_Project_And_Apply_Config
(Main_Project : out Prj.Project_Id;
User_Project_Node : Prj.Tree.Project_Node_Id;
- Config_File_Name : String := "";
+ Config_File_Name : String := "";
Autoconf_Specified : Boolean;
Project_Tree : Prj.Project_Tree_Ref;
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Packages_To_Check : String_List_Access;
- Allow_Automatic_Generation : Boolean := True;
+ Allow_Automatic_Generation : Boolean := True;
Automatically_Generated : out Boolean;
Config_File_Path : out String_Access;
- Target_Name : String := "";
+ Target_Name : String := "";
Normalized_Hostname : String;
- On_Load_Config : Config_File_Hook := null;
- Reset_Tree : Boolean := True);
+ On_Load_Config : Config_File_Hook := null;
+ Reset_Tree : Boolean := True;
+ On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null);
-- Same as above, except the project must already have been parsed through
-- Prj.Part.Parse, and only the processing of the project and the
-- configuration is done at this level.
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Allow_Automatic_Generation : Boolean;
- Config_File_Name : String := "";
+ Config_File_Name : String := "";
Autoconf_Specified : Boolean;
- Target_Name : String := "";
+ Target_Name : String := "";
Normalized_Hostname : String;
Packages_To_Check : String_List_Access := null;
Config : out Prj.Project_Id;
Config_File_Path : out String_Access;
Automatically_Generated : out Boolean;
- On_Load_Config : Config_File_Hook := null);
+ On_Load_Config : Config_File_Hook := null);
-- Compute the name of the configuration file that should be used. If no
-- default configuration file is found, a new one will be automatically
-- generated if Allow_Automatic_Generation is true. This configuration
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Extended_By : Project_Id;
- From_Encapsulated_Lib : Boolean);
+ From_Encapsulated_Lib : Boolean;
+ On_New_Tree_Loaded : Tree_Loaded_Callback := null);
-- Process project with node From_Project_Node in the tree. Do nothing if
-- From_Project_Node is Empty_Node. If project has already been processed,
-- simply return its project id. Otherwise create a new project id, mark it
--
-- From_Encapsulated_Lib is true if we are parsing a project from
-- encapsulated library dependencies.
+ --
+ -- If specified, On_New_Tree_Loaded is called after each aggregated project
+ -- has been processed succesfully.
function Get_Attribute_Index
(Tree : Project_Node_Tree_Ref;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
- Reset_Tree : Boolean := True)
+ Reset_Tree : Boolean := True;
+ On_New_Tree_Loaded : Tree_Loaded_Callback := null)
is
begin
Process_Project_Tree_Phase_1
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
Packages_To_Check => Packages_To_Check,
- Reset_Tree => Reset_Tree);
+ Reset_Tree => Reset_Tree,
+ On_New_Tree_Loaded => On_New_Tree_Loaded);
if Project_Qualifier_Of
(From_Project_Node, From_Project_Node_Tree) /= Configuration
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
- Reset_Tree : Boolean := True)
+ Reset_Tree : Boolean := True;
+ On_New_Tree_Loaded : Tree_Loaded_Callback := null)
is
begin
if Reset_Tree then
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
Extended_By => No_Project,
- From_Encapsulated_Lib => False);
+ From_Encapsulated_Lib => False,
+ On_New_Tree_Loaded => On_New_Tree_Loaded);
Success :=
Total_Errors_Detected = 0
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
Extended_By : Project_Id;
- From_Encapsulated_Lib : Boolean)
+ From_Encapsulated_Lib : Boolean;
+ On_New_Tree_Loaded : Tree_Loaded_Callback := null)
is
Shared : constant Shared_Project_Tree_Data_Access := In_Tree.Shared;
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
Extended_By => No_Project,
- From_Encapsulated_Lib => From_Encapsulated_Lib);
+ From_Encapsulated_Lib => From_Encapsulated_Lib,
+ On_New_Tree_Loaded => On_New_Tree_Loaded);
if Imported = null then
Project.Imported_Projects := new Project_List_Element'
From_Project_Node => Loaded_Project,
From_Project_Node_Tree => Node_Tree,
Env => Child_Env,
- Reset_Tree => False);
+ Reset_Tree => False,
+ On_New_Tree_Loaded => On_New_Tree_Loaded);
else
-- use the same environment as the rest of the aggregated
-- projects, ie the one that was setup by the root aggregate
From_Project_Node => Loaded_Project,
From_Project_Node_Tree => Node_Tree,
Env => Env,
- Reset_Tree => False);
+ Reset_Tree => False,
+ On_New_Tree_Loaded => On_New_Tree_Loaded);
+ end if;
+
+ if On_New_Tree_Loaded /= null then
+ On_New_Tree_Loaded
+ (Node_Tree, Tree, Loaded_Project, List.Project);
end if;
else
From_Project_Node_Tree => From_Project_Node_Tree,
Env => Env,
Extended_By => Project,
- From_Encapsulated_Lib => From_Encapsulated_Lib);
+ From_Encapsulated_Lib => From_Encapsulated_Lib,
+ On_New_Tree_Loaded => On_New_Tree_Loaded);
Process_Declarative_Items
(Project => Project,
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2013, 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- --
package Prj.Proc is
+ type Tree_Loaded_Callback is access procedure
+ (Node_Tree : Project_Node_Tree_Ref;
+ Tree : Project_Tree_Ref;
+ Project_Node : Project_Node_Id;
+ Project : Project_Id);
+ -- Callback used after the phase 1 of the processing of each aggregated
+ -- project to get access to project trees of aggregated projects.
+
procedure Process_Project_Tree_Phase_1
(In_Tree : Project_Tree_Ref;
Project : out Project_Id;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
- Reset_Tree : Boolean := True);
+ Reset_Tree : Boolean := True;
+ On_New_Tree_Loaded : Tree_Loaded_Callback := null);
-- Process a project tree (ie the direct resulting of parsing a .gpr file)
-- based on the current external references.
--
--
-- When Reset_Tree is True, all the project data are removed from the
-- project table before processing.
+ --
+ -- If specified, On_New_Tree_Loaded is called after each aggregated project
+ -- has been processed succesfully.
procedure Process_Project_Tree_Phase_2
(In_Tree : Project_Tree_Ref;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Env : in out Prj.Tree.Environment;
- Reset_Tree : Boolean := True);
+ Reset_Tree : Boolean := True;
+ On_New_Tree_Loaded : Tree_Loaded_Callback := null);
-- Performs the two phases of the processing
end Prj.Proc;
@itemize @bullet
+@item @b{Included_Patterns}: list
+
+If this attribute is defined it sets the patterns to
+synchronized from the master to the slaves. It is exclusive
+with Excluded_Patterns, that is it is an error to define
+both.
+
+@item @b{Included_Artifact_Patterns}: list
+
+If this attribute is defined it sets the patterns of compilation
+artifacts to synchronized from the slaves to the build master.
+This attribute replace the default hard-coded patterns.
+
@item @b{Excluded_Patterns}: list
Set of patterns to ignore when synchronizing sources from the build
-------------------------------
procedure Analyze_Package_Body_Stub (N : Node_Id) is
- Id : constant Entity_Id := Defining_Identifier (N);
- Nam : Entity_Id;
+ Id : constant Entity_Id := Defining_Identifier (N);
+ Nam : Entity_Id;
+ Opts : Config_Switches_Type;
begin
-- The package declaration must be in the current declarative part
Error_Msg_N ("duplicate or redundant stub for package", N);
else
+ -- Retain and restore the configuration options of the enclosing
+ -- context as the proper body may introduce a set of its own.
+
+ Save_Opt_Config_Switches (Opts);
+
-- Indicate that the body of the package exists. If we are doing
-- only semantic analysis, the stub stands for the body. If we are
-- generating code, the existence of the body will be confirmed
Set_Corresponding_Spec_Of_Stub (N, Nam);
Generate_Reference (Nam, Id, 'b');
Analyze_Proper_Body (N, Nam);
+
+ Restore_Opt_Config_Switches (Opts);
end if;
end Analyze_Package_Body_Stub;
procedure Analyze_Subprogram_Body_Stub (N : Node_Id) is
Decl : Node_Id;
+ Opts : Config_Switches_Type;
begin
Check_Stub_Level (N);
end loop;
end if;
+ -- Retain and restore the configuration options of the enclosing context
+ -- as the proper body may introduce a set of its own.
+
+ Save_Opt_Config_Switches (Opts);
+
-- Treat stub as a body, which checks conformance if there is a previous
-- declaration, or else introduces entity and its signature.
Analyze_Subprogram_Body (N);
Analyze_Proper_Body (N, Empty);
+
+ Restore_Opt_Config_Switches (Opts);
end Analyze_Subprogram_Body_Stub;
---------------------
Push_Scope (Spec_Id);
- -- Set SPARK_Mode from context
-
- Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma);
- Set_SPARK_Pragma_Inherited (Body_Id, True);
-
-- Make sure that the subprogram is immediately visible. For
-- child units that have no separate spec this is indispensable.
-- Otherwise it is safe albeit redundant.
Install_Formals (Body_Id);
Push_Scope (Body_Id);
-
- -- Set SPARK_Mode from context
-
- Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma);
- Set_SPARK_Pragma_Inherited (Body_Id, True);
end if;
-- For stubs and bodies with no previous spec, generate references to
Generate_Reference_To_Formals (Body_Id);
end if;
+ -- Set SPARK_Mode from context
+
+ Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma);
+ Set_SPARK_Pragma_Inherited (Body_Id, True);
+
-- If the return type is an anonymous access type whose designated type
-- is the limited view of a class-wide type and the non-limited view is
-- available, update the return type accordingly.
Name_Implementation : constant Name_Id := N + $;
Name_Implementation_Exceptions : constant Name_Id := N + $;
Name_Implementation_Suffix : constant Name_Id := N + $;
+ Name_Included_Artifact_Patterns : constant Name_Id := N + $;
+ Name_Included_Patterns : constant Name_Id := N + $;
Name_Include_Switches : constant Name_Id := N + $;
Name_Include_Path : constant Name_Id := N + $;
Name_Include_Path_File : constant Name_Id := N + $;
projects / thirdparty / gcc.git / commitdiff
