+2017-05-02 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch3.adb (Build_Initialization_Call): Generate a null
+ statement if the initialization call is a null procedure, as
+ can happen with a controlled type with no explicit Initialize
+ procedure, or an array of such.
+ * exp_ch7.adb (Process_Object_Declaration): For a type with
+ controlled components that has a trivial Initialize procedure,
+ insert declaration for finalization counter after object
+ declaration itself.
+ (Make_Deep_Array_Body, Build_Initialize_statements): Do not create
+ finalization block and attendant declarations if component has
+ a trivial Initialize procedure.
+ (Make_Init_Call): Do not generate a call if controlled type has
+ a trivial Initialize procedure.
+
+2017-05-02 Eric Botcazou <ebotcazou@adacore.com>
+
+ * g-forstr.ads (Data): Move Format component last.
+ * g-forstr.adb ("+"): Adjust for above change.
+ * g-rewdat.ads (Buffer): Move Buffer, Current, Pattern and Value last.
+ * g-sechas.ads (Context): Move Key last.
+ * g-socket.ads (Service_Entry_Type): Move Aliases last.
+ * s-fileio.adb (Temp_File_Record): Move Name last.
+ * s-regexp.adb (Regexp_Value): Move Case_Sensitive last.
+ * xr_tabls.ads (Project_File): Move Src_Dir and Obj_Dir last.
+
+2017-05-02 Jerome Lambourg <lambourg@adacore.com>
+
+ * bindusg.adb, bindgen.adb, gnatbind.adb, opt.ads: Remove the -nognarl
+ switch introduced recently. finally not needed.
+
+2017-05-02 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch6.adb (Analyze_Null_Procedure): Set the
+ Corresponding_Body link for a null procedure declaration.
+
2017-05-02 Eric Botcazou <ebotcazou@adacore.com>
* atree.h (Flag290): Add missing terminating parenthesis.
-- used: System.OS_Interface should always be used by any tasking
-- application.
- if not Opt.No_Libgnarl then
- Check_Package (With_GNARL, "system.os_interface%s");
- end if;
+ Check_Package (With_GNARL, "system.os_interface%s");
-- Ditto for the use of restricted tasking
Write_Line
(" -n No Ada main program (foreign main routine)");
- -- Line for -nognarl
-
- Write_Line
- (" -nognarl Don't use libgnarl when writing linker instructions");
-
-- Line for -nostdinc
Write_Line
if Is_Null_Init_Proc (Proc) and then not Init_Or_Norm_Scalars then
return Empty_List;
+
+ -- Nothing to do for an array of controlled components that have only
+ -- the inherited Initialize primitive. This is a useful optimization
+ -- for CodePeer.
+
+ elsif Is_Trivial_Subprogram (Proc)
+ and then Is_Array_Type (Full_Init_Type)
+ then
+ return New_List (Make_Null_Statement (Loc));
end if;
-- Use the [underlying] full view when dealing with a private type. This
Find_Last_Init (Count_Ins, Body_Ins);
end if;
+ -- If the Initialize function is null or trivial, the call will have
+ -- been replaced with a null statement, in which case place counter
+ -- declaration after object declaration itself.
+
+ if No (Count_Ins) then
+ Count_Ins := Decl;
+ end if;
+
Insert_After (Count_Ins, Inc_Decl);
Analyze (Inc_Decl);
Init_Call := Build_Initialization_Call;
- if Present (Init_Call) then
+ -- Only create finalization block if there is a non-trivial
+ -- call to initialization.
+
+ if Present (Init_Call)
+ and then Nkind (Init_Call) /= N_Null_Statement
+ then
Init_Loop :=
Make_Block_Statement (Loc,
Handled_Statement_Sequence =>
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts)));
+ -- If there are no calls to component initialization, indicate that
+ -- the procedure is trivial, so prevent calls to it.
+
+ if Is_Empty_List (Stmts)
+ or else Nkind (First (Stmts)) = N_Null_Statement
+ then
+ Set_Is_Trivial_Subprogram (Proc_Id);
+ end if;
+
return Proc_Id;
end Make_Deep_Proc;
Check_Visibly_Controlled (Initialize_Case, Typ, Proc, Ref);
end if;
+ -- If initialization procedure for an array of controlled objects is
+ -- trivial, do not generate a useless call to it.
+
+ if (Is_Array_Type (Utyp) and then Is_Trivial_Subprogram (Proc))
+ or else
+ (not Comes_From_Source (Proc)
+ and then Present (Alias (Proc))
+ and then Is_Trivial_Subprogram (Alias (Proc)))
+ then
+ return Make_Null_Statement (Loc);
+ end if;
+
-- The object reference may need another conversion depending on the
-- type of the formal and that of the actual.
-- --
-- B o d y --
-- --
--- Copyright (C) 2014-2016, Free Software Foundation, Inc. --
+-- Copyright (C) 2014-2017, 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- --
begin
return Formatted_String'
(Finalization.Controlled with
- D => new Data'(Format'Length, 1, Format, 1,
- Null_Unbounded_String, 0, 0, (0, 0)));
+ D => new Data'(Format'Length, 1, 1,
+ Null_Unbounded_String, 0, 0, (0, 0), Format));
end "+";
---------
-- --
-- S p e c --
-- --
--- Copyright (C) 2014-2016, Free Software Foundation, Inc. --
+-- Copyright (C) 2014-2017, 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- --
type Data (Size : Natural) is record
Ref_Count : Natural := 1;
- Format : String (1 .. Size); -- the format string
Index : Positive := 1; -- format index for next value
Result : Unbounded_String; -- current value
Current : Natural; -- the current format number
Stored_Value : Natural := 0; -- number of stored values in Stack
Stack : I_Vars;
+ Format : String (1 .. Size); -- the format string
end record;
type Data_Access is access Data;
-- --
-- S p e c --
-- --
--- Copyright (C) 2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2014-2017, 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- --
type Buffer
(Size, Size_Pattern, Size_Value : Stream_Element_Offset) is
limited record
+ Pos_C : Stream_Element_Offset; -- last valid element in Current
+ Pos_B : Stream_Element_Offset; -- last valid element in Buffer
+
+ Next : Buffer_Ref;
+ -- A link to another rewriter if any
+
Buffer : Stream_Element_Array (1 .. Size);
-- Fully prepared/rewritten data waiting to be output
Value : Stream_Element_Array (1 .. Size_Value);
-- The value the pattern is replaced by
-
- Pos_C : Stream_Element_Offset; -- last valid element in Current
- Pos_B : Stream_Element_Offset; -- last valid element in Buffer
-
- Next : Buffer_Ref;
- -- A link to another rewriter if any
end record;
end GNAT.Rewrite_Data;
-- --
-- S p e c --
-- --
--- Copyright (C) 2009-2016, Free Software Foundation, Inc. --
+-- Copyright (C) 2009-2017, 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- --
-- KL is 0 for a normal hash context, > 0 for HMAC
type Context (KL : Key_Length := 0) is record
- Key : Stream_Element_Array (1 .. KL);
- -- HMAC key
-
H_State : Hash_State.State (0 .. State_Words - 1) := Initial_State;
-- Function-specific state
M_State : Message_State (Block_Length);
-- Function-independent state (block buffer)
+
+ Key : Stream_Element_Array (1 .. KL);
+ -- HMAC key
end record;
Initial_Context : constant Context (KL => 0) := (others => <>);
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2016, AdaCore --
+-- Copyright (C) 2001-2017, AdaCore --
-- --
-- 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- --
type Service_Entry_Type (Aliases_Length : Natural) is record
Official : Name_Type;
- Aliases : Name_Array (1 .. Aliases_Length);
Port : Port_Type;
Protocol : Name_Type;
+ Aliases : Name_Array (1 .. Aliases_Length);
end record;
type Request_Flag_Type is mod 2 ** 8;
elsif Argv (2 .. Argv'Last) = "nostdinc" then
Opt.No_Stdinc := True;
- elsif Argv (2 .. Argv'Last) = "nognarl" then
- Opt.No_Libgnarl := True;
-
-- -static
elsif Argv (2 .. Argv'Last) = "static" then
-- GNATMAKE, GNATBIND, GNATFIND, GNATXREF
-- Set to True if no default library search dirs added to search list.
- No_Libgnarl : Boolean := False;
- -- GNATBIND
- -- Set to True if libgnarl is not available in the runtime.
-
No_Strict_Aliasing : Boolean := False;
-- GNAT
-- Set True if pragma No_Strict_Aliasing with no parameters encountered.
type Temp_File_Record is record
File : AFCB_Ptr;
- Name : String (1 .. max_path_len + 1);
Next : aliased Temp_File_Record_Ptr;
+ Name : String (1 .. max_path_len + 1);
end record;
-- One of these is allocated for each temporary file created
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2016, AdaCore --
+-- Copyright (C) 1999-2017, AdaCore --
-- --
-- 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- --
Num_States : State_Index) is
record
Map : Mapping;
+ Case_Sensitive : Boolean;
States : Regexp_Array (1 .. Num_States, 0 .. Alphabet_Size);
Is_Final : Boolean_Array (1 .. Num_States);
- Case_Sensitive : Boolean;
end record;
-- Deterministic finite-state machine
Is_Completion := False;
+ -- Link the body to the null procedure spec
+
+ if Nkind (N) = N_Subprogram_Declaration then
+ Set_Corresponding_Body (N, Defining_Entity (Null_Body));
+ end if;
+
-- Null procedures are always inlined, but generic formal subprograms
-- which appear as such in the internal instance of formal packages,
-- need no completion and are not marked Inline.
if Expander_Active
and then Nkind (N) /= N_Formal_Concrete_Subprogram_Declaration
then
- Set_Corresponding_Body (N, Defining_Entity (Null_Body));
Set_Body_To_Inline (N, Null_Body);
Set_Is_Inlined (Designator);
end if;
-- --
-- S p e c --
-- --
--- Copyright (C) 1998-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2017, 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- --
private
type Project_File (Src_Dir_Length, Obj_Dir_Length : Natural) is record
- Src_Dir : String (1 .. Src_Dir_Length);
- Src_Dir_Index : Integer;
-
- Obj_Dir : String (1 .. Obj_Dir_Length);
+ Src_Dir_Index : Integer;
Obj_Dir_Index : Integer;
Last_Obj_Dir_Start : Natural;
+ Src_Dir : String (1 .. Src_Dir_Length);
+ Obj_Dir : String (1 .. Obj_Dir_Length);
end record;
type Project_File_Ptr is access all Project_File;
type Declaration_Record (Symbol_Length : Natural) is record
Key : Cst_String_Access;
- Symbol : String (1 .. Symbol_Length);
Decl : Reference;
Is_Parameter : Boolean := False; -- True if entity is subprog param
Decl_Type : Character;
Match : Boolean := False;
Par_Symbol : Declaration_Reference := null;
Next : Declaration_Reference := null;
+ Symbol : String (1 .. Symbol_Length);
end record;
-- The lists of referenced (Body_Ref, Ref_Ref and Modif_Ref) are
-- kept unsorted until the results needs to be printed. This saves
projects / gcc.git / commitdiff