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

[multiple changes]

Browse source 
2017-01-20  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Access_Type_Declaration): Protect access to the
	Entity attribute.
	* sem_ch10.adb (Install_Siblings): Skip processing malformed trees.
	* sem_cat.adb (Validate_Categoriztion_Dependency): Skip processing
	malformed trees.

2017-01-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specification, case
	Dynamic_Predicate): If the entity E is a subtype that inherits
	a static predicate for its parent P,, the inherited and the
	new predicate combine in the generated predicate function,
	and E only has a dynamic predicate.

2017-01-20  Tristan Gingold  <gingold@adacore.com>

	* s-boustr.ads, s-boustr.adb: New package.
	* Makefile.rtl: Add s-boustr.

2017-01-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* inline.adb (Process_Formals): Qualify the
	expression of a return statement when it yields a universal type.

2017-01-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* freeze.adb (Freeze_All): Freeze the default
	expressions of all eligible formal parameters that appear in
	entries, entry families, and protected subprograms.

From-SVN: r244701
This commit is contained in:
Arnaud Charlet 2017-01-20 11:42:43 +01:00
parent 4f324de225
commit 89a53f83d8
10 changed files with 230 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
gcc/ada/ChangeLog
View file

@ -1,3 +1,35 @@
2017-01-20 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Access_Type_Declaration): Protect access to the
Entity attribute.
* sem_ch10.adb (Install_Siblings): Skip processing malformed trees.
* sem_cat.adb (Validate_Categoriztion_Dependency): Skip processing
malformed trees.
2017-01-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Specification, case
Dynamic_Predicate): If the entity E is a subtype that inherits
a static predicate for its parent P,, the inherited and the
new predicate combine in the generated predicate function,
and E only has a dynamic predicate.
2017-01-20 Tristan Gingold <gingold@adacore.com>
* s-boustr.ads, s-boustr.adb: New package.
* Makefile.rtl: Add s-boustr.
2017-01-20 Hristian Kirtchev <kirtchev@adacore.com>
* inline.adb (Process_Formals): Qualify the
expression of a return statement when it yields a universal type.
2017-01-20 Hristian Kirtchev <kirtchev@adacore.com>
* freeze.adb (Freeze_All): Freeze the default
expressions of all eligible formal parameters that appear in
entries, entry families, and protected subprograms.
2017-01-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Check_Nonoverridable_Aspects); Refine check

1
gcc/ada/Makefile.rtl
View file

@ -493,6 +493,7 @@ GNATRTL_NONTASKING_OBJS= \
s-bignum$(objext) \
s-bitops$(objext) \
s-boarop$(objext) \
s-boustr$(objext) \
s-bytswa$(objext) \
s-carsi8$(objext) \
s-carun8$(objext) \

46
gcc/ada/freeze.adb
View file

@ -1688,9 +1688,6 @@ package body Freeze is
-- as they are generated.
procedure Freeze_All (From : Entity_Id; After : in out Node_Id) is
E : Entity_Id;
Decl : Node_Id;
procedure Freeze_All_Ent (From : Entity_Id; After : in out Node_Id);
-- This is the internal recursive routine that does freezing of entities
-- (but NOT the analysis of default expressions, which should not be
@ -1863,10 +1860,10 @@ package body Freeze is
-- current package, but this body does not freeze incomplete
-- types that may be declared in this private part.
if (Nkind_In (Bod, N_Subprogram_Body,
N_Entry_Body,
if (Nkind_In (Bod, N_Entry_Body,
N_Package_Body,
N_Protected_Body,
N_Subprogram_Body,
N_Task_Body)
or else Nkind (Bod) in N_Body_Stub)
and then
@ -1885,6 +1882,12 @@ package body Freeze is
end loop;
end Freeze_All_Ent;
-- Local variables
Decl : Node_Id;
E : Entity_Id;
Item : Entity_Id;
-- Start of processing for Freeze_All
begin
@ -1925,33 +1928,28 @@ package body Freeze is
elsif Nkind (Decl) = N_Subprogram_Declaration
and then Present (Corresponding_Body (Decl))
and then
Nkind (Unit_Declaration_Node (Corresponding_Body (Decl)))
= N_Subprogram_Renaming_Declaration
Nkind (Unit_Declaration_Node (Corresponding_Body (Decl))) =
N_Subprogram_Renaming_Declaration
then
Build_And_Analyze_Renamed_Body
(Decl, Corresponding_Body (Decl), After);
end if;
end if;
elsif Ekind (E) in Task_Kind
and then Nkind_In (Parent (E), N_Task_Type_Declaration,
N_Single_Task_Declaration)
then
declare
Ent : Entity_Id;
-- Freeze the default expressions of entries, entry families, and
-- protected subprograms.
begin
Ent := First_Entity (E);
while Present (Ent) loop
if Is_Entry (Ent)
and then not Default_Expressions_Processed (Ent)
then
Process_Default_Expressions (Ent, After);
end if;
elsif Is_Concurrent_Type (E) then
Item := First_Entity (E);
while Present (Item) loop
if (Is_Entry (Item) or else Is_Subprogram (Item))
and then not Default_Expressions_Processed (Item)
then
Process_Default_Expressions (Item, After);
end if;
Next_Entity (Ent);
end loop;
end;
Next_Entity (Item);
end loop;
end if;
-- Historical note: We used to create a finalization master for an

11
gcc/ada/inline.adb
View file

@ -2483,13 +2483,12 @@ package body Inline is
-- errors, e.g. when the expression is a numeric literal and
-- the context is private. If the expression is an aggregate,
-- use a qualified expression, because an aggregate is not a
-- legal argument of a conversion. Ditto for numeric literals,
-- which must be resolved to a specific type.
-- legal argument of a conversion. Ditto for numeric literals
-- and attributes that yield a universal type, because those
-- must be resolved to a specific type.
if Nkind_In (Expression (N), N_Aggregate,
N_Null,
N_Real_Literal,
N_Integer_Literal)
if Nkind_In (Expression (N), N_Aggregate, N_Null)
or else Yields_Universal_Type (Expression (N))
then
Ret :=
Make_Qualified_Expression (Sloc (N),

95
gcc/ada/s-boustr.adb Normal file
View file

@ -0,0 +1,95 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . B O U N D E D _ S T R I N G S --
-- --
-- B o d y --
-- --
-- Copyright (C) 2016, 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with System.Storage_Elements;
package body System.Bounded_Strings is
------------
-- Append --
------------
procedure Append (X : in out Bounded_String; C : Character) is
begin
-- If we have too many characters to fit, simply drop them
if X.Length < X.Max_Length then
X.Length := X.Length + 1;
X.Chars (X.Length) := C;
end if;
end Append;
procedure Append (X : in out Bounded_String; S : String) is
begin
for C of S loop
Append (X, C);
end loop;
end Append;
--------------------
-- Append_Address --
--------------------
procedure Append_Address (X : in out Bounded_String; A : Address)
is
S : String (1 .. 18);
P : Natural;
use System.Storage_Elements;
N : Integer_Address;
H : constant array (Integer range 0 .. 15) of Character :=
"0123456789abcdef";
begin
P := S'Last;
N := To_Integer (A);
loop
S (P) := H (Integer (N mod 16));
P := P - 1;
N := N / 16;
exit when N = 0;
end loop;
S (P - 1) := '0';
S (P) := 'x';
Append (X, S (P - 1 .. S'Last));
end Append_Address;
---------------
-- To_String --
---------------
function To_String (X : Bounded_String) return String is
begin
return X.Chars (1 .. X.Length);
end To_String;
end System.Bounded_Strings;

59
gcc/ada/s-boustr.ads Normal file
View file

@ -0,0 +1,59 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- S Y S T E M . B O U N D E D _ S T R I N G S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2016, 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- A very simple implentation of bounded strings, used by tracebacks
package System.Bounded_Strings is
type Bounded_String (Max_Length : Natural) is limited private;
-- A string whose length is bounded by Max_Length. The bounded string is
-- empty at initialization.
procedure Append (X : in out Bounded_String; C : Character);
procedure Append (X : in out Bounded_String; S : String);
-- Append a character or a string to X. If the bounded string is full,
-- extra characters are simply dropped.
function To_String (X : Bounded_String) return String;
function "+" (X : Bounded_String) return String renames To_String;
-- Convert to a normal string
procedure Append_Address (X : in out Bounded_String; A : Address);
-- Append an address to X
private
type Bounded_String (Max_Length : Natural) is limited record
Length : Natural := 0;
-- Current length of the string
Chars : String (1 .. Max_Length);
-- String content
end record;
end System.Bounded_Strings;

3
gcc/ada/sem_cat.adb
View file

@ -1026,6 +1026,9 @@ package body Sem_Cat is
-- generic instantiation.
or else Error_Posted (Item))
and then not (Try_Semantics
-- Skip processing malformed trees
and then Nkind (Name (Item)) not in N_Has_Entity)
then
Entity_Of_Withed := Entity (Name (Item));
Check_Categorization_Dependencies

3
gcc/ada/sem_ch10.adb
View file

@ -4209,6 +4209,9 @@ package body Sem_Ch10 is
or else Implicit_With (Item)
or else Limited_Present (Item)
or else Error_Posted (Item)
-- Skip processing malformed trees
or else (Try_Semantics
and then Nkind (Name (Item)) not in N_Has_Entity)
then
null;

7
gcc/ada/sem_ch13.adb
View file

@ -2262,6 +2262,13 @@ package body Sem_Ch13 is
if A_Id = Aspect_Dynamic_Predicate then
Set_Has_Dynamic_Predicate_Aspect (E);
-- If the entity has a dynamic predicate, any inherited
-- static predicate becomes dynamic as well, and the
-- predicate function includes the conjunction of both.
Set_Has_Static_Predicate_Aspect (E, False);
elsif A_Id = Aspect_Static_Predicate then
Set_Has_Static_Predicate_Aspect (E);
end if;

4
gcc/ada/sem_ch3.adb
View file

@ -1333,7 +1333,9 @@ package body Sem_Ch3 is
if Nkind (S) /= N_Subtype_Indication then
Analyze (S);
if Ekind (Root_Type (Entity (S))) = E_Incomplete_Type then
if Present (Entity (S))
and then Ekind (Root_Type (Entity (S))) = E_Incomplete_Type
then
Set_Directly_Designated_Type (T, Entity (S));
-- If the designated type is a limited view, we cannot tell if