+2013-04-25 Robert Dewar <dewar@adacore.com>
+
+ * debug.adb: Remove d.X and d.Y entries and documentation.
+ * exp_ch4.adb (Expand_N_If_Expression): Remove special code used
+ if expression with actions not available (now always available).
+ (Expand_Short_Circuit_Operator): Same change.
+ * gnat1drv.adb (Adjust_Global_Switches) Remove setting
+ Use_Expression_With_Actions flag, since this is now obsolete.
+ * opt.ads (Use_Expression_Actions): Removed (always True now).
+ * sinfo.ads: Minor comment updates.
+
+2013-04-25 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.adb (Check_Generic_Actuals): If an actual is an array
+ subtype whose base type is currently private, install full view
+ when compiling instance body.
+
+2013-04-25 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_disp.adb (Check_Dispatching_Operation): Refine checks for
+ AI05-0125: the check for a hidden primitive that may be overridden
+ by the new declaration is only performed if the declaration comes
+ from source, and it must carry an explicit overriding indicator.
+
+2013-04-25 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * einfo.adb (Abstract_States): The attribute now applies to
+ generic packages.
+ * sem_ch3.adb (Analyze_Object_Declaration): Check whether an
+ object declaration introduces an illegal hidden state.
+ * sem_prag.adb (Analyze_Abstract_State): Check whether a state
+ declaration introduces an illegal hidden state.
+ * sem_util.ads, sem_util.adb (Check_No_Hidden_State): New routine.
+
+2013-04-25 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch6.adb (Is_Build_In_Place_Function_Call): The call may
+ be to a protected function, in which case the name in the call
+ is a selected component.
+
+2013-04-25 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch4.adb (Analyze_Quantified_Expression):
+ Warn on a suspicious use of quantifier "some" when "all" was meant.
+ (No_Else_Or_Trivial_True): New routine.
+
2013-04-25 Robert Dewar <dewar@adacore.com>
* einfo.ads, einfo.adb: Put back with/use for Namet.
-- d.U Ignore indirect calls for static elaboration
-- d.V Extensions for formal verification
-- d.W Print out debugging information for Walk_Library_Items
- -- d.X Use Expression_With_Actions
- -- d.Y Do not use Expression_With_Actions
+ -- d.X
+ -- d.Y
-- d.Z Dump flow analysis graphs, for debugging purposes (gnat2why)
-- d1 Error msgs have node numbers where possible
-- the order in which units are walked. This is primarily for use in
-- debugging CodePeer mode.
- -- d.X By default, the compiler uses an elaborate rewriting framework for
- -- short-circuited forms where the right hand condition generates
- -- actions to be inserted. With the gcc backend, we now use the new
- -- N_Expression_With_Actions node for this expansion, but we still use
- -- the old method for other backends and in SCIL mode. This debug flag
- -- forces use of the new N_Expression_With_Actions node in these other
- -- cases and is intended for transitional use.
-
-- d.Z In gnat2why, in Flow analysis mode (-gnatd.Q), dump the different
-- graphs (control flow, control dependence) for debugging purposes.
-- This debug flag will be removed when flow analysis is sufficiently
function Abstract_States (Id : E) return L is
begin
- pragma Assert (Ekind (Id) = E_Package);
+ pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
return Elist25 (Id);
end Abstract_States;
Remove (Expr);
if Present (Actions) then
-
- -- If we are not allowed to use Expression_With_Actions, just skip
- -- the optimization, it is not critical for correctness.
-
- if not Use_Expression_With_Actions then
- goto Skip_Optimization;
- end if;
-
Rewrite (N,
Make_Expression_With_Actions (Loc,
Expression => Relocate_Node (Expr),
Actions => Actions));
Analyze_And_Resolve (N, Typ);
-
else
Rewrite (N, Relocate_Node (Expr));
end if;
return;
end if;
- <<Skip_Optimization>>
-
-- If the type is limited or unconstrained, we expand as follows to
-- avoid any possibility of improper copies.
elsif Present (Then_Actions (N)) or else Present (Else_Actions (N)) then
- -- We have two approaches to handling this. If we are allowed to use
- -- N_Expression_With_Actions, then we can just wrap the actions into
- -- the appropriate expression.
-
- if Use_Expression_With_Actions then
- if Present (Then_Actions (N)) then
- Rewrite (Thenx,
- Make_Expression_With_Actions (Sloc (Thenx),
- Actions => Then_Actions (N),
- Expression => Relocate_Node (Thenx)));
- Set_Then_Actions (N, No_List);
- Analyze_And_Resolve (Thenx, Typ);
- end if;
-
- if Present (Else_Actions (N)) then
- Rewrite (Elsex,
- Make_Expression_With_Actions (Sloc (Elsex),
- Actions => Else_Actions (N),
- Expression => Relocate_Node (Elsex)));
- Set_Else_Actions (N, No_List);
- Analyze_And_Resolve (Elsex, Typ);
- end if;
-
- return;
-
- -- if we can't use N_Expression_With_Actions nodes, then we insert
- -- the following sequence of actions (using Insert_Actions):
+ -- We now wrap the actions into the appropriate expression
- -- Cnn : typ;
- -- if cond then
- -- <<then actions>>
- -- Cnn := then-expr;
- -- else
- -- <<else actions>>
- -- Cnn := else-expr
- -- end if;
-
- -- and replace the if expression by a reference to Cnn
-
- else
- Cnn := Make_Temporary (Loc, 'C', N);
-
- Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Cnn,
- Object_Definition => New_Occurrence_Of (Typ, Loc));
-
- New_If :=
- Make_Implicit_If_Statement (N,
- Condition => Relocate_Node (Cond),
-
- Then_Statements => New_List (
- Make_Assignment_Statement (Sloc (Thenx),
- Name => New_Occurrence_Of (Cnn, Sloc (Thenx)),
- Expression => Relocate_Node (Thenx))),
-
- Else_Statements => New_List (
- Make_Assignment_Statement (Sloc (Elsex),
- Name => New_Occurrence_Of (Cnn, Sloc (Elsex)),
- Expression => Relocate_Node (Elsex))));
-
- Set_Assignment_OK (Name (First (Then_Statements (New_If))));
- Set_Assignment_OK (Name (First (Else_Statements (New_If))));
+ if Present (Then_Actions (N)) then
+ Rewrite (Thenx,
+ Make_Expression_With_Actions (Sloc (Thenx),
+ Actions => Then_Actions (N),
+ Expression => Relocate_Node (Thenx)));
+ Set_Then_Actions (N, No_List);
+ Analyze_And_Resolve (Thenx, Typ);
+ end if;
- New_N := New_Occurrence_Of (Cnn, Loc);
+ if Present (Else_Actions (N)) then
+ Rewrite (Elsex,
+ Make_Expression_With_Actions (Sloc (Elsex),
+ Actions => Else_Actions (N),
+ Expression => Relocate_Node (Elsex)));
+ Set_Else_Actions (N, No_List);
+ Analyze_And_Resolve (Elsex, Typ);
end if;
+ return;
+
-- If no actions then no expansion needed, gigi will handle it using
-- the same approach as a C conditional expression.
Shortcut_Ent : constant Entity_Id := Boolean_Literals (Shortcut_Value);
-- If Left = Shortcut_Value then Right need not be evaluated
- function Make_Test_Expr (Opnd : Node_Id) return Node_Id;
- -- For Opnd a boolean expression, return a Boolean expression equivalent
- -- to Opnd /= Shortcut_Value.
-
- --------------------
- -- Make_Test_Expr --
- --------------------
-
- function Make_Test_Expr (Opnd : Node_Id) return Node_Id is
- begin
- if Shortcut_Value then
- return Make_Op_Not (Sloc (Opnd), Opnd);
- else
- return Opnd;
- end if;
- end Make_Test_Expr;
-
- Op_Var : Entity_Id;
- -- Entity for a temporary variable holding the value of the operator,
- -- used for expansion in the case where actions are present.
-
- -- Start of processing for Expand_Short_Circuit_Operator
-
begin
-- Deal with non-standard booleans
-- must only be executed if the right operand of the short circuit is
-- executed and not otherwise.
- -- the temporary variable C.
-
if Present (Actions (N)) then
Actlist := Actions (N);
- -- The old approach is to expand:
-
- -- left AND THEN right
-
- -- into
-
- -- C : Boolean := False;
- -- IF left THEN
- -- Actions;
- -- IF right THEN
- -- C := True;
- -- END IF;
- -- END IF;
-
- -- and finally rewrite the operator into a reference to C. Similarly
- -- for left OR ELSE right, with negated values. Note that this
- -- rewrite causes some difficulties for coverage analysis because
- -- of the introduction of the new variable C, which obscures the
- -- structure of the test.
-
- -- We use this "old approach" if use of N_Expression_With_Actions
- -- is False (see description in Opt of when this is or is not set).
+ -- We now use an Expression_With_Actions node for the right operand
+ -- of the short-circuit form. Note that this solves the traceability
+ -- problems for coverage analysis.
- if not Use_Expression_With_Actions then
- Op_Var := Make_Temporary (Loc, 'C', Related_Node => N);
-
- Insert_Action (N,
- Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Op_Var,
- Object_Definition =>
- New_Occurrence_Of (Standard_Boolean, Loc),
- Expression =>
- New_Occurrence_Of (Shortcut_Ent, Loc)));
-
- Append_To (Actlist,
- Make_Implicit_If_Statement (Right,
- Condition => Make_Test_Expr (Right),
- Then_Statements => New_List (
- Make_Assignment_Statement (LocR,
- Name => New_Occurrence_Of (Op_Var, LocR),
- Expression =>
- New_Occurrence_Of
- (Boolean_Literals (not Shortcut_Value), LocR)))));
-
- Insert_Action (N,
- Make_Implicit_If_Statement (Left,
- Condition => Make_Test_Expr (Left),
- Then_Statements => Actlist));
-
- Rewrite (N, New_Occurrence_Of (Op_Var, Loc));
- Analyze_And_Resolve (N, Standard_Boolean);
-
- -- The new approach, activated for now by the use of debug flag
- -- -gnatd.X is to use the new Expression_With_Actions node for the
- -- right operand of the short-circuit form. This should solve the
- -- traceability problems for coverage analysis.
-
- else
- Rewrite (Right,
- Make_Expression_With_Actions (LocR,
- Expression => Relocate_Node (Right),
- Actions => Actlist));
- Set_Actions (N, No_List);
- Analyze_And_Resolve (Right, Standard_Boolean);
- end if;
+ Rewrite (Right,
+ Make_Expression_With_Actions (LocR,
+ Expression => Relocate_Node (Right),
+ Actions => Actlist));
+ Set_Actions (N, No_List);
+ Analyze_And_Resolve (Right, Standard_Boolean);
Adjust_Result_Type (N, Typ);
return;
elsif Nkind (Name (Exp_Node)) = N_Explicit_Dereference then
Function_Id := Etype (Name (Exp_Node));
+ -- This may be a call to a protected function.
+
+ elsif Nkind (Name (Exp_Node)) = N_Selected_Component then
+ Function_Id := Etype (Entity (Selector_Name (Name (Exp_Node))));
+
else
raise Program_Error;
end if;
Suppress_Options.Suppress (Atomic_Synchronization) :=
not Atomic_Sync_Default_On_Target;
- -- Set switch indicating if we can use N_Expression_With_Actions
-
- -- Debug flag -gnatd.X decisively sets usage on
-
- if Debug_Flag_Dot_XX then
- Use_Expression_With_Actions := True;
-
- -- Debug flag -gnatd.Y decisively sets usage off
-
- elsif Debug_Flag_Dot_YY then
- Use_Expression_With_Actions := False;
-
- -- Otherwise this feature is implemented, so we allow its use
-
- else
- Use_Expression_With_Actions := True;
- end if;
-
-- Set switch indicating if back end can handle limited types, and
-- guarantee that no incorrect copies are made (e.g. in the context
-- of an if or case expression).
-- Set to True if -h (-gnath for the compiler) switch encountered
-- requesting usage information
- Use_Expression_With_Actions : Boolean;
- -- The N_Expression_With_Actions node has been introduced relatively
- -- recently, and not all back ends are prepared to handle it yet. So
- -- we use this flag to suppress its use during a transitional period.
- -- Currently the default is False for all cases (set in gnat1drv).
- -- The default can be modified using -gnatd.X/-gnatd.Y.
-
Use_Pragma_Linker_Constructor : Boolean := False;
-- GNATBIND
-- True if pragma Linker_Constructor applies to adainit
-- previous formal in the same unit. The privacy status of the component
-- type will have been examined earlier in the traversal of the
-- corresponding actuals, and this status should not be modified for the
- -- array type itself.
+ -- array (sub)type itself. However, if the base type of the array
+ -- (sub)type is private, its full view must be restored in the body to
+ -- be consistent with subsequent index subtypes, etc.
--
-- To detect this case we have to rescan the list of formals, which
-- is usually short enough to ignore the resulting inefficiency.
and then Is_Entity_Name (Subtype_Indication (Parent (E)))
then
if Is_Array_Type (E)
+ and then not Is_Private_Type (Etype (E))
and then Denotes_Previous_Actual (Component_Type (E))
then
null;
end if;
Analyze_Dimension (N);
+
+ -- Verify whether the object declaration introduces an illegal hidden
+ -- state within a package subject to a null abstract state.
+
+ if Formal_Extensions and then Ekind (Id) = E_Variable then
+ Check_No_Hidden_State (Id);
+ end if;
end Analyze_Object_Declaration;
---------------------------
-----------------------------------
procedure Analyze_Quantified_Expression (N : Node_Id) is
- QE_Scop : Entity_Id;
-
function Is_Empty_Range (Typ : Entity_Id) return Boolean;
-- If the iterator is part of a quantified expression, and the range is
-- known to be statically empty, emit a warning and replace expression
-- with its static value. Returns True if the replacement occurs.
+ function No_Else_Or_Trivial_True (If_Expr : Node_Id) return Boolean;
+ -- Determine whether if expression If_Expr lacks an else part or if it
+ -- has one, it evaluates to True.
+
--------------------
-- Is_Empty_Range --
--------------------
end if;
end Is_Empty_Range;
+ -----------------------------
+ -- No_Else_Or_Trivial_True --
+ -----------------------------
+
+ function No_Else_Or_Trivial_True (If_Expr : Node_Id) return Boolean is
+ Else_Expr : constant Node_Id :=
+ Next (Next (First (Expressions (If_Expr))));
+ begin
+ return
+ No (Else_Expr)
+ or else (Compile_Time_Known_Value (Else_Expr)
+ and then Is_True (Expr_Value (Else_Expr)));
+ end No_Else_Or_Trivial_True;
+
+ -- Local variables
+
+ Cond : constant Node_Id := Condition (N);
+ QE_Scop : Entity_Id;
+
-- Start of processing for Analyze_Quantified_Expression
begin
Preanalyze (Loop_Parameter_Specification (N));
end if;
- Preanalyze_And_Resolve (Condition (N), Standard_Boolean);
+ Preanalyze_And_Resolve (Cond, Standard_Boolean);
End_Scope;
Set_Etype (N, Standard_Boolean);
+
+ -- Diagnose a possible misuse of the "some" existential quantifier. When
+ -- we have a quantified expression of the form
+ --
+ -- for some X => (if P then Q [else True])
+ --
+ -- the if expression will not hold and render the quantified expression
+ -- trivially True.
+
+ if Formal_Extensions
+ and then not All_Present (N)
+ and then Nkind (Cond) = N_If_Expression
+ and then No_Else_Or_Trivial_True (Cond)
+ then
+ Error_Msg_N ("?suspicious expression", N);
+ Error_Msg_N ("\\did you mean (for all X ='> (if P then Q))", N);
+ Error_Msg_N ("\\or (for some X ='> P and then Q) instead'?", N);
+ end if;
end Analyze_Quantified_Expression;
-------------------
Ovr_Subp := Old_Subp;
-- [Ada 2012:AI-0125]: Search for inherited hidden primitive that may be
- -- overridden by Subp
+ -- overridden by Subp. This only applies to source subprograms, and
+ -- their declaration must carry an explicit overriding indicator.
if No (Ovr_Subp)
and then Ada_Version >= Ada_2012
+ and then Comes_From_Source (Subp)
+ and then
+ Nkind (Unit_Declaration_Node (Subp)) = N_Subprogram_Declaration
then
Ovr_Subp := Find_Hidden_Overridden_Primitive (Subp);
+
+ -- Verify that the proper overriding indicator has been supplied.
+
+ if Present (Ovr_Subp)
+ and then
+ not Must_Override (Specification (Unit_Declaration_Node (Subp)))
+ then
+ Error_Msg_NE ("missing overriding indicator for&", Subp, Subp);
+ end if;
end if;
-- Now it should be a correct primitive operation, put it in the list
Pop_Scope;
end if;
+ -- Verify whether the state introduces an illegal hidden state
+ -- within a package subject to a null abstract state.
+
+ if Formal_Extensions then
+ Check_No_Hidden_State (Id);
+ end if;
+
-- Associate the state with its related package
if No (Abstract_States (Pack_Id)) then
end if;
end Check_Nested_Access;
+ ---------------------------
+ -- Check_No_Hidden_State --
+ ---------------------------
+
+ procedure Check_No_Hidden_State (Id : Entity_Id) is
+ function Has_Null_Abstract_State (Pkg : Entity_Id) return Boolean;
+ -- Determine whether the entity of a package denoted by Pkg has a null
+ -- abstract state.
+
+ -----------------------------
+ -- Has_Null_Abstract_State --
+ -----------------------------
+
+ function Has_Null_Abstract_State (Pkg : Entity_Id) return Boolean is
+ States : constant Elist_Id := Abstract_States (Pkg);
+
+ begin
+ -- Check the first available state of the related package. A null
+ -- abstract state always appears as the sole element of the state
+ -- list.
+
+ return
+ Present (States)
+ and then Is_Null_State (Node (First_Elmt (States)));
+ end Has_Null_Abstract_State;
+
+ -- Local variables
+
+ Context : Entity_Id := Empty;
+ Not_Visible : Boolean := False;
+ Scop : Entity_Id;
+
+ -- Start of processing for Check_No_Hidden_State
+
+ begin
+ pragma Assert (Ekind_In (Id, E_Abstract_State, E_Variable));
+
+ -- Find the proper context where the object or state appears
+
+ Scop := Scope (Id);
+ while Present (Scop) loop
+ Context := Scop;
+
+ -- Keep track of the context's visibility
+
+ Not_Visible := Not_Visible or else In_Private_Part (Context);
+
+ -- Prevent the search from going too far
+
+ if Context = Standard_Standard then
+ return;
+
+ -- Objects and states that appear immediately within a subprogram or
+ -- inside a construct nested within a subprogram do not introduce a
+ -- hidden state. They behave as local variable declarations.
+
+ elsif Is_Subprogram (Context) then
+ return;
+
+ -- When examining a package body, use the entity of the spec as it
+ -- carries the abstract state declarations.
+
+ elsif Ekind (Context) = E_Package_Body then
+ Context := Spec_Entity (Context);
+ end if;
+
+ -- Stop the traversal when a package subject to a null abstract state
+ -- has been found.
+
+ if Ekind_In (Context, E_Generic_Package, E_Package)
+ and then Has_Null_Abstract_State (Context)
+ then
+ exit;
+ end if;
+
+ Scop := Scope (Scop);
+ end loop;
+
+ -- At this point we know that there is at least one package with a null
+ -- abstract state in visibility. Emit an error message unconditionally
+ -- if the entity being processed is a state because the placement of the
+ -- related package is irrelevant. This is not the case for objects as
+ -- the intermediate context matters.
+
+ if Present (Context)
+ and then (Ekind (Id) = E_Abstract_State or else Not_Visible)
+ then
+ Error_Msg_N ("cannot introduce hidden state &", Id);
+ Error_Msg_NE ("\package & has null abstract state", Id, Context);
+ end if;
+ end Check_No_Hidden_State;
+
------------------------------------------
-- Check_Potentially_Blocking_Operation --
------------------------------------------
-- the compilation unit, and install it in the Elaboration_Entity field
-- of Spec_Id, the entity for the compilation unit.
- procedure Build_Explicit_Dereference
- (Expr : Node_Id;
- Disc : Entity_Id);
- -- AI05-139: Names with implicit dereference. If the expression N is a
- -- reference type and the context imposes the corresponding designated
- -- type, convert N into N.Disc.all. Such expressions are always over-
- -- loaded with both interpretations, and the dereference interpretation
- -- carries the name of the reference discriminant.
+ procedure Build_Explicit_Dereference
+ (Expr : Node_Id;
+ Disc : Entity_Id);
+ -- AI05-139: Names with implicit dereference. If the expression N is a
+ -- reference type and the context imposes the corresponding designated
+ -- type, convert N into N.Disc.all. Such expressions are always over-
+ -- loaded with both interpretations, and the dereference interpretation
+ -- carries the name of the reference discriminant.
function Cannot_Raise_Constraint_Error (Expr : Node_Id) return Boolean;
-- Returns True if the expression cannot possibly raise Constraint_Error.
-- is accessed inside a nested procedure, and set Has_Up_Level_Access flag
-- accordingly. This is currently only enabled for VM_Target /= No_VM.
+ procedure Check_No_Hidden_State (Id : Entity_Id);
+ -- Determine whether object or state Id introduces a hidden state. If this
+ -- is the case, emit an error.
+
procedure Check_Potentially_Blocking_Operation (N : Node_Id);
-- N is one of the statement forms that is a potentially blocking
-- operation. If it appears within a protected action, emit warning.
-- Expression (Node3)
-- plus fields for expression
- -- Note: the actions list is always non-null, since we would
- -- never have created this node if there weren't some actions.
+ -- Note: the actions list is always non-null, since we would never have
+ -- created this node if there weren't some actions.
-- Note: Expression may be a Null_Statement, in which case the
-- N_Expression_With_Actions has type Standard_Void_Type. However some
projects / gcc.git / commitdiff