[multiple changes]

2009-04-15  Hristian Kirtchev  <kirtchev@adacore.com>

	* a-calend.adb: Add new constant Nanos_In_Four_Years.
	(Formatting_Operations.Time_Of): Change the way four year chunks of
	nanoseconds are added to the intermediate result.

2009-04-15  Nicolas Setton  <setton@adacore.com>

	* sysdep.c: Add __APPLE__ in the list of systems where get_immediate
	does not need to wait for a carriage return.

2009-04-15  Tristan Gingold  <gingold@adacore.com>

	* bindgen.adb: Do not generate adafinal if No_Finalization restriction
	is set.

2009-04-15  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Freeze_Entity): improve error message for improper use of
	incomplete types.
	Diagnose additional illegal uses of incomplete types in formal parts.
	appearing in formal parts.

	* sem_ch6.adb (Process_Formals, Analyze_Return_Type): ditto.

2009-04-15  Robert Dewar  <dewar@adacore.com>

	* exp_ch4.adb (Expand_N_Allocator): Install test for object too large.

From-SVN: r146098

gcc/ada/ChangeLog

+2009-04-15  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* a-calend.adb: Add new constant Nanos_In_Four_Years.
+	(Formatting_Operations.Time_Of): Change the way four year chunks of
+	nanoseconds are added to the intermediate result.
+
+2009-04-15  Nicolas Setton  <setton@adacore.com>
+
+	* sysdep.c: Add __APPLE__ in the list of systems where get_immediate
+	does not need to wait for a carriage return.
+
+2009-04-15  Tristan Gingold  <gingold@adacore.com>
+
+	* bindgen.adb: Do not generate adafinal if No_Finalization restriction
+	is set.
+
+2009-04-15  Ed Schonberg  <schonberg@adacore.com>
+
+	* freeze.adb (Freeze_Entity): improve error message for improper use of
+	incomplete types.
+	Diagnose additional illegal uses of incomplete types in formal parts.
+	appearing in formal parts.
+
+	* sem_ch6.adb (Process_Formals, Analyze_Return_Type): ditto.
+
+2009-04-15  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Allocator): Install test for object too large.
+
 2009-04-15  Nicolas Roche  <roche@adacore.com>
 
 	* adaint.c: Add function __gnat_lwp_self that retrieves the LWP of the

gcc/ada/a-calend.adb

@@ -148,6 +148,7 @@ package body Ada.Calendar is
    Ada_Min_Year          : constant Year_Number := Year_Number'First;
    Secs_In_Four_Years    : constant := (3 * 365 + 366) * Secs_In_Day;
    Secs_In_Non_Leap_Year : constant := 365 * Secs_In_Day;
+   Nanos_In_Four_Years   : constant := Secs_In_Four_Years * Nano;
 
    --  Lower and upper bound of Ada time. The zero (0) value of type Time is
    --  positioned at year 2150. Note that the lower and upper bound account
@@ -1317,7 +1318,9 @@ package body Ada.Calendar is
          --  the input date.
 
          Count := (Year - Year_Number'First) / 4;
-         Res_N := Res_N + Time_Rep (Count) * Secs_In_Four_Years * Nano;
+         for Four_Year_Segments in 1 .. Count loop
+            Res_N := Res_N + Nanos_In_Four_Years;
+         end loop;
 
          --  Note that non-leap centennial years are automatically considered
          --  leap in the operation above. An adjustment of several days is

gcc/ada/bindgen.adb

@@ -2332,10 +2332,13 @@ package body Bindgen is
             """__gnat_ada_main_program_name"");");
       end if;
 
-      WBI ("");
-      WBI ("   procedure " & Ada_Final_Name.all & ";");
-      WBI ("   pragma Export (C, " & Ada_Final_Name.all & ", """ &
-           Ada_Final_Name.all & """);");
+      if not Cumulative_Restrictions.Set (No_Finalization) then
+         WBI ("");
+         WBI ("   procedure " & Ada_Final_Name.all & ";");
+         WBI ("   pragma Export (C, " & Ada_Final_Name.all & ", """ &
+              Ada_Final_Name.all & """);");
+      end if;
+
       WBI ("");
       WBI ("   procedure " & Ada_Init_Name.all & ";");
       WBI ("   pragma Export (C, " & Ada_Init_Name.all & ", """ &
@@ -2507,7 +2510,11 @@ package body Bindgen is
 
       Gen_Adainit_Ada;
 
-      Gen_Adafinal_Ada;
+      --  Generate the adafinal routine unless there is no finalization to do.
+
+      if not Cumulative_Restrictions.Set (No_Finalization) then
+         Gen_Adafinal_Ada;
+      end if;
 
       if Bind_Main_Program and then VM_Target = No_VM then
 

gcc/ada/exp_ch4.adb

@@ -2935,6 +2935,11 @@ package body Exp_Ch4 is
       --  constrain. Such occurrences can be rewritten as aliased objects
       --  and their unrestricted access used instead of the coextension.
 
+      function Size_In_Storage_Elements (E : Entity_Id) return Node_Id;
+      --  Given a type E, returns a node representing the code to compute the
+      --  size in storage elements for the given type. This is not as trivial
+      --  as one might expect, as explained in the body.
+
       ---------------------------------------
       -- Complete_Coextension_Finalization --
       ---------------------------------------
@@ -3031,8 +3036,10 @@ package body Exp_Ch4 is
 
                      --  Retrieve the declaration of the body
 
-                     Decl := Parent (Parent (
-                               Corresponding_Body (Parent (Parent (S)))));
+                     Decl :=
+                       Parent
+                         (Parent
+                            (Corresponding_Body (Parent (Parent (S)))));
                      exit;
                   end if;
 
@@ -3161,6 +3168,74 @@ package body Exp_Ch4 is
          Analyze_And_Resolve (N, PtrT);
       end Rewrite_Coextension;
 
+      ------------------------------
+      -- Size_In_Storage_Elements --
+      ------------------------------
+
+      function Size_In_Storage_Elements (E : Entity_Id) return Node_Id is
+      begin
+         --  Logically this just returns E'Max_Size_In_Storage_Elements.
+         --  However, the reason for the existence of this function is
+         --  to construct a test for sizes too large, which means near the
+         --  32-bit limit on a 32-bit machine, and precisely the trouble
+         --  is that we get overflows when sizes are greater than 2**31.
+
+         --  So what we end up doing is using this expression for non-array
+         --  types, where it is not quite right, but should be good enough
+         --  most of the time. But for non-packed arrays, instead we compute
+         --  the expression:
+
+         --    number-of-elements * component_type'Max_Size_In_Storage_Elements
+
+         --  which avoids this problem. All this is a big bogus, but it does
+         --  mean we catch common cases of trying to allocate arrays that
+         --  are too large, and which in the absence of a check results in
+         --  undetected chaos ???
+
+         if Is_Array_Type (E) and then Is_Constrained (E) then
+            declare
+               Len : Node_Id;
+               Res : Node_Id;
+
+            begin
+               for J in 1 .. Number_Dimensions (E) loop
+                  Len :=
+                    Make_Attribute_Reference (Loc,
+                      Prefix         => New_Occurrence_Of (E, Loc),
+                      Attribute_Name => Name_Length,
+                      Expressions    => New_List (
+                        Make_Integer_Literal (Loc, J)));
+
+                  if J = 1 then
+                     Res := Len;
+
+                  else
+                     Res :=
+                       Make_Op_Multiply (Loc,
+                         Left_Opnd  => Res,
+                         Right_Opnd => Len);
+                  end if;
+               end loop;
+
+               return
+                 Make_Op_Multiply (Loc,
+                   Left_Opnd  => Len,
+                   Right_Opnd =>
+                     Make_Attribute_Reference (Loc,
+                       Prefix => New_Occurrence_Of (Component_Type (E), Loc),
+                       Attribute_Name => Name_Max_Size_In_Storage_Elements));
+            end;
+
+            --  Here for other than non-bit-packed array
+
+         else
+            return
+              Make_Attribute_Reference (Loc,
+                Prefix         => New_Occurrence_Of (E, Loc),
+                Attribute_Name => Name_Max_Size_In_Storage_Elements);
+         end if;
+      end Size_In_Storage_Elements;
+
    --  Start of processing for Expand_N_Allocator
 
    begin
@@ -3272,6 +3347,36 @@ package body Exp_Ch4 is
          Complete_Coextension_Finalization;
       end if;
 
+      --  Check for size too large, we do this because the back end misses
+      --  proper checks here and can generate rubbish allocation calls when
+      --  we are near the limit. We only do this for the 32-bit address case
+      --  since that is from a practical point of view where we see a problem.
+
+      if System_Address_Size = 32
+        and then not Storage_Checks_Suppressed (PtrT)
+        and then not Storage_Checks_Suppressed (Dtyp)
+        and then not Storage_Checks_Suppressed (Etyp)
+      then
+         --  The check we want to generate should look like
+
+         --  if Etyp'Max_Size_In_Storage_Elements > 3.5 gigabytes then
+         --    raise Storage_Error;
+         --  end if;
+
+         --  where 3.5 gigabytes is a constant large enough to accomodate
+         --  any reasonable request for
+
+         Insert_Action (N,
+           Make_Raise_Storage_Error (Loc,
+             Condition =>
+               Make_Op_Gt (Loc,
+                 Left_Opnd => Size_In_Storage_Elements (Etyp),
+                 Right_Opnd =>
+                   Make_Integer_Literal (Loc,
+                     Intval => Uint_7 * (Uint_2 ** 29))),
+             Reason    => SE_Object_Too_Large));
+      end if;
+
       --  Handle case of qualified expression (other than optimization above)
 
       if Nkind (Expression (N)) = N_Qualified_Expression then

gcc/ada/freeze.adb

@@ -2606,10 +2606,10 @@ package body Freeze is
                           ("?foreign convention function& should not " &
                            "return unconstrained array!", E);
 
-                     --  Ada 2005 (AI-326): Check wrong use of tagged
+                     --  Ada 2005 (AI-326): Check wrong use of
                      --  incomplete type
 
-                     --    type T is tagged;
+                     --    type T;   --  tagged or just incomplete.
                      --    function F (X : Boolean) return T; -- ERROR
 
                      --  The type must be declared in the current scope for the
@@ -2617,13 +2617,11 @@ package body Freeze is
                      --  when the construct that mentions it is frozen.
 
                      elsif Ekind (Etype (E)) = E_Incomplete_Type
-                       and then Is_Tagged_Type (Etype (E))
                        and then No (Full_View (Etype (E)))
                        and then not Is_Value_Type (Etype (E))
                      then
-                        Error_Msg_N
-                          ("(Ada 2005): invalid use of tagged incomplete type",
-                            E);
+                        Error_Msg_NE
+                          ("invalid use of incomplete type&", E, Etype (E));
                      end if;
                   end if;
                end;
@@ -3510,10 +3508,25 @@ package body Freeze is
 
          --  For access subprogram, freeze types of all formals, the return
          --  type was already frozen, since it is the Etype of the function.
+         --  Formal types can be tagged Taft amendment types, but otherwise
+         --  they cannot be incomplete;
 
          elsif Ekind (E) = E_Subprogram_Type then
             Formal := First_Formal (E);
+
             while Present (Formal) loop
+               if Ekind (Etype (Formal)) = E_Incomplete_Type
+                 and then No (Full_View (Etype (Formal)))
+                 and then not Is_Value_Type (Etype (Formal))
+               then
+                  if Is_Tagged_Type (Etype (Formal)) then
+                     null;
+                  else
+                     Error_Msg_NE
+                       ("invalid use of incomplete type&", E, Etype (Formal));
+                  end if;
+               end if;
+
                Freeze_And_Append (Etype (Formal), Loc, Result);
                Next_Formal (Formal);
             end loop;
@@ -3522,16 +3535,15 @@ package body Freeze is
 
             --  Ada 2005 (AI-326): Check wrong use of tag incomplete type
 
-            --    type T is tagged;
+            --    type T;  --   tagged or untagged, may be from limited view;
             --    type Acc is access function (X : T) return T; -- ERROR
 
             if Ekind (Etype (E)) = E_Incomplete_Type
-              and then Is_Tagged_Type (Etype (E))
               and then No (Full_View (Etype (E)))
               and then not Is_Value_Type (Etype (E))
             then
-               Error_Msg_N
-                 ("(Ada 2005): invalid use of tagged incomplete type", E);
+               Error_Msg_NE
+                 ("invalid use of incomplete type&", E, Etype (E));
             end if;
 
          --  For access to a protected subprogram, freeze the equivalent type
@@ -3557,12 +3569,11 @@ package body Freeze is
                end if;
 
                if Ekind (Etyp) = E_Incomplete_Type
-                 and then Is_Tagged_Type (Etyp)
                  and then No (Full_View (Etyp))
                  and then not Is_Value_Type (Etype (E))
                then
-                  Error_Msg_N
-                    ("(Ada 2005): invalid use of tagged incomplete type", E);
+                  Error_Msg_NE
+                    ("invalid use of incomplete type&", E, Etyp);
                end if;
             end;
 

gcc/ada/sem_ch6.adb

@@ -1326,8 +1326,8 @@ package body Sem_Ch6 is
                          and then
                            Ekind (Root_Type (Typ)) = E_Incomplete_Type)
             then
-               Error_Msg_N
-                 ("invalid use of incomplete type", Result_Definition (N));
+               Error_Msg_NE
+                 ("invalid use of incomplete type&", Designator, Typ);
             end if;
          end if;
 
@@ -7719,15 +7719,13 @@ package body Sem_Ch6 is
                elsif not Nkind_In (Parent (T), N_Access_Function_Definition,
                                                N_Access_Procedure_Definition)
                then
-                  Error_Msg_N ("invalid use of incomplete type", Param_Spec);
-
-               --  An incomplete type that is not tagged is allowed in an
-               --  access-to-subprogram type only if it is a local declaration
-               --  with a forthcoming completion (3.10.1 (9.2/2)).
+                  Error_Msg_NE
+                    ("invalid use of incomplete type&",
+                       Param_Spec, Formal_Type);
 
-               elsif Scope (Formal_Type) /= Scope (Current_Scope) then
-                  Error_Msg_N
-                    ("invalid use of limited view of type", Param_Spec);
+                  --  Further checks on the legality of incomplete types
+                  --  in formal parts must be delayed until the freeze point
+                  --  of the enclosing subprogram or access to subprogram.
                end if;
 
             elsif Ekind (Formal_Type) = E_Void then

gcc/ada/sysdep.c

@@ -348,7 +348,7 @@ __gnat_ttyname (int filedes)
   || defined (__MACHTEN__) || defined (__hpux__) || defined (_AIX) \
   || (defined (__svr4__) && defined (i386)) || defined (__Lynx__) \
   || defined (__CYGWIN__) || defined (__FreeBSD__) || defined (__OpenBSD__) \
-  || defined (__GLIBC__)
+  || defined (__GLIBC__) || defined (__APPLE__)
 
 #ifdef __MINGW32__
 #if OLD_MINGW
@@ -406,7 +406,7 @@ getc_immediate_common (FILE *stream,
     || defined (__CYGWIN32__) || defined (__MACHTEN__) || defined (__hpux__) \
     || defined (_AIX) || (defined (__svr4__) && defined (i386)) \
     || defined (__Lynx__) || defined (__FreeBSD__) || defined (__OpenBSD__) \
-    || defined (__GLIBC__)
+    || defined (__GLIBC__) || defined (__APPLE__)
   char c;
   int nread;
   int good_one = 0;
@@ -426,7 +426,7 @@ getc_immediate_common (FILE *stream,
     || defined (__osf__) || defined (__MACHTEN__) || defined (__hpux__) \
     || defined (_AIX) || (defined (__svr4__) && defined (i386)) \
     || defined (__Lynx__) || defined (__FreeBSD__) || defined (__OpenBSD__) \
-    || defined (__GLIBC__)
+    || defined (__GLIBC__) || defined (__APPLE__)
       eof_ch = termios_rec.c_cc[VEOF];
 
       /* If waiting (i.e. Get_Immediate (Char)), set MIN = 1 and wait for