diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 68 | ||||
| -rw-r--r-- | gcc/ada/a-coinve.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/a-stwima.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/a-stzmap.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/exp_ch11.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/g-comlin.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/s-pooglo.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/s-soflin.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 6 |
14 files changed, 132 insertions, 15 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6127fd5dc77..275d15792f0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,71 @@ +2015-11-18 Ed Schonberg <schonberg@adacore.com> + + * sem_ch5.adb (Analyze_Assignment): Diagnose assignment where + left-hand side has a limited view of a class-wide type. + * sem_ch6.adb (Detected_And_Exchange): Do not install a non-limited + view if the scope of the type of the formal is visible through + a limited_with_clause, even if the non-limited view is available. + +2015-11-18 Emmanuel Briot <briot@adacore.com> + + * s-pooglo.ads: Make Global_Pool_Object aliased. + +2015-11-18 Ed Schonberg <schonberg@adacore.com> + + * sem_attr.adb (Analyze_Attribute, case 'Access): If the prefix + is an expression function, do not analyze the generated body if + the current scope is not the scope of the expression function, + as may happen if the attribute is an actual in an instantiation. + * sem_ch10.adb, sem_ch12.adb, a-stzmap.adb, s-soflin.adb, + a-stwima.adb: Fix typos. + +2015-11-18 Arnaud Charlet <charlet@adacore.com> + + * exp_ch11.adb (Expand_N_Exception_Declaration): No-op when + generating C code. + +2015-11-18 Hristian Kirtchev <kirtchev@adacore.com> + + PR ada/66242 + + * exp_ch3.adb (Default_Initialize_Object): Reimplemented. Abort + defer / undefer pairs are now encapsulated in a block with + an AT END handler. Partial finalization now takes restriction + No_Exception_Propagation into account when generating blocks. + * exp_ch7.adb Various reformattings. + (Create_Finalizer): Change + the generation of abort defer / undefer pairs and explain the + lack of an AT END handler. + (Process_Transient_Objects): Add generation of abort defer/undefer + pairs. + * exp_ch9.adb Various reformattings. + (Build_Protected_Subprogram_Body): Use + Build_Runtime_Call to construct a call to Abort_Defer. + (Build_Protected_Subprogram_Call_Cleanup): Use + Build_Runtime_Call to construct a call to Abort_Undefer. + (Expand_N_Asynchronous_Select): Use Build_Runtime_Call to + construct a call to Abort_Defer. + * exp_intr.adb (Expand_Unc_Deallocation): Abort defer + / undefer pairs are now encapsulated in a block with + an AT END handler. Finalization now takes restriction + No_Exception_Propagation into account when generating blocks. + * exp_util.ads, exp_util.adb (Wrap_Cleanup_Procedure): Removed. + +2015-11-18 Vincent Celier <celier@adacore.com> + + * g-comlin.adb (Find_Longest_Matching_Switch): Do not take into + account a switch ending with '=' when the actual command line + switch is not followed with a space or '='. + +2015-11-18 Ed Schonberg <schonberg@adacore.com> + + * sem_res.adb (Resolve_Explicit_Dereference): Do not add an access + check if the type of the prefix is known to exclude null. + * a-coinve.adb (Get_Element_Access): The function returns an + access type that excludes null, so add an explicit check for + a null element pointer, which is created when Insert_Spaces is + called on an indefinite vector container. + 2015-11-18 Arnaud Charlet <charlet@adacore.com> * switch-c.adb (Scan_Front_End_Switches): Add a check requiring diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb index 7843b5e1348..ba0f6932471 100644 --- a/gcc/ada/a-coinve.adb +++ b/gcc/ada/a-coinve.adb @@ -1076,9 +1076,22 @@ package body Ada.Containers.Indefinite_Vectors is ------------------------ function Get_Element_Access - (Position : Cursor) return not null Element_Access is + (Position : Cursor) return not null Element_Access + is + Ptr : constant Element_Access := + Position.Container.Elements.EA (Position.Index); + begin - return Position.Container.Elements.EA (Position.Index); + -- An indefinite vector may contain spaces that hold no elements. + -- Any iteration over an indefinite vector with spaces will raise + -- Constraint_Error. + + if Ptr = null then + raise Constraint_Error; + + else + return Ptr; + end if; end Get_Element_Access; ----------------- diff --git a/gcc/ada/a-stwima.adb b/gcc/ada/a-stwima.adb index c7ab14f4ac4..ed6ef60f683 100644 --- a/gcc/ada/a-stwima.adb +++ b/gcc/ada/a-stwima.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -366,7 +366,7 @@ package body Ada.Strings.Wide_Maps is Wide_Character_Mapping_Values_Access); begin - if Object.Map /= Null_Map'Unrestricted_Access then + if Object.Map /= Null_Map'Unrestricted_Access then Free (Object.Map); end if; end Finalize; diff --git a/gcc/ada/a-stzmap.adb b/gcc/ada/a-stzmap.adb index 0afe4ff868f..b331a0f944b 100644 --- a/gcc/ada/a-stzmap.adb +++ b/gcc/ada/a-stzmap.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -368,7 +368,7 @@ package body Ada.Strings.Wide_Wide_Maps is Wide_Wide_Character_Mapping_Values_Access); begin - if Object.Map /= Null_Map'Unrestricted_Access then + if Object.Map /= Null_Map'Unrestricted_Access then Free (Object.Map); end if; end Finalize; diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index c41a95f4973..cd33300341f 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -1250,6 +1250,12 @@ package body Exp_Ch11 is -- Start of processing for Expand_N_Exception_Declaration begin + -- Nothing to do when generating C code + + if Generate_C_Code then + return; + end if; + -- Definition of the external name: nam : constant String := "A.B.NAME"; Ex_Id := diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb index 440b5d12f3c..de2f3f9601d 100644 --- a/gcc/ada/g-comlin.adb +++ b/gcc/ada/g-comlin.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2015, 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- -- @@ -556,6 +556,10 @@ package body GNAT.Command_Line is and then Switches (Index .. Last) = Arg (Arg'First .. Arg'First + Last - Index) and then Last - Index + 1 > Switch_Length + and then + (P /= Parameter_With_Space_Or_Equal + or else Arg'Last = Arg'First + Last - Index + or else Arg (Arg'First + Last - Index + 1) = '=') then Param := P; Index_In_Switches := Index; diff --git a/gcc/ada/s-pooglo.ads b/gcc/ada/s-pooglo.ads index 0a4d8eb9b83..99100f819fc 100644 --- a/gcc/ada/s-pooglo.ads +++ b/gcc/ada/s-pooglo.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -74,6 +74,6 @@ package System.Pool_Global is -- for T'Storage_Pool use Q'Storage_Pool; -- and Q'Storage_Pool hasn't been defined explicitly. - Global_Pool_Object : Unbounded_No_Reclaim_Pool; + Global_Pool_Object : aliased Unbounded_No_Reclaim_Pool; end System.Pool_Global; diff --git a/gcc/ada/s-soflin.adb b/gcc/ada/s-soflin.adb index 9158a92dccb..2d98f309e56 100644 --- a/gcc/ada/s-soflin.adb +++ b/gcc/ada/s-soflin.adb @@ -98,7 +98,7 @@ package body System.Soft_Links is -- Finalize all library-level controlled objects if needed - if Finalize_Library_Objects /= null then + if Finalize_Library_Objects /= null then Finalize_Library_Objects.all; end if; end Adafinal_NT; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index eaaeb15f136..f0bb4cf9322 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -10776,6 +10776,13 @@ package body Sem_Attr is elsif In_Open_Scopes (Subp_Id) then null; + -- If reference to the expression function appears in an + -- inner scope, for example as an actual in an instance, + -- this is not a freeze point either. + + elsif Scope (Subp_Id) /= Current_Scope then + null; + -- Analyze the body of the expression function to freeze -- the expression. This takes care of the case where the -- 'Access is part of dispatch table initialization and diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 6ff5f9ebfbc..b6116afcf4f 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -4429,7 +4429,7 @@ package body Sem_Ch10 is while Present (Subp_Id) loop if Chars (Node (Subp_Id)) = Chars (E) then if Nkind (Parent (Parent (Node (Subp_Id)))) - /= N_Subprogram_Renaming_Declaration + /= N_Subprogram_Renaming_Declaration then Prev_Id := Subp_Id; Next_Elmt (Subp_Id); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 4dfdac958bb..aa19cd5a5eb 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -11587,7 +11587,7 @@ package body Sem_Ch12 is -- Ada 2005: null-exclusion indicators of the two types must agree - if Can_Never_Be_Null (A_Gen_T) /= Can_Never_Be_Null (Act_T) then + if Can_Never_Be_Null (A_Gen_T) /= Can_Never_Be_Null (Act_T) then Error_Msg_NE ("non null exclusion of actual and formal & do not match", Actual, Gen_T); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 519aab41503..b4e82783b2b 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -506,6 +506,15 @@ package body Sem_Ch5 is Ghost_Mode := Save_Ghost_Mode; return; + -- A class-wide type may be a limited view. This illegal case is not + -- caught by previous checks. + + elsif Ekind (T1) = E_Class_Wide_Type + and then From_Limited_With (T1) + then + Error_Msg_NE ("invalid use of limited view of&", Lhs, T1); + return; + -- Enforce RM 3.9.3 (8): the target of an assignment operation cannot be -- abstract. This is only checked when the assignment Comes_From_Source, -- because in some cases the expander generates such assignments (such diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index a4e15bc49d6..254fca36394 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2786,7 +2786,10 @@ package body Sem_Ch6 is procedure Detect_And_Exchange (Id : Entity_Id); -- Determine whether Id's type denotes an incomplete type associated -- with a limited with clause and exchange the limited view with the - -- non-limited one when available. + -- non-limited one when available. Note that the non-limited view + -- may exist because of a with_clause in another unit in the context, + -- but cannot be used because the current view of the enclosing unit + -- is still a limited view. ------------------------- -- Detect_And_Exchange -- @@ -2795,7 +2798,10 @@ package body Sem_Ch6 is procedure Detect_And_Exchange (Id : Entity_Id) is Typ : constant Entity_Id := Etype (Id); begin - if From_Limited_With (Typ) and then Has_Non_Limited_View (Typ) then + if From_Limited_With (Typ) + and then Has_Non_Limited_View (Typ) + and then not From_Limited_With (Scope (Typ)) + then Set_Etype (Id, Non_Limited_View (Typ)); end if; end Detect_And_Exchange; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 0e2d1c79f01..ec7e01908c3 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -8119,7 +8119,11 @@ package body Sem_Res is Resolve (P); end if; - if Is_Access_Type (Etype (P)) then + -- If the prefix might be null, add an access check + + if Is_Access_Type (Etype (P)) + and then not Can_Never_Be_Null (Etype (P)) + then Apply_Access_Check (N); end if; |