OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2015-01-06  Vincent Celier  <celier@adacore.com>

	* a-strsup.adb (Times (Natural;String;Positive)): Raise
	Length_Error, not Index_Error, when the result is too long.

2015-01-06  Thomas Quinot  <quinot@adacore.com>

	* a-direct.adb (Create_Path): Minor error handling and
	performance improvement.

2015-01-06  Robert Dewar  <dewar@adacore.com>

	* 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  <dewar@adacore.com>

	* 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  <schonberg@adacore.com>

	* 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  <dewar@adacore.com>

	* exp_strm.adb (Build_Elementary_Input_Call): Return base type
	(as required by RM).

From-SVN: r219228
This commit is contained in:
Arnaud Charlet 2015-01-06 10:10:49 +01:00
parent 91afcbfd3e
commit 21f30884bc
9 changed files with 108 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
gcc/ada/ChangeLog
View File

@ -1,3 +1,37 @@
2015-01-06 Vincent Celier <celier@adacore.com>
* a-strsup.adb (Times (Natural;String;Positive)): Raise
Length_Error, not Index_Error, when the result is too long.
2015-01-06 Thomas Quinot <quinot@adacore.com>
* a-direct.adb (Create_Path): Minor error handling and
performance improvement.
2015-01-06 Robert Dewar <dewar@adacore.com>
* 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 <dewar@adacore.com>
* 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 <schonberg@adacore.com>
* 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 <dewar@adacore.com>
* exp_strm.adb (Build_Elementary_Input_Call): Return base type
(as required by RM).
2015-01-06 Arnaud Charlet <charlet@adacore.com>
* a-reatim.adb ("/"): Add explicit pragma Unsuppress (Division_Check).

33
gcc/ada/a-direct.adb
View File

@ -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;
if not Is_Directory (New_Dir (1 .. Last)) then
begin
Create_Directory
(New_Directory => New_Dir (1 .. Last), Form => Form);
-- It is an error if a file with such a name already exists
exception
when Use_Error =>
if File_Exists (New_Dir (1 .. Last)) then
elsif Is_Regular_File (New_Dir (1 .. Last)) then
raise Use_Error with
"file """ & New_Dir (1 .. Last) & """ already exists";
-- 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.
else
Create_Directory
(New_Directory => New_Dir (1 .. Last), Form => Form);
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;

4
gcc/ada/a-strsup.adb
View File

@ -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;

2
gcc/ada/checks.ads
View File

@ -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;

20
gcc/ada/exp_ch4.adb
View File

@ -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.

27
gcc/ada/exp_strm.adb
View File

@ -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;

1
gcc/ada/sem_ch10.adb
View File

@ -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

2
gcc/ada/sem_ch12.adb
View File

@ -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

6
gcc/ada/sem_prag.adb
View File

@ -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