+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).
-- 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;
-- --
-- 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- --
begin
if Nlen > Max_Length then
- raise Ada.Strings.Index_Error;
+ raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
-- 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;
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.
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;
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
-- 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
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
projects / gcc.git / commitdiff