Skip to content

R
riscv-gcc-1
Commit b727a82b by Arnaud Charlet
Options

[multiple changes] 

2012-01-30  Robert Dewar  <dewar@adacore.com>

	* sem.adb (Analyze): Call Analyze_Mod for N_Op_Mod mode.
	* sem_ch3.adb (Modular_Type_Declaration): Warn on mod value of
	form 2 * small-literal.
	* sem_ch4.adb (Analyze_Mod): New procedure (warn on suspicious
	mod value).
	* sem_ch4.ads (Analyze_Mod): New procedure.

2012-01-30  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb: sem_ch6.adb (Analyze_Expression_Function): Copy
	types and return expression when building spec for implicit
	body, to preserve global references that may be present in an
	instantiation.

2012-01-30  Matthew Heaney  <heaney@adacore.com>

	* a-convec.adb, a-coinve.adb, a-cobove.adb (Sort,
	Reverse_Elements): Check for cursor tampering.

2012-01-30  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Is_Fully_Initialized_Type): In Ada 2012, a
	type with aspect Default_Value or Default_Component_Value is
	fully initialized, and use of variables of such types do not
	generate warnings.

2012-01-30  Vincent Celier  <celier@adacore.com>

	* projects.texi: Add documentation for attribute Interfaces.

From-SVN: r183714
parent e11be5ac
Showing with 224 additions and 30 deletions
gcc/ada/ChangeLog
2012-01-30 Robert Dewar <dewar@adacore.com>
* sem.adb (Analyze): Call Analyze_Mod for N_Op_Mod mode.
* sem_ch3.adb (Modular_Type_Declaration): Warn on mod value of
form 2 * small-literal.
* sem_ch4.adb (Analyze_Mod): New procedure (warn on suspicious
mod value).
* sem_ch4.ads (Analyze_Mod): New procedure.
2012-01-30 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb: sem_ch6.adb (Analyze_Expression_Function): Copy
types and return expression when building spec for implicit
body, to preserve global references that may be present in an
instantiation.
2012-01-30 Matthew Heaney <heaney@adacore.com>
* a-convec.adb, a-coinve.adb, a-cobove.adb (Sort,
Reverse_Elements): Check for cursor tampering.
2012-01-30 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (Is_Fully_Initialized_Type): In Ada 2012, a
type with aspect Default_Value or Default_Component_Value is
fully initialized, and use of variables of such types do not
generate warnings.
2012-01-30 Javier Miranda <miranda@adacore.com>
PR ada/15846
* sem_ch8.adb (Analyze_Subprogram_Renaming):
Handle self-renaming when the renamed entity is referenced using
its expanded name.
2012-01-30 Vincent Celier <celier@adacore.com>
* projects.texi: Add documentation for attribute Interfaces.
2012-01-30 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch7.adb (Build_Finalizer_Call): Set loc again.
......
gcc/ada/a-cobove.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2004-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- --
......@@ -931,8 +931,7 @@ package body Ada.Containers.Bounded_Vectors is
-- Sort --
----------
procedure Sort (Container : in out Vector)
is
procedure Sort (Container : in out Vector) is
procedure Sort is
new Generic_Array_Sort
(Index_Type => Count_Type,
......@@ -940,14 +939,27 @@ package body Ada.Containers.Bounded_Vectors is
Array_Type => Elements_Array,
"<" => "<");
-- Start of processing for Sort
begin
if Container.Last <= Index_Type'First then
return;
end if;
if Container.Lock > 0 then
-- The exception behavior for the vector container must match that
-- for the list container, so we check for cursor tampering here
-- (which will catch more things) instead of for element tampering
-- (which will catch fewer things). It's true that the elements of
-- this vector container could be safely moved around while (say) an
-- iteration is taking place (iteration only increments the busy
-- counter), and so technically all we would need here is a test for
-- element tampering (indicated by the lock counter), that's simply
-- an artifact of our array-based implementation. Logically Sort
-- requires a check for cursor tampering.
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is locked)";
"attempt to tamper with cursors (vector is busy)";
end if;
Sort (Container.Elements (1 .. Container.Length));
......@@ -2234,9 +2246,20 @@ package body Ada.Containers.Bounded_Vectors is
return;
end if;
if Container.Lock > 0 then
-- The exception behavior for the vector container must match that for
-- the list container, so we check for cursor tampering here (which will
-- catch more things) instead of for element tampering (which will catch
-- fewer things). It's true that the elements of this vector container
-- could be safely moved around while (say) an iteration is taking place
-- (iteration only increments the busy counter), and so technically all
-- we would need here is a test for element tampering (indicated by the
-- lock counter), that's simply an artifact of our array-based
-- implementation. Logically Reverse_Elements requires a check for
-- cursor tampering.
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is locked)";
"attempt to tamper with cursors (vector is busy)";
end if;
Idx := 1;
......
gcc/ada/a-coinve.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2004-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- --
......@@ -1396,7 +1396,6 @@ package body Ada.Containers.Indefinite_Vectors is
----------
procedure Sort (Container : in out Vector) is
procedure Sort is new Generic_Array_Sort
(Index_Type => Index_Type,
Element_Type => Element_Access,
......@@ -1410,9 +1409,20 @@ package body Ada.Containers.Indefinite_Vectors is
return;
end if;
if Container.Lock > 0 then
-- The exception behavior for the vector container must match that
-- for the list container, so we check for cursor tampering here
-- (which will catch more things) instead of for element tampering
-- (which will catch fewer things). It's true that the elements of
-- this vector container could be safely moved around while (say) an
-- iteration is taking place (iteration only increments the busy
-- counter), and so technically all we would need here is a test for
-- element tampering (indicated by the lock counter), that's simply
-- an artifact of our array-based implementation. Logically Sort
-- requires a check for cursor tampering.
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is locked)";
"attempt to tamper with cursors (vector is busy)";
end if;
Sort (Container.Elements.EA (Index_Type'First .. Container.Last));
......@@ -3417,9 +3427,20 @@ package body Ada.Containers.Indefinite_Vectors is
return;
end if;
if Container.Lock > 0 then
-- The exception behavior for the vector container must match that for
-- the list container, so we check for cursor tampering here (which will
-- catch more things) instead of for element tampering (which will catch
-- fewer things). It's true that the elements of this vector container
-- could be safely moved around while (say) an iteration is taking place
-- (iteration only increments the busy counter), and so technically all
-- we would need here is a test for element tampering (indicated by the
-- lock counter), that's simply an artifact of our array-based
-- implementation. Logically Reverse_Elements requires a check for
-- cursor tampering.
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is locked)";
"attempt to tamper with cursors (vector is busy)";
end if;
declare
......
gcc/ada/a-convec.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2004-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- --
......@@ -1039,8 +1039,7 @@ package body Ada.Containers.Vectors is
-- Sort --
----------
procedure Sort (Container : in out Vector)
is
procedure Sort (Container : in out Vector) is
procedure Sort is
new Generic_Array_Sort
(Index_Type => Index_Type,
......@@ -1048,14 +1047,27 @@ package body Ada.Containers.Vectors is
Array_Type => Elements_Array,
"<" => "<");
-- Start of processing for Sort
begin
if Container.Last <= Index_Type'First then
return;
end if;
if Container.Lock > 0 then
-- The exception behavior for the vector container must match that
-- for the list container, so we check for cursor tampering here
-- (which will catch more things) instead of for element tampering
-- (which will catch fewer things). It's true that the elements of
-- this vector container could be safely moved around while (say) an
-- iteration is taking place (iteration only increments the busy
-- counter), and so technically all we would need here is a test for
-- element tampering (indicated by the lock counter), that's simply
-- an artifact of our array-based implementation. Logically Sort
-- requires a check for cursor tampering.
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is locked)";
"attempt to tamper with cursors (vector is busy)";
end if;
Sort (Container.Elements.EA (Index_Type'First .. Container.Last));
......@@ -2977,9 +2989,20 @@ package body Ada.Containers.Vectors is
return;
end if;
if Container.Lock > 0 then
-- The exception behavior for the vector container must match that for
-- the list container, so we check for cursor tampering here (which will
-- catch more things) instead of for element tampering (which will catch
-- fewer things). It's true that the elements of this vector container
-- could be safely moved around while (say) an iteration is taking place
-- (iteration only increments the busy counter), and so technically all
-- we would need here is a test for element tampering (indicated by the
-- lock counter), that's simply an artifact of our array-based
-- implementation. Logically Reverse_Elements requires a check for
-- cursor tampering.
if Container.Busy > 0 then
raise Program_Error with
"attempt to tamper with elements (vector is locked)";
"attempt to tamper with cursors (vector is busy)";
end if;
declare
......
gcc/ada/projects.texi
......@@ -1757,9 +1757,12 @@ The name of a stand-alone library, specified with attribute
The most prominent characteristic of a stand-alone library is that it offers a
distinction between interface units and implementation units. Only the former
are visible to units outside the library. A stand-alone library project is thus
characterised by a third attribute, @b{Library_Interface}, in addition to the
two attributes that make a project a Library Project (@code{Library_Name} and
@code{Library_Dir}).
characterised by a third attribute, usually @b{Library_Interface}, in addition
to the two attributes that make a project a Library Project
(@code{Library_Name} and @code{Library_Dir}). This third attribute may also be
@b{Interfaces}. @b{Library_Interface} only works when the interface is in Ada
and takes a list of units as parameter. @b{Interfaces} works for any supported
language and takes a list of sources as parameter.
@table @asis
@item @b{Library_Interface}:
......@@ -1777,6 +1780,13 @@ two attributes that make a project a Library Project (@code{Library_Name} and
@end group
@end smallexample
@item @b{Interfaces}
This attribute defnes an explicit subset of the source files of a project.
It may be used as a replacement for attribute @code{Library_Interface}. For
multi-language library projects, it is the only way to make the project a
Stand-Alone Library project and at the same time to reduce the non Ada
interfacing sources.
@item @b{Library_Standalone}:
@cindex @code{Library_Standalone}
This attribute defines the kind of standalone library to
......
gcc/ada/sem.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, 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- --
......@@ -376,7 +376,7 @@ package body Sem is
Analyze_Unary_Op (N);
when N_Op_Mod =>
Analyze_Arithmetic_Op (N);
Analyze_Mod (N);
when N_Op_Multiply =>
Analyze_Arithmetic_Op (N);
......
gcc/ada/sem_ch3.adb
......@@ -16808,6 +16808,21 @@ package body Sem_Ch3 is
-- Start of processing for Modular_Type_Declaration
begin
-- If the mod expression is (exactly) 2 * literal, where literal is
-- 64 or less,then almost certainly the * was meant to be **. Warn!
if Warn_On_Suspicious_Modulus_Value
and then Nkind (Mod_Expr) = N_Op_Multiply
and then Nkind (Left_Opnd (Mod_Expr)) = N_Integer_Literal
and then Intval (Left_Opnd (Mod_Expr)) = Uint_2
and then Nkind (Right_Opnd (Mod_Expr)) = N_Integer_Literal
and then Intval (Right_Opnd (Mod_Expr)) <= Uint_64
then
Error_Msg_N ("suspicious MOD value, was '*'* intended'??", Mod_Expr);
end if;
-- Proceed with analysis of mod expression
Analyze_And_Resolve (Mod_Expr, Any_Integer);
Set_Etype (T, T);
Set_Ekind (T, E_Modular_Integer_Type);
......
gcc/ada/sem_ch4.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, 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- --
......@@ -62,6 +62,7 @@ with Stand; use Stand;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
package body Sem_Ch4 is
......@@ -2637,6 +2638,34 @@ package body Sem_Ch4 is
end if;
end Analyze_Membership_Op;
-----------------
-- Analyze_Mod --
-----------------
procedure Analyze_Mod (N : Node_Id) is
begin
-- A special warning check, if we have an expression of the form:
-- expr mod 2 * literal
-- where literal is 64 or less, then probably what was meant was
-- expr mod 2 ** literal
-- so issue an appropriate warning.
if Warn_On_Suspicious_Modulus_Value
and then Nkind (Right_Opnd (N)) = N_Integer_Literal
and then Intval (Right_Opnd (N)) = Uint_2
and then Nkind (Parent (N)) = N_Op_Multiply
and then Nkind (Right_Opnd (Parent (N))) = N_Integer_Literal
and then Intval (Right_Opnd (Parent (N))) <= Uint_64
then
Error_Msg_N
("suspicious MOD value, was '*'* intended'??", Parent (N));
end if;
-- Remaining processing is same as for other arithmetic operators
Analyze_Arithmetic_Op (N);
end Analyze_Mod;
----------------------
-- Analyze_Negation --
----------------------
......
gcc/ada/sem_ch4.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, 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- --
......@@ -39,6 +39,7 @@ package Sem_Ch4 is
procedure Analyze_Expression_With_Actions (N : Node_Id);
procedure Analyze_Logical_Op (N : Node_Id);
procedure Analyze_Membership_Op (N : Node_Id);
procedure Analyze_Mod (N : Node_Id);
procedure Analyze_Negation (N : Node_Id);
procedure Analyze_Null (N : Node_Id);
procedure Analyze_Qualified_Expression (N : Node_Id);
......
gcc/ada/sem_ch6.adb
......@@ -293,7 +293,31 @@ package body Sem_Ch6 is
-- determine whether this is possible.
Inline_Processing_Required := True;
New_Spec := Copy_Separate_Tree (Spec);
-- Create a specification for the generated body. Types and defauts in
-- the profile are copies of the spec, but new entities must be created
-- for the unit name and the formals.
New_Spec := New_Copy_Tree (Spec);
Set_Defining_Unit_Name (New_Spec,
Make_Defining_Identifier (Sloc (Defining_Unit_Name (Spec)),
Chars (Defining_Unit_Name (Spec))));
if Present (Parameter_Specifications (New_Spec)) then
declare
Formal_Spec : Node_Id;
begin
Formal_Spec := First (Parameter_Specifications (New_Spec));
while Present (Formal_Spec) loop
Set_Defining_Identifier
(Formal_Spec,
Make_Defining_Identifier (Sloc (Formal_Spec),
Chars => Chars (Defining_Identifier (Formal_Spec))));
Next (Formal_Spec);
end loop;
end;
end if;
Prev := Current_Entity_In_Scope (Defining_Entity (Spec));
-- If there are previous overloadable entities with the same name,
......
gcc/ada/sem_util.adb
......@@ -7134,14 +7134,23 @@ package body Sem_Util is
function Is_Fully_Initialized_Type (Typ : Entity_Id) return Boolean is
begin
-- In Ada2012, a scalar type with an aspect Default_Value
-- is fully initialized.
if Is_Scalar_Type (Typ) then
return False;
return
Ada_Version >= Ada_2012
and then Has_Default_Aspect (Typ);
elsif Is_Access_Type (Typ) then
return True;
elsif Is_Array_Type (Typ) then
if Is_Fully_Initialized_Type (Component_Type (Typ)) then
if Is_Fully_Initialized_Type (Component_Type (Typ))
or else
(Ada_Version >= Ada_2012
and then Has_Default_Aspect (Typ))
then
return True;
end if;
......
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