diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 40 | ||||
| -rw-r--r-- | gcc/ada/arit64.c | 57 | ||||
| -rw-r--r-- | gcc/ada/checks.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/checks.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 50 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/Makefile.in | 2 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/projects.texi | 16 | ||||
| -rw-r--r-- | gcc/ada/s-arit64.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/s-tassta.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 101 | ||||
| -rw-r--r-- | gcc/ada/xref_lib.adb | 11 |
12 files changed, 191 insertions, 125 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a7440cf..f55671e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,43 @@ +2013-01-03 Emmanuel Briot <briot@adacore.com> + + * xref_lib.adb (Parse_Identifier_Info): Fix handling of arrays, which + have information in the ALI file for both the index and the component + types. + +2013-01-03 Emmanuel Briot <briot@adacore.com> + + * projects.texi: Fix error in documenting the project path + computed for an aggregate project. + +2013-01-03 Javier Miranda <miranda@adacore.com> + + * sem_warn.adb (Warn_On_Overlapping_Actuals): Adding documentation + plus restricting the functionality of this routine to cover the + cases described in the Ada 2012 reference manual. The previous + extended support is now available under -gnatX. + * s-tassta.adb (Finalize_Global_Tasks): Addition of a dummy + variable to call Timed_Sleep. Required to avoid warning on + overlapping out-mode actuals. + * opt.ads (Extensions_Allowed): Update documentation. + +2013-01-03 Tristan Gingold <gingold@adacore.com> + + * s-arit64.ads: Use Multiply_With_Ovflo_Check as __gnat_mulv64. + * arit64.c: Removed + * gcc-interface/Makefile.in: Remove reference to arit64.c. + +2013-01-03 Thomas Quinot <quinot@adacore.com> + + * checks.adb, checks.ads (Apply_Address_Clause_Check): The check must + be generated at the start of the freeze actions for the entity, not + before (or after) the freeze node. + +2013-01-03 Thomas Quinot <quinot@adacore.com> + + * exp_aggr.adb (Exp_Aggr.Convert_Aggregate_In_Obj_Decl): + Reorganize code to capture initialization statements in a block, + so that freeze nodes are excluded from the captured block. + 2013-01-03 Thomas Quinot <quinot@adacore.com> * exp_ch11.adb: Minor reformatting. diff --git a/gcc/ada/arit64.c b/gcc/ada/arit64.c deleted file mode 100644 index d906ded..0000000 --- a/gcc/ada/arit64.c +++ /dev/null @@ -1,57 +0,0 @@ -/**************************************************************************** - * * - * GNAT COMPILER COMPONENTS * - * * - * A R I T 6 4 . C * - * * - * C Implementation File * - * * - * Copyright (C) 2009-2012, 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- * - * ware Foundation; either version 3, or (at your option) any later ver- * - * sion. GNAT is distributed in the hope that it will be useful, but WITH- * - * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * - * or FITNESS FOR A PARTICULAR PURPOSE. * - * * - * As a special exception under Section 7 of GPL version 3, you are granted * - * additional permissions described in the GCC Runtime Library Exception, * - * version 3.1, as published by the Free Software Foundation. * - * * - * You should have received a copy of the GNU General Public License and * - * a copy of the GCC Runtime Library Exception along with this program; * - * see the files COPYING3 and COPYING.RUNTIME respectively. If not, see * - * <http://www.gnu.org/licenses/>. * - * * - * GNAT was originally developed by the GNAT team at New York University. * - * Extensive contributions were provided by Ada Core Technologies Inc. * - * * - ****************************************************************************/ - -extern void __gnat_rcheck_CE_Overflow_Check(char *file, int line) - __attribute__ ((__noreturn__)); - -long long int __gnat_mulv64 (long long int x, long long int y) -{ - unsigned neg = (x >= 0) ^ (y >= 0); - long long unsigned xa = x >= 0 ? (long long unsigned) x - : -(long long unsigned) x; - long long unsigned ya = y >= 0 ? (long long unsigned) y - : -(long long unsigned) y; - unsigned xhi = (unsigned) (xa >> 32); - unsigned yhi = (unsigned) (ya >> 32); - unsigned xlo = (unsigned) xa; - unsigned ylo = (unsigned) ya; - long long unsigned mid - = xhi ? (long long unsigned) xhi * (long long unsigned) ylo - : (long long unsigned) yhi * (long long unsigned) xlo; - long long unsigned low = (long long unsigned) xlo * (long long unsigned) ylo; - - if ((xhi && yhi) || mid + (low >> 32) > 0x7fffffff + neg) - __gnat_rcheck_CE_Overflow_Check (__FILE__, __LINE__); - - low += ((long long unsigned) (unsigned) mid) << 32; - - return (long long int) (neg ? -low : low); -} diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 38b6ea4..337546a 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -575,6 +575,8 @@ package body Checks is -------------------------------- procedure Apply_Address_Clause_Check (E : Entity_Id; N : Node_Id) is + pragma Assert (Nkind (N) = N_Freeze_Entity); + AC : constant Node_Id := Address_Clause (E); Loc : constant Source_Ptr := Sloc (AC); Typ : constant Entity_Id := Etype (E); @@ -734,7 +736,11 @@ package body Checks is Remove_Side_Effects (Expr); end if; - Insert_After_And_Analyze (N, + if No (Actions (N)) then + Set_Actions (N, New_List); + end if; + + Prepend_To (Actions (N), Make_Raise_Program_Error (Loc, Condition => Make_Op_Ne (Loc, @@ -745,11 +751,11 @@ package body Checks is (RTE (RE_Integer_Address), Expr), Right_Opnd => Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (E, Loc), + Prefix => New_Occurrence_Of (E, Loc), Attribute_Name => Name_Alignment)), Right_Opnd => Make_Integer_Literal (Loc, Uint_0)), - Reason => PE_Misaligned_Address_Value), - Suppress => All_Checks); + Reason => PE_Misaligned_Address_Value)); + Analyze (First (Actions (N)), Suppress => All_Checks); return; end if; diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads index 2221f0e..fb73706 100644 --- a/gcc/ada/checks.ads +++ b/gcc/ada/checks.ads @@ -131,8 +131,11 @@ package Checks is -- are enabled, then this procedure generates a check that the specified -- address has an alignment consistent with the alignment of the object, -- raising PE if this is not the case. The resulting check (if one is - -- generated) is inserted before node N. check is also made for the case of - -- a clear overlay situation that the size of the overlaying object is not + -- generated) is prepended to the Actions list of N_Freeze_Entity node N. + -- Note that the check references E'Alignment, so it cannot be emitted + -- before N (its freeze node), otherwise this would cause an illegal + -- access before elaboration error in GIGI. For the case of a clear overlay + -- situation, we also check that the size of the overlaying object is not -- larger than the overlaid object. procedure Apply_Arithmetic_Overflow_Check (N : Node_Id); diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 0f8f187..7476a84 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -3012,8 +3012,6 @@ package body Exp_Aggr is Loc : constant Source_Ptr := Sloc (Aggr); Typ : constant Entity_Id := Etype (Aggr); Occ : constant Node_Id := New_Occurrence_Of (Obj, Loc); - Blk : Node_Id := Empty; - Ins : Node_Id; function Discriminants_Ok return Boolean; -- If the object type is constrained, the discriminants in the @@ -3118,27 +3116,39 @@ package body Exp_Aggr is (Aggr, Sec_Stack => Is_Controlled (Typ) or else Has_Controlled_Component (Typ)); - Ins := N; + end if; + + declare + Node_After : constant Node_Id := Next (N); + Init_Node : Node_Id; + Blk : Node_Id; + Init_Actions : constant List_Id := New_List; + begin + Insert_Actions_After (N, Late_Expansion (Aggr, Typ, Occ)); - -- Need to Set_Initialization_Statements??? (see below) + -- Move inserted, analyzed actions to Init_Actions, but skip over + -- freeze nodes as these need to remain in the proper scope. - else - -- Capture initialization statements within an identified block - -- statement, as we might need to move them to the freeze actions - -- of Obj later on if a representation clause (such as an address - -- clause) makes it necessary to delay freezing. - - Ins := Make_Null_Statement (Loc); - Blk := Make_Block_Statement (Loc, - Declarations => New_List, - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => New_List (Ins))); - Insert_Action_After (N, Blk); - Set_Initialization_Statements (Obj, Blk); - end if; + Init_Node := N; - Insert_Actions_After (Ins, Late_Expansion (Aggr, Typ, Occ)); + while Next (Init_Node) /= Node_After loop + if Nkind (Next (Init_Node)) = N_Freeze_Entity then + Next (Init_Node); + else + Append_To (Init_Actions, Remove_Next (Init_Node)); + end if; + end loop; + + if not Is_Empty_List (Init_Actions) then + Blk := Make_Block_Statement (Loc, + Declarations => New_List, + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => Init_Actions)); + Insert_Action_After (Init_Node, Blk); + Set_Initialization_Statements (Obj, Blk); + end if; + end; Set_No_Initialization (N); Initialize_Discriminants (N, Typ); end Convert_Aggr_In_Object_Decl; diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 24c9966..bbb05a1 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -2308,7 +2308,7 @@ endif # LIBGNAT_SRCS is the list of all C files (including headers) of the runtime # library. LIBGNAT_OBJS is the list of object files for libgnat. # thread.c is special as put into GNATRTL_TASKING_OBJS by Makefile.rtl -LIBGNAT_OBJS = adadecode.o adaint.o argv.o arit64.o aux-io.o \ +LIBGNAT_OBJS = adadecode.o adaint.o argv.o aux-io.o \ cal.o cio.o cstreams.o ctrl_c.o \ env.o errno.o exit.o expect.o final.o \ init.o initialize.o locales.o mkdir.o \ diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 2b68d79..44e7431 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -563,7 +563,7 @@ package Opt is Extensions_Allowed : Boolean := False; -- GNAT -- Set to True by switch -gnatX if GNAT specific language extensions - -- are allowed. Currently there are no such defined extensions. + -- are allowed. type External_Casing_Type is ( As_Is, -- External names cased as they appear in the Ada source diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index 79ac662..f3ecde9 100644 --- a/gcc/ada/projects.texi +++ b/gcc/ada/projects.texi @@ -2514,11 +2514,17 @@ project files specified with @code{Project_Files}. Each aggregate project has its own (that is if agg1.gpr includes agg2.gpr, they can potentially both have a different project path). -This project path is defined as the concatenation, in that order, of -the current directory, followed by the command line -aP switches, -then the directories from the Project_Path attribute, then the -directories from the GPR_PROJECT_PATH and ADA_PROJECT_PATH env. -variables, and finally the predefined directories. + +This project path is defined as the concatenation, in that order, of: + +@itemize @bullet +@item the current directory; +@item followed by the command line -aP switches; +@item then the directories from the GPR_PROJECT_PATH and ADA_PROJECT_PATH environment +variables; +@item then the directories from the Project_Path attribute; +@item and finally the predefined directories. +@end itemize In the example above, agg2.gpr's project path is not influenced by the attribute agg1'Project_Path, nor is agg1 influenced by diff --git a/gcc/ada/s-arit64.ads b/gcc/ada/s-arit64.ads index 8ecbfed..4eb1153 100644 --- a/gcc/ada/s-arit64.ads +++ b/gcc/ada/s-arit64.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -33,6 +33,9 @@ -- signed integer values in cases where either overflow checking is -- required, or intermediate results are longer than 64 bits. +pragma Restrictions (No_Elaboration_Code); +-- Allow direct call from gigi generated code + with Interfaces; package System.Arith_64 is @@ -49,8 +52,10 @@ package System.Arith_64 is -- bits, otherwise returns the 64-bit signed integer difference. function Multiply_With_Ovflo_Check (X, Y : Int64) return Int64; + pragma Export (C, Multiply_With_Ovflo_Check, "__gnat_mulv64"); -- Raises Constraint_Error if product of operands overflows 64 -- bits, otherwise returns the 64-bit signed integer product. + -- GIGI may also call this routine directly. procedure Scaled_Divide (X, Y, Z : Int64; diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index cf63a30..75f4e2c 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -806,8 +806,9 @@ package body System.Tasking.Stages is procedure Finalize_Global_Tasks is Self_ID : constant Task_Id := STPO.Self; - Ignore : Boolean; - pragma Unreferenced (Ignore); + Ignore_1 : Boolean; + Ignore_2 : Boolean; + pragma Unreferenced (Ignore_1, Ignore_2); function State (Int : System.Interrupt_Management.Interrupt_ID) return Character; @@ -877,7 +878,7 @@ package body System.Tasking.Stages is Timed_Sleep (Self_ID, 0.01, System.OS_Primitives.Relative, - Self_ID.Common.State, Ignore, Ignore); + Self_ID.Common.State, Ignore_1, Ignore_2); end loop; end if; @@ -886,7 +887,7 @@ package body System.Tasking.Stages is Timed_Sleep (Self_ID, 0.01, System.OS_Primitives.Relative, - Self_ID.Common.State, Ignore, Ignore); + Self_ID.Common.State, Ignore_1, Ignore_2); Unlock (Self_ID); diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index e24e729..a23d0d7 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -3292,41 +3292,89 @@ package body Sem_Warn is Act1, Act2 : Node_Id; Form1, Form2 : Entity_Id; + function Is_Covered_Formal (Formal : Node_Id) return Boolean; + -- Return True if Formal is covered by the Ada 2012 rule. Under -gnatX + -- the rule is extended to cover record and array types. + + function Refer_Same_Object (Act1, Act2 : Node_Id) return Boolean; + -- Two names are known to refer to the same object if the two names + -- are known to denote the same object; or one of the names is a + -- selected_component, indexed_component, or slice and its prefix is + -- known to refer to the same object as the other name; or one of the + -- two names statically denotes a renaming declaration whose renamed + -- object_name is known to refer to the same object as the other name + -- (RM 6.4.1(6.11/3)) + + ----------------------- + -- Refer_Same_Object -- + ----------------------- + + function Refer_Same_Object (Act1, Act2 : Node_Id) return Boolean is + begin + return Denotes_Same_Object (Act1, Act2) + or else Denotes_Same_Prefix (Act1, Act2); + end Refer_Same_Object; + + ----------------------- + -- Is_Covered_Formal -- + ----------------------- + + function Is_Covered_Formal (Formal : Node_Id) return Boolean is + begin + -- Ada 2012 rule + + if not Extensions_Allowed then + return + Ekind_In (Formal, E_Out_Parameter, + E_In_Out_Parameter) + and then Is_Elementary_Type (Etype (Formal)); + + -- Under -gnatX the rule is extended to cover array and record types + + else + return + Ekind_In (Formal, E_Out_Parameter, + E_In_Out_Parameter) + and then (Is_Elementary_Type (Etype (Formal)) + or else Is_Record_Type (Etype (Formal)) + or else Is_Array_Type (Etype (Formal))); + end if; + end Is_Covered_Formal; + begin - if not Warn_On_Overlap then + if Ada_Version < Ada_2012 and then not Warn_On_Overlap then return; end if; -- Exclude calls rewritten as enumeration literals - if Nkind (N) not in N_Subprogram_Call then + if Nkind (N) not in N_Subprogram_Call + and then Nkind (N) /= N_Entry_Call_Statement + then return; end if; - -- Exclude calls to library subprograms. Container operations specify - -- safe behavior when source and target coincide. + -- If a call C has two or more parameters of mode in out or out that are + -- of an elementary type, then the call is legal only if for each name + -- N that is passed as a parameter of mode in out or out to the call C, + -- there is no other name among the other parameters of mode in out or + -- out to C that is known to denote the same object (RM 6.4.1(6.15/3)) - if Is_Predefined_File_Name - (Unit_File_Name (Get_Source_Unit (Sloc (Subp)))) - then - return; - end if; + -- Under -gnatX the rule is extended to cover array and record types. Form1 := First_Formal (Subp); Act1 := First_Actual (N); while Present (Form1) and then Present (Act1) loop - if Ekind (Form1) /= E_In_Parameter then + + if Is_Covered_Formal (Form1) then Form2 := First_Formal (Subp); Act2 := First_Actual (N); while Present (Form2) and then Present (Act2) loop if Form1 /= Form2 - and then Ekind (Form2) /= E_Out_Parameter - and then - (Denotes_Same_Object (Act1, Act2) - or else - Denotes_Same_Prefix (Act1, Act2)) + and then Is_Covered_Formal (Form2) + and then Refer_Same_Object (Act1, Act2) then - -- Exclude generic types and guard against previous errors + -- Guard against previous errors if Error_Posted (N) or else No (Etype (Act1)) @@ -3334,14 +3382,8 @@ package body Sem_Warn is then null; - elsif Is_Generic_Type (Etype (Act1)) - or else - Is_Generic_Type (Etype (Act2)) - then - null; - - -- If the actual is a function call in prefix notation, - -- there is no real overlap. + -- If the actual is a function call in prefix notation, + -- there is no real overlap. elsif Nkind (Act2) = N_Function_Call then null; @@ -3350,11 +3392,20 @@ package body Sem_Warn is -- intended. elsif - Is_By_Reference_Type (Underlying_Type (Etype (Form1))) + Present (Underlying_Type (Etype (Form1))) + and then + (Is_By_Reference_Type (Underlying_Type (Etype (Form1))) + or else + Convention (Underlying_Type (Etype (Form1))) + = Convention_Ada_Pass_By_Reference) then null; + -- Here we may need to issue message + else + Error_Msg_Warn := Ada_Version < Ada_2012; + declare Act : Node_Id; Form : Entity_Id; diff --git a/gcc/ada/xref_lib.adb b/gcc/ada/xref_lib.adb index 4110368..56a28ef 100644 --- a/gcc/ada/xref_lib.adb +++ b/gcc/ada/xref_lib.adb @@ -925,10 +925,11 @@ package body Xref_Lib is end; end if; - if Ali (Ptr) = '<' - or else Ali (Ptr) = '(' - or else Ali (Ptr) = '{' - then + while Ptr <= Ali'Last + and then (Ali (Ptr) = '<' + or else Ali (Ptr) = '(' + or else Ali (Ptr) = '{') + loop -- Here we have a type derivation information. The format is -- <3|12I45> which means that the current entity is derived from the -- type defined in unit number 3, line 12 column 45. The pipe and @@ -1065,7 +1066,7 @@ package body Xref_Lib is end loop; Ptr := Ptr + 1; end if; - end if; + end loop; -- To find the body, we will have to parse the file too |