mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-25 09:00:35 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2010-10-21  Robert Dewar  <dewar@adacore.com>

	* 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  <bosch@adacore.com>

	* ttypef.ads: Further cleanup of Safe_XXX float attributes.

From-SVN: r165756
This commit is contained in:
Arnaud Charlet 2010-10-21 11:52:52 +02:00
parent acee848666
commit 90c63b098c
12 changed files with 74 additions and 59 deletions

11
gcc/ada/ChangeLog

@ -1,3 +1,14 @@
2010-10-21 Robert Dewar <dewar@adacore.com>
* 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 <bosch@adacore.com>
* ttypef.ads: Further cleanup of Safe_XXX float attributes.
2010-10-19 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb, exp_ch4.ads (Expand_Quantified_Expression): New procedure

4
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);

42
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);

3
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);

7
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);

4
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;

2
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;

6
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)

32
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

4
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)

4
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 + $;

14
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;