[multiple changes]
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. From-SVN: r219293
This commit is contained in:
Arnaud Charlet
parent
ccfe725bc6
commit
10dfac72b1
|
|
@ -1,3 +1,29 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -4120,11 +4120,14 @@ package body Exp_Ch5 is
|
|||
-- 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);
|
||||
|
|
@ -4210,38 +4213,91 @@ package body Exp_Ch5 is
|
|||
-- 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,
|
||||
|
|
@ -4258,11 +4314,6 @@ package body Exp_Ch5 is
|
|||
|
||||
-- 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,
|
||||
|
|
|
|||
|
|
@ -5048,6 +5048,23 @@ combination @option{-gnatwu} followed by @option{-gnatwF} has the
|
|||
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})
|
||||
|
|
|
|||
|
|
@ -1669,6 +1669,13 @@ package Opt is
|
|||
-- 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
|
||||
|
|
|
|||
|
|
@ -9884,6 +9884,8 @@ package body Sem_Ch12 is
|
|||
Subt_Mark : Node_Id := Empty;
|
||||
|
||||
begin
|
||||
-- Formal may be an anonymous access
|
||||
|
||||
if Present (Subtype_Mark (Formal)) then
|
||||
Subt_Mark := Subtype_Mark (Formal);
|
||||
else
|
||||
|
|
@ -10140,9 +10142,14 @@ package body Sem_Ch12 is
|
|||
-- 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 :=
|
||||
|
|
@ -10150,7 +10157,7 @@ package body Sem_Ch12 is
|
|||
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)));
|
||||
|
||||
|
|
@ -10158,11 +10165,9 @@ package body Sem_Ch12 is
|
|||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -1990,10 +1990,21 @@ package body Sem_Elab is
|
|||
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;
|
||||
|
|
@ -2001,7 +2012,7 @@ package body Sem_Elab is
|
|||
-- 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)
|
||||
|
|
@ -2323,7 +2334,7 @@ package body Sem_Elab is
|
|||
-- 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;
|
||||
|
|
@ -2331,13 +2342,19 @@ package body Sem_Elab is
|
|||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -326,6 +326,12 @@ package body Warnsw is
|
|||
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;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue