diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 23 | ||||
| -rw-r--r-- | gcc/ada/checks.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/debug.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/freeze.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/layout.adb | 45 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 41 |
7 files changed, 108 insertions, 62 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 126ffbe..6371700 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2014-06-11 Thomas Quinot <quinot@adacore.com> + + * freeze.ads: Minor reformatting. + * checks.adb (Determine_Range): Do not attempt to determine + the range of a deferred constant whose full view has not been + seen yet. + * sem_res.adb (Resolve): Remove undesirable guard against + resolving expressions from expression functions. + +2014-06-11 Robert Dewar <dewar@adacore.com> + + * debug.adb (Debug_Flag_Dot_1): Set to enable fix for anonymous + access types. + * layout.adb (Layout_Type): Make anonymous access types for + subprogram formal types and return types always thin. For now + only enabled if -gnatd.1 set. + +2014-06-11 Ed Schonberg <schonberg@adacore.com> + + * sem_ch13.adb (Analyze_Stream_TSS_Definition): Apply legality + rule for stream attributes of interface types (RM 13.13.2 (38/3)): + subprogram must be a null procedure. + 2014-06-11 Hristian Kirtchev <kirtchev@adacore.com> * sem_prag.adb (Analyze_Input_Item): Allow formal diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 32f0249..7ec8599 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -4118,26 +4118,37 @@ package body Checks is -- Start of processing for Determine_Range begin + -- Prevent junk warnings by initializing range variables + + Lo := No_Uint; + Hi := No_Uint; + Lor := No_Uint; + Hir := No_Uint; + -- For temporary constants internally generated to remove side effects -- we must use the corresponding expression to determine the range of - -- the expression. + -- the expression. But note that the expander can also generate + -- constants in other cases, including deferred constants. if Is_Entity_Name (N) and then Nkind (Parent (Entity (N))) = N_Object_Declaration and then Ekind (Entity (N)) = E_Constant and then Is_Internal_Name (Chars (Entity (N))) then - Determine_Range - (Expression (Parent (Entity (N))), OK, Lo, Hi, Assume_Valid); - return; - end if; + if Present (Expression (Parent (Entity (N)))) then + Determine_Range + (Expression (Parent (Entity (N))), OK, Lo, Hi, Assume_Valid); - -- Prevent junk warnings by initializing range variables + elsif Present (Full_View (Entity (N))) then + Determine_Range + (Expression (Parent (Full_View (Entity (N)))), + OK, Lo, Hi, Assume_Valid); - Lo := No_Uint; - Hi := No_Uint; - Lor := No_Uint; - Hir := No_Uint; + else + OK := False; + end if; + return; + end if; -- If type is not defined, we can't determine its range diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index eaab4ff..67a3e2b 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -155,7 +155,7 @@ package body Debug is -- d8 Force opposite endianness in packed stuff -- d9 Allow lock free implementation - -- d.1 + -- d.1 Activate thin-as-default for subprogram anonymous access types -- d.2 -- d.3 -- d.4 @@ -733,6 +733,15 @@ package body Debug is -- d9 This allows lock free implementation for protected objects -- (see Exp_Ch9). + -- d.1 Right now, we have a problem with anonymous access types in the + -- context of subprogram formal parameter types and return types. The + -- problem occurs when in one place (e.g. the subprogram spec), the + -- designated type is unknown (e.g. private) and we choose to use a + -- thin pointer representation. Then in another place, we can see the + -- full declaration of the type, and choose a fat pointer. The fix is + -- to always use thin pointers, but this is causing some other issues, + -- so for now, this fix is under control of this debug flag. + ------------------------------------------ -- Documentation for Binder Debug Flags -- ------------------------------------------ diff --git a/gcc/ada/freeze.ads b/gcc/ada/freeze.ads index 5f08f59..188ea5d 100644 --- a/gcc/ada/freeze.ads +++ b/gcc/ada/freeze.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, 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- -- @@ -195,7 +195,7 @@ package Freeze is -- Returns No_List if no freeze nodes needed. procedure Freeze_All (From : Entity_Id; After : in out Node_Id); - -- Before a non-instance body, or at the end of a declarative part + -- Before a non-instance body, or at the end of a declarative part, -- freeze all entities therein that are not yet frozen. Calls itself -- recursively to catch types in inner packages that were not frozen -- at the inner level because they were not yet completely defined. diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index 466d1ca..306d5db 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -1200,8 +1200,7 @@ package body Layout is Len := Convert_To (Standard_Unsigned, Len); - -- If range definitely flat or superflat, - -- result size is zero + -- If range definitely flat or superflat, result size is 0 if OK and then LHi <= 0 then Set_Esize (E, Uint_0); @@ -2432,7 +2431,6 @@ package body Layout is -- represents them the same way. if Is_Access_Type (E) then - Desig_Type := Underlying_Type (Designated_Type (E)); -- If we only have a limited view of the type, see whether the @@ -2464,15 +2462,34 @@ package body Layout is Set_Size_Info (E, Base_Type (E)); Set_RM_Size (E, RM_Size (Base_Type (E))); + -- Anonymous access types in subprogram specifications are always + -- thin. In the unconstrained case we always use thin pointers for + -- anonymous access types, because otherwise we get into strange + -- conformance problems between two types, one of which can see + -- that something is unconstrained and one of which cannot. The + -- object of an extended return is treated similarly. + + elsif Ekind (E) = E_Anonymous_Access_Type + and then (Nkind_In (Associated_Node_For_Itype (E), + N_Function_Specification, + N_Procedure_Specification) + or else Ekind (Scope (E)) = E_Return_Statement) + + -- For now, debug flag -gnatd.1 must be set to enable this fix + + and then Debug_Flag_Dot_1 + then + Init_Size (E, System_Address_Size); + -- For other access types, we use either address size, or, if a fat -- pointer is used (pointer-to-unconstrained array case), twice the -- address size to accommodate a fat pointer. elsif Present (Desig_Type) - and then Is_Array_Type (Desig_Type) - and then not Is_Constrained (Desig_Type) - and then not Has_Completion_In_Body (Desig_Type) - and then not Debug_Flag_6 + and then Is_Array_Type (Desig_Type) + and then not Is_Constrained (Desig_Type) + and then not Has_Completion_In_Body (Desig_Type) + and then not Debug_Flag_6 then Init_Size (E, 2 * System_Address_Size); @@ -2493,12 +2510,11 @@ package body Layout is -- fat pointer. elsif Present (Desig_Type) - and then Present (Parent (Desig_Type)) - and then Nkind (Parent (Desig_Type)) = N_Full_Type_Declaration - and then - Nkind (Type_Definition (Parent (Desig_Type))) - = N_Unconstrained_Array_Definition - and then not Debug_Flag_6 + and then Present (Parent (Desig_Type)) + and then Nkind (Parent (Desig_Type)) = N_Full_Type_Declaration + and then Nkind (Type_Definition (Parent (Desig_Type))) = + N_Unconstrained_Array_Definition + and then not Debug_Flag_6 then Init_Size (E, 2 * System_Address_Size); @@ -2519,6 +2535,9 @@ package body Layout is or else Present (Enclosing_Subprogram (E))))) then Init_Size (E, 2 * System_Address_Size); + + -- Normal case of thin pointer + else Init_Size (E, System_Address_Size); end if; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 363572f..94cfd71 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -3213,6 +3213,21 @@ package body Sem_Ch13 is if Is_Abstract_Subprogram (Subp) then Error_Msg_N ("stream subprogram must not be abstract", Expr); return; + + -- Disable the following for now, until Polyorb issue is fixed. + + elsif Is_Interface (U_Ent) + and then not Inside_A_Generic + and then Ekind (Subp) = E_Procedure + and then + not Null_Present + (Specification + (Unit_Declaration_Node (Ultimate_Alias (Subp)))) + and then False + then + Error_Msg_N + ("stream subprogram for interface type " + & "must be null procedure", Expr); end if; Set_Entity (Expr, Subp); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index e0002d3..90a362c 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -1790,10 +1790,6 @@ package body Sem_Res is -- Try and fix up a literal so that it matches its expected type. New -- literals are manufactured if necessary to avoid cascaded errors. - function Proper_Current_Scope return Entity_Id; - -- Return the current scope. Skip loop scopes created for the purpose of - -- quantified expression analysis since those do not appear in the tree. - procedure Report_Ambiguous_Argument; -- Additional diagnostics when an ambiguous call has an ambiguous -- argument (typically a controlling actual). @@ -1856,30 +1852,6 @@ package body Sem_Res is end if; end Patch_Up_Value; - -------------------------- - -- Proper_Current_Scope -- - -------------------------- - - function Proper_Current_Scope return Entity_Id is - S : Entity_Id := Current_Scope; - - begin - while Present (S) loop - - -- Skip a loop scope created for quantified expression analysis - - if Ekind (S) = E_Loop - and then Nkind (Parent (S)) = N_Quantified_Expression - then - S := Scope (S); - else - exit; - end if; - end loop; - - return S; - end Proper_Current_Scope; - ------------------------------- -- Report_Ambiguous_Argument -- ------------------------------- @@ -2933,15 +2905,12 @@ package body Sem_Res is -- default expression mode (the Freeze_Expression routine tests this -- flag and only freezes static types if it is set). - -- Ada 2012 (AI05-177): Expression functions do not freeze. Only - -- their use (in an expanded call) freezes. + -- Ada 2012 (AI05-177): The declaration of an expression function + -- does not cause freezing, but we never reach here in that case. + -- Here we are resolving the corresponding expanded body, so we do + -- need to perform normal freezing. - if Ekind (Proper_Current_Scope) /= E_Function - or else Nkind (Original_Node (Unit_Declaration_Node - (Proper_Current_Scope))) /= N_Expression_Function - then - Freeze_Expression (N); - end if; + Freeze_Expression (N); -- Now we can do the expansion |