+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
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;
---------------------------
-- 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))
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
-- 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
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);
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);
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);
-- 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;
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;
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
-- 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
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
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;
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);
-- 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;
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;
-----------------
-- 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
-- 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
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';
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'
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' =>
OSDN Git Service
