From: Arnaud Charlet Date: Tue, 25 Apr 2017 09:28:49 +0000 (+0200) Subject: 2017-04-25 Arnaud Charlet X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f4f5851ea31b5cb5c5b81ba645ce51a0a593b0d7;p=gcc.git 2017-04-25 Arnaud Charlet * gnat1drv.adb (Gnat1Drv): Disable Generate_Processed_File in codepeer mode. 2017-04-25 Javier Miranda * urealp.adb (UR_Write): Fix output of constants with a base other that 10. 2017-04-25 Justin Squirek * sem_ch13.adb (Get_Interfacing_Aspects): Moved to sem_util.adb. * sem_prag.adb (Analyze_Pragma, Process_Import_Or_Interface): Add extra parameter for Process_Interface_Name. (Process_Interface_Name): Add parameter for pragma to analyze corresponding aspect. * sem_util.ads, sem_util.adb (Get_Interfacing_Aspects): Added from sem_ch13.adb From-SVN: r247160 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 192e893f92a..87481487bc3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2017-04-25 Arnaud Charlet + + * gnat1drv.adb (Gnat1Drv): Disable Generate_Processed_File in + codepeer mode. + +2017-04-25 Javier Miranda + + * urealp.adb (UR_Write): Fix output of constants with a base other + that 10. + +2017-04-25 Justin Squirek + + * sem_ch13.adb (Get_Interfacing_Aspects): Moved to sem_util.adb. + * sem_prag.adb (Analyze_Pragma, Process_Import_Or_Interface): + Add extra parameter for Process_Interface_Name. + (Process_Interface_Name): Add parameter for pragma to analyze + corresponding aspect. + * sem_util.ads, sem_util.adb (Get_Interfacing_Aspects): Added + from sem_ch13.adb + 2017-04-25 Gary Dismukes * exp_ch7.adb, einfo.ads, sem_prag.adb: Minor reformatting and typo diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 30ccd610437..22139df6d0c 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -286,6 +286,11 @@ procedure Gnat1drv is Debug_Generated_Code := False; + -- Ditto for -gnateG which interacts badly with handling of pragma + -- Annotate in gnat2scil. + + Generate_Processed_File := False; + -- Disable Exception_Extra_Info (-gnateE) which generates more -- complex trees with no added value, and may confuse CodePeer. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index ce47fd8433a..fdc39291ff6 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -147,27 +147,6 @@ package body Sem_Ch13 is -- Uint value. If the value is inappropriate, then error messages are -- posted as required, and a value of No_Uint is returned. - procedure Get_Interfacing_Aspects - (Iface_Asp : Node_Id; - Conv_Asp : out Node_Id; - EN_Asp : out Node_Id; - Expo_Asp : out Node_Id; - Imp_Asp : out Node_Id; - LN_Asp : out Node_Id; - Do_Checks : Boolean := False); - -- Given a single interfacing aspect Iface_Asp, retrieve other interfacing - -- aspects that apply to the same related entity. The aspects considered by - -- this routine are as follows: - -- - -- Conv_Asp - aspect Convention - -- EN_Asp - aspect External_Name - -- Expo_Asp - aspect Export - -- Imp_Asp - aspect Import - -- LN_Asp - aspect Link_Name - -- - -- When flag Do_Checks is set, this routine will flag duplicate uses of - -- aspects. - function Is_Operational_Item (N : Node_Id) return Boolean; -- A specification for a stream attribute is allowed before the full type -- is declared, as explained in AI-00137 and the corrigendum. Attributes @@ -11214,106 +11193,6 @@ package body Sem_Ch13 is end if; end Get_Alignment_Value; - ----------------------------- - -- Get_Interfacing_Aspects -- - ----------------------------- - - procedure Get_Interfacing_Aspects - (Iface_Asp : Node_Id; - Conv_Asp : out Node_Id; - EN_Asp : out Node_Id; - Expo_Asp : out Node_Id; - Imp_Asp : out Node_Id; - LN_Asp : out Node_Id; - Do_Checks : Boolean := False) - is - procedure Save_Or_Duplication_Error - (Asp : Node_Id; - To : in out Node_Id); - -- Save the value of aspect Asp in node To. If To already has a value, - -- then this is considered a duplicate use of aspect. Emit an error if - -- flag Do_Checks is set. - - ------------------------------- - -- Save_Or_Duplication_Error -- - ------------------------------- - - procedure Save_Or_Duplication_Error - (Asp : Node_Id; - To : in out Node_Id) - is - begin - -- Detect an extra aspect and issue an error - - if Present (To) then - if Do_Checks then - Error_Msg_Name_1 := Chars (Identifier (Asp)); - Error_Msg_Sloc := Sloc (To); - Error_Msg_N ("aspect % previously given #", Asp); - end if; - - -- Otherwise capture the aspect - - else - To := Asp; - end if; - end Save_Or_Duplication_Error; - - -- Local variables - - Asp : Node_Id; - Asp_Id : Aspect_Id; - - -- The following variables capture each individual aspect - - Conv : Node_Id := Empty; - EN : Node_Id := Empty; - Expo : Node_Id := Empty; - Imp : Node_Id := Empty; - LN : Node_Id := Empty; - - -- Start of processing for Get_Interfacing_Aspects - - begin - -- The input interfacing aspect should reside in an aspect specification - -- list. - - pragma Assert (Is_List_Member (Iface_Asp)); - - -- Examine the aspect specifications of the related entity. Find and - -- capture all interfacing aspects. Detect duplicates and emit errors - -- if applicable. - - Asp := First (List_Containing (Iface_Asp)); - while Present (Asp) loop - Asp_Id := Get_Aspect_Id (Asp); - - if Asp_Id = Aspect_Convention then - Save_Or_Duplication_Error (Asp, Conv); - - elsif Asp_Id = Aspect_External_Name then - Save_Or_Duplication_Error (Asp, EN); - - elsif Asp_Id = Aspect_Export then - Save_Or_Duplication_Error (Asp, Expo); - - elsif Asp_Id = Aspect_Import then - Save_Or_Duplication_Error (Asp, Imp); - - elsif Asp_Id = Aspect_Link_Name then - Save_Or_Duplication_Error (Asp, LN); - end if; - - Next (Asp); - end loop; - - Conv_Asp := Conv; - EN_Asp := EN; - Expo_Asp := Expo; - Imp_Asp := Imp; - LN_Asp := LN; - end Get_Interfacing_Aspects; - ------------------------------------- -- Inherit_Aspects_At_Freeze_Point -- ------------------------------------- diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index c00e86b1402..4549e8afd3b 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -3927,7 +3927,8 @@ package body Sem_Prag is procedure Process_Interface_Name (Subprogram_Def : Entity_Id; Ext_Arg : Node_Id; - Link_Arg : Node_Id); + Link_Arg : Node_Id; + Prag : Node_Id); -- Given the last two arguments of pragma Import, pragma Export, or -- pragma Interface_Name, performs validity checks and sets the -- Interface_Name field of the given subprogram entity to the @@ -3936,7 +3937,9 @@ package body Sem_Prag is -- Ext_Arg may represent the Link_Name if Link_Arg is missing, and -- appropriate named notation is used for Ext_Arg. If neither Ext_Arg -- nor Link_Arg is present, the interface name is set to the default - -- from the subprogram name. + -- from the subprogram name. In addition, the pragma itself is passed + -- to analyze any expressions in the case the pragma came from an aspect + -- specification. procedure Process_Interrupt_Or_Attach_Handler; -- Common processing for Interrupt and Attach_Handler pragmas @@ -8421,7 +8424,7 @@ package body Sem_Prag is Set_Imported (Def_Id); end if; - Process_Interface_Name (Def_Id, Arg3, Arg4); + Process_Interface_Name (Def_Id, Arg3, Arg4, N); -- Note that we do not set Is_Public here. That's because we -- only want to set it if there is no address clause, and we @@ -8583,7 +8586,7 @@ package body Sem_Prag is end if; end; - Process_Interface_Name (Def_Id, Arg3, Arg4); + Process_Interface_Name (Def_Id, Arg3, Arg4, N); end if; if Is_Compilation_Unit (Hom_Id) then @@ -9128,7 +9131,8 @@ package body Sem_Prag is procedure Process_Interface_Name (Subprogram_Def : Entity_Id; Ext_Arg : Node_Id; - Link_Arg : Node_Id) + Link_Arg : Node_Id; + Prag : Node_Id) is Ext_Nam : Node_Id; Link_Nam : Node_Id; @@ -9179,6 +9183,40 @@ package body Sem_Prag is -- Start of processing for Process_Interface_Name begin + -- If we are looking at a pragma that comes from an aspect then it + -- needs to have its corresponding aspect argument expressions + -- analyzed in addition to the generated pragma so that aspects + -- within generic units get properly resolved. + + if Present (Prag) and then From_Aspect_Specification (Prag) then + declare + Asp : constant Node_Id := Corresponding_Aspect (Prag); + Dummy_1 : Node_Id; + Dummy_2 : Node_Id; + Dummy_3 : Node_Id; + EN : Node_Id; + LN : Node_Id; + + begin + -- Obtain all interfacing aspects used to construct the pragma + + Get_Interfacing_Aspects + (Asp, Dummy_1, EN, Dummy_2, Dummy_3, LN); + + -- Analyze the expression of aspect External_Name + + if Present (EN) then + Analyze (Expression (EN)); + end if; + + -- Analyze the expressio of aspect Link_Name + + if Present (LN) then + Analyze (Expression (LN)); + end if; + end; + end if; + if No (Link_Arg) then if No (Ext_Arg) then return; @@ -13497,7 +13535,7 @@ package body Sem_Prag is if Arg_Count >= 2 then Set_Imported (Def_Id); Set_Is_Public (Def_Id); - Process_Interface_Name (Def_Id, Arg2, Arg3); + Process_Interface_Name (Def_Id, Arg2, Arg3, N); end if; Set_Has_Completion (Def_Id); @@ -14648,7 +14686,7 @@ package body Sem_Prag is (Get_Pragma_Arg (Arg2), Sure => False); end if; - Process_Interface_Name (Def_Id, Arg3, Arg4); + Process_Interface_Name (Def_Id, Arg3, Arg4, N); Set_Exported (Def_Id, Arg2); end if; @@ -15154,7 +15192,7 @@ package body Sem_Prag is Note_Possible_Modification (Get_Pragma_Arg (Arg2), Sure => False); - Process_Interface_Name (E, Arg3, Arg4); + Process_Interface_Name (E, Arg3, Arg4, N); Set_Exported (E, Arg2); end External; @@ -16607,7 +16645,7 @@ package body Sem_Prag is end if; Set_Is_Public (Def_Id); - Process_Interface_Name (Def_Id, Arg2, Arg3); + Process_Interface_Name (Def_Id, Arg2, Arg3, N); end if; -- Otherwise must be subprogram @@ -16627,7 +16665,7 @@ package body Sem_Prag is Def_Id := Get_Base_Subprogram (Hom_Id); if Is_Imported (Def_Id) then - Process_Interface_Name (Def_Id, Arg2, Arg3); + Process_Interface_Name (Def_Id, Arg2, Arg3, N); Found := True; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 8b78008c573..ebf585a4a3e 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -8181,6 +8181,106 @@ package body Sem_Util is end if; end Get_Index_Bounds; + ----------------------------- + -- Get_Interfacing_Aspects -- + ----------------------------- + + procedure Get_Interfacing_Aspects + (Iface_Asp : Node_Id; + Conv_Asp : out Node_Id; + EN_Asp : out Node_Id; + Expo_Asp : out Node_Id; + Imp_Asp : out Node_Id; + LN_Asp : out Node_Id; + Do_Checks : Boolean := False) + is + procedure Save_Or_Duplication_Error + (Asp : Node_Id; + To : in out Node_Id); + -- Save the value of aspect Asp in node To. If To already has a value, + -- then this is considered a duplicate use of aspect. Emit an error if + -- flag Do_Checks is set. + + ------------------------------- + -- Save_Or_Duplication_Error -- + ------------------------------- + + procedure Save_Or_Duplication_Error + (Asp : Node_Id; + To : in out Node_Id) + is + begin + -- Detect an extra aspect and issue an error + + if Present (To) then + if Do_Checks then + Error_Msg_Name_1 := Chars (Identifier (Asp)); + Error_Msg_Sloc := Sloc (To); + Error_Msg_N ("aspect % previously given #", Asp); + end if; + + -- Otherwise capture the aspect + + else + To := Asp; + end if; + end Save_Or_Duplication_Error; + + -- Local variables + + Asp : Node_Id; + Asp_Id : Aspect_Id; + + -- The following variables capture each individual aspect + + Conv : Node_Id := Empty; + EN : Node_Id := Empty; + Expo : Node_Id := Empty; + Imp : Node_Id := Empty; + LN : Node_Id := Empty; + + -- Start of processing for Get_Interfacing_Aspects + + begin + -- The input interfacing aspect should reside in an aspect specification + -- list. + + pragma Assert (Is_List_Member (Iface_Asp)); + + -- Examine the aspect specifications of the related entity. Find and + -- capture all interfacing aspects. Detect duplicates and emit errors + -- if applicable. + + Asp := First (List_Containing (Iface_Asp)); + while Present (Asp) loop + Asp_Id := Get_Aspect_Id (Asp); + + if Asp_Id = Aspect_Convention then + Save_Or_Duplication_Error (Asp, Conv); + + elsif Asp_Id = Aspect_External_Name then + Save_Or_Duplication_Error (Asp, EN); + + elsif Asp_Id = Aspect_Export then + Save_Or_Duplication_Error (Asp, Expo); + + elsif Asp_Id = Aspect_Import then + Save_Or_Duplication_Error (Asp, Imp); + + elsif Asp_Id = Aspect_Link_Name then + Save_Or_Duplication_Error (Asp, LN); + end if; + + Next (Asp); + end loop; + + Conv_Asp := Conv; + EN_Asp := EN; + Expo_Asp := Expo; + Imp_Asp := Imp; + LN_Asp := LN; + end Get_Interfacing_Aspects; + --------------------------------- -- Get_Iterable_Type_Primitive -- --------------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 7c0affc9ba8..014cb6379e1 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -923,6 +923,27 @@ package Sem_Util is -- the index type turns out to be a partial view; this case should not -- arise during normal compilation of semantically correct programs. + procedure Get_Interfacing_Aspects + (Iface_Asp : Node_Id; + Conv_Asp : out Node_Id; + EN_Asp : out Node_Id; + Expo_Asp : out Node_Id; + Imp_Asp : out Node_Id; + LN_Asp : out Node_Id; + Do_Checks : Boolean := False); + -- Given a single interfacing aspect Iface_Asp, retrieve other interfacing + -- aspects that apply to the same related entity. The aspects considered by + -- this routine are as follows: + -- + -- Conv_Asp - aspect Convention + -- EN_Asp - aspect External_Name + -- Expo_Asp - aspect Export + -- Imp_Asp - aspect Import + -- LN_Asp - aspect Link_Name + -- + -- When flag Do_Checks is set, this routine will flag duplicate uses of + -- aspects. + function Get_Enum_Lit_From_Pos (T : Entity_Id; Pos : Uint; diff --git a/gcc/ada/urealp.adb b/gcc/ada/urealp.adb index f2f036bfc5f..b839933bdae 100644 --- a/gcc/ada/urealp.adb +++ b/gcc/ada/urealp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, 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- -- @@ -1472,8 +1472,8 @@ package body Urealp is -- of the following forms, depending on the sign of the number -- and the sign of the exponent (= minus denominator value) - -- numerator.0*base**exponent - -- numerator.0*base**-exponent + -- numerator.0/base**exponent + -- numerator.0/base**-exponent -- And of course an exponent of 0 can be omitted @@ -1486,16 +1486,14 @@ package body Urealp is Write_Str (".0"); if Val.Den /= 0 then - Write_Char ('*'); + Write_Char ('/'); Write_Int (Val.Rbase); Write_Str ("**"); if Val.Den <= 0 then UI_Write (-Val.Den, Decimal); else - Write_Str ("(-"); UI_Write (Val.Den, Decimal); - Write_Char (')'); end if; end if;