From 81501d2b45d990aaab9c0c3b85a13b4315ed567e Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 12 Nov 2015 11:49:07 +0100 Subject: [PATCH] [multiple changes] 2015-11-12 Emmanuel Briot * s-os_lib.ads: Documentation update. 2015-11-12 Arnaud Charlet * s-taprop-vxworks.adb, s-osinte-vxworks.ads: Use a single import of taskDelay to avoid confusion. 2015-11-12 Ed Schonberg * exp_ch6.adb (Expand_Simple_Function_Return): If the return type is class-wide and the expression is a view conversion, remove the conversion to prevent overriding of the tag, which must be that of the object being returned. 2015-11-12 Tristan Gingold * bindgen.adb (Gen_Adainit): Code cleanup. 2015-11-12 Hristian Kirtchev * s-stalib.ads: Code cleanup. 2015-11-12 Ed Schonberg * sem_ch3.adb (Analyze_Incomplete_Type_Decl): small optimization. (Analyze_Subtype_Declaration): For floating point types, inherit dimensions. (OK_For_Limited_Init_In_05): Handle properly a conditional expression whose condition is static, and is rewritten as the branch that will be executed. 2015-11-12 Ed Schonberg * sem_attr.adb (Resolve_Attribute, case 'Access): If the context type is an access constant type, do not mark the attribute reference as a possible modification of the prefix. From-SVN: r230226 --- gcc/ada/ChangeLog | 39 ++++++++++++++++++++++++++++++++++++ gcc/ada/bindgen.adb | 10 ++++++++- gcc/ada/exp_ch6.adb | 19 +++++++++++++++--- gcc/ada/s-os_lib.ads | 6 ++++++ gcc/ada/s-osinte-vxworks.ads | 1 - gcc/ada/s-stalib.ads | 6 ++++-- gcc/ada/s-taprop-vxworks.adb | 8 ++++---- gcc/ada/sem_attr.adb | 6 ++++++ gcc/ada/sem_ch3.adb | 17 ++++++++++++---- 9 files changed, 97 insertions(+), 15 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5144c2d2ba2..8e1d8ecdb21 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,42 @@ +2015-11-12 Emmanuel Briot + + * s-os_lib.ads: Documentation update. + +2015-11-12 Arnaud Charlet + + * s-taprop-vxworks.adb, s-osinte-vxworks.ads: Use a single import of + taskDelay to avoid confusion. + +2015-11-12 Ed Schonberg + + * exp_ch6.adb (Expand_Simple_Function_Return): If the return + type is class-wide and the expression is a view conversion, + remove the conversion to prevent overriding of the tag, which + must be that of the object being returned. + +2015-11-12 Tristan Gingold + + * bindgen.adb (Gen_Adainit): Code cleanup. + +2015-11-12 Hristian Kirtchev + + * s-stalib.ads: Code cleanup. + +2015-11-12 Ed Schonberg + + * sem_ch3.adb (Analyze_Incomplete_Type_Decl): small optimization. + (Analyze_Subtype_Declaration): For floating point types, + inherit dimensions. + (OK_For_Limited_Init_In_05): Handle properly a conditional + expression whose condition is static, and is rewritten as the + branch that will be executed. + +2015-11-12 Ed Schonberg + + * sem_attr.adb (Resolve_Attribute, case 'Access): If the context + type is an access constant type, do not mark the attribute + reference as a possible modification of the prefix. + 2015-11-12 Steve Baird * sem_ch6.adb (Analyze_Procedure_Call) If CodePeer_Mode is True, diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 4ad19042ab3..c4f8c76c0cf 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -90,7 +90,7 @@ package body Bindgen is System_BB_CPU_Primitives_Multiprocessors_Used : Boolean := False; -- Flag indicating whether unit System.BB.CPU_Primitives.Multiprocessors - -- is in the closure of the partiation. This is set by procedure + -- is in the closure of the partition. This is set by procedure -- Resolve_Binder_Options, and it is used to call a procedure that starts -- slave processors. @@ -685,6 +685,14 @@ package body Bindgen is " ""__gnat_activate_all_tasks"");"); end if; + -- Import procedure to start slave cpus for bareboard runtime + + if System_BB_CPU_Primitives_Multiprocessors_Used then + WBI (" procedure Start_Slave_CPUs;"); + WBI (" pragma Import (C, Start_Slave_CPUs," & + " ""__gnat_start_slave_cpus"");"); + end if; + -- For restricted run-time libraries (ZFP and Ravenscar) -- tasks are non-terminating, so we do not want finalization. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 517143b9ea2..6aaeb87372d 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -5980,7 +5980,7 @@ package body Exp_Ch6 is Utyp : constant Entity_Id := Underlying_Type (R_Type); - Exp : constant Node_Id := Expression (N); + Exp : Node_Id := Expression (N); pragma Assert (Present (Exp)); Exptyp : constant Entity_Id := Etype (Exp); @@ -5996,11 +5996,24 @@ package body Exp_Ch6 is begin if Is_Class_Wide_Type (R_Type) - and then not Is_Class_Wide_Type (Etype (Exp)) + and then not Is_Class_Wide_Type (Exptyp) + and then Nkind (Exp) /= N_Type_Conversion then - Subtype_Ind := New_Occurrence_Of (Etype (Exp), Loc); + Subtype_Ind := New_Occurrence_Of (Exptyp, Loc); else Subtype_Ind := New_Occurrence_Of (R_Type, Loc); + + -- If the result type is class-wide and the expression is a view + -- conversion, the conversion plays no role in the expansion because + -- it does not modify the tag of the object. Remove the conversion + -- altogether to prevent tag overwriting. + + if Is_Class_Wide_Type (R_Type) + and then not Is_Class_Wide_Type (Exptyp) + and then Nkind (Exp) = N_Type_Conversion + then + Exp := Expression (Exp); + end if; end if; -- For the case of a simple return that does not come from an extended diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads index dcc1deab687..b86d052ec55 100644 --- a/gcc/ada/s-os_lib.ads +++ b/gcc/ada/s-os_lib.ads @@ -731,6 +731,12 @@ package System.OS_Lib is -- Argument_List. Note that the result is allocated on the heap, and must -- be freed by the programmer (when it is no longer needed) to avoid -- memory leaks. + -- On Windows, backslashes are used as directory separators. On Unix, + -- however, they are used to escape the following character, so that for + -- instance "-d=name\ with\ space" is a single argument. In the result + -- list, the backslashes have been cleaned up when needed. The previous + -- example will thus result a single-element array, where the element is + -- "-d=name with space" (Unix) or "-d=name\ with\ space" (windows). procedure Kill (Pid : Process_Id; Hard_Kill : Boolean := True); -- Kill the process designated by Pid. Does nothing if Pid is Invalid_Pid diff --git a/gcc/ada/s-osinte-vxworks.ads b/gcc/ada/s-osinte-vxworks.ads index e398084eac9..ba76dcdf347 100644 --- a/gcc/ada/s-osinte-vxworks.ads +++ b/gcc/ada/s-osinte-vxworks.ads @@ -303,7 +303,6 @@ package System.OS_Interface is pragma Import (C, taskIsSuspended, "taskIsSuspended"); function taskDelay (ticks : int) return int; - procedure taskDelay (ticks : int); pragma Import (C, taskDelay, "taskDelay"); function sysClkRateGet return int; diff --git a/gcc/ada/s-stalib.ads b/gcc/ada/s-stalib.ads index 5cfd6b37e03..d00d23b7942 100644 --- a/gcc/ada/s-stalib.ads +++ b/gcc/ada/s-stalib.ads @@ -53,9 +53,11 @@ pragma Polling (Off); with Ada.Unchecked_Conversion; package System.Standard_Library is - pragma Warnings (Off); + + -- Historical note: pragma Preelaborate was surrounded by a pair of pragma + -- Warnings (Off/On) to circumvent a bootstrap issue. + pragma Preelaborate; - pragma Warnings (On); subtype Big_String is String (1 .. Positive'Last); pragma Suppress_Initialization (Big_String); diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index 7aff4a66d6e..3b0dca37ae5 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.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. -- -- -- -- GNARL 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- -- @@ -589,12 +589,12 @@ package body System.Task_Primitives.Operations is if Single_Lock then Result := semGive (Single_RTS_Lock.Mutex); - taskDelay (0); + Result := taskDelay (0); Result := semTake (Single_RTS_Lock.Mutex, WAIT_FOREVER); else Result := semGive (Self_ID.Common.LL.L.Mutex); - taskDelay (0); + Result := taskDelay (0); Result := semTake (Self_ID.Common.LL.L.Mutex, WAIT_FOREVER); end if; end if; @@ -707,7 +707,7 @@ package body System.Task_Primitives.Operations is else Self_ID.Common.LL.L.Mutex); else - taskDelay (0); + Result := taskDelay (0); end if; end Timed_Delay; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 7112869f4a8..eaaeb15f136 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -9993,6 +9993,9 @@ package body Sem_Attr is -- to a missed warning (the Valid check does not really -- modify!) If this case, Note will be reset to False. + -- Skip it as well if the type is an Acccess_To_Constant, + -- given that no use of the value can modify the prefix. + begin if Attr_Id = Attribute_Unrestricted_Access and then Nkind (PN) = N_Function_Call @@ -10006,6 +10009,9 @@ package body Sem_Attr is then Note := False; end if; + + elsif Is_Access_Constant (Typ) then + Note := False; end if; if Note then diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 881921d5d69..0c01cebb944 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3043,16 +3043,14 @@ package body Sem_Ch3 is Set_Direct_Primitive_Operations (T, New_Elmt_List); end if; - Push_Scope (T); - Set_Stored_Constraint (T, No_Elist); if Present (Discriminant_Specifications (N)) then + Push_Scope (T); Process_Discriminants (N); + End_Scope; end if; - End_Scope; - -- If the type has discriminants, non-trivial subtypes may be -- declared before the full view of the type. The full views of those -- subtypes will be built after the full view of the type. @@ -4833,6 +4831,7 @@ package body Sem_Ch3 is Set_Scalar_Range (Id, Scalar_Range (T)); Set_Digits_Value (Id, Digits_Value (T)); Set_Is_Constrained (Id, Is_Constrained (T)); + Copy_Dimensions (From => T, To => Id); when Signed_Integer_Kind => Set_Ekind (Id, E_Signed_Integer_Subtype); @@ -18625,6 +18624,16 @@ package body Sem_Ch3 is -- dereference. The function may also be parameterless, in which case -- the source node is just an identifier. + -- A branch of a conditional expression may have been removed if the + -- condition is statically known. This happens during expansion, and + -- thus will not happen if previous errors were encountered. The check + -- will have been performed on the chosen branch, which replaces the + -- original conditional expression. + + if No (Exp) then + return True; + end if; + case Nkind (Original_Node (Exp)) is when N_Aggregate | N_Extension_Aggregate | N_Function_Call | N_Op => return True; -- 2.30.2