[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
This commit is contained in:
Arnaud Charlet
parent
bb481772fe
commit
9a0ddeee0f
|
|
@ -1,3 +1,24 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
---------------------------
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
-----------------
|
||||
|
|
|
|||
|
|
@ -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,69 +272,94 @@ 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;
|
||||
|
||||
else
|
||||
case Switch_Chars (Ptr) is
|
||||
|
||||
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;
|
||||
|
||||
when 'G' =>
|
||||
Ptr := Ptr + 1;
|
||||
Add_Switch_Component ("-gnateG");
|
||||
|
||||
when 'I' =>
|
||||
Ptr := Ptr + 1;
|
||||
|
||||
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 Ptr = Max then
|
||||
Last := 0;
|
||||
return;
|
||||
end if;
|
||||
|
||||
if Switch_Chars (Ptr) = '=' then
|
||||
Ptr := Ptr + 1;
|
||||
end if;
|
||||
|
||||
-- To normalize, always put a '=' after
|
||||
-- -gnatep. Because that could lengthen the
|
||||
-- switch string, declare a local variable.
|
||||
|
||||
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;
|
||||
|
||||
return;
|
||||
|
||||
when 'S' =>
|
||||
Ptr := Ptr + 1;
|
||||
Add_Switch_Component ("-gnateS");
|
||||
|
||||
when others =>
|
||||
Last := 0;
|
||||
return;
|
||||
end case;
|
||||
end if;
|
||||
|
||||
-- Processing for -gnateD
|
||||
|
||||
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));
|
||||
|
||||
-- Processing for -gnatep=
|
||||
|
||||
elsif Switch_Chars (Ptr) = 'p' then
|
||||
Ptr := Ptr + 1;
|
||||
|
||||
if Ptr = Max then
|
||||
Last := 0;
|
||||
return;
|
||||
end if;
|
||||
|
||||
if Switch_Chars (Ptr) = '=' then
|
||||
Ptr := Ptr + 1;
|
||||
end if;
|
||||
|
||||
-- To normalize, always put a '=' after -gnatep.
|
||||
-- Because that could lengthen the switch string,
|
||||
-- declare a local variable.
|
||||
|
||||
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) = 'G' then
|
||||
Add_Switch_Component ("-gnateG");
|
||||
|
||||
elsif Switch_Chars (Ptr) = 'S' then
|
||||
Add_Switch_Component ("-gnateS");
|
||||
end if;
|
||||
|
||||
return;
|
||||
|
||||
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' =>
|
||||
|
|
|
|||
Loading…
Reference in New Issue