OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2013-04-24  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb (Process_Convention): Move Stdcall tests to
	Set_Convention_From_Pragma so that they are applied to each
	entry of a homonym set.
	(Process_Convention): Don't try to set convention if already set.

2013-04-24  Robert Dewar  <dewar@adacore.com>

	* gnatbind.adb: Minor reformatting.

2013-04-24  Vincent Celier  <celier@adacore.com>

	* clean.adb (Gnatclean): Add the default project search
	directories in the project search path after scanning the
	switches on the command line.
	(Initialize): Do not put the default project search directories in the
	project search path.
	* gnatcmd.adb (GNATcmd): Add the default project search
	directories in the project search path after scanning the switches
	on the command line.
	* make.adb (Initialize): Add the default project search
	directories in the project search path after scanning the switches
	on the command line.

2013-04-24  Yannick Moy  <moy@adacore.com>

	* restrict.ads (Restriction_Warnings): Initialize with all False value.

2013-04-24  Robert Dewar  <dewar@adacore.com>

	* checks.ads, checks.adb (Predicate_Checks_Suppressed): New function.
	* exp_util.ads, exp_util.adb (Make_Predicate_Check): Check setting of
	Predicate_Check.
	* snames.ads-tmpl (Name_Predicate_Check): New check name.
	* types.ads (Predicate_Check): New definition.
	* gnat_rm.texi: Add documentation for Predicate_Check.

From-SVN: r198226
This commit is contained in:
Arnaud Charlet 2013-04-24 15:13:04 +02:00
parent ced8450b58
commit f1c8097750
14 changed files with 199 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
gcc/ada/ChangeLog
View File

@ -1,3 +1,41 @@
2013-04-24 Robert Dewar <dewar@adacore.com>
* sem_prag.adb (Process_Convention): Move Stdcall tests to
Set_Convention_From_Pragma so that they are applied to each
entry of a homonym set.
(Process_Convention): Don't try to set convention if already set.
2013-04-24 Robert Dewar <dewar@adacore.com>
* gnatbind.adb: Minor reformatting.
2013-04-24 Vincent Celier <celier@adacore.com>
* clean.adb (Gnatclean): Add the default project search
directories in the project search path after scanning the
switches on the command line.
(Initialize): Do not put the default project search directories in the
project search path.
* gnatcmd.adb (GNATcmd): Add the default project search
directories in the project search path after scanning the switches
on the command line.
* make.adb (Initialize): Add the default project search
directories in the project search path after scanning the switches
on the command line.
2013-04-24 Yannick Moy <moy@adacore.com>
* restrict.ads (Restriction_Warnings): Initialize with all False value.
2013-04-24 Robert Dewar <dewar@adacore.com>
* checks.ads, checks.adb (Predicate_Checks_Suppressed): New function.
* exp_util.ads, exp_util.adb (Make_Predicate_Check): Check setting of
Predicate_Check.
* snames.ads-tmpl (Name_Predicate_Check): New check name.
* types.ads (Predicate_Check): New definition.
* gnat_rm.texi: Add documentation for Predicate_Check.
2013-04-24 Ed Schonberg <schonberg@adacore.com>
* exp_ch8.adb (Expand_N_Subprogram_Renaming_Declaration): If this

13
gcc/ada/checks.adb
View File

@ -7750,6 +7750,19 @@ package body Checks is
end if;
end Overflow_Checks_Suppressed;
---------------------------------
-- Predicate_Checks_Suppressed --
---------------------------------
function Predicate_Checks_Suppressed (E : Entity_Id) return Boolean is
begin
if Present (E) and then Checks_May_Be_Suppressed (E) then
return Is_Check_Suppressed (E, Predicate_Check);
else
return Scope_Suppress.Suppress (Predicate_Check);
end if;
end Predicate_Checks_Suppressed;
-----------------------------
-- Range_Checks_Suppressed --
-----------------------------

3
gcc/ada/checks.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
@ -56,6 +56,7 @@ package Checks is
function Index_Checks_Suppressed (E : Entity_Id) return Boolean;
function Length_Checks_Suppressed (E : Entity_Id) return Boolean;
function Overflow_Checks_Suppressed (E : Entity_Id) return Boolean;
function Predicate_Checks_Suppressed (E : Entity_Id) return Boolean;
function Range_Checks_Suppressed (E : Entity_Id) return Boolean;
function Storage_Checks_Suppressed (E : Entity_Id) return Boolean;
function Tag_Checks_Suppressed (E : Entity_Id) return Boolean;

10
gcc/ada/clean.adb
View File

@ -1377,6 +1377,13 @@ package body Clean is
Parse_Cmd_Line;
-- Add the default project search directories now, after the directories
-- that have been specified by switches -aP<dir>.
Prj.Env.Initialize_Default_Project_Path
(Root_Environment.Project_Path,
Target_Name => Sdefault.Target_Name.all);
if Verbose_Mode then
Display_Copyright;
end if;
@ -1550,9 +1557,6 @@ package body Clean is
Snames.Initialize;
Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
Prj.Env.Initialize_Default_Project_Path
(Root_Environment.Project_Path,
Target_Name => Sdefault.Target_Name.all);
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);

26
gcc/ada/exp_util.adb
View File

@ -46,7 +46,6 @@ with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch8; use Sem_Ch8;
with Sem_Eval; use Sem_Eval;
with Sem_Prag; use Sem_Prag;
with Sem_Res; use Sem_Res;
with Sem_Type; use Sem_Type;
with Sem_Util; use Sem_Util;
@ -5472,18 +5471,11 @@ package body Exp_Util is
begin
pragma Assert
(Has_Invariants (Typ) and then Present (Invariant_Procedure (Typ)));
if Check_Kind (Name_Invariant) = Name_Check then
return
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (Invariant_Procedure (Typ), Loc),
Parameter_Associations => New_List (Relocate_Node (Expr)));
else
return
Make_Null_Statement (Loc);
end if;
return
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (Invariant_Procedure (Typ), Loc),
Parameter_Associations => New_List (Relocate_Node (Expr)));
end Make_Invariant_Call;
------------------------
@ -5605,6 +5597,14 @@ package body Exp_Util is
Nam : Name_Id;
begin
-- If predicate checks are suppressed, then return a null statement.
-- For this call, we check only the scope setting. If the caller wants
-- to check a specific entity's setting, they must do it manually.
if Predicate_Checks_Suppressed (Empty) then
return Make_Null_Statement (Loc);
end if;
-- Compute proper name to use, we need to get this right so that the
-- right set of check policies apply to the Check pragma we are making.

5
gcc/ada/exp_util.ads
View File

@ -665,8 +665,9 @@ package Exp_Util is
(Typ : Entity_Id;
Expr : Node_Id) return Node_Id;
-- Typ is a type with Predicate_Function set. This routine builds a Check
-- pragma whose first argument is Predicate, and the second argument is a
-- call to the this predicate function with Expr as the argument.
-- pragma whose first argument is Predicate, and the second argument is
-- a call to the predicate function of Typ with Expr as the argument. If
-- Predicate_Check is suppressed then a null statement is returned instead.
function Make_Subtype_From_Expr
(E : Node_Id;

40
gcc/ada/gnat_rm.texi
View File

@ -5628,12 +5628,38 @@ pragma Suppress (Identifier [, [On =>] Name]);
@noindent
This is a standard pragma, and supports all the check names required in
the RM. It is included here because GNAT recognizes one additional check
name: @code{Alignment_Check} which can be used to suppress alignment checks
the RM. It is included here because GNAT recognizes some additional check
names that are implementation defined (as permitted by the RM):
@itemize @bullet
@item
@code{Alignment_Check} can be used to suppress alignment checks
on addresses used in address clauses. Such checks can also be suppressed
by suppressing range checks, but the specific use of @code{Alignment_Check}
allows suppression of alignment checks without suppressing other range checks.
@item
@code{Predicate_Check} can be used to control whether predicate checks are
active. It is applicable only to predicates for which the policy is
@code{Check}. Unlike @code{Assertion_Policy}, which determines if a given
predicate is ignored or checked for the whole program, the use of
@code{Suppress} and @code{Unsuppress} with this check name allows a given
predicate to be turned on and off at specific points in the program.
@item
@code{Validity_Check} can be used specifically to control validity checks.
If @code{Suppress} is used to suppress validity checks, then no validity
checks are performed, including those specified by the appropriate compiler
switch or the @code{Validity_Checks} pragma.
@item
Additional check names previously introduced by use of the @code{Check_Name}
pragma are also allowed.
@end itemize
@noindent
Note that pragma Suppress gives the compiler permission to omit
checks, but does not require the compiler to omit checks. The compiler
will generate checks if they are essentially free, even when they are
@ -6182,6 +6208,10 @@ checks.
This pragma is standard in Ada 2005. It is available in all earlier versions
of Ada as an implementation-defined pragma.
Note that in addition to the checks defined in the Ada RM, GNAT recogizes
a number of implementation-defined check names. See description of pragma
@code{Suppress} for full details.
@node Pragma Use_VADS_Size
@unnumberedsec Pragma Use_VADS_Size
@cindex @code{Size}, VADS compatibility
@ -10430,6 +10460,12 @@ The implementation defined check name Alignment_Check controls checking of
address clause values for proper alignment (that is, the address supplied
must be consistent with the alignment of the type).
The implementation defined check name Predicate_Check controls whether
predicate checks are generated.
The implementation defined check name Validity_Check controls whether
validity checks are generated.
In addition, a user program can add implementation-defined check names
by means of the pragma Check_Name.

10
gcc/ada/gnatbind.adb
View File

@ -494,13 +494,14 @@ procedure Gnatbind is
procedure Generic_Scan_Bind_Args is
Next_Arg : Positive := 1;
begin
-- Use low level argument routines to avoid dragging in the secondary
-- stack
-- Use low level argument routines to avoid dragging in secondary stack
while Next_Arg < Arg_Count loop
declare
Next_Argv : String (1 .. Len_Arg (Next_Arg));
begin
Fill_Arg (Next_Argv'Address, Next_Arg);
@ -531,6 +532,10 @@ procedure Gnatbind is
end loop;
end Generic_Scan_Bind_Args;
---------------
-- Write_Arg --
---------------
procedure Write_Arg (S : String) is
begin
Write_Str (" " & S);
@ -545,7 +550,6 @@ procedure Gnatbind is
-- Start of processing for Gnatbind
begin
-- Set default for Shared_Libgnat option
declare

10
gcc/ada/gnatcmd.adb
View File

@ -1395,9 +1395,6 @@ begin
Snames.Initialize;
Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags);
Prj.Env.Initialize_Default_Project_Path
(Root_Environment.Project_Path,
Target_Name => Sdefault.Target_Name.all);
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);
@ -1911,6 +1908,13 @@ begin
end Inspect_Switches;
end if;
-- Add the default project search directories now, after the directories
-- that have been specified by switches -aP<dir>.
Prj.Env.Initialize_Default_Project_Path
(Root_Environment.Project_Path,
Target_Name => Sdefault.Target_Name.all);
-- If there is a project file specified, parse it, get the switches
-- for the tool and setup PATH environment variables.

8
gcc/ada/make.adb
View File

@ -6392,8 +6392,6 @@ package body Make is
-- the command line switches
Prj.Tree.Initialize (Env, Gnatmake_Flags);
Prj.Env.Initialize_Default_Project_Path
(Env.Project_Path, Target_Name => Sdefault.Target_Name.all);
Project_Node_Tree := new Project_Node_Tree_Data;
Prj.Tree.Initialize (Project_Node_Tree);
@ -6492,6 +6490,12 @@ package body Make is
Usage;
end if;
-- Add the default project search directories now, after the directories
-- that have been specified by switches -aP<dir>.
Prj.Env.Initialize_Default_Project_Path
(Env.Project_Path, Target_Name => Sdefault.Target_Name.all);
-- Test for trailing -P switch
if Project_File_Name_Present and then Project_File_Name = null then

2
gcc/ada/restrict.ads
View File

@ -62,7 +62,7 @@ package Restrict is
-- since we want the binder to be able to accurately diagnose inter-unit
-- restriction violations.
Restriction_Warnings : Rident.Restriction_Flags;
Restriction_Warnings : Rident.Restriction_Flags := (others => False);
-- If one of these flags is set, then it means that violation of the
-- corresponding restriction results only in a warning message, not
-- in an error message, and the restriction is not otherwise enforced.

91
gcc/ada/sem_prag.adb
View File

@ -4928,6 +4928,51 @@ package body Sem_Prag is
& "operation", Arg1);
end if;
-- Special checks for Convention_Stdcall
if C = Convention_Stdcall then
-- A dispatching call is not allowed. A dispatching subprogram
-- cannot be used to interface to the Win32 API, so in fact
-- this check does not impose any effective restriction.
if Is_Dispatching_Operation (E) then
Error_Msg_Sloc := Sloc (E);
-- Note: make this unconditional so that if there is more
-- than one call to which the pragma applies, we get a
-- message for each call. Also don't use Error_Pragma,
-- so that we get multiple messages!
Error_Msg_N
("dispatching subprogram# cannot use Stdcall convention!",
Arg1);
-- Subprogram is allowed, but not a generic subprogram
elsif not Is_Subprogram (E)
and then not Is_Generic_Subprogram (E)
-- A variable is OK
and then Ekind (E) /= E_Variable
-- An access to subprogram is also allowed
and then not
(Is_Access_Type (E)
and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
-- Allow internal call to set convention of subprogram type
and then not (Ekind (E) = E_Subprogram_Type)
then
Error_Pragma_Arg
("second argument of pragma% must be subprogram (type)",
Arg2);
end if;
end if;
-- Set the convention
Set_Convention (E, C);
@ -5158,40 +5203,7 @@ package body Sem_Prag is
("second argument of pragma% must be a subprogram", Arg2);
end if;
-- Stdcall case
if C = Convention_Stdcall then
-- A dispatching call is not allowed. A dispatching subprogram
-- cannot be used to interface to the Win32 API, so in fact this
-- check does not impose any effective restriction.
if Is_Dispatching_Operation (E) then
Error_Pragma
("dispatching subprograms cannot use Stdcall convention");
-- Subprogram is allowed, but not a generic subprogram, and not a
-- dispatching operation.
elsif not Is_Subprogram (E)
and then not Is_Generic_Subprogram (E)
-- A variable is OK
and then Ekind (E) /= E_Variable
-- An access to subprogram is also allowed
and then not
(Is_Access_Type (E)
and then Ekind (Designated_Type (E)) = E_Subprogram_Type)
then
Error_Pragma_Arg
("second argument of pragma% must be subprogram (type)",
Arg2);
end if;
end if;
-- Deal with non-subprogram cases
if not Is_Subprogram (E)
and then not Is_Generic_Subprogram (E)
@ -5202,7 +5214,7 @@ package body Sem_Prag is
Check_First_Subtype (Arg2);
Set_Convention_From_Pragma (Base_Type (E));
-- For subprograms, we must set the convention on the
-- For access subprograms, we must set the convention on the
-- internally generated directly designated type as well.
if Ekind (E) = E_Access_Subprogram_Type then
@ -5251,6 +5263,12 @@ package body Sem_Prag is
E1 := Homonym (E1);
exit when No (E1) or else Scope (E1) /= Current_Scope;
-- Ignore entry for which convention is already set
if Has_Convention_Pragma (E1) then
goto Continue;
end if;
-- Do not set the pragma on inherited operations or on formal
-- subprograms.
@ -5274,6 +5292,9 @@ package body Sem_Prag is
Generate_Reference (E1, Id, 'b');
end if;
end if;
<<Continue>>
null;
end loop;
end if;
end Process_Convention;

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

@ -1082,6 +1082,7 @@ package Snames is
Name_Index_Check : constant Name_Id := N + $;
Name_Length_Check : constant Name_Id := N + $;
Name_Overflow_Check : constant Name_Id := N + $;
Name_Predicate_Check : constant Name_Id := N + $; -- GNAT
Name_Range_Check : constant Name_Id := N + $;
Name_Storage_Check : constant Name_Id := N + $;
Name_Tag_Check : constant Name_Id := N + $;

13
gcc/ada/types.ads
View File

@ -666,15 +666,16 @@ package Types is
Index_Check : constant := 8;
Length_Check : constant := 9;
Overflow_Check : constant := 10;
Range_Check : constant := 11;
Storage_Check : constant := 12;
Tag_Check : constant := 13;
Validity_Check : constant := 14;
Predicate_Check : constant := 11;
Range_Check : constant := 12;
Storage_Check : constant := 13;
Tag_Check : constant := 14;
Validity_Check : constant := 15;
-- Values used to represent individual predefined checks (including the
-- setting of Atomic_Synchronization, which is implemented internally using
-- a "check" whose name is Atomic_Synchronization.
-- a "check" whose name is Atomic_Synchronization).
All_Checks : constant := 15;
All_Checks : constant := 16;
-- Value used to represent All_Checks value
subtype Predefined_Check_Id is Check_Id range 1 .. All_Checks;