2009-06-19 Robert Dewar <dewar@adacore.com>

	* sem_type.ads, sem_ch12.adb: Minor reformatting

	* s-wchcnv.adb (UTF_32_To_Char_Sequence): Handle invalid data properly

2009-06-19  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch9.adb (Build_Wrapper_Spec): Handle properly an overridden
	primitive operation of a rivate extension whose controlling argument
	is an out parameter.

	* sem.adb (Walk_Library_Units): exclude generic package declarations
	from check.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@148696 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 75 insertions, 57 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index af67e51be2a..64768dd9e35 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2009-06-19  Robert Dewar  <dewar@adacore.com>
+
+	* sem_type.ads, sem_ch12.adb: Minor reformatting
+
+	* s-wchcnv.adb (UTF_32_To_Char_Sequence): Handle invalid data properly
+
+2009-06-19  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch9.adb (Build_Wrapper_Spec): Handle properly an overridden
+	primitive operation of a rivate extension whose controlling argument
+	is an out parameter.
+
+	* sem.adb (Walk_Library_Units): exclude generic package declarations
+	from check.
+
 2009-06-19  Thomas Quinot  <quinot@adacore.com>
 
 	* i-vxwoio.ads: Add comments
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index ddaa632f0ba..aa69402723a 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -2073,14 +2073,15 @@ package body Exp_Ch9 is
                 Parameter_Type      => Obj_Param_Typ);
 
          --  If we are dealing with a primitive declared between two views,
-         --  create a default parameter.
+         --  create a default parameter. The mode of the parameter must
+         --  match that of the primitive operation.
 
          else pragma Assert (Is_Private_Primitive_Subprogram (Subp_Id));
             Obj_Param :=
               Make_Parameter_Specification (Loc,
                 Defining_Identifier =>
                   Make_Defining_Identifier (Loc, Name_uO),
-                In_Present => True,
+                In_Present  => In_Present (Parent (First_Entity (Subp_Id))),
                 Out_Present => Ekind (Subp_Id) /= E_Function,
                   Parameter_Type => New_Reference_To (Obj_Typ, Loc));
          end if;
diff --git a/gcc/ada/s-wchcnv.adb b/gcc/ada/s-wchcnv.adb
index bb806f08aa5..893232e605a 100644
--- a/gcc/ada/s-wchcnv.adb
+++ b/gcc/ada/s-wchcnv.adb
@@ -284,6 +284,14 @@ package body System.WCh_Cnv is
       U      : Unsigned_32;
 
    begin
+      --  Raise CE for invalid UTF_32_Code
+
+      if not Val'Valid then
+         raise Constraint_Error;
+      end if;
+
+      --  Processing depends on encoding mode
+
       case EM is
 
          when WCEM_Hex =>
@@ -425,10 +433,6 @@ package body System.WCh_Cnv is
 
                if Val > 16#FFFF# then
                   if Val > 16#00FF_FFFF# then
-                     if Val > 16#7FFF_FFFF# then
-                        raise Constraint_Error;
-                     end if;
-
                      Out_Char (Hexc (Val / 16 ** 7));
                      Out_Char (Hexc ((Val / 16 ** 6) mod 16));
                   end if;
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 94cfbdc00ad..58521e9c727 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -1600,13 +1600,13 @@ package body Sem is
                begin
                   if not Done (Get_Cunit_Unit_Number (Withed_Unit)) then
                      if not Nkind_In
-                              (Unit (Withed_Unit), N_Package_Body,
-                                                   N_Subprogram_Body)
+                              (Unit (Withed_Unit),
+                                 N_Generic_Package_Declaration,
+                                 N_Package_Body,
+                                 N_Subprogram_Body)
                      then
                         Write_Unit_Name
-                          (Unit_Name
-                            (Get_Cunit_Unit_Number
-                             (Withed_Unit)));
+                          (Unit_Name (Get_Cunit_Unit_Number (Withed_Unit)));
                         Write_Str (" not yet walked!");
 
                         if Get_Cunit_Unit_Number (Withed_Unit) = Unit_Num then
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index b84cf1ea8d1..a07832cbd15 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -4360,7 +4360,7 @@ package body Sem_Ch12 is
       Old_Main   : constant Entity_Id := Cunit_Entity (Main_Unit);
 
    begin
-      --  A new compilation unit node is built for the instance declaration.
+      --  A new compilation unit node is built for the instance declaration
 
       Decl_Cunit :=
         Make_Compilation_Unit (Sloc (N),
diff --git a/gcc/ada/sem_type.ads b/gcc/ada/sem_type.ads
index a4986fc6192..879432435fd 100644
--- a/gcc/ada/sem_type.ads
+++ b/gcc/ada/sem_type.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, 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- --
@@ -55,12 +55,12 @@ package Sem_Type is
    --  Corresponding to the set of interpretations for a given overloadable
    --  identifier, there is a set of possible types corresponding to the types
    --  that the overloaded call may return. We keep a 1-to-1 correspondence
-   --  between interpretations and types: for user-defined subprograms the
-   --  type is the declared return type. For operators, the type is determined
-   --  by the type of the arguments. If the arguments themselves are
-   --  overloaded, we enter the operator name in the names table for each
-   --  possible result type. In most cases, arguments are not overloaded and
-   --  only one interpretation is present anyway.
+   --  between interpretations and types: for user-defined subprograms the type
+   --  is the declared return type. For operators, the type is determined by
+   --  the type of the arguments. If the arguments themselves are overloaded,
+   --  we enter the operator name in the names table for each possible result
+   --  type. In most cases, arguments are not overloaded and only one
+   --  interpretation is present anyway.
 
    type Interp is record
       Nam         : Entity_Id;
@@ -97,23 +97,22 @@ package Sem_Type is
    --  Invoked by gnatf when processing multiple files
 
    procedure Collect_Interps (N : Node_Id);
-   --  Invoked when the name N has more than one visible interpretation.
-   --  This is the high level routine which accumulates the possible
-   --  interpretations of the node. The first meaning and type of N have
-   --  already been stored in N. If the name is an expanded name, the homonyms
-   --  are only those that belong to the same scope.
+   --  Invoked when the name N has more than one visible interpretation. This
+   --  is the high level routine which accumulates the possible interpretations
+   --  of the node. The first meaning and type of N have already been stored
+   --  in N. If the name is an expanded name, the homonyms are only those that
+   --  belong to the same scope.
 
    function Is_Invisible_Operator
      (N    : Node_Id;
       T    : Entity_Id)
       return Boolean;
-   --  Check whether a predefined operation with universal operands appears
-   --  in a context in which the operators of the expected type are not
-   --  visible.
+   --  Check whether a predefined operation with universal operands appears in
+   --  a context in which the operators of the expected type are not visible.
 
    procedure List_Interps (Nam : Node_Id; Err : Node_Id);
-   --  List candidate interpretations of an overloaded name. Used for
-   --  various error reports.
+   --  List candidate interpretations of an overloaded name. Used for various
+   --  error reports.
 
    procedure Add_One_Interp
      (N         : Node_Id;
@@ -121,13 +120,13 @@ package Sem_Type is
       T         : Entity_Id;
       Opnd_Type : Entity_Id := Empty);
    --  Add (E, T) to the list of interpretations of the node being resolved.
-   --  For calls and operators, i.e. for nodes that have a name field,
-   --  E is an overloadable entity, and T is its type. For constructs such
-   --  as indexed expressions, the caller sets E equal to T, because the
-   --  overloading comes from other fields, and the node itself has no name
-   --  to resolve. Hidden denotes whether an interpretation has been disabled
-   --  by an abstract operator. Add_One_Interp includes semantic processing to
-   --  deal with adding entries that hide one another etc.
+   --  For calls and operators, i.e. for nodes that have a name field, E is an
+   --  overloadable entity, and T is its type. For constructs such as indexed
+   --  expressions, the caller sets E equal to T, because the overloading comes
+   --  from other fields, and the node itself has no name to resolve. Hidden
+   --  denotes whether an interpretation has been disabled by an abstract
+   --  operator. Add_One_Interp includes semantic processing to deal with
+   --  adding entries that hide one another etc.
 
    --  For operators, the legality of the operation depends on the visibility
    --  of T and its scope. If the operator is an equality or comparison, T is
@@ -166,10 +165,9 @@ package Sem_Type is
    --  New_N, its new copy. It has no effect in the non-overloaded case.
 
    function Covers (T1, T2 : Entity_Id) return Boolean;
-   --  This is the basic type compatibility routine. T1 is the expected
-   --  type, imposed by context, and T2 is the actual type. The processing
-   --  reflects both the definition of type coverage and the rules
-   --  for operand matching.
+   --  This is the basic type compatibility routine. T1 is the expected type,
+   --  imposed by context, and T2 is the actual type. The processing reflects
+   --  both the definition of type coverage and the rules for operand matching.
 
    function Disambiguate
      (N      : Node_Id;
@@ -188,24 +186,24 @@ package Sem_Type is
    --  opposed to an operator, type and mode conformance are required.
 
    function Find_Unique_Type (L : Node_Id; R : Node_Id) return Entity_Id;
-   --  Used in second pass of resolution,  for equality and comparison nodes.
-   --  L is the left operand, whose type is known to be correct, and R is
-   --  the right operand,  which has one interpretation compatible with that
-   --  of L. Return the type intersection of the two.
+   --  Used in second pass of resolution, for equality and comparison nodes. L
+   --  is the left operand, whose type is known to be correct, and R is the
+   --  right operand, which has one interpretation compatible with that of L.
+   --  Return the type intersection of the two.
 
    function Has_Compatible_Type
      (N    : Node_Id;
       Typ  : Entity_Id)
       return Boolean;
-   --  Verify that some interpretation of the node N has a type compatible
-   --  with Typ. If N is not overloaded, then its unique type must be
-   --  compatible with Typ. Otherwise iterate through the interpretations
-   --  of N looking for a compatible one.
+   --  Verify that some interpretation of the node N has a type compatible with
+   --  Typ. If N is not overloaded, then its unique type must be compatible
+   --  with Typ. Otherwise iterate through the interpretations of N looking for
+   --  a compatible one.
 
    function Hides_Op (F : Entity_Id; Op : Entity_Id) return Boolean;
-   --  A user-defined function hides a predefined operator if it is
-   --  matches the signature of the operator, and is declared in an
-   --  open scope, or in the scope of the result type.
+   --  A user-defined function hides a predefined operator if it is matches the
+   --  signature of the operator, and is declared in an open scope, or in the
+   --  scope of the result type.
 
    function Interface_Present_In_Ancestor
      (Typ   : Entity_Id;
@@ -241,15 +239,15 @@ package Sem_Type is
    --  real type, or a one dimensional array with a discrete component type.
 
    function Valid_Boolean_Arg (T : Entity_Id) return Boolean;
-   --  A valid argument of a boolean operator is either some boolean type,
-   --  or a one-dimensional array of boolean type.
+   --  A valid argument of a boolean operator is either some boolean type, or a
+   --  one-dimensional array of boolean type.
 
    procedure Write_Interp_Ref (Map_Ptr : Int);
-   --  Debugging procedure to display entry in Interp_Map. Would not be
-   --  needed if it were possible to debug instantiations of Table.
+   --  Debugging procedure to display entry in Interp_Map. Would not be needed
+   --  if it were possible to debug instantiations of Table.
 
    procedure Write_Overloads (N : Node_Id);
-   --  Debugging procedure to output info on possibly overloaded entities
-   --  for specified node.
+   --  Debugging procedure to output info on possibly overloaded entities for
+   --  specified node.
 
 end Sem_Type;