2008-04-08 Robert Dewar <dewar@adacore.com>

	    Gary Dismukes  <dismukes@adacore.com>
	    Javier Miranda  <miranda@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* fe.h: Remove global Optimize_Alignment flag, no longer used

	* layout.adb: Test Optimize_Alignment flags rather than global switch

	* lib.ads, lib.adb: New OA_Setting field in library record

	* lib-load.adb: New OA_Setting field in library record

	* lib-writ.ads, lib-writ.adb (Collect_Withs, Write_With_Lines): Place
	units mentioned in limited_with_ clauses in the ali file, with an
	'Y' marker.
	New Ox fields in U line

	* opt.adb: New flag Optimize_Alignment_Local
	(Check_Policy_List[_Config]): New flags

	* opt.ads (Invalid_Value_Used): New flag
	New switch Optimize_Alignment_Local
	(Warn_On_Parameter_Order): New flag
	(Check_Policy_List[_Config]): New flags

	* ali.ads, ali.adb: Add indicator 'Y' to mark mark the presence of
	limited_with clauses.
	New data structures for Optimize_Alignment

	* bcheck.adb (Check_Consistent_Restriction_No_Default_Initialization):
	New procedure
	(Check_Consistent_Optimize_Alignment): Rework for new structure
	(Check_Consistent_Restrictions): Fix incorrect error message

	sem_ch10.adb (Decorate_Tagged_Type): Set the Parent field of a newly
	created class-wide type (to the Parent field of the specific type).
	(Install_Siblings): Handle properly private_with_clauses on subprogram
	bodies and on generic units.
	(Analyze_With_Clause, Install_Limited_Withed_Unit): Guard against an
	illegal limited_with_clause that names a non-existent package.
	(Check_Body_Required): Determine whether a unit named a limited_with
	clause needs a body.
	(Analyze_Context): A limited_with_clause is illegal on a unit_renaming.
	Capture Optimize_Alignment settings to set new OA_Setting field in
	library record.
	(Build_Limited_Views): Include task and protected type declarations.

	* sem_ch3.ads, sem_ch3.adb (Analyze_Object_Declaration): Handle the
	case of a possible constant redeclaration where the current object is
	an entry index constant.
	(Analyze_Object_Declaration): Generate an error in case of CPP
	class-wide object initialization.
	(Analyze_Object_Declaration): Add extra information on warnings for
	declaration of unconstrained objects.
	(Access_Type_Declaration): Set Associated_Final_Chain to Empty, to avoid
	conflicts with the setting of Stored_Constraint in the case where the
	access type entity has already been created as an E_Incomplete_Type due
	to a limited with clause.
	Use new Is_Standard_Character_Type predicate
	(Analyze_Object_Declaration): Apply access_constant check only after
	expression has been resolved, given that it may be overloaded with
	several access types.
	(Constant_Redeclaration): Additional legality checks for deferred
	constant declarations tha involve anonymous access types and/or null
	exclusion indicators.
	(Analyze_Type_Declaration): Set Optimize_Alignment flags
	(Analyze_Subtype_Declaration): Ditto
	(Analyze_Object_Declaration): Ditto
	(Analyze_Object_Declaration): Don't count tasks in generics
	Change name In_Default_Expression      => In_Spec_Expression
	Change name Analyze_Per_Use_Expression => Preanalyze_Spec_Expression
	Change name Pre_Analyze_And_Resolve    => Preanalyze_And_Resolve
	(Process_Discriminants): Additional check for illegal use of default
	expressions in access discriminant specifications in a type that is not
	explicitly limited.
	(Check_Abstract_Overriding): If an inherited function dispaches on an
	access result, it must be overridden, even if the type is a null
	extension.
	(Derive_Subprogram): The formals of the derived subprogram have the
	names and defaults of the parent subprogram, even if the type is
	obtained from the actual subprogram.
	(Derive_Subprogram): In the presence of interfaces, a formal of an
	inherited operation has the derived type not only if it descends from
	the type of the formal of the parent operation, but also if it
	implements it. This is relevant for the renamings created for the
	primitive operations of the actual for a formal derived type.
	(Is_Progenitor): New predicate, to determine whether the type of a
	formal in the parent operation must be replaced by the derived type.

	* sem_util.ads, sem_util.adb (Has_Overriding_Initialize): Make
	predicate recursive to handle components that have a user-defined
	Initialize procedure. Handle controlled derived types whose ancestor
	has a user-defined Initialize procedured.
	(Note_Possible_Modification): Add Sure parameter, generate warning if
	sure modification of constant
	Use new Is_Standard_Character_Type predicate
	(Find_Parameter_Type): when determining whether a protected operation
	implements an interface operation, retrieve the type of the formal from
	the entity when the formal is an access parameter or an
	anonymous-access-to-subprogram.
	Move Copy_Parameter_List to sem_util, for use when building stubbed
	subprogram bodies.
	(Has_Access_Values): Tagged types now return False
	(Within_HSS_Or_If): New procedure
	(Set_Optimize_Alignment_Flags): New procedure
	Change name In_Default_Expression      => In_Spec_Expression
	Change name Analyze_Per_Use_Expression => Preanalyze_Spec_Expression
	Change name Pre_Analyze_And_Resolve    => Preanalyze_And_Resolve



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

1 files changed, 99 insertions, 31 deletions

diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb
index c397cc8dc92..3332d2083f8 100644
--- a/gcc/ada/bcheck.adb
+++ b/gcc/ada/bcheck.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -43,7 +43,7 @@ package body Bcheck is
    -----------------------
 
    --  The following checking subprograms make up the parts of the
-   --  configuration consistency check.
+   --  configuration consistency check. See bodies for details of checks.
 
    procedure Check_Consistent_Dispatching_Policy;
    procedure Check_Consistent_Dynamic_Elaboration_Checking;
@@ -54,6 +54,7 @@ package body Bcheck is
    procedure Check_Consistent_Optimize_Alignment;
    procedure Check_Consistent_Queuing_Policy;
    procedure Check_Consistent_Restrictions;
+   procedure Check_Consistent_Restriction_No_Default_Initialization;
    procedure Check_Consistent_Zero_Cost_Exception_Handling;
 
    procedure Consistency_Error_Msg (Msg : String);
@@ -90,6 +91,7 @@ package body Bcheck is
       Check_Consistent_Optimize_Alignment;
       Check_Consistent_Dynamic_Elaboration_Checking;
       Check_Consistent_Restrictions;
+      Check_Consistent_Restriction_No_Default_Initialization;
       Check_Consistent_Interrupt_States;
       Check_Consistent_Dispatching_Policy;
    end Check_Configuration_Consistency;
@@ -700,34 +702,40 @@ package body Bcheck is
    -- Check_Consistent_Optimize_Alignment --
    -----------------------------------------
 
-   --  The rule is that all units other than internal units must be compiled
-   --  with the same setting for Optimize_Alignment. We can exclude internal
-   --  units since they are forced to compile with Optimize_Alignment (Off).
+   --  The rule is that all units which depend on the global default setting
+   --  of Optimize_Alignment must be compiled with the same settinng for this
+   --  default. Units which specify an explicit local value for this setting
+   --  are exempt from the consistency rule (this includes all internal units).
 
    procedure Check_Consistent_Optimize_Alignment is
       OA_Setting : Character := ' ';
-      --  Reset when we find a non-internal unit
+      --  Reset when we find a unit that depends on the default and does
+      --  not have a local specification of the Optimize_Alignment setting.
 
-      OA_Unit : ALI_Id;
+      OA_Unit : Unit_Id;
       --  Id of unit from which OA_Setting was set
 
+      C : Character;
+
    begin
-      for A in ALIs.First .. ALIs.Last loop
-         if not Is_Internal_File_Name (ALIs.Table (A).Afile) then
+      for U in First_Unit_Entry .. Units.Last loop
+         C := Units.Table (U).Optimize_Alignment;
+
+         if C /= 'L' then
             if OA_Setting = ' ' then
-               OA_Setting := ALIs.Table (A).Optimize_Alignment_Setting;
-               OA_Unit := A;
+               OA_Setting := C;
+               OA_Unit := U;
 
-            elsif OA_Setting = ALIs.Table (A).Optimize_Alignment_Setting then
+            elsif OA_Setting = C then
                null;
 
             else
-               Error_Msg_File_1 := ALIs.Table (OA_Unit).Sfile;
-               Error_Msg_File_2 := ALIs.Table (A).Sfile;
+               Error_Msg_Unit_1 := Units.Table (OA_Unit).Uname;
+               Error_Msg_Unit_2 := Units.Table (U).Uname;
 
                Consistency_Error_Msg
-                 ("{ and { compiled with different "
-                  & "Optimize_Alignment settings");
+                 ("$ and $ compiled with different "
+                  & "default Optimize_Alignment settings");
                return;
             end if;
          end if;
@@ -775,10 +783,9 @@ package body Bcheck is
    -- Check_Consistent_Restrictions --
    -----------------------------------
 
-   --  The rule is that if a restriction is specified in any unit,
-   --  then all units must obey the restriction. The check applies
-   --  only to restrictions which require partition wide consistency,
-   --  and not to internal units.
+   --  The rule is that if a restriction is specified in any unit, then all
+   --  units must obey the restriction. The check applies only to restrictions
+   --  which require partition wide consistency, and not to internal units.
 
    procedure Check_Consistent_Restrictions is
       Restriction_File_Output : Boolean;
@@ -811,7 +818,7 @@ package body Bcheck is
                   declare
                      M1 : constant String := "{ has restriction ";
                      S  : constant String := Restriction_Id'Image (R);
-                     M2 : String (1 .. 200); -- big enough!
+                     M2 : String (1 .. 2000); -- big enough!
                      P  : Integer;
 
                   begin
@@ -902,7 +909,7 @@ package body Bcheck is
                                 ("  { (count = at least #)");
                            else
                               Consistency_Error_Msg
-                                ("  % (count = #)");
+                                ("  { (count = #)");
                            end if;
                         end if;
                      end if;
@@ -950,6 +957,75 @@ package body Bcheck is
       end loop;
    end Check_Consistent_Restrictions;
 
+   ------------------------------------------------------------
+   -- Check_Consistent_Restriction_No_Default_Initialization --
+   ------------------------------------------------------------
+
+   --  The Restriction (No_Default_Initialization) has special consistency
+   --  rules. The rule is that no unit compiled without this restriction
+   --  that violates the restriction can WITH a unit that is compiled with
+   --  the restriction.
+
+   procedure Check_Consistent_Restriction_No_Default_Initialization is
+   begin
+      --  Nothing to do if no one set this restriction
+
+      if not Cumulative_Restrictions.Set (No_Default_Initialization) then
+         return;
+      end if;
+
+      --  Nothing to do if no one violates the restriction
+
+      if not Cumulative_Restrictions.Violated (No_Default_Initialization) then
+         return;
+      end if;
+
+      --  Otherwise we go into a full scan to find possible problems
+
+      for U in Units.First .. Units.Last loop
+         declare
+            UTE : Unit_Record renames Units.Table (U);
+            ATE : ALIs_Record renames ALIs.Table (UTE.My_ALI);
+
+         begin
+            if ATE.Restrictions.Violated (No_Default_Initialization) then
+               for W in UTE.First_With .. UTE.Last_With loop
+                  declare
+                     AFN : constant File_Name_Type := Withs.Table (W).Afile;
+
+                  begin
+                     --  The file name may not be present for withs of certain
+                     --  generic run-time files. The test can be safely left
+                     --  out in such cases anyway.
+
+                     if AFN /= No_File then
+                        declare
+                           WAI : constant ALI_Id :=
+                                   ALI_Id (Get_Name_Table_Info (AFN));
+                           WTE : ALIs_Record renames ALIs.Table (WAI);
+
+                        begin
+                           if WTE.Restrictions.Set
+                               (No_Default_Initialization)
+                           then
+                              Error_Msg_Unit_1 := UTE.Uname;
+                              Consistency_Error_Msg
+                                ("unit $ compiled without restriction "
+                                 & "No_Default_Initialization");
+                              Error_Msg_Unit_1 := Withs.Table (W).Uname;
+                              Consistency_Error_Msg
+                                ("withs unit $, compiled with restriction "
+                                 & "No_Default_Initialization");
+                           end if;
+                        end;
+                     end if;
+                  end;
+               end loop;
+            end if;
+         end;
+      end loop;
+   end Check_Consistent_Restriction_No_Default_Initialization;
+
    ---------------------------------------------------
    -- Check_Consistent_Zero_Cost_Exception_Handling --
    ---------------------------------------------------
@@ -1056,15 +1132,7 @@ package body Bcheck is
          --  If consistency errors are tolerated,
          --  output the message as a warning.
 
-         declare
-            Warning_Msg : String (1 .. Msg'Length + 1);
-
-         begin
-            Warning_Msg (1) := '?';
-            Warning_Msg (2 .. Warning_Msg'Last) := Msg;
-
-            Error_Msg (Warning_Msg);
-         end;
+         Error_Msg ('?' & Msg);
 
       --  Otherwise the consistency error is a true error