* makeutl.adb (Check_Source_Info_In_ALI): Do not recompile if a subunit
from the runtime is found, except if gnatmake switch -a is used and this
subunit cannot be found.
2009-10-27 Ed Schonberg <schonberg@adacore.com>
* gnatbind.adb (gnatbind): When the -R option is selected, list subunits
as well, for tools that need the complete closure of the main program.
2009-10-27 Sergey Rybin <rybin@adacore.com>
* gnat_ugn.texi: Minor updates.
2009-10-27 Emmanuel Briot <briot@adacore.com>
* prj-tree.adb (Free): Fix memory leak.
2009-10-27 Vasiliy Fofanov <fofanov@adacore.com>
* adaint.c, s-os_lib.adb (__gnat_create_output_file_new): New function
that ensures the file that is created is new. Use this function to make
sure there is no race condition if several processes are creating temp
files concurrently.
* s-os_lib.ads: Update comment.
2009-10-27 Thomas Quinot <quinot@adacore.com>
* sem_ch12.adb: Minor reformatting
2009-10-27 Javier Miranda <miranda@adacore.com>
* exp_ch4.ads (Integer_Promotion_Possible): New subprogram.
* exp_ch4.adb (Integer_Promotion_Possible): New subprogram.
(Expand_N_Type_Conversion): Replace code that checks if the integer
promotion of the operands is possible by a call to the new function
Integer_Promotion_Possible. Minor reformating because an enclosing
block is now not needed.
* checks.adb (Apply_Arithmetic_Overflow_Check): Add missing check to
see if the integer promotion is possible; in such case the runtime
checks are not generated.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@153592
138bc75d-0d04-0410-961f-
82ee72b054a4
}
int
+__gnat_create_output_file_new (char *path)
+{
+ int fd;
+#if defined (VMS)
+ fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM,
+ "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
+ "shr=del,get,put,upd");
+#elif defined (__MINGW32__)
+ {
+ TCHAR wpath[GNAT_MAX_PATH_LEN];
+
+ S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
+ fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
+ }
+#else
+ fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
+#endif
+
+ return fd < 0 ? -1 : fd;
+}
+
+int
__gnat_open_append (char *path, int fmode)
{
int fd;
with Einfo; use Einfo;
with Errout; use Errout;
with Exp_Ch2; use Exp_Ch2;
+with Exp_Ch4; use Exp_Ch4;
with Exp_Ch11; use Exp_Ch11;
with Exp_Pakd; use Exp_Pakd;
with Exp_Util; use Exp_Util;
begin
-- Skip check if back end does overflow checks, or the overflow flag
- -- is not set anyway, or we are not doing code expansion.
+ -- is not set anyway, or we are not doing code expansion, or the
+ -- parent node is a type conversion whose operand is an arithmetic
+ -- operation on signed integers on which the expander can promote
+ -- later the operands to type integer (see Expand_N_Type_Conversion).
-- Special case CLI target, where arithmetic overflow checks can be
-- performed for integer and long_integer
if Backend_Overflow_Checks_On_Target
or else not Do_Overflow_Check (N)
or else not Expander_Active
+ or else (Present (Parent (N))
+ and then Nkind (Parent (N)) = N_Type_Conversion
+ and then Integer_Promotion_Possible (Parent (N)))
or else
(VM_Target = CLI_Target and then Siz >= Standard_Integer_Size)
then
-- have to be sure not to generate junk overflow checks in the first
-- place, since it would be trick to remove them here!
- declare
- Root_Operand_Type : constant Entity_Id := Root_Type (Operand_Type);
-
- begin
- -- Enable transformation if all conditions are met
+ if Integer_Promotion_Possible (N) then
- if
- -- We only do this transformation for source constructs. We assume
- -- that the expander knows what it is doing when it generates code.
-
- Comes_From_Source (N)
+ -- All conditions met, go ahead with transformation
- -- If the operand type is Short_Integer or Short_Short_Integer,
- -- then we will promote to Integer, which is available on all
- -- targets, and is sufficient to ensure no intermediate overflow.
- -- Furthermore it is likely to be as efficient or more efficient
- -- than using the smaller type for the computation so we do this
- -- unconditionally.
-
- and then
- (Root_Operand_Type = Base_Type (Standard_Short_Integer)
- or else
- Root_Operand_Type = Base_Type (Standard_Short_Short_Integer))
-
- -- Test for interesting operation, which includes addition,
- -- division, exponentiation, multiplication, subtraction, and
- -- unary negation.
+ declare
+ Opnd : Node_Id;
+ L, R : Node_Id;
- and then Nkind_In (Operand, N_Op_Add,
- N_Op_Divide,
- N_Op_Expon,
- N_Op_Minus,
- N_Op_Multiply,
- N_Op_Subtract)
- then
- -- All conditions met, go ahead with transformation
+ begin
+ R :=
+ Make_Type_Conversion (Loc,
+ Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
+ Expression => Relocate_Node (Right_Opnd (Operand)));
- declare
- Opnd : Node_Id;
- L, R : Node_Id;
+ if Nkind (Operand) = N_Op_Minus then
+ Opnd := Make_Op_Minus (Loc, Right_Opnd => R);
- begin
- R :=
+ else
+ L :=
Make_Type_Conversion (Loc,
Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
- Expression => Relocate_Node (Right_Opnd (Operand)));
-
- if Nkind (Operand) = N_Op_Minus then
- Opnd := Make_Op_Minus (Loc, Right_Opnd => R);
-
- else
- L :=
- Make_Type_Conversion (Loc,
- Subtype_Mark => New_Reference_To (Standard_Integer, Loc),
- Expression => Relocate_Node (Left_Opnd (Operand)));
-
- case Nkind (Operand) is
- when N_Op_Add =>
- Opnd := Make_Op_Add (Loc, L, R);
- when N_Op_Divide =>
- Opnd := Make_Op_Divide (Loc, L, R);
- when N_Op_Expon =>
- Opnd := Make_Op_Expon (Loc, L, R);
- when N_Op_Multiply =>
- Opnd := Make_Op_Multiply (Loc, L, R);
- when N_Op_Subtract =>
- Opnd := Make_Op_Subtract (Loc, L, R);
- when others =>
- raise Program_Error;
- end case;
+ Expression => Relocate_Node (Left_Opnd (Operand)));
+
+ case Nkind (Operand) is
+ when N_Op_Add =>
+ Opnd := Make_Op_Add (Loc, L, R);
+ when N_Op_Divide =>
+ Opnd := Make_Op_Divide (Loc, L, R);
+ when N_Op_Expon =>
+ Opnd := Make_Op_Expon (Loc, L, R);
+ when N_Op_Multiply =>
+ Opnd := Make_Op_Multiply (Loc, L, R);
+ when N_Op_Subtract =>
+ Opnd := Make_Op_Subtract (Loc, L, R);
+ when others =>
+ raise Program_Error;
+ end case;
- Rewrite (N,
- Make_Type_Conversion (Loc,
- Subtype_Mark => Relocate_Node (Subtype_Mark (N)),
- Expression => Opnd));
+ Rewrite (N,
+ Make_Type_Conversion (Loc,
+ Subtype_Mark => Relocate_Node (Subtype_Mark (N)),
+ Expression => Opnd));
- Analyze_And_Resolve (N, Target_Type);
- return;
- end if;
- end;
- end if;
- end;
+ Analyze_And_Resolve (N, Target_Type);
+ return;
+ end if;
+ end;
+ end if;
-- Do validity check if validity checking operands
return;
end Insert_Dereference_Action;
+ --------------------------------
+ -- Integer_Promotion_Possible --
+ --------------------------------
+
+ function Integer_Promotion_Possible (N : Node_Id) return Boolean is
+ Operand : constant Node_Id := Expression (N);
+ Operand_Type : constant Entity_Id := Etype (Operand);
+ Root_Operand_Type : constant Entity_Id := Root_Type (Operand_Type);
+
+ begin
+ pragma Assert (Nkind (N) = N_Type_Conversion);
+
+ return
+
+ -- We only do the transformation for source constructs. We assume
+ -- that the expander knows what it is doing when it generates code.
+
+ Comes_From_Source (N)
+
+ -- If the operand type is Short_Integer or Short_Short_Integer,
+ -- then we will promote to Integer, which is available on all
+ -- targets, and is sufficient to ensure no intermediate overflow.
+ -- Furthermore it is likely to be as efficient or more efficient
+ -- than using the smaller type for the computation so we do this
+ -- unconditionally.
+
+ and then
+ (Root_Operand_Type = Base_Type (Standard_Short_Integer)
+ or else
+ Root_Operand_Type = Base_Type (Standard_Short_Short_Integer))
+
+ -- Test for interesting operation, which includes addition,
+ -- division, exponentiation, multiplication, subtraction, and
+ -- unary negation.
+
+ and then Nkind_In (Operand, N_Op_Add,
+ N_Op_Divide,
+ N_Op_Expon,
+ N_Op_Minus,
+ N_Op_Multiply,
+ N_Op_Subtract);
+ end Integer_Promotion_Possible;
+
------------------------------
-- Make_Array_Comparison_Op --
------------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
-- to insert those bodies at the right place. Nod provides the Sloc
-- value for generated code.
+ function Integer_Promotion_Possible (N : Node_Id) return Boolean;
+ -- Returns true if the node is a type conversion whose operand is an
+ -- arithmetic operation on signed integers, and the base type of the
+ -- signed integer type is smaller than Standard.Integer. In such case we
+ -- have special circuitry in Expand_N_Type_Conversion to promote both of
+ -- the operands to type Integer.
+
end Exp_Ch4;
@smallexample
$ gnatcheck @ovar{switches} @{@var{filename}@}
@r{[}^-files^/FILES^=@{@var{arg_list_filename}@}@r{]}
- @r{[}-cargs @var{gcc_switches}@r{]} @r{[}-rules @var{rule_options}@r{]}
+ @r{[}-cargs @var{gcc_switches}@r{]} -rules @var{rule_options}
@end smallexample
@noindent
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
end if;
end loop;
+ -- Subunits do not appear in the elaboration table because
+ -- they are subsumed by their parent units, but we need to
+ -- list them for other tools. For now they are listed after
+ -- other files, rather than following immediately their parent,
+ -- because there is no cheap link between the elaboration table
+ -- and the ALIs table.
+
+ for J in Sdep.First .. Sdep.Last loop
+ if Sdep.Table (J).Subunit_Name /= No_Name
+ and then not Is_Internal_File_Name (Sdep.Table (J).Sfile)
+ then
+ if not Zero_Formatting then
+ Write_Str (" ");
+ end if;
+
+ Write_Str
+ (Get_Name_String (Sdep.Table (J).Sfile));
+ Write_Eol;
+ end if;
+ end loop;
+
if not Zero_Formatting then
Write_Eol;
end if;
with ALI; use ALI;
with Debug;
+with Fname;
with Osint; use Osint;
with Output; use Output;
with Opt; use Opt;
if Unit_Name /= No_Name then
-- For separates, the file is no longer associated with the
- -- unit ("proc-sep.adb" is not associated with unit "proc.sep".
- -- So we need to check whether the source file still exists in
+ -- unit ("proc-sep.adb" is not associated with unit "proc.sep")
+ -- so we need to check whether the source file still exists in
-- the source tree: it will if it matches the naming scheme
-- (and then will be for the same unit).
if Find_Source
- (In_Tree => Project_Tree,
- Project => No_Project,
+ (In_Tree => Project_Tree,
+ Project => No_Project,
Base_Name => SD.Sfile) = No_Source
then
- -- If this is not a runtime file (when using -a) ? Otherwise
- -- we get complaints about a-except.adb, which uses
- -- separates.
-
- if not Check_Readonly_Files
- or else Find_File (SD.Sfile, Osint.Source) = No_File
+ -- If this is not a runtime file or if, when gnatmake switch
+ -- -a is used, we are not able to find this subunit in the
+ -- source directories, then recompilation is needed.
+
+ if not Fname.Is_Internal_File_Name (SD.Sfile)
+ or else
+ (Check_Readonly_Files and then
+ Find_File (SD.Sfile, Osint.Source) = No_File)
then
if Verbose_Mode then
Write_Line
- ("While parsing ALI file: Sdep associates "
+ ("While parsing ALI file, file "
& Get_Name_String (SD.Sfile)
- & " with unit " & Get_Name_String (Unit_Name)
+ & " is indicated as containing subunit "
+ & Get_Name_String (Unit_Name)
& " but this does not match what was found while"
& " parsing the project. Will recompile");
end if;
if Proj /= null then
Project_Node_Table.Free (Proj.Project_Nodes);
Projects_Htable.Reset (Proj.Projects_HT);
+ Free (Proj.Project_Path);
Unchecked_Free (Proj);
end if;
end Free;
Attempts : Natural := 0;
Current : String (Current_Temp_File_Name'Range);
+ ---------------------------------
+ -- Create_New_Output_Text_File --
+ ---------------------------------
+
+ function Create_New_Output_Text_File
+ (Name : String) return File_Descriptor;
+ -- Similar to Create_Output_Text_File, except it fails if the file
+ -- already exists. We need this behavior to ensure we don't accidentally
+ -- open a temp file that has just been created by a concurrently running
+ -- process. There is no point exposing this function, as it's generally
+ -- not particularly useful.
+
+ function Create_New_Output_Text_File
+ (Name : String) return File_Descriptor is
+ function C_Create_File
+ (Name : C_File_Name) return File_Descriptor;
+ pragma Import (C, C_Create_File, "__gnat_create_output_file_new");
+
+ C_Name : String (1 .. Name'Length + 1);
+
+ begin
+ C_Name (1 .. Name'Length) := Name;
+ C_Name (C_Name'Last) := ASCII.NUL;
+ return C_Create_File (C_Name (C_Name'First)'Address);
+ end Create_New_Output_Text_File;
+
begin
-- Loop until a new temp file can be created
-- Attempt to create the file
if Stdout then
- FD := Create_Output_Text_File (Current);
+ FD := Create_New_Output_Text_File (Current);
else
- FD := Create_File (Current, Binary);
+ FD := Create_New_File (Current, Binary);
end if;
if FD /= Invalid_FD then
-- It is the responsibility of the caller to deallocate the access value
-- returned in Name.
--
- -- The file is opened in the mode specified by the With_Mode parameter.
+ -- The file is opened in text mode.
--
-- This procedure will always succeed if the current working directory is
-- writable. If the current working directory is not writable, then
Lo :=
Make_Attribute_Reference (Loc,
Attribute_Name => Name_First,
- Prefix => New_Reference_To (T, Loc));
+ Prefix => New_Reference_To (T, Loc));
Set_Etype (Lo, T);
Hi :=
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Last,
- Prefix => New_Reference_To (T, Loc));
+ Prefix => New_Reference_To (T, Loc));
Set_Etype (Hi, T);
Set_Scalar_Range (T,
Make_Range (Loc,
- Low_Bound => Lo,
+ Low_Bound => Lo,
High_Bound => Hi));
Set_Ekind (Base, E_Enumeration_Type);
OSDN Git Service
