mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-04 23:01:19 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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.

From-SVN: r192928
This commit is contained in:
Arnaud Charlet 2012-10-29 12:00:17 +01:00
parent 0cc71b488a
commit 54f471f024
18 changed files with 356 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
gcc/ada/ChangeLog
View File

@ -1,3 +1,49 @@
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

91
gcc/ada/ali.adb
View File

@ -107,17 +107,18 @@ package body ALI is
-- 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;
--------------
@ -813,36 +814,37 @@ package body ALI is
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,
@ -1027,6 +1029,13 @@ package body ALI is
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

11
gcc/ada/ali.ads
View File

@ -156,6 +156,12 @@ package ALI is
-- 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
@ -485,6 +491,11 @@ package ALI is
-- 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.

58
gcc/ada/bcheck.adb
View File

@ -52,6 +52,7 @@ package body Bcheck is
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;
@ -83,6 +84,10 @@ package body Bcheck is
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;
@ -744,6 +749,59 @@ package body Bcheck is
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 --
-------------------------------------

9
gcc/ada/exp_ch3.adb
View File

@ -1537,7 +1537,8 @@ package body Exp_Ch3 is
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));
@ -1993,7 +1994,8 @@ package body Exp_Ch3 is
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;
@ -7806,7 +7808,8 @@ package body Exp_Ch3 is
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,

3
gcc/ada/exp_ch9.adb
View File

@ -911,7 +911,8 @@ package body Exp_Ch9 is
-- 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;

19
gcc/ada/gnat_rm.texi
View File

@ -1212,7 +1212,24 @@ pragma Assert_And_Cut (
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

5
gcc/ada/lib-writ.adb
View File

@ -1099,6 +1099,11 @@ package body Lib.Writ is
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;

4
gcc/ada/lib-writ.ads
View File

@ -196,6 +196,10 @@ package Lib.Writ is
-- 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).

12
gcc/ada/opt.ads
View File

@ -1085,6 +1085,18 @@ package Opt is
-- 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

1
gcc/ada/par-prag.adb
View File

@ -1202,6 +1202,7 @@ begin
Pragma_Optimize_Alignment |
Pragma_Overflow_Checks |
Pragma_Pack |
Pragma_Partition_Elaboration_Policy |
Pragma_Passive |
Pragma_Preelaborable_Initialization |
Pragma_Polling |

4
gcc/ada/s-tarest.ads
View File

@ -167,6 +167,10 @@ package System.Tasking.Restricted.Stages is
-- 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");

17
gcc/ada/sem_ch6.adb
View File

@ -11468,10 +11468,19 @@ package body Sem_Ch6 is
-- 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
@ -11797,7 +11806,7 @@ package body Sem_Ch6 is
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
@ -11806,7 +11815,7 @@ package body Sem_Ch6 is
Plist := Empty_List;
end if;
-- Special processing for function case
-- Special processing for function return
if Ekind (Designator) /= E_Procedure then
declare

68
gcc/ada/sem_prag.adb
View File

@ -505,6 +505,10 @@ package body Sem_Prag is
-- 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);
@ -1190,6 +1194,22 @@ package body Sem_Prag is
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 --
-------------------------
@ -12039,6 +12059,53 @@ package body Sem_Prag is
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 --
-------------
@ -15312,6 +15379,7 @@ package body Sem_Prag is
Pragma_Ordered => 0,
Pragma_Pack => 0,
Pragma_Page => -1,
Pragma_Partition_Elaboration_Policy => -1,
Pragma_Passive => -1,
Pragma_Preelaborable_Initialization => -1,
Pragma_Polling => -1,

11
gcc/ada/snames.adb-tmpl
View File

@ -419,6 +419,17 @@ package body Snames is
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 --
-----------------------------

18
gcc/ada/snames.ads-tmpl
View File

@ -409,6 +409,7 @@ package Snames is
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
@ -1015,6 +1016,17 @@ package Snames is
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
@ -1666,6 +1678,7 @@ package Snames is
Pragma_Normalize_Scalars,
Pragma_Optimize_Alignment,
Pragma_Overflow_Checks,
Pragma_Partition_Elaboration_Policy,
Pragma_Persistent_BSS,
Pragma_Polling,
Pragma_Priority_Specific_Dispatching,
@ -1902,6 +1915,10 @@ package Snames is
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
@ -1978,6 +1995,7 @@ private
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);

58
gcc/ada/xr_tabls.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -223,6 +223,7 @@ package body Xr_Tabls is
Line : Natural;
Column : Natural;
Decl_Type : Character;
Is_Parameter : Boolean := False;
Remove_Only : Boolean := False;
Symbol_Match : Boolean := True)
return Declaration_Reference
@ -235,7 +236,7 @@ package body Xr_Tabls is
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
@ -243,7 +244,7 @@ package body Xr_Tabls is
-- 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);
@ -269,7 +270,7 @@ package body Xr_Tabls is
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,
@ -294,6 +295,10 @@ package body Xr_Tabls is
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;
@ -392,6 +397,8 @@ package body Xr_Tabls is
Labels_As_Ref : Boolean)
is
New_Ref : Reference;
New_Decl : Declaration_Reference;
pragma Unreferenced (New_Decl);
begin
case Ref_Type is
@ -407,36 +414,21 @@ package body Xr_Tabls 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.
-- 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.
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;
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;

5
gcc/ada/xr_tabls.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -78,6 +78,7 @@ package Xr_Tabls is
Line : Natural;
Column : Natural;
Decl_Type : Character;
Is_Parameter : Boolean := False;
Remove_Only : Boolean := False;
Symbol_Match : Boolean := True)
return Declaration_Reference;
@ -89,6 +90,8 @@ package Xr_Tabls is
-- 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;