+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
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;
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;
procedure Reraise is
Excep : constant EOA := Get_Current_Excep.all;
-
begin
Abort_Defer.all;
Exception_Propagation.Setup_Exception (Excep, Excep, Reraised => True);
---------------
procedure To_Stderr (C : Character) is
-
type int is new Integer;
procedure put_char_stderr (C : int);
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
-- exit;
-- end if;
-- end loop;
- --
+
-- Conversely, an existentially quantified expression becomes:
- --
+
-- R := False;
-- for all X in range loop
-- if Cond then
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);
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;
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,
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
Disc := First_Discriminant (Ptyp);
Dcon := First_Elmt (Discriminant_Constraint (Ptyp));
-
Discr_Loop : while Present (Dcon) loop
Dval := Node (Dcon);
-- 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)
Res := New_Copy (N);
Set_Etype (Res, T3);
+
case Nkind (N) is
when N_Op_And =>
Set_Entity (Res, Standard_Op_And);
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
Scan;
Set_Loop_Parameter_Specification (Node1, P_Loop_Parameter_Specification);
+
if Token = Tok_Arrow then
Scan;
Set_Condition (Node1, P_Expression);
-- 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;
(E_Loop, Current_Scope, Sloc (N), 'L');
Iterator : Node_Id;
+
begin
Set_Etype (Ent, Standard_Void_Type);
Set_Parent (Ent, N);
Analyze_Iteration_Scheme (Iterator);
Analyze (Condition (N));
End_Scope;
+
Set_Etype (N, Standard_Boolean);
end Analyze_Quantified_Expression;
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)
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)));
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);
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
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;
-------------------------
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))
----------------------------------------------
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;
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))
Prefix_Type := Etype (P);
else
- -- Check for prefix being an aliased component ???
+ -- Check for prefix being an aliased component???
+
null;
end if;
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
-- 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)
-- 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 + $;
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;
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;
OSDN Git Service
