From 07aff4e355ed0d2c6a360a4d587855f4cec530de Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 20 Feb 2015 12:38:17 +0100 Subject: [PATCH] [multiple changes] 2015-02-20 Yannick Moy * sem_prag.ads: Minor typo in comment. 2015-02-20 Pascal Obry * s-osprim-mingw.adb: Fix Get_Base_Time parameter mode. 2015-02-20 Vincent Celier * makeutl.adb (Get_Directories.Add_Dir): Add a directory only if it exists. 2015-02-20 Robert Dewar * sem_eval.ads: Minor reformatting. 2015-02-20 Eric Botcazou * freeze.adb (Size_Known): Do not set the packed size for independent type or component. (Freeze_Array_Type): Check for Independent[_Components] with packing or explicit component size clause. * gnat1drv.adb (Post_Compilation_Validation_Checks): Do the validation of independence pragmas only for non-GCC back-ends. * sem_ch13.adb (Initialize): Likewise for the initialization. * sem_prag.adb (Record_Independence_Check): New procedure to record an independence check in the table. (Analyze_Pragma): Use it throughout instead of doing it manually. * gcc-interface/decl.c (gnat_to_gnu_field): Add support for independent type or component. 2015-02-20 Thomas Quinot * adaint.c (__gnat_readdir): For Solaris, use 64 bit variants of struct direct and readdir. This is required for NFS filesystems mounted from servers that use 64-bit cookies. 2015-02-20 Ed Schonberg * sem_ch12.adb (Analyze_Subprogram_Instantiaion): New subprogram Build_Subprogram_Renaming, to create renaming of subprogram instance in the the declaration of the wrapper package rather than in its body, so that it is available for analysis of aspects propagated from generic to instantiation. (Check_Mismatch): An actual for a formal package that is an incomplete type matches a formal type that is incomplete. (Instantiate_Package_Body): Move code that builds subprogram renaming to Analyze_Subprogram_Instantiation. (Instantiate_Type): The generated subtype is a limited view if the actual is a limited view. (Load_Parent_Of_Generic): Retrieve instance declaration from its new position within wrapper package. 2015-02-20 Arnaud Charlet * s-parame-vxworks.adb, s-os_lib.ads: Update comments. 2015-02-20 Robert Dewar * s-osinte-vxworks.ads (To_Timespec): Add comment about the issue of negative arguments. From-SVN: r220850 --- gcc/ada/ChangeLog | 63 ++++++++++++++++++ gcc/ada/adaint.c | 12 +++- gcc/ada/freeze.adb | 67 ++++++++++++++++++- gcc/ada/gcc-interface/decl.c | 30 ++++++--- gcc/ada/gnat1drv.adb | 10 ++- gcc/ada/makeutl.adb | 6 +- gcc/ada/s-os_lib.ads | 4 +- gcc/ada/s-osinte-vxworks.ads | 8 ++- gcc/ada/s-osprim-mingw.adb | 4 +- gcc/ada/s-parame-vxworks.adb | 4 +- gcc/ada/sem_ch12.adb | 153 ++++++++++++++++++++++++++++--------------- gcc/ada/sem_ch13.adb | 5 +- gcc/ada/sem_eval.ads | 4 +- gcc/ada/sem_prag.adb | 27 ++++++-- gcc/ada/sem_prag.ads | 4 +- 15 files changed, 314 insertions(+), 87 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e826f4e..c06fb21 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,66 @@ +2015-02-20 Yannick Moy + + * sem_prag.ads: Minor typo in comment. + +2015-02-20 Pascal Obry + + * s-osprim-mingw.adb: Fix Get_Base_Time parameter mode. + +2015-02-20 Vincent Celier + + * makeutl.adb (Get_Directories.Add_Dir): Add a directory only + if it exists. + +2015-02-20 Robert Dewar + + * sem_eval.ads: Minor reformatting. + +2015-02-20 Eric Botcazou + + * freeze.adb (Size_Known): Do not set the packed size for + independent type or component. + (Freeze_Array_Type): Check for Independent[_Components] with packing + or explicit component size clause. + * gnat1drv.adb (Post_Compilation_Validation_Checks): Do the validation + of independence pragmas only for non-GCC back-ends. + * sem_ch13.adb (Initialize): Likewise for the initialization. + * sem_prag.adb (Record_Independence_Check): New procedure to record an + independence check in the table. + (Analyze_Pragma): Use it throughout instead of doing it manually. + * gcc-interface/decl.c (gnat_to_gnu_field): Add support for + independent type or component. + +2015-02-20 Thomas Quinot + + * adaint.c (__gnat_readdir): For Solaris, use 64 bit variants of + struct direct and readdir. This is required for NFS filesystems + mounted from servers that use 64-bit cookies. + +2015-02-20 Ed Schonberg + + * sem_ch12.adb (Analyze_Subprogram_Instantiaion): New subprogram + Build_Subprogram_Renaming, to create renaming of subprogram + instance in the the declaration of the wrapper package rather + than in its body, so that it is available for analysis of aspects + propagated from generic to instantiation. + (Check_Mismatch): An actual for a formal package that is an + incomplete type matches a formal type that is incomplete. + (Instantiate_Package_Body): Move code that builds subprogram + renaming to Analyze_Subprogram_Instantiation. + (Instantiate_Type): The generated subtype is a limited view if + the actual is a limited view. + (Load_Parent_Of_Generic): Retrieve instance declaration from + its new position within wrapper package. + +2015-02-20 Arnaud Charlet + + * s-parame-vxworks.adb, s-os_lib.ads: Update comments. + +2015-02-20 Robert Dewar + + * s-osinte-vxworks.ads (To_Timespec): Add comment about the + issue of negative arguments. + 2015-02-20 Eric Botcazou * gnat1drv.adb: Minor consistency fix. diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index ab74ce0..d9bccfe 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2014, Free Software Foundation, Inc. * + * Copyright (C) 1992-2015, 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- * @@ -297,7 +297,8 @@ int max_path_len = GNAT_MAX_PATH_LEN; int __gnat_use_acl = 1; /* The following macro HAVE_READDIR_R should be defined if the - system provides the routine readdir_r. */ + system provides the routine readdir_r. + ... but we never define it anywhere??? */ #undef HAVE_READDIR_R #define MAYBE_TO_PTR32(argv) argv @@ -1223,6 +1224,13 @@ DIR* __gnat_opendir (char *name) /* Read the next entry in a directory. The returned string points somewhere in the buffer. */ +#if defined (sun) && defined (__SVR4) +/* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may + fail with EOVERFLOW if the server uses 64-bit cookies. */ +#define dirent dirent64 +#define readdir readdir64 +#endif + char * __gnat_readdir (DIR *dirp, char *buffer, int *len) { diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 2864fb1..aa3c52b 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -944,12 +944,15 @@ package body Freeze is Packed_Size_Known := False; end if; - -- We do not know the packed size if we have a by reference - -- type, or an atomic type or an atomic component, or an - -- aliased component (because packing does not touch these). + -- We do not know the packed size if we have an atomic type + -- or component, or an independent type or component, or a + -- by reference type or aliased component (because packing + -- does not touch these). if Is_Atomic (Ctyp) or else Is_Atomic (Comp) + or else Is_Independent (Ctyp) + or else Is_Independent (Comp) or else Is_By_Reference_Type (Ctyp) or else Is_Aliased (Comp) then @@ -2500,6 +2503,64 @@ package body Freeze is end Alias_Atomic_Check; end if; + -- Check for Independent_Components/Independent with unsuitable + -- packing or explicit component size clause given. + + if (Has_Independent_Components (Arr) or else Is_Independent (Ctyp)) + and then + (Has_Component_Size_Clause (Arr) or else Is_Packed (Arr)) + then + begin + -- If object size of component type isn't known, we cannot + -- be sure so we defer to the back end. + + if not Known_Static_Esize (Ctyp) then + null; + + -- Case where component size has no effect. First check for + -- object size of component type multiple of the storage + -- unit size. + + elsif Esize (Ctyp) mod System_Storage_Unit = 0 + + -- OK in both packing case and component size case if RM + -- size is known and multiple of the storage unit size. + + and then + ((Known_Static_RM_Size (Ctyp) + and then RM_Size (Ctyp) mod System_Storage_Unit = 0) + + -- Or if we have an explicit component size clause and + -- the component size is larger than the object size. + + or else + (Has_Component_Size_Clause (Arr) + and then Component_Size (Arr) >= Esize (Ctyp))) + then + null; + + else + if Has_Component_Size_Clause (Arr) then + Clause := + Get_Attribute_Definition_Clause + (FS, Attribute_Component_Size); + + Error_Msg_N + ("incorrect component size for " + & "independent components", Clause); + Error_Msg_Uint_1 := Esize (Ctyp); + Error_Msg_N + ("\minimum allowed is^", Clause); + + else + Error_Msg_N + ("cannot pack independent components", + Get_Rep_Pragma (FS, Name_Pack)); + end if; + end if; + end; + end if; + -- Warn for case of atomic type Clause := Get_Rep_Pragma (FS, Name_Atomic); diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 94043b6..c0ca2f3 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -6427,17 +6427,22 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, bool definition, bool debug_info_p) { const Entity_Id gnat_field_type = Etype (gnat_field); - tree gnu_field_type = gnat_to_gnu_type (gnat_field_type); - tree gnu_field_id = get_entity_name (gnat_field); - tree gnu_field, gnu_size, gnu_pos; - bool is_aliased + const bool is_aliased = Is_Aliased (gnat_field); - bool is_atomic + const bool is_atomic = (Is_Atomic (gnat_field) || Is_Atomic (gnat_field_type)); - bool is_volatile + const bool is_independent + = (Is_Independent (gnat_field) || Is_Independent (gnat_field_type)); + const bool is_volatile = (Treat_As_Volatile (gnat_field) || Treat_As_Volatile (gnat_field_type)); - bool needs_strict_alignment - = (is_aliased || is_volatile || Strict_Alignment (gnat_field_type)); + const bool needs_strict_alignment + = (is_aliased + || is_independent + || is_volatile + || Strict_Alignment (gnat_field_type)); + tree gnu_field_type = gnat_to_gnu_type (gnat_field_type); + tree gnu_field_id = get_entity_name (gnat_field); + tree gnu_field, gnu_size, gnu_pos; /* If this field requires strict alignment, we cannot pack it because it would very likely be under-aligned in the record. */ @@ -6555,6 +6560,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, s = "position of atomic field& must be multiple of ^ bits"; else if (is_aliased) s = "position of aliased field& must be multiple of ^ bits"; + else if (is_independent) + s = "position of independent field& must be multiple of ^ bits"; else if (is_volatile) s = "position of volatile field& must be multiple of ^ bits"; else if (Strict_Alignment (gnat_field_type)) @@ -6583,6 +6590,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, s = "size of atomic field& must be ^ bits"; else if (is_aliased) s = "size of aliased field& must be ^ bits"; + else if (is_independent) + s = "size of independent field& must be at least ^ bits"; else if (is_volatile) s = "size of volatile field& must be at least ^ bits"; else if (Strict_Alignment (gnat_field_type)) @@ -6602,7 +6611,10 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed, { const char *s; - if (is_volatile) + if (is_independent) + s = "size of independent field& must be multiple of" + " Storage_Unit"; + else if (is_volatile) s = "size of volatile field& must be multiple of" " Storage_Unit"; else if (Strict_Alignment (gnat_field_type)) diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index b572bc4..f210fcb 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -833,10 +833,14 @@ procedure Gnat1drv is Sem_Ch13.Validate_Address_Clauses; - -- Validate independence pragmas (again using values annotated by - -- the back end for component layout etc.) + -- Validate independence pragmas (again using values annotated by the + -- back end for component layout where possible) but only for non-GCC + -- back ends, as this is done a priori for GCC back ends. + + if VM_Target /= No_VM or else AAMP_On_Target then + Sem_Ch13.Validate_Independence; + end if; - Sem_Ch13.Validate_Independence; end Post_Compilation_Validation_Checks; -- Start of processing for Gnat1drv diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 5960d3e..997cbf0 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2015, 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- -- @@ -897,7 +897,9 @@ package body Makeutl is Add_It : Boolean := True; begin - if Value /= No_Path then + if Value /= No_Path + and then Is_Directory (Get_Name_String (Value)) + then for Index in 1 .. Directories.Last loop if Directories.Table (Index) = Value then Add_It := False; diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads index d285fd4..abffa53 100644 --- a/gcc/ada/s-os_lib.ads +++ b/gcc/ada/s-os_lib.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1995-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2015, 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- -- @@ -910,7 +910,7 @@ package System.OS_Lib is -- On other Unix-like systems: fork, followed in the child -- process by execv. - -- On vxworks, nucleus, and RTX, spawning of processes is not supported + -- On vxworks, spawning of processes is not supported -- For details, look at the functions __gnat_portable_spawn and -- __gnat_portable_no_block_spawn in adaint.c. diff --git a/gcc/ada/s-osinte-vxworks.ads b/gcc/ada/s-osinte-vxworks.ads index 777c381..e398084 100644 --- a/gcc/ada/s-osinte-vxworks.ads +++ b/gcc/ada/s-osinte-vxworks.ads @@ -7,7 +7,7 @@ -- S p e c -- -- -- -- Copyright (C) 1991-1994, Florida State University -- --- Copyright (C) 1995-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2015, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -252,6 +252,12 @@ package System.OS_Interface is function To_Timespec (D : Duration) return timespec; pragma Inline (To_Timespec); + -- Convert a Duration value to a timespec value. Note that in VxWorks, + -- timespec is always non-negative (since time_t is defined above as + -- unsigned long). This means that there is a potential problem if a + -- negative argument is passed for D. However, in actual usage, the + -- value of the input argument D is always non-negative, so no problem + -- arises in practice. function To_Clock_Ticks (D : Duration) return int; -- Convert a duration value (in seconds) into clock ticks diff --git a/gcc/ada/s-osprim-mingw.adb b/gcc/ada/s-osprim-mingw.adb index ddd2554..13c5354 100644 --- a/gcc/ada/s-osprim-mingw.adb +++ b/gcc/ada/s-osprim-mingw.adb @@ -90,7 +90,7 @@ package body System.OS_Primitives is Signature : Signature_Type := 0; pragma Atomic (Signature); - procedure Get_Base_Time (Data : out Clock_Data); + procedure Get_Base_Time (Data : in out Clock_Data); -- Retrieve the base time and base ticks. These values will be used by -- clock to compute the current time by adding to it a fraction of the -- performance counter. This is for the implementation of a high-resolution @@ -166,7 +166,7 @@ package body System.OS_Primitives is -- Get_Base_Time -- ------------------- - procedure Get_Base_Time (Data : out Clock_Data) is + procedure Get_Base_Time (Data : in out Clock_Data) is -- The resolution for GetSystemTime is 1 millisecond diff --git a/gcc/ada/s-parame-vxworks.adb b/gcc/ada/s-parame-vxworks.adb index eb9ed69..1fe2288 100644 --- a/gcc/ada/s-parame-vxworks.adb +++ b/gcc/ada/s-parame-vxworks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1995-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1995-2015, 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- -- @@ -29,7 +29,7 @@ -- -- ------------------------------------------------------------------------------ --- Version used on all VxWorks, Nucleus, and RTX RTSS targets +-- Version used on all VxWorks targets package body System.Parameters is diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 0d698cf..20b10c9 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -4603,7 +4603,13 @@ package body Sem_Ch12 is Gen_Decl : Node_Id; Pack_Id : Entity_Id; Parent_Installed : Boolean := False; - Renaming_List : List_Id; + + Renaming_List : List_Id; + -- The list of declarations that link formals and actuals of the + -- instance. These are subtype declarations for formal types, and + -- renaming declarations for other formals. The subprogram declaration + -- for the instance is then appended to the list, and the last item on + -- the list is the renaming declaration for the instance. procedure Analyze_Instance_And_Renamings; -- The instance must be analyzed in a context that includes the mappings @@ -4612,6 +4618,14 @@ package body Sem_Ch12 is -- package. The subprogram instance is simply an alias for the internal -- subprogram, declared in the current scope. + procedure Build_Subprogram_Renaming; + -- If the subprogram is recursive, there are occurrences of the name of + -- the generic within the body, which must resolve to the current + -- instance. We add a renaming declaration after the declaration, which + -- is available in the instance body, as well as in the analysis of + -- aspects that appear in the generic. This renaming declaration is + -- inserted after the instance declaration which it renames. + ------------------------------------ -- Analyze_Instance_And_Renamings -- ------------------------------------ @@ -4766,6 +4780,52 @@ package body Sem_Ch12 is end if; end Analyze_Instance_And_Renamings; + ------------------------------- + -- Build_Subprogram_Renaming -- + ------------------------------- + + procedure Build_Subprogram_Renaming is + Renaming_Decl : Node_Id; + Unit_Renaming : Node_Id; + + begin + Unit_Renaming := + Make_Subprogram_Renaming_Declaration (Loc, + Specification => + Copy_Generic_Node + (Specification (Original_Node (Gen_Decl)), + Empty, + Instantiating => True), + Name => New_Occurrence_Of (Anon_Id, Loc)); + + -- The generic may be a a child unit. The renaming needs an + -- identifier with the proper name. + + Set_Defining_Unit_Name (Specification (Unit_Renaming), + Make_Defining_Identifier (Loc, Chars (Gen_Unit))); + + -- If there is a formal subprogram with the same name as the unit + -- itself, do not add this renaming declaration, to prevent + -- ambiguities when there is a call with that name in the body. + -- This is a partial and ugly fix for one ACATS test. ??? + + Renaming_Decl := First (Renaming_List); + while Present (Renaming_Decl) loop + if Nkind (Renaming_Decl) = N_Subprogram_Renaming_Declaration + and then + Chars (Defining_Entity (Renaming_Decl)) = Chars (Gen_Unit) + then + exit; + end if; + + Next (Renaming_Decl); + end loop; + + if No (Renaming_Decl) then + Append (Unit_Renaming, Renaming_List); + end if; + end Build_Subprogram_Renaming; + -- Local variables Save_IPSM : constant Boolean := Ignore_Pragma_SPARK_Mode; @@ -4931,6 +4991,7 @@ package body Sem_Ch12 is end if; Append (Act_Decl, Renaming_List); + Build_Subprogram_Renaming; Analyze_Instance_And_Renamings; -- If the generic is marked Import (Intrinsic), then so is the @@ -5515,6 +5576,12 @@ package body Sem_Ch12 is then null; + -- Ada 2012: If both formal and actual are incomplete types they + -- are conformant. + + elsif Is_Incomplete_Type (E1) and then Is_Incomplete_Type (E2) then + null; + elsif B then Error_Msg_NE ("actual for & in actual instance does not match formal", @@ -10686,14 +10753,11 @@ package body Sem_Ch12 is Defining_Unit_Name (Specification (Act_Decl)); Pack_Id : constant Entity_Id := Defining_Unit_Name (Parent (Act_Decl)); - Decls : List_Id; Gen_Body : Node_Id; Gen_Body_Id : Node_Id; Act_Body : Node_Id; Pack_Body : Node_Id; - Prev_Formal : Entity_Id; Ret_Expr : Node_Id; - Unit_Renaming : Node_Id; Parent_Installed : Boolean := False; @@ -10823,47 +10887,14 @@ package body Sem_Ch12 is Parent_Installed := True; end if; - -- Inside its body, a reference to the generic unit is a reference - -- to the instance. The corresponding renaming is the first - -- declaration in the body. - - Unit_Renaming := - Make_Subprogram_Renaming_Declaration (Loc, - Specification => - Copy_Generic_Node ( - Specification (Original_Node (Gen_Body)), - Empty, - Instantiating => True), - Name => New_Occurrence_Of (Anon_Id, Loc)); - - -- If there is a formal subprogram with the same name as the unit - -- itself, do not add this renaming declaration. This is a temporary - -- fix for one ACATS test. ??? - - Prev_Formal := First_Entity (Pack_Id); - while Present (Prev_Formal) loop - if Chars (Prev_Formal) = Chars (Gen_Unit) - and then Is_Overloadable (Prev_Formal) - then - exit; - end if; - - Next_Entity (Prev_Formal); - end loop; - - if Present (Prev_Formal) then - Decls := New_List (Act_Body); - else - Decls := New_List (Unit_Renaming, Act_Body); - end if; - - -- The subprogram body is placed in the body of a dummy package body, - -- whose spec contains the subprogram declaration as well as the - -- renaming declarations for the generic parameters. + -- Subprogram body is placed in the body of wrapper package, + -- whose spec contains the subprogram declaration as well as + -- the renaming declarations for the generic parameters. - Pack_Body := Make_Package_Body (Loc, - Defining_Unit_Name => New_Copy (Pack_Id), - Declarations => Decls); + Pack_Body := + Make_Package_Body (Loc, + Defining_Unit_Name => New_Copy (Pack_Id), + Declarations => New_List (Act_Body)); Set_Corresponding_Spec (Pack_Body, Pack_Id); @@ -12297,6 +12328,14 @@ package body Sem_Ch12 is Set_Has_Private_View (Subtype_Indication (Decl_Node)); end if; + -- In Ada 2012 the actual may be a limited view. Indicate that + -- the local subtype must be treated as such. + + if From_Limited_With (Act_T) then + Set_Ekind (Subt, E_Incomplete_Subtype); + Set_From_Limited_With (Subt); + end if; + Decl_Nodes := New_List (Decl_Node); -- Flag actual derived types so their elaboration produces the @@ -12666,14 +12705,24 @@ package body Sem_Ch12 is -- Subprogram instance else - -- The instance_spec is the wrapper package, - -- and the subprogram declaration is the last - -- declaration in the wrapper. - - Info.Act_Decl := - Last - (Visible_Declarations - (Specification (Info.Act_Decl))); + -- The instance_spec is in the wrapper package, + -- usually followed by its local renaming + -- declaration. See Build_Subprogram_Renaming + -- for details. + + declare + Decl : Node_Id := + (Last (Visible_Declarations + (Specification (Info.Act_Decl)))); + begin + if Nkind (Decl) = + N_Subprogram_Renaming_Declaration + then + Decl := Prev (Decl); + end if; + + Info.Act_Decl := Decl; + end; Instantiate_Subprogram_Body (Info, Body_Optional => True); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 56aee5a..f717523 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -11048,8 +11048,11 @@ package body Sem_Ch13 is procedure Initialize is begin Address_Clause_Checks.Init; - Independence_Checks.Init; Unchecked_Conversions.Init; + + if VM_Target /= No_VM or else AAMP_On_Target then + Independence_Checks.Init; + end if; end Initialize; --------------------------- diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads index 23bf235..7f206e7 100644 --- a/gcc/ada/sem_eval.ads +++ b/gcc/ada/sem_eval.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -248,7 +248,7 @@ package Sem_Eval is -- Determines whether a subtype fits the definition of an Ada static -- subtype as given in (RM 4.9(26)) with the additional check that neither -- bound raises constraint error (meaning that Expr_Value[_R|S] can be used - -- on these bounds. Important note: This check does not include the Ada + -- on these bounds). Important note: This check does not include the Ada -- 2012 case of a non-static predicate which results in an otherwise static -- subtype being non-static. Such a subtype will return True for this test, -- so if the distinction is important, the caller must deal with this. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 8c26e3e..98b825a 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -3216,6 +3216,10 @@ package body Sem_Prag is -- Suppress_Case is True for the Suppress case, and False for the -- Unsuppress case. + procedure Record_Independence_Check (N : Node_Id; E : Entity_Id); + -- Subsidiary to the analysis of pragmas Independent[_Components]. + -- Record such a pragma N applied to entity E for future checks. + procedure Set_Exported (E : Entity_Id; Arg : Node_Id); -- This procedure sets the Is_Exported flag for the given entity, -- checking that the entity was not previously imported. Arg is @@ -6232,7 +6236,7 @@ package body Sem_Prag is Set_Is_Independent (Base_Type (E)); if Prag_Id = Pragma_Independent then - Independence_Checks.Append ((N, Base_Type (E))); + Record_Independence_Check (N, Base_Type (E)); end if; end if; @@ -6307,7 +6311,7 @@ package body Sem_Prag is Set_Is_Independent (E); if Prag_Id = Pragma_Independent then - Independence_Checks.Append ((N, E)); + Record_Independence_Check (N, E); end if; end if; @@ -9194,6 +9198,21 @@ package body Sem_Prag is end if; end Process_Suppress_Unsuppress; + ------------------------------- + -- Record_Independence_Check -- + ------------------------------- + + procedure Record_Independence_Check (N : Node_Id; E : Entity_Id) is + begin + -- For GCC back ends the validation is done a priori + + if VM_Target = No_VM and then not AAMP_On_Target then + return; + end if; + + Independence_Checks.Append ((N, E)); + end Record_Independence_Check; + ------------------ -- Set_Exported -- ------------------ @@ -14995,7 +15014,7 @@ package body Sem_Prag is and then (Is_Array_Type (E) or else Is_Record_Type (E)) then Set_Has_Independent_Components (Base_Type (E)); - Independence_Checks.Append ((N, Base_Type (E))); + Record_Independence_Check (N, Base_Type (E)); -- For record type, set all components independent @@ -15013,7 +15032,7 @@ package body Sem_Prag is N_Constrained_Array_Definition then Set_Has_Independent_Components (E); - Independence_Checks.Append ((N, E)); + Record_Independence_Check (N, E); else Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1); diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index d89039a..e5790985 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -244,7 +244,7 @@ package Sem_Prag is -- Returns True if Nam is one of the names recognized as a valid assertion -- kind by the Assertion_Policy pragma. Note that the 'Class cases are -- represented by the corresponding special names Name_uPre, Name_uPost, - -- Name_uInviarnat, and Name_uType_Invariant (_Pre, _Post, _Invariant, + -- Name_uInvariant, and Name_uType_Invariant (_Pre, _Post, _Invariant, -- and _Type_Invariant). procedure Make_Aspect_For_PPC_In_Gen_Sub_Decl (Decl : Node_Id); -- 2.7.4