Commit 21a5b575 by Arnaud Charlet

[multiple changes]

2010-10-11  Ed Schonberg  <schonberg@adacore.com>

	* lib-xref.adb (Output_References): Common handling for objects and
	formals of an anonymous access type.

2010-10-11  Eric Botcazou  <ebotcazou@adacore.com>

	* make.adb (Scan_Make_Arg): Also pass -O to both compiler and linker.

2010-10-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb: Fix check for illegal equality declaration in Ada2012

2010-10-11  Gary Dismukes  <dismukes@adacore.com>

	* sem_disp.adb (Check_Dispatching_Operation): When testing for issuing
	a warning about subprograms of a tagged type not being dispatching,
	limit this to cases where the tagged type and the subprogram are
	declared within the same declaration list.

2010-10-11  Jerome Lambourg  <lambourg@adacore.com>

	* projects.texi, prj-attr.adb: Add new attribute documentation_dir.

From-SVN: r165284
parent 0791fbe9
2010-10-11 Ed Schonberg <schonberg@adacore.com>
* lib-xref.adb (Output_References): Common handling for objects and
formals of an anonymous access type.
2010-10-11 Eric Botcazou <ebotcazou@adacore.com>
* make.adb (Scan_Make_Arg): Also pass -O to both compiler and linker.
2010-10-11 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb: Fix check for illegal equality declaration in Ada2012
2010-10-11 Gary Dismukes <dismukes@adacore.com>
* sem_disp.adb (Check_Dispatching_Operation): When testing for issuing
a warning about subprograms of a tagged type not being dispatching,
limit this to cases where the tagged type and the subprogram are
declared within the same declaration list.
2010-10-11 Jerome Lambourg <lambourg@adacore.com>
* projects.texi, prj-attr.adb: Add new attribute documentation_dir.
2010-10-11 Bob Duff <duff@adacore.com> 2010-10-11 Bob Duff <duff@adacore.com>
* par-ch9.adb, sem_aggr.adb, exp_ch5.adb, sem_ch3.adb, impunit.adb, * par-ch9.adb, sem_aggr.adb, exp_ch5.adb, sem_ch3.adb, impunit.adb,
......
...@@ -1809,27 +1809,25 @@ package body Lib.Xref is ...@@ -1809,27 +1809,25 @@ package body Lib.Xref is
Ctyp := '*'; Ctyp := '*';
end if; end if;
-- Special handling for access parameter -- Special handling for access parameters and objects of
-- an anonymous access type.
declare if Ekind_In (Etype (XE.Ent),
K : constant Entity_Kind := Ekind (Etype (XE.Ent)); E_Anonymous_Access_Type,
E_Anonymous_Access_Subprogram_Type,
begin E_Anonymous_Access_Protected_Subprogram_Type)
if (K = E_Anonymous_Access_Type then
or else if Is_Formal (XE.Ent)
K = E_Anonymous_Access_Subprogram_Type or else Ekind_In (XE.Ent, E_Variable, E_Constant)
or else K =
E_Anonymous_Access_Protected_Subprogram_Type)
and then Is_Formal (XE.Ent)
then then
Ctyp := 'p'; Ctyp := 'p';
end if;
-- Special handling for Boolean -- Special handling for Boolean
elsif Ctyp = 'e' and then Is_Boolean_Type (Ent) then elsif Ctyp = 'e' and then Is_Boolean_Type (Ent) then
Ctyp := 'b'; Ctyp := 'b';
end if; end if;
end;
end if; end if;
-- Special handling for abstract types and operations -- Special handling for abstract types and operations
......
...@@ -8115,7 +8115,7 @@ package body Make is ...@@ -8115,7 +8115,7 @@ package body Make is
or else Argv (2 .. Argv'Last) = "pg" or else Argv (2 .. Argv'Last) = "pg"
or else (Argv (2) = 'm' and then Argv'Last > 2) or else (Argv (2) = 'm' and then Argv'Last > 2)
or else (Argv (2) = 'f' and then Argv'Last > 2) or else (Argv (2) = 'f' and then Argv'Last > 2)
or else (Argv (2) = 'O' and then Argv'Last > 2) or else Argv (2) = 'O'
then then
Add_Switch (Argv, Compiler, And_Save => And_Save); Add_Switch (Argv, Compiler, And_Save => And_Save);
Add_Switch (Argv, Linker, And_Save => And_Save); Add_Switch (Argv, Linker, And_Save => And_Save);
......
...@@ -334,6 +334,7 @@ package body Prj.Attr is ...@@ -334,6 +334,7 @@ package body Prj.Attr is
"SVvcs_kind#" & "SVvcs_kind#" &
"SVvcs_file_check#" & "SVvcs_file_check#" &
"SVvcs_log_check#" & "SVvcs_log_check#" &
"SVdocumentation_dir#" &
-- package Stack -- package Stack
......
...@@ -2874,6 +2874,7 @@ system (file). The text is between brackets ([]) if the index is optional. ...@@ -2874,6 +2874,7 @@ system (file). The text is between brackets ([]) if the index is optional.
@item VCS_Kind @tab string @tab IDE @tab - @item VCS_Kind @tab string @tab IDE @tab -
@item VCS_File_Check @tab string @tab IDE @tab - @item VCS_File_Check @tab string @tab IDE @tab -
@item VCS_Log_Check @tab string @tab IDE @tab - @item VCS_Log_Check @tab string @tab IDE @tab -
@item Documentation_Dir @tab string @tab IDE @tab -
@headitem @headitem
Configuration files @tab @tab @tab See gprbuild manual Configuration files @tab @tab @tab See gprbuild manual
@item Default_Language @tab string @tab - @tab - @item Default_Language @tab string @tab - @tab -
......
...@@ -5899,32 +5899,55 @@ package body Sem_Ch6 is ...@@ -5899,32 +5899,55 @@ package body Sem_Ch6 is
and then Is_Record_Type (Typ) and then Is_Record_Type (Typ)
and then not Is_Tagged_Type (Typ) and then not Is_Tagged_Type (Typ)
then then
-- If the type is not declared in a package, or if we are in the
-- body of the package or in some other scope, the new operation is
-- not primitive, and therefore legal, though suspicious. If the
-- type is a generic actual (sub)type, the operation is not primitive
-- either because the base type is declared elsewhere.
if Is_Frozen (Typ) then if Is_Frozen (Typ) then
Error_Msg_NE if Ekind (Scope (Typ)) /= E_Package
("equality operator must be declared " or else Scope (Typ) /= Current_Scope
& "before type& is frozen", Eq_Op, Typ); then
null;
Obj_Decl := Next (Parent (Typ)); elsif Is_Generic_Actual_Type (Typ) then
while Present (Obj_Decl) null;
and then Obj_Decl /= Decl
loop
if Nkind (Obj_Decl) = N_Object_Declaration
and then Etype (Defining_Identifier (Obj_Decl)) = Typ
then
Error_Msg_NE ("type& is frozen by declaration?",
Obj_Decl, Typ);
Error_Msg_N
("\an equality operator cannot be declared after this "
& "point ('R'M 4.5.2 (9.8)) (Ada 2012))?", Obj_Decl);
exit;
end if;
Next (Obj_Decl); elsif In_Package_Body (Scope (Typ)) then
end loop; null; -- warrants a warning ???
else
Error_Msg_NE
("equality operator must be declared "
& "before type& is frozen", Eq_Op, Typ);
Obj_Decl := Next (Parent (Typ));
while Present (Obj_Decl)
and then Obj_Decl /= Decl
loop
if Nkind (Obj_Decl) = N_Object_Declaration
and then Etype (Defining_Identifier (Obj_Decl)) = Typ
then
Error_Msg_NE ("type& is frozen by declaration?",
Obj_Decl, Typ);
Error_Msg_N
("\an equality operator cannot be declared after this "
& "point ('R'M 4.5.2 (9.8)) (Ada 2012))?", Obj_Decl);
exit;
end if;
Next (Obj_Decl);
end loop;
end if;
elsif not In_Same_List (Parent (Typ), Decl) elsif not In_Same_List (Parent (Typ), Decl)
and then not Is_Limited_Type (Typ) and then not Is_Limited_Type (Typ)
then then
-- This makes it illegal to have a primitive equality declared in
-- the private part if the type is visible.
Error_Msg_N ("equality operator appears too late", Eq_Op); Error_Msg_N ("equality operator appears too late", Eq_Op);
end if; end if;
end if; end if;
......
...@@ -1044,9 +1044,16 @@ package body Sem_Disp is ...@@ -1044,9 +1044,16 @@ package body Sem_Disp is
-- If the type is not frozen yet and we are not in the overriding -- If the type is not frozen yet and we are not in the overriding
-- case it looks suspiciously like an attempt to define a primitive -- case it looks suspiciously like an attempt to define a primitive
-- operation, which requires the declaration to be in a package spec -- operation, which requires the declaration to be in a package spec
-- (3.2.3(6)). -- (3.2.3(6)). Only report cases where the type and subprogram are
-- in the same declaration list (by comparing the unit nodes reached
elsif not Is_Frozen (Tagged_Type) then -- via Parent links), to avoid spurious warnings on subprograms in
-- instance bodies when the type is declared in the instance spec but
-- hasn't been frozen by the instance body.
elsif not Is_Frozen (Tagged_Type)
and then
Parent (Parent (Tagged_Type)) = Parent (Parent (Parent (Subp)))
then
Error_Msg_N Error_Msg_N
("?not dispatching (must be defined in a package spec)", Subp); ("?not dispatching (must be defined in a package spec)", Subp);
return; return;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment