diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5f3d5c56257..2756c8cecc9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2009-04-17 Thomas Quinot + + * exp_ch7.adb: Minor reformatting + +2009-04-17 Robert Dewar + + * restrict.adb (Check_Restriction_No_Dependence): Don't check + restriction if outside main extended source unit. + + * sem_ch10.adb (Analyze_With_Clause): Check No_Dependence restriction + for parents of child units as well as the child unit itself. + +2009-04-17 Bob Duff + + * checks.ads: Minor comment fix + + * exp_aggr.ads: Minor comment fix + +2009-04-17 Nicolas Roche + + * adaint.c: Improve cross compiler detection and handling. + 2009-04-17 Eric Botcazou * exp_ch4.adb (Expand_Concatenation): Do not use calls at -Os. diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 1b6bb7ff67b..3ac773dacc3 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -237,9 +237,11 @@ struct vstring #endif /* Check for cross-compilation */ -#ifdef CROSS_DIRECTORY_STRUCTURE +#if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE) +#define IS_CROSS 1 int __gnat_is_cross_compiler = 1; #else +#undef IS_CROSS int __gnat_is_cross_compiler = 0; #endif @@ -664,7 +666,7 @@ __gnat_os_filename (char *filename, char *w_filename ATTRIBUTE_UNUSED, char *os_name, int *o_length, char *encoding ATTRIBUTE_UNUSED, int *e_length) { -#if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE) +#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) WS2SC (os_name, (TCHAR *)w_filename, o_length); *o_length = strlen (os_name); strcpy (encoding, "encoding=utf8"); @@ -681,7 +683,7 @@ __gnat_os_filename (char *filename, char *w_filename ATTRIBUTE_UNUSED, int __gnat_unlink (char *path) { -#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (CROSS_COMPILE) +#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS) { TCHAR wpath[GNAT_MAX_PATH_LEN]; @@ -698,7 +700,7 @@ __gnat_unlink (char *path) int __gnat_rename (char *from, char *to) { -#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (CROSS_COMPILE) +#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS) { TCHAR wfrom[GNAT_MAX_PATH_LEN], wto[GNAT_MAX_PATH_LEN]; @@ -716,7 +718,7 @@ __gnat_rename (char *from, char *to) int __gnat_chdir (char *path) { -#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (CROSS_COMPILE) +#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS) { TCHAR wpath[GNAT_MAX_PATH_LEN]; @@ -733,7 +735,7 @@ __gnat_chdir (char *path) int __gnat_rmdir (char *path) { -#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (CROSS_COMPILE) +#if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS) { TCHAR wpath[GNAT_MAX_PATH_LEN]; @@ -748,7 +750,7 @@ __gnat_rmdir (char *path) FILE * __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED) { -#if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE) +#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) TCHAR wpath[GNAT_MAX_PATH_LEN]; TCHAR wmode[10]; @@ -772,7 +774,7 @@ __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED) FILE * __gnat_freopen (char *path, char *mode, FILE *stream, int encoding ATTRIBUTE_UNUSED) { -#if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE) +#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) TCHAR wpath[GNAT_MAX_PATH_LEN]; TCHAR wmode[10]; @@ -1578,7 +1580,8 @@ __gnat_get_libraries_from_registry (void) { char *result = (char *) ""; -#if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE) && ! defined (RTX) +#if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) \ + && ! defined (RTX) HKEY reg_key; DWORD name_size, value_size; @@ -3178,7 +3181,7 @@ _flush_cache() } #endif -#if defined (CROSS_DIRECTORY_STRUCTURE) \ +#if defined (IS_CROSS) \ || (! ((defined (sparc) || defined (i386)) && defined (sun) \ && defined (__SVR4)) \ && ! (defined (linux) && (defined (i386) || defined (__x86_64__))) \ diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads index 07ac2722549..e0cc54d0936 100644 --- a/gcc/ada/checks.ads +++ b/gcc/ada/checks.ads @@ -135,9 +135,9 @@ package Checks is Typ : Entity_Id; No_Sliding : Boolean := False); -- Top-level procedure, calls all the others depending on the class of Typ. - -- Checks that expression N verifies the constraint of type Typ. No_Sliding - -- is only relevant for constrained array types, if set to True, it - -- checks that indexes are in range. + -- Checks that expression N satisfies the constraint of type Typ. + -- No_Sliding is only relevant for constrained array types, if set to True, + -- it checks that indexes are in range. procedure Apply_Discriminant_Check (N : Node_Id; diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads index 8f9f9630a25..0b024fc2b8d 100644 --- a/gcc/ada/exp_aggr.ads +++ b/gcc/ada/exp_aggr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2009, 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- -- @@ -45,7 +45,7 @@ package Exp_Aggr is Aggr : Node_Id); -- Alloc is the allocator whose expression is the aggregate Aggr. -- Decl is an N_Object_Declaration created during allocator expansion. - -- This procedure perform in-place aggregate assignment into the + -- This procedure performs in-place aggregate assignment into the -- temporary declared in Decl, and the allocator becomes an access to -- that temporary. diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index b46d577625a..acd7887089d 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -1371,36 +1371,36 @@ package body Exp_Ch7 is end if; -- Resolution is now finished, make sure we don't start analysis again - -- because of the duplication + -- because of the duplication. Set_Analyzed (N); Ref := Duplicate_Subexpr_No_Checks (N); - -- Now we can generate the Attach Call, note that this value is - -- always in the (secondary) stack and thus is attached to a singly - -- linked final list: + -- Now we can generate the Attach Call. Note that this value is always + -- on the (secondary) stack and thus is attached to a singly linked + -- final list: -- Resx := F (X)'reference; -- Attach_To_Final_List (_Lx, Resx.all, 1); - -- or when there are controlled components + -- or when there are controlled components: -- Attach_To_Final_List (_Lx, Resx._controller, 1); - -- or when it is both is_controlled and has_controlled_components + -- or when it is both Is_Controlled and Has_Controlled_Components: -- Attach_To_Final_List (_Lx, Resx._controller, 1); -- Attach_To_Final_List (_Lx, Resx, 1); - -- or if it is an array with is_controlled (and has_controlled) + -- or if it is an array with Is_Controlled (and Has_Controlled) -- Attach_To_Final_List (_Lx, Resx (Resx'last), 3); - -- An attach level of 3 means that a whole array is to be - -- attached to the finalization list (including the controlled - -- components) - -- or if it is an array with has_controlled components but not - -- is_controlled + -- An attach level of 3 means that a whole array is to be attached to + -- the finalization list (including the controlled components). + + -- or if it is an array with Has_Controlled_Components but not + -- Is_Controlled: -- Attach_To_Final_List (_Lx, Resx (Resx'last)._controller, 3); @@ -1466,8 +1466,8 @@ package body Exp_Ch7 is end if; end; - -- Here we know that 'Ref' has a controller so we may as well - -- attach it directly + -- Here we know that 'Ref' has a controller so we may as well attach + -- it directly. Action := Make_Attach_Call ( @@ -1485,12 +1485,12 @@ package body Exp_Ch7 is With_Attach => Make_Integer_Literal (Loc, Attach_Level)); end if; - -- Here, we have a controlled type that does not seem to have - -- controlled components but it could be a class wide type whose - -- further derivations have controlled components. So we don't know - -- if the object itself needs to be attached or if it has a record - -- controller. We need to call a runtime function (Deep_Tag_Attach) - -- which knows what to do thanks to the RC_Offset in the dispatch table. + -- Here, we have a controlled type that does not seem to have controlled + -- components but it could be a class wide type whose further + -- derivations have controlled components. So we don't know if the + -- object itself needs to be attached or if it has a record controller. + -- We need to call a runtime function (Deep_Tag_Attach) which knows what + -- to do thanks to the RC_Offset in the dispatch table. else Action := diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index c883e0a8963..a57ac4c66ee 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -316,6 +316,15 @@ package body Restrict is DU : Node_Id; begin + -- Ignore call if node U is not in the main source unit. This avoids + -- cascaded errors, e.g. when Ada.Containers units with other units. + + if not In_Extended_Main_Source_Unit (U) then + return; + end if; + + -- Loop through entries in No_Dependence table to check each one in turn + for J in No_Dependence.First .. No_Dependence.Last loop DU := No_Dependence.Table (J).Unit; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index a5a25fd8a79..b72c1d291cb 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -2405,6 +2405,8 @@ package body Sem_Ch10 is Set_Entity_With_Style_Check (Name (N), E_Name); Generate_Reference (E_Name, Name (N), 'w', Set_Ref => False); + -- Generate references and check No_Dependence restriction for parents + if Is_Child_Unit (E_Name) then Pref := Prefix (Name (N)); Par_Name := Scope (E_Name); @@ -2413,6 +2415,7 @@ package body Sem_Ch10 is Set_Entity_With_Style_Check (Pref, Par_Name); Generate_Reference (Par_Name, Pref); + Check_Restriction_No_Dependence (Pref, N); Pref := Prefix (Pref); -- If E_Name is the dummy entity for a nonexistent unit, its scope