Commit c7518e6f by Arnaud Charlet

[multiple changes]

2016-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Export_Import): Signal that there is no
	corresponding pragma.

2016-04-27  Bob Duff  <duff@adacore.com>

	* exp_ch3.adb: Minor comment improvement.

2016-04-27  Ed Schonberg  <schonberg@adacore.com>

	* 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  <miranda@adacore.com>

	* 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  <schonberg@adacore.com>

	* 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
parent 814cc240
2016-04-27 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch13.adb (Analyze_Aspect_Export_Import): Signal that there is no
corresponding pragma.
2016-04-27 Bob Duff <duff@adacore.com>
* exp_ch3.adb: Minor comment improvement.
2016-04-27 Ed Schonberg <schonberg@adacore.com>
* 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 <miranda@adacore.com>
* 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 <schonberg@adacore.com>
* 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 <charlet@adacore.com>
* s-rident.ads: Make No_Implicit_Loops non partition wide.
......
......@@ -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;
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment