From: Arnaud Charlet Date: Tue, 6 Jan 2015 09:10:49 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=21f30884bcd502e083f531cc0f5fa1b89c4e22b5;p=gcc.git [multiple changes] 2015-01-06 Vincent Celier * a-strsup.adb (Times (Natural;String;Positive)): Raise Length_Error, not Index_Error, when the result is too long. 2015-01-06 Thomas Quinot * a-direct.adb (Create_Path): Minor error handling and performance improvement. 2015-01-06 Robert Dewar * checks.ads, sem_ch12.adb: Minor reformatting. * exp_ch4.adb (Expand_N_Op_Divide): Generate explicit divide by zero check for fixed-point case if Backend_Divide_Checks_On_Target is False. 2015-01-06 Robert Dewar * sem_prag.adb (Analyze_Pragma, case No_Elaboration_Code_All): Do not set restriction No_Elaboration_Code unless the pragma appears in the main unit). 2015-01-06 Ed Schonberg * sem_ch10.adb (Is_Regular_With_Clause): Add guard to verify that with clause has already been analyzed before checking kind of with_clause. 2015-01-06 Robert Dewar * exp_strm.adb (Build_Elementary_Input_Call): Return base type (as required by RM). From-SVN: r219228 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 64c02b3b572..82e4b138915 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,37 @@ +2015-01-06 Vincent Celier + + * a-strsup.adb (Times (Natural;String;Positive)): Raise + Length_Error, not Index_Error, when the result is too long. + +2015-01-06 Thomas Quinot + + * a-direct.adb (Create_Path): Minor error handling and + performance improvement. + +2015-01-06 Robert Dewar + + * checks.ads, sem_ch12.adb: Minor reformatting. + * exp_ch4.adb (Expand_N_Op_Divide): Generate explicit divide by + zero check for fixed-point case if Backend_Divide_Checks_On_Target + is False. + +2015-01-06 Robert Dewar + + * sem_prag.adb (Analyze_Pragma, case No_Elaboration_Code_All): + Do not set restriction No_Elaboration_Code unless the pragma + appears in the main unit). + +2015-01-06 Ed Schonberg + + * sem_ch10.adb (Is_Regular_With_Clause): Add guard to verify + that with clause has already been analyzed before checking kind + of with_clause. + +2015-01-06 Robert Dewar + + * exp_strm.adb (Build_Elementary_Input_Call): Return base type + (as required by RM). + 2015-01-06 Arnaud Charlet * a-reatim.adb ("/"): Add explicit pragma Unsuppress (Division_Check). diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb index f567984a679..d28182915b9 100644 --- a/gcc/ada/a-direct.adb +++ b/gcc/ada/a-direct.adb @@ -490,18 +490,33 @@ package body Ada.Directories is -- No need to create the directory if it already exists - if Is_Directory (New_Dir (1 .. Last)) then - null; - - -- It is an error if a file with such a name already exists - - elsif Is_Regular_File (New_Dir (1 .. Last)) then - raise Use_Error with - "file """ & New_Dir (1 .. Last) & """ already exists"; - - else - Create_Directory - (New_Directory => New_Dir (1 .. Last), Form => Form); + if not Is_Directory (New_Dir (1 .. Last)) then + begin + Create_Directory + (New_Directory => New_Dir (1 .. Last), Form => Form); + + exception + when Use_Error => + if File_Exists (New_Dir (1 .. Last)) then + + -- A file with such a name already exists. If it is + -- a directory, then it was apparently just created + -- by another process or thread, and all is well. + -- If it is of some other kind, report an error. + + if not Is_Directory (New_Dir (1 .. Last)) then + raise Use_Error with + "file """ & New_Dir (1 .. Last) & + """ already exists and is not a directory"; + end if; + + else + -- Create_Directory failed for some other reason: + -- propagate the exception. + + raise; + end if; + end; end if; end if; end loop; diff --git a/gcc/ada/a-strsup.adb b/gcc/ada/a-strsup.adb index ed14e58964c..072f728a64b 100644 --- a/gcc/ada/a-strsup.adb +++ b/gcc/ada/a-strsup.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2003-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2014, 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- -- @@ -1842,7 +1842,7 @@ package body Ada.Strings.Superbounded is begin if Nlen > Max_Length then - raise Ada.Strings.Index_Error; + raise Ada.Strings.Length_Error; else Result.Current_Length := Nlen; diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads index d3e002cf18a..24e5e6d9cd8 100644 --- a/gcc/ada/checks.ads +++ b/gcc/ada/checks.ads @@ -242,7 +242,7 @@ package Checks is -- flags Do_Division_Check or Do_Overflow_Check is set, then this routine -- ensures that the appropriate checks are made. Note that overflow can -- occur in the signed case for the case of the largest negative number - -- divided by minus one. + -- divided by minus one. This procedure only applies to Integer types. procedure Apply_Parameter_Aliasing_Checks (Call : Node_Id; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index aff9becb8dc..340462cf1f9 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -6701,6 +6701,26 @@ package body Exp_Ch4 is if Is_Fixed_Point_Type (Typ) then + -- Deal with divide-by-zero check if back end cannot handle them + -- and the flag is set indicating that we need such a check. Note + -- that we don't need to bother here with the case of mixed-mode + -- (Right operand an integer type), since these will be rewritten + -- with conversions to a divide with a fixed-point right operand. + + if Do_Division_Check (N) + and then not Backend_Divide_Checks_On_Target + and then not Is_Integer_Type (Rtyp) + then + Set_Do_Division_Check (N, False); + Insert_Action (N, + Make_Raise_Constraint_Error (Loc, + Condition => + Make_Op_Eq (Loc, + Left_Opnd => Duplicate_Subexpr_Move_Checks (Ropnd), + Right_Opnd => Make_Real_Literal (Loc, Ureal_0)), + Reason => CE_Divide_By_Zero)); + end if; + -- No special processing if Treat_Fixed_As_Integer is set, since -- from a semantic point of view such operations are simply integer -- operations and will be treated that way. diff --git a/gcc/ada/exp_strm.adb b/gcc/ada/exp_strm.adb index 1c0713c3d30..7186de4afe1 100644 --- a/gcc/ada/exp_strm.adb +++ b/gcc/ada/exp_strm.adb @@ -642,12 +642,27 @@ package body Exp_Strm is return Res; else - return - Unchecked_Convert_To (P_Type, - Make_Function_Call (Loc, - Name => New_Occurrence_Of (RTE (Lib_RE), Loc), - Parameter_Associations => New_List ( - Relocate_Node (Strm)))); + Res := + Make_Function_Call (Loc, + Name => New_Occurrence_Of (RTE (Lib_RE), Loc), + Parameter_Associations => New_List ( + Relocate_Node (Strm))); + + -- Now convert to the base type if we do not have a biased type. Note + -- that we did not do this in some older versions, and the result was + -- losing some required range checking for the 'Read case. + + if not Has_Biased_Representation (P_Type) then + return Unchecked_Convert_To (Base_Type (P_Type), Res); + + -- For the biased case, the conversion to the base type loses the + -- biasing, so just convert to Ptype. This is not quite right, and + -- for example may lose a corner case CE test, but it is such a + -- rare case that for now we ignore it ??? + + else + return Unchecked_Convert_To (P_Type, Res); + end if; end if; end Build_Elementary_Input_Call; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 5479df0d1e8..f482245d019 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -6494,6 +6494,7 @@ package body Sem_Ch10 is Item := First (Context_Items (Comp_Unit)); while Present (Item) loop if Nkind (Item) = N_With_Clause + and then Is_Entity_Name (Name (Item)) and then Entity (Name (Item)) = E and then not Private_Present (Item) then diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index ab118c62075..7861c454004 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -10237,7 +10237,7 @@ package body Sem_Ch12 is -- the enclosing instance is analyzed. if Present (Etype (Actual)) - and then Is_Constr_Subt_For_U_Nominal (Etype (Actual)) + and then Is_Constr_Subt_For_U_Nominal (Etype (Actual)) then Freeze_Before (Instantiation_Node, Etype (Actual)); else diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 207f4ba20eb..8798fa1e249 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -16783,9 +16783,11 @@ package body Sem_Prag is Set_No_Elab_Code_All (Current_Sem_Unit); - -- Set restriction No_Elaboration_Code + -- Set restriction No_Elaboration_Code if this is the main unit - Set_Restriction (No_Elaboration_Code, N); + if Current_Sem_Unit = Main_Unit then + Set_Restriction (No_Elaboration_Code, N); + end if; -- If we are in the main unit or in an extended main source unit, -- then we also add it to the configuration restrictions so that