From 83b77c5c9214b1a85d219921ba333a952cf9b90a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 7 Sep 2017 11:58:24 +0200 Subject: [PATCH] [multiple changes] 2017-09-07 Arnaud Charlet * sem_prag.adb (Collect_States_And_Objects): Detect also instances of single concurrent objects. 2017-09-07 Javier Miranda * s-regexp.ads: Fix documentation of the globbing grammar. 2017-09-07 Gary Dismukes * a-tags.ads, einfo.ads, exp_disp.ads: Minor reformatting. 2017-09-07 Arnaud Charlet * gnat1drv.adb (Gnat1drv): Enable pragma Ignore_Pragma (Global) in CodePeer mode, to support more legacy code automatically. 2017-09-07 Ed Schonberg * 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 * comperr.adb (Delete_SCIL_Files): Handle case of N_Package_Instantiation. 2017-09-07 Ed Schonberg * 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 * 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 * par_sco.adb: Minor reformatting. From-SVN: r251840 --- gcc/ada/ChangeLog | 48 ++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/a-tags.ads | 8 ++++---- gcc/ada/comperr.adb | 4 +++- gcc/ada/einfo.ads | 8 ++++---- gcc/ada/exp_disp.adb | 10 +++++++++ gcc/ada/exp_disp.ads | 2 +- gcc/ada/gnat1drv.adb | 6 +++++- gcc/ada/par_sco.adb | 4 ++-- gcc/ada/s-regexp.ads | 16 +++++++++------ gcc/ada/sem_ch10.adb | 7 +++++-- gcc/ada/sem_ch13.adb | 5 ++++- gcc/ada/sem_prag.adb | 5 ++++- 12 files changed, 100 insertions(+), 23 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 64a16dafdae..c8f6d7cea89 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,51 @@ +2017-09-07 Arnaud Charlet + + * sem_prag.adb (Collect_States_And_Objects): Detect also instances of + single concurrent objects. + +2017-09-07 Javier Miranda + + * s-regexp.ads: Fix documentation of the globbing grammar. + +2017-09-07 Gary Dismukes + + * a-tags.ads, einfo.ads, exp_disp.ads: Minor reformatting. + +2017-09-07 Arnaud Charlet + + * gnat1drv.adb (Gnat1drv): Enable pragma Ignore_Pragma (Global) + in CodePeer mode, to support more legacy code automatically. + +2017-09-07 Ed Schonberg + + * 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 + + * comperr.adb (Delete_SCIL_Files): Handle case of + N_Package_Instantiation. + +2017-09-07 Ed Schonberg + + * 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 + + * 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 + + * par_sco.adb: Minor reformatting. + 2017-09-07 Arnaud Charlet * s-parame-ae653.ads: Removed. diff --git a/gcc/ada/a-tags.ads b/gcc/ada/a-tags.ads index df578eb1839..564ce205f49 100644 --- a/gcc/ada/a-tags.ads +++ b/gcc/ada/a-tags.ads @@ -557,13 +557,13 @@ private -- -- "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 diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb index 0892a86592b..67df3431ed1 100644 --- a/gcc/ada/comperr.adb +++ b/gcc/ada/comperr.adb @@ -476,7 +476,9 @@ package body Comperr is 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 diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 928ea3c475c..e83c1c430d4 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -357,10 +357,10 @@ package Einfo is -- 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) diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 77833548cd2..dd0266fdcc6 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -701,6 +701,16 @@ package body Exp_Disp is 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; diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads index 7cb56d8829e..cfd4b7821c9 100644 --- a/gcc/ada/exp_disp.ads +++ b/gcc/ada/exp_disp.ads @@ -216,7 +216,7 @@ package Exp_Disp is 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. diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 9edc9587c0b..6264c0b38e0 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -264,7 +264,11 @@ procedure Gnat1drv is 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 diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 69be2e6196b..1a93f4d7eb4 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -214,8 +214,8 @@ package body Par_SCO is -- 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); diff --git a/gcc/ada/s-regexp.ads b/gcc/ada/s-regexp.ads index 6090f8c0983..0155b43be4d 100644 --- a/gcc/ada/s-regexp.ads +++ b/gcc/ada/s-regexp.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -83,14 +83,18 @@ package System.Regexp is -- 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 diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 332863966aa..6da229cfc59 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -6638,13 +6638,16 @@ package body Sem_Ch10 is -- 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; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 124a4af08ea..1bd332daee1 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -9280,7 +9280,10 @@ package body Sem_Ch13 is 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 diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 0354db7aa17..4104e756e31 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -3066,7 +3066,7 @@ package body Sem_Prag is 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 @@ -3076,6 +3076,9 @@ package body Sem_Prag is 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); -- 2.30.2