From: Arnaud Charlet Date: Mon, 6 Aug 2012 08:02:35 +0000 (+0200) Subject: [multiple changes] X-Git-Tag: releases/gcc-4.8.0~4111 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=a39a553eacce1f39fac4cffc0f5768bee425c1a1;p=thirdparty%2Fgcc.git [multiple changes] 2012-08-06 Hristian Kirtchev * sem_mech.adb (Set_Mechanisms): OUT and IN OUT parameters are now unconditionally passed by reference. IN parameters subject to convention C_Pass_By_Copy are passed by copy, otherwise they are passed by reference. 2012-08-06 Ed Schonberg * sem_ch3.adb (Analyze_Object_Declaration): According to AI95-0303, protected objects with interrupt handlers can be declared in nested scopes. This is a binding interpretation, and thus applies to all versions of the compiler. 2012-08-06 Robert Dewar * frontend.adb, exp_aggr.adb: Minor reformatting. 2012-08-06 Thomas Quinot * par-endh.adb: Minor reformatting. From-SVN: r190162 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1502371eef3a..b538ecfc8f3b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2012-08-06 Hristian Kirtchev + + * sem_mech.adb (Set_Mechanisms): OUT and IN OUT parameters are + now unconditionally passed by reference. IN parameters subject + to convention C_Pass_By_Copy are passed by copy, otherwise they + are passed by reference. + +2012-08-06 Ed Schonberg + + * sem_ch3.adb (Analyze_Object_Declaration): According to + AI95-0303, protected objects with interrupt handlers can be + declared in nested scopes. This is a binding interpretation, + and thus applies to all versions of the compiler. + +2012-08-06 Robert Dewar + + * frontend.adb, exp_aggr.adb: Minor reformatting. + +2012-08-06 Thomas Quinot + + * par-endh.adb: Minor reformatting. + 2012-08-06 Hristian Kirtchev * exp_ch7.adb (Process_Transient_Objects): Remove obsolete loop diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 850457956e06..98070a9a2df9 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -5981,6 +5981,9 @@ package body Exp_Aggr is -- Bounds are within 32-bit Int range -- All bounds and values are static + -- Note: for now, in the 2-D case, we only handle component sizes of + -- 1, 2, 4 (cases where an integral number of elements occupies a byte). + function Packed_Array_Aggregate_Handled (N : Node_Id) return Boolean is Loc : constant Source_Ptr := Sloc (N); Typ : constant Entity_Id := Etype (N); @@ -6302,7 +6305,8 @@ package body Exp_Aggr is return False; else return Expr_Value (L1) /= Expr_Value (L2) - or else Expr_Value (H1) /= Expr_Value (H2); + or else + Expr_Value (H1) /= Expr_Value (H2); end if; end if; end Must_Slide; @@ -6386,39 +6390,36 @@ package body Exp_Aggr is -- Expression in original aggregate One_Dim : Node_Id; - -- one-dimensional subaggregate + -- One-dimensional subaggregate begin - -- For now, only deal with tight packing. The boolean case is the - -- most common. + -- For now, only deal with cases where an integral number of elements + -- fit in a single byte. This includes the most common boolean case. - if Comp_Size = 1 - or else Comp_Size = 2 - or else Comp_Size = 4 + if not (Comp_Size = 1 or else + Comp_Size = 2 or else + Comp_Size = 4) then - null; - - else return False; end if; Convert_To_Positional (N, Max_Others_Replicate => 64, Handle_Bit_Packed => True); - -- Verify that all components are static. + -- Verify that all components are static if Nkind (N) = N_Aggregate and then Compile_Time_Known_Aggregate (N) then null; - -- The aggregate may have been re-analyzed and converted already. + -- The aggregate may have been re-analyzed and converted already elsif Nkind (N) /= N_Aggregate then return True; - -- If component associations remain, the aggregate is not static. + -- If component associations remain, the aggregate is not static elsif Present (Component_Associations (N)) then return False; @@ -6460,17 +6461,17 @@ package body Exp_Aggr is Comp_Val : Uint; -- integer value of component - Incr : Int; + Incr : Int; -- Step size for packing Init_Shift : Int; - -- endian-dependent start position for packing + -- Endian-dependent start position for packing Shift : Int; - -- current insertion position + -- Current insertion position - Val : Int; - -- component of packed array being assembled. + Val : Int; + -- Component of packed array being assembled. begin Comps := New_List; @@ -6485,10 +6486,10 @@ package body Exp_Aggr is xor Reverse_Storage_Order (Base_Type (Typ)) then Init_Shift := Byte_Size - Comp_Size; - Incr := -Comp_Size; + Incr := -Comp_Size; else Init_Shift := 0; - Incr := +Comp_Size; + Incr := +Comp_Size; end if; Shift := Init_Shift; @@ -6531,7 +6532,7 @@ package body Exp_Aggr is if Packed_Num > 0 then - -- Add final incomplete byte if present. + -- Add final incomplete byte if present Append (Make_Integer_Literal (Sloc (One_Dim), Val), Comps); end if; @@ -6540,8 +6541,8 @@ package body Exp_Aggr is Unchecked_Convert_To (Typ, Make_Qualified_Expression (Loc, Subtype_Mark => New_Occurrence_Of (Packed_Array, Loc), - Expression => - Make_Aggregate (Loc, Expressions => Comps)))); + Expression => + Make_Aggregate (Loc, Expressions => Comps)))); Analyze_And_Resolve (N); return True; end; diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index 13d283373d18..749e94875d72 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -282,8 +282,13 @@ begin -- a context for their semantic processing. if Config_Pragmas /= Error_List - and then not Fatal_Error (Main_Unit) and then Operating_Mode /= Check_Syntax + + -- Do not attempt to process deferred configuration pragmas if the main + -- unit failed to load, to avoid cascaded inconsistencies that can lead + -- to a compiler crash. + + and then not Fatal_Error (Main_Unit) then -- Pragmas that require some semantic activity, such as -- Interrupt_State, cannot be processed until the main unit diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb index 12f7015f6a5f..e6d4e19d6ac7 100644 --- a/gcc/ada/par-endh.adb +++ b/gcc/ada/par-endh.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -199,7 +199,7 @@ package body Endh is End_OK := True; Scan; -- past END - -- Set End_Span if expected. note that this will be useless + -- Set End_Span if expected. Note that this will be useless -- if we do not have the right ending keyword, but in this -- case we have a malformed program anyway, and the setting -- of End_Span will simply be unreliable in this case anyway. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 71c075571db0..7080d37b7acd 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3078,8 +3078,11 @@ package body Sem_Ch3 is -- in the RM is removed) because accessibility checks are sufficient -- to make handlers not at the library level illegal. + -- AI05-0303: the AI is in fact a binding interpretation, and thus + -- applies to the '95 version of the language as well. + if Has_Interrupt_Handler (T) - and then Ada_Version < Ada_2005 + and then Ada_Version < Ada_95 then Error_Msg_N ("interrupt object can only be declared at library level", Id); diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb index d21e6ae6fa53..6bd498ef9fcb 100644 --- a/gcc/ada/sem_mech.adb +++ b/gcc/ada/sem_mech.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2012, 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- -- @@ -352,13 +352,13 @@ package body Sem_Mech is -- Access parameters (RM B.3(68)) -- Access to subprogram types (RM B.3(71)) - -- Note: in the case of access parameters, it is the - -- pointer that is passed by value. In GNAT access - -- parameters are treated as IN parameters of an - -- anonymous access type, so this falls out free. + -- Note: in the case of access parameters, it is the pointer + -- that is passed by value. In GNAT access parameters are + -- treated as IN parameters of an anonymous access type, so + -- this falls out free. - -- The bottom line is that all IN elementary types - -- are passed by copy in GNAT. + -- The bottom line is that all IN elementary types are + -- passed by copy in GNAT. if Is_Elementary_Type (Typ) then if Ekind (Formal) = E_In_Parameter then @@ -385,10 +385,21 @@ package body Sem_Mech is if Convention (Typ) /= Convention_C then Set_Mechanism (Formal, By_Reference); - -- If convention C_Pass_By_Copy was specified for - -- the record type, then we pass by copy. + -- OUT and IN OUT parameters of record types are passed + -- by reference regardless of pragmas (RM B.3 (69/2)). - elsif C_Pass_By_Copy (Typ) then + elsif Ekind_In (Formal, E_Out_Parameter, + E_In_Out_Parameter) + then + Set_Mechanism (Formal, By_Reference); + + -- IN parameters of record types are passed by copy only + -- when the related type has convention C_Pass_By_Copy + -- (RM B.3 (68.1/2)). + + elsif Ekind (Formal) = E_In_Parameter + and then C_Pass_By_Copy (Typ) + then Set_Mechanism (Formal, By_Copy); -- Otherwise, for a C convention record, we set the