[multiple changes]

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.

From-SVN: r165169
This commit is contained in:
Arnaud Charlet 2010-10-08 14:40:25 +02:00
parent 3786bbd19b
commit bd622b6454
9 changed files with 98 additions and 24 deletions

View File

@ -1,3 +1,32 @@
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.

View File

@ -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;

View File

@ -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;

View File

@ -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);

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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;

View File

@ -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 --