Skip to content

R
riscv-gcc-1
Commit 9a0ddeee by Arnaud Charlet
Options

[multiple changes] 

2010-06-23  Thomas Quinot  <quinot@adacore.com>

	* sem_util.adb: Minor code cleanup: test for proper entity instead of
	testing just Chars attribute when checking whether a given scope is
	System.
	* exp_ch4.adb, einfo.adb: Minor reformatting.

2010-06-23  Vincent Celier  <celier@adacore.com>

	PR ada/44633
	* switch-m.adb (Normalize_Compiler_Switches): Take into account
	switches -gnatB, -gnatD=nn, -gnatG (incuding -gnatG=nn), -gnatI,
	-gnatl=file, -gnatS, -gnatjnn, -gnateI=nn and -gnatWx.

2010-06-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Membership_Op): If left operand is a mixed mode
	operation with a universal real operand, and the right operand is a
	range with universal bounds, find unique fixed point that may be
	candidate, and warn appropriately.

From-SVN: r161264
parent bb481772
Showing with 178 additions and 91 deletions
gcc/ada/ChangeLog
2010-06-23 Thomas Quinot <quinot@adacore.com>
* sem_util.adb: Minor code cleanup: test for proper entity instead of
testing just Chars attribute when checking whether a given scope is
System.
* exp_ch4.adb, einfo.adb: Minor reformatting.
2010-06-23 Vincent Celier <celier@adacore.com>
PR ada/44633
* switch-m.adb (Normalize_Compiler_Switches): Take into account
switches -gnatB, -gnatD=nn, -gnatG (incuding -gnatG=nn), -gnatI,
-gnatl=file, -gnatS, -gnatjnn, -gnateI=nn and -gnatWx.
2010-06-23 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Membership_Op): If left operand is a mixed mode
operation with a universal real operand, and the right operand is a
range with universal bounds, find unique fixed point that may be
candidate, and warn appropriately.
2010-06-23 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Intrinsic_Operator): Add guards to handle
......
gcc/ada/einfo.adb
......@@ -5856,7 +5856,7 @@ package body Einfo is
return Convention (Id) in Foreign_Convention
or else (Convention (Id) = Convention_Intrinsic
and then Present (Interface_Name (Id)));
and then Present (Interface_Name (Id)));
end Has_Foreign_Convention;
---------------------------
......
gcc/ada/exp_ch4.adb
......@@ -4378,9 +4378,9 @@ package body Exp_Ch4 is
-- Check case of explicit test for an expression in range of its
-- subtype. This is suspicious usage and we replace it with a 'Valid
-- test and give a warning. For floating point types however, this
-- is a standard way to check for finite numbers, and using 'Valid
-- would typically be a pessimization
-- test and give a warning. For floating point types however, this is a
-- standard way to check for finite numbers, and using 'Valid vould
-- typically be a pessimization.
if Is_Scalar_Type (Etype (Lop))
and then not Is_Floating_Point_Type (Etype (Lop))
......@@ -4420,9 +4420,9 @@ package body Exp_Ch4 is
and then Comes_From_Source (N)
and then not In_Instance;
-- This must be true for any of the optimization warnings, we
-- clearly want to give them only for source with the flag on.
-- We also skip these warnings in an instance since it may be
-- the case that different instantiations have different ranges.
-- clearly want to give them only for source with the flag on. We
-- also skip these warnings in an instance since it may be the
-- case that different instantiations have different ranges.
Warn2 : constant Boolean :=
Warn1
......@@ -4431,8 +4431,8 @@ package body Exp_Ch4 is
-- For the case where only one bound warning is elided, we also
-- insist on an explicit range and an integer type. The reason is
-- that the use of enumeration ranges including an end point is
-- common, as is the use of a subtype name, one of whose bounds
-- is the same as the type of the expression.
-- common, as is the use of a subtype name, one of whose bounds is
-- the same as the type of the expression.
begin
-- If test is explicit x'first .. x'last, replace by valid check
......@@ -4477,8 +4477,8 @@ package body Exp_Ch4 is
return;
end if;
-- If we have an explicit range, do a bit of optimization based
-- on range analysis (we may be able to kill one or both checks).
-- If we have an explicit range, do a bit of optimization based on
-- range analysis (we may be able to kill one or both checks).
Lcheck := Compile_Time_Compare (Lop, Lo, Assume_Valid => False);
Ucheck := Compile_Time_Compare (Lop, Hi, Assume_Valid => False);
......@@ -4493,8 +4493,7 @@ package body Exp_Ch4 is
Error_Msg_N ("\?value is known to be out of range", N);
end if;
Rewrite (N,
New_Reference_To (Standard_False, Loc));
Rewrite (N, New_Reference_To (Standard_False, Loc));
Analyze_And_Resolve (N, Rtyp);
Set_Is_Static_Expression (N, Static);
......@@ -4509,8 +4508,7 @@ package body Exp_Ch4 is
Error_Msg_N ("\?value is known to be in range", N);
end if;
Rewrite (N,
New_Reference_To (Standard_True, Loc));
Rewrite (N, New_Reference_To (Standard_True, Loc));
Analyze_And_Resolve (N, Rtyp);
Set_Is_Static_Expression (N, Static);
......@@ -4624,9 +4622,7 @@ package body Exp_Ch4 is
-- Update decoration of relocated node referenced by the
-- SCIL node.
if Generate_SCIL
and then Present (SCIL_Node)
then
if Generate_SCIL and then Present (SCIL_Node) then
Set_SCIL_Node (N, SCIL_Node);
end if;
end if;
......@@ -4666,12 +4662,10 @@ package body Exp_Ch4 is
Make_Raise_Program_Error (Loc,
Reason => PE_Unchecked_Union_Restriction));
-- Prevent Gigi from generating incorrect code by rewriting
-- the test as a standard False.
Rewrite (N,
New_Occurrence_Of (Standard_False, Loc));
-- Prevent Gigi from generating incorrect code by rewriting the
-- test as False.
Rewrite (N, New_Occurrence_Of (Standard_False, Loc));
return;
end if;
......@@ -4682,8 +4676,7 @@ package body Exp_Ch4 is
end if;
if not Is_Constrained (Typ) then
Rewrite (N,
New_Reference_To (Standard_True, Loc));
Rewrite (N, New_Reference_To (Standard_True, Loc));
Analyze_And_Resolve (N, Rtyp);
-- For the constrained array case, we have to check the subscripts
......@@ -4691,19 +4684,18 @@ package body Exp_Ch4 is
-- must match in any case).
elsif Is_Array_Type (Typ) then
Check_Subscripts : declare
function Construct_Attribute_Reference
function Build_Attribute_Reference
(E : Node_Id;
Nam : Name_Id;
Dim : Nat) return Node_Id;
-- Build attribute reference E'Nam(Dim)
-- Build attribute reference E'Nam (Dim)
-----------------------------------
-- Construct_Attribute_Reference --
-----------------------------------
-------------------------------
-- Build_Attribute_Reference --
-------------------------------
function Construct_Attribute_Reference
function Build_Attribute_Reference
(E : Node_Id;
Nam : Name_Id;
Dim : Nat) return Node_Id
......@@ -4711,11 +4703,11 @@ package body Exp_Ch4 is
begin
return
Make_Attribute_Reference (Loc,
Prefix => E,
Prefix => E,
Attribute_Name => Nam,
Expressions => New_List (
Expressions => New_List (
Make_Integer_Literal (Loc, Dim)));
end Construct_Attribute_Reference;
end Build_Attribute_Reference;
-- Start of processing for Check_Subscripts
......@@ -4724,21 +4716,21 @@ package body Exp_Ch4 is
Evolve_And_Then (Cond,
Make_Op_Eq (Loc,
Left_Opnd =>
Construct_Attribute_Reference
Build_Attribute_Reference
(Duplicate_Subexpr_No_Checks (Obj),
Name_First, J),
Right_Opnd =>
Construct_Attribute_Reference
Build_Attribute_Reference
(New_Occurrence_Of (Typ, Loc), Name_First, J)));
Evolve_And_Then (Cond,
Make_Op_Eq (Loc,
Left_Opnd =>
Construct_Attribute_Reference
Build_Attribute_Reference
(Duplicate_Subexpr_No_Checks (Obj),
Name_Last, J),
Right_Opnd =>
Construct_Attribute_Reference
Build_Attribute_Reference
(New_Occurrence_Of (Typ, Loc), Name_Last, J)));
end loop;
......
gcc/ada/sem_res.adb
......@@ -7036,6 +7036,18 @@ package body Sem_Res is
T := Intersect_Types (L, R);
end if;
-- If mixed-mode operations are present and operands are all literal,
-- the only interpretation involves Duration, which is probably not
-- the intention of the programmer.
if T = Any_Fixed then
T := Unique_Fixed_Point_Type (N);
if T = Any_Type then
return;
end if;
end if;
Resolve (L, T);
Check_Unset_Reference (L);
......
gcc/ada/sem_util.adb
......@@ -1770,8 +1770,7 @@ package body Sem_Util is
-- appear in the target-specific extension to System.
if No (Id)
and then Chars (B_Scope) = Name_System
and then Scope (B_Scope) = Standard_Standard
and then B_Scope = RTU_Entity (System)
and then Present_System_Aux
then
B_Scope := System_Aux_Id;
......@@ -7225,7 +7224,7 @@ package body Sem_Util is
and then Scope (Op) = System_Aux_Id)
or else
(True_VMS_Target
and then Chars (Scope (Scope (Op))) = Name_System));
and then Scope (Scope (Op)) = RTU_Entity (System)));
end Is_VMS_Operator;
-----------------
......
gcc/ada/switch-m.adb
......@@ -215,9 +215,9 @@ package body Switch.M is
-- One-letter switches
when 'a' | 'A' | 'b' | 'c' | 'C' | 'D' | 'E' | 'f' |
'F' | 'g' | 'h' | 'H' | 'l' | 'L' | 'n' | 'N' |
'o' | 'O' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' |
when 'a' | 'A' | 'b' | 'B' | 'c' | 'C' | 'E' | 'f' |
'F' | 'g' | 'h' | 'H' | 'I' | 'L' | 'n' | 'N' |
'o' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 'S' |
't' | 'u' | 'U' | 'v' | 'x' | 'X' | 'Z' =>
Storing (First_Stored) := C;
Add_Switch_Component
......@@ -226,10 +226,14 @@ package body Switch.M is
-- One-letter switches followed by a positive number
when 'k' | 'm' | 'T' =>
when 'D' | 'G' | 'j' | 'k' | 'm' | 'T' =>
Storing (First_Stored) := C;
Last_Stored := First_Stored;
if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
Ptr := Ptr + 1;
end if;
loop
Ptr := Ptr + 1;
exit when Ptr > Max
......@@ -268,68 +272,93 @@ package body Switch.M is
when 'e' =>
-- Store -gnateD, -gnatep=, -gnateG and -gnateS in the
-- ALI file. The other -gnate switches do not need to be
-- stored.
-- Some of the gnate... switches are not stored
Storing (First_Stored) := 'e';
Ptr := Ptr + 1;
if Ptr > Max
or else (Switch_Chars (Ptr) /= 'D'
and then Switch_Chars (Ptr) /= 'G'
and then Switch_Chars (Ptr) /= 'p'
and then Switch_Chars (Ptr) /= 'S')
then
if Ptr > Max then
Last := 0;
return;
end if;
-- Processing for -gnateD
else
case Switch_Chars (Ptr) is
if Switch_Chars (Ptr) = 'D' then
Storing (First_Stored + 1 ..
First_Stored + Max - Ptr + 1) :=
Switch_Chars (Ptr .. Max);
Add_Switch_Component
(Storing (Storing'First ..
First_Stored + Max - Ptr + 1));
when 'D' =>
Storing (First_Stored + 1 ..
First_Stored + Max - Ptr + 1) :=
Switch_Chars (Ptr .. Max);
Add_Switch_Component
(Storing (Storing'First ..
First_Stored + Max - Ptr + 1));
Ptr := Max + 1;
-- Processing for -gnatep=
when 'G' =>
Ptr := Ptr + 1;
Add_Switch_Component ("-gnateG");
elsif Switch_Chars (Ptr) = 'p' then
Ptr := Ptr + 1;
when 'I' =>
Ptr := Ptr + 1;
if Ptr = Max then
Last := 0;
return;
end if;
declare
First : constant Positive := Ptr - 1;
begin
if Ptr <= Max and then
Switch_Chars (Ptr) = '='
then
Ptr := Ptr + 1;
end if;
while Ptr <= Max and then
Switch_Chars (Ptr) in '0' .. '9'
loop
Ptr := Ptr + 1;
end loop;
Storing (First_Stored + 1 ..
First_Stored + Ptr - First) :=
Switch_Chars (First .. Ptr - 1);
Add_Switch_Component
(Storing (Storing'First ..
First_Stored + Ptr - First));
end;
when 'p' =>
Ptr := Ptr + 1;
if Switch_Chars (Ptr) = '=' then
Ptr := Ptr + 1;
end if;
if Ptr = Max then
Last := 0;
return;
end if;
-- To normalize, always put a '=' after -gnatep.
-- Because that could lengthen the switch string,
-- declare a local variable.
if Switch_Chars (Ptr) = '=' then
Ptr := Ptr + 1;
end if;
declare
To_Store : String (1 .. Max - Ptr + 9);
begin
To_Store (1 .. 8) := "-gnatep=";
To_Store (9 .. Max - Ptr + 9) :=
Switch_Chars (Ptr .. Max);
Add_Switch_Component (To_Store);
end;
-- To normalize, always put a '=' after
-- -gnatep. Because that could lengthen the
-- switch string, declare a local variable.
elsif Switch_Chars (Ptr) = 'G' then
Add_Switch_Component ("-gnateG");
declare
To_Store : String (1 .. Max - Ptr + 9);
begin
To_Store (1 .. 8) := "-gnatep=";
To_Store (9 .. Max - Ptr + 9) :=
Switch_Chars (Ptr .. Max);
Add_Switch_Component (To_Store);
end;
elsif Switch_Chars (Ptr) = 'S' then
Add_Switch_Component ("-gnateS");
end if;
return;
return;
when 'S' =>
Ptr := Ptr + 1;
Add_Switch_Component ("-gnateS");
when others =>
Last := 0;
return;
end case;
end if;
when 'i' =>
Storing (First_Stored) := 'i';
......@@ -360,6 +389,20 @@ package body Switch.M is
return;
end if;
-- -gnatl may be -gnatl=<file name>
when 'l' =>
Ptr := Ptr + 1;
if Ptr > Max or else Switch_Chars (Ptr) /= '=' then
Add_Switch_Component ("-gnatl");
else
Add_Switch_Component
("-gnatl" & Switch_Chars (Ptr .. Max));
return;
end if;
-- -gnatR may be followed by '0', '1', '2' or '3',
-- then by 's'
......@@ -395,6 +438,26 @@ package body Switch.M is
Add_Switch_Component
(Storing (Storing'First .. Last_Stored));
-- -gnatWx, x = 'h'. 'u', 's', 'e', '8' or 'b'
when 'W' =>
Storing (First_Stored) := 'W';
Ptr := Ptr + 1;
if Ptr <= Max then
case Switch_Chars (Ptr) is
when 'h' | 'u' | 's' | 'e' | '8' | 'b' =>
Storing (First_Stored + 1) := Switch_Chars (Ptr);
Add_Switch_Component
(Storing (Storing'First .. First_Stored + 1));
Ptr := Ptr + 1;
when others =>
Last := 0;
return;
end case;
end if;
-- Multiple switches
when 'V' | 'w' | 'y' =>
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment