2012-03-07 Ed Schonberg <schonberg@adacore.com>
* checks.adb (Apply_Predicate_Check): Do not generate a predicate
check is the context is an internally generated type-specific
function.
* sem_ch6.adb (Process_PPCs); the formals of internally generated
type-specific functions do not get assertion checks.
2012-03-07 Yannick Moy <moy@adacore.com>
* gnat_rm.texi: Minor renaming of title.
* gnat_ugn.texi: Minor correction.
2012-03-07 Vincent Pucci <pucci@adacore.com>
* exp_ch4.adb (Expand_N_Quantified_Expression): Minor
reformating.
* sem_ch4.adb (Analyze_Quantified_Expression): Creation and
analysis of the iteration scheme added in all cases.
* sem_ch5.adb (Analyze_Iteration_Scheme): Minor reformating.
(Analyze_Iterator_Specification): Minor reformating.
* sem_res.adb (Resolve_Quantified_Expression): Resolution of
the condition added in all cases.
From-SVN: r185050
+2012-03-07 Ed Schonberg <schonberg@adacore.com>
+
+ * checks.adb (Apply_Predicate_Check): Do not generate a predicate
+ check is the context is an internally generated type-specific
+ function.
+ * sem_ch6.adb (Process_PPCs); the formals of internally generated
+ type-specific functions do not get assertion checks.
+
+2012-03-07 Yannick Moy <moy@adacore.com>
+
+ * gnat_rm.texi: Minor renaming of title.
+ * gnat_ugn.texi: Minor correction.
+
+2012-03-07 Vincent Pucci <pucci@adacore.com>
+
+ * exp_ch4.adb (Expand_N_Quantified_Expression): Minor
+ reformating.
+ * sem_ch4.adb (Analyze_Quantified_Expression): Creation and
+ analysis of the iteration scheme added in all cases.
+ * sem_ch5.adb (Analyze_Iteration_Scheme): Minor reformating.
+ (Analyze_Iterator_Specification): Minor reformating.
+ * sem_res.adb (Resolve_Quantified_Expression): Resolution of
+ the condition added in all cases.
+
2012-03-07 Thomas Quinot <quinot@adacore.com>
* einfo.adb, einfo.ads: Add flag Reverse_Storage_Order.
-- --
-- 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- --
with Exp_Ch4; use Exp_Ch4;
with Exp_Ch11; use Exp_Ch11;
with Exp_Pakd; use Exp_Pakd;
+with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Elists; use Elists;
with Eval_Fat; use Eval_Fat;
---------------------------
procedure Apply_Predicate_Check (N : Node_Id; Typ : Entity_Id) is
+ S : Entity_Id;
begin
if Present (Predicate_Function (Typ)) then
- Insert_Action (N,
- Make_Predicate_Check (Typ, Duplicate_Subexpr (N)));
+
+ -- A predicate check does not apply within internally generated
+ -- subprograms, such as TSS functions.
+
+ S := Current_Scope;
+ while Present (S)
+ and then not Is_Subprogram (S)
+ loop
+ S := Scope (S);
+ end loop;
+
+ if Present (S)
+ and then Get_TSS_Name (S) /= TSS_Null
+ then
+ return;
+
+ else
+ Insert_Action (N,
+ Make_Predicate_Check (Typ, Duplicate_Subexpr (N)));
+ end if;
end if;
end Apply_Predicate_Check;
Make_Exit_Statement (Loc)));
if Present (Loop_Parameter_Specification (N)) then
- I_Scheme :=
- Make_Iteration_Scheme (Loc,
- Loop_Parameter_Specification =>
- Loop_Parameter_Specification (N));
+ I_Scheme := Relocate_Node (Parent (Loop_Parameter_Specification (N)));
else
- I_Scheme :=
- Make_Iteration_Scheme (Loc,
- Iterator_Specification => Iterator_Specification (N));
+ I_Scheme := Relocate_Node (Parent (Iterator_Specification (N)));
end if;
Append_To (Actions,
* About This Guide::
* Implementation Defined Pragmas::
* Implementation Defined Attributes::
-* Implementation Defined Restrictions::
+* Standard and Implementation Defined Restrictions::
* Implementation Advice::
* Implementation Defined Characteristics::
* Intrinsic Subprograms::
* Wchar_T_Size::
* Word_Size::
-Implementation Defined Restrictions
+Standard and Implementation Defined Restrictions
* Partition-Wide Restrictions::
* Program Unit Level Restrictions::
enhance the functionality of the compiler.
@item
-@ref{Implementation Defined Restrictions}, lists GNAT
+@ref{Standard and Implementation Defined Restrictions}, lists GNAT
implementation-dependent restrictions, which can be used to extend and
enhance the functionality of the compiler.
@code{Standard'Word_Size} (@code{Standard} is the only permissible
prefix) provides the value @code{System.Word_Size}.
-@node Implementation Defined Restrictions
-@chapter Implementation Defined Restrictions
+@node Standard and Implementation Defined Restrictions
+@chapter Standard and Implementation Defined Restrictions
@noindent
All RM defined Restriction identifiers are implemented:
@code{Restrictions}. See 13.12(7).
@end cartouche
@noindent
-@xref{Implementation Defined Restrictions}.
+@xref{Standard and Implementation Defined Restrictions}.
@sp 1
@cartouche
@table @option
@c !sort!
+@item -gnatw.a
@item -gnatwB
@item -gnatw.b
@item -gnatwC
Iterator : Node_Id;
begin
- Set_Etype (Ent, Standard_Void_Type);
+ Set_Etype (Ent, Standard_Void_Type);
Set_Scope (Ent, Current_Scope);
Set_Parent (Ent, N);
Check_SPARK_Restriction ("quantified expression is not allowed", N);
- -- If expansion is enabled (and not in Alfa mode), the condition is
- -- analyzed after rewritten as a loop. So we only need to set the type.
-
- if Operating_Mode /= Check_Semantics
- and then not Alfa_Mode
- then
- Set_Etype (N, Standard_Boolean);
- return;
- end if;
-
if Present (Loop_Parameter_Specification (N)) then
Iterator :=
Make_Iteration_Scheme (Loc,
Set_Iterator_Specification
(N, Iterator_Specification (Iterator));
Set_Loop_Parameter_Specification (N, Empty);
+ Set_Parent (Iterator_Specification (Iterator), Iterator);
end if;
Analyze (Condition (N));
-- --
-- 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- --
-- because the second one may be created in a different scope,
-- e.g. a precondition procedure, leading to a crash in GIGI.
- if No (Etype (Id)) or else Etype (Id) = Any_Type then
+ -- 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
Set_Etype (Id, Etype (DS));
end if;
end;
end Analyze_Iteration_Scheme;
- -------------------------------------
- -- Analyze_Iterator_Specification --
- -------------------------------------
+ ------------------------------------
+ -- Analyze_Iterator_Specification --
+ ------------------------------------
procedure Analyze_Iterator_Specification (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
Typ : Entity_Id;
begin
- -- In semantics/Alfa modes, we won't be further expanding the loop, so
- -- introduce loop variable so that loop body can be properly analyzed.
- -- Otherwise this happens after expansion.
-
- if Operating_Mode = Check_Semantics
- or else Alfa_Mode
- then
- Enter_Name (Def_Id);
- end if;
+ Enter_Name (Def_Id);
Set_Ekind (Def_Id, E_Variable);
-- The declaration must be a renaming because the body of the loop may
-- assign to elements.
- if not Is_Entity_Name (Iter_Name) then
+ -- 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.
+
+ if not Is_Entity_Name (Iter_Name)
+ and then Nkind (Parent (Parent (N))) /= N_Quantified_Expression
+ then
declare
Id : constant Entity_Id := Make_Temporary (Loc, 'R', Iter_Name);
Decl : Node_Id;
-- Iterate is not a reserved name. What matter is that the return type
-- of the function is an iterator type.
- else
+ elsif Is_Entity_Name (Iter_Name) then
Analyze (Iter_Name);
if Nkind (Iter_Name) = N_Function_Call then
Designator := Body_Id;
end if;
+ -- Internally generated subprograms, such as type-specific functions,
+ -- don't get assertions checks.
+
+ if Get_TSS_Name (Designator) /= TSS_Null then
+ return;
+ end if;
+
-- Grab preconditions from spec
if Present (Spec_Id) then
begin
if not Alfa_Mode then
- -- If expansion is enabled, analysis is delayed until the expresssion
- -- is rewritten as a loop.
-
- if Operating_Mode /= Check_Semantics then
- return;
- end if;
-
-- The loop structure is already resolved during its analysis, only
-- the resolution of the condition needs to be done. Expansion is
-- disabled so that checks and other generated code are inserted in
projects / thirdparty / gcc.git / commitdiff
