diff options
Diffstat (limited to 'gcc/ada/sem_ch6.adb')
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 118 |
1 files changed, 98 insertions, 20 deletions
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index a9f84d34faa..780a916bc2d 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -268,14 +268,19 @@ package body Sem_Ch6 is procedure Analyze_Expression_Function (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); LocX : constant Source_Ptr := Sloc (Expression (N)); - Def_Id : constant Entity_Id := Defining_Entity (Specification (N)); Expr : constant Node_Id := Expression (N); - New_Body : Node_Id; - New_Decl : Node_Id; + Spec : constant Node_Id := Specification (N); - Prev : constant Entity_Id := Current_Entity_In_Scope (Def_Id); + Def_Id : Entity_Id; + pragma Unreferenced (Def_Id); + + Prev : Entity_Id; -- If the expression is a completion, Prev is the entity whose - -- declaration is completed. + -- declaration is completed. Def_Id is needed to analyze the spec. + + New_Body : Node_Id; + New_Decl : Node_Id; + New_Spec : Node_Id; begin -- This is one of the occasions on which we transform the tree during @@ -286,10 +291,20 @@ package body Sem_Ch6 is -- determine whether this is possible. Inline_Processing_Required := True; + New_Spec := Copy_Separate_Tree (Spec); + Prev := Current_Entity_In_Scope (Defining_Entity (Spec)); + + -- If there are previous overloadable entities with the same name, + -- check whether any of them is completed by the expression function. + + if Present (Prev) and then Is_Overloadable (Prev) then + Def_Id := Analyze_Subprogram_Specification (Spec); + Prev := Find_Corresponding_Spec (N); + end if; New_Body := Make_Subprogram_Body (Loc, - Specification => Copy_Separate_Tree (Specification (N)), + Specification => New_Spec, Declarations => Empty_List, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (LocX, @@ -307,6 +322,7 @@ package body Sem_Ch6 is Insert_After (N, New_Body); Rewrite (N, Make_Null_Statement (Loc)); + Set_Has_Completion (Prev, False); Analyze (N); Analyze (New_Body); Set_Is_Inlined (Prev); @@ -314,6 +330,7 @@ package body Sem_Ch6 is elsif Present (Prev) and then Comes_From_Source (Prev) then + Set_Has_Completion (Prev, False); Rewrite (N, New_Body); Analyze (N); @@ -333,8 +350,7 @@ package body Sem_Ch6 is else New_Decl := - Make_Subprogram_Declaration (Loc, - Specification => Specification (N)); + Make_Subprogram_Declaration (Loc, Specification => Spec); Rewrite (N, New_Decl); Analyze (N); @@ -1469,9 +1485,19 @@ package body Sem_Ch6 is -- extended_return_statement. if Returns_Object then - Error_Msg_N - ("extended_return_statement cannot return value; " & - "use `""RETURN;""`", N); + if Nkind (N) = N_Extended_Return_Statement then + Error_Msg_N + ("extended return statements cannot be nested; use `RETURN;`", + N); + + -- Case of a simple return statement with a value inside extended + -- return statement. + + else + Error_Msg_N + ("return nested in extended return statement cannot return " & + "value; use `RETURN;`", N); + end if; end if; else @@ -8536,19 +8562,19 @@ package body Sem_Ch6 is and then In_Private_Part (Current_Scope) then Priv_Decls := - Private_Declarations ( - Specification (Unit_Declaration_Node (Current_Scope))); + Private_Declarations + (Specification (Unit_Declaration_Node (Current_Scope))); return In_Package_Body (Current_Scope) or else (Is_List_Member (Decl) - and then List_Containing (Decl) = Priv_Decls) + 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 List_Containing (Parent (Parent (Decl))) - = Priv_Decls); + and then not + Is_Compilation_Unit + (Defining_Entity (Parent (Decl))) + and then List_Containing (Parent (Parent (Decl))) = + Priv_Decls); else return False; end if; @@ -9562,6 +9588,15 @@ package body Sem_Ch6 is -- or IN OUT parameters of the subprogram, or (for a function) if the -- return value has an invariant. + function Is_Public_Subprogram_For (T : Entity_Id) return Boolean; + -- T is the entity for a private type for which invariants are defined. + -- This function returns True if the procedure corresponding to the + -- value of Designator is a public procedure from the point of view of + -- this type (i.e. its spec is in the visible part of the package that + -- contains the declaration of the private type). A True value means + -- that an invariant check is required (for an IN OUT parameter, or + -- the returned value of a function. + -------------- -- Grab_PPC -- -------------- @@ -9689,6 +9724,45 @@ package body Sem_Ch6 is return False; end Invariants_Or_Predicates_Present; + ------------------------------ + -- Is_Public_Subprogram_For -- + ------------------------------ + + -- The type T is a private type, its declaration is therefore in + -- the list of public declarations of some package. The test for a + -- public subprogram is that its declaration is in this same list + -- of declarations for the same package (note that all the public + -- declarations are in one list, and all the private declarations + -- in another, so this deals with the public/private distinction). + + function Is_Public_Subprogram_For (T : Entity_Id) return Boolean is + DD : constant Node_Id := Unit_Declaration_Node (Designator); + -- The subprogram declaration for the subprogram in question + + TL : constant List_Id := + Visible_Declarations + (Specification (Unit_Declaration_Node (Scope (T)))); + -- The list of declarations containing the private declaration of + -- the type. We know it is a private type, so we know its scope is + -- the package in question, and we know it must be in the visible + -- declarations of this package. + + begin + -- If the subprogram declaration is not a list member, it must be + -- an Init_Proc, in which case we want to consider it to be a + -- public subprogram, since we do get initializations to deal with. + + if not Is_List_Member (DD) then + return True; + + -- Otherwise we test whether the subprogram is declared in the + -- visible declarations of the package containing the type. + + else + return TL = List_Containing (DD); + end if; + end Is_Public_Subprogram_For; + -- Start of processing for Process_PPCs begin @@ -9985,10 +10059,13 @@ package body Sem_Ch6 is Parameter_Type => New_Occurrence_Of (Ftyp, Loc), Defining_Identifier => Rent)); - -- Add invariant call if returning type with invariants + -- Add invariant call if returning type with invariants and + -- this is a public function, i.e. a function declared in the + -- visible part of the package defining the private type. if Has_Invariants (Etype (Rent)) and then Present (Invariant_Procedure (Etype (Rent))) + and then Is_Public_Subprogram_For (Etype (Rent)) then Append_To (Plist, Make_Invariant_Call (New_Occurrence_Of (Rent, Loc))); @@ -10017,6 +10094,7 @@ package body Sem_Ch6 is if Has_Invariants (Ftype) and then Present (Invariant_Procedure (Ftype)) + and then Is_Public_Subprogram_For (Ftype) then Append_To (Plist, Make_Invariant_Call |