procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2015-10-16  Javier Miranda  <miranda@adacore.com>

	* inline.adb (Add_Inlined_Body): Ensure that
	Analyze_Inlined_Bodies will be invoked after completing the
	analysis of the current unit.

2015-10-16  Arnaud Charlet  <charlet@adacore.com>

	* sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order): Fix error
	message for bad last bit position.
	* sem_ch3.adb, sem_util.adb, sem_util.ads: Minor reformatting.

2015-10-16  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_N_Case_Statement): If expression is
	compile-time known but does not obey a static predicate on
	its type, replace the case statement with a raise statement,
	as with other statically detected constraint violations.

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

	* s-traceb.adb, s-traceb.ads, s-traceb-hpux.adb, s-traceb-mastop.adb:
	Reinstate code.
	* opt.ads: Minor typo.

From-SVN: r228866
This commit is contained in:
Arnaud Charlet 2015-10-16 12:44:09 +02:00
parent 251b6a477e
commit 113522092b
12 changed files with 96 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
gcc/ada/ChangeLog
View file

@ -1,3 +1,28 @@
2015-10-16 Javier Miranda <miranda@adacore.com>
* inline.adb (Add_Inlined_Body): Ensure that
Analyze_Inlined_Bodies will be invoked after completing the
analysis of the current unit.
2015-10-16 Arnaud Charlet <charlet@adacore.com>
* sem_ch13.adb (Adjust_Record_For_Reverse_Bit_Order): Fix error
message for bad last bit position.
* sem_ch3.adb, sem_util.adb, sem_util.ads: Minor reformatting.
2015-10-16 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Expand_N_Case_Statement): If expression is
compile-time known but does not obey a static predicate on
its type, replace the case statement with a raise statement,
as with other statically detected constraint violations.
2015-10-16 Bob Duff <duff@adacore.com>
* s-traceb.adb, s-traceb.ads, s-traceb-hpux.adb, s-traceb-mastop.adb:
Reinstate code.
* opt.ads: Minor typo.
2015-10-16 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (Gather_Components): When gathering components

13
gcc/ada/exp_ch5.adb
View file

@ -2590,9 +2590,20 @@ package body Exp_Ch5 is
-- If the value is static but its subtype is predicated and the value
-- does not obey the predicate, the value is marked non-static, and
-- there can be no corresponding static alternative.
-- there can be no corresponding static alternative. In that case we
-- replace the case statement with an exception, regardless of whether
-- assertions are enabled or not.
if Compile_Time_Known_Value (Expr)
and then Has_Predicates (Etype (Expr))
and then not Is_OK_Static_Expression (Expr)
then
Rewrite (N,
Make_Raise_Constraint_Error (Loc, Reason => CE_Invalid_Data));
Analyze (N);
return;
elsif Compile_Time_Known_Value (Expr)
and then (not Has_Predicates (Etype (Expr))
or else Is_Static_Expression (Expr))
then

5
gcc/ada/inline.adb
View file

@ -405,6 +405,11 @@ package body Inline is
Pack : constant Entity_Id := Get_Code_Unit_Entity (E);
begin
-- Ensure that Analyze_Inlined_Bodies will be invoked after
-- completing the analysis of the current unit.
Inline_Processing_Required := True;
if Pack = E then
-- Library-level inlined function. Add function itself to

2
gcc/ada/opt.ads
View file

@ -819,7 +819,7 @@ package Opt is
-- be inlined in GNATprove mode.
Init_Or_Norm_Scalars : Boolean := False;
-- GNAT, GANTBIND
-- GNAT, GNATBIND
-- Set True if a pragma Initialize_Scalars applies to the current unit.
-- Also set True if a pragma Restriction (Normalize_Scalars) applies.

19
gcc/ada/s-traceb-hpux.adb
View file

@ -7,7 +7,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2009-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2009-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- --
@ -262,15 +262,14 @@ package body System.Traceback is
-- but it is not usable when frames with dynamically allocated space are
-- on the way.
-- procedure Call_Chain
-- (Traceback : System.Address;
-- Max_Len : Natural;
-- Len : out Natural;
-- Exclude_Min : System.Address := System.Null_Address;
-- Exclude_Max : System.Address := System.Null_Address;
-- Skip_Frames : Natural := 1);
-- -- Same as the exported version, but takes Traceback as an Address
-- ???See declaration in the spec for why this is temporarily commented out.
procedure Call_Chain
(Traceback : System.Address;
Max_Len : Natural;
Len : out Natural;
Exclude_Min : System.Address := System.Null_Address;
Exclude_Max : System.Address := System.Null_Address;
Skip_Frames : Natural := 1);
-- Same as the exported version, but takes Traceback as an Address
------------------
-- C_Call_Chain --

19
gcc/ada/s-traceb-mastop.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2014, AdaCore --
-- Copyright (C) 1999-2015, AdaCore --
-- --
-- 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- --
@ -37,15 +37,14 @@ package body System.Traceback is
use System.Machine_State_Operations;
-- procedure Call_Chain
-- (Traceback : System.Address;
-- Max_Len : Natural;
-- Len : out Natural;
-- Exclude_Min : System.Address := System.Null_Address;
-- Exclude_Max : System.Address := System.Null_Address;
-- Skip_Frames : Natural := 1);
-- -- Same as the exported version, but takes Traceback as an Address
-- ???See declaration in the spec for why this is temporarily commented out.
procedure Call_Chain
(Traceback : System.Address;
Max_Len : Natural;
Len : out Natural;
Exclude_Min : System.Address := System.Null_Address;
Exclude_Max : System.Address := System.Null_Address;
Skip_Frames : Natural := 1);
-- Same as the exported version, but takes Traceback as an Address
----------------
-- Call_Chain --

11
gcc/ada/s-traceb.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1999-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1999-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- --
@ -38,6 +38,15 @@ pragma Compiler_Unit_Warning;
package body System.Traceback is
procedure Call_Chain
(Traceback : System.Address;
Max_Len : Natural;
Len : out Natural;
Exclude_Min : System.Address := System.Null_Address;
Exclude_Max : System.Address := System.Null_Address;
Skip_Frames : Natural := 1);
-- Same as the exported version, but takes Traceback as an Address
------------------
-- C_Call_Chain --
------------------

15
gcc/ada/s-traceb.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1999-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- --
@ -78,19 +78,6 @@ package System.Traceback is
-- number of stored entries. The first entry is the most recent call,
-- and the last entry is the highest level call.
procedure Call_Chain
(Traceback : System.Address;
Max_Len : Natural;
Len : out Natural;
Exclude_Min : System.Address := System.Null_Address;
Exclude_Max : System.Address := System.Null_Address;
Skip_Frames : Natural := 1);
-- Same as the previous version, but takes Traceback as an Address. The
-- previous version is preferred. ???This version should be removed from
-- this spec, and calls replaced with calls to the previous version. This
-- declaration can be moved to the bodies (s-traceb.adb, s-traceb-hpux.adb,
-- and s-traceb-mastop.adb), but it should not be visible to clients.
function C_Call_Chain
(Traceback : System.Address;
Max_Len : Natural) return Natural;

6
gcc/ada/sem_ch13.adb
View file

@ -471,10 +471,10 @@ package body Sem_Ch13 is
("machine scalar rules not followed for&",
First_Bit (CC), Comp);
Error_Msg_Uint_1 := Lbit;
Error_Msg_Uint_1 := Lbit + 1;
Error_Msg_Uint_2 := Max_Machine_Scalar_Size;
Error_Msg_F
("\last bit (^) exceeds maximum machine "
("\last bit + 1 (^) exceeds maximum machine "
& "scalar size (^)",
First_Bit (CC));
@ -482,7 +482,7 @@ package body Sem_Ch13 is
Error_Msg_Uint_1 := SSU;
Error_Msg_F
("\and is not a multiple of Storage_Unit (^) "
& "(RM 13.4.1(10))",
& "(RM 13.5.1(10))",
First_Bit (CC));
else

12
gcc/ada/sem_ch3.adb
View file

@ -17945,9 +17945,9 @@ package body Sem_Ch3 is
(C : Entity_Id;
N : Node_Id := Empty) return Boolean
is
Original_Comp : Entity_Id := Empty;
Original_Comp : Entity_Id := Empty;
Original_Type : Entity_Id;
Type_Scope : Entity_Id;
Type_Scope : Entity_Id;
function Is_Local_Type (Typ : Entity_Id) return Boolean;
-- Check whether parent type of inherited component is declared locally,
@ -18088,9 +18088,9 @@ package body Sem_Ch3 is
if Ancestor = Original_Type then
return True;
-- The ancestor may have a partial view of the original
-- type, but if the full view is in scope, as in a child
-- body, the component is visible.
-- The ancestor may have a partial view of the original type,
-- but if the full view is in scope, as in a child body, the
-- component is visible.
elsif In_Private_Part (Scope (Original_Type))
and then Full_View (Ancestor) = Original_Type
@ -18099,7 +18099,7 @@ package body Sem_Ch3 is
elsif Ancestor = Etype (Ancestor) then
-- No further ancestors to examine.
-- No further ancestors to examine
return False;
end if;

19
gcc/ada/sem_util.adb
View file

@ -17109,6 +17109,10 @@ package body Sem_Util is
-- This shouldn't be necessary, but without this check, we crash in
-- gimplify. ???
------------------------------
-- Caller_Known_Size_Record --
------------------------------
function Caller_Known_Size_Record (Typ : Entity_Id) return Boolean is
pragma Assert (Typ = Underlying_Type (Typ));
@ -17118,9 +17122,10 @@ package body Sem_Util is
end if;
declare
Comp : Entity_Id := First_Entity (Typ);
Comp : Entity_Id;
begin
Comp := First_Entity (Typ);
while Present (Comp) loop
-- Only look at E_Component entities. No need to look at
@ -17156,6 +17161,10 @@ package body Sem_Util is
return True;
end Caller_Known_Size_Record;
---------------------------
-- Has_Discrim_Dep_Array --
---------------------------
function Has_Discrim_Dep_Array (Typ : Entity_Id) return Boolean is
pragma Assert (Typ = Underlying_Type (Typ));
@ -17165,13 +17174,14 @@ package body Sem_Util is
end if;
if Is_Record_Type (Typ)
or else
Is_Protected_Type (Typ)
or else
Is_Protected_Type (Typ)
then
declare
Comp : Entity_Id := First_Entity (Typ);
Comp : Entity_Id;
begin
Comp := First_Entity (Typ);
while Present (Comp) loop
-- Only look at E_Component entities. No need to look at
@ -17182,7 +17192,6 @@ package body Sem_Util is
declare
Comp_Type : constant Entity_Id :=
Underlying_Type (Etype (Comp));
begin
if Has_Discrim_Dep_Array (Comp_Type) then
return True;

2
gcc/ada/sem_util.ads
View file

@ -823,7 +823,7 @@ package Sem_Util is
-- returned. Otherwise the Etype of the node is returned.
function Get_Body_From_Stub (N : Node_Id) return Node_Id;
-- Return the body node for a stub.
-- Return the body node for a stub
function Get_Cursor_Type
(Aspect : Node_Id;