+2013-04-24 Robert Dewar <dewar@adacore.com>
+
+ * sem_type.adb, exp_attr.adb, exp_ch4.adb: Minor reformatting.
+
+2013-04-24 Robert Dewar <dewar@adacore.com>
+
+ * gnat_rm.texi: Document 'Update attribute.
+ * sem_attr.adb (Analyze_Attribute, case Update): Remove call
+ to S14_Attribute (S14_Attribute): removed.
+
+2013-04-24 Robert Dewar <dewar@adacore.com>
+
+ * interfac.ads: Add size clauses for IEEE_Float_32/64
+
+2013-04-24 Claire Dross <dross@adacore.com>
+
+ * gnat1drv.adb (Adjust_Global_Switches): Remove
+ special assignment of Use_Expression_With_Actions for SPARK_Mode.
+
+2013-04-24 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * checks.adb (Apply_Predicate_Check): Check for the presence
+ of the dynamic predicate aspect when trying to determine if the
+ predicate of a type is non-static.
+ * sem_ch5.adb (Analyze_Loop_Parameter_Specification): Check
+ for the presence of the dynamic predicate aspect when trying to
+ determine if the predicate of a type is non- static.
+ * sem_ch13.adb (Add_Call): Capture the nature of the
+ inherited ancestor predicate.
+ (Build_Predicate_Functions): Update comments. Rewrite the checks on
+ static predicate application. Complain about the form of a non-static
+ expression only when the type is static.
+
+2013-04-24 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_prag.adb: Add guard to tree traversal.
+
+2013-04-24 Vincent Celier <celier@adacore.com>
+
+ * clean.adb (Clean): Remove local variable Root_Environment,
+ use Makeutl.Root_Environment instead.
+ * gnatcmd.adb: Remove local variable Root_Environment, use
+ Makeutl.Root_Environment instead.
+ * make.adb (Gnatmake): Remove local variable Root_Environment,
+ use Makeutl.Root_Environment instead.
+ * prj-makr.adb: Remove local variable Root_Environment, use
+ Makeutl.Root_Environment instead.
+
2013-04-24 Hristian Kirtchev <kirtchev@adacore.com>
* exp_attr.adb (Expand_Loop_Entry_Attribute): Clarify the
Make_Raise_Storage_Error (Sloc (N),
Reason => SE_Infinite_Recursion));
- -- Here for normal case of predicate active.
+ -- Here for normal case of predicate active
else
-- If the predicate is a static predicate and the operand is
-- static, the predicate must be evaluated statically. If the
-- evaluation fails this is a static constraint error. This check
-- is disabled in -gnatc mode, because the compiler is incapable
- -- of evaluating static expressions in that case.
-
- if Is_OK_Static_Expression (N) then
- if Present (Static_Predicate (Typ)) then
- if Operating_Mode < Generate_Code
- or else Eval_Static_Predicate_Check (N, Typ)
- then
- return;
- else
- Error_Msg_NE
- ("static expression fails static predicate check on&",
- N, Typ);
- end if;
+ -- of evaluating static expressions in that case. Note that when
+ -- inherited predicates are involved, a type may have both static
+ -- and dynamic forms. Check the presence of a dynamic predicate
+ -- aspect.
+
+ if Is_OK_Static_Expression (N)
+ and then Present (Static_Predicate (Typ))
+ and then not Has_Dynamic_Predicate_Aspect (Typ)
+ then
+ if Operating_Mode < Generate_Code
+ or else Eval_Static_Predicate_Check (N, Typ)
+ then
+ return;
+ else
+ Error_Msg_NE
+ ("static expression fails static predicate check on&",
+ N, Typ);
end if;
end if;
Project_Node_Tree : Project_Node_Tree_Ref;
- Root_Environment : Prj.Tree.Environment;
-
Main_Project : Prj.Project_Id := Prj.No_Project;
All_Projects : Boolean := False;
-- When the related loop name appears as the argument of attribute
-- Loop_Entry, the corresponding label construct is the generated
- -- block statement. This happens because the expander reuses the
- -- label.
+ -- block statement. This is because the expander reuses the label.
if Nkind (Loop_Stmt) = N_Block_Statement then
Decls := Declarations (Loop_Stmt);
else
pragma Assert
(Nkind (Parent (Loop_Stmt)) = N_Handled_Sequence_Of_Statements
- and then Nkind (Parent (Parent (Loop_Stmt))) =
- N_Block_Statement);
+ and then Nkind (Parent (Parent (Loop_Stmt))) =
+ N_Block_Statement);
Decls := Declarations (Parent (Parent (Loop_Stmt)));
end if;
Expand_N_Full_Type_Declaration
(Parent (Base_Type (PtrT)));
- else
- -- If the type of the allocator is an itype,
- -- the master must exist in the context. This
- -- is the case when the allocator initializes
- -- an access component in an init-proc.
+ -- The only other possibility is an itype. For this
+ -- case, the master must exist in the context. This is
+ -- the case when the allocator initializes an access
+ -- component in an init-proc.
+ else
pragma Assert (Is_Itype (PtrT));
Build_Master_Renaming (PtrT, N);
end if;
Debug_Flag_HH := True;
- -- Disable Expressions_With_Actions nodes
-
- -- The gnat2why backend does not deal with Expressions_With_Actions
- -- in all places (in particular assertions). It is difficult to
- -- determine in the frontend which cases are allowed, so we disable
- -- Expressions_With_Actions entirely. Even in the cases where
- -- gnat2why deals with Expressions_With_Actions, it is easier to
- -- deal with the original constructs (quantified, conditional and
- -- case expressions) instead of the rewritten ones.
-
- Use_Expression_With_Actions := False;
-
-- Enable assertions, since they give valuable extra information for
-- formal verification.
* Unconstrained_Array::
* Universal_Literal_String::
* Unrestricted_Access::
+* Update::
* Valid_Scalars::
* VADS_Size::
* Value_Size::
* Unconstrained_Array::
* Universal_Literal_String::
* Unrestricted_Access::
+* Update::
* Valid_Scalars::
* VADS_Size::
* Value_Size::
to create a unconstrained pointer and then return that value to the
caller.
+@node Update
+@unnumberedsec Update
+@findex Update
+@noindent
+The @code{Update} attribute creates a copy of an array or record value
+with one or more modified components. The syntax is:
+
+@smallexample @c ada
+PREFIX'Update (AGGREGATE);
+@end smallexample
+
+@noindent
+where @code{PREFIX} is the name of an array or record object, and
+@code{AGGREGATE} is a named aggregate that does not contain an @code{others}
+choice. The effect is to yield a copy of the array or record value which
+is unchanged apart from the components mentioned in the aggregate, which
+are changed to the indicated value. The original value of the array or
+record value is not affected. For example:
+
+@smallexample @c ada
+type Arr is Array (1 .. 5) of Integer;
+...
+Avar1 : Arr := (1,2,3,4,5);
+Avar2 : Arr := Avar1'Update ((2 => 10, 3 .. 4 => 20));
+@end smallexample
+
+@noindent
+yields a value for @code{Avar2} of 1,10,20,20,5 with @code{Avar1}
+begin unmodified. Similarly:
+
+@smallexample @c ada
+type Rec is A, B, C : Integer;
+...
+Rvar1 : Rec := (A => 1, B => 2, C => 3);
+Rvar2 : Rec := Rvar1'Update ((B => 20));
+@end smallexample
+
+@noindent
+yields a value for @code{Rvar2} of (A => 1, B => 20, C => 3),
+with @code{Rvar1} being unmodifed.
+Note that the value of the attribute reference is computed
+completely before it is used. This means that if you write:
+
+@smallexample @c ada
+Avar1 := Avar1'Update ((1 => 10, 2 => Function_Call));
+@end smallexample
+
+@noindent
+then the value of @code{Avar1} is not modified if @code{Function_Call}
+raises an exception, unlike the effect of a series of direct assignments
+to elements of @code{Avar1}. In general this requires that
+two extra complete copies of the object are required, which should be
+kept in mind when considering efficiency.
+
+The @code{Update} attribute cannot be applied to prefixes of a limited
+type, and cannot reference discriminants in the case of a record type.
+
+In the record case, no component can be mentioned more than once. In
+the array case, two overlapping ranges can appear in the aggregate,
+in which case the modifications are processed left to right.
+
+Multi-dimensional arrays can be modified, as shown by this example:
+
+@smallexample @c ada
+A : array (1 .. 10, 1 .. 10) of Integer;
+..
+A := A'Update (1 => (2 => 20), 3 => (4 => 30));
+@end smallexample
+
+@noindent
+which changes element (1,2) to 20 and (3,4) to 30.
+
@node Valid_Scalars
@unnumberedsec Valid_Scalars
@findex Valid_Scalars
procedure GNATCmd is
Project_Node_Tree : Project_Node_Tree_Ref;
- Root_Environment : Prj.Tree.Environment;
Project_File : String_Access;
Project : Prj.Project_Id;
Current_Verbosity : Prj.Verbosity := Prj.Default;
-- --
-- S p e c --
-- --
--- Copyright (C) 2002-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2013, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
type IEEE_Float_32 is digits 6;
pragma Float_Representation (IEEE_Float, IEEE_Float_32);
+ for IEEE_Float_32'Size use 32;
type IEEE_Float_64 is digits 15;
pragma Float_Representation (IEEE_Float, IEEE_Float_64);
+ for IEEE_Float_64'Size use 64;
-- If there is an IEEE extended float available on the machine, we assume
-- that it is available as Long_Long_Float.
-- is invoked with the -F switch to force checking of elaboration flags.
Project_Node_Tree : Project_Node_Tree_Ref;
- Root_Environment : Prj.Tree.Environment;
Stop_Compile : Boolean;
with Csets;
with Hostparm;
+with Makeutl; use Makeutl;
with Opt;
with Output;
with Osint; use Osint;
Tree : constant Project_Node_Tree_Ref := new Project_Node_Tree_Data;
-- The project tree where the project file is parsed
- Root_Environment : Prj.Tree.Environment;
-
Args : Argument_List_Access;
-- The list of arguments for calls to the compiler to get the unit names
-- and kinds (spec or body) in the Ada sources.
pragma No_Return (Error_Attr);
-- Like Error_Attr, but error is posted at the start of the prefix
- procedure S14_Attribute;
- -- Called for all attributes defined for formal verification to check
- -- that the S14_Extensions flag is set.
- -- Bad name ???
- -- No such thing as S14_Extensions flag ???
-
procedure Standard_Attribute (Val : Int);
-- Used to process attributes whose prefix is package Standard which
-- yield values of type Universal_Integer. The attribute reference
Set_Etype (N, Standard_Boolean);
end Legal_Formal_Attribute;
- -------------------
- -- S14_Attribute --
- -------------------
-
- procedure S14_Attribute is
- begin
- if not Formal_Extensions then
- Error_Attr
- ("attribute % requires the use of debug switch -gnatd.V", N);
- end if;
- end S14_Attribute;
-
------------------------
-- Standard_Attribute --
------------------------
-- Start of processing for Update
begin
- S14_Attribute;
Check_E1;
if not Is_Object_Reference (P) then
Dynamic_Predicate_Present : Boolean := False;
-- Set True if a dynamic predicate is present, results in the entire
- -- predicate being considered dynamic even if it looks static
+ -- predicate being considered dynamic even if it looks static.
Static_Predicate_Present : Node_Id := Empty;
-- Set to N_Pragma node for a static predicate if one is encountered
if Present (T) and then Present (Predicate_Function (T)) then
Set_Has_Predicates (Typ);
+ -- Capture the nature of the inherited ancestor predicate
+
+ if Has_Dynamic_Predicate_Aspect (T) then
+ Dynamic_Predicate_Present := True;
+ end if;
+
-- Build the call to the predicate function of T
Exp :=
if Nkind (Ritem) = N_Pragma
and then Pragma_Name (Ritem) = Name_Predicate
then
+ -- Capture the nature of the predicate
+
if Present (Corresponding_Aspect (Ritem)) then
case Chars (Identifier (Corresponding_Aspect (Ritem))) is
when Name_Dynamic_Predicate =>
end;
end if;
- -- Deal with static predicate case
+ if Is_Scalar_Type (Typ) then
- -- ??? We don't currently deal with real types
- -- ??? Why requiring that Typ is static?
+ -- Attempt to build a static predicate for a discrete or a real
+ -- subtype. This action may fail because the actual expression may
+ -- not be static.
- if Ekind (Typ) in Discrete_Kind
- and then Is_Static_Subtype (Typ)
- and then not Dynamic_Predicate_Present
- then
- -- Only build the predicate for subtypes
-
- if Ekind_In (Typ, E_Enumeration_Subtype,
+ if Ekind_In (Typ, E_Decimal_Fixed_Point_Subtype,
+ E_Enumeration_Subtype,
+ E_Floating_Point_Subtype,
E_Modular_Integer_Subtype,
+ E_Ordinary_Fixed_Point_Subtype,
E_Signed_Integer_Subtype)
then
Build_Static_Predicate (Typ, Expr, Object_Name);
+ -- The predicate is categorized as static but its expression is
+ -- dynamic. Note that the predicate may become non-static when
+ -- inherited dynamic predicates are involved.
+
if Present (Static_Predicate_Present)
- and No (Static_Predicate (Typ))
+ and then No (Static_Predicate (Typ))
+ and then not Dynamic_Predicate_Present
then
Error_Msg_F
("expression does not have required form for "
Set_Etype (DS, Entity (DS));
end if;
- -- Attempt to iterate through non-static predicate
+ -- Attempt to iterate through non-static predicate. Note that a type
+ -- with inherited predicates may have both static and dynamic forms.
+ -- In this case it is not sufficent to check the static predicate
+ -- function only, look for a dynamic predicate aspect as well.
if Is_Discrete_Type (Entity (DS))
and then Present (Predicate_Function (Entity (DS)))
- and then No (Static_Predicate (Entity (DS)))
+ and then (No (Static_Predicate (Entity (DS)))
+ or else Has_Dynamic_Predicate_Aspect (Entity (DS)))
then
Bad_Predicated_Subtype_Use
("cannot use subtype& with non-static predicate for loop " &
begin
if Is_Entity_Name (N)
+ and then Present (Entity (N))
and then Is_Formal (Entity (N))
and then Nkind (Parent (N)) /= N_Type_Conversion
then
elsif (Nkind (N) = N_Function_Call
and then Nkind (Name (N)) = N_Expanded_Name
and then (Chars (Predef_Subp) /= Name_Op_Expon
- or else Hides_Op (User_Subp, Predef_Subp))
+ or else Hides_Op (User_Subp, Predef_Subp))
and then Scope (User_Subp) = Entity (Prefix (Name (N))))
or else Hides_Op (User_Subp, Predef_Subp)
then
and then Nam_In (Chars (Nam1), Name_Op_Multiply, Name_Op_Divide)
and then
(Ada_Version = Ada_83
- or else
- (Ada_Version >= Ada_2012
- and then
- In_Same_Declaration_List
- (First_Subtype (Typ),
- Unit_Declaration_Node (User_Subp))))
+ or else (Ada_Version >= Ada_2012
+ and then In_Same_Declaration_List
+ (First_Subtype (Typ),
+ Unit_Declaration_Node (User_Subp))))
then
if It2.Nam = Predef_Subp then
return It1;
projects / gcc.git / commitdiff