From 8aec446b9825afac7364819ffa8ea00307fbaaff Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 15 Apr 2009 12:26:33 +0200 Subject: [PATCH] [multiple changes] 2009-04-15 Hristian Kirtchev * 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 * 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 * bindgen.adb: Do not generate adafinal if No_Finalization restriction is set. 2009-04-15 Ed Schonberg * 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 * exp_ch4.adb (Expand_N_Allocator): Install test for object too large. From-SVN: r146098 --- gcc/ada/ChangeLog | 29 ++++++++++++ gcc/ada/a-calend.adb | 5 +- gcc/ada/bindgen.adb | 17 +++++-- gcc/ada/exp_ch4.adb | 109 ++++++++++++++++++++++++++++++++++++++++++- gcc/ada/freeze.adb | 37 +++++++++------ gcc/ada/sem_ch6.adb | 18 ++++--- gcc/ada/sysdep.c | 6 +-- 7 files changed, 187 insertions(+), 34 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5b7a12dba2d8..cb212e69e059 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2009-04-15 Hristian Kirtchev + + * 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 + + * 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 + + * bindgen.adb: Do not generate adafinal if No_Finalization restriction + is set. + +2009-04-15 Ed Schonberg + + * 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 + + * exp_ch4.adb (Expand_N_Allocator): Install test for object too large. + 2009-04-15 Nicolas Roche * adaint.c: Add function __gnat_lwp_self that retrieves the LWP of the diff --git a/gcc/ada/a-calend.adb b/gcc/ada/a-calend.adb index a2759b53a897..7e785116f027 100644 --- a/gcc/ada/a-calend.adb +++ b/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 diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 6f6b557ca1db..cc4c6ddfa5df 100644 --- a/gcc/ada/bindgen.adb +++ b/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 diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 27bc6c6e7e0b..978225e4b947 100644 --- a/gcc/ada/exp_ch4.adb +++ b/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 diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 31b41d51470e..88ea26929cc0 100644 --- a/gcc/ada/freeze.adb +++ b/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; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index c206c4b3ebae..23ed091c2749 100644 --- a/gcc/ada/sem_ch6.adb +++ b/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); + Error_Msg_NE + ("invalid use of incomplete type&", + Param_Spec, Formal_Type); - -- 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)). - - 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 diff --git a/gcc/ada/sysdep.c b/gcc/ada/sysdep.c index a0fd4b0a1157..56f3ebd3b0f5 100644 --- a/gcc/ada/sysdep.c +++ b/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