[multiple changes]

2010-06-22  Robert Dewar  <dewar@adacore.com>

	* lib-writ.ads, errout.adb, einfo.adb, einfo.ads: Minor reformatting.

2010-06-22  Vincent Celier  <celier@adacore.com>

	* adaint.c (__gnat_locate_regular_file): If a directory in the path is
	empty, make it the current working directory.

2010-06-22  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb (Build_Derived_Record_Type): When deriving a tagged
	private type with discriminants, make sure the parent type is frozen.

2010-06-22  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference) <Attribute_Bit>: Deal
	with packed array references specially.
	* exp_ch4.adb (Expand_N_Indexed_Component): Do not convert a reference
	to a component of a bit packed array if it is the prefix of 'Bit.
	* exp_pakd.ads (Expand_Packed_Bit_Reference): Declare.
	* exp_pakd.adb (Expand_Packed_Bit_Reference): New procedure.  Expand a
	'Bit reference, where the prefix involves a packed array reference.
	(Get_Base_And_Bit_Offset): New helper, extracted from...
	(Expand_Packed_Address_Reference): ...here.  Call above procedure to
	get the outer object and offset expression.

From-SVN: r161160

11 files changed, 290 insertions, 189 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2791cc5..2b2728c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,30 @@
+2010-06-22  Robert Dewar  <dewar@adacore.com>
+
+	* lib-writ.ads, errout.adb, einfo.adb, einfo.ads: Minor reformatting.
+
+2010-06-22  Vincent Celier  <celier@adacore.com>
+
+	* adaint.c (__gnat_locate_regular_file): If a directory in the path is
+	empty, make it the current working directory.
+
+2010-06-22  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch3.adb (Build_Derived_Record_Type): When deriving a tagged
+	private type with discriminants, make sure the parent type is frozen.
+
+2010-06-22  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_attr.adb (Expand_N_Attribute_Reference) <Attribute_Bit>: Deal
+	with packed array references specially.
+	* exp_ch4.adb (Expand_N_Indexed_Component): Do not convert a reference
+	to a component of a bit packed array if it is the prefix of 'Bit.
+	* exp_pakd.ads (Expand_Packed_Bit_Reference): Declare.
+	* exp_pakd.adb (Expand_Packed_Bit_Reference): New procedure.  Expand a
+	'Bit reference, where the prefix involves a packed array reference.
+	(Get_Base_And_Bit_Offset): New helper, extracted from...
+	(Expand_Packed_Address_Reference): ...here.  Call above procedure to
+	get the outer object and offset expression.
+
 2010-06-22  Thomas Quinot  <quinot@adacore.com>
 
 	* exp_attr.adb, lib-writ.ads, bindgen.adb: Minor reformatting.
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 5ceedd0..9379950 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -2788,12 +2788,6 @@ __gnat_locate_regular_file (char *file_name, char *path_val)
 
     for (;;)
       {
-        for (; *path_val == PATH_SEPARATOR; path_val++)
-          ;
-
-      if (*path_val == 0)
-        return 0;
-
       /* Skip the starting quote */
 
       if (*path_val == '"')
@@ -2802,7 +2796,14 @@ __gnat_locate_regular_file (char *file_name, char *path_val)
       for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
 	*ptr++ = *path_val++;
 
-      ptr--;
+      /* If directory is empty, it is the current directory*/
+
+      if (ptr == file_path)
+        {
+         *ptr = '.';
+        }
+      else
+        ptr--;
 
       /* Skip the ending quote */
 
@@ -2816,6 +2817,13 @@ __gnat_locate_regular_file (char *file_name, char *path_val)
 
       if (__gnat_is_regular_file (file_path))
         return xstrdup (file_path);
+
+      if (*path_val == 0)
+        return 0;
+
+      /* Skip path separator */
+
+      path_val++;
       }
   }
 
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index fd2eee3..07144c3 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -5755,9 +5755,7 @@ package body Einfo is
 
    function Get_Full_View (T : Entity_Id) return Entity_Id is
    begin
-      if Ekind (T) = E_Incomplete_Type
-        and then Present (Full_View (T))
-      then
+      if Ekind (T) = E_Incomplete_Type and then Present (Full_View (T)) then
          return Full_View (T);
 
       elsif Is_Class_Wide_Type (T)
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 3eb3528..d5f43ae 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -6821,9 +6821,9 @@ package Einfo is
    --  Add an entity to the list of entities declared in the scope V
 
    function Get_Full_View (T : Entity_Id) return Entity_Id;
-   --  If T is an incomplete type and the full declaration has been
-   --  seen, or is the name of a class_wide type whose root is incomplete.
-   --  return the corresponding full declaration.
+   --  If T is an incomplete type and the full declaration has been seen, or
+   --  is the name of a class_wide type whose root is incomplete, return the
+   --  corresponding full declaration, else return T itself.
 
    function Is_Entity_Name (N : Node_Id) return Boolean;
    --  Test if the node N is the name of an entity (i.e. is an identifier,
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 651b43d..d71ebad 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -176,25 +176,24 @@ package body Errout is
    --  If the message should be generated (the normal case) False is returned.
 
    procedure Unwind_Internal_Type (Ent : in out Entity_Id);
-   --  This procedure is given an entity id for an internal type, i.e.
-   --  a type with an internal name. It unwinds the type to try to get
-   --  to something reasonably printable, generating prefixes like
-   --  "subtype of", "access to", etc along the way in the buffer. The
-   --  value in Ent on return is the final name to be printed. Hopefully
-   --  this is not an internal name, but in some internal name cases, it
-   --  is an internal name, and has to be printed anyway (although in this
-   --  case the message has been killed if possible). The global variable
-   --  Class_Flag is set to True if the resulting entity should have
-   --  'Class appended to its name (see Add_Class procedure), and is
-   --  otherwise unchanged.
+   --  This procedure is given an entity id for an internal type, i.e. a type
+   --  with an internal name. It unwinds the type to try to get to something
+   --  reasonably printable, generating prefixes like "subtype of", "access
+   --  to", etc along the way in the buffer. The value in Ent on return is the
+   --  final name to be printed. Hopefully this is not an internal name, but in
+   --  some internal name cases, it is an internal name, and has to be printed
+   --  anyway (although in this case the message has been killed if possible).
+   --  The global variable Class_Flag is set to True if the resulting entity
+   --  should have 'Class appended to its name (see Add_Class procedure), and
+   --  is otherwise unchanged.
 
    procedure VMS_Convert;
-   --  This procedure has no effect if called when the host is not OpenVMS.
-   --  If the host is indeed OpenVMS, then the error message stored in
-   --  Msg_Buffer is scanned for appearances of switch names which need
-   --  converting to corresponding VMS qualifier names. See Gnames/Vnames
-   --  table in Errout spec for precise definition of the conversion that
-   --  is performed by this routine in OpenVMS mode.
+   --  This procedure has no effect if called when the host is not OpenVMS. If
+   --  the host is indeed OpenVMS, then the error message stored in Msg_Buffer
+   --  is scanned for appearances of switch names which need converting to
+   --  corresponding VMS qualifier names. See Gnames/Vnames table in Errout
+   --  spec for precise definition of the conversion that is performed by this
+   --  routine in OpenVMS mode.
 
    -----------------------
    -- Change_Error_Text --
@@ -242,10 +241,10 @@ package body Errout is
    ---------------
 
    --  Error_Msg posts a flag at the given location, except that if the
-   --  Flag_Location points within a generic template and corresponds
-   --  to an instantiation of this generic template, then the actual
-   --  message will be posted on the generic instantiation, along with
-   --  additional messages referencing the generic declaration.
+   --  Flag_Location points within a generic template and corresponds to an
+   --  instantiation of this generic template, then the actual message will be
+   --  posted on the generic instantiation, along with additional messages
+   --  referencing the generic declaration.
 
    procedure Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
       Sindex : Source_File_Index;
@@ -256,8 +255,8 @@ package body Errout is
       --  template in instantiation case, otherwise unchanged).
 
    begin
-      --  It is a fatal error to issue an error message when scanning from
-      --  the internal source buffer (see Sinput for further documentation)
+      --  It is a fatal error to issue an error message when scanning from the
+      --  internal source buffer (see Sinput for further documentation)
 
       pragma Assert (Sinput.Source /= Internal_Source_Ptr);
 
@@ -267,8 +266,8 @@ package body Errout is
          return;
       end if;
 
-      --  If we already have messages, and we are trying to place a message
-      --  at No_Location or in package Standard, then just ignore the attempt
+      --  If we already have messages, and we are trying to place a message at
+      --  No_Location or in package Standard, then just ignore the attempt
       --  since we assume that what is happening is some cascaded junk. Note
       --  that this is safe in the sense that proceeding will surely bomb.
 
@@ -284,24 +283,23 @@ package body Errout is
       Test_Style_Warning_Serious_Msg (Msg);
       Orig_Loc := Original_Location (Flag_Location);
 
-      --  If the current location is in an instantiation, the issue arises
-      --  of whether to post the message on the template or the instantiation.
+      --  If the current location is in an instantiation, the issue arises of
+      --  whether to post the message on the template or the instantiation.
 
-      --  The way we decide is to see if we have posted the same message
-      --  on the template when we compiled the template (the template is
-      --  always compiled before any instantiations). For this purpose,
-      --  we use a separate table of messages. The reason we do this is
-      --  twofold:
+      --  The way we decide is to see if we have posted the same message on
+      --  the template when we compiled the template (the template is always
+      --  compiled before any instantiations). For this purpose, we use a
+      --  separate table of messages. The reason we do this is twofold:
 
       --     First, the messages can get changed by various processing
       --     including the insertion of tokens etc, making it hard to
       --     do the comparison.
 
-      --     Second, we will suppress a warning on a template if it is
-      --     not in the current extended source unit. That's reasonable
-      --     and means we don't want the warning on the instantiation
-      --     here either, but it does mean that the main error table
-      --     would not in any case include the message.
+      --     Second, we will suppress a warning on a template if it is not in
+      --     the current extended source unit. That's reasonable and means we
+      --     don't want the warning on the instantiation here either, but it
+      --     does mean that the main error table would not in any case include
+      --     the message.
 
       if Flag_Location = Orig_Loc then
          Non_Instance_Msgs.Append ((new String'(Msg), Flag_Location));
@@ -310,8 +308,8 @@ package body Errout is
       --  Here we have an instance message
 
       else
-         --  Delete if debug flag off, and this message duplicates a
-         --  message already posted on the corresponding template
+         --  Delete if debug flag off, and this message duplicates a message
+         --  already posted on the corresponding template
 
          if not Debug_Flag_GG then
             for J in Non_Instance_Msgs.First .. Non_Instance_Msgs.Last loop
@@ -373,9 +371,9 @@ package body Errout is
       --  instantiation error message can be repeated, pointing to each
       --  of the relevant instantiations.
 
-      --  Note: the instantiation mechanism is also shared for inlining
-      --  of subprogram bodies when front end inlining is done. In this
-      --  case the messages have the form:
+      --  Note: the instantiation mechanism is also shared for inlining of
+      --  subprogram bodies when front end inlining is done. In this case the
+      --  messages have the form:
 
       --     in inlined body at ...
       --     original error message
@@ -385,9 +383,8 @@ package body Errout is
       --     warning: in inlined body at
       --     warning: original warning message
 
-      --  OK, this is the case where we have an instantiation error, and
-      --  we need to generate the error on the instantiation, rather than
-      --  on the template.
+      --  OK, here we have an instantiation error, and we need to generate the
+      --  error on the instantiation, rather than on the template.
 
       declare
          Actual_Error_Loc : Source_Ptr;
@@ -396,9 +393,9 @@ package body Errout is
          --  location where all error messages will actually be posted.
 
          Save_Error_Msg_Sloc : constant Source_Ptr := Error_Msg_Sloc;
-         --  Save possible location set for caller's message. We need to
-         --  use Error_Msg_Sloc for the location of the instantiation error
-         --  but we have to preserve a possible original value.
+         --  Save possible location set for caller's message. We need to use
+         --  Error_Msg_Sloc for the location of the instantiation error but we
+         --  have to preserve a possible original value.
 
          X : Source_File_Index;
 
@@ -417,10 +414,9 @@ package body Errout is
             exit when Instantiation (X) = No_Location;
          end loop;
 
-         --  Since we are generating the messages at the instantiation
-         --  point in any case, we do not want the references to the
-         --  bad lines in the instance to be annotated with the location
-         --  of the instantiation.
+         --  Since we are generating the messages at the instantiation point in
+         --  any case, we do not want the references to the bad lines in the
+         --  instance to be annotated with the location of the instantiation.
 
          Suppress_Instance_Location := True;
          Msg_Cont_Status := False;
@@ -679,10 +675,10 @@ package body Errout is
             Expander_Active := False;
          end if;
 
-         --  Set the fatal error flag in the unit table unless we are
-         --  in Try_Semantics mode. This stops the semantics from being
-         --  performed if we find a serious error. This is skipped if we
-         --  are currently dealing with the configuration pragma file.
+         --  Set the fatal error flag in the unit table unless we are in
+         --  Try_Semantics mode. This stops the semantics from being performed
+         --  if we find a serious error. This is skipped if we are currently
+         --  dealing with the configuration pragma file.
 
          if not Try_Semantics and then Current_Source_Unit /= No_Unit then
             Set_Fatal_Error (Get_Source_Unit (Sptr));
@@ -722,10 +718,10 @@ package body Errout is
          return;
       end if;
 
-      --  Return without doing anything if message is killed and this
-      --  is not the first error message. The philosophy is that if we
-      --  get a weird error message and we already have had a message,
-      --  then we hope the weird message is a junk cascaded message
+      --  Return without doing anything if message is killed and this is not
+      --  the first error message. The philosophy is that if we get a weird
+      --  error message and we already have had a message, then we hope the
+      --  weird message is a junk cascaded message
 
       if Kill_Message
         and then not All_Errors_Mode
@@ -749,15 +745,15 @@ package body Errout is
             return;
          end if;
 
-         --  If the flag location is in the main extended source unit
-         --  then for sure we want the warning since it definitely belongs
+         --  If the flag location is in the main extended source unit then for
+         --  sure we want the warning since it definitely belongs
 
          if In_Extended_Main_Source_Unit (Sptr) then
             null;
 
-         --  If the flag location is not in the main extended source unit,
-         --  then we want to eliminate the warning, unless it is in the
-         --  extended main code unit and we want warnings on the instance.
+         --  If the flag location is not in the main extended source unit, then
+         --  we want to eliminate the warning, unless it is in the extended
+         --  main code unit and we want warnings on the instance.
 
          elsif In_Extended_Main_Code_Unit (Sptr) and then Warn_On_Instance then
             null;
@@ -1325,13 +1321,12 @@ package body Errout is
       S := Sloc (F);
 
       --  The following circuit is a bit subtle. When we have parenthesized
-      --  expressions, then the Sloc will not record the location of the
-      --  paren, but we would like to post the flag on the paren. So what
-      --  we do is to crawl up the tree from the First_Node, adjusting the
-      --  Sloc value for any parentheses we know are present. Yes, we know
-      --  this circuit is not 100% reliable (e.g. because we don't record
-      --  all possible paren level values), but this is only for an error
-      --  message so it is good enough.
+      --  expressions, then the Sloc will not record the location of the paren,
+      --  but we would like to post the flag on the paren. So what we do is to
+      --  crawl up the tree from the First_Node, adjusting the Sloc value for
+      --  any parentheses we know are present. Yes, we know this circuit is not
+      --  100% reliable (e.g. because we don't record all possible paren level
+      --  values), but this is only for an error message so it is good enough.
 
       Node_Loop : loop
          Paren_Loop : for J in 1 .. Paren_Count (F) loop
@@ -1378,8 +1373,8 @@ package body Errout is
       Cur_Msg := No_Error_Msg;
       List_Pragmas.Init;
 
-      --  Initialize warnings table, if all warnings are suppressed, supply
-      --  an initial dummy entry covering all possible source locations.
+      --  Initialize warnings table, if all warnings are suppressed, supply an
+      --  initial dummy entry covering all possible source locations.
 
       Warnings.Init;
       Specific_Warnings.Init;
@@ -2100,12 +2095,12 @@ package body Errout is
          Flen := Flen + 1;
       end loop;
 
-      --  Loop through file names to find matching one. This is a bit slow,
-      --  but we only do it in error situations so it is not so terrible.
-      --  Note that if the loop does not exit, then the desired case will
-      --  be left set to Mixed_Case, this can happen if the name was not
-      --  in canonical form, and gets canonicalized on VMS. Possibly we
-      --  could fix this by unconditinally canonicalizing these names ???
+      --  Loop through file names to find matching one. This is a bit slow, but
+      --  we only do it in error situations so it is not so terrible. Note that
+      --  if the loop does not exit, then the desired case will be left set to
+      --  Mixed_Case, this can happen if the name was not in canonical form,
+      --  and gets canonicalized on VMS. Possibly we could fix this by
+      --  unconditinally canonicalizing these names ???
 
       for J in 1 .. Last_Source_File loop
          Get_Name_String (Full_Debug_Name (J));
@@ -2185,9 +2180,9 @@ package body Errout is
          K := Nkind (Error_Msg_Node_1);
 
          --  If we have operator case, skip quotes since name of operator
-         --  itself will supply the required quotations. An operator can be
-         --  an applied use in an expression or an explicit operator symbol,
-         --  or an identifier whose name indicates it is an operator.
+         --  itself will supply the required quotations. An operator can be an
+         --  applied use in an expression or an explicit operator symbol, or an
+         --  identifier whose name indicates it is an operator.
 
          if K in N_Op
            or else K = N_Operator_Symbol
@@ -2333,8 +2328,8 @@ package body Errout is
          Set_Msg_Node (Ent);
          Add_Class;
 
-         --  If Ent is an anonymous subprogram type, there is no name
-         --  to print, so remove enclosing quotes.
+         --  If Ent is an anonymous subprogram type, there is no name to print,
+         --  so remove enclosing quotes.
 
          if Buffer_Ends_With ("""") then
             Buffer_Remove ("""");
@@ -2343,8 +2338,8 @@ package body Errout is
          end if;
       end if;
 
-      --  If the original type did not come from a predefined
-      --  file, add the location where the type was defined.
+      --  If the original type did not come from a predefined file, add the
+      --  location where the type was defined.
 
       if Sloc (Error_Msg_Node_1) > Standard_Location
         and then
@@ -2521,9 +2516,9 @@ package body Errout is
             Set_Casing (Mixed_Case);
 
          else
-            --  Determine if the reference we are dealing with corresponds
-            --  to text at the point of the error reference. This will often
-            --  be the case for simple identifier references, and is the case
+            --  Determine if the reference we are dealing with corresponds to
+            --  text at the point of the error reference. This will often be
+            --  the case for simple identifier references, and is the case
             --  where we can copy the spelling from the source.
 
             Sbuffer := Source_Text (Get_Source_File_Index (Src_Loc));
@@ -2536,8 +2531,8 @@ package body Errout is
                Src_Ptr := Src_Ptr + 1;
             end loop;
 
-            --  If we get through the loop without a mismatch, then output
-            --  the name the way it is spelled in the source program
+            --  If we get through the loop without a mismatch, then output the
+            --  name the way it is spelled in the source program
 
             if Ref_Ptr > Name_Len then
                Src_Ptr := Src_Loc;
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index a88cf85..445baa0 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -1206,6 +1206,20 @@ package body Exp_Attr is
          Analyze_And_Resolve (N, RTE (RE_AST_Handler));
       end AST_Entry;
 
+      ---------
+      -- Bit --
+      ---------
+
+      --  We compute this if a packed array reference was present, otherwise we
+      --  leave the computation up to the back end.
+
+      when Attribute_Bit =>
+         if Involves_Packed_Array_Reference (Pref) then
+            Expand_Packed_Bit_Reference (N);
+         else
+            Apply_Universal_Integer_Attribute_Checks (N);
+         end if;
+
       ------------------
       -- Bit_Position --
       ------------------
@@ -1218,8 +1232,7 @@ package body Exp_Attr is
       --  in generated code (i.e. the prefix is an identifier that
       --  references the component or discriminant entity).
 
-      when Attribute_Bit_Position => Bit_Position :
-      declare
+      when Attribute_Bit_Position => Bit_Position : declare
          CE : Entity_Id;
 
       begin
@@ -3232,9 +3245,9 @@ package body Exp_Attr is
       --  For enumeration types with a standard representation, Pos is
       --  handled by the back end.
 
-      --  For enumeration types, with a non-standard representation we
-      --  generate a call to the _Rep_To_Pos function created when the
-      --  type was frozen. The call has the form
+      --  For enumeration types, with a non-standard representation we generate
+      --  a call to the _Rep_To_Pos function created when the type was frozen.
+      --  The call has the form
 
       --    _rep_to_pos (expr, flag)
 
@@ -3541,6 +3554,7 @@ package body Exp_Attr is
       ------------------
 
       when Attribute_Range_Length => Range_Length : begin
+
          --  The only special processing required is for the case where
          --  Range_Length is applied to an enumeration type with holes.
          --  In this case we transform
@@ -4257,8 +4271,7 @@ package body Exp_Attr is
       --  2. For floating-point, generate call to attribute function
       --  3. For other cases, deal with constraint checking
 
-      when Attribute_Succ => Succ :
-      declare
+      when Attribute_Succ => Succ : declare
          Etyp : constant Entity_Id := Base_Type (Ptyp);
 
       begin
@@ -4350,8 +4363,7 @@ package body Exp_Attr is
 
       --  Transforms X'Tag into a direct reference to the tag of X
 
-      when Attribute_Tag => Tag :
-      declare
+      when Attribute_Tag => Tag : declare
          Ttyp           : Entity_Id;
          Prefix_Is_Type : Boolean;
 
@@ -4598,8 +4610,7 @@ package body Exp_Attr is
       --  with a non-standard representation we use the _Pos_To_Rep array that
       --  was created when the type was frozen.
 
-      when Attribute_Val => Val :
-      declare
+      when Attribute_Val => Val : declare
          Etyp : constant Entity_Id := Base_Type (Entity (Pref));
 
       begin
@@ -4662,8 +4673,7 @@ package body Exp_Attr is
       --  The code for valid is dependent on the particular types involved.
       --  See separate sections below for the generated code in each case.
 
-      when Attribute_Valid => Valid :
-      declare
+      when Attribute_Valid => Valid : declare
          Btyp : Entity_Id := Base_Type (Ptyp);
          Tst  : Node_Id;
 
@@ -5267,7 +5277,6 @@ package body Exp_Attr is
       --  that the result is in range.
 
       when Attribute_Aft                          |
-           Attribute_Bit                          |
            Attribute_Max_Size_In_Storage_Elements
       =>
          Apply_Universal_Integer_Attribute_Checks (N);
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index a74ba46..02a5ad4 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4883,7 +4883,7 @@ package body Exp_Ch4 is
 
       --    The second expression in a 'Read attribute reference
 
-      --    The prefix of an address or size attribute reference
+      --    The prefix of an address or bit or size attribute reference
 
       --  The following circuit detects these exceptions
 
@@ -4907,6 +4907,8 @@ package body Exp_Ch4 is
             elsif Nkind (Parnt) = N_Attribute_Reference
               and then (Attribute_Name (Parnt) = Name_Address
                          or else
+                        Attribute_Name (Parnt) = Name_Bit
+                         or else
                         Attribute_Name (Parnt) = Name_Size)
               and then Prefix (Parnt) = Child
             then
diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index bf41756..be4669c 100644
--- a/gcc/ada/exp_pakd.adb
+++ b/gcc/ada/exp_pakd.adb
@@ -455,6 +455,15 @@ package body Exp_Pakd is
    --  expression whose type is the implementation type used to represent
    --  the packed array. Aexp is analyzed and resolved on entry and on exit.
 
+   procedure Get_Base_And_Bit_Offset
+     (N      : Node_Id;
+      Base   : out Node_Id;
+      Offset : out Node_Id);
+   --  Given a node N for a name which involves a packed array reference,
+   --  return the base object of the reference and build an expression of
+   --  type Standard.Integer representing the zero-based offset in bits
+   --  from Base'Address to the first bit of the reference.
+
    function Known_Aligned_Enough (Obj : Node_Id; Csiz : Nat) return Boolean;
    --  There are two versions of the Set routines, the ones used when the
    --  object is known to be sufficiently well aligned given the number of
@@ -1663,18 +1672,11 @@ package body Exp_Pakd is
 
    procedure Expand_Packed_Address_Reference (N : Node_Id) is
       Loc    : constant Source_Ptr := Sloc (N);
-      Ploc   : Source_Ptr;
-      Pref   : Node_Id;
-      Expr   : Node_Id;
-      Term   : Node_Id;
-      Atyp   : Entity_Id;
-      Subscr : Node_Id;
+      Base   : Node_Id;
+      Offset : Node_Id;
 
    begin
-      Pref := Prefix (N);
-      Expr := Empty;
-
-      --  We build up an expression serially that has the form
+      --  We build an expression that has the form
 
       --    outer_object'Address
       --      + (linear-subscript * component_size  for each array reference
@@ -1682,49 +1684,7 @@ package body Exp_Pakd is
       --      +  ...
       --      +  ...) / Storage_Unit;
 
-      --  Some additional conversions are required to deal with the addition
-      --  operation, which is not normally visible to generated code.
-
-      loop
-         Ploc := Sloc (Pref);
-
-         if Nkind (Pref) = N_Indexed_Component then
-            Convert_To_Actual_Subtype (Prefix (Pref));
-            Atyp := Etype (Prefix (Pref));
-            Compute_Linear_Subscript (Atyp, Pref, Subscr);
-
-            Term :=
-              Make_Op_Multiply (Ploc,
-                Left_Opnd => Subscr,
-                Right_Opnd =>
-                 Make_Attribute_Reference (Ploc,
-                   Prefix         => New_Occurrence_Of (Atyp, Ploc),
-                   Attribute_Name => Name_Component_Size));
-
-         elsif Nkind (Pref) = N_Selected_Component then
-            Term :=
-              Make_Attribute_Reference (Ploc,
-                Prefix         => Selector_Name (Pref),
-                Attribute_Name => Name_Bit_Position);
-
-         else
-            exit;
-         end if;
-
-         Term := Convert_To (RTE (RE_Integer_Address), Term);
-
-         if No (Expr) then
-            Expr := Term;
-
-         else
-            Expr :=
-              Make_Op_Add (Ploc,
-                Left_Opnd  => Expr,
-                Right_Opnd => Term);
-         end if;
-
-         Pref := Prefix (Pref);
-      end loop;
+      Get_Base_And_Bit_Offset (Prefix (N), Base, Offset);
 
       Rewrite (N,
         Unchecked_Convert_To (RTE (RE_Address),
@@ -1732,18 +1692,47 @@ package body Exp_Pakd is
             Left_Opnd =>
               Unchecked_Convert_To (RTE (RE_Integer_Address),
                 Make_Attribute_Reference (Loc,
-                  Prefix         => Pref,
+                  Prefix         => Base,
                   Attribute_Name => Name_Address)),
 
             Right_Opnd =>
-              Make_Op_Divide (Loc,
-                Left_Opnd => Expr,
-                Right_Opnd =>
-                  Make_Integer_Literal (Loc, System_Storage_Unit)))));
+              Unchecked_Convert_To (RTE (RE_Integer_Address),
+                Make_Op_Divide (Loc,
+                  Left_Opnd => Offset,
+                  Right_Opnd =>
+                    Make_Integer_Literal (Loc, System_Storage_Unit))))));
 
       Analyze_And_Resolve (N, RTE (RE_Address));
    end Expand_Packed_Address_Reference;
 
+   ---------------------------------
+   -- Expand_Packed_Bit_Reference --
+   ---------------------------------
+
+   procedure Expand_Packed_Bit_Reference (N : Node_Id) is
+      Loc    : constant Source_Ptr := Sloc (N);
+      Base   : Node_Id;
+      Offset : Node_Id;
+
+   begin
+      --  We build an expression that has the form
+
+      --    (linear-subscript * component_size      for each array reference
+      --      +  field'Bit_Position                 for each record field
+      --      +  ...
+      --      +  ...) mod Storage_Unit;
+
+      Get_Base_And_Bit_Offset (Prefix (N), Base, Offset);
+
+      Rewrite (N,
+        Unchecked_Convert_To (Universal_Integer,
+          Make_Op_Mod (Loc,
+            Left_Opnd => Offset,
+            Right_Opnd => Make_Integer_Literal (Loc, System_Storage_Unit))));
+
+      Analyze_And_Resolve (N, Universal_Integer);
+   end Expand_Packed_Bit_Reference;
+
    ------------------------------------
    -- Expand_Packed_Boolean_Operator --
    ------------------------------------
@@ -2229,6 +2218,70 @@ package body Exp_Pakd is
 
    end Expand_Packed_Not;
 
+   -----------------------------
+   -- Get_Base_And_Bit_Offset --
+   -----------------------------
+
+   procedure Get_Base_And_Bit_Offset
+     (N      : Node_Id;
+      Base   : out Node_Id;
+      Offset : out Node_Id)
+   is
+      Loc    : Source_Ptr;
+      Term   : Node_Id;
+      Atyp   : Entity_Id;
+      Subscr : Node_Id;
+
+   begin
+      Base   := N;
+      Offset := Empty;
+
+      --  We build up an expression serially that has the form
+
+      --    linear-subscript * component_size       for each array reference
+      --      +  field'Bit_Position                 for each record field
+      --      +  ...
+
+      loop
+         Loc := Sloc (Base);
+
+         if Nkind (Base) = N_Indexed_Component then
+            Convert_To_Actual_Subtype (Prefix (Base));
+            Atyp := Etype (Prefix (Base));
+            Compute_Linear_Subscript (Atyp, Base, Subscr);
+
+            Term :=
+              Make_Op_Multiply (Loc,
+                Left_Opnd => Subscr,
+                Right_Opnd =>
+                 Make_Attribute_Reference (Loc,
+                   Prefix         => New_Occurrence_Of (Atyp, Loc),
+                   Attribute_Name => Name_Component_Size));
+
+         elsif Nkind (Base) = N_Selected_Component then
+            Term :=
+              Make_Attribute_Reference (Loc,
+                Prefix         => Selector_Name (Base),
+                Attribute_Name => Name_Bit_Position);
+
+         else
+            return;
+         end if;
+
+         if No (Offset) then
+            Offset := Term;
+
+         else
+            Offset :=
+              Make_Op_Add (Loc,
+                Left_Opnd  => Offset,
+                Right_Opnd => Term);
+         end if;
+
+         Base := Prefix (Base);
+      end loop;
+   end Get_Base_And_Bit_Offset;
+
    -------------------------------------
    -- Involves_Packed_Array_Reference --
    -------------------------------------
diff --git a/gcc/ada/exp_pakd.ads b/gcc/ada/exp_pakd.ads
index 0c2e815..bd21a30 100644
--- a/gcc/ada/exp_pakd.ads
+++ b/gcc/ada/exp_pakd.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, 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- --
@@ -272,4 +272,9 @@ package Exp_Pakd is
    --  the prefix involves a packed array reference. This routine expands the
    --  necessary code for performing the address reference in this case.
 
+   procedure Expand_Packed_Bit_Reference (N : Node_Id);
+   --  The node N is an attribute reference for the 'Bit reference, where the
+   --  prefix involves a packed array reference. This routine expands the
+   --  necessary code for performing the bit reference in this case.
+
 end Exp_Pakd;
diff --git a/gcc/ada/lib-writ.ads b/gcc/ada/lib-writ.ads
index 8e8e321..5451432 100644
--- a/gcc/ada/lib-writ.ads
+++ b/gcc/ada/lib-writ.ads
@@ -696,14 +696,13 @@ package Lib.Writ is
    --  reference data. See the spec of Par_SCO for full details of the format.
 
    ----------------------
-   -- Global variables --
+   -- Global Variables --
    ----------------------
 
-   --  The table structure defined here stores one entry for each
-   --  Interrupt_State pragma encountered either in the main source or
-   --  in an ancillary with'ed source. Since interrupt state values
-   --  have to be consistent across all units in a partition, we may
-   --  as well detect inconsistencies at compile time when we can.
+   --  The table defined here stores one entry for each Interrupt_State pragma
+   --  encountered either in the main source or in an ancillary with'ed source.
+   --  Since interrupt state values have to be consistent across all units in a
+   --  partition, we detect inconsistencies at compile time when we can.
 
    type Interrupt_State_Entry is record
       Interrupt_Number : Pos;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 09e5319..6fe2d64 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -6790,6 +6790,13 @@ package body Sem_Ch3 is
          Mark_Rewrite_Insertion (New_Decl);
          Insert_Before (N, New_Decl);
 
+         --  In the tagged case, make sure ancestor is frozen appropriately
+         --  (see also non-discriminated case below).
+
+         if not Private_Extension or else Is_Interface (Parent_Base) then
+            Freeze_Before (New_Decl, Parent_Type);
+         end if;
+
          --  Note that this call passes False for the Derive_Subps parameter
          --  because subprogram derivation is deferred until after creating
          --  the subtype (see below).
@@ -6880,9 +6887,7 @@ package body Sem_Ch3 is
          --  The declaration of a specific descendant of an interface type
          --  freezes the interface type (RM 13.14).
 
-         if not Private_Extension
-           or else Is_Interface (Parent_Base)
-         then
+         if not Private_Extension or else Is_Interface (Parent_Base) then
             Freeze_Before (N, Parent_Type);
          end if;