[multiple changes]

2004-02-23  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch6.adb (Expand_N_Subprogram_Declaration): Do not create
	protected operations if original subprogram is flagged as eliminated.
	(Expand_N_Subprogram_Body): For a protected operation, create
	discriminals for next operation before checking whether the operation
	is eliminated.

	* exp_ch9.adb (Expand_N_Protected_Body,
	Expand_N_Protected_Type_Declaration): Do not generate specs and bodies
	for internal protected operations if the original subprogram is
	eliminated.

	* sem_elim.adb (Check_Eliminated): Handle properly protected operations
	declared in a single protected object.

2004-02-23  Vincent Celier  <celier@gnat.com>

	* prj-attr.adb: Make attribute Builder'Executable an associative array,
	case insensitive if file names are case insensitive, instead of a
	standard associative array.

	* prj-attr.adb (Initialize): For 'b' associative arrays, do not set
	them as case insensitive on platforms where the file names are case
	sensitive.

	* prj-part.adb (Parse_Single_Project): Make sure, when checking if
	project file has already been parsed that canonical path are compared.

2004-02-23  Robert Dewar  <dewar@gnat.com>

	* sinput-c.ads: Correct bad unit title in header

	* freeze.adb: Minor reformatting

2004-02-23  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* trans.c (tree_transform, case N_Procedure_Call_Statement): For
	nonaddressable COMPONENT_REF that is removing padding that we are
	taking the address of, take the address of the padded record instead
	if item is variable size.

From-SVN: r78292

gcc/ada/ChangeLog

+2004-02-23  Ed Schonberg  <schonberg@gnat.com>
+
+	* exp_ch6.adb (Expand_N_Subprogram_Declaration): Do not create
+	protected operations if original subprogram is flagged as eliminated.
+	(Expand_N_Subprogram_Body): For a protected operation, create
+	discriminals for next operation before checking whether the operation
+	is eliminated.
+
+	* exp_ch9.adb (Expand_N_Protected_Body,
+	Expand_N_Protected_Type_Declaration): Do not generate specs and bodies
+	for internal protected operations if the original subprogram is
+	eliminated.
+
+	* sem_elim.adb (Check_Eliminated): Handle properly protected operations
+	declared in a single protected object.
+
+2004-02-23  Vincent Celier  <celier@gnat.com>
+
+	* prj-attr.adb: Make attribute Builder'Executable an associative array,
+	case insensitive if file names are case insensitive, instead of a
+	standard associative array.
+
+	* prj-attr.adb (Initialize): For 'b' associative arrays, do not set
+	them as case insensitive on platforms where the file names are case
+	sensitive.
+
+	* prj-part.adb (Parse_Single_Project): Make sure, when checking if
+	project file has already been parsed that canonical path are compared.
+
+2004-02-23  Robert Dewar  <dewar@gnat.com>
+
+	* sinput-c.ads: Correct bad unit title in header
+
+	* freeze.adb: Minor reformatting
+
+2004-02-23  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* trans.c (tree_transform, case N_Procedure_Call_Statement): For
+	nonaddressable COMPONENT_REF that is removing padding that we are
+	taking the address of, take the address of the padded record instead
+	if item is variable size.
+
 2004-02-20  Robert Dewar  <dewar@gnat.com>
 
 	* bld.adb, exp_util.adb, gprcmd.adb: Minor reformatting

gcc/ada/exp_ch6.adb

@@ -3191,6 +3191,34 @@ package body Exp_Ch6 is
          end;
       end if;
 
+      Scop := Scope (Spec_Id);
+
+      --  Add discriminal renamings to protected subprograms.
+      --  Install new discriminals for expansion of the next
+      --  subprogram of this protected type, if any.
+
+      if Is_List_Member (N)
+        and then Present (Parent (List_Containing (N)))
+        and then Nkind (Parent (List_Containing (N))) = N_Protected_Body
+      then
+         Add_Discriminal_Declarations
+           (Declarations (N), Scop, Name_uObject, Loc);
+         Add_Private_Declarations (Declarations (N), Scop, Name_uObject, Loc);
+
+         --  Associate privals and discriminals with the next protected
+         --  operation body to be expanded. These are used to expand
+         --  references to private data objects and discriminants,
+         --  respectively.
+
+         Next_Op := Next_Protected_Operation (N);
+
+         if Present (Next_Op) then
+            Dec := Parent (Base_Type (Scop));
+            Set_Privals (Dec, Next_Op, Loc);
+            Set_Discriminals (Dec);
+         end if;
+      end if;
+
       --  Clear out statement list for stubbed procedure
 
       if Present (Corresponding_Spec (N)) then
@@ -3208,8 +3236,6 @@ package body Exp_Ch6 is
          end if;
       end if;
 
-      Scop := Scope (Spec_Id);
-
       --  Returns_By_Ref flag is normally set when the subprogram is frozen
       --  but subprograms with no specs are not frozen
 
@@ -3298,32 +3324,6 @@ package body Exp_Ch6 is
          end;
       end if;
 
-      --  Add discriminal renamings to protected subprograms.
-      --  Install new discriminals for expansion of the next
-      --  subprogram of this protected type, if any.
-
-      if Is_List_Member (N)
-        and then Present (Parent (List_Containing (N)))
-        and then Nkind (Parent (List_Containing (N))) = N_Protected_Body
-      then
-         Add_Discriminal_Declarations
-           (Declarations (N), Scop, Name_uObject, Loc);
-         Add_Private_Declarations (Declarations (N), Scop, Name_uObject, Loc);
-
-         --  Associate privals and discriminals with the next protected
-         --  operation body to be expanded. These are used to expand
-         --  references to private data objects and discriminants,
-         --  respectively.
-
-         Next_Op := Next_Protected_Operation (N);
-
-         if Present (Next_Op) then
-            Dec := Parent (Base_Type (Scop));
-            Set_Privals (Dec, Next_Op, Loc);
-            Set_Discriminals (Dec);
-         end if;
-      end if;
-
       --  If subprogram contains a parameterless recursive call, then we may
       --  have an infinite recursion, so see if we can generate code to check
       --  for this possibility if storage checks are not suppressed.
@@ -3420,14 +3420,17 @@ package body Exp_Ch6 is
       Prot_Id   : Entity_Id;
 
    begin
-      --  Deal with case of protected subprogram
+      --  Deal with case of protected subprogram. Do not generate
+      --  protected operation if operation is flagged as eliminated.
 
       if Is_List_Member (N)
         and then Present (Parent (List_Containing (N)))
         and then Nkind (Parent (List_Containing (N))) = N_Protected_Body
         and then Is_Protected_Type (Scop)
       then
-         if No (Protected_Body_Subprogram (Subp)) then
+         if No (Protected_Body_Subprogram (Subp))
+           and then not Is_Eliminated (Subp)
+         then
             Prot_Decl :=
               Make_Subprogram_Declaration (Loc,
                 Specification =>

gcc/ada/exp_ch9.adb

@@ -4885,7 +4885,9 @@ package body Exp_Ch9 is
 
                --  Exclude functions created to analyze defaults.
 
-               if not Is_Eliminated (Defining_Entity (Op_Body)) then
+               if not Is_Eliminated (Defining_Entity (Op_Body))
+                 and then not Is_Eliminated (Corresponding_Spec (Op_Body))
+               then
                   New_Op_Body :=
                     Build_Unprotected_Subprogram_Body (Op_Body, Pid);
 
@@ -5372,14 +5374,17 @@ package body Exp_Ch9 is
       --  subprogram; one to call from outside the object and one to
       --  call from inside. Build a barrier function and an entry
       --  body action procedure specification for each protected entry.
-      --  Initialize the entry body array.
+      --  Initialize the entry body array. If subprogram is flagged as
+      --  eliminated, do not generate any internal operations.
 
       E_Count := 0;
 
       Comp := First (Visible_Declarations (Pdef));
 
       while Present (Comp) loop
-         if Nkind (Comp) = N_Subprogram_Declaration then
+         if Nkind (Comp) = N_Subprogram_Declaration
+           and then not Is_Eliminated (Defining_Entity (Comp))
+         then
             Sub :=
               Make_Subprogram_Declaration (Loc,
                 Specification =>

gcc/ada/freeze.adb

@@ -1479,6 +1479,10 @@ package body Freeze is
          --  might otherwise be frozen in the wrong scope, and a freeze node
          --  on subtype has no effect.
 
+         -----------------
+         -- Check_Itype --
+         -----------------
+
          procedure Check_Itype (Desig : Entity_Id) is
          begin
             if not Is_Frozen (Desig)
@@ -1522,11 +1526,10 @@ package body Freeze is
             then
                Set_First_Entity (Rec, First_Entity (Base_Type (Rec)));
 
-            --  If this is an internal type without a declaration, as for
-            --  a record component, the base type may not yet be frozen,
-            --  and its controller has not been created. Add an explicit
-            --  freeze node for the itype, so it will be frozen after the
-            --  base type.
+            --  If this is an internal type without a declaration, as for a
+            --  record component, the base type may not yet be frozen, and its
+            --  controller has not been created. Add an explicit freeze node
+            --  for the itype, so it will be frozen after the base type.
 
             elsif Is_Itype (Rec)
               and then Has_Delayed_Freeze (Base_Type (Rec))
@@ -1997,7 +2000,6 @@ package body Freeze is
                   --  Loop through formals
 
                   Formal := First_Formal (E);
-
                   while Present (Formal) loop
                      F_Type := Etype (Formal);
                      Freeze_And_Append (F_Type, Loc, Result);

gcc/ada/prj-attr.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---             Copyright (C) 2001-2003 Free Software Foundation, Inc.       --
+--             Copyright (C) 2001-2004 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- --
@@ -105,7 +105,7 @@ package body Prj.Attr is
      "Pbuilder#" &
      "Ladefault_switches#" &
      "Lbswitches#" &
-     "SAexecutable#" &
+     "Sbexecutable#" &
      "SVexecutable_suffix#" &
      "SVglobal_configuration_pragmas#" &
 
@@ -258,7 +258,7 @@ package body Prj.Attr is
 
                when 'b' =>
                   if File_Names_Case_Sensitive then
-                     Kind_2 := Case_Insensitive_Associative_Array;
+                     Kind_2 := Associative_Array;
                   else
                      Kind_2 := Case_Insensitive_Associative_Array;
                   end if;

gcc/ada/prj-part.adb

@@ -97,13 +97,14 @@ package body Prj.Part is
    --  projects. These imported projects will be effectively parsed after the
    --  name of the current project has been extablished.
 
-   type Name_And_Id is record
-      Name : Name_Id;
+   type Names_And_Id is record
+      Path_Name           : Name_Id;
+      Canonical_Path_Name : Name_Id;
       Id   : Project_Node_Id;
    end record;
 
    package Project_Stack is new Table.Table
-     (Table_Component_Type => Name_And_Id,
+     (Table_Component_Type => Names_And_Id,
       Table_Index_Type     => Nat,
       Table_Low_Bound      => 1,
       Table_Initial        => 10,
@@ -717,7 +718,7 @@ package body Prj.Part is
 
                if Project_Stack.Last > 1 then
                   for Index in reverse 1 .. Project_Stack.Last loop
-                     Error_Msg_Name_1 := Project_Stack.Table (Index).Name;
+                     Error_Msg_Name_1 := Project_Stack.Table (Index).Path_Name;
                      Error_Msg ("\imported by {", Current_With.Location);
                   end loop;
                end if;
@@ -761,7 +762,7 @@ package body Prj.Part is
                      Canonical_Path_Name := Name_Find;
 
                      for Index in 1 .. Project_Stack.Last loop
-                        if Project_Stack.Table (Index).Name =
+                        if Project_Stack.Table (Index).Canonical_Path_Name =
                           Canonical_Path_Name
                         then
                            --  We have found the limited imported project,
@@ -875,13 +876,15 @@ package body Prj.Part is
       --  Check for a circular dependency
 
       for Index in 1 .. Project_Stack.Last loop
-         if Canonical_Path_Name = Project_Stack.Table (Index).Name then
+         if Canonical_Path_Name =
+              Project_Stack.Table (Index).Canonical_Path_Name
+         then
             Error_Msg ("circular dependency detected", Token_Ptr);
             Error_Msg_Name_1 := Normed_Path_Name;
             Error_Msg ("\  { is imported by", Token_Ptr);
 
             for Current in reverse 1 .. Project_Stack.Last loop
-               Error_Msg_Name_1 := Project_Stack.Table (Current).Name;
+               Error_Msg_Name_1 := Project_Stack.Table (Current).Path_Name;
 
                if Error_Msg_Name_1 /= Canonical_Path_Name then
                   Error_Msg
@@ -901,16 +904,25 @@ package body Prj.Part is
       --  Put the new path name on the stack
 
       Project_Stack.Increment_Last;
-      Project_Stack.Table (Project_Stack.Last).Name := Canonical_Path_Name;
+      Project_Stack.Table (Project_Stack.Last).Path_Name := Normed_Path_Name;
+      Project_Stack.Table (Project_Stack.Last).Canonical_Path_Name :=
+        Canonical_Path_Name;
 
       --  Check if the project file has already been parsed.
 
       while
         A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
       loop
-         if
-           Path_Name_Of (A_Project_Name_And_Node.Node) = Canonical_Path_Name
-         then
+         declare
+            Path_Id : Name_Id := Path_Name_Of (A_Project_Name_And_Node.Node);
+         begin
+            if Path_Id /= No_Name then
+               Get_Name_String (Path_Id);
+               Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
+               Path_Id := Name_Find;
+            end if;
+
+            if Path_Id = Canonical_Path_Name then
                if Extended then
 
                   if A_Project_Name_And_Node.Extended then
@@ -925,11 +937,12 @@ package body Prj.Part is
                   end if;
 
                elsif A_Project_Name_And_Node.Extended then
-               Extends_All := Is_Extending_All (A_Project_Name_And_Node.Node);
+                  Extends_All :=
+                    Is_Extending_All (A_Project_Name_And_Node.Node);
 
-               --  If the imported project is an extended project A, and we are
-               --  in an extended project, replace A with the ultimate project
-               --  extending A.
+                  --  If the imported project is an extended project A,
+                  --  and we are in an extended project, replace A with the
+                  --  ultimate project extending A.
 
                   if From_Extended /= None then
                      declare
@@ -958,6 +971,7 @@ package body Prj.Part is
                Project_Stack.Decrement_Last;
                return;
             end if;
+         end;
 
          A_Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next;
       end loop;
@@ -1202,11 +1216,12 @@ package body Prj.Part is
 
                   if Project_Stack.Last > 1 then
                      Error_Msg_Name_1 :=
-                       Project_Stack.Table (Project_Stack.Last).Name;
+                       Project_Stack.Table (Project_Stack.Last).Path_Name;
                      Error_Msg ("\extended by {", Token_Ptr);
 
                      for Index in reverse 1 .. Project_Stack.Last - 1 loop
-                        Error_Msg_Name_1 := Project_Stack.Table (Index).Name;
+                        Error_Msg_Name_1 :=
+                          Project_Stack.Table (Index).Path_Name;
                         Error_Msg ("\imported by {", Token_Ptr);
                      end loop;
                   end if;

gcc/ada/sem_elim.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1997-2004 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- --
@@ -232,6 +232,29 @@ package body Sem_Elim is
       Ctr  : Nat;
       Ent  : Entity_Id;
 
+      function Original_Chars (S : Entity_Id) return Name_Id;
+      --  If the candidate subprogram is a protected operation of a single
+      --  protected object, the scope of the operation is the created
+      --  protected type, and we have to retrieve the original name of
+      --  the object.
+
+      --------------------
+      -- Original_Chars --
+      --------------------
+
+      function Original_Chars (S : Entity_Id) return Name_Id is
+      begin
+         if Ekind (S) /= E_Protected_Type
+           or else Comes_From_Source (S)
+         then
+            return Chars (S);
+         else
+            return Chars (Defining_Identifier (Original_Node (Parent (S))));
+         end if;
+      end Original_Chars;
+
+   --  Start of processing for Check_Eliminated
+
    begin
       if No_Elimination then
          return;
@@ -270,7 +293,7 @@ package body Sem_Elim is
             Scop := Scope (E);
             if Elmt.Entity_Scope /= null then
                for J in reverse Elmt.Entity_Scope'Range loop
-                  if Elmt.Entity_Scope (J) /= Chars (Scop) then
+                  if Elmt.Entity_Scope (J) /= Original_Chars (Scop) then
                      goto Continue;
                   end if;
 

gcc/ada/sinput-c.ads

@@ -2,11 +2,11 @@
 --                                                                          --
 --                         GNAT COMPILER COMPONENTS                         --
 --                                                                          --
---                             S I N P U T . P                              --
+--                             S I N P U T . C                              --
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2002, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2004, 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- --

gcc/ada/trans.c

@@ -2997,6 +2997,19 @@ tree_transform (Node_Id gnat_node)
 				   gnu_actual);
 		  }
 
+		/* Otherwise, if we have a non-addressable COMPONENT_REF of a
+		   variable-size type see if it's doing a unpadding operation.
+		   If so, remove that operation since we have no way of
+		   allocating the required temporary.  */
+		if (TREE_CODE (gnu_actual) == COMPONENT_REF
+		    && ! TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_actual)))
+		    && (TREE_CODE (TREE_TYPE (TREE_OPERAND (gnu_actual, 0)))
+			== RECORD_TYPE)
+		    && TYPE_IS_PADDING_P (TREE_TYPE
+					  (TREE_OPERAND (gnu_actual, 0)))
+		    && !addressable_p (gnu_actual))
+		  gnu_actual = TREE_OPERAND (gnu_actual, 0);
+
 		/* The symmetry of the paths to the type of an entity is
 		   broken here since arguments don't know that they will
 		   be passed by ref. */