+2017-12-15 Bob Duff <duff@adacore.com>
+
+ * exp_ch6.adb (Expand_N_Extended_Return_Statement): If the
+ Init_Assignment is rewritten, we need to set Assignment_OK on the new
+ node. Otherwise, we will get spurious errors when initializing via
+ assignment statement.
+
+2017-12-15 Arnaud Charlet <charlet@adacore.com>
+
+ * exp_unst.adb (Visit_Node): Refine handling of 'Access to ignore non
+ relevant nodes.
+ (Has_Non_Null_Statements): Moved to sem_util for later reuse.
+
+2017-12-15 Eric Botcazou <ebotcazou@adacore.com>
+
+ * exp_attr.adb (Is_Inline_Floating_Point_Attribute): Fix comment.
+ * libgnat/s-fatgen.adb (Model): Use Machine attribute.
+ (Truncation): Likewise.
+
+2017-12-15 Bob Duff <duff@adacore.com>
+
+ * exp_ch7.adb (Expand_Cleanup_Actions): Make sure the block and handled
+ statement sequence generated for certain extended return statements
+ have a Sloc that is not No_Location. Otherwise, the back end doesn't
+ set any location and ends up reading uninitialized variables.
+
2017-12-15 Bob Duff <duff@adacore.com>
* types.ads, exp_ch6.adb, libgnat/s-regexp.ads, opt.ads: Partly revert
-- Start of processing for Is_Inline_Floating_Point_Attribute
begin
- -- Machine and Model can be expanded by the GCC and AAMP back ends only
+ -- Machine and Model can be expanded by the GCC back end only
if Id = Attribute_Machine or else Id = Attribute_Model then
return Is_GCC_Target;
Rewrite (Name (Init_Assignment),
Make_Explicit_Dereference (Loc,
Prefix => New_Occurrence_Of (Alloc_Obj_Id, Loc)));
+ pragma Assert
+ (Assignment_OK
+ (Original_Node (Name (Init_Assignment))));
+ Set_Assignment_OK (Name (Init_Assignment));
Set_Etype (Name (Init_Assignment), Etype (Ret_Obj_Id));
begin
-- ???For now, enable build-in-place for a very narrow set of
-- controlled types. Change "if True" to "if False" to
- -- experiment more controlled types. Eventually, we would
+ -- experiment with more controlled types. Eventually, we might
-- like to enable build-in-place for all tagged types, all
-- types that need finalization, and all caller-unknown-size
-- types.
return;
end if;
- -- If we are generating expanded code for debugging purposes, use the
- -- Sloc of the point of insertion for the cleanup code. The Sloc will be
- -- updated subsequently to reference the proper line in .dg files. If we
- -- are not debugging generated code, use No_Location instead, so that
- -- no debug information is generated for the cleanup code. This makes
- -- the behavior of the NEXT command in GDB monotonic, and makes the
- -- placement of breakpoints more accurate.
-
- if Debug_Generated_Code then
- Loc := Sloc (Scop);
- else
- Loc := No_Location;
- end if;
-
-- If an extended return statement contains something like
-- X := F (...);
-- where F is a build-in-place function call returning a controlled
if Nkind (N) = N_Extended_Return_Statement then
declare
Block : constant Node_Id :=
- Make_Block_Statement (Loc,
+ Make_Block_Statement (Sloc (N),
Declarations => Empty_List,
Handled_Statement_Sequence =>
Handled_Statement_Sequence (N));
begin
Set_Handled_Statement_Sequence
- (N, Make_Handled_Sequence_Of_Statements (Loc,
+ (N, Make_Handled_Sequence_Of_Statements (Sloc (N),
Statements => New_List (Block)));
Analyze (Block);
end;
Old_Poll : Boolean;
begin
+ -- If we are generating expanded code for debugging purposes, use the
+ -- Sloc of the point of insertion for the cleanup code. The Sloc will
+ -- be updated subsequently to reference the proper line in .dg files.
+ -- If we are not debugging generated code, use No_Location instead,
+ -- so that no debug information is generated for the cleanup code.
+ -- This makes the behavior of the NEXT command in GDB monotonic, and
+ -- makes the placement of breakpoints more accurate.
+
+ if Debug_Generated_Code then
+ Loc := Sloc (Scop);
+ else
+ Loc := No_Location;
+ end if;
+
-- Set polling off. The finalization and cleanup code is executed
-- with aborts deferred.
| Attribute_Unchecked_Access
| Attribute_Unrestricted_Access
=>
- Ent := Entity (Prefix (N));
+ if Nkind (Prefix (N)) in N_Has_Entity then
+ Ent := Entity (Prefix (N));
- -- We are only interested in calls to subprograms
- -- nested within Subp.
+ -- We are only interested in calls to subprograms
+ -- nested within Subp.
- if Scope_Within (Ent, Subp) then
- if Is_Imported (Ent) then
- null;
+ if Scope_Within (Ent, Subp) then
+ if Is_Imported (Ent) then
+ null;
- elsif Is_Subprogram (Ent) then
- Append_Unique_Call
- ((N, Current_Subprogram, Ent));
+ elsif Is_Subprogram (Ent) then
+ Append_Unique_Call
+ ((N, Current_Subprogram, Ent));
+ end if;
end if;
end if;
function Model (X : T) return T is
begin
- return Machine (X);
+ return T'Machine (X);
end Model;
----------
Result := abs X;
if Result >= Radix_To_M_Minus_1 then
- return Machine (X);
+ return T'Machine (X);
else
- Result := Machine (Radix_To_M_Minus_1 + Result) - Radix_To_M_Minus_1;
+ Result :=
+ T'Machine (Radix_To_M_Minus_1 + Result) - Radix_To_M_Minus_1;
if Result > abs X then
Result := Result - 1.0;
and then Nkind (Node (First_Elmt (Constits))) /= N_Null;
end Has_Non_Null_Refinement;
+ -----------------------------
+ -- Has_Non_Null_Statements --
+ -----------------------------
+
+ function Has_Non_Null_Statements (L : List_Id) return Boolean is
+ Node : Node_Id;
+
+ begin
+ if Is_Non_Empty_List (L) then
+ Node := First (L);
+
+ loop
+ if Nkind (Node) /= N_Null_Statement then
+ return True;
+ end if;
+
+ Next (Node);
+ exit when Node = Empty;
+ end loop;
+ end if;
+
+ return False;
+ end Has_Non_Null_Statements;
+
----------------------------------
-- Has_Non_Trivial_Precondition --
----------------------------------
-- in pragma Refined_State. This function does not take into account the
-- visible refinement region of abstract state Id.
+ function Has_Non_Null_Statements (L : List_Id) return Boolean;
+ -- Return True if L has non-null statements
+
function Has_Overriding_Initialize (T : Entity_Id) return Boolean;
-- Predicate to determine whether a controlled type has a user-defined
-- Initialize primitive (and, in Ada 2012, whether that primitive is
projects / gcc.git / commitdiff