From b727a82b8cd5ef7b0852360f67d122e6cc5da9a4 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 30 Jan 2012 13:16:12 +0100 Subject: [PATCH] [multiple changes] 2012-01-30 Robert Dewar * 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 * 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 * a-convec.adb, a-coinve.adb, a-cobove.adb (Sort, Reverse_Elements): Check for cursor tampering. 2012-01-30 Ed Schonberg * 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 * projects.texi: Add documentation for attribute Interfaces. From-SVN: r183714 --- gcc/ada/ChangeLog | 39 +++++++++++++++++++++++++++++++++++++++ gcc/ada/a-cobove.adb | 37 ++++++++++++++++++++++++++++++------- gcc/ada/a-coinve.adb | 33 +++++++++++++++++++++++++++------ gcc/ada/a-convec.adb | 37 ++++++++++++++++++++++++++++++------- gcc/ada/projects.texi | 16 +++++++++++++--- gcc/ada/sem.adb | 4 ++-- gcc/ada/sem_ch3.adb | 15 +++++++++++++++ gcc/ada/sem_ch4.adb | 31 ++++++++++++++++++++++++++++++- gcc/ada/sem_ch4.ads | 3 ++- gcc/ada/sem_ch6.adb | 26 +++++++++++++++++++++++++- gcc/ada/sem_util.adb | 13 +++++++++++-- 11 files changed, 224 insertions(+), 30 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 916f5a2d9dd..d2385a8b3a5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,42 @@ +2012-01-30 Robert Dewar + + * 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 + + * 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 + + * a-convec.adb, a-coinve.adb, a-cobove.adb (Sort, + Reverse_Elements): Check for cursor tampering. + +2012-01-30 Ed Schonberg + + * 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 + +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 + + * projects.texi: Add documentation for attribute Interfaces. + 2012-01-30 Hristian Kirtchev * exp_ch7.adb (Build_Finalizer_Call): Set loc again. diff --git a/gcc/ada/a-cobove.adb b/gcc/ada/a-cobove.adb index 99659abc795..aaf69c31213 100644 --- a/gcc/ada/a-cobove.adb +++ b/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; diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb index 92c08749d9a..ef5389f95a3 100644 --- a/gcc/ada/a-coinve.adb +++ b/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 diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb index 2e3523514e4..837c7832f53 100644 --- a/gcc/ada/a-convec.adb +++ b/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 diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index 78bcf3aad05..8f9faad645f 100644 --- a/gcc/ada/projects.texi +++ b/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 diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index fc8f74cf811..fdd6ec3b6ed 100644 --- a/gcc/ada/sem.adb +++ b/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); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 3afea799d85..d56c59fd64a 100644 --- a/gcc/ada/sem_ch3.adb +++ b/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); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 5ade3a88166..32300126b48 100644 --- a/gcc/ada/sem_ch4.adb +++ b/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 -- ---------------------- diff --git a/gcc/ada/sem_ch4.ads b/gcc/ada/sem_ch4.ads index 96550f26c4b..5e3150b6990 100644 --- a/gcc/ada/sem_ch4.ads +++ b/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); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index cd65caa4253..eec427a0ddf 100644 --- a/gcc/ada/sem_ch6.adb +++ b/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, diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 37ab9508850..3da93ea2931 100644 --- a/gcc/ada/sem_util.adb +++ b/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;