[multiple changes]
2008-04-15 Ed Schonberg <schonberg@adacore.com> gcc/ada/ PR ada/16086 * sem_ch12.adb (Analyze_Formal_Subprogram): The default can be any protected operation that matches the signature, not only an entry, a regular subprogram or a literal. 2008-04-15 Samuel Tardieu <sam@rfc1149.net> gcc/testsuite/ PR ada/16086 * gnat.dg/prot_def.adb: New. From-SVN: r134312
This commit is contained in:
parent
29f4754ff0
commit
8abe457acb
4 changed files with 78 additions and 13 deletions
|
@ -1,3 +1,10 @@
|
|||
2008-04-15 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
PR ada/16086
|
||||
* sem_ch12.adb (Analyze_Formal_Subprogram): The default can be any
|
||||
protected operation that matches the signature, not only an entry, a
|
||||
regular subprogram or a literal.
|
||||
|
||||
2008-04-15 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* ada-tree.h (DECL_BY_COMPONENT_PTR_P): Use DECL_LANG_FLAG_3.
|
||||
|
|
|
@ -2361,30 +2361,34 @@ package body Sem_Ch12 is
|
|||
|
||||
-- Default name may be overloaded, in which case the interpretation
|
||||
-- with the correct profile must be selected, as for a renaming.
|
||||
-- If the definition is an indexed component, it must denote a
|
||||
-- member of an entry family. If it is a selected component, it
|
||||
-- can be a protected operation.
|
||||
|
||||
if Etype (Def) = Any_Type then
|
||||
return;
|
||||
|
||||
elsif Nkind (Def) = N_Selected_Component then
|
||||
Subp := Entity (Selector_Name (Def));
|
||||
|
||||
if Ekind (Subp) /= E_Entry then
|
||||
if not Is_Overloadable (Entity (Selector_Name (Def))) then
|
||||
Error_Msg_N ("expect valid subprogram name as default", Def);
|
||||
return;
|
||||
end if;
|
||||
|
||||
elsif Nkind (Def) = N_Indexed_Component then
|
||||
if Nkind (Prefix (Def)) /= N_Selected_Component then
|
||||
Error_Msg_N ("expect valid subprogram name as default", Def);
|
||||
return;
|
||||
if Is_Entity_Name (Prefix (Def)) then
|
||||
if Ekind (Entity (Prefix (Def))) /= E_Entry_Family then
|
||||
Error_Msg_N ("expect valid subprogram name as default", Def);
|
||||
end if;
|
||||
|
||||
elsif Nkind (Prefix (Def)) = N_Selected_Component then
|
||||
if Ekind (Entity (Selector_Name (Prefix (Def))))
|
||||
/= E_Entry_Family
|
||||
then
|
||||
Error_Msg_N ("expect valid subprogram name as default", Def);
|
||||
end if;
|
||||
|
||||
else
|
||||
Subp := Entity (Selector_Name (Prefix (Def)));
|
||||
|
||||
if Ekind (Subp) /= E_Entry_Family then
|
||||
Error_Msg_N ("expect valid subprogram name as default", Def);
|
||||
return;
|
||||
end if;
|
||||
Error_Msg_N ("expect valid subprogram name as default", Def);
|
||||
return;
|
||||
end if;
|
||||
|
||||
elsif Nkind (Def) = N_Character_Literal then
|
||||
|
@ -2410,6 +2414,9 @@ package body Sem_Ch12 is
|
|||
end if;
|
||||
|
||||
else
|
||||
|
||||
-- Several interpretations. Disambiguate as for a renaming.
|
||||
|
||||
declare
|
||||
I : Interp_Index;
|
||||
I1 : Interp_Index := 0;
|
||||
|
@ -9778,6 +9785,8 @@ package body Sem_Ch12 is
|
|||
-- interface then the generic formal is not unless declared
|
||||
-- explicitly so. If not declared limited, the actual cannot be
|
||||
-- limited (see AI05-0087).
|
||||
-- Disable check for now, limited interfaces implemented by
|
||||
-- protected types are common, Need to update tests ???
|
||||
|
||||
if Is_Limited_Type (Act_T)
|
||||
and then not Is_Limited_Type (A_Gen_T)
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2008-04-15 Samuel Tardieu <sam@rfc1149.net>
|
||||
|
||||
PR ada/16086
|
||||
* gnat.dg/prot_def.adb: New.
|
||||
|
||||
2008-04-14 Ian Lance Taylor <iant@google.com>
|
||||
|
||||
* gcc.dg/strict-overflow-6.c: New.
|
||||
|
|
44
gcc/testsuite/gnat.dg/prot_def.adb
Normal file
44
gcc/testsuite/gnat.dg/prot_def.adb
Normal file
|
@ -0,0 +1,44 @@
|
|||
-- { dg-do run }
|
||||
procedure Prot_Def is
|
||||
|
||||
protected Prot is
|
||||
procedure Inc;
|
||||
function Get return Integer;
|
||||
private
|
||||
Data : Integer := 0;
|
||||
end Prot;
|
||||
|
||||
protected body Prot is
|
||||
procedure Inc is
|
||||
begin
|
||||
Data := Data + 1;
|
||||
end Inc;
|
||||
function Get return Integer is
|
||||
begin
|
||||
return Data;
|
||||
end Get;
|
||||
end Prot;
|
||||
|
||||
generic
|
||||
with procedure Inc is Prot.Inc;
|
||||
with function Get return Integer is Prot.Get;
|
||||
package Gen is
|
||||
function Add2_Get return Integer;
|
||||
end Gen;
|
||||
|
||||
package body Gen is
|
||||
function Add2_Get return Integer is
|
||||
begin
|
||||
Inc;
|
||||
Inc;
|
||||
return Get;
|
||||
end Add2_Get;
|
||||
end Gen;
|
||||
|
||||
package Inst is new Gen;
|
||||
|
||||
begin
|
||||
if Inst.Add2_Get /= 2 then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
end Prot_Def;
|
Loading…
Add table
Reference in a new issue