[multiple changes]
2015-02-05 Javier Miranda <miranda@adacore.com> * errout.adb (Error_Msg_PT): Add missing error. * sem_ch6.adb (Check_Synchronized_Overriding): Check the missing RM rule. Code cleanup. * exp_ch9.adb (Build_Wrapper_Spec): Propagate "constant" in anonymous access types. Found working on the tests. Code cleanup. 2015-02-05 Vincent Celier <celier@adacore.com> * prj-dect.adb (Parse_Attribute_Declaration): Continue scanning when there are incomplete withs. * prj-nmsc.adb (Process_Naming): Do not try to get the value of an element when it is nil. (Check_Naming): Do not check a nil suffix for illegality * prj-proc.adb (Expression): Do not process an empty term. * prj-strt.adb (Attribute_Reference): If attribute cannot be found, parse a possible index to avoid cascading errors. 2015-02-05 Ed Schonberg <schonberg@adacore.com> * sem_aux.adb (Is_Derived_Type): A subprogram_type generated for an access_to_subprogram declaration is not a derived type. From-SVN: r220451
This commit is contained in:
Arnaud Charlet
parent
ee7c8ffd33
commit
273123a48a
|
|
@ -1,3 +1,27 @@
|
|||
2015-02-05 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* errout.adb (Error_Msg_PT): Add missing error.
|
||||
* sem_ch6.adb (Check_Synchronized_Overriding): Check the missing
|
||||
RM rule. Code cleanup.
|
||||
* exp_ch9.adb (Build_Wrapper_Spec): Propagate "constant" in
|
||||
anonymous access types. Found working on the tests. Code cleanup.
|
||||
|
||||
2015-02-05 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* prj-dect.adb (Parse_Attribute_Declaration): Continue scanning
|
||||
when there are incomplete withs.
|
||||
* prj-nmsc.adb (Process_Naming): Do not try to get the value
|
||||
of an element when it is nil.
|
||||
(Check_Naming): Do not check a nil suffix for illegality
|
||||
* prj-proc.adb (Expression): Do not process an empty term.
|
||||
* prj-strt.adb (Attribute_Reference): If attribute cannot be
|
||||
found, parse a possible index to avoid cascading errors.
|
||||
|
||||
2015-02-05 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_aux.adb (Is_Derived_Type): A subprogram_type generated
|
||||
for an access_to_subprogram declaration is not a derived type.
|
||||
|
||||
2015-02-05 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* errout.adb (Error_Msg_Internal): For non-serious error set
|
||||
|
|
|
|||
|
|
@ -686,9 +686,16 @@ package body Errout is
|
|||
("illegal overriding of subprogram inherited from interface", E);
|
||||
|
||||
Error_Msg_Sloc := Sloc (Iface_Prim);
|
||||
|
||||
if Ekind (E) = E_Function then
|
||||
Error_Msg_N
|
||||
("\first formal of & declared # must be of mode `IN` " &
|
||||
"or access-to-constant", E);
|
||||
else
|
||||
Error_Msg_N
|
||||
("\first formal of & declared # must be of mode `OUT`, `IN OUT` " &
|
||||
"or access-to-variable", E);
|
||||
end if;
|
||||
end Error_Msg_PT;
|
||||
|
||||
-----------------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2015, 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- --
|
||||
|
|
@ -2640,10 +2640,11 @@ package body Exp_Ch9 is
|
|||
Obj_Param_Typ :=
|
||||
Make_Access_Definition (Loc,
|
||||
Subtype_Mark =>
|
||||
New_Occurrence_Of (Obj_Typ, Loc));
|
||||
Set_Null_Exclusion_Present (Obj_Param_Typ,
|
||||
Null_Exclusion_Present (Parameter_Type (First_Param)));
|
||||
|
||||
New_Occurrence_Of (Obj_Typ, Loc),
|
||||
Null_Exclusion_Present =>
|
||||
Null_Exclusion_Present (Parameter_Type (First_Param)),
|
||||
Constant_Present =>
|
||||
Constant_Present (Parameter_Type (First_Param)));
|
||||
else
|
||||
Obj_Param_Typ := New_Occurrence_Of (Obj_Typ, Loc);
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2001-2015, 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- --
|
||||
|
|
@ -582,7 +582,7 @@ package body Prj.Dect is
|
|||
The_Project := Imported_Or_Extended_Project_Of
|
||||
(Current_Project, In_Tree, Token_Name);
|
||||
|
||||
if No (The_Project) then
|
||||
if No (The_Project) and then not In_Tree.Incomplete_With then
|
||||
Error_Msg (Flags, "unknown project", Location);
|
||||
Scan (In_Tree); -- past the project name
|
||||
|
||||
|
|
@ -617,8 +617,10 @@ package body Prj.Dect is
|
|||
Get_Name_String
|
||||
(Name_Of (Current_Package, In_Tree)),
|
||||
Token_Ptr);
|
||||
Scan (In_Tree); -- past the package name
|
||||
|
||||
else
|
||||
if Present (The_Project) then
|
||||
The_Package :=
|
||||
First_Package_Of (The_Project, In_Tree);
|
||||
|
||||
|
|
@ -626,7 +628,8 @@ package body Prj.Dect is
|
|||
|
||||
while Present (The_Package)
|
||||
and then
|
||||
Name_Of (The_Package, In_Tree) /= Token_Name
|
||||
Name_Of (The_Package, In_Tree) /=
|
||||
Token_Name
|
||||
loop
|
||||
The_Package :=
|
||||
Next_Package_In_Project
|
||||
|
|
@ -645,6 +648,7 @@ package body Prj.Dect is
|
|||
"package % not declared in project %",
|
||||
Token_Ptr);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Scan (In_Tree); -- past the package name
|
||||
end if;
|
||||
|
|
@ -653,7 +657,7 @@ package body Prj.Dect is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
if Present (The_Project) then
|
||||
if Present (The_Project) or else In_Tree.Incomplete_With then
|
||||
|
||||
-- Looking for '<same attribute name>
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2014, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2000-2015, 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- --
|
||||
|
|
@ -1803,7 +1803,10 @@ package body Prj.Nmsc is
|
|||
Lang_Index := Get_Language_From_Name
|
||||
(Project, Get_Name_String (Element.Index));
|
||||
|
||||
if Lang_Index /= No_Language_Index then
|
||||
if Lang_Index /= No_Language_Index and then
|
||||
Element.Value.Kind = Single and then
|
||||
Element.Value.Value /= No_Name
|
||||
then
|
||||
case Current_Array.Name is
|
||||
when Name_Spec_Suffix | Name_Specification_Suffix =>
|
||||
|
||||
|
|
@ -4287,7 +4290,9 @@ package body Prj.Nmsc is
|
|||
Shared => Shared);
|
||||
end if;
|
||||
|
||||
if Suffix /= Nil_Variable_Value then
|
||||
if Suffix /= Nil_Variable_Value and then
|
||||
Suffix.Value /= No_Name
|
||||
then
|
||||
Lang_Id.Config.Naming_Data.Spec_Suffix :=
|
||||
File_Name_Type (Suffix.Value);
|
||||
|
||||
|
|
@ -4320,7 +4325,9 @@ package body Prj.Nmsc is
|
|||
Shared => Shared);
|
||||
end if;
|
||||
|
||||
if Suffix /= Nil_Variable_Value then
|
||||
if Suffix /= Nil_Variable_Value and then
|
||||
Suffix.Value /= No_Name
|
||||
then
|
||||
Lang_Id.Config.Naming_Data.Body_Suffix :=
|
||||
File_Name_Type (Suffix.Value);
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2001-2015, 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- --
|
||||
|
|
@ -539,6 +539,8 @@ package body Prj.Proc is
|
|||
The_Term := First_Term;
|
||||
while Present (The_Term) loop
|
||||
The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
|
||||
|
||||
if The_Current_Term /= Empty_Node then
|
||||
Current_Term_Kind :=
|
||||
Kind_Of (The_Current_Term, From_Project_Node_Tree);
|
||||
|
||||
|
|
@ -1367,6 +1369,7 @@ package body Prj.Proc is
|
|||
raise Program_Error;
|
||||
|
||||
end case;
|
||||
end if;
|
||||
|
||||
The_Term := Next_Term (The_Term, From_Project_Node_Tree);
|
||||
end loop;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2001-2015, 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- --
|
||||
|
|
@ -207,6 +207,20 @@ package body Prj.Strt is
|
|||
|
||||
Scan (In_Tree);
|
||||
|
||||
-- Skip a possible index for an associative array
|
||||
|
||||
if Token = Tok_Left_Paren then
|
||||
Scan (In_Tree);
|
||||
|
||||
if Token = Tok_String_Literal then
|
||||
Scan (In_Tree);
|
||||
|
||||
if Token = Tok_Right_Paren then
|
||||
Scan (In_Tree);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
else
|
||||
-- Give its characteristics to this attribute reference
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2015, 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- --
|
||||
|
|
@ -981,6 +981,7 @@ package body Sem_Aux is
|
|||
if Is_Type (Ent)
|
||||
and then Base_Type (Ent) /= Root_Type (Ent)
|
||||
and then not Is_Class_Wide_Type (Ent)
|
||||
and then Ekind (Ent) /= E_Subprogram_Type
|
||||
then
|
||||
if not Is_Numeric_Type (Root_Type (Ent)) then
|
||||
return True;
|
||||
|
|
|
|||
|
|
@ -9259,7 +9259,6 @@ package body Sem_Ch6 is
|
|||
declare
|
||||
Candidate : Entity_Id := Empty;
|
||||
Hom : Entity_Id := Empty;
|
||||
Iface_Typ : Entity_Id;
|
||||
Subp : Entity_Id := Empty;
|
||||
|
||||
begin
|
||||
|
|
@ -9333,40 +9332,35 @@ package body Sem_Ch6 is
|
|||
Parameter_Specifications (Parent (Subp)))
|
||||
and then Etype (Result_Definition (Parent (Def_Id))) =
|
||||
Etype (Result_Definition (Parent (Subp)))
|
||||
then
|
||||
Candidate := Subp;
|
||||
|
||||
-- If an inherited subprogram is implemented by a protected
|
||||
-- function, then the first parameter of the inherited
|
||||
-- subprogram shall be of mode in, but not an
|
||||
-- access-to-variable parameter (RM 9.4(11/9)
|
||||
|
||||
if Present (First_Formal (Subp))
|
||||
and then Ekind (First_Formal (Subp)) = E_In_Parameter
|
||||
and then
|
||||
(not Is_Access_Type (Etype (First_Formal (Subp)))
|
||||
or else
|
||||
Is_Access_Constant (Etype (First_Formal (Subp))))
|
||||
then
|
||||
Overridden_Subp := Subp;
|
||||
return;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Hom := Homonym (Hom);
|
||||
end loop;
|
||||
|
||||
-- After examining all candidates for overriding, we are left with
|
||||
-- the best match which is a mode incompatible interface routine.
|
||||
-- Do not emit an error if the Expander is active since this error
|
||||
-- will be detected later on after all concurrent types are
|
||||
-- expanded and all wrappers are built. This check is meant for
|
||||
-- spec-only compilations.
|
||||
|
||||
if Present (Candidate) and then not Expander_Active then
|
||||
Iface_Typ :=
|
||||
Find_Parameter_Type (Parent (First_Formal (Candidate)));
|
||||
|
||||
-- Def_Id is primitive of a protected type, declared inside the
|
||||
-- type, and the candidate is primitive of a limited or
|
||||
-- synchronized interface.
|
||||
|
||||
if In_Scope
|
||||
and then Is_Protected_Type (Typ)
|
||||
and then
|
||||
(Is_Limited_Interface (Iface_Typ)
|
||||
or else Is_Protected_Interface (Iface_Typ)
|
||||
or else Is_Synchronized_Interface (Iface_Typ)
|
||||
or else Is_Task_Interface (Iface_Typ))
|
||||
then
|
||||
if In_Scope and then Present (Candidate) then
|
||||
Error_Msg_PT (Def_Id, Candidate);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Overridden_Subp := Candidate;
|
||||
return;
|
||||
|
|
|
|||
Loading…
Reference in New Issue