+2016-04-27 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_elab.adb (Check_Internal_Call): Do not
+ consider a call when it appears within pragma Initial_Condition
+ since the pragma is part of the elaboration statements of a
+ package body and may only call external subprograms or subprograms
+ whose body is already available.
+ (Within_Initial_Condition): New routine.
+
+2016-04-27 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_util.adb (Build_Procedure_Form): Prevent double generation
+ of the procedure form when dealing with an expression function
+ whose return type is an array.
+ * sem_ch3.adb: Fix out-of order Has_Predicates setting.
+ * exp_ch6.adb: Proper conversion for inherited operation in C.
+ * sem_ch6.adb: Code cleanup.
+
+2016-04-27 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * lib-xref.ads, sem_ch10.adb: minor style fix in comment
+ * g-socket.adb: Minor reformatting.
+ * sinfo.ads: Minor comment correction.
+ * sem_warn.ads: minor grammar fix in comment
+
2016-04-27 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (gnat_to_gnu_entity): Adjust prototype.
if not Comes_From_Source (Orig_Func)
and then Etype (Orig_Func) /= Etype (Func_Id)
then
- Last_Actual := Unchecked_Convert_To (Etype (Func_Id), Last_Actual);
+ Last_Actual :=
+ Make_Type_Conversion (Loc,
+ New_Occurrence_Of (Etype (Func_Id), Loc),
+ Last_Actual);
end if;
Append_To (Actuals,
Proc_Decl : Node_Id;
begin
- -- No action needed if this transformation was already done or in case
- -- of subprogram renaming declarations
+ -- No action needed if this transformation was already done, or in case
+ -- of subprogram renaming declarations.
if Nkind (Specification (N)) = N_Procedure_Specification
or else Nkind (N) = N_Subprogram_Renaming_Declaration
return;
end if;
+ -- Ditto when dealing with an expression function, where both the
+ -- original expression and the generated declaration end up being
+ -- expanded here.
+
+ if Rewritten_For_C (Subp) then
+ return;
+ end if;
+
Proc_Formals := New_List;
-- Create a list of formal parameters with the same types as the
procedure Raise_Host_Error (H_Error : Integer; Name : String) is
function Dedot (Value : String) return String is
- (if Value /= "" and then Value (Value'Last) = '.'
- then Value (Value'First .. Value'Last - 1) else Value);
+ (if Value /= "" and then Value (Value'Last) = '.' then
+ Value (Value'First .. Value'Last - 1)
+ else
+ Value);
-- Removes dot at the end of error message
+
begin
raise Host_Error with
Err_Code_Image (H_Error)
-- --
-- S p e c --
-- --
--- Copyright (C) 1998-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2016, 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- --
Table_Name => "Name_Deferred_References");
procedure Process_Deferred_References;
- -- This procedure is called from Frontend to process these table entries.
+ -- This procedure is called from Frontend to process these table entries
-----------------------------
-- SPARK Xrefs Information --
if Nkind (Unit_Node) = N_Package_Body then
-- If no Lib_Unit, then there was a serious previous error, so just
- -- ignore the entire analysis effort
+ -- ignore the entire analysis effort.
if No (Lib_Unit) then
Check_Error_Detected;
-- built. Still it is a cheap check and seems safer to make it.
if Has_Predicates (Priv_T) then
+ Set_Has_Predicates (Full_T);
+
if Present (Predicate_Function (Priv_T)) then
Set_Predicate_Function (Full_T, Predicate_Function (Priv_T));
end if;
-
- Set_Has_Predicates (Full_T);
end if;
end Process_Full_View;
-- has already been created. We reuse the source body of the function,
-- because in an instance it may contain global references that cannot
-- be reanalyzed. The source function itself is not used any further,
- -- so we mark it as having a completion.
+ -- so we mark it as having a completion. If the subprogram is a stub the
+ -- transformation is done later, when the proper body is analyzed.
if Expander_Active
and then Modify_Tree_For_C
and then Present (Spec_Id)
and then Ekind (Spec_Id) = E_Function
+ and then Nkind (N) /= N_Subprogram_Body_Stub
and then Rewritten_For_C (Spec_Id)
then
Set_Has_Completion (Spec_Id);
-- --
-- B o d y --
-- --
--- Copyright (C) 1997-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1997-2016, 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- --
Table_Increment => 100,
Table_Name => "Elab_Visited");
- -- This table stores calls to Check_Internal_Call that are delayed
- -- until all generics are instantiated, and in particular that all
- -- generic bodies have been inserted. We need to delay, because we
- -- need to be able to look through the inserted bodies.
+ -- This table stores calls to Check_Internal_Call that are delayed until
+ -- all generics are instantiated and in particular until after all generic
+ -- bodies have been inserted. We need to delay, because we need to be able
+ -- to look through the inserted bodies.
type Delay_Element is record
N : Node_Id;
- -- The parameter N from the call to Check_Internal_Call. Note that
- -- this node may get rewritten over the delay period by expansion
- -- in the call case (but not in the instantiation case).
+ -- The parameter N from the call to Check_Internal_Call. Note that this
+ -- node may get rewritten over the delay period by expansion in the call
+ -- case (but not in the instantiation case).
E : Entity_Id;
-- The parameter E from the call to Check_Internal_Call
-- The parameter Orig_Ent from the call to Check_Internal_Call
Curscop : Entity_Id;
- -- The current scope of the call. This is restored when we complete
- -- the delayed call, so that we do this in the right scope.
+ -- The current scope of the call. This is restored when we complete the
+ -- delayed call, so that we do this in the right scope.
From_Elab_Code : Boolean;
-- Save indication of whether this call is from elaboration code
Outer_Scope : Entity_Id;
Orig_Ent : Entity_Id)
is
+ function Within_Initial_Condition (Call : Node_Id) return Boolean;
+ -- Determine whether call Call occurs within pragma Initial_Condition or
+ -- pragma Check with check_kind set to Initial_Condition.
+
+ ------------------------------
+ -- Within_Initial_Condition --
+ ------------------------------
+
+ function Within_Initial_Condition (Call : Node_Id) return Boolean is
+ Args : List_Id;
+ Nam : Name_Id;
+ Par : Node_Id;
+
+ begin
+ -- Traverse the parent chain looking for an enclosing pragma
+
+ Par := Call;
+ while Present (Par) loop
+ if Nkind (Par) = N_Pragma then
+ Nam := Pragma_Name (Par);
+
+ -- Pragma Initial_Condition appears in its alternative from as
+ -- Check (Initial_Condition, ...).
+
+ if Nam = Name_Check then
+ Args := Pragma_Argument_Associations (Par);
+
+ -- Pragma Check should have at least two arguments
+
+ pragma Assert (Present (Args));
+
+ return
+ Chars (Expression (First (Args))) = Name_Initial_Condition;
+
+ -- Direct match
+
+ elsif Nam = Name_Initial_Condition then
+ return True;
+
+ -- Since pragmas are never nested within other pragmas, stop
+ -- the traversal.
+
+ else
+ return False;
+ end if;
+
+ -- Prevent the search from going too far
+
+ elsif Is_Body_Or_Package_Declaration (Par) then
+ exit;
+ end if;
+
+ Par := Parent (Par);
+ end loop;
+
+ return False;
+ end Within_Initial_Condition;
+
+ -- Local variables
+
Inst_Case : constant Boolean := Nkind (N) in N_Generic_Instantiation;
+ -- Start of processing for Check_Internal_Call
+
begin
-- For P'Access, we want to warn if the -gnatw.f switch is set, and the
-- node comes from source.
- if Nkind (N) = N_Attribute_Reference and then
- (not Warn_On_Elab_Access or else not Comes_From_Source (N))
+ 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)
+ elsif not Nkind_In (N, N_Attribute_Reference,
+ N_Function_Call,
+ N_Procedure_Call_Statement)
and then not Inst_Case
then
return;
elsif Inside_A_Generic then
return;
+
+ -- Nothing to do when the call appears within pragma Initial_Condition.
+ -- The pragma is part of the elaboration statements of a package body
+ -- and may only call external subprograms or subprograms whose body is
+ -- already available.
+
+ elsif Within_Initial_Condition (N) then
+ return;
end if;
-- Delay this call if we are still delaying calls
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2016, 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- --
-- should only be made if at least one of the flags Warn_On_Modified_Unread
-- or Warn_On_All_Unread_Out_Parameters is True, and if Ent is in the
-- extended main source unit. N is Empty for the end of block call
- -- (warning message says value unreferenced), or the it is the node for
+ -- (warning message says value unreferenced), or it is the node for
-- an overwriting assignment (warning message points to this assignment).
procedure Warn_On_Useless_Assignments (E : Entity_Id);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
-- Note: aliased is not permitted in Ada 83 mode
- -- The N_Object_Declaration node is only for the first two cases.
+ -- The N_Object_Declaration node is only for the first three cases.
-- Single task declaration is handled by P_Task (9.1)
-- Single protected declaration is handled by P_protected (9.5)
git://gcc.gnu.org / gcc.git / commitdiff