+2015-01-07 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch5.adb (Expand_Predicated_Loop): Handle properly loops
+ over static predicates when the loop parameter specification
+ carries a Reverse indicator.
+
+2015-01-07 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.adb (Instantiate_Object): If formal has a default,
+ actual is missing and formal has an anonymous access type, copy
+ access definition in full so that tree for instance is properly
+ formatted for ASIS use.
+
+2015-01-07 Bob Duff <duff@adacore.com>
+
+ * sem_elab.adb (Check_Internal_Call_Continue): Give a warning
+ for P'Access, where P is a subprogram in the same package as
+ the P'Access, and the P'Access is evaluated at elaboration
+ time, and occurs before the body of P. For example, "X : T :=
+ P'Access;" would allow a subsequent call to X.all to be an
+ access-before-elaboration error; hence the warning. This warning
+ is enabled by the -gnatw.f switch.
+ * opt.ads (Warn_On_Elab_Access): New flag for warning switch.
+ * warnsw.adb (Set_Dot_Warning_Switch): Set Warn_On_Elab_Access.
+ * gnat_ugn.texi: Document the new warning.
+
2015-01-07 Johannes Kanig <kanig@adacore.com>
* lib-xref-spark_specific.adb (Collect_SPARK_Xrefs): Skip unneeded
-- end loop;
-- end;
+ -- with min-val replaced by max-val and Succ replaced by Pred if the
+ -- loop parameter specification carries a Reverse indicator.
+
-- To make this a little clearer, let's take a specific example:
-- type Int is range 1 .. 10;
- -- subtype L is Int with
- -- predicate => L in 3 | 10 | 5 .. 7;
+ -- subtype StaticP is Int with
+ -- predicate => StaticP in 3 | 10 | 5 .. 7;
-- ...
-- for L in StaticP loop
-- Put_Line ("static:" & J'Img);
-- Loop to create branches of case statement
Alts := New_List;
- P := First (Stat);
- while Present (P) loop
- if No (Next (P)) then
- S := Make_Exit_Statement (Loc);
- else
- S :=
- Make_Assignment_Statement (Loc,
- Name => New_Occurrence_Of (Loop_Id, Loc),
- Expression => Lo_Val (Next (P)));
- Set_Suppress_Assignment_Checks (S);
- end if;
- Append_To (Alts,
- Make_Case_Statement_Alternative (Loc,
- Statements => New_List (S),
- Discrete_Choices => New_List (Hi_Val (P))));
+ if Reverse_Present (LPS) then
- Next (P);
- end loop;
+ -- Initial value is largest value in predicate.
+
+ D :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Loop_Id,
+ Object_Definition => New_Occurrence_Of (Ltype, Loc),
+ Expression => Hi_Val (Last (Stat)));
+
+ P := Last (Stat);
+ while Present (P) loop
+ if No (Prev (P)) then
+ S := Make_Exit_Statement (Loc);
+ else
+ S :=
+ Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Loop_Id, Loc),
+ Expression => Hi_Val (Prev (P)));
+ Set_Suppress_Assignment_Checks (S);
+ end if;
+
+ Append_To (Alts,
+ Make_Case_Statement_Alternative (Loc,
+ Statements => New_List (S),
+ Discrete_Choices => New_List (Lo_Val (P))));
+
+ Prev (P);
+ end loop;
+
+ else
+
+ -- Initial value is smallest value in predicate.
+
+ D :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Loop_Id,
+ Object_Definition => New_Occurrence_Of (Ltype, Loc),
+ Expression => Lo_Val (First (Stat)));
+
+ P := First (Stat);
+ while Present (P) loop
+ if No (Next (P)) then
+ S := Make_Exit_Statement (Loc);
+ else
+ S :=
+ Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Loop_Id, Loc),
+ Expression => Lo_Val (Next (P)));
+ Set_Suppress_Assignment_Checks (S);
+ end if;
+
+ Append_To (Alts,
+ Make_Case_Statement_Alternative (Loc,
+ Statements => New_List (S),
+ Discrete_Choices => New_List (Hi_Val (P))));
+
+ Next (P);
+ end loop;
+ end if;
-- Add others choice
- S :=
- Make_Assignment_Statement (Loc,
- Name => New_Occurrence_Of (Loop_Id, Loc),
- Expression =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Ltype, Loc),
- Attribute_Name => Name_Succ,
- Expressions => New_List (
- New_Occurrence_Of (Loop_Id, Loc))));
- Set_Suppress_Assignment_Checks (S);
+ declare
+ Name_Next : Name_Id;
+
+ begin
+ if Reverse_Present (LPS) then
+ Name_Next := Name_Pred;
+ else
+ Name_Next := Name_Succ;
+ end if;
+
+ S :=
+ Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Loop_Id, Loc),
+ Expression =>
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Ltype, Loc),
+ Attribute_Name => Name_Next,
+ Expressions => New_List (
+ New_Occurrence_Of (Loop_Id, Loc))));
+ Set_Suppress_Assignment_Checks (S);
+ end;
Append_To (Alts,
Make_Case_Statement_Alternative (Loc,
-- Rewrite the loop
- D :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Loop_Id,
- Object_Definition => New_Occurrence_Of (Ltype, Loc),
- Expression => Lo_Val (First (Stat)));
Set_Suppress_Assignment_Checks (D);
Rewrite (N,
effect of warning on unreferenced entities other than subprogram
formals.
+@item -gnatw.f
+@emph{Activate warnings on suspicious subprogram 'Access.}
+@cindex @option{-gnatw.f} (@command{gcc})
+This switch causes a warning to be generated if @code{P'Access} occurs
+in the same package where subprogram P is declared, and the
+@code{P'Access} is evaluated at elaboration time, and occurs before
+the body of P has been elaborated. For example, if we have
+@code{X : T := P'Access;}, then if X.all is subsequently called before
+the body of P is elaborated, it could cause
+access-before-elaboration. The default is that these warnings are not
+generated.
+
+@item -gnatw.F
+@emph{Suppress warnings on suspicious subprogram 'Access.}
+@cindex @option{-gnatw.F} (@command{gcc})
+This switch suppresses warnings for suspicious subprogram 'Access.
+
@item -gnatwg
@emph{Activate warnings on unrecognized pragmas.}
@cindex @option{-gnatwg} (@command{gcc})
-- Set to True to generate warnings for suspicious use of export or
-- import pragmas. Modified by use of -gnatwx/X.
+ Warn_On_Elab_Access : Boolean := False;
+ -- GNAT
+ -- Set to True to generate warnings for P'Access in the case where
+ -- subprogram P is in the same package as the P'Access, and the P'Access is
+ -- evaluated at package elaboration time, and occurs before the body of P
+ -- has been elaborated.
+
Warn_On_Hiding : Boolean := False;
-- GNAT
-- Set to True to generate warnings if a declared entity hides another
Subt_Mark : Node_Id := Empty;
begin
+ -- Formal may be an anonymous access
+
if Present (Subtype_Mark (Formal)) then
Subt_Mark := Subtype_Mark (Formal);
else
-- Use default to construct declaration
if Present (Subt_Mark) then
- Def := Subt_Mark;
+ Def := New_Copy (Subt_Mark);
+
else pragma Assert (Present (Acc_Def));
- Def := Acc_Def;
+
+ -- If formal is an anonymous access, copy access definition of
+ -- formal for object declaration.
+
+ Def := New_Copy_Tree (Acc_Def);
end if;
Decl_Node :=
Defining_Identifier => New_Copy (Gen_Obj),
Constant_Present => True,
Null_Exclusion_Present => Null_Exclusion_Present (Formal),
- Object_Definition => New_Copy (Def),
+ Object_Definition => Def,
Expression => New_Copy_Tree
(Default_Expression (Formal)));
Set_Analyzed (Expression (Decl_Node), False);
else
- Error_Msg_NE
- ("missing actual&",
- Instantiation_Node, Gen_Obj);
+ Error_Msg_NE ("missing actual&", Instantiation_Node, Gen_Obj);
Error_Msg_NE ("\in instantiation of & declared#",
- Instantiation_Node, Scope (A_Gen_Obj));
+ Instantiation_Node, Scope (A_Gen_Obj));
if Is_Scalar_Type (Etype (A_Gen_Obj)) then
Inst_Case : constant Boolean := Nkind (N) in N_Generic_Instantiation;
begin
- -- If not function or procedure call or instantiation, then ignore
- -- call (this happens in some error cases and rewriting cases).
+ -- For P'Access, we want to warn if the -gnatw.f switch is set, and the
+ -- node comes from source.
- if not Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement)
+ if Nkind (N) = N_Attribute_Reference and then
+ (not Warn_On_Elab_Access or else not Comes_From_Source (N))
+ then
+ return;
+
+ -- If not function or procedure call, instantiation, or 'Access, then
+ -- ignore call (this happens in some error cases and rewriting cases).
+
+ elsif not Nkind_In
+ (N, N_Function_Call,
+ N_Procedure_Call_Statement,
+ N_Attribute_Reference)
and then not Inst_Case
then
return;
-- Nothing to do if this is a call or instantiation that has already
-- been found to be a sure ABE.
- elsif ABE_Is_Certain (N) then
+ elsif Nkind (N) /= N_Attribute_Reference and then ABE_Is_Certain (N) then
return;
-- Nothing to do if errors already detected (avoid cascaded errors)
-- Not that special case, warning and dynamic check is required
-- If we have nothing in the call stack, then this is at the outer
- -- level, and the ABE is bound to occur.
+ -- level, and the ABE is bound to occur, unless it's a 'Access.
if Elab_Call.Last = 0 then
Error_Msg_Warn := SPARK_Mode /= On;
if Inst_Case then
Error_Msg_NE
("cannot instantiate& before body seen<<", N, Orig_Ent);
- else
+ elsif Nkind (N) /= N_Attribute_Reference then
Error_Msg_NE
("cannot call& before body seen<<", N, Orig_Ent);
+ else
+ Error_Msg_NE
+ ("Access attribute of & before body seen<<", N, Orig_Ent);
+ Error_Msg_N ("\possible Program_Error on later references<", N);
end if;
- Error_Msg_N ("\Program_Error [<<", N);
- Insert_Elab_Check (N);
+ if Nkind (N) /= N_Attribute_Reference then
+ Error_Msg_N ("\Program_Error [<<", N);
+ Insert_Elab_Check (N);
+ end if;
-- Call is not at outer level
when 'e' =>
All_Warnings (True);
+ when 'f' =>
+ Warn_On_Elab_Access := True;
+
+ when 'F' =>
+ Warn_On_Elab_Access := False;
+
when 'g' =>
Set_GNAT_Mode_Warnings;
projects / gcc.git / commitdiff