2003-11-17 Jerome Guitton <guitton@act-europe.fr>

	* 5zthrini.adb: Remove the call to Init_RTS at elaboration, as it is
	already called in System.Threads.

	* 5ztiitho.adb (Initialize_Task_Hooks): Remove the registration of the
	environment task, as it has been moved to System.Threads.Initialization.

2003-11-17  Arnaud Charlet  <charlet@act-europe.fr>

	* adaint.c (__gnatlib_install_locks): Only reference
	__gnat_install_locks on VMS, since other platforms can avoid using
	--enable-threads=gnat

2003-11-17  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* ada-tree.h: (TYPE_IS_PACKED_ARRAY_TYPE_P): New macro.

	* decl.c (gnat_to_gnu_entity, case E_Array_Subtype): Set
	TYPE_PACKED_ARRAY_TYPE_P.
	(validate_size): Do not verify size if TYPE_IS_PACKED_ARRAY_TYPE_P.

	Part of PR ada/12806
	* utils.c (float_type_for_precision): Renamed from float_type_for_size.
	Use GET_MODE_PRECISION instead of GET_MODE_BITSIZE.

2003-11-17  Vincent Celier  <celier@gnat.com>

	* gnatchop.adb (Error_Msg): New Boolean parameter Warning, defaulted
	to False.
	Do not set exit status to Failure when Warning is True.
	(Gnatchop): Make errors "no compilation units found" and
	"no source files written" warnings only.

	* make.adb (Gnatmake): When using a project file, set
	Look_In_Primary_Dir to False.
	(Configuration_Pragmas_Switch): Check for Global_Configuration_Pragmas
	and Local_Configuration_Pragmas in the project where they are declared
	not an extending project which might have inherited them.

	* osint.adb (Locate_File): If Name is already an absolute path, do not
	look for a directory.

	* par-ch10.adb (P_Compilation_Unit): If source contains no token, and
	-gnats (Check_Syntax) is used, issue only a warning, not an error.

	* prj.adb (Register_Default_Naming_Scheme): Add new component Project
	in objects of type Variable_Value.

	* prj.ads: (Variable_Value): New component Project

	* prj-nmsc.adb (Ada_Check.Warn_If_Not_Sources): No warning if source
	is in a project extended by Project.

	* prj-proc.adb (Add_Attributes): New parameter Project. Set component
	Project of Variable_Values to this new parameter value.
	(Expression): Set component Project of Variable_Values.
	(Process_Declarative_Items): Call Add_Attributes with parameter Project.
	Set the component Project in array elements.

2003-11-17  Sergey Rybin  <rybin@act-europe.fr>

	* errout.adb: (Initialize): Add initialization for error nodes.

	* sem_ch12.adb (Initialize): Add missing initializations for
	Exchanged_Views and Hidden_Entities.

2003-11-17  Ed Schonberg  <schonberg@gnat.com>

	* sem_ch12.adb (Copy_Generic_Node): Preserve entity when copying an
	already instantiated tree for use in subsequent inlining.
	(Analyze_Associations, Instantiate_Formal_Subprogram,
	Instantiate_Object): improve error message for mismatch in
	instantiations.

	* sem_ch6.adb (Build_Body_To_Inline): Major cleanup to handle
	instantiations of subprograms declared in instances.

2003-11-17  Javier Miranda  <miranda@gnat.com>

	* sem_ch4.adb (Analyze_Allocator): Previous modification must be
	executed only under the Extensions_Allowed flag.

2003-11-17  Robert Dewar  <dewar@gnat.com>

	* a-exexda.adb (Address_Image): Fix documentation to indicate leading
	zeroes suppressed.
	(Address_Image): Fix bug of returning 0x instead of 0x0
	Minor reformatting (function specs).

	* einfo.ads: Minor fix for documentation of Is_Bit_Packed_Array
	(missed case of 33-63)

	* freeze.adb, sem_ch13.adb: Properly check size of packed bit array

	* s-thread.adb: Add comments for pragma Restriction

	* exp_aggr.adb, g-debuti.adb, par-ch4.adb, sem_aggr.adb,
	sem_ch6.adb, sprint.adb, xref_lib.adb: Minor reformatting

2003-11-17  Ed Falis  <falis@gnat.com>

	* s-thread.adb: Added No_Tasking restriction for this implementation.

2003-11-17  Emmanuel Briot  <briot@act-europe.fr>

	* xref_lib.adb (Parse_Identifier_Info): Add handling of generic
	instanciation references in the parent type description.

2003-11-17  GNAT Script  <nobody@gnat.com>

	* Make-lang.in: Makefile automatically updated


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

1 files changed, 65 insertions, 11 deletions

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 8ebf0c639e8..ca9bb01355c 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1881,7 +1881,7 @@ package body Sem_Ch13 is
       Biased  : Boolean;
 
       Max_Bit_So_Far : Uint;
-      --  Records the maximum bit position so far. If all field positoins
+      --  Records the maximum bit position so far. If all field positions
       --  are monotonically increasing, then we can skip the circuit for
       --  checking for overlap, since no overlap is possible.
 
@@ -2153,10 +2153,9 @@ package body Sem_Ch13 is
                               CC, Rectype);
                         end if;
 
-                        --  This information is also set in the
-                        --  corresponding component of the base type,
-                        --  found by accessing the Original_Record_Component
-                        --  link if it is present.
+                        --  This information is also set in the corresponding
+                        --  component of the base type, found by accessing the
+                        --  Original_Record_Component link if it is present.
 
                         Ocomp := Original_Record_Component (Comp);
 
@@ -2848,21 +2847,68 @@ package body Sem_Ch13 is
    begin
       Biased := False;
 
-      --  Immediate return if size is same as standard size or if composite
-      --  item, or generic type, or type with previous errors.
+      --  Dismiss cases for generic types or types with previous errors
 
       if No (UT)
         or else UT = Any_Type
         or else Is_Generic_Type (UT)
         or else Is_Generic_Type (Root_Type (UT))
-        or else Is_Composite_Type (UT)
-        or else (Known_Esize (UT) and then Siz = Esize (UT))
       then
          return;
 
+      --  Check case of bit packed array
+
+      elsif Is_Array_Type (UT)
+        and then Known_Static_Component_Size (UT)
+        and then Is_Bit_Packed_Array (UT)
+      then
+         declare
+            Asiz : Uint;
+            Indx : Node_Id;
+            Ityp : Entity_Id;
+
+         begin
+            Asiz := Component_Size (UT);
+            Indx := First_Index (UT);
+            loop
+               Ityp := Etype (Indx);
+
+               --  If non-static bound, then we are not in the business of
+               --  trying to check the length, and indeed an error will be
+               --  issued elsewhere, since sizes of non-static array types
+               --  cannot be set implicitly or explicitly.
+
+               if not Is_Static_Subtype (Ityp) then
+                  return;
+               end if;
+
+               --  Otherwise accumulate next dimension
+
+               Asiz := Asiz * (Expr_Value (Type_High_Bound (Ityp)) -
+                               Expr_Value (Type_Low_Bound  (Ityp)) +
+                               Uint_1);
+
+               Next_Index (Indx);
+               exit when No (Indx);
+            end loop;
+
+            if Asiz <= Siz then
+               return;
+            else
+               Error_Msg_Uint_1 := Asiz;
+               Error_Msg_NE
+                 ("size for& too small, minimum allowed is ^", N, T);
+            end if;
+         end;
+
+      --  All other composite types are ignored
+
+      elsif Is_Composite_Type (UT) then
+         return;
+
       --  For fixed-point types, don't check minimum if type is not frozen,
-      --  since type is not known till then
-      --  at freeze time.
+      --  since we don't know all the characteristics of the type that can
+      --  affect the size (e.g. a specified small) till freeze time.
 
       elsif Is_Fixed_Point_Type (UT)
         and then not Is_Frozen (UT)
@@ -2872,6 +2918,14 @@ package body Sem_Ch13 is
       --  Cases for which a minimum check is required
 
       else
+         --  Ignore if specified size is correct for the type
+
+         if Known_Esize (UT) and then Siz = Esize (UT) then
+            return;
+         end if;
+
+         --  Otherwise get minimum size
+
          M := UI_From_Int (Minimum_Size (UT));
 
          if Siz < M then