+2017-09-07 Arnaud Charlet <charlet@adacore.com>
+
+ * sem_prag.adb (Collect_States_And_Objects): Detect also instances of
+ single concurrent objects.
+
+2017-09-07 Javier Miranda <miranda@adacore.com>
+
+ * s-regexp.ads: Fix documentation of the globbing grammar.
+
+2017-09-07 Gary Dismukes <dismukes@adacore.com>
+
+ * a-tags.ads, einfo.ads, exp_disp.ads: Minor reformatting.
+
+2017-09-07 Arnaud Charlet <charlet@adacore.com>
+
+ * gnat1drv.adb (Gnat1drv): Enable pragma Ignore_Pragma (Global)
+ in CodePeer mode, to support more legacy code automatically.
+
+2017-09-07 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_disp.adb (Replace_Formals): If thr formal is classwide,
+ and thus not a controlling argument, preserve its type after
+ rewriting because it may appear in an nested call with a classwide
+ parameter.
+
+2017-09-07 Arnaud Charlet <charlet@adacore.com>
+
+ * comperr.adb (Delete_SCIL_Files): Handle case of
+ N_Package_Instantiation.
+
+2017-09-07 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch10.adb (Remove_Private_With_Clause): If a private with
+ clause for a unit U appears in a context that includes a regular
+ with_clause on U, rewrite the redundant private clause into a null
+ statement, rather than removing it altogether from the context,
+ so that ASIS tools can reconstruct the original source.
+
+2017-09-07 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch13.adb (Check_Aspect_At_Freeze_Point): The expression
+ for aspect Small can be of any real type (not only a universal
+ real literal) as long as it is a static constant.
+
+2017-09-07 Thomas Quinot <quinot@adacore.com>
+
+ * par_sco.adb: Minor reformatting.
+
2017-09-07 Arnaud Charlet <charlet@adacore.com>
* s-parame-ae653.ads: Removed.
--
-- "This" is the object whose dispatch table is being initialized. Prim_T
-- is the primary tag of such object. Interface_T is the interface tag for
- -- which the secondary dispatch table is being initialized, Offset_Value
+ -- which the secondary dispatch table is being initialized. Offset_Value
-- is the distance from "This" to the object component containing the tag
-- of the secondary dispatch table (a zero value means that this interface
-- shares the primary dispatch table). Offset_Func references a function
- -- that must be called to evaluate the offset at runtime. This routine also
- -- takes care of registering these values in the table of interfaces of the
- -- type.
+ -- that must be called to evaluate the offset at run time. This routine
+ -- also takes care of registering these values in the table of interfaces
+ -- of the type.
procedure Set_Entry_Index (T : Tag; Position : Positive; Value : Positive);
-- Ada 2005 (AI-345): Set the entry index of a primitive operation in T's
when N_Package_Body =>
Unit_Name := Corresponding_Spec (Main);
- when N_Package_Renaming_Declaration =>
+ when N_Package_Renaming_Declaration
+ | N_Package_Instantiation
+ =>
Unit_Name := Defining_Unit_Name (Main);
-- No SCIL file generated for generic package declarations
-- Access_Disp_Table_Elab_Flag (Node30) [implementation base type only]
-- Defined in E_Record_Type and E_Record_Subtype entities. Set in tagged
--- types whose dispatch table elaboration must be completed at runtime by
--- the IP routine to point to its pending elaboration flag entity. This
--- flag is needed when the elaboration of the dispatch table relies on
--- attribute 'Position applied to an object of the type; it is used by
+-- types whose dispatch table elaboration must be completed at run time
+-- by the IP routine to point to its pending elaboration flag entity.
+-- This flag is needed when the elaboration of the dispatch table relies
+-- on attribute 'Position applied to an object of the type; it is used by
-- the IP routine to avoid performing this elaboration twice.
-- Activation_Record_Component (Node31)
while Present (F) loop
if F = Entity (N) then
Rewrite (N, New_Copy_Tree (A));
+
+ -- If the formal is class-wide, and thus not a
+ -- controlling argument, preserve its type because
+ -- it may appear in a nested call with a class-wide
+ -- parameter.
+
+ if Is_Class_Wide_Type (Etype (F)) then
+ Set_Etype (N, Etype (F));
+ end if;
+
exit;
end if;
function Elab_Flag_Needed (Typ : Entity_Id) return Boolean;
-- Return True if the elaboration of the tagged type Typ is completed at
- -- runtime by the execution of code located in the IP routine and the
+ -- run time by the execution of code located in the IP routine and the
-- expander must generate an extra elaboration flag to avoid performing
-- such elaboration twice.
Restrict.Restrictions.Set (Max_Asynchronous_Select_Nesting) := True;
Restrict.Restrictions.Value (Max_Asynchronous_Select_Nesting) := 0;
- -- Suppress division by zero and access checks since they are handled
+ -- Enable pragma Ignore_Pragma (Global) to support legacy code
+
+ Set_Name_Table_Boolean3 (Name_Id'(Name_Find ("global")), True);
+
+ -- Suppress division by zero checks since they are handled
-- implicitly by CodePeer.
-- Turn off dynamic elaboration checks: generates inconsistencies in
-- Parameter D, when present, indicates the dominant of the first
-- declaration or statement within N.
- -- Why is Traverse_Sync_Definition commented specificaly and
- -- the others are not???
+ -- Why is Traverse_Sync_Definition commented specifically, whereas
+ -- the others are not???
procedure Traverse_Generic_Package_Declaration (N : Node_Id);
-- --
-- S p e c --
-- --
--- Copyright (C) 1998-2010, AdaCore --
+-- Copyright (C) 1998-2017, 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- --
-- regexp ::= term
-- term ::= elmt
-
-- term ::= elmt elmt ... -- concatenation (elmt then elmt)
- -- term ::= * -- any string of 0 or more characters
- -- term ::= ? -- matches any character
- -- term ::= [char char ...] -- matches any character listed
- -- term ::= [char - char] -- matches any character in given range
-- term ::= {elmt, elmt, ...} -- alternation (matches any of elmt)
+ -- elmt ::= * -- any string of 0 or more characters
+ -- elmt ::= ? -- matches any character
+ -- elmt ::= char
+ -- elmt ::= [^ char char ...] -- matches any character not listed
+ -- elmt ::= [char char ...] -- matches any character listed
+ -- elmt ::= [char - char] -- matches any character in given range
+
+ -- \char is also supported by this grammar.
+
-- Important note : This package was mainly intended to match regular
-- expressions against file names. The whole string has to match the
-- regular expression. If only a substring matches, then the function
-- If private_with_clause is redundant, remove it from context,
-- as a small optimization to subsequent handling of private_with
- -- clauses in other nested packages.
+ -- clauses in other nested packages. We replace the clause with
+ -- a null statement, which is otherwise ignored by the rest of
+ -- the compiler, so that ASIS tools can reconstruct the source.
if In_Regular_With_Clause (Entity (Name (Item))) then
declare
Nxt : constant Node_Id := Next (Item);
begin
- Remove (Item);
+ Rewrite (Item, Make_Null_Statement (Sloc (Item)));
+ Analyze (Item);
Item := Nxt;
end;
T := Standard_Integer;
when Aspect_Small =>
- T := Universal_Real;
+ -- Note that the expression can be of any real type (not just
+ -- a real universal literal) as long as it is a static constant.
+
+ T := Any_Real;
-- For a simple storage pool, we have to retrieve the type of the
-- pool object associated with the aspect's corresponding attribute
States_And_Objs := New_Copy_Elist (Abstract_States (Pack_Id));
end if;
- -- Collect all objects the appear in the visible declarations of the
+ -- Collect all objects that appear in the visible declarations of the
-- related package.
if Present (Visible_Declarations (Pack_Spec)) then
and then Nkind (Decl) = N_Object_Declaration
then
Append_New_Elmt (Defining_Entity (Decl), States_And_Objs);
+ elsif Is_Single_Concurrent_Type_Declaration (Decl) then
+ Append_New_Elmt (Anonymous_Object (Defining_Entity (Decl)),
+ States_And_Objs);
end if;
Next (Decl);
projects / gcc.git / commitdiff