From 21a5b575cfbb5cb2395cbd0689c718fa76f7c686 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 11 Oct 2010 11:25:26 +0200 Subject: [PATCH] [multiple changes] 2010-10-11 Ed Schonberg * lib-xref.adb (Output_References): Common handling for objects and formals of an anonymous access type. 2010-10-11 Eric Botcazou * make.adb (Scan_Make_Arg): Also pass -O to both compiler and linker. 2010-10-11 Ed Schonberg * sem_ch6.adb: Fix check for illegal equality declaration in Ada2012 2010-10-11 Gary Dismukes * 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 * projects.texi, prj-attr.adb: Add new attribute documentation_dir. From-SVN: r165284 --- gcc/ada/ChangeLog | 24 +++++++++++++++++ gcc/ada/lib-xref.adb | 32 +++++++++++------------ gcc/ada/make.adb | 2 +- gcc/ada/prj-attr.adb | 1 + gcc/ada/projects.texi | 1 + gcc/ada/sem_ch6.adb | 61 +++++++++++++++++++++++++++++-------------- gcc/ada/sem_disp.adb | 11 ++++++-- 7 files changed, 93 insertions(+), 39 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c46da7e81d02..87552d1dcf15 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2010-10-11 Ed Schonberg + + * lib-xref.adb (Output_References): Common handling for objects and + formals of an anonymous access type. + +2010-10-11 Eric Botcazou + + * make.adb (Scan_Make_Arg): Also pass -O to both compiler and linker. + +2010-10-11 Ed Schonberg + + * sem_ch6.adb: Fix check for illegal equality declaration in Ada2012 + +2010-10-11 Gary Dismukes + + * 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 + + * projects.texi, prj-attr.adb: Add new attribute documentation_dir. + 2010-10-11 Bob Duff * par-ch9.adb, sem_aggr.adb, exp_ch5.adb, sem_ch3.adb, impunit.adb, diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 8fc8108c0fb3..d87daec69b94 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -1809,27 +1809,25 @@ package body Lib.Xref is 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'; - - -- Special handling for Boolean - - elsif Ctyp = 'e' and then Is_Boolean_Type (Ent) then - Ctyp := 'b'; end if; - end; + + -- Special handling for Boolean + + elsif Ctyp = 'e' and then Is_Boolean_Type (Ent) then + Ctyp := 'b'; + end if; end if; -- Special handling for abstract types and operations diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 8774ba723b09..9aa812a2356e 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -8115,7 +8115,7 @@ package body Make is 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); diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index 86f5af1739d5..91ae42cd41f7 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -334,6 +334,7 @@ package body Prj.Attr is "SVvcs_kind#" & "SVvcs_file_check#" & "SVvcs_log_check#" & + "SVdocumentation_dir#" & -- package Stack diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index c1afd0d83e71..979dc33ab2ef 100644 --- a/gcc/ada/projects.texi +++ b/gcc/ada/projects.texi @@ -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_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 - diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index f6a1d8a2b138..12635f49a59e 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -5899,32 +5899,55 @@ package body Sem_Ch6 is 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; diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index bd51df435dab..478819af0077 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -1044,9 +1044,16 @@ package body Sem_Disp is -- 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)). + -- (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) then + 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;