+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.
-- --
-- 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- --
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.
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
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;
-- --
-- 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- --
-- 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
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
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
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
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.
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
-- 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;
projects / gcc.git / commitdiff