diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 11 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 73 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 8 |
4 files changed, 55 insertions, 38 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 58df8e1..5dc09e1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2009-04-07 Ed Schonberg <schonberg@adacore.com> + + * sem_ch8.adb (Restore_Scope_Stack): First_Private_Entity is only + relevant to packages. + +2009-04-07 Robert Dewar <dewar@adacore.com> + + * sem_attr.adb: Minor reformatting + + * sem_ch6.adb: Minor reformatting + 2009-04-07 Tristan Gingold <gingold@adacore.com> * socket.c: Add more protections against S_resolvLib_ macros. diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index d0812ad..533c8b4 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -5517,6 +5517,7 @@ package body Sem_Attr is -- an optimization, but it falls out essentially free, so why not. -- Again we compute the variable Static for easy reference later -- (note that no array attributes are static in Ada 83). + -- We also need to set Static properly for subsequent legality checks -- which might otherwise accept non-static constants in contexts -- where they are not legal. diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 86793d2..e8ffbaa 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -3093,10 +3093,12 @@ package body Sem_Ch6 is -- Start of processing for Build_Body_To_Inline begin + -- Return immediately if done already + if Nkind (Decl) = N_Subprogram_Declaration and then Present (Body_To_Inline (Decl)) then - return; -- Done already + return; -- Functions that return unconstrained composite types require -- secondary stack handling, and cannot currently be inlined, unless @@ -5517,6 +5519,7 @@ package body Sem_Ch6 is and then Post_Error then Error_Msg_Sloc := Sloc (E); + if Is_Imported (E) then Error_Msg_NE ("body not allowed for imported subprogram & declared#", @@ -5646,7 +5649,6 @@ package body Sem_Ch6 is Act := First (Actuals); if Nkind (Op_Node) in N_Binary_Op then - if not FCE (Left_Opnd (Op_Node), Act) then return False; end if; @@ -5771,7 +5773,6 @@ package body Sem_Ch6 is Elt1 := First (Constraints (Constraint (Indic1))); Elt2 := First (Constraints (Constraint (Indic2))); - while Present (Elt1) and then Present (Elt2) loop if not FCE (Elt1, Elt2) then return False; @@ -6233,13 +6234,13 @@ package body Sem_Ch6 is return False; end if; - -- If the generic type is a private type, then the original - -- operation was not overriding in the generic, because there was - -- no primitive operation to override. + -- If the generic type is a private type, then the original operation + -- was not overriding in the generic, because there was no primitive + -- operation to override. if Nkind (Parent (G_Typ)) = N_Formal_Type_Declaration and then Nkind (Formal_Type_Definition (Parent (G_Typ))) = - N_Formal_Private_Type_Definition + N_Formal_Private_Type_Definition then return True; @@ -6495,17 +6496,17 @@ package body Sem_Ch6 is B_Typ : Entity_Id; function Visible_Part_Type (T : Entity_Id) return Boolean; - -- Returns true if T is declared in the visible part of - -- the current package scope; otherwise returns false. - -- Assumes that T is declared in a package. + -- Returns true if T is declared in the visible part of the current + -- package scope; otherwise returns false. Assumes that T is declared + -- in a package. procedure Check_Private_Overriding (T : Entity_Id); -- Checks that if a primitive abstract subprogram of a visible - -- abstract type is declared in a private part, then it must - -- override an abstract subprogram declared in the visible part. - -- Also checks that if a primitive function with a controlling - -- result is declared in a private part, then it must override - -- a function declared in the visible part. + -- abstract type is declared in a private part, then it must override + -- an abstract subprogram declared in the visible part. Also checks + -- that if a primitive function with a controlling result is declared + -- in a private part, then it must override a function declared in + -- the visible part. ------------------------------ -- Check_Private_Overriding -- @@ -6521,7 +6522,7 @@ package body Sem_Ch6 is if Is_Abstract_Type (T) and then Is_Abstract_Subprogram (S) and then (not Is_Overriding - or else not Is_Abstract_Subprogram (E)) + or else not Is_Abstract_Subprogram (E)) then Error_Msg_N ("abstract subprograms must be visible " & "(RM 3.9.3(10))!", S); @@ -6550,8 +6551,8 @@ package body Sem_Ch6 is N : Node_Id; begin - -- If the entity is a private type, then it must be - -- declared in a visible part. + -- If the entity is a private type, then it must be declared in a + -- visible part. if Ekind (T) in Private_Kind then return True; @@ -7027,10 +7028,11 @@ package body Sem_Ch6 is (Is_List_Member (Decl) and then List_Containing (Decl) = Priv_Decls) or else (Nkind (Parent (Decl)) = N_Package_Specification - and then not Is_Compilation_Unit ( - Defining_Entity (Parent (Decl))) + and then not + Is_Compilation_Unit + (Defining_Entity (Parent (Decl))) and then List_Containing (Parent (Parent (Decl))) - = Priv_Decls); + = Priv_Decls); else return False; end if; @@ -7197,7 +7199,6 @@ package body Sem_Ch6 is and then Is_Overriding_Alias (E, S))) and then Ekind (E) /= E_Enumeration_Literal then - -- When an derived operation is overloaded it may be due to -- the fact that the full view of a private extension -- re-inherits. It has to be dealt with. @@ -7240,7 +7241,7 @@ package body Sem_Ch6 is and then (not In_Instance or else No (Parent (E)) or else Nkind (Unit_Declaration_Node (E)) /= - N_Subprogram_Renaming_Declaration) + N_Subprogram_Renaming_Declaration) then -- A subprogram child unit is not allowed to override -- an inherited subprogram (10.1.1(20)). @@ -7254,6 +7255,7 @@ package body Sem_Ch6 is if Is_Non_Overriding_Operation (E, S) then Enter_Overloaded_Entity (S); + if No (Derived_Type) or else Is_Tagged_Type (Derived_Type) then @@ -7276,7 +7278,6 @@ package body Sem_Ch6 is begin Prev := First_Entity (Current_Scope); - while Present (Prev) and then Next_Entity (Prev) /= E loop @@ -7312,17 +7313,17 @@ package body Sem_Ch6 is then -- For nondispatching derived operations that are -- overridden by a subprogram declared in the private - -- part of a package, we retain the derived - -- subprogram but mark it as not immediately visible. - -- If the derived operation was declared in the - -- visible part then this ensures that it will still - -- be visible outside the package with the proper - -- signature (calls from outside must also be - -- directed to this version rather than the - -- overriding one, unlike the dispatching case). - -- Calls from inside the package will still resolve - -- to the overriding subprogram since the derived one - -- is marked as not visible within the package. + -- part of a package, we retain the derived subprogram + -- but mark it as not immediately visible. If the + -- derived operation was declared in the visible part + -- then this ensures that it will still be visible + -- outside the package with the proper signature + -- (calls from outside must also be directed to this + -- version rather than the overriding one, unlike the + -- dispatching case). Calls from inside the package + -- will still resolve to the overriding subprogram + -- since the derived one is marked as not visible + -- within the package. -- If the private operation is dispatching, we achieve -- the overriding by keeping the implicit operation @@ -7335,7 +7336,6 @@ package body Sem_Ch6 is -- remove the implicit operation altogether. if Is_Private_Declaration (S) then - if not Is_Dispatching_Operation (E) then Set_Is_Immediately_Visible (E, False); else @@ -7459,6 +7459,7 @@ package body Sem_Ch6 is declare F1 : Entity_Id; F2 : Entity_Id; + begin F1 := First_Formal (S); F2 := First_Formal (E); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 3e231f6..0ff2df4 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -6613,7 +6613,11 @@ package body Sem_Ch8 is Next_Entity (E); - if not Full_Vis then + if not Full_Vis + and then Is_Package_Or_Generic_Package (S) + then + -- We are in the visible part of the package scope + exit when E = First_Private_Entity (S); end if; end loop; |