[multiple changes]
2012-03-15 Robert Dewar <dewar@adacore.com> * par-ch6.adb, einfo.ads, sem_eval.adb, sem_eval.ads, sem_case.adb: Minor reformatting. 2012-03-15 Robert Dewar <dewar@adacore.com> * exp_attr.adb (Expand_N_Attribute_Reference): Add handling of First_Valid/Last_Valid. * sem_attr.adb (Check_First_Last_Valid): New procedure (Analyze_Attribute): Add handling of First_Valid and Last_Valid (Eval_Attribute): ditto. * snames.ads-tmpl: Add entries for First_Valid and Last_Valid. 2012-03-15 Ed Schonberg <schonberg@adacore.com> * exp_ch5.adb (Expand_Predicated_Loop): Suppress warnings on loop variable, for the unusual case where the range has a single element and the loop variable has no visible assignment to it. 2012-03-15 Vincent Pucci <pucci@adacore.com> * exp_ch4.adb (Expand_N_Quantified_Expression): Expand the original quantified expression node. * sem_ch4.adb (Analyze_Quantified_Expression): Properly analyze the quantified expression and preserve the original non-analyzed quantified expression when an expansion is needed. * sem_ch5.adb (Analyze_Iteration_Scheme): Special treatment for quantified expressions. (Analyze_Iterator_Specification): Special treatment for quantified expressions. 2012-03-15 Ed Falis <falis@adacore.com> * s-vxwork-ppc.ads: Update FP_CONTEXT so name of former pad field matches VxWorks headers. From-SVN: r185409
This commit is contained in:
parent
5457d860af
commit
011f9d5d67
@ -1,3 +1,40 @@
|
||||
2012-03-15 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* par-ch6.adb, einfo.ads, sem_eval.adb, sem_eval.ads,
|
||||
sem_case.adb: Minor reformatting.
|
||||
|
||||
2012-03-15 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* exp_attr.adb (Expand_N_Attribute_Reference): Add handling
|
||||
of First_Valid/Last_Valid.
|
||||
* sem_attr.adb (Check_First_Last_Valid): New procedure
|
||||
(Analyze_Attribute): Add handling of First_Valid and Last_Valid
|
||||
(Eval_Attribute): ditto.
|
||||
* snames.ads-tmpl: Add entries for First_Valid and Last_Valid.
|
||||
|
||||
2012-03-15 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_ch5.adb (Expand_Predicated_Loop): Suppress warnings on
|
||||
loop variable, for the unusual case where the range has a single
|
||||
element and the loop variable has no visible assignment to it.
|
||||
|
||||
2012-03-15 Vincent Pucci <pucci@adacore.com>
|
||||
|
||||
* exp_ch4.adb (Expand_N_Quantified_Expression): Expand the
|
||||
original quantified expression node.
|
||||
* sem_ch4.adb (Analyze_Quantified_Expression): Properly analyze
|
||||
the quantified expression and preserve the original non-analyzed
|
||||
quantified expression when an expansion is needed.
|
||||
* sem_ch5.adb (Analyze_Iteration_Scheme): Special treatment
|
||||
for quantified expressions.
|
||||
(Analyze_Iterator_Specification): Special treatment for quantified
|
||||
expressions.
|
||||
|
||||
2012-03-15 Ed Falis <falis@adacore.com>
|
||||
|
||||
* s-vxwork-ppc.ads: Update FP_CONTEXT so name of former pad
|
||||
field matches VxWorks headers.
|
||||
|
||||
2012-03-14 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
|
||||
|
||||
* gcc-interface/Makefile.in (mips-sgi-irix6*): Remove.
|
||||
|
@ -3682,13 +3682,14 @@ package Einfo is
|
||||
|
||||
-- Static_Predicate (List25)
|
||||
-- Present in discrete types/subtypes with predicates (Has_Predicates
|
||||
-- set True). Points to a list of expression and N_Range nodes that
|
||||
-- represent the predicate in canonical form. The canonical form has
|
||||
-- entries sorted in ascending order, with all duplicates eliminated,
|
||||
-- and adjacent ranges coalesced, so that there is always a gap in the
|
||||
-- values between successive entries. The entries in this list are
|
||||
-- fully analyzed and typed with the base type of the subtype. Note
|
||||
-- that all entries are static and have values within the subtype range.
|
||||
-- set True). Set if the type/subtype has a static predicate. Points to
|
||||
-- a list of expression and N_Range nodes that represent the predicate
|
||||
-- in canonical form. The canonical form has entries sorted in ascending
|
||||
-- order, with duplicates eliminated, and adjacent ranges coalesced, so
|
||||
-- that there is always a gap in the values between successive entries.
|
||||
-- The entries in this list are fully analyzed and typed with the base
|
||||
-- type of the subtype. Note that all entries are static and have values
|
||||
-- within the subtype range.
|
||||
|
||||
-- Storage_Size_Variable (Node15) [implementation base type only]
|
||||
-- Present in access types and task type entities. This flag is set
|
||||
|
@ -5701,10 +5701,12 @@ package body Exp_Attr is
|
||||
Attribute_Enabled |
|
||||
Attribute_Epsilon |
|
||||
Attribute_Fast_Math |
|
||||
Attribute_First_Valid |
|
||||
Attribute_Has_Access_Values |
|
||||
Attribute_Has_Discriminants |
|
||||
Attribute_Has_Tagged_Values |
|
||||
Attribute_Large |
|
||||
Attribute_Last_Valid |
|
||||
Attribute_Machine_Emax |
|
||||
Attribute_Machine_Emin |
|
||||
Attribute_Machine_Mantissa |
|
||||
|
@ -7891,9 +7891,22 @@ package body Exp_Ch4 is
|
||||
Cond : Node_Id;
|
||||
Decl : Node_Id;
|
||||
I_Scheme : Node_Id;
|
||||
Original_N : Node_Id;
|
||||
Test : Node_Id;
|
||||
|
||||
begin
|
||||
-- Retrieve the original quantified expression (non analyzed)
|
||||
|
||||
if Present (Loop_Parameter_Specification (N)) then
|
||||
Original_N := Parent (Parent (Loop_Parameter_Specification (N)));
|
||||
else
|
||||
Original_N := Parent (Parent (Iterator_Specification (N)));
|
||||
end if;
|
||||
|
||||
-- Rewrite N with the original quantified expression
|
||||
|
||||
Rewrite (N, Original_N);
|
||||
|
||||
Decl :=
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Tnn,
|
||||
@ -7904,13 +7917,6 @@ package body Exp_Ch4 is
|
||||
|
||||
Cond := Relocate_Node (Condition (N));
|
||||
|
||||
-- Reset flag analyzed in the condition to force its analysis. Required
|
||||
-- since the previous analysis was done with expansion disabled (see
|
||||
-- Resolve_Quantified_Expression) and hence checks were not inserted
|
||||
-- and record comparisons have not been expanded.
|
||||
|
||||
Reset_Analyzed_Flags (Cond);
|
||||
|
||||
if Is_Universal then
|
||||
Cond := Make_Op_Not (Loc, Cond);
|
||||
end if;
|
||||
@ -7926,9 +7932,14 @@ package body Exp_Ch4 is
|
||||
Make_Exit_Statement (Loc)));
|
||||
|
||||
if Present (Loop_Parameter_Specification (N)) then
|
||||
I_Scheme := Relocate_Node (Parent (Loop_Parameter_Specification (N)));
|
||||
I_Scheme :=
|
||||
Make_Iteration_Scheme (Loc,
|
||||
Loop_Parameter_Specification =>
|
||||
Loop_Parameter_Specification (N));
|
||||
else
|
||||
I_Scheme := Relocate_Node (Parent (Iterator_Specification (N)));
|
||||
I_Scheme :=
|
||||
Make_Iteration_Scheme (Loc,
|
||||
Iterator_Specification => Iterator_Specification (N));
|
||||
end if;
|
||||
|
||||
Append_To (Actions,
|
||||
|
@ -3759,6 +3759,14 @@ package body Exp_Ch5 is
|
||||
Set_Analyzed (Loop_Id, False);
|
||||
Set_Ekind (Loop_Id, E_Variable);
|
||||
|
||||
-- In most loops the loop variable is assigned in various
|
||||
-- alternatives in the body. However, in the rare case when
|
||||
-- the range specifies a single element, the loop variable
|
||||
-- may trigger a spurious warning that is could be constant.
|
||||
-- This warning might as well be suppressed.
|
||||
|
||||
Set_Warnings_Off (Loop_Id);
|
||||
|
||||
-- Loop to create branches of case statement
|
||||
|
||||
Alts := New_List;
|
||||
|
@ -128,7 +128,8 @@ package body Ch6 is
|
||||
-- other subprogram constructs.
|
||||
|
||||
-- EXPRESSION_FUNCTION ::=
|
||||
-- FUNCTION SPECIFICATION IS (EXPRESSION);
|
||||
-- FUNCTION SPECIFICATION IS (EXPRESSION)
|
||||
-- [ASPECT_SPECIFICATIONS];
|
||||
|
||||
-- The value in Pf_Flags indicates which of these possible declarations
|
||||
-- is acceptable to the caller:
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1998-2011, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNARL is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -44,9 +44,9 @@ package System.VxWorks is
|
||||
type Fpr_Array is array (1 .. FP_NUM_DREGS) of IC.double;
|
||||
|
||||
type FP_CONTEXT is record
|
||||
fpr : Fpr_Array;
|
||||
fpcsr : IC.int;
|
||||
pad : IC.int;
|
||||
fpr : Fpr_Array;
|
||||
fpcsr : IC.int;
|
||||
fpcsrCopy : IC.int;
|
||||
end record;
|
||||
pragma Convention (C, FP_CONTEXT);
|
||||
|
||||
|
@ -217,9 +217,13 @@ package body Sem_Attr is
|
||||
-- allowed with a type that has predicates. If the type is a generic
|
||||
-- actual, then the message is a warning, and we generate code to raise
|
||||
-- program error with an appropriate reason. No error message is given
|
||||
-- for internally generated uses of the attributes.
|
||||
-- The legality rule only applies to scalar types, even though the
|
||||
-- current AI mentions all subtypes.
|
||||
-- for internally generated uses of the attributes. This legality rule
|
||||
-- only applies to scalar types.
|
||||
|
||||
procedure Check_Ada_2012_Attribute;
|
||||
-- Check that we are in Ada 2012 mode for an Ada 2012 attribute, and
|
||||
-- issue appropriate messages if not (and return to caller even in
|
||||
-- the error case).
|
||||
|
||||
procedure Check_Array_Or_Scalar_Type;
|
||||
-- Common procedure used by First, Last, Range attribute to check
|
||||
@ -270,6 +274,9 @@ package body Sem_Attr is
|
||||
-- reference when analyzing an inlined body will lose a proper warning
|
||||
-- on a useless with_clause.
|
||||
|
||||
procedure Check_First_Last_Valid;
|
||||
-- Perform all checks for First_Valid and Last_Valid attributes
|
||||
|
||||
procedure Check_Fixed_Point_Type;
|
||||
-- Verify that prefix of attribute N is a fixed type
|
||||
|
||||
@ -862,6 +869,21 @@ package body Sem_Attr is
|
||||
end if;
|
||||
end Bad_Attribute_For_Predicate;
|
||||
|
||||
------------------------------
|
||||
-- Check_Ada_2012_Attribute --
|
||||
------------------------------
|
||||
|
||||
procedure Check_Ada_2012_Attribute is
|
||||
begin
|
||||
if Ada_Version < Ada_2012 then
|
||||
Error_Msg_Name_1 := Aname;
|
||||
Error_Msg_N
|
||||
("attribute % is an Ada 2012 feature", N);
|
||||
Error_Msg_N
|
||||
("\unit must be compiled with -gnat2012 switch", N);
|
||||
end if;
|
||||
end Check_Ada_2012_Attribute;
|
||||
|
||||
--------------------------------
|
||||
-- Check_Array_Or_Scalar_Type --
|
||||
--------------------------------
|
||||
@ -1244,6 +1266,37 @@ package body Sem_Attr is
|
||||
end if;
|
||||
end Check_Enum_Image;
|
||||
|
||||
----------------------------
|
||||
-- Check_First_Last_Valid --
|
||||
----------------------------
|
||||
|
||||
procedure Check_First_Last_Valid is
|
||||
begin
|
||||
Check_Ada_2012_Attribute;
|
||||
Check_Discrete_Type;
|
||||
|
||||
if not Is_Static_Subtype (P_Type) then
|
||||
Error_Attr_P ("prefix of % attribute must be a static subtype");
|
||||
end if;
|
||||
|
||||
if Has_Predicates (P_Type)
|
||||
and then No (Static_Predicate (P_Type))
|
||||
then
|
||||
Error_Attr_P
|
||||
("prefix of % attribute may not have dynamic predicate");
|
||||
end if;
|
||||
|
||||
if Expr_Value (Type_Low_Bound (P_Type)) >
|
||||
Expr_Value (Type_High_Bound (P_Type))
|
||||
or else (Has_Predicates (P_Type)
|
||||
and then Is_Empty_List (Static_Predicate (P_Type)))
|
||||
then
|
||||
Error_Attr_P
|
||||
("prefix of % attribute must be subtype with "
|
||||
& "at least one value");
|
||||
end if;
|
||||
end Check_First_Last_Valid;
|
||||
|
||||
----------------------------
|
||||
-- Check_Fixed_Point_Type --
|
||||
----------------------------
|
||||
@ -3240,6 +3293,14 @@ package body Sem_Attr is
|
||||
Check_Component;
|
||||
Set_Etype (N, Universal_Integer);
|
||||
|
||||
-----------------
|
||||
-- First_Valid --
|
||||
-----------------
|
||||
|
||||
when Attribute_First_Valid =>
|
||||
Check_First_Last_Valid;
|
||||
Set_Etype (N, P_Type);
|
||||
|
||||
-----------------
|
||||
-- Fixed_Value --
|
||||
-----------------
|
||||
@ -3456,6 +3517,14 @@ package body Sem_Attr is
|
||||
Check_Component;
|
||||
Set_Etype (N, Universal_Integer);
|
||||
|
||||
----------------
|
||||
-- Last_Valid --
|
||||
----------------
|
||||
|
||||
when Attribute_Last_Valid =>
|
||||
Check_First_Last_Valid;
|
||||
Set_Etype (N, P_Type);
|
||||
|
||||
------------------
|
||||
-- Leading_Part --
|
||||
------------------
|
||||
@ -3928,12 +3997,7 @@ package body Sem_Attr is
|
||||
----------------------
|
||||
|
||||
when Attribute_Overlaps_Storage =>
|
||||
if Ada_Version < Ada_2012 then
|
||||
Error_Msg_N
|
||||
("attribute Overlaps_Storage is an Ada 2012 feature", N);
|
||||
Error_Msg_N
|
||||
("\unit must be compiled with -gnat2012 switch", N);
|
||||
end if;
|
||||
Check_Ada_2012_Attribute;
|
||||
Check_E1;
|
||||
|
||||
-- Both arguments must be objects of any type
|
||||
@ -4425,13 +4489,7 @@ package body Sem_Attr is
|
||||
------------------
|
||||
|
||||
when Attribute_Same_Storage =>
|
||||
if Ada_Version < Ada_2012 then
|
||||
Error_Msg_N
|
||||
("attribute Same_Storage is an Ada 2012 feature", N);
|
||||
Error_Msg_N
|
||||
("\unit must be compiled with -gnat2012 switch", N);
|
||||
end if;
|
||||
|
||||
Check_Ada_2012_Attribute;
|
||||
Check_E1;
|
||||
|
||||
-- The arguments must be objects of any type
|
||||
@ -5388,10 +5446,11 @@ package body Sem_Attr is
|
||||
-- Used for First, Last and Length attributes applied to an array or
|
||||
-- array subtype. Sets the variables Lo_Bound and Hi_Bound to the low
|
||||
-- and high bound expressions for the index referenced by the attribute
|
||||
-- designator (i.e. the first index if no expression is present, and
|
||||
-- the N'th index if the value N is present as an expression). Also
|
||||
-- used for First and Last of scalar types. Static is reset to False
|
||||
-- if the type or index type is not statically constrained.
|
||||
-- designator (i.e. the first index if no expression is present, and the
|
||||
-- N'th index if the value N is present as an expression). Also used for
|
||||
-- First and Last of scalar types and for First_Valid and Last_Valid.
|
||||
-- Static is reset to False if the type or index type is not statically
|
||||
-- constrained.
|
||||
|
||||
function Statically_Denotes_Entity (N : Node_Id) return Boolean;
|
||||
-- Verify that the prefix of a potentially static array attribute
|
||||
@ -6459,6 +6518,31 @@ package body Sem_Attr is
|
||||
end if;
|
||||
end First_Attr;
|
||||
|
||||
-----------------
|
||||
-- First_Valid --
|
||||
-----------------
|
||||
|
||||
when Attribute_First_Valid => First_Valid :
|
||||
begin
|
||||
if Has_Predicates (P_Type)
|
||||
and then Present (Static_Predicate (P_Type))
|
||||
then
|
||||
declare
|
||||
FirstN : constant Node_Id := First (Static_Predicate (P_Type));
|
||||
begin
|
||||
if Nkind (FirstN) = N_Range then
|
||||
Fold_Uint (N, Expr_Value (Low_Bound (FirstN)), Static);
|
||||
else
|
||||
Fold_Uint (N, Expr_Value (FirstN), Static);
|
||||
end if;
|
||||
end;
|
||||
|
||||
else
|
||||
Set_Bounds;
|
||||
Fold_Uint (N, Expr_Value (Lo_Bound), Static);
|
||||
end if;
|
||||
end First_Valid;
|
||||
|
||||
-----------------
|
||||
-- Fixed_Value --
|
||||
-----------------
|
||||
@ -6634,7 +6718,7 @@ package body Sem_Attr is
|
||||
-- Last --
|
||||
----------
|
||||
|
||||
when Attribute_Last => Last :
|
||||
when Attribute_Last => Last_Attr :
|
||||
begin
|
||||
Set_Bounds;
|
||||
|
||||
@ -6658,7 +6742,32 @@ package body Sem_Attr is
|
||||
else
|
||||
Check_Concurrent_Discriminant (Hi_Bound);
|
||||
end if;
|
||||
end Last;
|
||||
end Last_Attr;
|
||||
|
||||
----------------
|
||||
-- Last_Valid --
|
||||
----------------
|
||||
|
||||
when Attribute_Last_Valid => Last_Valid :
|
||||
begin
|
||||
if Has_Predicates (P_Type)
|
||||
and then Present (Static_Predicate (P_Type))
|
||||
then
|
||||
declare
|
||||
LastN : constant Node_Id := Last (Static_Predicate (P_Type));
|
||||
begin
|
||||
if Nkind (LastN) = N_Range then
|
||||
Fold_Uint (N, Expr_Value (High_Bound (LastN)), Static);
|
||||
else
|
||||
Fold_Uint (N, Expr_Value (LastN), Static);
|
||||
end if;
|
||||
end;
|
||||
|
||||
else
|
||||
Set_Bounds;
|
||||
Fold_Uint (N, Expr_Value (Hi_Bound), Static);
|
||||
end if;
|
||||
end Last_Valid;
|
||||
|
||||
------------------
|
||||
-- Leading_Part --
|
||||
@ -8568,14 +8677,13 @@ package body Sem_Attr is
|
||||
if Ada_Version >= Ada_2005
|
||||
and then (Is_Local_Anonymous_Access (Btyp)
|
||||
|
||||
-- Handle cases where Btyp is the
|
||||
-- anonymous access type of an Ada 2012
|
||||
-- stand-alone object.
|
||||
-- Handle cases where Btyp is the anonymous access
|
||||
-- type of an Ada 2012 stand-alone object.
|
||||
|
||||
or else Nkind (Associated_Node_For_Itype (Btyp)) =
|
||||
N_Object_Declaration)
|
||||
and then Object_Access_Level (P)
|
||||
> Deepest_Type_Access_Level (Btyp)
|
||||
and then
|
||||
Object_Access_Level (P) > Deepest_Type_Access_Level (Btyp)
|
||||
and then Attr_Id = Attribute_Access
|
||||
then
|
||||
-- In an instance, this is a runtime check, but one we
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1996-2010, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1996-2012, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -530,8 +530,8 @@ package body Sem_Case is
|
||||
begin
|
||||
if Case_Table'Last = 0 then
|
||||
|
||||
-- Special case: only an others case is present.
|
||||
-- The others case covers the full range of the type.
|
||||
-- Special case: only an others case is present. The others case
|
||||
-- covers the full range of the type.
|
||||
|
||||
if Is_Static_Subtype (Choice_Type) then
|
||||
Choice := New_Occurrence_Of (Choice_Type, Loc);
|
||||
@ -543,8 +543,8 @@ package body Sem_Case is
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Establish the bound values for the choice depending upon whether
|
||||
-- the type of the case statement is static or not.
|
||||
-- Establish the bound values for the choice depending upon whether the
|
||||
-- type of the case statement is static or not.
|
||||
|
||||
if Is_OK_Static_Subtype (Choice_Type) then
|
||||
Exp_Lo := Type_Low_Bound (Choice_Type);
|
||||
|
@ -3390,14 +3390,25 @@ package body Sem_Ch4 is
|
||||
-----------------------------------
|
||||
|
||||
procedure Analyze_Quantified_Expression (N : Node_Id) is
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Ent : constant Entity_Id :=
|
||||
New_Internal_Entity
|
||||
(E_Loop, Current_Scope, Sloc (N), 'L');
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Ent : constant Entity_Id :=
|
||||
New_Internal_Entity
|
||||
(E_Loop, Current_Scope, Sloc (N), 'L');
|
||||
Needs_Expansion : constant Boolean :=
|
||||
Operating_Mode /= Check_Semantics
|
||||
and then not Alfa_Mode;
|
||||
|
||||
Iterator : Node_Id;
|
||||
Iterator : Node_Id;
|
||||
Original_N : Node_Id;
|
||||
|
||||
begin
|
||||
-- Preserve the original node used for the expansion of the quantified
|
||||
-- expression.
|
||||
|
||||
if Needs_Expansion then
|
||||
Original_N := Copy_Separate_Tree (N);
|
||||
end if;
|
||||
|
||||
Set_Etype (Ent, Standard_Void_Type);
|
||||
Set_Scope (Ent, Current_Scope);
|
||||
Set_Parent (Ent, N);
|
||||
@ -3433,7 +3444,15 @@ package body Sem_Ch4 is
|
||||
|
||||
Analyze (Condition (N));
|
||||
End_Scope;
|
||||
|
||||
Set_Etype (N, Standard_Boolean);
|
||||
|
||||
-- Attach the original node to the iteration scheme created above
|
||||
|
||||
if Needs_Expansion then
|
||||
Set_Etype (Original_N, Standard_Boolean);
|
||||
Set_Parent (Iterator, Original_N);
|
||||
end if;
|
||||
end Analyze_Quantified_Expression;
|
||||
|
||||
-------------------
|
||||
|
@ -2087,7 +2087,17 @@ package body Sem_Ch5 is
|
||||
|
||||
Check_Controlled_Array_Attribute (DS);
|
||||
|
||||
Make_Index (DS, LP, In_Iter_Schm => True);
|
||||
-- The index is not processed during the analysis of a
|
||||
-- quantified expression but delayed to its expansion where the
|
||||
-- quantified expression is transformed into an expression with
|
||||
-- actions.
|
||||
|
||||
if Nkind (Parent (N)) /= N_Quantified_Expression
|
||||
or else Operating_Mode = Check_Semantics
|
||||
or else Alfa_Mode
|
||||
then
|
||||
Make_Index (DS, LP, In_Iter_Schm => True);
|
||||
end if;
|
||||
|
||||
Set_Ekind (Id, E_Loop_Parameter);
|
||||
|
||||
@ -2097,14 +2107,7 @@ package body Sem_Ch5 is
|
||||
-- because the second one may be created in a different scope,
|
||||
-- e.g. a precondition procedure, leading to a crash in GIGI.
|
||||
|
||||
-- Note that if the parent node is a quantified expression,
|
||||
-- this preservation is delayed until the expansion of the
|
||||
-- quantified expression where the node is rewritten as an
|
||||
-- expression with actions.
|
||||
|
||||
if (No (Etype (Id)) or else Etype (Id) = Any_Type)
|
||||
and then Nkind (Parent (N)) /= N_Quantified_Expression
|
||||
then
|
||||
if No (Etype (Id)) or else Etype (Id) = Any_Type then
|
||||
Set_Etype (Id, Etype (DS));
|
||||
end if;
|
||||
|
||||
@ -2241,14 +2244,14 @@ package body Sem_Ch5 is
|
||||
-- If domain of iteration is an expression, create a declaration for
|
||||
-- it, so that finalization actions are introduced outside of the loop.
|
||||
-- The declaration must be a renaming because the body of the loop may
|
||||
-- assign to elements.
|
||||
|
||||
-- Note that if the parent node is a quantified expression, this
|
||||
-- declaration is created during the expansion of the quantified
|
||||
-- expression where the node is rewritten as an expression with actions.
|
||||
-- assign to elements. In case of a quantified expression, this
|
||||
-- declaration is delayed to its expansion where the node is rewritten
|
||||
-- as an expression with actions.
|
||||
|
||||
if not Is_Entity_Name (Iter_Name)
|
||||
and then Nkind (Parent (Parent (N))) /= N_Quantified_Expression
|
||||
and then (Nkind (Parent (Parent (N))) /= N_Quantified_Expression
|
||||
or else Operating_Mode = Check_Semantics
|
||||
or else Alfa_Mode)
|
||||
then
|
||||
declare
|
||||
Id : constant Entity_Id := Make_Temporary (Loc, 'R', Iter_Name);
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -4310,8 +4310,8 @@ package body Sem_Eval is
|
||||
return
|
||||
Ekind (Typ) = E_String_Literal_Subtype
|
||||
or else
|
||||
(Is_OK_Static_Subtype (Component_Type (Typ))
|
||||
and then Is_OK_Static_Subtype (Etype (First_Index (Typ))));
|
||||
(Is_OK_Static_Subtype (Component_Type (Typ))
|
||||
and then Is_OK_Static_Subtype (Etype (First_Index (Typ))));
|
||||
|
||||
-- Scalar types
|
||||
|
||||
@ -4401,9 +4401,8 @@ package body Sem_Eval is
|
||||
elsif Is_String_Type (Typ) then
|
||||
return
|
||||
Ekind (Typ) = E_String_Literal_Subtype
|
||||
or else
|
||||
(Is_Static_Subtype (Component_Type (Typ))
|
||||
and then Is_Static_Subtype (Etype (First_Index (Typ))));
|
||||
or else (Is_Static_Subtype (Component_Type (Typ))
|
||||
and then Is_Static_Subtype (Etype (First_Index (Typ))));
|
||||
|
||||
-- Scalar types
|
||||
|
||||
|
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
@ -196,7 +196,15 @@ package Sem_Eval is
|
||||
|
||||
function Is_Static_Subtype (Typ : Entity_Id) return Boolean;
|
||||
-- Determines whether a subtype fits the definition of an Ada static
|
||||
-- subtype as given in (RM 4.9(26)).
|
||||
-- subtype as given in (RM 4.9(26)). Important note: This check does not
|
||||
-- include the Ada 2012 case of a non-static predicate which results in an
|
||||
-- otherwise static subtype being non-static. Such a subtype will return
|
||||
-- True for this test, so if the distinction is important, the caller must
|
||||
-- deal with this.
|
||||
--
|
||||
-- Implementation note: an attempt to include this Ada 2012 case failed,
|
||||
-- since it appears that this routine is called in some cases before the
|
||||
-- Static_Predicate field is set ???
|
||||
|
||||
function Is_OK_Static_Subtype (Typ : Entity_Id) return Boolean;
|
||||
-- Like Is_Static_Subtype but also makes sure that the bounds of the
|
||||
|
@ -770,6 +770,7 @@ package Snames is
|
||||
Name_Fast_Math : constant Name_Id := N + $; -- GNAT
|
||||
Name_First : constant Name_Id := N + $;
|
||||
Name_First_Bit : constant Name_Id := N + $;
|
||||
Name_First_Valid : constant Name_Id := N + $; -- Ada 12
|
||||
Name_Fixed_Value : constant Name_Id := N + $; -- GNAT
|
||||
Name_Fore : constant Name_Id := N + $;
|
||||
Name_Has_Access_Values : constant Name_Id := N + $; -- GNAT
|
||||
@ -784,6 +785,7 @@ package Snames is
|
||||
Name_Large : constant Name_Id := N + $; -- Ada 83
|
||||
Name_Last : constant Name_Id := N + $;
|
||||
Name_Last_Bit : constant Name_Id := N + $;
|
||||
Name_Last_Valid : constant Name_Id := N + $; -- Ada 12
|
||||
Name_Leading_Part : constant Name_Id := N + $;
|
||||
Name_Length : constant Name_Id := N + $;
|
||||
Name_Machine_Emax : constant Name_Id := N + $;
|
||||
@ -1332,6 +1334,7 @@ package Snames is
|
||||
Attribute_Fast_Math,
|
||||
Attribute_First,
|
||||
Attribute_First_Bit,
|
||||
Attribute_First_Valid,
|
||||
Attribute_Fixed_Value,
|
||||
Attribute_Fore,
|
||||
Attribute_Has_Access_Values,
|
||||
@ -1346,6 +1349,7 @@ package Snames is
|
||||
Attribute_Large,
|
||||
Attribute_Last,
|
||||
Attribute_Last_Bit,
|
||||
Attribute_Last_Valid,
|
||||
Attribute_Leading_Part,
|
||||
Attribute_Length,
|
||||
Attribute_Machine_Emax,
|
||||
|
Loading…
Reference in New Issue
Block a user