From: charlet Date: Wed, 23 Jun 2010 09:14:55 +0000 (+0000) Subject: 2010-06-23 Thomas Quinot X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=commitdiff_plain;h=31c85ce50498700c07932332ddac2649467a9ce4;ds=sidebyside 2010-06-23 Thomas Quinot * 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 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 * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161264 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 45879d571c6..12e60cc7fef 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2010-06-23 Thomas Quinot + + * 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 + + 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 + + * 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 * sem_res.adb (Resolve_Intrinsic_Operator): Add guards to handle diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 7769ff1b2bd..f1145a1ac07 100644 --- a/gcc/ada/einfo.adb +++ b/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; --------------------------- diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 6a78a935080..cf9f8d78fb4 100644 --- a/gcc/ada/exp_ch4.adb +++ b/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; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index c3e6956235c..33b48d60c31 100644 --- a/gcc/ada/sem_res.adb +++ b/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); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 47e681a428f..6339e3e9c65 100644 --- a/gcc/ada/sem_util.adb +++ b/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; ----------------- diff --git a/gcc/ada/switch-m.adb b/gcc/ada/switch-m.adb index b549b2cac69..11491d3de42 100644 --- a/gcc/ada/switch-m.adb +++ b/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= + + 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' =>