procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2013-01-03  Emmanuel Briot  <briot@adacore.com>

	* xref_lib.adb (Parse_Identifier_Info): Fix handling of arrays, which
	have information in the ALI file for both the index and the component
	types.

2013-01-03  Emmanuel Briot  <briot@adacore.com>

	* projects.texi: Fix error in documenting the project path
	computed for an aggregate project.

2013-01-03  Javier Miranda  <miranda@adacore.com>

	* sem_warn.adb (Warn_On_Overlapping_Actuals): Adding documentation
	plus restricting the functionality of this routine to cover the
	cases described in the Ada 2012 reference manual. The previous
	extended support is now available under -gnatX.
	* s-tassta.adb (Finalize_Global_Tasks): Addition of a dummy
	variable to call Timed_Sleep.  Required to avoid warning on
	overlapping out-mode actuals.
	* opt.ads (Extensions_Allowed): Update documentation.

2013-01-03  Tristan Gingold  <gingold@adacore.com>

	* s-arit64.ads: Use Multiply_With_Ovflo_Check as __gnat_mulv64.
	* arit64.c: Removed
	* gcc-interface/Makefile.in: Remove reference to arit64.c.

2013-01-03  Thomas Quinot  <quinot@adacore.com>

	* checks.adb, checks.ads (Apply_Address_Clause_Check): The check must
	be generated at the start of the freeze actions for the entity, not
	before (or after) the freeze node.

2013-01-03  Thomas Quinot  <quinot@adacore.com>

	* exp_aggr.adb (Exp_Aggr.Convert_Aggregate_In_Obj_Decl):
	Reorganize code to capture initialization statements in a block,
	so that freeze nodes are excluded from the captured block.

From-SVN: r194848
This commit is contained in:
Arnaud Charlet 2013-01-03 12:05:20 +01:00
parent 02217452f0
commit 6f5c2c4b49
12 changed files with 193 additions and 127 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
gcc/ada/ChangeLog
View file

@ -1,3 +1,43 @@
2013-01-03 Emmanuel Briot <briot@adacore.com>
* xref_lib.adb (Parse_Identifier_Info): Fix handling of arrays, which
have information in the ALI file for both the index and the component
types.
2013-01-03 Emmanuel Briot <briot@adacore.com>
* projects.texi: Fix error in documenting the project path
computed for an aggregate project.
2013-01-03 Javier Miranda <miranda@adacore.com>
* sem_warn.adb (Warn_On_Overlapping_Actuals): Adding documentation
plus restricting the functionality of this routine to cover the
cases described in the Ada 2012 reference manual. The previous
extended support is now available under -gnatX.
* s-tassta.adb (Finalize_Global_Tasks): Addition of a dummy
variable to call Timed_Sleep. Required to avoid warning on
overlapping out-mode actuals.
* opt.ads (Extensions_Allowed): Update documentation.
2013-01-03 Tristan Gingold <gingold@adacore.com>
* s-arit64.ads: Use Multiply_With_Ovflo_Check as __gnat_mulv64.
* arit64.c: Removed
* gcc-interface/Makefile.in: Remove reference to arit64.c.
2013-01-03 Thomas Quinot <quinot@adacore.com>
* checks.adb, checks.ads (Apply_Address_Clause_Check): The check must
be generated at the start of the freeze actions for the entity, not
before (or after) the freeze node.
2013-01-03 Thomas Quinot <quinot@adacore.com>
* exp_aggr.adb (Exp_Aggr.Convert_Aggregate_In_Obj_Decl):
Reorganize code to capture initialization statements in a block,
so that freeze nodes are excluded from the captured block.
2013-01-03 Thomas Quinot <quinot@adacore.com>
* exp_ch11.adb: Minor reformatting.

57
gcc/ada/arit64.c
View file

@ -1,57 +0,0 @@
/****************************************************************************
* *
* GNAT COMPILER COMPONENTS *
* *
* A R I T 6 4 . C *
* *
* C Implementation File *
* *
* Copyright (C) 2009-2012, 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- *
* ware Foundation; either version 3, or (at your option) any later ver- *
* sion. GNAT is distributed in the hope that it will be useful, but WITH- *
* OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
* or FITNESS FOR A PARTICULAR PURPOSE. *
* *
* As a special exception under Section 7 of GPL version 3, you are granted *
* additional permissions described in the GCC Runtime Library Exception, *
* version 3.1, as published by the Free Software Foundation. *
* *
* You should have received a copy of the GNU General Public License and *
* a copy of the GCC Runtime Library Exception along with this program; *
* see the files COPYING3 and COPYING.RUNTIME respectively. If not, see *
* <http://www.gnu.org/licenses/>. *
* *
* GNAT was originally developed by the GNAT team at New York University. *
* Extensive contributions were provided by Ada Core Technologies Inc. *
* *
****************************************************************************/
extern void __gnat_rcheck_CE_Overflow_Check(char *file, int line)
__attribute__ ((__noreturn__));
long long int __gnat_mulv64 (long long int x, long long int y)
{
unsigned neg = (x >= 0) ^ (y >= 0);
long long unsigned xa = x >= 0 ? (long long unsigned) x
: -(long long unsigned) x;
long long unsigned ya = y >= 0 ? (long long unsigned) y
: -(long long unsigned) y;
unsigned xhi = (unsigned) (xa >> 32);
unsigned yhi = (unsigned) (ya >> 32);
unsigned xlo = (unsigned) xa;
unsigned ylo = (unsigned) ya;
long long unsigned mid
= xhi ? (long long unsigned) xhi * (long long unsigned) ylo
: (long long unsigned) yhi * (long long unsigned) xlo;
long long unsigned low = (long long unsigned) xlo * (long long unsigned) ylo;
if ((xhi && yhi) || mid + (low >> 32) > 0x7fffffff + neg)
__gnat_rcheck_CE_Overflow_Check (__FILE__, __LINE__);
low += ((long long unsigned) (unsigned) mid) << 32;
return (long long int) (neg ? -low : low);
}

14
gcc/ada/checks.adb
View file

@ -575,6 +575,8 @@ package body Checks is
--------------------------------
procedure Apply_Address_Clause_Check (E : Entity_Id; N : Node_Id) is
pragma Assert (Nkind (N) = N_Freeze_Entity);
AC : constant Node_Id := Address_Clause (E);
Loc : constant Source_Ptr := Sloc (AC);
Typ : constant Entity_Id := Etype (E);
@ -734,7 +736,11 @@ package body Checks is
Remove_Side_Effects (Expr);
end if;
Insert_After_And_Analyze (N,
if No (Actions (N)) then
Set_Actions (N, New_List);
end if;
Prepend_To (Actions (N),
Make_Raise_Program_Error (Loc,
Condition =>
Make_Op_Ne (Loc,
@ -745,11 +751,11 @@ package body Checks is
(RTE (RE_Integer_Address), Expr),
Right_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (E, Loc),
Prefix => New_Occurrence_Of (E, Loc),
Attribute_Name => Name_Alignment)),
Right_Opnd => Make_Integer_Literal (Loc, Uint_0)),
Reason => PE_Misaligned_Address_Value),
Suppress => All_Checks);
Reason => PE_Misaligned_Address_Value));
Analyze (First (Actions (N)), Suppress => All_Checks);
return;
end if;

7
gcc/ada/checks.ads
View file

@ -131,8 +131,11 @@ package Checks is
-- are enabled, then this procedure generates a check that the specified
-- address has an alignment consistent with the alignment of the object,
-- raising PE if this is not the case. The resulting check (if one is
-- generated) is inserted before node N. check is also made for the case of
-- a clear overlay situation that the size of the overlaying object is not
-- generated) is prepended to the Actions list of N_Freeze_Entity node N.
-- Note that the check references E'Alignment, so it cannot be emitted
-- before N (its freeze node), otherwise this would cause an illegal
-- access before elaboration error in GIGI. For the case of a clear overlay
-- situation, we also check that the size of the overlaying object is not
-- larger than the overlaid object.
procedure Apply_Arithmetic_Overflow_Check (N : Node_Id);

52
gcc/ada/exp_aggr.adb
View file

@ -3012,8 +3012,6 @@ package body Exp_Aggr is
Loc : constant Source_Ptr := Sloc (Aggr);
Typ : constant Entity_Id := Etype (Aggr);
Occ : constant Node_Id := New_Occurrence_Of (Obj, Loc);
Blk : Node_Id := Empty;
Ins : Node_Id;
function Discriminants_Ok return Boolean;
-- If the object type is constrained, the discriminants in the
@ -3118,27 +3116,39 @@ package body Exp_Aggr is
(Aggr,
Sec_Stack =>
Is_Controlled (Typ) or else Has_Controlled_Component (Typ));
Ins := N;
-- Need to Set_Initialization_Statements??? (see below)
else
-- Capture initialization statements within an identified block
-- statement, as we might need to move them to the freeze actions
-- of Obj later on if a representation clause (such as an address
-- clause) makes it necessary to delay freezing.
Ins := Make_Null_Statement (Loc);
Blk := Make_Block_Statement (Loc,
Declarations => New_List,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Ins)));
Insert_Action_After (N, Blk);
Set_Initialization_Statements (Obj, Blk);
end if;
Insert_Actions_After (Ins, Late_Expansion (Aggr, Typ, Occ));
declare
Node_After : constant Node_Id := Next (N);
Init_Node : Node_Id;
Blk : Node_Id;
Init_Actions : constant List_Id := New_List;
begin
Insert_Actions_After (N, Late_Expansion (Aggr, Typ, Occ));
-- Move inserted, analyzed actions to Init_Actions, but skip over
-- freeze nodes as these need to remain in the proper scope.
Init_Node := N;
while Next (Init_Node) /= Node_After loop
if Nkind (Next (Init_Node)) = N_Freeze_Entity then
Next (Init_Node);
else
Append_To (Init_Actions, Remove_Next (Init_Node));
end if;
end loop;
if not Is_Empty_List (Init_Actions) then
Blk := Make_Block_Statement (Loc,
Declarations => New_List,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Init_Actions));
Insert_Action_After (Init_Node, Blk);
Set_Initialization_Statements (Obj, Blk);
end if;
end;
Set_No_Initialization (N);
Initialize_Discriminants (N, Typ);
end Convert_Aggr_In_Object_Decl;

2
gcc/ada/gcc-interface/Makefile.in
View file

@ -2308,7 +2308,7 @@ endif
# LIBGNAT_SRCS is the list of all C files (including headers) of the runtime
# library. LIBGNAT_OBJS is the list of object files for libgnat.
# thread.c is special as put into GNATRTL_TASKING_OBJS by Makefile.rtl
LIBGNAT_OBJS = adadecode.o adaint.o argv.o arit64.o aux-io.o \
LIBGNAT_OBJS = adadecode.o adaint.o argv.o aux-io.o \
cal.o cio.o cstreams.o ctrl_c.o \
env.o errno.o exit.o expect.o final.o \
init.o initialize.o locales.o mkdir.o \

2
gcc/ada/opt.ads
View file

@ -563,7 +563,7 @@ package Opt is
Extensions_Allowed : Boolean := False;
-- GNAT
-- Set to True by switch -gnatX if GNAT specific language extensions
-- are allowed. Currently there are no such defined extensions.
-- are allowed.
type External_Casing_Type is (
As_Is, -- External names cased as they appear in the Ada source

16
gcc/ada/projects.texi
View file

@ -2514,11 +2514,17 @@ project files specified with @code{Project_Files}.
Each aggregate project has its own (that is if agg1.gpr includes
agg2.gpr, they can potentially both have a different project path).
This project path is defined as the concatenation, in that order, of
the current directory, followed by the command line -aP switches,
then the directories from the Project_Path attribute, then the
directories from the GPR_PROJECT_PATH and ADA_PROJECT_PATH env.
variables, and finally the predefined directories.
This project path is defined as the concatenation, in that order, of:
@itemize @bullet
@item the current directory;
@item followed by the command line -aP switches;
@item then the directories from the GPR_PROJECT_PATH and ADA_PROJECT_PATH environment
variables;
@item then the directories from the Project_Path attribute;
@item and finally the predefined directories.
@end itemize
In the example above, agg2.gpr's project path is not influenced by
the attribute agg1'Project_Path, nor is agg1 influenced by

7
gcc/ada/s-arit64.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
@ -33,6 +33,9 @@
-- signed integer values in cases where either overflow checking is
-- required, or intermediate results are longer than 64 bits.
pragma Restrictions (No_Elaboration_Code);
-- Allow direct call from gigi generated code
with Interfaces;
package System.Arith_64 is
@ -49,8 +52,10 @@ package System.Arith_64 is
-- bits, otherwise returns the 64-bit signed integer difference.
function Multiply_With_Ovflo_Check (X, Y : Int64) return Int64;
pragma Export (C, Multiply_With_Ovflo_Check, "__gnat_mulv64");
-- Raises Constraint_Error if product of operands overflows 64
-- bits, otherwise returns the 64-bit signed integer product.
-- GIGI may also call this routine directly.
procedure Scaled_Divide
(X, Y, Z : Int64;

9
gcc/ada/s-tassta.adb
View file

@ -806,8 +806,9 @@ package body System.Tasking.Stages is
procedure Finalize_Global_Tasks is
Self_ID : constant Task_Id := STPO.Self;
Ignore : Boolean;
pragma Unreferenced (Ignore);
Ignore_1 : Boolean;
Ignore_2 : Boolean;
pragma Unreferenced (Ignore_1, Ignore_2);
function State
(Int : System.Interrupt_Management.Interrupt_ID) return Character;
@ -877,7 +878,7 @@ package body System.Tasking.Stages is
Timed_Sleep
(Self_ID, 0.01, System.OS_Primitives.Relative,
Self_ID.Common.State, Ignore, Ignore);
Self_ID.Common.State, Ignore_1, Ignore_2);
end loop;
end if;
@ -886,7 +887,7 @@ package body System.Tasking.Stages is
Timed_Sleep
(Self_ID, 0.01, System.OS_Primitives.Relative,
Self_ID.Common.State, Ignore, Ignore);
Self_ID.Common.State, Ignore_1, Ignore_2);
Unlock (Self_ID);

103
gcc/ada/sem_warn.adb
View file

@ -3292,41 +3292,89 @@ package body Sem_Warn is
Act1, Act2 : Node_Id;
Form1, Form2 : Entity_Id;
function Is_Covered_Formal (Formal : Node_Id) return Boolean;
-- Return True if Formal is covered by the Ada 2012 rule. Under -gnatX
-- the rule is extended to cover record and array types.
function Refer_Same_Object (Act1, Act2 : Node_Id) return Boolean;
-- Two names are known to refer to the same object if the two names
-- are known to denote the same object; or one of the names is a
-- selected_component, indexed_component, or slice and its prefix is
-- known to refer to the same object as the other name; or one of the
-- two names statically denotes a renaming declaration whose renamed
-- object_name is known to refer to the same object as the other name
-- (RM 6.4.1(6.11/3))
-----------------------
-- Refer_Same_Object --
-----------------------
function Refer_Same_Object (Act1, Act2 : Node_Id) return Boolean is
begin
return Denotes_Same_Object (Act1, Act2)
or else Denotes_Same_Prefix (Act1, Act2);
end Refer_Same_Object;
-----------------------
-- Is_Covered_Formal --
-----------------------
function Is_Covered_Formal (Formal : Node_Id) return Boolean is
begin
-- Ada 2012 rule
if not Extensions_Allowed then
return
Ekind_In (Formal, E_Out_Parameter,
E_In_Out_Parameter)
and then Is_Elementary_Type (Etype (Formal));
-- Under -gnatX the rule is extended to cover array and record types
else
return
Ekind_In (Formal, E_Out_Parameter,
E_In_Out_Parameter)
and then (Is_Elementary_Type (Etype (Formal))
or else Is_Record_Type (Etype (Formal))
or else Is_Array_Type (Etype (Formal)));
end if;
end Is_Covered_Formal;
begin
if not Warn_On_Overlap then
if Ada_Version < Ada_2012 and then not Warn_On_Overlap then
return;
end if;
-- Exclude calls rewritten as enumeration literals
if Nkind (N) not in N_Subprogram_Call then
return;
end if;
-- Exclude calls to library subprograms. Container operations specify
-- safe behavior when source and target coincide.
if Is_Predefined_File_Name
(Unit_File_Name (Get_Source_Unit (Sloc (Subp))))
if Nkind (N) not in N_Subprogram_Call
and then Nkind (N) /= N_Entry_Call_Statement
then
return;
end if;
-- If a call C has two or more parameters of mode in out or out that are
-- of an elementary type, then the call is legal only if for each name
-- N that is passed as a parameter of mode in out or out to the call C,
-- there is no other name among the other parameters of mode in out or
-- out to C that is known to denote the same object (RM 6.4.1(6.15/3))
-- Under -gnatX the rule is extended to cover array and record types.
Form1 := First_Formal (Subp);
Act1 := First_Actual (N);
while Present (Form1) and then Present (Act1) loop
if Ekind (Form1) /= E_In_Parameter then
if Is_Covered_Formal (Form1) then
Form2 := First_Formal (Subp);
Act2 := First_Actual (N);
while Present (Form2) and then Present (Act2) loop
if Form1 /= Form2
and then Ekind (Form2) /= E_Out_Parameter
and then
(Denotes_Same_Object (Act1, Act2)
or else
Denotes_Same_Prefix (Act1, Act2))
and then Is_Covered_Formal (Form2)
and then Refer_Same_Object (Act1, Act2)
then
-- Exclude generic types and guard against previous errors
-- Guard against previous errors
if Error_Posted (N)
or else No (Etype (Act1))
@ -3334,14 +3382,8 @@ package body Sem_Warn is
then
null;
elsif Is_Generic_Type (Etype (Act1))
or else
Is_Generic_Type (Etype (Act2))
then
null;
-- If the actual is a function call in prefix notation,
-- there is no real overlap.
-- If the actual is a function call in prefix notation,
-- there is no real overlap.
elsif Nkind (Act2) = N_Function_Call then
null;
@ -3350,11 +3392,20 @@ package body Sem_Warn is
-- intended.
elsif
Is_By_Reference_Type (Underlying_Type (Etype (Form1)))
Present (Underlying_Type (Etype (Form1)))
and then
(Is_By_Reference_Type (Underlying_Type (Etype (Form1)))
or else
Convention (Underlying_Type (Etype (Form1)))
= Convention_Ada_Pass_By_Reference)
then
null;
-- Here we may need to issue message
else
Error_Msg_Warn := Ada_Version < Ada_2012;
declare
Act : Node_Id;
Form : Entity_Id;

11
gcc/ada/xref_lib.adb
View file

@ -925,10 +925,11 @@ package body Xref_Lib is
end;
end if;
if Ali (Ptr) = '<'
or else Ali (Ptr) = '('
or else Ali (Ptr) = '{'
then
while Ptr <= Ali'Last
and then (Ali (Ptr) = '<'
or else Ali (Ptr) = '('
or else Ali (Ptr) = '{')
loop
-- Here we have a type derivation information. The format is
-- <3|12I45> which means that the current entity is derived from the
-- type defined in unit number 3, line 12 column 45. The pipe and
@ -1065,7 +1066,7 @@ package body Xref_Lib is
end loop;
Ptr := Ptr + 1;
end if;
end if;
end loop;
-- To find the body, we will have to parse the file too