From 89a53f83d8494256c90b0658be00bc9cff38bf3b Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 20 Jan 2017 11:42:43 +0100 Subject: [PATCH] [multiple changes] 2017-01-20 Javier Miranda * 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 * 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 * s-boustr.ads, s-boustr.adb: New package. * Makefile.rtl: Add s-boustr. 2017-01-20 Hristian Kirtchev * inline.adb (Process_Formals): Qualify the expression of a return statement when it yields a universal type. 2017-01-20 Hristian Kirtchev * 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 --- gcc/ada/ChangeLog | 32 +++++++++++++++ gcc/ada/Makefile.rtl | 1 + gcc/ada/freeze.adb | 46 ++++++++++----------- gcc/ada/inline.adb | 11 +++-- gcc/ada/s-boustr.adb | 95 ++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/s-boustr.ads | 59 +++++++++++++++++++++++++++ gcc/ada/sem_cat.adb | 3 ++ gcc/ada/sem_ch10.adb | 3 ++ gcc/ada/sem_ch13.adb | 7 ++++ gcc/ada/sem_ch3.adb | 4 +- 10 files changed, 230 insertions(+), 31 deletions(-) create mode 100644 gcc/ada/s-boustr.adb create mode 100644 gcc/ada/s-boustr.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 654df038c67..03f1e983d63 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2017-01-20 Javier Miranda + + * 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 + + * 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 + + * s-boustr.ads, s-boustr.adb: New package. + * Makefile.rtl: Add s-boustr. + +2017-01-20 Hristian Kirtchev + + * inline.adb (Process_Formals): Qualify the + expression of a return statement when it yields a universal type. + +2017-01-20 Hristian Kirtchev + + * 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 * sem_ch3.adb (Check_Nonoverridable_Aspects); Refine check diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 5f5c3a84e0a..63b1a95e3a8 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -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) \ diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 2a5c416ba3f..c6cb52e9cec 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -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 diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 3b79bc32c07..049ebd8f70c 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -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), diff --git a/gcc/ada/s-boustr.adb b/gcc/ada/s-boustr.adb new file mode 100644 index 00000000000..ca07dbb0932 --- /dev/null +++ b/gcc/ada/s-boustr.adb @@ -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 -- +-- . -- +-- -- +-- 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; diff --git a/gcc/ada/s-boustr.ads b/gcc/ada/s-boustr.ads new file mode 100644 index 00000000000..6e81a49506c --- /dev/null +++ b/gcc/ada/s-boustr.ads @@ -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 -- +-- . -- +-- -- +-- 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; diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb index ba684e1268c..fbe5382c1b3 100644 --- a/gcc/ada/sem_cat.adb +++ b/gcc/ada/sem_cat.adb @@ -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 diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 53001058eee..180c025dfdb 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -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; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 5e4641e4753..c9832bef5e4 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index d8372737584..dbf126e933e 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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 -- 2.30.2