git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

2014-06-13  Eric Botcazou  <ebotcazou@adacore.com>

	* checks.adb (Apply_Address_Clause_Check): Only issue the new
	warning if the propagation warning is issued.

2014-06-13  Thomas Quinot  <quinot@adacore.com>

	* exp_ch4.adb: Minor reformatting.

2014-06-13  Robert Dewar  <dewar@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference, case Pred):
	Handle float range check case (Expand_N_Attribute_Reference,
	case Succ): Handle float range check case.
	* sem_attr.adb (Analyze_Attribute, case Pred/Succ): Handle float
	range check case.

2014-06-13  Vincent Celier  <celier@adacore.com>

	* makeutl.ads (Compute_Builder_Switches): Change name of
	parameter Root_Environment to Env.
	* prj-conf.adb (Check_Switches): Call Locate_Runtime with the
	Env parameter of procedure Get_Or_Create_Configuration_File.
	(Locate_Runtime): Call Find_Rts_In_Path with the Project_Path
	of new parameter Env.
	* prj-conf.ads (Locate_Runtime): New parameter Env of type
	Prj.Tree.Environment.

2014-06-13  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Minor comment clarification for Check_Float_Overflow.

From-SVN: r211623
This commit is contained in:
Arnaud Charlet 2014-06-13 12:18:11 +02:00
parent 890f1954ed
commit 0083dd6691
11 changed files with 124 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
gcc/ada/ChangeLog
View File

@ -1,3 +1,35 @@
2014-06-13 Eric Botcazou <ebotcazou@adacore.com>
* checks.adb (Apply_Address_Clause_Check): Only issue the new
warning if the propagation warning is issued.
2014-06-13 Thomas Quinot <quinot@adacore.com>
* exp_ch4.adb: Minor reformatting.
2014-06-13 Robert Dewar <dewar@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference, case Pred):
Handle float range check case (Expand_N_Attribute_Reference,
case Succ): Handle float range check case.
* sem_attr.adb (Analyze_Attribute, case Pred/Succ): Handle float
range check case.
2014-06-13 Vincent Celier <celier@adacore.com>
* makeutl.ads (Compute_Builder_Switches): Change name of
parameter Root_Environment to Env.
* prj-conf.adb (Check_Switches): Call Locate_Runtime with the
Env parameter of procedure Get_Or_Create_Configuration_File.
(Locate_Runtime): Call Find_Rts_In_Path with the Project_Path
of new parameter Env.
* prj-conf.ads (Locate_Runtime): New parameter Env of type
Prj.Tree.Environment.
2014-06-13 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Minor comment clarification for Check_Float_Overflow.
2014-06-13 Robert Dewar <dewar@adacore.com>
* exp_attr.adb, exp_ch9.adb, lib-writ.adb, g-comlin.adb: Minor

1
gcc/ada/checks.adb
View File

@ -767,6 +767,7 @@ package body Checks is
if Nkind (First (Actions (N))) = N_Raise_Program_Error
and then not Warnings_Off (E)
and then Warn_On_Non_Local_Exception
and then Restriction_Active (No_Exception_Propagation)
then
Error_Msg_N

59
gcc/ada/exp_attr.adb
View File

@ -4440,7 +4440,8 @@ package body Exp_Attr is
----------
-- 1. Deal with enumeration types with holes
-- 2. For floating-point, generate call to attribute function
-- 2. For floating-point, generate call to attribute function and deal
-- with range checking if Check_Float_Overflow modde.
-- 3. For other cases, deal with constraint checking
when Attribute_Pred => Pred :
@ -4512,9 +4513,36 @@ package body Exp_Attr is
Analyze_And_Resolve (N, Typ);
-- For floating-point, we transform 'Pred into a call to the Pred
-- floating-point attribute function in Fat_xxx (xxx is root type)
-- floating-point attribute function in Fat_xxx (xxx is root type).
elsif Is_Floating_Point_Type (Ptyp) then
-- Handle case of range check. The Do_Range_Check flag is set only
-- in Check_Float_Overflow mode, and what we need is a specific
-- check against typ'First, since that is the only overflow case.
declare
Expr : constant Node_Id := First (Exprs);
begin
if Do_Range_Check (Expr) then
Set_Do_Range_Check (Expr, False);
Insert_Action (N,
Make_Raise_Constraint_Error (Loc,
Condition =>
Make_Op_Eq (Loc,
Left_Opnd => Duplicate_Subexpr (Expr),
Right_Opnd =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_First,
Prefix =>
New_Occurrence_Of (Base_Type (Ptyp), Loc))),
Reason => CE_Range_Check_Failed),
Suppress => All_Checks);
end if;
end;
-- Transform into call to attribute function
Expand_Fpt_Attribute_R (N);
Analyze_And_Resolve (N, Typ);
@ -5563,6 +5591,33 @@ package body Exp_Attr is
-- floating-point attribute function in Fat_xxx (xxx is root type)
elsif Is_Floating_Point_Type (Ptyp) then
-- Handle case of range check. The Do_Range_Check flag is set only
-- in Check_Float_Overflow mode, and what we need is a specific
-- check against typ'Last, since that is the only overflow case.
declare
Expr : constant Node_Id := First (Exprs);
begin
if Do_Range_Check (Expr) then
Set_Do_Range_Check (Expr, False);
Insert_Action (N,
Make_Raise_Constraint_Error (Loc,
Condition =>
Make_Op_Eq (Loc,
Left_Opnd => Duplicate_Subexpr (Expr),
Right_Opnd =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Last,
Prefix =>
New_Occurrence_Of (Base_Type (Ptyp), Loc))),
Reason => CE_Range_Check_Failed),
Suppress => All_Checks);
end if;
end;
-- Transform into call to attribute function
Expand_Fpt_Attribute_R (N);
Analyze_And_Resolve (N, Typ);

2
gcc/ada/exp_ch4.adb
View File

@ -12559,7 +12559,7 @@ package body Exp_Ch4 is
-- hook pointer is null.
procedure Find_Enclosing_Contexts (N : Node_Id);
-- Find the logical context where N appears, and initializae
-- Find the logical context where N appears, and initialize
-- Hook_Context and Finalization_Context accordingly. Also
-- sets Finalize_Always.

3
gcc/ada/gnat_rm.texi
View File

@ -1779,7 +1779,8 @@ as overflow checking could be guaranteed.
The @code{Check_Float_Overflow}
configuration pragma achieves this effect. If a unit is compiled
subject to this configuration pragma, then all operations
on predefined floating-point types will be treated as
on predefined floating-point types including operations on
base types of these floating-point types will be treated as
though those types were constrained, and overflow checks
will be generated. The @code{Constraint_Error}
exception is raised if the result is out of range.

2
gcc/ada/make.adb
View File

@ -5327,7 +5327,7 @@ package body Make is
if Compute_Builder then
Do_Compute_Builder_Switches
(Project_Tree => Project_Tree,
Root_Environment => Root_Environment,
Env => Root_Environment,
Main_Project => Main_Project,
Only_For_Lang => Name_Ada);

6
gcc/ada/makeutl.adb
View File

@ -3173,7 +3173,7 @@ package body Makeutl is
procedure Compute_Builder_Switches
(Project_Tree : Project_Tree_Ref;
Root_Environment : in out Prj.Tree.Environment;
Env : in out Prj.Tree.Environment;
Main_Project : Project_Id;
Only_For_Lang : Name_Id := No_Name)
is
@ -3312,7 +3312,7 @@ package body Makeutl is
and then Default_Switches_Array /= No_Array
then
Prj.Err.Error_Msg
(Root_Environment.Flags,
(Env.Flags,
"Default_Switches forbidden in presence of " &
"Global_Compilation_Switches. Use Switches instead.",
Project_Tree.Shared.Arrays.Table
@ -3432,7 +3432,7 @@ package body Makeutl is
Name_Len := Name_Len + Name_Len;
Prj.Err.Error_Msg
(Root_Environment.Flags,
(Env.Flags,
'"' & Name_Buffer (1 .. Name_Len) &
""" is not a builder switch. Consider moving " &
"it to Global_Compilation_Switches.",

4
gcc/ada/makeutl.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2014, 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- --
@ -323,7 +323,7 @@ package Makeutl is
procedure Compute_Builder_Switches
(Project_Tree : Project_Tree_Ref;
Root_Environment : in out Prj.Tree.Environment;
Env : in out Prj.Tree.Environment;
Main_Project : Project_Id;
Only_For_Lang : Name_Id := No_Name);
-- Compute the builder switches and global compilation switches. Every time

11
gcc/ada/prj-conf.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2006-2014, 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- --
@ -721,7 +721,7 @@ package body Prj.Conf is
Set_Runtime_For
(Name_Ada,
Name_Buffer (7 .. Name_Len));
Locate_Runtime (Name_Ada, Project_Tree);
Locate_Runtime (Name_Ada, Project_Tree, Env);
end if;
elsif Name_Len > 7
@ -748,7 +748,7 @@ package body Prj.Conf is
if not Runtime_Name_Set_For (Lang) then
Set_Runtime_For (Lang, RTS);
Locate_Runtime (Lang, Project_Tree);
Locate_Runtime (Lang, Project_Tree, Env);
end if;
end;
end if;
@ -1518,7 +1518,8 @@ package body Prj.Conf is
procedure Locate_Runtime
(Language : Name_Id;
Project_Tree : Prj.Project_Tree_Ref)
Project_Tree : Prj.Project_Tree_Ref;
Env : Prj.Tree.Environment)
is
function Is_Base_Name (Path : String) return Boolean;
-- Returns True if Path has no directory separator
@ -1551,7 +1552,7 @@ package body Prj.Conf is
begin
if not Is_Base_Name (RTS_Name) then
Full_Path :=
Find_Rts_In_Path (Root_Environment.Project_Path, RTS_Name);
Find_Rts_In_Path (Env.Project_Path, RTS_Name);
if Full_Path = null then
Fail_Program (Project_Tree, "cannot find RTS " & RTS_Name);

5
gcc/ada/prj-conf.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2006-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2006-2014, 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- --
@ -218,7 +218,8 @@ package Prj.Conf is
procedure Locate_Runtime
(Language : Name_Id;
Project_Tree : Prj.Project_Tree_Ref);
Project_Tree : Prj.Project_Tree_Ref;
Env : Prj.Tree.Environment);
-- If RTS_Name is a base name (a name without path separator), then
-- do nothing. Otherwise, convert it to an absolute path (possibly by
-- searching it in the project path) and call Set_Runtime_For with the

24
gcc/ada/sem_attr.adb
View File

@ -2409,6 +2409,8 @@ package body Sem_Attr is
end if;
end if;
-- Cases where prefix must be resolvable by itself
if Is_Overloaded (P)
and then Aname /= Name_Access
and then Aname /= Name_Address
@ -4835,17 +4837,20 @@ package body Sem_Attr is
if Is_Real_Type (P_Type) or else Is_Boolean_Type (P_Type) then
Error_Msg_Name_1 := Aname;
Error_Msg_Name_2 := Chars (P_Type);
Check_SPARK_Restriction
("attribute% is not allowed for type%", P);
Check_SPARK_Restriction ("attribute% is not allowed for type%", P);
end if;
Resolve (E1, P_Base_Type);
Set_Etype (N, P_Base_Type);
-- Nothing to do for real type case
-- For real types, enable range check in Check_Overflow_Mode only
if Is_Real_Type (P_Type) then
null;
if Check_Float_Overflow
and then not Range_Checks_Suppressed (P_Base_Type)
then
Enable_Range_Check (E1);
end if;
-- If not modular type, test for overflow check required
@ -5739,17 +5744,20 @@ package body Sem_Attr is
if Is_Real_Type (P_Type) or else Is_Boolean_Type (P_Type) then
Error_Msg_Name_1 := Aname;
Error_Msg_Name_2 := Chars (P_Type);
Check_SPARK_Restriction
("attribute% is not allowed for type%", P);
Check_SPARK_Restriction ("attribute% is not allowed for type%", P);
end if;
Resolve (E1, P_Base_Type);
Set_Etype (N, P_Base_Type);
-- Nothing to do for real type case
-- For real types, enable range check in Check_Overflow_Mode only
if Is_Real_Type (P_Type) then
null;
if Check_Float_Overflow
and then not Range_Checks_Suppressed (P_Base_Type)
then
Enable_Range_Check (E1);
end if;
-- If not modular type, test for overflow check required