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> 2015-10-20 Thomas Quinot <quinot@adacore.com>
* types.ads: Minor reformatting. * types.ads: Minor reformatting.
......
...@@ -1534,6 +1534,12 @@ package body Inline is ...@@ -1534,6 +1534,12 @@ package body Inline is
elsif In_Package_Visible_Spec (Id) then elsif In_Package_Visible_Spec (Id) then
return False; 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 -- Do not inline subprograms that have a contract on the spec or the
-- body. Use the contract(s) instead in GNATprove. -- body. Use the contract(s) instead in GNATprove.
......
...@@ -1720,12 +1720,17 @@ package body Make is ...@@ -1720,12 +1720,17 @@ package body Make is
for J in 1 .. Last_Argument loop 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) = '-' if Arguments (J) (1) = '-'
and then Arguments (J) (2) /= 'c' and then Arguments (J) (2) /= 'c'
and then Arguments (J) (2) /= 'o' and then Arguments (J) (2) /= 'o'
and then Arguments (J) (2) /= 'I' 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 then
Normalize_Compiler_Switches Normalize_Compiler_Switches
(Arguments (J).all, (Arguments (J).all,
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -350,6 +350,7 @@ package body Output is ...@@ -350,6 +350,7 @@ package body Output is
procedure Write_Char (C : Character) is procedure Write_Char (C : Character) is
begin begin
pragma Assert (Next_Col in Buffer'Range);
if Next_Col = Buffer'Length then if Next_Col = Buffer'Length then
Write_Eol; Write_Eol;
end if; end if;
...@@ -406,17 +407,29 @@ package body Output is ...@@ -406,17 +407,29 @@ package body Output is
--------------- ---------------
procedure Write_Int (Val : Int) 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 begin
if Val < 0 then if Val < 0 then
Write_Char ('-'); Write_Char ('-');
Write_Int (-Val); Write_Abs (Val);
else else
if Val > 9 then Write_Abs (-Val);
Write_Int (Val / 10);
end if;
Write_Char (Character'Val ((Val mod 10) + Character'Pos ('0')));
end if; end if;
end Write_Int; end Write_Int;
......
...@@ -17148,14 +17148,16 @@ package body Sem_Util is ...@@ -17148,14 +17148,16 @@ package body Sem_Util is
then then
return New_Requires_Transient_Scope (Cloned_Subtype (Typ)); return New_Requires_Transient_Scope (Cloned_Subtype (Typ));
-- Functions returning tagged types may dispatch on result so their -- Functions returning specific tagged types may dispatch on result, so
-- returned value is allocated on the secondary stack, even in the -- their returned value is allocated on the secondary stack, even in the
-- definite case. Is_Tagged_Type includes controlled types and -- definite case. We must treat nondispatching functions the same way,
-- class-wide types. Controlled type temporaries need finalization. -- 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 -- ???It's not clear why we need to return noncontrolled types with
-- controlled components on the secondary stack. Also, it's not clear -- controlled components on the secondary stack.
-- why nonprimitive tagged type functions need the secondary stack,
-- since they can't be called via dispatching.
elsif Is_Tagged_Type (Typ) or else Has_Controlled_Component (Typ) then elsif Is_Tagged_Type (Typ) or else Has_Controlled_Component (Typ) then
return True; return True;
......
...@@ -532,7 +532,8 @@ package Sem_Util is ...@@ -532,7 +532,8 @@ package Sem_Util is
-- Returns the closest ancestor of Typ that is a CPP type. -- Returns the closest ancestor of Typ that is a CPP type.
function Enclosing_Declaration (N : Node_Id) return Node_Id; 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 function Enclosing_Generic_Body
(N : Node_Id) return Node_Id; (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