* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165284
138bc75d-0d04-0410-961f-
82ee72b054a4
+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>
* par-ch9.adb, sem_aggr.adb, exp_ch5.adb, sem_ch3.adb, impunit.adb,
Ctyp := '*';
end if;
- -- Special handling for access parameter
+ -- Special handling for access parameters and objects of
+ -- an anonymous access type.
- declare
- K : constant Entity_Kind := Ekind (Etype (XE.Ent));
-
- begin
- if (K = E_Anonymous_Access_Type
- or else
- K = E_Anonymous_Access_Subprogram_Type
- or else K =
- E_Anonymous_Access_Protected_Subprogram_Type)
- and then Is_Formal (XE.Ent)
+ if Ekind_In (Etype (XE.Ent),
+ E_Anonymous_Access_Type,
+ E_Anonymous_Access_Subprogram_Type,
+ E_Anonymous_Access_Protected_Subprogram_Type)
+ then
+ if Is_Formal (XE.Ent)
+ or else Ekind_In (XE.Ent, E_Variable, E_Constant)
then
Ctyp := 'p';
+ end if;
- -- Special handling for Boolean
+ -- Special handling for Boolean
- elsif Ctyp = 'e' and then Is_Boolean_Type (Ent) then
- Ctyp := 'b';
- end if;
- end;
+ elsif Ctyp = 'e' and then Is_Boolean_Type (Ent) then
+ Ctyp := 'b';
+ end if;
end if;
-- Special handling for abstract types and operations
or else Argv (2 .. Argv'Last) = "pg"
or else (Argv (2) = 'm' 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
Add_Switch (Argv, Compiler, And_Save => And_Save);
Add_Switch (Argv, Linker, And_Save => And_Save);
"SVvcs_kind#" &
"SVvcs_file_check#" &
"SVvcs_log_check#" &
+ "SVdocumentation_dir#" &
-- package Stack
@item VCS_Kind @tab string @tab IDE @tab -
@item VCS_File_Check @tab string @tab IDE @tab -
@item VCS_Log_Check @tab string @tab IDE @tab -
+@item Documentation_Dir @tab string @tab IDE @tab -
@headitem
Configuration files @tab @tab @tab See gprbuild manual
@item Default_Language @tab string @tab - @tab -
and then Is_Record_Type (Typ)
and then not Is_Tagged_Type (Typ)
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
- Error_Msg_NE
- ("equality operator must be declared "
- & "before type& is frozen", Eq_Op, Typ);
+ if Ekind (Scope (Typ)) /= E_Package
+ or else Scope (Typ) /= Current_Scope
+ then
+ null;
- 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;
+ elsif Is_Generic_Actual_Type (Typ) then
+ null;
- Next (Obj_Decl);
- end loop;
+ elsif In_Package_Body (Scope (Typ)) then
+ 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)
and then not Is_Limited_Type (Typ)
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);
end if;
end if;
-- 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
-- operation, which requires the declaration to be in a package spec
- -- (3.2.3(6)).
-
- elsif not Is_Frozen (Tagged_Type) then
+ -- (3.2.3(6)). Only report cases where the type and subprogram are
+ -- in the same declaration list (by comparing the unit nodes reached
+ -- 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
("?not dispatching (must be defined in a package spec)", Subp);
return;
OSDN Git Service
