diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 58 | ||||
| -rw-r--r-- | gcc/ada/decl.c | 9 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 389 | ||||
| -rw-r--r-- | gcc/ada/prj-attr.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/prj-nmsc.adb | 98 | ||||
| -rw-r--r-- | gcc/ada/prj.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 9 | ||||
| -rw-r--r-- | gcc/ada/snames.adb | 45 | ||||
| -rw-r--r-- | gcc/ada/snames.ads | 66 | ||||
| -rw-r--r-- | gcc/ada/trans.c | 9 |
10 files changed, 516 insertions, 169 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 76ab8a01779..69ad3d71611 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,61 @@ +2001-12-17 Vincent Celier <celier@gnat.com> + + * make.adb: + (Switches_Of): New function + (Test_If_Relative_Path): New procedure + (Add_Switches): Use new function Switches_Of + (Collect_Arguments_And_Compile): Use new function Switches_Of. + When using a project file, test if there are any relative + search path. Fail if there are any. + (Gnatmake): Only add switches for the primary directory when not using + a project file. When using a project file, change directory to the + object directory of the main project file. When using a project file, + test if there are any relative search path. Fail if there are any. + When using a project file, fail if specified executable is relative + path with directory information, and prepend executable, if not + specified as an absolute path, with the exec directory. Make sure + that only one -o switch is transmitted to the linker. + + * prj-attr.adb (Initialization_Data): Add project attribute Exec_Dir + + * prj-nmsc.adb: + (Ada_Check): Get Spec_Suffix_Loc and Impl_Suffix_Loc, + when using a non standard naming scheme. + (Check_Ada_Naming_Scheme): Make sure that error messages + do not raise exceptions. + (Is_Illegal_Append): Return True if there is no dot in the suffix. + (Language_Independent_Check): Check the exec directory. + + * prj.adb (Project_Empty): Add new component Exec_Directory + + * prj.ads: + (Default_Ada_Spec_Suffix, Default_Ada_Impl_Suffix): Add defaults. + (Project_Data): Add component Exec_Directory + + * snames.adb: Updated to match snames.ads revision 1.215 + + * snames.ads: Added Exec_Dir + +2001-12-17 Robert Dewar <dewar@gnat.com> + + * make.adb: Minor reformatting + + * prj-nmsc.adb: Minor reformatting + + * snames.adb: Updated to match snames.ads + + * snames.ads: Alphebetize entries for project file + +2001-12-17 Ed Schonberg <schonber@gnat.com> + + * trans.c (process_freeze_entity): Do nothing if the entity is a + subprogram that was already elaborated. + +2001-12-17 Richard Kenner <kenner@gnat.com> + + * decl.c (gnat_to_gnu_entity, object): Do not back-annotate Alignment + and Esize if object is referenced via pointer. + 2001-12-17 Ed Schonberg <schonber@gnat.com> * sem_ch3.adb (Analyze_Variant_Part): check that type of discriminant diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index 6207cb76054..9cf7815b7c0 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -1060,12 +1060,15 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) } /* Back-annotate the Alignment of the object if not already in the - tree. Likewise for Esize if the object is of a constant size. */ - if (Unknown_Alignment (gnat_entity)) + tree. Likewise for Esize if the object is of a constant size. + But if the "object" is actually a pointer to an object, the + alignment and size are the same as teh type, so don't back-annotate + the values for the pointer. */ + if (! used_by_ref && Unknown_Alignment (gnat_entity)) Set_Alignment (gnat_entity, UI_From_Int (DECL_ALIGN (gnu_decl) / BITS_PER_UNIT)); - if (Unknown_Esize (gnat_entity) + if (! used_by_ref && Unknown_Esize (gnat_entity) && DECL_SIZE (gnu_decl) != 0) { tree gnu_back_size = DECL_SIZE (gnu_decl); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 739fbee2f49..a18c81e68cd 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- $Revision: 1.5 $ +-- $Revision$ -- -- -- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- -- -- @@ -28,7 +28,9 @@ with Ada.Exceptions; use Ada.Exceptions; with Ada.Command_Line; use Ada.Command_Line; -with GNAT.OS_Lib; use GNAT.OS_Lib; + +with GNAT.Directory_Operations; use GNAT.Directory_Operations; +with GNAT.OS_Lib; use GNAT.OS_Lib; with ALI; use ALI; with ALI.Util; use ALI.Util; @@ -376,6 +378,25 @@ package body Make is -- The caller process ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are -- not affected. + function Switches_Of + (Source_File : Name_Id; + Source_File_Name : String; + Naming : Naming_Data; + In_Package : Package_Id; + Allow_ALI : Boolean) + return Variable_Value; + -- Return the switches for the source file in the specified package + -- of a project file. If the Source_File ends with a standard GNAT + -- extension (".ads" or ".adb"), try first the full name, then the + -- name without the extension. If there is no switches for either + -- names, try the default switches for Ada. If all failed, return + -- No_Variable_Value. + + procedure Test_If_Relative_Path (Switch : String_Access); + -- Test if Switch is a relative search path switch. + -- Fail if it is. This subprogram is only called + -- when using project files. + procedure Set_Library_For (Project : Project_Id; There_Are_Libraries : in out Boolean); @@ -630,27 +651,18 @@ package body Make is Switch_List : String_List_Id; Element : String_Element; - Switches_Array : constant Array_Element_Id := - Prj.Util.Value_Of - (Name => Name_Switches, - In_Arrays => Packages.Table (The_Package).Decl.Arrays); - Default_Switches_Array : constant Array_Element_Id := - Prj.Util.Value_Of - (Name => Name_Default_Switches, - In_Arrays => Packages.Table (The_Package).Decl.Arrays); - begin if File_Name'Length > 0 then Name_Len := File_Name'Length; Name_Buffer (1 .. Name_Len) := File_Name; Switches := - Prj.Util.Value_Of (Index => Name_Find, In_Array => Switches_Array); - - if Switches = Nil_Variable_Value then - Switches := Prj.Util.Value_Of - (Index => Name_Ada, - In_Array => Default_Switches_Array); - end if; + Switches_Of + (Source_File => Name_Find, + Source_File_Name => File_Name, + Naming => Projects.Table (Main_Project).Naming, + In_Package => The_Package, + Allow_ALI => + Program = Binder or else Program = Linker); case Switches.Kind is when Undefined => @@ -861,30 +873,30 @@ package body Make is -- Data declarations for Check -- --------------------------------- - Full_Lib_File : File_Name_Type; + Full_Lib_File : File_Name_Type; -- Full name of current library file - Full_Obj_File : File_Name_Type; + Full_Obj_File : File_Name_Type; -- Full name of the object file corresponding to Lib_File. - Lib_Stamp : Time_Stamp_Type; + Lib_Stamp : Time_Stamp_Type; -- Time stamp of the current ada library file. - Obj_Stamp : Time_Stamp_Type; + Obj_Stamp : Time_Stamp_Type; -- Time stamp of the current object file. - Modified_Source : File_Name_Type; + Modified_Source : File_Name_Type; -- The first source in Lib_File whose current time stamp differs -- from that stored in Lib_File. - New_Spec : File_Name_Type; + New_Spec : File_Name_Type; -- If Lib_File contains in its W (with) section a body (for a -- subprogram) for which there exists a spec and the spec did not -- appear in the Sdep section of Lib_File, New_Spec contains the file -- name of this new spec. Source_Name : Name_Id; - Text : Text_Buffer_Ptr; + Text : Text_Buffer_Ptr; Prev_Switch : Character; -- First character of previous switch processed @@ -1034,6 +1046,8 @@ package body Make is end if; end loop; + -- Special_Arg is non-null + else for J in Special_Arg'Range loop @@ -1679,34 +1693,14 @@ package body Make is -- the specific switches for the current source, -- or the global switches, if any. - declare - Defaults : constant Array_Element_Id := - Prj.Util.Value_Of - (Name => Name_Default_Switches, - In_Arrays => - Packages.Table - (Compiler_Package) .Decl.Arrays); - - Switches_Array : constant Array_Element_Id := - Prj.Util.Value_Of - (Name => Name_Switches, - In_Arrays => - Packages.Table - (Compiler_Package). - Decl.Arrays); + Switches := Switches_Of + (Source_File => Source_File, + Source_File_Name => Source_File_Name, + Naming => + Projects.Table (Current_Project).Naming, + In_Package => Compiler_Package, + Allow_ALI => False); - begin - Switches := - Prj.Util.Value_Of - (Index => Source_File, - In_Array => Switches_Array); - - if Switches = Nil_Variable_Value then - Switches := - Prj.Util.Value_Of - (Index => Name_Ada, In_Array => Defaults); - end if; - end; end if; case Switches.Kind is @@ -1739,6 +1733,7 @@ package body Make is String_To_Name_Buffer (Element.Value); New_Args (Index) := new String' (Name_Buffer (1 .. Name_Len)); + Test_If_Relative_Path (New_Args (Index)); Current := Element.Next; end loop; @@ -1764,6 +1759,7 @@ package body Make is (Name_Buffer (1 .. Name_Len))); begin + Test_If_Relative_Path (New_Args (1)); Pid := Compile (Path_Name, Lib_File, @@ -2388,7 +2384,6 @@ package body Make is end loop; end; end if; - end Compile_Sources; ------------- @@ -2551,11 +2546,11 @@ package body Make is declare Main_Id : constant Name_Id := Name_Find; - Mains : constant Prj.Variable_Value := - Prj.Util.Value_Of - (Variable_Name => Main_Id, - In_Variables => - Projects.Table (Main_Project).Decl.Attributes); + Mains : constant Prj.Variable_Value := + Prj.Util.Value_Of + (Variable_Name => Main_Id, + In_Variables => + Projects.Table (Main_Project).Decl.Attributes); Value : String_List_Id := Mains.Values; @@ -2615,21 +2610,22 @@ package body Make is if Project_File_Name = null then Add_Switch ("-I-", Compiler, And_Save => True); Add_Switch ("-I-", Binder, And_Save => True); - end if; - if Opt.Look_In_Primary_Dir then + if Opt.Look_In_Primary_Dir then - Add_Switch - ("-I" & - Normalize_Directory_Name - (Get_Primary_Src_Search_Directory.all).all, - Compiler, Append_Switch => False, - And_Save => False); + Add_Switch + ("-I" & + Normalize_Directory_Name + (Get_Primary_Src_Search_Directory.all).all, + Compiler, Append_Switch => False, + And_Save => False); + + Add_Switch ("-aO" & Normalized_CWD, + Binder, + Append_Switch => False, + And_Save => False); + end if; - Add_Switch ("-aO" & Normalized_CWD, - Binder, - Append_Switch => False, - And_Save => False); end if; -- If the user wants a program without a main subprogram, add the @@ -2641,6 +2637,9 @@ package body Make is if Main_Project /= No_Project then + Change_Dir + (Get_Name_String (Projects.Table (Main_Project).Object_Directory)); + -- Find the file name of the main unit declare @@ -2859,12 +2858,26 @@ package body Make is for J in 1 .. Saved_Gcc_Switches.Last loop The_Saved_Gcc_Switches (J) := Saved_Gcc_Switches.Table (J); + Test_If_Relative_Path (The_Saved_Gcc_Switches (J)); end loop; -- We never use gnat.adc when a project file is used The_Saved_Gcc_Switches (The_Saved_Gcc_Switches'Last) := No_gnat_adc; + + for J in 1 .. Gcc_Switches.Last loop + Test_If_Relative_Path (Gcc_Switches.Table (J)); + end loop; + + for J in 1 .. Binder_Switches.Last loop + Test_If_Relative_Path (Binder_Switches.Table (J)); + end loop; + + for J in 1 .. Linker_Switches.Last loop + Test_If_Relative_Path (Linker_Switches.Table (J)); + end loop; + end if; -- If there was a --GCC, --GNATBIND or --GNATLINK switch on @@ -2939,7 +2952,9 @@ package body Make is -- Look inside the linker switches to see if the name -- of the final executable program was specified. - for J in Linker_Switches.First .. Linker_Switches.Last loop + for + J in reverse Linker_Switches.First .. Linker_Switches.Last + loop if Linker_Switches.Table (J).all = Output_Flag.all then pragma Assert (J < Linker_Switches.Last); @@ -2998,6 +3013,7 @@ package body Make is (Projects.Table (Main_Project). Naming.Current_Impl_Suffix); + Spec_Append : constant String := Get_Name_String (Projects.Table @@ -3013,12 +3029,10 @@ package body Make is Body_Append then -- We have found the body termination. We remove it - -- add the executable termination (if any) and set - -- Non_Std_Executable. + -- add the executable termination, if any. Name_Len := Name_Len - Body_Append'Length; Executable := Executable_Name (Name_Find); - Non_Std_Executable := True; elsif Name_Len > Spec_Append'Length and then @@ -3027,21 +3041,57 @@ package body Make is Spec_Append then -- We have found the spec termination. We remove - -- it, add the executable termination (if any), - -- and set Non_Std_Executable. + -- it, add the executable termination, if any. Name_Len := Name_Len - Spec_Append'Length; Executable := Executable_Name (Name_Find); - Non_Std_Executable := True; else Executable := Executable_Name (Strip_Suffix (Main_Source_File)); end if; + end; end if; end if; + if Main_Project /= No_Project then + declare + Exec_File_Name : constant String := + Get_Name_String (Executable); + + begin + if not Is_Absolute_Path (Exec_File_Name) then + for Index in Exec_File_Name'Range loop + if Exec_File_Name (Index) = Directory_Separator then + Fail ("relative executable (""" & + Exec_File_Name & + """) with directory part not allowed " & + "when using project files"); + end if; + end loop; + + Get_Name_String (Projects.Table + (Main_Project).Exec_Directory); + + if + Name_Buffer (Name_Len) /= Directory_Separator + then + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Directory_Separator; + end if; + + Name_Buffer (Name_Len + 1 .. + Name_Len + Exec_File_Name'Length) := + Exec_File_Name; + Name_Len := Name_Len + Exec_File_Name'Length; + Executable := Name_Find; + Non_Std_Executable := True; + end if; + end; + + end if; + -- Now we invoke Compile_Sources for the current main Compile_Sources @@ -3212,7 +3262,6 @@ package body Make is end if; end if; end Recursive_Compilation_Step; - end if; -- If we are here, it means that we need to rebuilt the current @@ -3243,7 +3292,10 @@ package body Make is Main_ALI_File := Full_Lib_File_Name (Main_ALI_File); end if; - pragma Assert (Main_ALI_File /= No_File); + if Main_ALI_File = No_File then + Fail ("could not find the main ALI file"); + end if; + end Main_ALI_In_Place_Mode_Step; if Do_Bind_Step then @@ -3268,7 +3320,6 @@ package body Make is Bind (Main_ALI_File, Args); end Bind_Step; - end if; if Do_Link_Step then @@ -3278,7 +3329,6 @@ package body Make is Linker_Switches_Last : constant Integer := Linker_Switches.Last; begin - if Main_Project /= No_Project then if MLib.Tgt.Libraries_Are_Supported then @@ -3310,9 +3360,7 @@ package body Make is Linker_Switches.Table (Linker_Switches.Last) := Option; end if; - end; - end if; -- Put the object directories in ADA_OBJECTS_PATH @@ -3322,34 +3370,50 @@ package body Make is declare Args : Argument_List - (Linker_Switches.First .. Linker_Switches.Last + 2); + (Linker_Switches.First .. Linker_Switches.Last + 2); + + Last_Arg : Integer := Linker_Switches.First - 1; + Skip : Boolean := False; begin -- Get all the linker switches for J in Linker_Switches.First .. Linker_Switches.Last loop - Args (J) := Linker_Switches.Table (J); + if Skip then + Skip := False; + + elsif Non_Std_Executable + and then Linker_Switches.Table (J).all = "-o" + then + Skip := True; + + else + Last_Arg := Last_Arg + 1; + Args (Last_Arg) := Linker_Switches.Table (J); + end if; + end loop; -- And invoke the linker if Non_Std_Executable then - Args (Linker_Switches.Last + 1) := new String'("-o"); - Args (Linker_Switches.Last + 2) := + Last_Arg := Last_Arg + 1; + Args (Last_Arg) := new String'("-o"); + Last_Arg := Last_Arg + 1; + Args (Last_Arg) := new String'(Get_Name_String (Executable)); - Link (Main_ALI_File, Args); + Link (Main_ALI_File, Args (Args'First .. Last_Arg)); else Link (Main_ALI_File, - Args (Linker_Switches.First .. Linker_Switches.Last)); + Args (Args'First .. Last_Arg)); end if; end; Linker_Switches.Set_Last (Linker_Switches_Last); end Link_Step; - end if; -- We go to here when we skip the bind and link steps. @@ -3592,7 +3656,6 @@ package body Make is when Err : SFN_Scan.Syntax_Error_In_GNAT_ADC => Osint.Fail (Exception_Message (Err)); end; - end Initialize; ----------------------------------- @@ -4515,6 +4578,150 @@ package body Make is end if; end Set_Library_For; + ----------------- + -- Switches_Of -- + ----------------- + + function Switches_Of + (Source_File : Name_Id; + Source_File_Name : String; + Naming : Naming_Data; + In_Package : Package_Id; + Allow_ALI : Boolean) + return Variable_Value + is + Switches : Variable_Value; + + Defaults : constant Array_Element_Id := + Prj.Util.Value_Of + (Name => Name_Default_Switches, + In_Arrays => + Packages.Table (In_Package).Decl.Arrays); + + Switches_Array : constant Array_Element_Id := + Prj.Util.Value_Of + (Name => Name_Switches, + In_Arrays => + Packages.Table (In_Package).Decl.Arrays); + + begin + Switches := + Prj.Util.Value_Of + (Index => Source_File, + In_Array => Switches_Array); + + if Switches = Nil_Variable_Value then + declare + Name : String (1 .. Source_File_Name'Length + 3); + Last : Positive := Source_File_Name'Length; + Spec_Suffix : constant String := + Get_Name_String (Naming.Current_Spec_Suffix); + Impl_Suffix : constant String := + Get_Name_String (Naming.Current_Impl_Suffix); + Truncated : Boolean := False; + + begin + Name (1 .. Last) := Source_File_Name; + + if Last > Impl_Suffix'Length + and then Name (Last - Impl_Suffix'Length + 1 .. Last) = + Impl_Suffix + then + Truncated := True; + Last := Last - Impl_Suffix'Length; + end if; + + if not Truncated + and then Last > Spec_Suffix'Length + and then Name (Last - Spec_Suffix'Length + 1 .. Last) = + Spec_Suffix + then + Truncated := True; + Last := Last - Spec_Suffix'Length; + end if; + + if Truncated then + Name_Len := Last; + Name_Buffer (1 .. Name_Len) := Name (1 .. Last); + Switches := + Prj.Util.Value_Of + (Index => Name_Find, + In_Array => Switches_Array); + + if Switches = Nil_Variable_Value then + Last := Source_File_Name'Length; + + while Name (Last) /= '.' loop + Last := Last - 1; + end loop; + + Name (Last + 1 .. Last + 3) := "ali"; + Name_Len := Last + 3; + Name_Buffer (1 .. Name_Len) := Name (1 .. Name_Len); + Switches := + Prj.Util.Value_Of + (Index => Name_Find, + In_Array => Switches_Array); + end if; + end if; + end; + end if; + + if Switches = Nil_Variable_Value then + Switches := Prj.Util.Value_Of + (Index => Name_Ada, In_Array => Defaults); + end if; + + return Switches; + end Switches_Of; + + --------------------------- + -- Test_If_Relative_Path -- + --------------------------- + + procedure Test_If_Relative_Path (Switch : String_Access) is + begin + if Switch /= null then + + declare + Sw : String (1 .. Switch'Length); + Start : Positive; + + begin + Sw := Switch.all; + + if Sw (1) = '-' then + if Sw'Length >= 3 + and then (Sw (2) = 'A' + or else Sw (2) = 'I' + or else Sw (2) = 'L') + then + Start := 3; + + if Sw = "-I-" then + return; + end if; + + elsif Sw'Length >= 4 + and then (Sw (2 .. 3) = "aL" + or else Sw (2 .. 3) = "aO" + or else Sw (2 .. 3) = "aI") + then + Start := 4; + + else + return; + end if; + + if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then + Fail ("relative search path switches (""" & + Sw & """) are not allowed when using project files"); + end if; + end if; + end; + end if; + end Test_If_Relative_Path; + ------------ -- Unmark -- ------------ diff --git a/gcc/ada/prj-attr.adb b/gcc/ada/prj-attr.adb index 6710f2119df..b9ed55b6eb6 100644 --- a/gcc/ada/prj-attr.adb +++ b/gcc/ada/prj-attr.adb @@ -54,6 +54,7 @@ package body Prj.Attr is -- project attributes "SVobject_dir#" & + "SVexec_dir#" & "LVsource_dirs#" & "LVsource_files#" & "SVsource_list_file#" & diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 56075cf292d..9f11f6f0170 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -628,14 +628,18 @@ package body Prj.Nmsc is -- Check Specification_Suffix declare - Ada_Spec_Suffix : constant Name_Id := + Ada_Spec_Suffix : constant Variable_Value := Prj.Util.Value_Of (Index => Name_Ada, In_Array => Data.Naming.Specification_Suffix); begin - if Ada_Spec_Suffix /= No_Name then - Data.Naming.Current_Spec_Suffix := Ada_Spec_Suffix; + if Ada_Spec_Suffix.Kind = Single + and then String_Length (Ada_Spec_Suffix.Value) /= 0 + then + String_To_Name_Buffer (Ada_Spec_Suffix.Value); + Data.Naming.Current_Spec_Suffix := Name_Find; + Data.Naming.Spec_Suffix_Loc := Ada_Spec_Suffix.Location; else Data.Naming.Current_Spec_Suffix := Default_Ada_Spec_Suffix; @@ -652,14 +656,18 @@ package body Prj.Nmsc is -- Check Implementation_Suffix declare - Ada_Impl_Suffix : constant Name_Id := + Ada_Impl_Suffix : constant Variable_Value := Prj.Util.Value_Of (Index => Name_Ada, In_Array => Data.Naming.Implementation_Suffix); begin - if Ada_Impl_Suffix /= No_Name then - Data.Naming.Current_Impl_Suffix := Ada_Impl_Suffix; + if Ada_Impl_Suffix.Kind = Single + and then String_Length (Ada_Impl_Suffix.Value) /= 0 + then + String_To_Name_Buffer (Ada_Impl_Suffix.Value); + Data.Naming.Current_Impl_Suffix := Name_Find; + Data.Naming.Impl_Suffix_Loc := Ada_Impl_Suffix.Location; else Data.Naming.Current_Impl_Suffix := Default_Ada_Impl_Suffix; @@ -920,9 +928,9 @@ package body Prj.Nmsc is end if; end Check_Ada_Name; - ------------------------- - -- Check_Naming_Scheme -- - ------------------------- + ----------------------------- + -- Check_Ada_Naming_Scheme -- + ----------------------------- procedure Check_Ada_Naming_Scheme (Naming : Naming_Data) is begin @@ -982,24 +990,24 @@ package body Prj.Nmsc is -- - start with an '_' followed by an alphanumeric if Is_Illegal_Append (Specification_Suffix) then + Error_Msg_Name_1 := Naming.Current_Spec_Suffix; Error_Msg - ('"' & Specification_Suffix & - """ is illegal for Specification_Suffix.", + ("{ is illegal for Specification_Suffix", Naming.Spec_Suffix_Loc); end if; if Is_Illegal_Append (Implementation_Suffix) then + Error_Msg_Name_1 := Naming.Current_Impl_Suffix; Error_Msg - ('"' & Implementation_Suffix & - """ is illegal for Implementation_Suffix.", + ("% is illegal for Implementation_Suffix", Naming.Impl_Suffix_Loc); end if; if Implementation_Suffix /= Separate_Suffix then if Is_Illegal_Append (Separate_Suffix) then + Error_Msg_Name_1 := Naming.Separate_Suffix; Error_Msg - ('"' & Separate_Suffix & - """ is illegal for Separate_Append.", + ("{ is illegal for Separate_Append", Naming.Sep_Suffix_Loc); end if; end if; @@ -1039,6 +1047,7 @@ package body Prj.Nmsc is end if; end; end if; + end Check_Ada_Naming_Scheme; --------------- @@ -1430,6 +1439,7 @@ package body Prj.Nmsc is begin return This'Length = 0 or else Is_Alphanumeric (This (This'First)) + or else Index (This, ".") = 0 or else (This'Length >= 2 and then This (This'First) = '_' and then Is_Alphanumeric (This (This'First + 1))); @@ -1701,7 +1711,7 @@ package body Prj.Nmsc is Write_Line ("Starting to look for directories"); end if; - -- Let's check the object directory + -- Check the object directory declare Object_Dir : Variable_Value := @@ -1757,6 +1767,62 @@ package body Prj.Nmsc is end if; end if; + -- Check the exec directory + + declare + Exec_Dir : Variable_Value := + Util.Value_Of (Name_Exec_Dir, Data.Decl.Attributes); + + begin + pragma Assert (Exec_Dir.Kind = Single, + "Exec_Dir is not a single string"); + + -- We set the object directory to its default + + Data.Exec_Directory := Data.Object_Directory; + + if not String_Equal (Exec_Dir.Value, Empty_String) then + + String_To_Name_Buffer (Exec_Dir.Value); + + if Name_Len = 0 then + Error_Msg ("Exec_Dir cannot be empty", + Exec_Dir.Location); + + else + -- We check that the specified object directory + -- does exist. + + Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); + + declare + Dir_Id : constant Name_Id := Name_Find; + + begin + Data.Exec_Directory := + Locate_Directory (Dir_Id, Data.Directory); + + if Data.Exec_Directory = No_Name then + Error_Msg_Name_1 := Dir_Id; + Error_Msg + ("the exec directory { cannot be found", + Data.Location); + end if; + end; + end if; + end if; + end; + + if Current_Verbosity = High then + if Data.Exec_Directory = No_Name then + Write_Line ("No exec directory"); + else + Write_Str ("Exec directory: """); + Write_Str (Get_Name_String (Data.Exec_Directory)); + Write_Line (""""); + end if; + end if; + -- Look for the source directories declare diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index ca6758e55ab..e03d83884f7 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -89,6 +89,7 @@ package body Prj is Sources => Nil_String, Source_Dirs => Nil_String, Object_Directory => No_Name, + Exec_Directory => No_Name, Modifies => No_Project, Modified_By => No_Project, Naming => Std_Naming_Data, diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index eb02bf4804a..d121c2dd5f2 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -40,11 +40,11 @@ with Types; use Types; package Prj is - Default_Ada_Spec_Suffix : Name_Id := No_Name; + Default_Ada_Spec_Suffix : Name_Id; -- The Name_Id for the standard GNAT suffix for Ada spec source file -- name ".ads". Initialized by Prj.Initialize. - Default_Ada_Impl_Suffix : Name_Id := No_Name; + Default_Ada_Impl_Suffix : Name_Id; -- The Name_Id for the standard GNAT suffix for Ada body source file -- name ".adb". Initialized by Prj.Initialize. @@ -366,6 +366,11 @@ package Prj is -- The object directory of this project file. -- Set by Prj.Nmsc.Check_Naming_Scheme. + Exec_Directory : Name_Id := No_Name; + -- The exec directory of this project file. + -- Default is equal to Object_Directory. + -- Set by Prj.Nmsc.Check_Naming_Scheme. + Modifies : Project_Id := No_Project; -- The reference of the project file, if any, that this -- project file modifies. diff --git a/gcc/ada/snames.adb b/gcc/ada/snames.adb index d72b0b8f1ca..5ffb23d9922 100644 --- a/gcc/ada/snames.adb +++ b/gcc/ada/snames.adb @@ -566,36 +566,37 @@ package body Snames is "requeue#" & "tagged#" & "raise_exception#" & - "project#" & + "binder#" & + "builder#" & + "compiler#" & + "cross_reference#" & + "default_switches#" & + "exec_dir#" & "extends#" & - "naming#" & - "object_dir#" & - "source_dirs#" & - "specification#" & + "finder#" & + "gnatls#" & + "gnatstub#" & "implementation#" & - "specification_exceptions#" & "implementation_exceptions#" & - "specification_suffix#" & "implementation_suffix#" & - "separate_suffix#" & - "source_files#" & - "source_list_file#" & - "default_switches#" & - "switches#" & + "languages#" & "library_dir#" & - "library_name#" & + "library_elaboration#" & "library_kind#" & + "library_name#" & "library_version#" & - "library_elaboration#" & - "languages#" & - "builder#" & - "gnatls#" & - "cross_reference#" & - "finder#" & - "binder#" & "linker#" & - "compiler#" & - "gnatstub#" & + "naming#" & + "object_dir#" & + "project#" & + "separate_suffix#" & + "source_dirs#" & + "source_files#" & + "source_list_file#" & + "specification#" & + "specification_exceptions#" & + "specification_suffix#" & + "switches#" & "#"; --------------------- diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads index f56403f1282..f1e29eab175 100644 --- a/gcc/ada/snames.ads +++ b/gcc/ada/snames.ads @@ -861,44 +861,40 @@ package Snames is -- Additional reserved words in GNAT Project Files -- Note that Name_External is already previously declared - Name_Project : constant Name_Id := N + 523; - Name_Extends : constant Name_Id := N + 524; - - -- Names used in GNAT Project Files - - Name_Naming : constant Name_Id := N + 525; - Name_Object_Dir : constant Name_Id := N + 526; - Name_Source_Dirs : constant Name_Id := N + 527; - Name_Specification : constant Name_Id := N + 528; - Name_Implementation : constant Name_Id := N + 529; - Name_Specification_Exceptions : constant Name_Id := N + 530; - Name_Implementation_Exceptions : constant Name_Id := N + 531; - Name_Specification_Suffix : constant Name_Id := N + 532; - Name_Implementation_Suffix : constant Name_Id := N + 533; - Name_Separate_Suffix : constant Name_Id := N + 534; - Name_Source_Files : constant Name_Id := N + 535; - Name_Source_List_File : constant Name_Id := N + 536; - Name_Default_Switches : constant Name_Id := N + 537; - Name_Switches : constant Name_Id := N + 538; - Name_Library_Dir : constant Name_Id := N + 539; + Name_Binder : constant Name_Id := N + 523; + Name_Builder : constant Name_Id := N + 524; + Name_Compiler : constant Name_Id := N + 525; + Name_Cross_Reference : constant Name_Id := N + 526; + Name_Default_Switches : constant Name_Id := N + 527; + Name_Exec_Dir : constant Name_Id := N + 528; + Name_Extends : constant Name_Id := N + 529; + Name_Finder : constant Name_Id := N + 530; + Name_Gnatls : constant Name_Id := N + 531; + Name_Gnatstub : constant Name_Id := N + 532; + Name_Implementation : constant Name_Id := N + 533; + Name_Implementation_Exceptions : constant Name_Id := N + 534; + Name_Implementation_Suffix : constant Name_Id := N + 535; + Name_Languages : constant Name_Id := N + 536; + Name_Library_Dir : constant Name_Id := N + 537; + Name_Library_Elaboration : constant Name_Id := N + 538; + Name_Library_Kind : constant Name_Id := N + 539; Name_Library_Name : constant Name_Id := N + 540; - Name_Library_Kind : constant Name_Id := N + 541; - Name_Library_Version : constant Name_Id := N + 542; - Name_Library_Elaboration : constant Name_Id := N + 543; - Name_Languages : constant Name_Id := N + 544; - - Name_Builder : constant Name_Id := N + 545; - Name_Gnatls : constant Name_Id := N + 546; - Name_Cross_Reference : constant Name_Id := N + 547; - Name_Finder : constant Name_Id := N + 548; - Name_Binder : constant Name_Id := N + 549; - Name_Linker : constant Name_Id := N + 550; - Name_Compiler : constant Name_Id := N + 551; - Name_Gnatstub : constant Name_Id := N + 552; - + Name_Library_Version : constant Name_Id := N + 541; + Name_Linker : constant Name_Id := N + 542; + Name_Naming : constant Name_Id := N + 543; + Name_Object_Dir : constant Name_Id := N + 544; + Name_Project : constant Name_Id := N + 545; + Name_Separate_Suffix : constant Name_Id := N + 546; + Name_Source_Dirs : constant Name_Id := N + 547; + Name_Source_Files : constant Name_Id := N + 548; + Name_Source_List_File : constant Name_Id := N + 549; + Name_Specification : constant Name_Id := N + 550; + Name_Specification_Exceptions : constant Name_Id := N + 551; + Name_Specification_Suffix : constant Name_Id := N + 552; + Name_Switches : constant Name_Id := N + 553; -- Mark last defined name for consistency check in Snames body - Last_Predefined_Name : constant Name_Id := N + 552; + Last_Predefined_Name : constant Name_Id := N + 553; subtype Any_Operator_Name is Name_Id range First_Operator_Name .. Last_Operator_Name; diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c index e158a6e9dbf..1d6bf982559 100644 --- a/gcc/ada/trans.c +++ b/gcc/ada/trans.c @@ -3993,6 +3993,15 @@ process_freeze_entity (gnat_node) && Present (Equivalent_Type (gnat_entity)))) return; + /* Don't do anything for subprograms that may have been elaborated before + their freeze nodes. This can happen, for example because of an inner call + in an instance body. */ + if (gnu_old != 0 + && TREE_CODE (gnu_old) == FUNCTION_DECL + && (Ekind (gnat_entity) == E_Function + || Ekind (gnat_entity) == E_Procedure)) + return; + /* If we have a non-dummy type old tree, we have nothing to do. Unless this is the public view of a private type whose full view was not delayed, this node was never delayed as it should have been. |