+2017-10-09 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_util.adb (Make_Predicate_Call): If the type of the expression to
+ which the predicate check applies is tagged, convert the expression to
+ that type. This is in most cases a no-op, but is relevant if the
+ expression is clas-swide, because the predicate function being invoked
+ is not a primitive of the type and cannot take a class-wide actual.
+
+2017-10-09 Gary Dismukes <dismukes@adacore.com>
+
+ * exp_disp.adb: Minor reformatting.
+
+2017-10-09 Arnaud Charlet <charlet@adacore.com>
+
+ * sem_warn.adb (Warn_On_Unreferenced_Entity): Fix typo.
+
+2017-10-09 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_elab.adb (Install_ABE_Check): Do not generate an ABE check for
+ GNATprove.
+ (Install_ABE_Failure): Do not generate an ABE failure for GNATprove.
+
+2017-10-09 Bob Duff <duff@adacore.com>
+
+ * exp_ch6.adb: (Make_Build_In_Place_Call_In_Object_Declaration): Return
+ immediately if the call has already been processed (by a previous call
+ to Make_Build_In_Place_Call_In_Anonymous_Context).
+ * sem_elab.adb: Minor typo fixes.
+
+2017-10-09 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch13.adb (Replace_Type_Ref): In the expression for a dynamic
+ predicate, do not replace an identifier that matches the type if the
+ identifier is a selector in a selected component, because this
+ indicates a reference to some homograph of the type itself, and not to
+ the current occurence in the predicate.
+
+2017-10-09 Eric Botcazou <ebotcazou@adacore.com>
+
+ * repinfo.adb (List_Record_Layout): Tweak formatting.
+ (Write_Val): Remove superfluous spaces in back-end layout mode.
+
+2017-10-09 Piotr Trojanek <trojanek@adacore.com>
+
+ * sem_res.adb (Property_Error): Remove.
+ (Resolve_Actuals): check for SPARK RM 7.1.3(10) rewritten to match the
+ current wording of the rule.
+
+2017-10-09 Justin Squirek <squirek@adacore.com>
+
+ * sem_ch3.adb (Analyze_Declarations): Add check for ghost packages
+ before analyzing a given scope due to an expression function.
+ (Uses_Unseen_Lib_Unit_Priv): Rename to Uses_Unseen_Priv.
+
2017-10-09 Bob Duff <duff@adacore.com>
* exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration): Use
-- Caller_Known_Size (specific) tagged type, we treat it as
-- indefinite, because the code for the Definite case below sets the
-- initialization expression of the object to Empty, which would be
- -- illegal Ada, and would cause gigi to mis-allocate X.
+ -- illegal Ada, and would cause gigi to misallocate X.
+
+ -- Start of processing for Make_Build_In_Place_Call_In_Object_Declaration
begin
+ -- If the call has already been processed to add build-in-place actuals
+ -- then return.
+
+ if Is_Expanded_Build_In_Place_Call (Func_Call) then
+ return;
+ end if;
+
-- Mark the call as processed as a build-in-place call
- pragma Assert (not Is_Expanded_Build_In_Place_Call (Func_Call));
Set_Is_Expanded_Build_In_Place_Call (Func_Call);
-- Create an access type designating the function's result subtype.
Set_Etype (N, Etype (F));
-- Conversely, if this is a controlling argument
- -- (in a dispatching call in the condition)
- -- that is a dereference, the source is an access to
- -- classwide type, so preserve the dispatching nature
- -- of the call in the rewritten condition.
+ -- (in a dispatching call in the condition) that is a
+ -- dereference, the source is an access-to-class-wide
+ -- type, so preserve the dispatching nature of the
+ -- call in the rewritten condition.
elsif Nkind (Parent (N)) = N_Explicit_Dereference
and then Is_Controlling_Actual (Parent (N))
-- Case of calling normal predicate function
- Call :=
- Make_Function_Call (Loc,
- Name => New_Occurrence_Of (Func_Id, Loc),
- Parameter_Associations => New_List (Relocate_Node (Expr)));
+ -- If the type is tagged, the expression may be class-wide, in which
+ -- case it has to be converted to its root type, given that the
+ -- generated predicate function is not dispatching.
+
+ if Is_Tagged_Type (Typ) then
+ Call :=
+ Make_Function_Call (Loc,
+ Name => New_Occurrence_Of (Func_Id, Loc),
+ Parameter_Associations =>
+ New_List (Convert_To (Typ, Relocate_Node (Expr))));
+ else
+ Call :=
+ Make_Function_Call (Loc,
+ Name => New_Occurrence_Of (Func_Id, Loc),
+ Parameter_Associations => New_List (Relocate_Node (Expr)));
+ end if;
Restore_Ghost_Mode (Saved_GM);
and then List_Representation_Info = 3
then
Spaces (Max_Spos_Length - 2);
- Write_Str ("bit offset");
+ Write_Str ("bit offset ");
if Starting_Position /= Uint_0
or else Starting_First_Bit /= Uint_0
then
- Write_Char (' ');
UI_Write (Starting_Position * SSU + Starting_First_Bit);
- Write_Str (" +");
+ Write_Str (" + ");
end if;
Write_Val (Bofs, Paren => True);
Write_Str ("??");
else
- if Back_End_Layout then
- Write_Char (' ');
-
- if Paren then
- Write_Char ('(');
- List_GCC_Expression (Val);
- Write_Char (')');
- else
- List_GCC_Expression (Val);
- end if;
-
- Write_Char (' ');
+ if Paren then
+ Write_Char ('(');
+ end if;
+ if Back_End_Layout then
+ List_GCC_Expression (Val);
else
- if Paren then
- Write_Char ('(');
- Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val)));
- Write_Char (')');
- else
- Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val)));
- end if;
+ Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val)));
+ end if;
+
+ if Paren then
+ Write_Char (')');
end if;
end if;
if Present (Default_Element) then
Analyze (Default_Element);
-
- if Is_Entity_Name (Default_Element)
- and then not Covers (Entity (Default_Element), Ret_Type)
- and then False
- then
- Illegal_Indexing
- ("wrong return type for indexing function");
- return;
- end if;
end if;
-- For variable_indexing the return type must be a reference type
return Skip;
- -- Otherwise do the replacement and we are done with this node
+ -- Otherwise do the replacement if this is not a qualified
+ -- reference to a homograph of the type itself. Note that the
+ -- current instance could not appear in such a context, e.g.
+ -- the prefix of a type conversion.
else
- Replace_Type_Reference (N);
+ if Nkind (Parent (N)) /= N_Selected_Component
+ or else N /= Selector_Name (Parent (N))
+ then
+ Replace_Type_Reference (N);
+ end if;
+
return Skip;
end if;
elsif Nkind (N) = N_Selected_Component then
- -- If selector name is not our type, keeping going (we might still
+ -- If selector name is not our type, keep going (we might still
-- have an occurrence of the type in the prefix).
if Nkind (Selector_Name (N)) /= N_Identifier
-- Utility to resolve the expressions of aspects at the end of a list of
-- declarations.
- function Uses_Unseen_Lib_Unit_Priv (Pkg : Entity_Id) return Boolean;
- -- Check if an inner package has entities within it that rely on library
- -- level private types where the full view has not been seen.
+ function Uses_Unseen_Priv (Pkg : Entity_Id) return Boolean;
+ -- Check if a nested package has entities within it that rely on library
+ -- level private types where the full view has not been seen for the
+ -- purposes of checking if it is acceptable to freeze an expression
+ -- function at the point of declaration.
-----------------
-- Adjust_Decl --
end loop;
end Resolve_Aspects;
- -------------------------------
- -- Uses_Unseen_Lib_Unit_Priv --
- -------------------------------
+ ----------------------
+ -- Uses_Unseen_Priv --
+ ----------------------
- function Uses_Unseen_Lib_Unit_Priv (Pkg : Entity_Id) return Boolean is
+ function Uses_Unseen_Priv (Pkg : Entity_Id) return Boolean is
Curr : Entity_Id;
begin
end if;
return False;
- end Uses_Unseen_Lib_Unit_Priv;
+ end Uses_Unseen_Priv;
-- Local variables
elsif not Analyzed (Next_Decl) and then Is_Body (Next_Decl)
and then ((Nkind (Next_Decl) /= N_Subprogram_Body
- or else not Was_Expression_Function (Next_Decl))
- or else not Uses_Unseen_Lib_Unit_Priv (Current_Scope))
+ or else not Was_Expression_Function (Next_Decl))
+ or else (not Is_Ignored_Ghost_Entity (Current_Scope)
+ and then not Uses_Unseen_Priv (Current_Scope)))
then
-- When a controlled type is frozen, the expander generates stream
-- and controlled-type support routines. If the freeze is caused
Scop_Id : Entity_Id;
begin
+ -- Nothing to do when compiling for GNATprove because raise statements
+ -- are not supported.
+
+ if GNATprove_Mode then
+ return;
+
-- Nothing to do when the compilation will not produce an executable
- if Serious_Errors_Detected > 0 then
+ elsif Serious_Errors_Detected > 0 then
return;
-- Nothing to do for a compilation unit because there is no executable
-- Start for processing for Install_ABE_Check
begin
+ -- Nothing to do when compiling for GNATprove because raise statements
+ -- are not supported.
+
+ if GNATprove_Mode then
+ return;
+
-- Nothing to do when the compilation will not produce an executable
- if Serious_Errors_Detected > 0 then
+ elsif Serious_Errors_Detected > 0 then
return;
-- Nothing to do when the target is a protected subprogram because the
Scop_Id : Entity_Id;
begin
+ -- Nothing to do when compiling for GNATprove because raise statements
+ -- are not supported.
+
+ if GNATprove_Mode then
+ return;
+
-- Nothing to do when the compilation will not produce an executable
- if Serious_Errors_Detected > 0 then
+ elsif Serious_Errors_Detected > 0 then
return;
-- Do not install an ABE check for a compilation unit because there is
-- an instance of the default expression. The insertion is always
-- a named association.
- procedure Property_Error
- (Var : Node_Id;
- Var_Id : Entity_Id;
- Prop_Nam : Name_Id);
- -- Emit an error concerning variable Var with entity Var_Id that has
- -- enabled property Prop_Nam when it acts as an actual parameter in a
- -- call and the corresponding formal parameter is of mode IN.
-
function Same_Ancestor (T1, T2 : Entity_Id) return Boolean;
-- Check whether T1 and T2, or their full views, are derived from a
-- common type. Used to enforce the restrictions on array conversions
Prev := Actval;
end Insert_Default;
- --------------------
- -- Property_Error --
- --------------------
-
- procedure Property_Error
- (Var : Node_Id;
- Var_Id : Entity_Id;
- Prop_Nam : Name_Id)
- is
- begin
- Error_Msg_Name_1 := Prop_Nam;
- Error_Msg_NE
- ("external variable & with enabled property % cannot appear as "
- & "actual in procedure call (SPARK RM 7.1.3(10))", Var, Var_Id);
- Error_Msg_N ("\\corresponding formal parameter has mode In", Var);
- end Property_Error;
-
-------------------
-- Same_Ancestor --
-------------------
Flag_Effectively_Volatile_Objects (A);
end if;
- -- Detect an external variable with an enabled property that
- -- does not match the mode of the corresponding formal in a
- -- procedure call. Functions are not considered because they
- -- cannot have effectively volatile formal parameters in the
- -- first place.
+ -- An effectively volatile variable cannot act as an actual
+ -- parameter in a procedure call when the variable has enabled
+ -- property Effective_Reads and the corresponding formal is of
+ -- mode IN (SPARK RM 7.1.3(10)).
if Ekind (Nam) = E_Procedure
and then Ekind (F) = E_In_Parameter
and then Is_Entity_Name (A)
- and then Present (Entity (A))
- and then Ekind (Entity (A)) = E_Variable
then
A_Id := Entity (A);
- if Async_Readers_Enabled (A_Id) then
- Property_Error (A, A_Id, Name_Async_Readers);
- elsif Effective_Reads_Enabled (A_Id) then
- Property_Error (A, A_Id, Name_Effective_Reads);
- elsif Effective_Writes_Enabled (A_Id) then
- Property_Error (A, A_Id, Name_Effective_Writes);
+ if Ekind (A_Id) = E_Variable
+ and then Is_Effectively_Volatile (Etype (A_Id))
+ and then Effective_Reads_Enabled (A_Id)
+ then
+ Error_Msg_NE
+ ("effectively volatile variable & cannot appear as "
+ & "actual in procedure call", A, A_Id);
+
+ Error_Msg_Name_1 := Name_Effective_Reads;
+ Error_Msg_N ("\\variable has enabled property %", A);
+ Error_Msg_N ("\\corresponding formal has mode IN", A);
end if;
end if;
end if;
then
if not Has_Pragma_Unmodified_Check_Spec (E) then
Error_Msg_N -- CODEFIX
- ("?u?variable & is assigned but never read!", E);
+ ("?m?variable & is assigned but never read!", E);
end if;
Set_Last_Assignment (E, Empty);
projects / gcc.git / commitdiff