From 276e7ed0242aaa390159bb8e2e3b57f70face83a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 4 Aug 2011 17:44:22 +0200 Subject: [PATCH] [multiple changes] 2011-08-04 Ed Schonberg * sem_util.ads, sem_unit.adb (Type_Without_Stream_Operation): determine whether a type lacks user-defined Read or Write operations, or has a component that lacks them. * sem_attr.adb (Check_Stream_Attribute): if restriction No_Default_Stream_Attributes is active, verify that all subcomponent types of the target have user-defined stream operations, and report error otherwise. * exp_ch3.adb (Stream_Operqtion_OK): use Type_Without_Stream_Operation. * exp_strm.adb: Build_Elementary_Input_Call, Build_Elementary_Write_Call): remove checks for restriction No_Default_Stream_Attributes, now checked in semantics. 2011-08-04 Vincent Celier * prj-conf.ads, prj-conf.adb (Do_Autoconf): If there is no --RTS switches on the command line, look for all valid --RTS switches in the Builder switches and for each language use the first runtime name found to invoke gprconfig. (Get_Or_Create_Configuration_File): Warn if --RTS is specified on the command line and there is no auto-configuration. (Runtime_Name_Set_For): New function. 2011-08-04 Hristian Kirtchev * exp_ch7.adb (Build_Object_Declarations): Do not generate the elaborate initialization expression for variable Abort when processing a package body or a declaration. (Create_Finalizer): Propagate the package context when creating the exception-related variables. * exp_ch7.ads (Build_Object_Declarations): New formal parameter For_Package along with usage comment. From-SVN: r177407 --- gcc/ada/ChangeLog | 34 +++++++++++ gcc/ada/exp_ch3.adb | 54 +----------------- gcc/ada/exp_ch7.adb | 16 ++++-- gcc/ada/exp_ch7.ads | 11 ++-- gcc/ada/exp_strm.adb | 25 -------- gcc/ada/prj-conf.adb | 133 ++++++++++++++++++++++++++++++++++++++++--- gcc/ada/prj-conf.ads | 3 + gcc/ada/sem_attr.adb | 33 +++++++++++ gcc/ada/sem_util.adb | 68 +++++++++++++++++++++- gcc/ada/sem_util.ads | 11 ++++ 10 files changed, 290 insertions(+), 98 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c6b8cd82a23..6162166601a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,37 @@ +2011-08-04 Ed Schonberg + + * sem_util.ads, sem_unit.adb (Type_Without_Stream_Operation): determine + whether a type lacks user-defined Read or Write operations, or has a + component that lacks them. + * sem_attr.adb (Check_Stream_Attribute): if restriction + No_Default_Stream_Attributes is active, verify that all subcomponent + types of the target have user-defined stream operations, and report + error otherwise. + * exp_ch3.adb (Stream_Operqtion_OK): use Type_Without_Stream_Operation. + * exp_strm.adb: Build_Elementary_Input_Call, + Build_Elementary_Write_Call): remove checks for restriction + No_Default_Stream_Attributes, now checked in semantics. + +2011-08-04 Vincent Celier + + * prj-conf.ads, prj-conf.adb (Do_Autoconf): If there is no --RTS + switches on the command line, look for all valid --RTS switches in the + Builder switches and for each language use the first runtime name found + to invoke gprconfig. + (Get_Or_Create_Configuration_File): Warn if --RTS is specified on the + command line and there is no auto-configuration. + (Runtime_Name_Set_For): New function. + +2011-08-04 Hristian Kirtchev + + * exp_ch7.adb (Build_Object_Declarations): Do not generate the + elaborate initialization expression for variable Abort when processing + a package body or a declaration. + (Create_Finalizer): Propagate the package context when creating the + exception-related variables. + * exp_ch7.ads (Build_Object_Declarations): New formal parameter + For_Package along with usage comment. + 2011-08-04 Arnaud Charlet * gcc-interface/Makefile.in: Clean up targets. diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 6d73822c356..7f495ace586 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -8964,58 +8964,6 @@ package body Exp_Ch3 is is Has_Predefined_Or_Specified_Stream_Attribute : Boolean := False; - function Needs_Elementary_Stream_Operation - (T : Entity_Id) return Boolean; - -- AI05-0161 : if the restriction No_Default_Stream_Attributes is active - -- then we can generate stream subprograms for records that have scalar - -- subcomponents only if those subcomponents have user-defined stream - -- subprograms. For elementary types only 'Read and 'Write are needed. - - --------------------------------------- - -- Needs_Elementary_Stream_Operation -- - --------------------------------------- - - function Needs_Elementary_Stream_Operation - (T : Entity_Id) return Boolean - is - begin - if not Restriction_Active (No_Default_Stream_Attributes) then - return False; - - elsif Is_Elementary_Type (T) then - return No (TSS (T, TSS_Stream_Read)) - or else No (TSS (T, TSS_Stream_Write)); - - elsif Is_Array_Type (T) then - return Needs_Elementary_Stream_Operation (Component_Type (T)); - - elsif Is_Record_Type (T) then - declare - Comp : Entity_Id; - - begin - Comp := First_Component (T); - while Present (Comp) loop - if Needs_Elementary_Stream_Operation (Etype (Comp)) then - return True; - end if; - Next_Component (Comp); - end loop; - return False; - end; - - elsif Is_Private_Type (T) - and then Present (Full_View (T)) - then - return Needs_Elementary_Stream_Operation (Full_View (T)); - - else - return False; - end if; - end Needs_Elementary_Stream_Operation; - - -- Start processing for Stream_Operation_OK - begin -- Special case of a limited type extension: a default implementation -- of the stream attributes Read or Write exists if that attribute @@ -9109,7 +9057,7 @@ package body Exp_Ch3 is and then not Restriction_Active (No_Dispatch) and then not No_Run_Time_Mode and then RTE_Available (RE_Tag) - and then not Needs_Elementary_Stream_Operation (Typ) + and then No (Type_Without_Stream_Operation (Typ)) and then RTE_Available (RE_Root_Stream_Type) and then not Is_RTE (Typ, RE_Finalization_Collection); end Stream_Operation_OK; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 8343d2af0b4..91384420a3e 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -1558,7 +1558,8 @@ package body Exp_Ch7 is and then Exceptions_OK then Prepend_List_To (Finalizer_Decls, - Build_Object_Declarations (Loc, Abort_Id, E_Id, Raised_Id)); + Build_Object_Declarations + (Loc, Abort_Id, E_Id, Raised_Id, For_Package)); end if; -- Create the body of the finalizer @@ -2926,10 +2927,11 @@ package body Exp_Ch7 is ------------------------------- function Build_Object_Declarations - (Loc : Source_Ptr; - Abort_Id : Entity_Id; - E_Id : Entity_Id; - Raised_Id : Entity_Id) return List_Id + (Loc : Source_Ptr; + Abort_Id : Entity_Id; + E_Id : Entity_Id; + Raised_Id : Entity_Id; + For_Package : Boolean := False) return List_Id is A_Expr : Node_Id; E_Decl : Node_Id; @@ -2956,8 +2958,12 @@ package body Exp_Ch7 is -- does not include routine Raise_From_Controlled_Operation which is the -- the sole user of flag Abort. + -- This is not needed for library-level finalizers as they are called + -- by the environment task and cannot be aborted. + if Abort_Allowed and then VM_Target = No_VM + and then not For_Package then declare Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'E'); diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads index 7a7f8746701..68e5e7538d9 100644 --- a/gcc/ada/exp_ch7.ads +++ b/gcc/ada/exp_ch7.ads @@ -58,10 +58,11 @@ package Exp_Ch7 is -- the controlling operations. function Build_Object_Declarations - (Loc : Source_Ptr; - Abort_Id : Entity_Id; - E_Id : Entity_Id; - Raised_Id : Entity_Id) return List_Id; + (Loc : Source_Ptr; + Abort_Id : Entity_Id; + E_Id : Entity_Id; + Raised_Id : Entity_Id; + For_Package : Boolean := False) return List_Id; -- Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Return a -- list containing the object declarations of boolean flag Abort_Id, the -- exception occurrence E_Id and boolean flag Raised_Id. @@ -70,7 +71,7 @@ package Exp_Ch7 is -- Exception_Identity (Get_Current_Excep.all) = -- Standard'Abort_Signal'Identity; -- - -- Abort_Id : constant Boolean := False; -- no abort + -- Abort_Id : constant Boolean := False; -- no abort or For_Package -- -- E_Id : Exception_Occurrence; -- Raised_Id : Boolean := False; diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb index cc697bf8270..35fcb640529 100644 --- a/gcc/ada/exp_strm.adb +++ b/gcc/ada/exp_strm.adb @@ -25,14 +25,11 @@ with Atree; use Atree; with Einfo; use Einfo; -with Errout; use Errout; with Exp_Util; use Exp_Util; with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; with Opt; use Opt; -with Restrict; use Restrict; -with Rident; use Rident; with Rtsfind; use Rtsfind; with Sem_Aux; use Sem_Aux; with Sem_Util; use Sem_Util; @@ -475,18 +472,6 @@ package body Exp_Strm is Lib_RE : RE_Id; begin - Check_Restriction (No_Default_Stream_Attributes, N); - - -- Are we sure following messages are issued in -gnatc mode ??? - - if Restriction_Active (No_Default_Stream_Attributes) then - Error_Msg_NE - ("missing user-defined Input for type&", N, Etype (Targ)); - if Nkind (Targ) = N_Selected_Component then - Error_Msg_NE - ("\which is a component of type&", N, Etype (Prefix (Targ))); - end if; - end if; -- Check first for Boolean and Character. These are enumeration types, -- but we treat them specially, since they may require special handling @@ -696,16 +681,6 @@ package body Exp_Strm is Libent : Entity_Id; begin - Check_Restriction (No_Default_Stream_Attributes, N); - - if Restriction_Active (No_Default_Stream_Attributes) then - Error_Msg_NE - ("missing user-defined Write for type&", N, Etype (Item)); - if Nkind (Item) = N_Selected_Component then - Error_Msg_NE - ("\which is a component of type&", N, Etype (Prefix (Item))); - end if; - end if; -- Compute the size of the stream element. This is either the size of -- the first subtype or if given the size of the Stream_Size attribute. diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb index 1e0e87eab7d..2df66930277 100644 --- a/gcc/ada/prj-conf.adb +++ b/gcc/ada/prj-conf.adb @@ -921,10 +921,10 @@ package body Prj.Conf is end loop; declare - Obj_Dir : constant String := Name_Buffer (1 .. Name_Len); - Switches : Argument_List_Access := Get_Config_Switches; - Args : Argument_List (1 .. 5); - Arg_Last : Positive; + Obj_Dir : constant String := Name_Buffer (1 .. Name_Len); + Config_Switches : Argument_List_Access; + Args : Argument_List (1 .. 5); + Arg_Last : Positive; Obj_Dir_Exists : Boolean := True; @@ -968,6 +968,104 @@ package body Prj.Conf is end case; end if; + -- If no switch --RTS have been specified on the command line, + -- look for --RTS switches in the Builder switches. + + if RTS_Languages.Get_First = No_Name then + declare + Builder : constant Package_Id := + Value_Of (Name_Builder, Project.Decl.Packages, Shared); + Switch_Array_Id : Array_Element_Id; + Switch_Array : Array_Element; + + Switch_List : String_List_Id := Nil_String; + Switch : String_Element; + + Lang : Name_Id; + Lang_Last : Positive; + + begin + if Builder /= No_Package then + Switch_Array_Id := + Value_Of + (Name => Name_Switches, + In_Arrays => + Shared.Packages.Table (Builder).Decl.Arrays, + Shared => Shared); + + while Switch_Array_Id /= No_Array_Element loop + Switch_Array := + Shared.Array_Elements.Table (Switch_Array_Id); + Switch_List := Switch_Array.Value.Values; + + while Switch_List /= Nil_String loop + Switch := + Shared.String_Elements.Table (Switch_List); + + if Switch.Value /= No_Name then + Get_Name_String (Switch.Value); + + if Name_Len >= 7 and then + Name_Buffer (1 .. 5) = "--RTS" + then + if Name_Buffer (6) = '=' then + if not Runtime_Name_Set_For (Name_Ada) then + Set_Runtime_For + (Name_Ada, + Name_Buffer (7 .. Name_Len)); + end if; + + elsif Name_Len > 7 and then + Name_Buffer (6) = ':' and then + Name_Buffer (7) /= '=' + then + Lang_Last := 7; + while Lang_Last < Name_Len and then + Name_Buffer (Lang_Last + 1) /= '=' + loop + Lang_Last := Lang_Last + 1; + end loop; + + if + Name_Buffer (Lang_Last + 1) = '=' + then + declare + RTS : constant String := + Name_Buffer (Lang_Last + 2 .. + Name_Len); + begin + Name_Buffer (1 .. Lang_Last - 6) + := Name_Buffer (7 .. Lang_Last); + Name_Len := Lang_Last - 6; + To_Lower + (Name_Buffer (1 .. Name_Len)); + Lang := Name_Find; + + if + not Runtime_Name_Set_For (Lang) + then + Set_Runtime_For (Lang, RTS); + end if; + end; + end if; + end if; + end if; + end if; + + Switch_List := Switch.Next; + end loop; + + Switch_Array_Id := Switch_Array.Next; + end loop; + end if; + end; + end if; + + -- Get the config switches. This should be done only now, as some + -- runtimes may have been found if the Builder switches. + + Config_Switches := Get_Config_Switches; + -- Invoke gprconfig Args (1) := new String'("--batch"); @@ -1041,9 +1139,9 @@ package body Prj.Conf is Write_Str (Args (J).all); end loop; - for J in Switches'Range loop + for J in Config_Switches'Range loop Write_Char (' '); - Write_Str (Switches (J).all); + Write_Str (Config_Switches (J).all); end loop; Write_Eol; @@ -1061,10 +1159,11 @@ package body Prj.Conf is end if; end if; - Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) & Switches.all, + Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) & + Config_Switches.all, Success); - Free (Switches); + Free (Config_Switches); Config_File_Path := Locate_Config_File (Args (3).all); @@ -1122,6 +1221,15 @@ package body Prj.Conf is Do_Autoconf; end if; + + -- If the config file is not auto-generated, warn if there is any --RTS + -- switch on the command line. + + elsif RTS_Languages.Get_First /= No_Name and then + Opt.Warning_Mode /= Opt.Suppress + then + Write_Line + ("warning: --RTS is taken into account only in auto-configuration"); end if; -- Parse the configuration file @@ -1405,6 +1513,15 @@ package body Prj.Conf is end if; end Runtime_Name_For; + -------------------------- + -- Runtime_Name_Set_For -- + -------------------------- + + function Runtime_Name_Set_For (Language : Name_Id) return Boolean is + begin + return RTS_Languages.Get (Language) /= No_Name; + end Runtime_Name_Set_For; + --------------------- -- Set_Runtime_For -- --------------------- diff --git a/gcc/ada/prj-conf.ads b/gcc/ada/prj-conf.ads index 38e46bef426..977344d455e 100644 --- a/gcc/ada/prj-conf.ads +++ b/gcc/ada/prj-conf.ads @@ -186,4 +186,7 @@ package Prj.Conf is -- Returns the runtime name for a language. Returns an empty string if no -- runtime was specified for the language using option --RTS. + function Runtime_Name_Set_For (Language : Name_Id) return Boolean; + -- Returns True only of Set_Runtime_For has been called for the Language + end Prj.Conf; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index caf036cda70..0f00423a850 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1633,6 +1633,39 @@ package body Sem_Attr is Check_Restriction (No_Streams, P); end if; + -- AI05-0057: if restriction No_Default_Stream_Attributes is active, + -- it is illegal to use a predefined elementary type stream attribute + -- either by itself, or more importantly as part of the attribute + -- subprogram for a composite type. + + if Restriction_Active (No_Default_Stream_Attributes) then + declare + T : Entity_Id; + begin + if Nam = TSS_Stream_Input + or else Nam = TSS_Stream_Read + then + T := + Type_Without_Stream_Operation (P_Type, TSS_Stream_Read); + else + T := + Type_Without_Stream_Operation (P_Type, TSS_Stream_Write); + end if; + + if Present (T) then + Check_Restriction (No_Default_Stream_Attributes, N); + + Error_Msg_NE + ("missing user-defined Stream Read or Write for type&", + N, T); + if not Is_Elementary_Type (P_Type) then + Error_Msg_NE + ("\which is a component of type&", N, P_Type); + end if; + end if; + end; + end if; + -- Check special case of Exception_Id and Exception_Occurrence which -- are not allowed for restriction No_Exception_Registration. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b7b8fe01a6f..47a8c35f68f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -31,7 +31,6 @@ with Errout; use Errout; with Elists; use Elists; with Exp_Ch11; use Exp_Ch11; with Exp_Disp; use Exp_Disp; -with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; with Fname; use Fname; with Freeze; use Freeze; @@ -10784,7 +10783,9 @@ package body Sem_Util is elsif Is_Record_Type (Btype) then Component := First_Entity (Btype); - while Present (Component) loop + while Present (Component) + and then Comes_From_Source (Component) + loop -- Skip anonymous types generated by constrained components @@ -12229,6 +12230,69 @@ package body Sem_Util is return Scope_Depth (Enclosing_Dynamic_Scope (Btyp)); end Type_Access_Level; + ------------------------------------ + -- Type_Without_Stream_Operation -- + ------------------------------------ + + function Type_Without_Stream_Operation + (T : Entity_Id; Op : TSS_Name_Type := TSS_Null) return Entity_Id + is + BT : constant Entity_Id := Base_Type (T); + Op_Missing : Boolean; + begin + if not Restriction_Active (No_Default_Stream_Attributes) then + return Empty; + end if; + + if Is_Elementary_Type (T) then + if Op = TSS_Null then + Op_Missing := + No (TSS (BT, TSS_Stream_Read)) + or else No (TSS (BT, TSS_Stream_Write)); + + else + Op_Missing := No (TSS (BT, Op)); + end if; + + if Op_Missing then + return T; + + else + return Empty; + end if; + + elsif Is_Array_Type (T) then + return Type_Without_Stream_Operation (Component_Type (T), Op); + + elsif Is_Record_Type (T) then + declare + Comp : Entity_Id; + C_Typ : Entity_Id; + + begin + Comp := First_Component (T); + while Present (Comp) loop + C_Typ := Type_Without_Stream_Operation (Etype (Comp), Op); + if Present (C_Typ) then + return C_Typ; + end if; + + Next_Component (Comp); + end loop; + + return Empty; + end; + + elsif Is_Private_Type (T) + and then Present (Full_View (T)) + then + return Type_Without_Stream_Operation (Full_View (T), Op); + + else + return Empty; + end if; + end Type_Without_Stream_Operation; + ---------------------------- -- Unique_Defining_Entity -- ---------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 5078b3a23c7..ae04cc44e4c 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -26,6 +26,7 @@ -- Package containing utility procedures used throughout the semantics with Einfo; use Einfo; +with Exp_Tss; use Exp_Tss; with Namet; use Namet; with Nmake; use Nmake; with Snames; use Snames; @@ -1377,6 +1378,16 @@ package Sem_Util is function Type_Access_Level (Typ : Entity_Id) return Uint; -- Return the accessibility level of Typ + function Type_Without_Stream_Operation + (T : Entity_Id; Op : TSS_Name_Type := TSS_Null) return Entity_Id; + -- AI05-0161 : if the restriction No_Default_Stream_Attributes is active + -- then we cannot generate stream subprograms for composite types with + -- elementary subcomponents that lack user-defined stream subprograms. + -- This predicate determines whether a type has such an elementary + -- subcomponent. If Op is TSS_Null, a type that lacks either Read or Write + -- prevents the construction of a composite stream operation. If Op is + -- specified we check only for the given stream operation. + function Unique_Defining_Entity (N : Node_Id) return Entity_Id; -- Return the entity which represents declaration N, so that matching -- declaration and body have the same entity. -- 2.30.2