From: charlet Date: Mon, 2 Apr 2012 09:19:30 +0000 (+0000) Subject: 2012-04-02 Yannick Moy X-Git-Tag: upstream/4.9.2~13460 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=98564bfcd46b25d87fdcdcf0c2b247e81f1b825a;p=platform%2Fupstream%2Flinaro-gcc.git 2012-04-02 Yannick Moy * lib-xref-alfa.adb: Code clean up. 2012-04-02 Ed Schonberg * sem_ch12.adb (Analyze_Subprogram_Instantiation): Do not suppress style checks, because the subprogram instance itself may contain violations of syle rules. * style.adb (Missing_Overriding): Check for missing overriding indicator on a subprogram instance. 2012-04-02 Hristian Kirtchev * sem_ch6.adb (Last_Implicit_Declaration): New routine. (Process_PPCs): Insert the body of _postconditions after the last internally generated declaration. This ensures that actual subtypes created for formal parameters are visible and properly frozen as _postconditions may reference them. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@186070 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b8155a1..904c9cc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2012-04-02 Yannick Moy + + * lib-xref-alfa.adb: Code clean up. + +2012-04-02 Ed Schonberg + + * sem_ch12.adb (Analyze_Subprogram_Instantiation): Do not suppress + style checks, because the subprogram instance itself may contain + violations of syle rules. + * style.adb (Missing_Overriding): Check for missing overriding + indicator on a subprogram instance. + +2012-04-02 Hristian Kirtchev + + * sem_ch6.adb (Last_Implicit_Declaration): New routine. + (Process_PPCs): Insert the body of _postconditions after the + last internally generated declaration. This ensures that actual + subtypes created for formal parameters are visible and properly + frozen as _postconditions may reference them. + 2012-04-02 Robert Dewar * einfo.adb (First_Component_Or_Discriminant) Now applies to diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb index e63863c..c9ab1e0 100644 --- a/gcc/ada/lib-xref-alfa.adb +++ b/gcc/ada/lib-xref-alfa.adb @@ -570,67 +570,68 @@ package body Alfa is elsif T1.Def /= T2.Def then return T1.Def < T2.Def; - -- The following should be commented, it sure looks like a test, - -- but it sits uncommented between the "third test" and the "fourth - -- test! ??? Shouldn't this in any case be an assertion ??? + else + -- Both entities must be equal at this point - elsif T1.Key.Ent /= T2.Key.Ent then - raise Program_Error; + pragma Assert (T1.Key.Ent = T2.Key.Ent); - -- Fourth test: if reference is in same unit as entity definition, - -- sort first. + -- Fourth test: if reference is in same unit as entity definition, + -- sort first. - elsif T1.Key.Lun /= T2.Key.Lun - and then T1.Ent_Scope_File = T1.Key.Lun - then - return True; + if T1.Key.Lun /= T2.Key.Lun + and then T1.Ent_Scope_File = T1.Key.Lun + then + return True; - elsif T1.Key.Lun /= T2.Key.Lun - and then T2.Ent_Scope_File = T2.Key.Lun - then - return False; + elsif T1.Key.Lun /= T2.Key.Lun + and then T2.Ent_Scope_File = T2.Key.Lun + then + return False; - -- Fifth test: if reference is in same unit and same scope as entity - -- definition, sort first. + -- Fifth test: if reference is in same unit and same scope as + -- entity definition, sort first. - elsif T1.Ent_Scope_File = T1.Key.Lun - and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope - and then T1.Key.Ent_Scope = T1.Key.Ref_Scope - then - return True; + elsif T1.Ent_Scope_File = T1.Key.Lun + and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope + and then T1.Key.Ent_Scope = T1.Key.Ref_Scope + then + return True; - elsif T2.Ent_Scope_File = T2.Key.Lun - and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope - and then T2.Key.Ent_Scope = T2.Key.Ref_Scope - then - return False; + elsif T2.Ent_Scope_File = T2.Key.Lun + and then T1.Key.Ref_Scope /= T2.Key.Ref_Scope + and then T2.Key.Ent_Scope = T2.Key.Ref_Scope + then + return False; - -- Sixth test: for same entity, sort by reference location unit + -- Sixth test: for same entity, sort by reference location unit - elsif T1.Key.Lun /= T2.Key.Lun then - return Dependency_Num (T1.Key.Lun) < Dependency_Num (T2.Key.Lun); + elsif T1.Key.Lun /= T2.Key.Lun then + return Dependency_Num (T1.Key.Lun) < + Dependency_Num (T2.Key.Lun); - -- Seventh test: for same entity, sort by reference location scope + -- Seventh test: for same entity, sort by reference location scope - elsif Get_Scope_Num (T1.Key.Ref_Scope) /= - Get_Scope_Num (T2.Key.Ref_Scope) - then - return Get_Scope_Num (T1.Key.Ref_Scope) < - Get_Scope_Num (T2.Key.Ref_Scope); + elsif Get_Scope_Num (T1.Key.Ref_Scope) /= + Get_Scope_Num (T2.Key.Ref_Scope) + then + return Get_Scope_Num (T1.Key.Ref_Scope) < + Get_Scope_Num (T2.Key.Ref_Scope); - -- Eighth test: order of location within referencing unit + -- Eighth test: order of location within referencing unit - elsif T1.Key.Loc /= T2.Key.Loc then - return T1.Key.Loc < T2.Key.Loc; + elsif T1.Key.Loc /= T2.Key.Loc then + return T1.Key.Loc < T2.Key.Loc; - -- Finally, for two locations at the same address prefer the one that - -- does NOT have the type 'r', so that a modification or extension - -- takes preference, when there are more than one reference at the - -- same location. As a result, in the case of entities that are - -- in-out actuals, the read reference follows the modify reference. + -- Finally, for two locations at the same address prefer the one + -- that does NOT have the type 'r', so that a modification or + -- extension takes preference, when there are more than one + -- reference at the same location. As a result, in the case of + -- entities that are in-out actuals, the read reference follows + -- the modify reference. - else - return T2.Key.Typ = 'r'; + else + return T2.Key.Typ = 'r'; + end if; end if; end Lt; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 159594f..e516ec0 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -4404,9 +4404,6 @@ package body Sem_Ch12 is Parent_Installed : Boolean := False; Renaming_List : List_Id; - Save_Style_Check : constant Boolean := Style_Check; - -- Save style check mode for restore on exit - procedure Analyze_Instance_And_Renamings; -- The instance must be analyzed in a context that includes the mappings -- of generic parameters into actuals. We create a package declaration @@ -4587,11 +4584,13 @@ package body Sem_Ch12 is Instantiation_Node := N; - -- Turn off style checking in instances. If the check is enabled on the - -- generic unit, a warning in an instance would just be noise. If not - -- enabled on the generic, then a warning in an instance is just wrong. + -- For package instantiations we turn off style checks, because they + -- will have been emitted in the generic. For subprogram instantiations + -- we want to apply at least the check on overriding indicators so we + -- do not modify the style check status. - Style_Check := False; + -- The renaming declarations for the actuals do not come from source and + -- will not generate spurious warnings. Preanalyze_Actuals (N); @@ -4859,8 +4858,6 @@ package body Sem_Ch12 is Generic_Renamings_HTable.Reset; end if; - Style_Check := Save_Style_Check; - <> if Has_Aspects (N) then Analyze_Aspect_Specifications (N, Act_Decl_Id); @@ -4875,8 +4872,6 @@ package body Sem_Ch12 is if Env_Installed then Restore_Env; end if; - - Style_Check := Save_Style_Check; end Analyze_Subprogram_Instantiation; ------------------------- diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 8ec60c7..f925905 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -11057,6 +11057,9 @@ package body Sem_Ch6 is -- that an invariant check is required (for an IN OUT parameter, or -- the returned value of a function. + function Last_Implicit_Declaration return Node_Id; + -- Return the last internally-generated declaration of N + ------------- -- Grab_CC -- ------------- @@ -11307,6 +11310,50 @@ package body Sem_Ch6 is end if; end Is_Public_Subprogram_For; + ------------------------------- + -- Last_Implicit_Declaration -- + ------------------------------- + + function Last_Implicit_Declaration return Node_Id is + Loc : constant Source_Ptr := Sloc (N); + Decls : List_Id := Declarations (N); + Decl : Node_Id; + Succ : Node_Id; + + begin + if No (Decls) then + Decls := New_List (Make_Null_Statement (Loc)); + Set_Declarations (N, Decls); + + elsif Is_Empty_List (Declarations (N)) then + Append_To (Decls, Make_Null_Statement (Loc)); + end if; + + -- Implicit and source declarations may be interspersed. Search for + -- the last implicit declaration which is either succeeded by a + -- source construct or is the last node in the declarative list. + + Decl := First (Declarations (N)); + while Present (Decl) loop + Succ := Next (Decl); + + -- The current declaration is the last one, do not return Empty + + if No (Succ) then + exit; + + -- The successor is a source construct + + elsif Comes_From_Source (Succ) then + exit; + end if; + + Next (Decl); + end loop; + + return Decl; + end Last_Implicit_Declaration; + -- Start of processing for Process_PPCs begin @@ -11712,7 +11759,7 @@ package body Sem_Ch6 is -- The entity for the _Postconditions procedure begin - Prepend_To (Declarations (N), + Insert_After (Last_Implicit_Declaration, Make_Subprogram_Body (Loc, Specification => Make_Procedure_Specification (Loc, diff --git a/gcc/ada/style.adb b/gcc/ada/style.adb index 727a0cd..b603702 100644 --- a/gcc/ada/style.adb +++ b/gcc/ada/style.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -236,7 +236,13 @@ package body Style is procedure Missing_Overriding (N : Node_Id; E : Entity_Id) is begin - if Style_Check_Missing_Overriding and then Comes_From_Source (N) then + + -- Perform the check on source subprograms and on subprogram instances, + -- because these can be primitives of untagged types. + + if Style_Check_Missing_Overriding + and then (Comes_From_Source (N) or else Is_Generic_Instance (E)) + then if Nkind (N) = N_Subprogram_Body then Error_Msg_NE -- CODEFIX ("(style) missing OVERRIDING indicator in body of&", N, E);