[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

gcc/ada/ChangeLog

+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.

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,6 +2796,13 @@ __gnat_locate_regular_file (char *file_name, char *path_val)
       for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
 	*ptr++ = *path_val++;
 
+      /* 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++;
       }
   }
 

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)

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,

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);

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

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 =>
+              Unchecked_Convert_To (RTE (RE_Integer_Address),
                 Make_Op_Divide (Loc,
-                Left_Opnd => Expr,
+                  Left_Opnd => Offset,
                   Right_Opnd =>
-                  Make_Integer_Literal (Loc, System_Storage_Unit)))));
+                    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 --
    -------------------------------------

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;

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;

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;