+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
s-bignum$(objext) \
s-bitops$(objext) \
s-boarop$(objext) \
+ s-boustr$(objext) \
s-bytswa$(objext) \
s-carsi8$(objext) \
s-carun8$(objext) \
-- 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
-- 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
end loop;
end Freeze_All_Ent;
+ -- Local variables
+
+ Decl : Node_Id;
+ E : Entity_Id;
+ Item : Entity_Id;
+
-- Start of processing for Freeze_All
begin
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
-- 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),
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
-- 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
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;
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;
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
projects / gcc.git / commitdiff