From bd622b6454b89d73f3330733ff47da406ff7c042 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 8 Oct 2010 14:40:25 +0200 Subject: [PATCH] [multiple changes] 2010-10-08 Robert Dewar * par-ch3.adb: Minor reformatting. 2010-10-08 Javier Miranda * exp_disp.adb (Make_DT): Do not generate dispatch tables for CIL/Java types. 2010-10-08 Robert Dewar * par-ch8.adb (P_Use_Type_Clause): Recognize ALL keyword in Ada 2012 mode. * sinfo.adb (Use_Type_Clause): Add All_Present flag. * sinfo.ads (Use_Type_Clause): Add All_Present flag. * s-rident.ads: Add entry for No_Allocators_After_Elaboration, No_Anonymous_Allocators. 2010-10-08 Vincent Celier * bindgen.adb (Gen_Restrictions_Ada): No new line after last restriction, so that the last comma is always replaced with a left parenthesis. 2010-10-08 Javier Miranda * sem_prag.adb (Analyze_Pragma): Add specific check on the type of the first formal of delegates. From-SVN: r165169 --- gcc/ada/ChangeLog | 29 +++++++++++++++++++++++++++++ gcc/ada/bindgen.adb | 10 +++++----- gcc/ada/exp_disp.adb | 2 ++ gcc/ada/par-ch3.adb | 9 +++++---- gcc/ada/par-ch8.adb | 28 ++++++++++++++++++++++------ gcc/ada/s-rident.ads | 4 +++- gcc/ada/sem_prag.adb | 29 ++++++++++++++++++++++++----- gcc/ada/sinfo.adb | 6 ++++-- gcc/ada/sinfo.ads | 5 ++++- 9 files changed, 98 insertions(+), 24 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2b37a3c..87ee729 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,34 @@ 2010-10-08 Robert Dewar + * par-ch3.adb: Minor reformatting. + +2010-10-08 Javier Miranda + + * exp_disp.adb (Make_DT): Do not generate dispatch tables for CIL/Java + types. + +2010-10-08 Robert Dewar + + * par-ch8.adb (P_Use_Type_Clause): Recognize ALL keyword in Ada 2012 + mode. + * sinfo.adb (Use_Type_Clause): Add All_Present flag. + * sinfo.ads (Use_Type_Clause): Add All_Present flag. + * s-rident.ads: Add entry for No_Allocators_After_Elaboration, + No_Anonymous_Allocators. + +2010-10-08 Vincent Celier + + * bindgen.adb (Gen_Restrictions_Ada): No new line after last + restriction, so that the last comma is always replaced with a left + parenthesis. + +2010-10-08 Javier Miranda + + * sem_prag.adb (Analyze_Pragma): Add specific check on the type of the + first formal of delegates. + +2010-10-08 Robert Dewar + * sem_aggr.adb: Minor reformatting. 2010-10-08 Robert Dewar diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index cbcc96b..ff2498c 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -479,9 +479,9 @@ package body Bindgen is Set_String (", """); Get_Name_String (U.Uname); - -- In the case of JGNAT we need to emit an Import name - -- that includes the class name (using '$' separators - -- in the case of a child unit name). + -- In the case of JGNAT we need to emit an Import name that + -- includes the class name (using '$' separators in the case + -- of a child unit name). if VM_Target /= No_VM then for J in 1 .. Name_Len - 2 loop @@ -2818,7 +2818,7 @@ package body Bindgen is Set_String (", "); Count := Count + 1; - if Count = 8 then + if J /= Cumulative_Restrictions.Set'Last and then Count = 8 then Write_Statement_Buffer; Set_String (" "); Count := 0; @@ -2845,7 +2845,7 @@ package body Bindgen is Set_String (", "); Count := Count + 1; - if Count = 8 then + if J /= Cumulative_Restrictions.Set'Last and then Count = 8 then Write_Statement_Buffer; Set_String (" "); Count := 0; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index af3a0b3..d783cda 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -4316,6 +4316,8 @@ package body Exp_Disp is if Has_Dispatch_Table (Typ) or else No (Access_Disp_Table (Typ)) or else Is_CPP_Class (Typ) + or else Convention (Typ) = Convention_CIL + or else Convention (Typ) = Convention_Java then return Result; diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 885ba1e..ec1f33a 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -3677,10 +3677,11 @@ package body Ch3 is -- when (A in 1 .. 10 | 12) => -- when (A in 1 .. 10) | 12 => - -- To solve this, in Ada 2012 mode, we disallow - -- the use of membership operations in expressions in - -- choices. Technically in the grammar, the expression - -- must match the grammar for restricted expression. + -- To solve this, in Ada 2012 mode, we disallow the use of + -- membership operations in expressions in choices. + + -- Technically in the grammar, the expression must match the + -- grammar for restricted expression. if Ada_Version >= Ada_12 then Check_Restricted_Expression (Expr_Node); diff --git a/gcc/ada/par-ch8.adb b/gcc/ada/par-ch8.adb index 888b6d1..99c2624 100644 --- a/gcc/ada/par-ch8.adb +++ b/gcc/ada/par-ch8.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- 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- -- @@ -51,9 +51,8 @@ package body Ch8 is begin Scan; -- past USE - if Token = Tok_Type then + if Token = Tok_Type or else Token = Tok_All then return P_Use_Type_Clause; - else return P_Use_Package_Clause; end if; @@ -95,18 +94,35 @@ package body Ch8 is -- 8.4 Use Type Clause -- -------------------------- - -- USE_TYPE_CLAUSE ::= use type SUBTYPE_MARK {, SUBTYPE_MARK}; + -- USE_TYPE_CLAUSE ::= use [ALL] type SUBTYPE_MARK {, SUBTYPE_MARK}; -- The caller has checked that the initial token is USE, scanned it out - -- and that the current token is TYPE. + -- and that the current token is either ALL or TYPE. + + -- Note: Use of ALL is an Ada 2012 feature -- Error recovery: cannot raise Error_Resync function P_Use_Type_Clause return Node_Id is - Use_Node : Node_Id; + Use_Node : Node_Id; + All_Present : Boolean; begin + if Token = Tok_All then + if Ada_Version < Ada_12 then + Error_Msg_SC ("|`USE ALL TYPE` is an Ada 2012 feature"); + Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch"); + end if; + + All_Present := True; + Scan; -- past ALL + + else + All_Present := False; + end if; + Use_Node := New_Node (N_Use_Type_Clause, Prev_Token_Ptr); + Set_All_Present (Use_Node, All_Present); Set_Subtype_Marks (Use_Node, New_List); if Ada_Version = Ada_83 then diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads index 110731f..972a3e8 100644 --- a/gcc/ada/s-rident.ads +++ b/gcc/ada/s-rident.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- -- -- 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- -- @@ -62,6 +62,7 @@ package System.Rident is No_Abort_Statements, -- (RM D.7(5), H.4(3)) No_Access_Subprograms, -- (RM H.4(17)) No_Allocators, -- (RM H.4(7)) + No_Anonymous_Allocators, -- Ada 2012 No_Asynchronous_Control, -- (RM D.7(10)) No_Calendar, -- GNAT No_Delay, -- (RM H.4(21)) @@ -70,6 +71,7 @@ package System.Rident is No_Dispatching_Calls, -- GNAT No_Dynamic_Attachment, -- GNAT No_Dynamic_Priorities, -- (RM D.9(9)) + No_Allocators_After_Elaboration, -- Ada 2012 No_Enumeration_Maps, -- GNAT No_Entry_Calls_In_Elaboration_Code, -- GNAT No_Entry_Queue, -- GNAT (Ravenscar) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 30a0a3f..3a9a482 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -9009,16 +9009,35 @@ package body Sem_Prag is ("first formal of % function must be named `this`", Parent (First_Formal (Def_Id))); + elsif not Is_Access_Type (Etype (First_Formal (Def_Id))) then + Error_Msg_Name_1 := Pname; + Error_Msg_N + ("first formal of % function must be an access type", + Parameter_Type (Parent (First_Formal (Def_Id)))); + + -- For delegates the type of the first formal must be a + -- named access-to-subprogram type (see previous example) + + elsif Ekind (Etype (Def_Id)) = E_Access_Subprogram_Type + and then Ekind (Etype (First_Formal (Def_Id))) + /= E_Access_Subprogram_Type + then + Error_Msg_Name_1 := Pname; + Error_Msg_N + ("first formal of % function must be a named access" & + " to subprogram type", + Parameter_Type (Parent (First_Formal (Def_Id)))); + -- Warning: We should reject anonymous access types because -- the constructor must not be handled as a primitive of the -- tagged type. We temporarily allow it because this profile -- is currently generated by cil2ada??? - elsif not Is_Access_Type (Etype (First_Formal (Def_Id))) - or else not Ekind_In (Etype (First_Formal (Def_Id)), - E_Access_Type, - E_General_Access_Type, - E_Anonymous_Access_Type) -- ??? + elsif Ekind (Etype (Def_Id)) /= E_Access_Subprogram_Type + and then not Ekind_In (Etype (First_Formal (Def_Id)), + E_Access_Type, + E_General_Access_Type, + E_Anonymous_Access_Type) then Error_Msg_Name_1 := Pname; Error_Msg_N diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 4565902..cac6e73 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -223,7 +223,8 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Access_Definition - or else NT (N).Nkind = N_Access_To_Object_Definition); + or else NT (N).Nkind = N_Access_To_Object_Definition + or else NT (N).Nkind = N_Use_Type_Clause); return Flag15 (N); end All_Present; @@ -3137,7 +3138,8 @@ package body Sinfo is begin pragma Assert (False or else NT (N).Nkind = N_Access_Definition - or else NT (N).Nkind = N_Access_To_Object_Definition); + or else NT (N).Nkind = N_Access_To_Object_Definition + or else NT (N).Nkind = N_Use_Type_Clause); Set_Flag15 (N, Val); end Set_All_Present; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 3f40322..df4abd2 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -4730,15 +4730,18 @@ package Sinfo is -- 8.4 Use Type Clause -- -------------------------- - -- USE_TYPE_CLAUSE ::= use type SUBTYPE_MARK {, SUBTYPE_MARK}; + -- USE_TYPE_CLAUSE ::= use [ALL] type SUBTYPE_MARK {, SUBTYPE_MARK}; -- Note: use type clause is not permitted in Ada 83 mode + -- Note: the ALL keyword can appear only in Ada 2012 mode + -- N_Use_Type_Clause -- Sloc points to USE -- Subtype_Marks (List2) -- Next_Use_Clause (Node3-Sem) -- Hidden_By_Use_Clause (Elist4-Sem) + -- All_Present (Flag15) ------------------------------- -- 8.5 Renaming Declaration -- -- 2.7.4