+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.
-- --
-- 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- --
-- 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,
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));
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;
-- --
-- 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- --
----------
procedure Sort (Container : in out Vector) is
-
procedure Sort is new Generic_Array_Sort
(Index_Type => Index_Type,
Element_Type => Element_Access,
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));
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
-- --
-- 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- --
-- 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,
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));
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
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}:
@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
-- --
-- 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- --
Analyze_Unary_Op (N);
when N_Op_Mod =>
- Analyze_Arithmetic_Op (N);
+ Analyze_Mod (N);
when N_Op_Multiply =>
Analyze_Arithmetic_Op (N);
-- 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);
-- --
-- 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- --
with Sinfo; use Sinfo;
with Snames; use Snames;
with Tbuild; use Tbuild;
+with Uintp; use Uintp;
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 --
----------------------
-- --
-- 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- --
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);
-- 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,
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;
projects / gcc.git / commitdiff