diff options
Diffstat (limited to 'gcc/ada/sem_ch3.adb')
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 23 |
1 files changed, 15 insertions, 8 deletions
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 45b28bf..5354d82 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4163,7 +4163,7 @@ package body Sem_Ch3 is procedure Check_Return_Subtype_Indication (Obj_Decl : Node_Id) is Obj_Id : constant Entity_Id := Defining_Identifier (Obj_Decl); - Obj_Typ : constant Entity_Id := Etype (Obj_Id); + Obj_Typ : Entity_Id := Etype (Obj_Id); Func_Id : constant Entity_Id := Return_Applies_To (Scope (Obj_Id)); R_Typ : constant Entity_Id := Etype (Func_Id); Indic : constant Node_Id := @@ -4199,6 +4199,15 @@ package body Sem_Ch3 is return; end if; + -- The return object type could have been rewritten into a + -- constrained type, so for the legality checks that follow we need + -- to recover the nominal unconstrained type. + + if Is_Constr_Subt_For_U_Nominal (Obj_Typ) then + Obj_Typ := Entity (Original_Node (Object_Definition (Obj_Decl))); + pragma Assert (not Is_Constrained (Obj_Typ)); + end if; + -- "return access T" case; check that the return statement also has -- "access T", and that the subtypes statically match: -- if this is an access to subprogram the signatures must match. @@ -4267,7 +4276,7 @@ package body Sem_Ch3 is -- AI05-103: for elementary types, subtypes must statically match - if Is_Constrained (R_Typ) or else Is_Access_Type (R_Typ) then + if Is_Elementary_Type (R_Typ) then if not Subtypes_Statically_Match (Obj_Typ, R_Typ) then Error_No_Match (Indic); end if; @@ -4283,13 +4292,12 @@ package body Sem_Ch3 is -- code is expanded on the basis of the base type (see subprogram -- Stream_Base_Type). - elsif Nkind (Indic) = N_Subtype_Indication - and then not Subtypes_Statically_Compatible (Obj_Typ, R_Typ) + elsif not Subtypes_Statically_Compatible (Obj_Typ, R_Typ) and then not Is_TSS (Func_Id, TSS_Stream_Input) then Error_Msg_N ("result subtype must be statically compatible with the " & - "function result type", Indic); + "function result subtype", Indic); if not Predicates_Compatible (Obj_Typ, R_Typ) then Error_Msg_NE @@ -19159,8 +19167,7 @@ package body Sem_Ch3 is -- Otherwise we have a subtype mark without a constraint elsif Error_Posted (S) then - -- Don't rewrite if S is Empty or Error - if S > Empty_Or_Error then + if S not in Empty | Error then Rewrite (S, New_Occurrence_Of (Any_Id, Sloc (S))); end if; return Any_Type; @@ -21094,7 +21101,7 @@ package body Sem_Ch3 is -- If no range was given, set a dummy range - if RRS <= Empty_Or_Error then + if RRS in Empty | Error then Low_Val := -Small_Val; High_Val := Small_Val; |