From: Arnaud Charlet Date: Wed, 27 Apr 2016 12:30:49 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c7518e6f52aad178875818666fcfc92ff4e08e8f;p=gcc.git [multiple changes] 2016-04-27 Hristian Kirtchev * sem_ch13.adb (Analyze_Aspect_Export_Import): Signal that there is no corresponding pragma. 2016-04-27 Bob Duff * exp_ch3.adb: Minor comment improvement. 2016-04-27 Ed Schonberg * exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration): If the return type is an untagged limited record with only access discriminants and no controlled components, the return value does not need to use the secondary stack. 2016-04-27 Javier Miranda * exp_util.adb (Remove_Side_Effects): When generating C code handle object declarations that have discriminants and are initialized by means of a call to a function. 2016-04-27 Ed Schonberg * a-textio.adb (Get_Line function): Handle properly the case of a line that has the same length as the buffer (or a multiple thereof) and there is no line terminator. * a-tigeli.adb (Get_Line procedure): Do not store an end_of_file in the string when there is no previous line terminator and we need at most one additional character. From-SVN: r235492 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b04b513777c..4b39a4d8542 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2016-04-27 Hristian Kirtchev + + * sem_ch13.adb (Analyze_Aspect_Export_Import): Signal that there is no + corresponding pragma. + +2016-04-27 Bob Duff + + * exp_ch3.adb: Minor comment improvement. + +2016-04-27 Ed Schonberg + + * exp_ch6.adb (Make_Build_In_Place_Call_In_Object_Declaration): If the + return type is an untagged limited record with only access + discriminants and no controlled components, the return value does not + need to use the secondary stack. + +2016-04-27 Javier Miranda + + * exp_util.adb (Remove_Side_Effects): When + generating C code handle object declarations that have + discriminants and are initialized by means of a call to a + function. + +2016-04-27 Ed Schonberg + + * a-textio.adb (Get_Line function): Handle properly the case of + a line that has the same length as the buffer (or a multiple + thereof) and there is no line terminator. + * a-tigeli.adb (Get_Line procedure): Do not store an end_of_file + in the string when there is no previous line terminator and we + need at most one additional character. + 2016-04-27 Arnaud Charlet * s-rident.ads: Make No_Implicit_Loops non partition wide. diff --git a/gcc/ada/a-textio.adb b/gcc/ada/a-textio.adb index dc0b45358fe..61d6accc078 100644 --- a/gcc/ada/a-textio.adb +++ b/gcc/ada/a-textio.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, 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- -- @@ -704,9 +704,6 @@ package body Ada.Text_IO is end Get_Line; function Get_Line (File : File_Type) return String is - Buffer : String (1 .. 500); - Last : Natural; - function Get_Rest (S : String) return String; -- This is a recursive function that reads the rest of the line and -- returns it. S is the part read so far. @@ -732,12 +729,19 @@ package body Ada.Text_IO is begin if Last < Buffer'Last then return R; + else return Get_Rest (R); end if; end; end Get_Rest; + -- Local variables + + Buffer : String (1 .. 500); + ch : int; + Last : Natural; + -- Start of processing for Get_Line begin @@ -745,6 +749,22 @@ package body Ada.Text_IO is if Last < Buffer'Last then return Buffer (1 .. Last); + + -- If the String has the same length as the buffer, and there is no end + -- of line, check whether we are at the end of file, in which case we + -- have the full String in the buffer. + + elsif Last = Buffer'Last then + ch := Getc (File); + + if ch = EOF then + return Buffer; + + else + Ungetc (ch, File); + return Get_Rest (Buffer (1 .. Last)); + end if; + else return Get_Rest (Buffer (1 .. Last)); end if; diff --git a/gcc/ada/a-tigeli.adb b/gcc/ada/a-tigeli.adb index 8273b050775..d4aedcdd7d1 100644 --- a/gcc/ada/a-tigeli.adb +++ b/gcc/ada/a-tigeli.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, 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- -- @@ -187,8 +187,13 @@ begin -- If we get EOF after already reading data, this is an incomplete -- last line, in which case no End_Error should be raised. - if ch = EOF and then Last < Item'First then - raise End_Error; + if ch = EOF then + if Last < Item'First then + raise End_Error; + + else -- All done + return; + end if; elsif ch /= LM then diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 09253290f09..e76db7eeeb7 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -7108,8 +7108,10 @@ package body Exp_Ch3 is end; end if; - -- Final transformation - turn the object declaration into a renaming if - -- appropriate. + -- Final transformation - turn the object declaration into a renaming + -- if appropriate. If this is the completion of a deferred constant + -- declaration, then this transformation generates what would be + -- illegal code if written by hand, but that's OK. if Present (Expr) then if Rewrite_As_Renaming then diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 4e996a16411..60c2ce034ea 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -7783,7 +7783,12 @@ package body Exp_Ch6 is Result_Subt : Entity_Id; Definite : Boolean; - -- True for definite function result subtype + -- True if result subtype is definite, or has a size that does not + -- require secondary stack usage (i.e. no variant part or components + -- whose type depends on discriminants). In particular, untagged types + -- with only access discriminants do not require secondary stack use. + -- Note that if the return type is tagged we must always use the sec. + -- stack because the call may dispatch on result. begin -- Step past qualification or unchecked conversion (the latter can occur @@ -7818,7 +7823,10 @@ package body Exp_Ch6 is end if; Result_Subt := Etype (Function_Id); - Definite := Is_Definite_Subtype (Underlying_Type (Result_Subt)); + Definite := + (Is_Definite_Subtype (Underlying_Type (Result_Subt)) + and then not Is_Tagged_Type (Result_Subt)) + or else not Requires_Transient_Scope (Underlying_Type (Result_Subt)); -- Create an access type designating the function's result subtype. We -- use the type of the original call because it may be a call to an diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 2e8e1d6966f..7591c3afd27 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -7944,13 +7944,35 @@ package body Exp_Util is else -- An expression which is in SPARK mode is considered side effect -- free if the resulting value is captured by a variable or a - -- constant. Same reasoning when generating C code. - -- Why can't we apply this test in general??? + -- constant. - if (GNATprove_Mode or Generate_C_Code) + if GNATprove_Mode and then Nkind (Parent (Exp)) = N_Object_Declaration then goto Leave; + + -- When generating C code we cannot consider side effect free object + -- declarations that have discriminants and are initialized by means + -- of a function call since on this target there is no secondary + -- stack to store the return value and the expander may generate an + -- extra call to the function to compute the discriminant value. In + -- addition, for targets that have secondary stack, the expansion of + -- functions with side effects involves the generation of an access + -- type to capture the return value stored in the secondary stack; + -- by contrast when generating C code such expansion generates an + -- internal object declaration (no access type involved) which must + -- be identified here to avoid entering into a never-ending loop + -- generating internal object declarations. + + elsif Generate_C_Code + and then Nkind (Parent (Exp)) = N_Object_Declaration + and then + (Nkind (Exp) /= N_Function_Call + or else not Has_Discriminants (Exp_Type) + or else Is_Internal_Name + (Chars (Defining_Identifier (Parent (Exp))))) + then + goto Leave; end if; -- Special processing for function calls that return a limited type. @@ -8063,12 +8085,39 @@ package body Exp_Util is Set_Analyzed (E, False); end if; - Insert_Action (Exp, - Make_Object_Declaration (Loc, - Defining_Identifier => Def_Id, - Object_Definition => New_Occurrence_Of (Ref_Type, Loc), - Constant_Present => True, - Expression => New_Exp)); + -- Generating C code of object declarations that have discriminants + -- and are initialized by means of a function call we propagate the + -- discriminants of the parent type to the internally built object. + -- This is needed to avoid generating an extra call to the called + -- function. + + -- For example, if we generate here the following declaration, it + -- will be expanded later adding an extra call to evaluate the value + -- of the discriminant (needed to compute the size of the object). + -- + -- type Rec (D : Integer) is ... + -- Obj : constant Rec := SomeFunc; + + if Generate_C_Code + and then Nkind (Parent (Exp)) = N_Object_Declaration + and then Has_Discriminants (Exp_Type) + and then Nkind (Exp) = N_Function_Call + then + Insert_Action (Exp, + Make_Object_Declaration (Loc, + Defining_Identifier => Def_Id, + Object_Definition => New_Copy_Tree + (Object_Definition (Parent (Exp))), + Constant_Present => True, + Expression => New_Exp)); + else + Insert_Action (Exp, + Make_Object_Declaration (Loc, + Defining_Identifier => Def_Id, + Object_Definition => New_Occurrence_Of (Ref_Type, Loc), + Constant_Present => True, + Expression => New_Exp)); + end if; end if; -- Preserve the Assignment_OK flag in all copies, since at least one diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 5e4368e563c..d42b7cad79e 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1691,6 +1691,12 @@ package body Sem_Ch13 is -- into account Conversion, External_Name, and Link_Name. Aitem := Build_Export_Import_Pragma (Aspect, E); + + -- Otherwise the expression is either False or erroneous. There + -- is no corresponding pragma. + + else + Aitem := Empty; end if; end Analyze_Aspect_Export_Import;