Commit 7188885e by Arnaud Charlet

[multiple changes]

2015-10-20  Bob Duff  <duff@adacore.com>

	* output.adb (Write_Int): Work with negative numbers in order to avoid
	negating Int'First and thereby causing overflow.
	* sem_util.adb: Minor comment fix.

2015-10-20  Eric Botcazou  <ebotcazou@adacore.com>

	* make.adb (Check): Skip multilib switches reinstated by the
	compiler when doing the comparison with switches passed to
	gnatmake.

2015-10-20  Yannick Moy  <moy@adacore.com>

	* inline.adb (Can_Be_Inlined_In_GNATprove_Mode): Return
	False for procedures marked No_Return.
	* sem_util.ads (Enclosing_Declaration): Improve comment.
	* einfo.adb (Is_Completely_Hidden): Remove spurious assertion.

From-SVN: r229029
parent f06f5f6b
2015-10-20 Bob Duff <duff@adacore.com>
* output.adb (Write_Int): Work with negative numbers in order to avoid
negating Int'First and thereby causing overflow.
* sem_util.adb: Minor comment fix.
2015-10-20 Eric Botcazou <ebotcazou@adacore.com>
* make.adb (Check): Skip multilib switches reinstated by the
compiler when doing the comparison with switches passed to
gnatmake.
2015-10-20 Yannick Moy <moy@adacore.com>
* inline.adb (Can_Be_Inlined_In_GNATprove_Mode): Return
False for procedures marked No_Return.
* sem_util.ads (Enclosing_Declaration): Improve comment.
* einfo.adb (Is_Completely_Hidden): Remove spurious assertion.
2015-10-20 Thomas Quinot <quinot@adacore.com>
* types.ads: Minor reformatting.
......
......@@ -1534,6 +1534,12 @@ package body Inline is
elsif In_Package_Visible_Spec (Id) then
return False;
-- Do not inline subprograms marked No_Return, possibly used for
-- signaling errors, which GNATprove handles specially.
elsif No_Return (Id) then
return False;
-- Do not inline subprograms that have a contract on the spec or the
-- body. Use the contract(s) instead in GNATprove.
......
......@@ -1720,12 +1720,17 @@ package body Make is
for J in 1 .. Last_Argument loop
-- Skip non switches -c, -I and -o switches
-- Skip -c, -I and -o switches, as well as multilib switches
-- reinstated by the compiler according to lang-specs.h.
if Arguments (J) (1) = '-'
and then Arguments (J) (2) /= 'c'
and then Arguments (J) (2) /= 'o'
and then Arguments (J) (2) /= 'I'
and then not (Arguments (J)'Length = 5
and then Arguments (J) (2 .. 5) = "mrtp")
and then not (Arguments (J)'Length = 6
and then Arguments (J) (2 .. 6) = "fsjlj")
then
Normalize_Compiler_Switches
(Arguments (J).all,
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
......@@ -350,6 +350,7 @@ package body Output is
procedure Write_Char (C : Character) is
begin
pragma Assert (Next_Col in Buffer'Range);
if Next_Col = Buffer'Length then
Write_Eol;
end if;
......@@ -406,17 +407,29 @@ package body Output is
---------------
procedure Write_Int (Val : Int) is
-- Type Int has one extra negative number (i.e. two's complement), so we
-- work with negative numbers here. Otherwise, negating Int'First will
-- overflow.
subtype Nonpositive is Int range Int'First .. 0;
procedure Write_Abs (Val : Nonpositive);
-- Write out the absolute value of Val
procedure Write_Abs (Val : Nonpositive) is
begin
if Val < -9 then
Write_Abs (Val / 10); -- Recursively write higher digits
end if;
Write_Char (Character'Val (-(Val rem 10) + Character'Pos ('0')));
end Write_Abs;
begin
if Val < 0 then
Write_Char ('-');
Write_Int (-Val);
Write_Abs (Val);
else
if Val > 9 then
Write_Int (Val / 10);
end if;
Write_Char (Character'Val ((Val mod 10) + Character'Pos ('0')));
Write_Abs (-Val);
end if;
end Write_Int;
......
......@@ -17148,14 +17148,16 @@ package body Sem_Util is
then
return New_Requires_Transient_Scope (Cloned_Subtype (Typ));
-- Functions returning tagged types may dispatch on result so their
-- returned value is allocated on the secondary stack, even in the
-- definite case. Is_Tagged_Type includes controlled types and
-- class-wide types. Controlled type temporaries need finalization.
-- Functions returning specific tagged types may dispatch on result, so
-- their returned value is allocated on the secondary stack, even in the
-- definite case. We must treat nondispatching functions the same way,
-- because access-to-function types can point at both, so the calling
-- conventions must be compatible. Is_Tagged_Type includes controlled
-- types and class-wide types. Controlled type temporaries need
-- finalization.
-- ???It's not clear why we need to return noncontrolled types with
-- controlled components on the secondary stack. Also, it's not clear
-- why nonprimitive tagged type functions need the secondary stack,
-- since they can't be called via dispatching.
-- controlled components on the secondary stack.
elsif Is_Tagged_Type (Typ) or else Has_Controlled_Component (Typ) then
return True;
......
......@@ -532,7 +532,8 @@ package Sem_Util is
-- Returns the closest ancestor of Typ that is a CPP type.
function Enclosing_Declaration (N : Node_Id) return Node_Id;
-- Returns the declaration node enclosing N, if any, or Empty otherwise
-- Returns the declaration node enclosing N (including possibly N itself),
-- if any, or Empty otherwise
function Enclosing_Generic_Body
(N : Node_Id) return Node_Id;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment