+2010-10-08 Robert Dewar <dewar@adacore.com>
+
+ * par-ch3.adb: Minor reformatting.
+
+2010-10-08 Javier Miranda <miranda@adacore.com>
+
+ * exp_disp.adb (Make_DT): Do not generate dispatch tables for CIL/Java
+ types.
+
+2010-10-08 Robert Dewar <dewar@adacore.com>
+
+ * 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 <celier@adacore.com>
+
+ * 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 <miranda@adacore.com>
+
+ * sem_prag.adb (Analyze_Pragma): Add specific check on the type of the
+ first formal of delegates.
+
2010-10-08 Robert Dewar <dewar@adacore.com>
* sem_aggr.adb: Minor reformatting.
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
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;
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;
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;
-- 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);
-- --
-- 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- --
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;
-- 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
-- --
-- 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- --
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))
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)
("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
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;
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;
-- 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 --