+2012-10-29 Tristan Gingold <gingold@adacore.com>
+
+ * exp_ch9.adb, s-tarest.ads, exp_ch3.adb: Update comments.
+
+2012-10-29 Yannick Moy <moy@adacore.com>
+
+ * gnat_rm.texi: Minor documentation addition.
+
+2012-10-29 Emmanuel Briot <briot@adacore.com>
+
+ * xr_tabls.adb, xr_tabls.ads (Add_Declaration, Add_Reference): No
+ longer assume that a parameter declaration is seen after the subprogram
+ that uses it.
+
+2012-10-29 Tristan Gingold <gingold@adacore.com>
+
+ * lib-writ.adb (Write_ALI): Emit partition elaboration policy
+ in P line.
+ * lib-writ.ads: Document partition elaboration policy indication.
+ * sem_prag.adb (Check_Arg_Is_Partition_Elaboration_Policy): New
+ procedure.
+ (Analyze_Pragma): Handle Partition_Elaboration_Policy.
+ (Sig_Flags): Add flag for Pragma_Partition_Elaboration_Policy
+ * ali.adb (Initialize_ALI): Init Partition_Elaboration_Policy_Specified.
+ (Scan_ALI): Read Ex indications.
+ * ali.ads: ALIs_Record: Add Partition_Elaboration_Policy.
+ * par-prag.adb (Prag): Add Partition_Elaboration_Policy.
+ * snames.adb-tmpl (Is_Partition_Elaboration_Policy_Name): New function.
+ * opt.ads (Partition_Elaboration_Policy): Declare.
+ (Partition_Elaboration_Policy_Sloc): Declare.
+ * bcheck.adb (Check_Consistent_Partition_Elaboration_Policy):
+ New procedure. (Check_Configuration_Consistency): Check partition
+ elaboration policy consistency.
+ * snames.ads-tmpl (Name_Partition_Elaboration_Policy): New name.
+ (First_Partition_Elaboration_Policy_Name, Name_Concurrent,
+ Name_Sequential, Last_Partition_Elaboration_Policy_Name): Likewise.
+ (Pragma_Partition_Elaboration_Policy): New literal.
+ (Is_Partition_Elaboration_Policy_Name): New function.
+
+2012-10-29 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch6.adb (Is_Public_Subprogram_For): Handle properly
+ expression functions, which are rewritten as subprogram
+ declarations, when generating invariants for its return value
+ and in-out parameters.
+
2012-10-29 Arnaud Charlet <charlet@adacore.com>
* warnsw.adb (Set_GNAT_Mode_Warnings): Unset
-- Initialize global variables recording cumulative options in all
-- ALI files that are read for a given processing run in gnatbind.
- Dynamic_Elaboration_Checks_Specified := False;
- Float_Format_Specified := ' ';
- Locking_Policy_Specified := ' ';
- No_Normalize_Scalars_Specified := False;
- No_Object_Specified := False;
- Normalize_Scalars_Specified := False;
- Queuing_Policy_Specified := ' ';
- Static_Elaboration_Model_Used := False;
- Task_Dispatching_Policy_Specified := ' ';
- Unreserve_All_Interrupts_Specified := False;
- Zero_Cost_Exceptions_Specified := False;
+ Dynamic_Elaboration_Checks_Specified := False;
+ Float_Format_Specified := ' ';
+ Locking_Policy_Specified := ' ';
+ No_Normalize_Scalars_Specified := False;
+ No_Object_Specified := False;
+ Normalize_Scalars_Specified := False;
+ Partition_Elaboration_Policy_Specified := ' ';
+ Queuing_Policy_Specified := ' ';
+ Static_Elaboration_Model_Used := False;
+ Task_Dispatching_Policy_Specified := ' ';
+ Unreserve_All_Interrupts_Specified := False;
+ Zero_Cost_Exceptions_Specified := False;
end Initialize_ALI;
--------------
Set_Name_Table_Info (F, Int (Id));
ALIs.Table (Id) := (
- Afile => F,
- Compile_Errors => False,
- First_Interrupt_State => Interrupt_States.Last + 1,
- First_Sdep => No_Sdep_Id,
- First_Specific_Dispatching => Specific_Dispatching.Last + 1,
- First_Unit => No_Unit_Id,
- Float_Format => 'I',
- Last_Interrupt_State => Interrupt_States.Last,
- Last_Sdep => No_Sdep_Id,
- Last_Specific_Dispatching => Specific_Dispatching.Last,
- Last_Unit => No_Unit_Id,
- Locking_Policy => ' ',
- Main_Priority => -1,
- Main_CPU => -1,
- Main_Program => None,
- No_Object => False,
- Normalize_Scalars => False,
- Ofile_Full_Name => Full_Object_File_Name,
- Queuing_Policy => ' ',
- Restrictions => No_Restrictions,
- SAL_Interface => False,
- Sfile => No_File,
- Task_Dispatching_Policy => ' ',
- Time_Slice_Value => -1,
- Allocator_In_Body => False,
- WC_Encoding => 'b',
- Unit_Exception_Table => False,
- Ver => (others => ' '),
- Ver_Len => 0,
- Zero_Cost_Exceptions => False);
+ Afile => F,
+ Compile_Errors => False,
+ First_Interrupt_State => Interrupt_States.Last + 1,
+ First_Sdep => No_Sdep_Id,
+ First_Specific_Dispatching => Specific_Dispatching.Last + 1,
+ First_Unit => No_Unit_Id,
+ Float_Format => 'I',
+ Last_Interrupt_State => Interrupt_States.Last,
+ Last_Sdep => No_Sdep_Id,
+ Last_Specific_Dispatching => Specific_Dispatching.Last,
+ Last_Unit => No_Unit_Id,
+ Locking_Policy => ' ',
+ Main_Priority => -1,
+ Main_CPU => -1,
+ Main_Program => None,
+ No_Object => False,
+ Normalize_Scalars => False,
+ Ofile_Full_Name => Full_Object_File_Name,
+ Partition_Elaboration_Policy => ' ',
+ Queuing_Policy => ' ',
+ Restrictions => No_Restrictions,
+ SAL_Interface => False,
+ Sfile => No_File,
+ Task_Dispatching_Policy => ' ',
+ Time_Slice_Value => -1,
+ Allocator_In_Body => False,
+ WC_Encoding => 'b',
+ Unit_Exception_Table => False,
+ Ver => (others => ' '),
+ Ver_Len => 0,
+ Zero_Cost_Exceptions => False);
-- Now we acquire the input lines from the ALI file. Note that the
-- convention in the following code is that as we enter each section,
Checkc ('B');
Detect_Blocking := True;
+ -- Processing for Ex
+
+ elsif C = 'E' then
+ Partition_Elaboration_Policy_Specified := Getc;
+ ALIs.Table (Id).Partition_Elaboration_Policy :=
+ Partition_Elaboration_Policy_Specified;
+
-- Processing for FD/FG/FI
elsif C = 'F' then
-- this is a language defined unit. Otherwise set to first character
-- (upper case) of policy name. Not set if 'P' appears in Ignore_Lines.
+ Partition_Elaboration_Policy : Character;
+ -- Indicates partition elaboration policy for units in this file. Space
+ -- means that no Partition_Elaboration_Policy pragma was present or that
+ -- this is a language defined unit. Otherwise set to first character
+ -- (upper case) of policy name. Not set if 'P' appears in Ignore_Lines.
+
Queuing_Policy : Character;
-- Indicates queuing policy for units in this file. Space means tasking
-- was not used, or that no Queuing_Policy pragma was present or that
-- Set to False by Initialize_ALI. Set to True if an ali file indicates
-- that the file was compiled in Normalize_Scalars mode.
+ Partition_Elaboration_Policy_Specified : Character := ' ';
+ -- Set to blank by Initialize_ALI. Set to the appropriate partition
+ -- elaboration policy character if an ali file contains a P line setting
+ -- the policy.
+
Queuing_Policy_Specified : Character := ' ';
-- Set to blank by Initialize_ALI. Set to the appropriate queuing policy
-- character if an ali file contains a P line setting the queuing policy.
procedure Check_Consistent_Locking_Policy;
procedure Check_Consistent_Normalize_Scalars;
procedure Check_Consistent_Optimize_Alignment;
+ procedure Check_Consistent_Partition_Elaboration_Policy;
procedure Check_Consistent_Queuing_Policy;
procedure Check_Consistent_Restrictions;
procedure Check_Consistent_Restriction_No_Default_Initialization;
Check_Consistent_Locking_Policy;
end if;
+ if Partition_Elaboration_Policy_Specified /= ' ' then
+ Check_Consistent_Partition_Elaboration_Policy;
+ end if;
+
if Zero_Cost_Exceptions_Specified then
Check_Consistent_Zero_Cost_Exception_Handling;
end if;
end loop;
end Check_Consistent_Optimize_Alignment;
+ ---------------------------------------------------
+ -- Check_Consistent_Partition_Elaboration_Policy --
+ ---------------------------------------------------
+
+ -- The rule is that all files for which the partition elaboration policy is
+ -- significant must be compiled with the same setting.
+
+ procedure Check_Consistent_Partition_Elaboration_Policy is
+ begin
+ -- First search for a unit specifying a policy and then
+ -- check all remaining units against it.
+
+ Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
+ if ALIs.Table (A1).Partition_Elaboration_Policy /= ' ' then
+ Check_Policy : declare
+ Policy : constant Character :=
+ ALIs.Table (A1).Partition_Elaboration_Policy;
+
+ begin
+ for A2 in A1 + 1 .. ALIs.Last loop
+ if ALIs.Table (A2).Partition_Elaboration_Policy /= ' '
+ and then
+ ALIs.Table (A2).Partition_Elaboration_Policy /= Policy
+ then
+ Error_Msg_File_1 := ALIs.Table (A1).Sfile;
+ Error_Msg_File_2 := ALIs.Table (A2).Sfile;
+
+ Consistency_Error_Msg
+ ("{ and { compiled with different partition "
+ & "elaboration policies");
+ exit Find_Policy;
+ end if;
+ end loop;
+ end Check_Policy;
+
+ -- A No_Task_Hierarchy restriction must be specified for the
+ -- Sequential policy (RM H.6(6/2)).
+
+ if Partition_Elaboration_Policy_Specified = 'S'
+ and then not Cumulative_Restrictions.Set (No_Task_Hierarchy)
+ then
+ Error_Msg_File_1 := ALIs.Table (A1).Sfile;
+ Error_Msg
+ ("{ has sequential partition elaboration policy, but no");
+ Error_Msg
+ ("pragma Restrictions (No_Task_Hierarchy) was specified");
+ end if;
+
+ exit Find_Policy;
+ end if;
+ end loop Find_Policy;
+ end Check_Consistent_Partition_Elaboration_Policy;
+
-------------------------------------
-- Check_Consistent_Queuing_Policy --
-------------------------------------
Append_To (Args, Make_Identifier (Loc, Name_uMaster));
end if;
- -- Add _Chain (not done in the restricted profile because ???)
+ -- Add _Chain (not done in the restricted profile because not used,
+ -- see comment of Create_Restricted_Task in s-tarest.ads).
if not Restricted_Profile then
Append_To (Args, Make_Identifier (Loc, Name_uChain));
if not Restricted_Profile then
- -- No _Chain for restricted profile
+ -- No _Chain for the restricted profile because not used,
+ -- see comment of Create_Restricted_Task in s-tarest.ads.
Append_To (Args, Make_Identifier (Loc, Name_uChain));
end if;
if not Restricted_Profile then
- -- No _Chain for restricted profile
+ -- No _Chain for the restricted profile because not used, see
+ -- comment of Create_Restricted_Task in s-tarest.ads.
Append_To (Formals,
Make_Parameter_Specification (Loc,
-- Start of processing for Build_Activation_Chain_Entity
begin
- -- Activation chain is never used in restricted profile (why not???)
+ -- Activation chain is never used in restricted profile, see comment
+ -- of Create_Restricted_Task in s-tarest.ads.
if Restricted_Profile then
return;
The effect of this pragma for compilation is exactly the same as the one
of pragma @code{Assert}. This pragma is used to help formal verification
tools by marking program points where the tool can simplify precise
-knowledge about execution based on the assertion given.
+knowledge about execution based on the assertion given. For example, in
+the procedure below, all that is needed to prove that the code using X
+is free from run-time errors is that X is positive. Without the pragma,
+GNATprove considers all execution paths through P, which may be
+many. With the pragma, GNATprove only needs to consider the paths from
+the start of the procedure to the pragma, and the paths from the pragma
+to the end of the procedure, hence many fewer paths. For more details,
+see the GNATprove User's Guide.
+
+@smallexample @c ada
+procedure P is
+ X : Integer;
+begin
+ -- complex computation that sets X
+ pragma Assert_And_Cut (X > 0);
+ -- complex computation that uses X
+end P;
+@end smallexample
@node Pragma Assertion_Policy
@unnumberedsec Pragma Assertion_Policy
end if;
end if;
+ if Partition_Elaboration_Policy /= ' ' then
+ Write_Info_Str (" E");
+ Write_Info_Char (Partition_Elaboration_Policy);
+ end if;
+
if not Object then
Write_Info_Str (" NO");
end if;
-- DB Detect_Blocking pragma is in effect for all units in this
-- file.
--
+ -- Ex A valid Partition_Elaboration_Policy pragma applies to all
+ -- the units in this file, where x is the first character
+ -- (upper case) of the policy name (e.g. 'C' for Concurrent).
+ --
-- FD Configuration pragmas apply to all the units in this file
-- specifying a possibly non-standard floating point format
-- (VAX float with Long_Float using D_Float).
-- True if output of list of objects is requested (-O switch set). List is
-- output under the given filename, or standard output if not specified.
+ Partition_Elaboration_Policy : Character := ' ';
+ -- GNAT, GNATBIND
+ -- Set to ' ' for the default case (no elaboration policy specified). Reset
+ -- to first character (uppercase) of locking policy name if a valid pragma
+ -- Partition_Elaboration_Policy is encountered.
+
+ Partition_Elaboration_Policy_Sloc : Source_Ptr := No_Location;
+ -- GNAT, GNATBIND
+ -- Remember location of previous Partition_Elaboration_Policy pragma. This
+ -- is used for inconsistency error messages. A value of System_Location is
+ -- used if the policy is set in package System.
+
Persistent_BSS_Mode : Boolean := False;
-- GNAT
-- True if a Persistent_BSS configuration pragma is in effect, causing
Pragma_Optimize_Alignment |
Pragma_Overflow_Checks |
Pragma_Pack |
+ Pragma_Partition_Elaboration_Policy |
Pragma_Passive |
Pragma_Preelaborable_Initialization |
Pragma_Polling |
-- Created_Task is the resulting task.
--
-- This procedure can raise Storage_Error if the task creation fails
+ --
+ -- Contrary to Create_Task, there is no Chain parameter (for the activation
+ -- chain), as there is only one global activation chain, which is declared
+ -- in the body of this package.
procedure Activate_Tasks;
pragma Export (C, Activate_Tasks, "__gnat_activate_tasks");
-- public subprogram, since we do get initializations to deal with.
-- Other internally generated subprograms are not public.
- if not Is_List_Member (DD) and then Is_Init_Proc (DD) then
+ if not Is_List_Member (DD)
+ and then Is_Init_Proc (Defining_Entity (DD))
+ then
return True;
- elsif not Comes_From_Source (DD) then
+ -- The declaration may have been generated for an expression function
+ -- so check whether that function comes from source.
+
+ elsif not Comes_From_Source (DD)
+ and then
+ (Nkind (Original_Node (DD)) /= N_Expression_Function
+ or else not Comes_From_Source (Defining_Entity (DD)))
+ then
return False;
-- Otherwise we test whether the subprogram is declared in the
end if;
-- If we had any postconditions and expansion is enabled, or if the
- -- procedure has invariants, then build the _Postconditions procedure.
+ -- subprogram has invariants, then build the _Postconditions procedure.
if (Present (Plist) or else Invariants_Or_Predicates_Present)
and then Expander_Active
Plist := Empty_List;
end if;
- -- Special processing for function case
+ -- Special processing for function return
if Ekind (Designator) /= E_Procedure then
declare
-- Check the specified argument Arg to make sure that it is a valid
-- locking policy name. If not give error and raise Pragma_Exit.
+ procedure Check_Arg_Is_Partition_Elaboration_Policy (Arg : Node_Id);
+ -- Check the specified argument Arg to make sure that it is a valid
+ -- elaboration policy name. If not give error and raise Pragma_Exit.
+
procedure Check_Arg_Is_One_Of
(Arg : Node_Id;
N1, N2 : Name_Id);
end if;
end Check_Arg_Is_Locking_Policy;
+ -----------------------------------------------
+ -- Check_Arg_Is_Partition_Elaboration_Policy --
+ -----------------------------------------------
+
+ procedure Check_Arg_Is_Partition_Elaboration_Policy (Arg : Node_Id) is
+ Argx : constant Node_Id := Get_Pragma_Arg (Arg);
+
+ begin
+ Check_Arg_Is_Identifier (Argx);
+
+ if not Is_Partition_Elaboration_Policy_Name (Chars (Argx)) then
+ Error_Pragma_Arg
+ ("& is not a valid partition elaboration policy name", Argx);
+ end if;
+ end Check_Arg_Is_Partition_Elaboration_Policy;
+
-------------------------
-- Check_Arg_Is_One_Of --
-------------------------
when Pragma_Page =>
null;
+ ----------------------------------
+ -- Partition_Elaboration_Policy --
+ ----------------------------------
+
+ -- pragma Partition_Elaboration_Policy (policy_IDENTIFIER);
+
+ when Pragma_Partition_Elaboration_Policy => declare
+ subtype PEP_Range is Name_Id
+ range First_Partition_Elaboration_Policy_Name
+ .. Last_Partition_Elaboration_Policy_Name;
+ PEP_Val : PEP_Range;
+ PEP : Character;
+
+ begin
+ Ada_2005_Pragma;
+ Check_Arg_Count (1);
+ Check_No_Identifiers;
+ Check_Arg_Is_Partition_Elaboration_Policy (Arg1);
+ Check_Valid_Configuration_Pragma;
+ PEP_Val := Chars (Get_Pragma_Arg (Arg1));
+
+ case PEP_Val is
+ when Name_Concurrent =>
+ PEP := 'C';
+ when Name_Sequential =>
+ PEP := 'S';
+ end case;
+
+ if Partition_Elaboration_Policy /= ' '
+ and then Partition_Elaboration_Policy /= PEP
+ then
+ Error_Msg_Sloc := Partition_Elaboration_Policy_Sloc;
+ Error_Pragma
+ ("partition elaboration policy incompatible with policy#");
+
+ -- Set new policy, but always preserve System_Location since we
+ -- like the error message with the run time name.
+
+ else
+ Partition_Elaboration_Policy := PEP;
+
+ if Partition_Elaboration_Policy_Sloc /= System_Location then
+ Partition_Elaboration_Policy_Sloc := Loc;
+ end if;
+ end if;
+ end;
+
-------------
-- Passive --
-------------
Pragma_Ordered => 0,
Pragma_Pack => 0,
Pragma_Page => -1,
+ Pragma_Partition_Elaboration_Policy => -1,
Pragma_Passive => -1,
Pragma_Preelaborable_Initialization => -1,
Pragma_Polling => -1,
return N in First_Locking_Policy_Name .. Last_Locking_Policy_Name;
end Is_Locking_Policy_Name;
+ -------------------------------------
+ -- Is_Partition_Elaboration_Policy --
+ -------------------------------------
+
+ function Is_Partition_Elaboration_Policy_Name (N : Name_Id)
+ return Boolean is
+ begin
+ return N in First_Partition_Elaboration_Policy_Name
+ .. Last_Partition_Elaboration_Policy_Name;
+ end Is_Partition_Elaboration_Policy_Name;
+
-----------------------------
-- Is_Operator_Symbol_Name --
-----------------------------
Name_Normalize_Scalars : constant Name_Id := N + $;
Name_Optimize_Alignment : constant Name_Id := N + $; -- GNAT
Name_Overflow_Checks : constant Name_Id := N + $; -- GNAT
+ Name_Partition_Elaboration_Policy : constant Name_Id := N + $; -- Ada 05
Name_Persistent_BSS : constant Name_Id := N + $; -- GNAT
Name_Polling : constant Name_Id := N + $; -- GNAT
Name_Priority_Specific_Dispatching : constant Name_Id := N + $; -- Ada 05
Name_Round_Robin_Within_Priorities : constant Name_Id := N + $;
Last_Task_Dispatching_Policy_Name : constant Name_Id := N + $;
+ -- Names of recognized partition elaboration policy identifiers
+
+ -- Note: policies are identified by the first character of the name (e.g. S
+ -- for Sequential). If new policy names are added, the first character must
+ -- be distinct.
+
+ First_Partition_Elaboration_Policy_Name : constant Name_Id := N + $;
+ Name_Concurrent : constant Name_Id := N + $;
+ Name_Sequential : constant Name_Id := N + $;
+ Last_Partition_Elaboration_Policy_Name : constant Name_Id := N + $;
+
-- Names of recognized checks for pragma Suppress
-- Note: the name Atomic_Synchronization can only be specified internally
Pragma_Normalize_Scalars,
Pragma_Optimize_Alignment,
Pragma_Overflow_Checks,
+ Pragma_Partition_Elaboration_Policy,
Pragma_Persistent_BSS,
Pragma_Polling,
Pragma_Priority_Specific_Dispatching,
function Is_Locking_Policy_Name (N : Name_Id) return Boolean;
-- Test to see if the name N is the name of a recognized locking policy
+ function Is_Partition_Elaboration_Policy_Name (N : Name_Id) return Boolean;
+ -- Test to see if the name N is the name of a recognized partition
+ -- elaboration policy.
+
function Is_Operator_Symbol_Name (N : Name_Id) return Boolean;
-- Test to see if the name N is the name of an operator symbol
pragma Inline (Is_Entity_Attribute_Name);
pragma Inline (Is_Type_Attribute_Name);
pragma Inline (Is_Locking_Policy_Name);
+ pragma Inline (Is_Partition_Elaboration_Policy_Name);
pragma Inline (Is_Operator_Symbol_Name);
pragma Inline (Is_Queuing_Policy_Name);
pragma Inline (Is_Pragma_Name);
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2012, 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- --
Line : Natural;
Column : Natural;
Decl_Type : Character;
+ Is_Parameter : Boolean := False;
Remove_Only : Boolean := False;
Symbol_Match : Boolean := True)
return Declaration_Reference
New_Decl : Declaration_Reference :=
Entities_HTable.Get (Key'Unchecked_Access);
- Is_Parameter : Boolean := False;
+ Is_Param : Boolean := Is_Parameter;
begin
-- Insert the Declaration in the table. There might already be a
-- need to check that first.
if New_Decl /= null and then New_Decl.Symbol_Length = 0 then
- Is_Parameter := New_Decl.Is_Parameter;
+ Is_Param := Is_Parameter or else New_Decl.Is_Parameter;
Entities_HTable.Remove (Key'Unrestricted_Access);
Entities_Count := Entities_Count - 1;
Free (New_Decl.Key);
Column => Column,
Source_Line => null,
Next => null),
- Is_Parameter => Is_Parameter,
+ Is_Parameter => Is_Param,
Decl_Type => Decl_Type,
Body_Ref => null,
Ref_Ref => null,
then
New_Decl.Match := Default_Match
or else Match (File_Ref, Line, Column);
+ New_Decl.Is_Parameter := New_Decl.Is_Parameter or else Is_Param;
+
+ elsif New_Decl /= null then
+ New_Decl.Is_Parameter := New_Decl.Is_Parameter or else Is_Param;
end if;
return New_Decl;
Labels_As_Ref : Boolean)
is
New_Ref : Reference;
+ New_Decl : Declaration_Reference;
+ pragma Unreferenced (New_Decl);
begin
case Ref_Type is
when '=' | '<' | '>' | '^' =>
-- Create a dummy declaration in the table to report it as a
- -- parameter. Note that the current declaration for the subprogram
- -- comes before the declaration of the parameter.
-
- declare
- Key : constant String :=
- Key_From_Ref (File_Ref, Line, Column);
- New_Decl : Declaration_Reference;
-
- begin
- New_Decl := new Declaration_Record'
- (Symbol_Length => 0,
- Symbol => "",
- Key => new String'(Key),
- Decl => new Reference_Record'
- (File => File_Ref,
- Line => Line,
- Column => Column,
- Source_Line => null,
- Next => null),
- Is_Parameter => True,
- Decl_Type => ' ',
- Body_Ref => null,
- Ref_Ref => null,
- Modif_Ref => null,
- Match => False,
- Par_Symbol => null,
- Next => null);
- Entities_HTable.Set (New_Decl);
- Entities_Count := Entities_Count + 1;
- end;
+ -- parameter.
+ -- In a given ALI file, the declaration of the subprogram comes
+ -- before the declaration of the parameter. However, it is
+ -- possible that another ALI file has been parsed that also
+ -- references the parameter (for instance a named parameter in a
+ -- call), so we need to check whether there already exists a
+ -- declaration for the parameter.
+
+ New_Decl := Add_Declaration
+ (File_Ref => File_Ref,
+ Symbol => "",
+ Line => Line,
+ Column => Column,
+ Decl_Type => ' ',
+ Is_Parameter => True);
when 'e' | 'z' | 't' | 'p' | 'P' | 'k' | 'd' =>
return;
-- --
-- S p e c --
-- --
--- Copyright (C) 1998-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2012, 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- --
Line : Natural;
Column : Natural;
Decl_Type : Character;
+ Is_Parameter : Boolean := False;
Remove_Only : Boolean := False;
Symbol_Match : Boolean := True)
return Declaration_Reference;
-- the command line. In that case, the entity will not be output by
-- gnatfind. If Symbol_Match is True, the entity will only be output if the
-- file name itself matches.
+ -- Is_Parameter should be set to True if the entity is known to be a
+ -- subprogram parameter.
procedure Add_Parent
(Declaration : in out Declaration_Reference;