diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9eb7c45c8665..416cb95eddc2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2010-10-21 Robert Dewar + + * exp_ch4.adb, exp_intr.adb, par-ch4.adb, scn.adb, sem_ch4.adb, + sem_res.adb, sem_util.adb, sinfo.ads, a-except-2005.adb: Minor + reformatting. + * snames.ads-tmpl: Add note on Name_Some (not a reserved keyword). + +2010-10-21 Geert Bosch + + * ttypef.ads: Further cleanup of Safe_XXX float attributes. + 2010-10-19 Ed Schonberg * exp_ch4.adb, exp_ch4.ads (Expand_Quantified_Expression): New procedure diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb index 8f44c6c99a9e..48574e236feb 100644 --- a/gcc/ada/a-except-2005.adb +++ b/gcc/ada/a-except-2005.adb @@ -1232,7 +1232,6 @@ package body Ada.Exceptions is Rmsg_05 (Rmsg_05'First .. Rmsg_05'Last - 1) & ASCII.LF & "index " & Image (Index) & " not in " & Image (First) & ".." & Image (Last) & ASCII.NUL; - begin Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address); end Rcheck_05_Ext; @@ -1244,7 +1243,6 @@ package body Ada.Exceptions is Rmsg_12 (Rmsg_12'First .. Rmsg_12'Last - 1) & ASCII.LF & "value " & Image (Index) & " not in " & Image (First) & ".." & Image (Last) & ASCII.NUL; - begin Raise_Constraint_Error_Msg (File, Line, Column, Msg'Address); end Rcheck_12_Ext; @@ -1255,7 +1253,6 @@ package body Ada.Exceptions is procedure Reraise is Excep : constant EOA := Get_Current_Excep.all; - begin Abort_Defer.all; Exception_Propagation.Setup_Exception (Excep, Excep, Reraised => True); @@ -1397,7 +1394,6 @@ package body Ada.Exceptions is --------------- procedure To_Stderr (C : Character) is - type int is new Integer; procedure put_char_stderr (C : int); diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 04fd5c07f7da..5717f9eecad5 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -7399,17 +7399,20 @@ package body Exp_Ch4 is procedure Expand_N_Quantified_Expression (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); - Iterator : constant Node_Id := Loop_Parameter_Specification (N); - Cond : constant Node_Id := Condition (N); + Iterator : constant Node_Id := Loop_Parameter_Specification (N); + Cond : constant Node_Id := Condition (N); Actions : List_Id; Decl : Node_Id; Test : Node_Id; Tnn : Entity_Id; - -- We expand + -- We expand: + -- for all X in range => Cond - -- into + + -- into: + -- R := True; -- for all X in range loop -- if not Cond then @@ -7417,9 +7420,9 @@ package body Exp_Ch4 is -- exit; -- end if; -- end loop; - -- + -- Conversely, an existentially quantified expression becomes: - -- + -- R := False; -- for all X in range loop -- if Cond then @@ -7431,9 +7434,10 @@ package body Exp_Ch4 is begin Actions := New_List; Tnn := Make_Temporary (Loc, 'T'); - Decl := Make_Object_Declaration (Loc, - Defining_Identifier => Tnn, - Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc)); + Decl := + Make_Object_Declaration (Loc, + Defining_Identifier => Tnn, + Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc)); Append_To (Actions, Decl); @@ -7442,22 +7446,23 @@ package body Exp_Ch4 is Test := Make_If_Statement (Loc, - Condition => + Condition => Make_Op_Not (Loc, Relocate_Node (Cond)), Then_Statements => New_List ( Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Tnn, Loc), + Name => New_Occurrence_Of (Tnn, Loc), Expression => New_Occurrence_Of (Standard_False, Loc)), Make_Exit_Statement (Loc))); + else Set_Expression (Decl, New_Occurrence_Of (Standard_False, Loc)); Test := Make_If_Statement (Loc, - Condition => Relocate_Node (Cond), + Condition => Relocate_Node (Cond), Then_Statements => New_List ( Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Tnn, Loc), + Name => New_Occurrence_Of (Tnn, Loc), Expression => New_Occurrence_Of (Standard_True, Loc)), Make_Exit_Statement (Loc))); end if; @@ -7467,8 +7472,8 @@ package body Exp_Ch4 is Iteration_Scheme => Make_Iteration_Scheme (Loc, Loop_Parameter_Specification => Iterator), - Statements => New_List (Test), - End_Label => Empty)); + Statements => New_List (Test), + End_Label => Empty)); Rewrite (N, Make_Expression_With_Actions (Loc, @@ -7507,10 +7512,10 @@ package body Exp_Ch4 is function In_Left_Hand_Side (Comp : Node_Id) return Boolean is begin return (Nkind (Parent (Comp)) = N_Assignment_Statement - and then Comp = Name (Parent (Comp))) + and then Comp = Name (Parent (Comp))) or else (Present (Parent (Comp)) - and then Nkind (Parent (Comp)) in N_Subexpr - and then In_Left_Hand_Side (Parent (Comp))); + and then Nkind (Parent (Comp)) in N_Subexpr + and then In_Left_Hand_Side (Parent (Comp))); end In_Left_Hand_Side; -- Start of processing for Expand_N_Selected_Component @@ -7625,7 +7630,6 @@ package body Exp_Ch4 is Disc := First_Discriminant (Ptyp); Dcon := First_Elmt (Discriminant_Constraint (Ptyp)); - Discr_Loop : while Present (Dcon) loop Dval := Node (Dcon); diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 4ba5affffe5e..977e335567d0 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -127,7 +127,7 @@ package body Exp_Intr is -- Maximum of operand sizes begin - -- Nothing to do if the operands have the same modular type. + -- Nothing to do if the operands have the same modular type if Base_Type (T1) = Base_Type (T2) and then Is_Modular_Integer_Type (T1) @@ -148,6 +148,7 @@ package body Exp_Intr is Res := New_Copy (N); Set_Etype (Res, T3); + case Nkind (N) is when N_Op_And => Set_Entity (Res, Standard_Op_And); diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index b679e2033487..a613e1f17df5 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -2524,9 +2524,9 @@ package body Ch4 is if Token = Tok_All then Set_All_Present (Node1); - -- We treat Some as a non-reserved keyword, so it appears to - -- the scanner as an identifier. If Some is made into a reserved - -- work, the check below is against Tok_Some. + -- We treat Some as a non-reserved keyword, so it appears to the scanner + -- as an identifier. If Some is made into a reserved word, the check + -- below is against Tok_Some. elsif Token /= Tok_Identifier or else Chars (Token_Node) /= Name_Some @@ -2537,6 +2537,7 @@ package body Ch4 is Scan; Set_Loop_Parameter_Specification (Node1, P_Loop_Parameter_Specification); + if Token = Tok_Arrow then Scan; Set_Condition (Node1, P_Expression); diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb index fb38d225b263..6023780f0c14 100644 --- a/gcc/ada/scn.adb +++ b/gcc/ada/scn.adb @@ -477,9 +477,7 @@ package body Scn is -- check will make it into a regular identifer in earlier versions -- of the language. - if Token = Tok_Some - and then Ada_Version < Ada_2012 - then + if Token = Tok_Some and then Ada_Version < Ada_2012 then null; else Error_Msg_Name_1 := Token_Name; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index a96bcecd8108..ff152f1e2574 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3188,6 +3188,7 @@ package body Sem_Ch4 is (E_Loop, Current_Scope, Sloc (N), 'L'); Iterator : Node_Id; + begin Set_Etype (Ent, Standard_Void_Type); Set_Parent (Ent, N); @@ -3200,6 +3201,7 @@ package body Sem_Ch4 is Analyze_Iteration_Scheme (Iterator); Analyze (Condition (N)); End_Scope; + Set_Etype (N, Standard_Boolean); end Analyze_Quantified_Expression; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index cc8ac857b56b..80b074e01943 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7758,9 +7758,9 @@ package body Sem_Res is Wrong_Type (Expr, Target_Typ); end if; - -- If the target type is unconstrained, then we reset the type of - -- the result from the type of the expression. For other cases, the - -- actual subtype of the expression is the target type. + -- If the target type is unconstrained, then we reset the type of the + -- result from the type of the expression. For other cases, the actual + -- subtype of the expression is the target type. if Is_Composite_Type (Target_Typ) and then not Is_Constrained (Target_Typ) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 55576c57f8e1..b74761894ac7 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -5570,7 +5570,8 @@ package body Sem_Util is Save_Interps (N, New_Prefix); Rewrite (N, - Make_Explicit_Dereference (Sloc (Parent (N)), Prefix => New_Prefix)); + Make_Explicit_Dereference (Sloc (Parent (N)), + Prefix => New_Prefix)); Set_Etype (N, Designated_Type (Etype (New_Prefix))); @@ -5623,7 +5624,7 @@ package body Sem_Util is end if; end if; - -- Place the reference on the entity node. + -- Place the reference on the entity node if Present (Ent) then Generate_Reference (Ent, Pref); @@ -5652,8 +5653,8 @@ package body Sem_Util is and then Comes_From_Source (Decl) - -- The constant is not completed. A full object declaration - -- or a pragma Import complete a deferred constant. + -- The constant is not completed. A full object declaration or a + -- pragma Import complete a deferred constant. and then not Has_Completion (Defining_Identifier (Decl)) then @@ -5687,8 +5688,7 @@ package body Sem_Util is Call : Node_Id; begin Find_Actual (N, Formal, Call); - return Present (Formal) - and then Ekind (Formal) = E_Out_Parameter; + return Present (Formal) and then Ekind (Formal) = E_Out_Parameter; end Is_Actual_Out_Parameter; ------------------------- @@ -5860,9 +5860,7 @@ package body Sem_Util is begin -- Predicate is not relevant to subprograms - if Is_Entity_Name (N) - and then Is_Overloadable (Entity (N)) - then + if Is_Entity_Name (N) and then Is_Overloadable (Entity (N)) then return False; elsif Is_Atomic (Etype (N)) @@ -6015,7 +6013,7 @@ package body Sem_Util is ---------------------------------------------- function Is_Dependent_Component_Of_Mutable_Object - (Object : Node_Id) return Boolean + (Object : Node_Id) return Boolean is P : Node_Id; Prefix_Type : Entity_Id; @@ -6055,10 +6053,9 @@ package body Sem_Util is P_Aliased := True; end if; - -- A discriminant check on a selected component may be - -- expanded into a dereference when removing side-effects. - -- Recover the original node and its type, which may be - -- unconstrained. + -- A discriminant check on a selected component may be expanded + -- into a dereference when removing side-effects. Recover the + -- original node and its type, which may be unconstrained. elsif Nkind (P) = N_Explicit_Dereference and then not (Comes_From_Source (P)) @@ -6067,7 +6064,8 @@ package body Sem_Util is Prefix_Type := Etype (P); else - -- Check for prefix being an aliased component ??? + -- Check for prefix being an aliased component??? + null; end if; @@ -6116,8 +6114,8 @@ package body Sem_Util is Comp := Original_Record_Component (Entity (Selector_Name (Object))); - -- As per AI-0017, the renaming is illegal in a generic body, - -- even if the subtype is indefinite. + -- As per AI-0017, the renaming is illegal in a generic body, even + -- if the subtype is indefinite. -- Ada 2005 (AI-363): In Ada 2005 an aliased object can be mutable diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 556bffad1f31..f47892a0ab15 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -3825,10 +3825,10 @@ package Sinfo is -- for QUANTIFIER LOOP_PARAMETER_SPECIFICATION => PREDICATE | -- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE -- - -- QUANTIFIER ::= all | some + -- QUANTIFIER ::= all | some -- N_Quantified_Expression - -- Sloc points to token for + -- Sloc points to FOR -- Loop_Parameter_Specification (Node4) -- Condition (Node1) -- All_Present (Flag15) diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 57f40a5593cc..4ec549e32086 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -937,6 +937,10 @@ package Snames is -- Names corresponding to reserved keywords, excluding those already -- declared in the attribute list (Access, Delta, Digits, Mod, Range). + -- Note: Name_Some is here even though for now we do not treat it as being + -- reserved. We treat it instead as an unreserved keyword. This may change + -- in the future, but in any case it belongs in the following list. + Name_Abort : constant Name_Id := N + $; Name_Abs : constant Name_Id := N + $; Name_Accept : constant Name_Id := N + $; diff --git a/gcc/ada/ttypef.ads b/gcc/ada/ttypef.ads index 0970021f3c58..58cdbff83422 100644 --- a/gcc/ada/ttypef.ads +++ b/gcc/ada/ttypef.ads @@ -142,7 +142,7 @@ package Ttypef is IEEEL_Safe_First : constant := -16#0.FFFF_FFFF_FFFF_F8#E+256; IEEEX_Safe_First : constant := -16#0.FFFF_FFFF_FFFF_FFFF#E+4096; VAXFF_Safe_First : constant := -16#0.7FFF_FF8#E+32; - VAXDF_Safe_First : constant := -16#0.7FFF_FFFF_FFFF_FC0#E+32; + VAXDF_Safe_First : constant := -16#0.7FFF_FFFF_FFFF_FF8#E+32; VAXGF_Safe_First : constant := -16#0.7FFF_FFFF_FFFF_FC#E+256; AAMPS_Safe_First : constant := -16#0.7FFF_FF8#E+32; AAMPL_Safe_First : constant := -16#0.7FFF_FFFF_FF8#E+32; @@ -150,17 +150,17 @@ package Ttypef is IEEES_Safe_Large : constant := 16#0.FFFF_FF#E+32; IEEEL_Safe_Large : constant := 16#0.FFFF_FFFF_FFFF_F8#E+256; IEEEX_Safe_Large : constant := 16#0.FFFF_FFFF_FFFF_FFFF#E+4096; - VAXFF_Safe_Large : constant := 16#0.7FFF_FC0#E+32; - VAXDF_Safe_Large : constant := 16#0.7FFF_FFFF_0000_000#E+32; - VAXGF_Safe_Large : constant := 16#0.7FFF_FFFF_FFFF_F0#E+256; - AAMPS_Safe_Large : constant := 16#0.7FFF_FC0#E+32; - AAMPL_Safe_Large : constant := 16#0.7FFF_FFFF#E+32; + VAXFF_Safe_Large : constant := 16#0.7FFF_FF8#E+32; + VAXDF_Safe_Large : constant := 16#0.7FFF_FFFF_FFFF_FF8#E+32; + VAXGF_Safe_Large : constant := 16#0.7FFF_FFFF_FFFF_FC#E+256; + AAMPS_Safe_Large : constant := 16#0.7FFF_FF8#E+32; + AAMPL_Safe_Large : constant := 16#0.7FFF_FFFF_FF8#E+32; IEEES_Safe_Last : constant := 16#0.FFFF_FF#E+32; IEEEL_Safe_Last : constant := 16#0.FFFF_FFFF_FFFF_F8#E+256; IEEEX_Safe_Last : constant := 16#0.FFFF_FFFF_FFFF_FFFF#E+4096; VAXFF_Safe_Last : constant := 16#0.7FFF_FF8#E+32; - VAXDF_Safe_Last : constant := 16#0.7FFF_FFFF_FFFF_FC0#E+32; + VAXDF_Safe_Last : constant := 16#0.7FFF_FFFF_FFFF_FF8#E+32; VAXGF_Safe_Last : constant := 16#0.7FFF_FFFF_FFFF_FC#E+256; AAMPS_Safe_Last : constant := 16#0.7FFF_FF8#E+32; AAMPL_Safe_Last : constant := 16#0.7FFF_FFFF_FF8#E+32;