From a5fe079c34eeafbc36a1620fbd9ab5aa974c6413 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 30 Jul 2012 17:21:46 +0200 Subject: [PATCH] [multiple changes] 2012-07-30 Robert Dewar * bindusg.adb: Clarify file in -A lines. 2012-07-30 Robert Dewar * freeze.adb: Minor reformatting. 2012-07-30 Robert Dewar * gnatcmd.adb, makeutl.adb, makeutl.ads: Minor code reorganization. 2012-07-30 Vincent Pucci * exp_ch9.adb (Build_Lock_Free_Unprotected_Subprogram_Body): Minor reformatting. * sem_ch9.adb (Allows_Lock_Free_Implementation): Minor reformatting. Capture the correct error message in case of a quantified expression. 2012-07-30 Thomas Quinot * g-socket.adb (Get_Socket_Option, Set_Socket_Option): On Windows, the value is a milliseconds count in a DWORD, not a struct timeval. From-SVN: r189979 --- gcc/ada/ChangeLog | 24 +++++ gcc/ada/bindusg.adb | 5 +- gcc/ada/exp_ch9.adb | 11 +-- gcc/ada/freeze.adb | 4 +- gcc/ada/g-socket.adb | 70 +++++++++++++-- gcc/ada/gnatcmd.adb | 172 ++++++++++++++++++------------------ gcc/ada/makeutl.adb | 206 +++++++++++++++++++++---------------------- gcc/ada/makeutl.ads | 87 +++++++++--------- gcc/ada/sem_ch9.adb | 13 ++- 9 files changed, 340 insertions(+), 252 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index aa72155f1e4..61bdbc76be0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2012-07-30 Robert Dewar + + * bindusg.adb: Clarify file in -A lines. + +2012-07-30 Robert Dewar + + * freeze.adb: Minor reformatting. + +2012-07-30 Robert Dewar + + * gnatcmd.adb, makeutl.adb, makeutl.ads: Minor code reorganization. + +2012-07-30 Vincent Pucci + + * exp_ch9.adb (Build_Lock_Free_Unprotected_Subprogram_Body): Minor + reformatting. + * sem_ch9.adb (Allows_Lock_Free_Implementation): Minor reformatting. + Capture the correct error message in case of a quantified expression. + +2012-07-30 Thomas Quinot + + * g-socket.adb (Get_Socket_Option, Set_Socket_Option): On Windows, the + value is a milliseconds count in a DWORD, not a struct timeval. + 2012-07-30 Hristian Kirtchev * sem_ch12.adb (Earlier): Add local variables T1 and T2. Minor code diff --git a/gcc/ada/bindusg.adb b/gcc/ada/bindusg.adb index 6b1751bcadc..e9d39504af1 100644 --- a/gcc/ada/bindusg.adb +++ b/gcc/ada/bindusg.adb @@ -76,9 +76,10 @@ package body Bindusg is Write_Line (" -a Automatically initialize elaboration " & "procedure"); - -- Line for -A switch + -- Lines for -A switch - Write_Line (" -A[=file] Give list of ALI files in partition"); + Write_Line (" -A Give list of ALI files in partition"); + Write_Line (" -A=file Write ALI file list to named file"); -- Line for -b switch diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 53ff97e343f..a6c1940a8cc 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -3260,9 +3260,6 @@ package body Exp_Ch9 is begin -- Get the type size - -- Surely this should be Known_Static_Esize if you are about - -- to assume you can do UI_To_Int on it! ??? - if Known_Esize (Comp_Type) then Typ_Size := UI_To_Int (Esize (Comp_Type)); @@ -3270,10 +3267,14 @@ package body Exp_Ch9 is -- the RM_Size (Value_Size) since it may have been set by an -- explicit representation clause. - -- And how do we know this is statically known??? + elsif Known_RM_Size (Comp_Type) then + Typ_Size := UI_To_Int (RM_Size (Comp_Type)); + + -- Should not happen since this has already been checked in + -- Allows_Lock_Free_Implementation (see Sem_Ch9). else - Typ_Size := UI_To_Int (RM_Size (Comp_Type)); + raise Program_Error; end if; -- Retrieve all relevant atomic routines and types diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index bd677d997f7..5f0547c4bdb 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -4204,12 +4204,12 @@ package body Freeze is elsif Is_Access_Type (E) and then not Is_Access_Subprogram_Type (E) then - -- If a pragma Default_Storage_Pool applies, and this type has no -- Storage_Pool or Storage_Size clause (which must have occurred -- before the freezing point), then use the default. This applies -- only to base types. - -- None of this applies to access to subprogramss, for which there + + -- None of this applies to access to subprograms, for which there -- are clearly no pools. if Present (Default_Pool) diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index d48065a23f5..d84c28f0732 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2011, AdaCore -- +-- Copyright (C) 2001-2012, AdaCore -- -- -- -- 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- -- @@ -1112,6 +1112,7 @@ package body GNAT.Sockets is Level : Level_Type := Socket_Level; Name : Option_Name) return Option_Type is + use SOSC; use type C.unsigned_char; V8 : aliased Two_Ints; @@ -1144,8 +1145,22 @@ package body GNAT.Sockets is when Send_Timeout | Receive_Timeout => - Len := VT'Size / 8; - Add := VT'Address; + + -- The standard argument for SO_RCVTIMEO and SO_SNDTIMEO is a + -- struct timeval, but on Windows it is a milliseconds count in + -- a DWORD. + + pragma Warnings (Off); + if Target_OS = Windows then + pragma Warnings (On); + + Len := V4'Size / 8; + Add := V4'Address; + + else + Len := VT'Size / 8; + Add := VT'Address; + end if; when Linger | Add_Membership | @@ -1201,7 +1216,23 @@ package body GNAT.Sockets is when Send_Timeout | Receive_Timeout => - Opt.Timeout := To_Duration (VT); + + pragma Warnings (Off); + if Target_OS = Windows then + pragma Warnings (On); + + -- Timeout is in milliseconds, actual value is 500 ms + + -- returned value (unless it is 0). + + if V4 = 0 then + Opt.Timeout := 0.0; + else + Opt.Timeout := Natural (V4) * 0.001 + 0.500; + end if; + + else + Opt.Timeout := To_Duration (VT); + end if; end case; return Opt; @@ -2176,6 +2207,8 @@ package body GNAT.Sockets is Level : Level_Type := Socket_Level; Option : Option_Type) is + use SOSC; + V8 : aliased Two_Ints; V4 : aliased C.int; V1 : aliased C.unsigned_char; @@ -2236,9 +2269,32 @@ package body GNAT.Sockets is when Send_Timeout | Receive_Timeout => - VT := To_Timeval (Option.Timeout); - Len := VT'Size / 8; - Add := VT'Address; + + pragma Warnings (Off); + if Target_OS = Windows then + pragma Warnings (On); + + -- On Windows, the timeout is a DWORD in milliseconds, and + -- the actual timeout is 500 ms + the given value (unless it + -- is 0). + + V4 := C.int (Option.Timeout / 0.001); + + if V4 > 500 then + V4 := V4 - 500; + + elsif V4 > 0 then + V4 := 1; + end if; + + Len := V4'Size / 8; + Add := V4'Address; + + else + VT := To_Timeval (Option.Timeout); + Len := VT'Size / 8; + Add := VT'Address; + end if; end case; diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index bf3bfcf2872..82e3f4593b4 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -238,12 +238,7 @@ procedure GNATCmd is function Configuration_Pragmas_File return Path_Name_Type; -- Return an argument, if there is a configuration pragmas file to be - -- specified for Project, otherwise return No_Name. Used for gnatstub (GNAT - -- STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric (GNAT - -- METRIC). - - function Mapping_File return Path_Name_Type; - -- Create and return the path name of a mapping file. Used for gnatstub + -- specified for Project, otherwise return No_Name. Used for gnatstub -- (GNAT STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric -- (GNAT METRIC). @@ -251,10 +246,22 @@ procedure GNATCmd is -- Delete all temporary config files. The caller is responsible for -- ensuring that Keep_Temporary_Files is False. + procedure Ensure_Absolute_Path + (Switch : in out String_Access; + Parent : String); + -- Test if Switch is a relative search path switch. If it is and it + -- includes directory information, prepend the path with Parent. This + -- subprogram is only called when using project files. + procedure Get_Closure; -- Get the sources in the closure of the ASIS_Main and add them to the -- list of arguments. + function Mapping_File return Path_Name_Type; + -- Create and return the path name of a mapping file. Used for gnatstub + -- (GNAT STUB), gnatpp (GNAT PRETTY), gnatelim (GNAT ELIM), and gnatmetric + -- (GNAT METRIC). + procedure Non_VMS_Usage; -- Display usage for platforms other than VMS @@ -268,17 +275,9 @@ procedure GNATCmd is -- If Project is a library project, add the correct -L and -l switches to -- the linker invocation. - procedure Set_Libraries is - new For_Every_Project_Imported (Boolean, Set_Library_For); - -- Add the -L and -l switches to the linker for all of the library - -- projects. - - procedure Ensure_Absolute_Path - (Switch : in out String_Access; - Parent : String); - -- Test if Switch is a relative search path switch. If it is and it - -- includes directory information, prepend the path with Parent. This - -- subprogram is only called when using project files. + procedure Set_Libraries is new + For_Every_Project_Imported (Boolean, Set_Library_For); + -- Add the -L and -l switches to the linker for all the library projects -------------------------- -- Add_To_Carg_Switches -- @@ -789,6 +788,22 @@ procedure GNATCmd is end if; end Delete_Temp_Config_Files; + --------------------------- + -- Ensure_Absolute_Path -- + --------------------------- + + procedure Ensure_Absolute_Path + (Switch : in out String_Access; + Parent : String) + is + begin + Makeutl.Ensure_Absolute_Path + (Switch, Parent, + Do_Fail => Osint.Fail'Access, + Including_Non_Switch => False, + Including_RTS => True); + end Ensure_Absolute_Path; + ----------------- -- Get_Closure -- ----------------- @@ -962,6 +977,59 @@ procedure GNATCmd is return Result; end Mapping_File; + ------------------- + -- Non_VMS_Usage -- + ------------------- + + procedure Non_VMS_Usage is + begin + Output_Version; + New_Line; + Put_Line ("List of available commands"); + New_Line; + + for C in Command_List'Range loop + + -- No usage for VMS only command or for Sync + + if not Command_List (C).VMS_Only and then C /= Sync then + if Targparm.AAMP_On_Target then + Put ("gnaampcmd "); + else + Put ("gnat "); + end if; + + Put (To_Lower (Command_List (C).Cname.all)); + Set_Col (25); + + -- Never call gnatstack with a prefix + + if C = Stack then + Put (Command_List (C).Unixcmd.all); + else + Put (Program_Name (Command_List (C).Unixcmd.all, "gnat").all); + end if; + + declare + Sws : Argument_List_Access renames Command_List (C).Unixsws; + begin + if Sws /= null then + for J in Sws'Range loop + Put (' '); + Put (Sws (J).all); + end loop; + end if; + end; + + New_Line; + end if; + end loop; + + New_Line; + Put_Line ("All commands except chop, krunch and preprocess " & + "accept project file switches -vPx, -Pprj and -Xnam=val"); + New_Line; + end Non_VMS_Usage; ------------------ -- Process_Link -- ------------------ @@ -1302,76 +1370,6 @@ procedure GNATCmd is end if; end Set_Library_For; - --------------------------- - -- Ensure_Absolute_Path -- - --------------------------- - - procedure Ensure_Absolute_Path - (Switch : in out String_Access; - Parent : String) - is - begin - Makeutl.Ensure_Absolute_Path - (Switch, Parent, - Do_Fail => Osint.Fail'Access, - Including_Non_Switch => False, - Including_RTS => True); - end Ensure_Absolute_Path; - - ------------------- - -- Non_VMS_Usage -- - ------------------- - - procedure Non_VMS_Usage is - begin - Output_Version; - New_Line; - Put_Line ("List of available commands"); - New_Line; - - for C in Command_List'Range loop - - -- No usage for VMS only command or for Sync - - if not Command_List (C).VMS_Only and then C /= Sync then - if Targparm.AAMP_On_Target then - Put ("gnaampcmd "); - else - Put ("gnat "); - end if; - - Put (To_Lower (Command_List (C).Cname.all)); - Set_Col (25); - - -- Never call gnatstack with a prefix - - if C = Stack then - Put (Command_List (C).Unixcmd.all); - else - Put (Program_Name (Command_List (C).Unixcmd.all, "gnat").all); - end if; - - declare - Sws : Argument_List_Access renames Command_List (C).Unixsws; - begin - if Sws /= null then - for J in Sws'Range loop - Put (' '); - Put (Sws (J).all); - end loop; - end if; - end; - - New_Line; - end if; - end loop; - - New_Line; - Put_Line ("All commands except chop, krunch and preprocess " & - "accept project file switches -vPx, -Pprj and -Xnam=val"); - New_Line; - end Non_VMS_Usage; - -- Start of processing for GNATCmd begin diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 253e8db814c..cdbe1aa134c 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -507,6 +507,109 @@ package body Makeutl is return Name_Find; end Create_Name; + --------------------------- + -- Ensure_Absolute_Path -- + --------------------------- + + procedure Ensure_Absolute_Path + (Switch : in out String_Access; + Parent : String; + Do_Fail : Fail_Proc; + For_Gnatbind : Boolean := False; + Including_Non_Switch : Boolean := True; + Including_RTS : Boolean := False) + 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) = 'I' + or else (not For_Gnatbind + and then (Sw (2) = 'L' + or else Sw (2) = 'A'))) + 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" + or else + (For_Gnatbind and then Sw (2 .. 3) = "A=")) + then + Start := 4; + + elsif Including_RTS + and then Sw'Length >= 7 + and then Sw (2 .. 6) = "-RTS=" + then + Start := 7; + + else + return; + end if; + + -- Because relative path arguments to --RTS= may be relative to + -- the search directory prefix, those relative path arguments + -- are converted only when they include directory information. + + if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then + if Parent'Length = 0 then + Do_Fail + ("relative search path switches (""" + & Sw + & """) are not allowed"); + + elsif Including_RTS then + for J in Start .. Sw'Last loop + if Sw (J) = Directory_Separator then + Switch := + new String' + (Sw (1 .. Start - 1) & + Parent & + Directory_Separator & + Sw (Start .. Sw'Last)); + return; + end if; + end loop; + + else + Switch := + new String' + (Sw (1 .. Start - 1) & + Parent & + Directory_Separator & + Sw (Start .. Sw'Last)); + end if; + end if; + + elsif Including_Non_Switch then + if not Is_Absolute_Path (Sw) then + if Parent'Length = 0 then + Do_Fail + ("relative paths (""" & Sw & """) are not allowed"); + else + Switch := new String'(Parent & Directory_Separator & Sw); + end if; + end if; + end if; + end; + end if; + end Ensure_Absolute_Path; + ---------------------------- -- Executable_Prefix_Path -- ---------------------------- @@ -1936,109 +2039,6 @@ package body Makeutl is end if; end Path_Or_File_Name; - --------------------------- - -- Ensure_Absolute_Path -- - --------------------------- - - procedure Ensure_Absolute_Path - (Switch : in out String_Access; - Parent : String; - Do_Fail : Fail_Proc; - For_Gnatbind : Boolean := False; - Including_Non_Switch : Boolean := True; - Including_RTS : Boolean := False) - 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) = 'I' - or else (not For_Gnatbind - and then (Sw (2) = 'L' - or else Sw (2) = 'A'))) - 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" - or else - (For_Gnatbind and then Sw (2 .. 3) = "A=")) - then - Start := 4; - - elsif Including_RTS - and then Sw'Length >= 7 - and then Sw (2 .. 6) = "-RTS=" - then - Start := 7; - - else - return; - end if; - - -- Because relative path arguments to --RTS= may be relative to - -- the search directory prefix, those relative path arguments - -- are converted only when they include directory information. - - if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then - if Parent'Length = 0 then - Do_Fail - ("relative search path switches (""" - & Sw - & """) are not allowed"); - - elsif Including_RTS then - for J in Start .. Sw'Last loop - if Sw (J) = Directory_Separator then - Switch := - new String' - (Sw (1 .. Start - 1) & - Parent & - Directory_Separator & - Sw (Start .. Sw'Last)); - return; - end if; - end loop; - - else - Switch := - new String' - (Sw (1 .. Start - 1) & - Parent & - Directory_Separator & - Sw (Start .. Sw'Last)); - end if; - end if; - - elsif Including_Non_Switch then - if not Is_Absolute_Path (Sw) then - if Parent'Length = 0 then - Do_Fail - ("relative paths (""" & Sw & """) are not allowed"); - else - Switch := new String'(Parent & Directory_Separator & Sw); - end if; - end if; - end if; - end; - end if; - end Ensure_Absolute_Path; - ------------------- -- Unit_Index_Of -- ------------------- diff --git a/gcc/ada/makeutl.ads b/gcc/ada/makeutl.ads index 693fafcd266..198e61aaab5 100644 --- a/gcc/ada/makeutl.ads +++ b/gcc/ada/makeutl.ads @@ -128,6 +128,20 @@ package Makeutl is -- source files are still associated with the same units). Return the name -- of the unit if everything is still valid. Return No_Name otherwise. + procedure Ensure_Absolute_Path + (Switch : in out String_Access; + Parent : String; + Do_Fail : Fail_Proc; + For_Gnatbind : Boolean := False; + Including_Non_Switch : Boolean := True; + Including_RTS : Boolean := False); + -- Do nothing if Switch is an absolute path switch. If relative, fail if + -- Parent is the empty string, otherwise prepend the path with Parent. This + -- subprogram is only used when using project files. If For_Gnatbind is + -- True, gnatbind switches that are not paths (-L, -A) are left unchaned. + -- If Including_RTS is True, process also switches --RTS=. Do_Fail is + -- called in case of error. Using Osint.Fail might be appropriate. + function Is_Subunit (Source : Source_Id) return Boolean; -- Return True if source is a subunit @@ -151,26 +165,6 @@ package Makeutl is -- entered by a call to Prj.Ext.Add, so that in a project file, External -- ("name") will return "value". - procedure Verbose_Msg - (N1 : Name_Id; - S1 : String; - N2 : Name_Id := No_Name; - S2 : String := ""; - Prefix : String := " -> "; - Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low); - procedure Verbose_Msg - (N1 : File_Name_Type; - S1 : String; - N2 : File_Name_Type := No_File; - S2 : String := ""; - Prefix : String := " -> "; - Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low); - -- If the verbose flag (Verbose_Mode) is set and the verbosity level is at - -- least equal to Minimum_Verbosity, then print Prefix to standard output - -- followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2 - -- is printed last. Both N1 and N2 are printed in quotation marks. The two - -- forms differ only in taking Name_Id or File_name_Type arguments. - type Name_Ids is array (Positive range <>) of Name_Id; No_Names : constant Name_Ids := (1 .. 0 => No_Name); -- Name_Ids is used for list of language names in procedure Get_Directories @@ -231,26 +225,32 @@ package Makeutl is -- of project Project, in project tree In_Tree, and in the projects that -- it imports directly or indirectly, and returns the result. + function Path_Or_File_Name (Path : Path_Name_Type) return String; + -- Returns a file name if -df is used, otherwise return a path name + function Unit_Index_Of (ALI_File : File_Name_Type) return Int; -- Find the index of a unit in a source file. Return zero if the file is -- not a multi-unit source file. - procedure Ensure_Absolute_Path - (Switch : in out String_Access; - Parent : String; - Do_Fail : Fail_Proc; - For_Gnatbind : Boolean := False; - Including_Non_Switch : Boolean := True; - Including_RTS : Boolean := False); - -- Do nothing if Switch is an absolute path switch. If relative, fail if - -- Parent is the empty string, otherwise prepend the path with Parent. This - -- subprogram is only used when using project files. If For_Gnatbind is - -- True, gnatbind switches that are not paths (-L, -A) are left unchaned. - -- If Including_RTS is True, process also switches --RTS=. Do_Fail is - -- called in case of error. Using Osint.Fail might be appropriate. - - function Path_Or_File_Name (Path : Path_Name_Type) return String; - -- Returns a file name if -df is used, otherwise return a path name + procedure Verbose_Msg + (N1 : Name_Id; + S1 : String; + N2 : Name_Id := No_Name; + S2 : String := ""; + Prefix : String := " -> "; + Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low); + procedure Verbose_Msg + (N1 : File_Name_Type; + S1 : String; + N2 : File_Name_Type := No_File; + S2 : String := ""; + Prefix : String := " -> "; + Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low); + -- If the verbose flag (Verbose_Mode) is set and the verbosity level is at + -- least equal to Minimum_Verbosity, then print Prefix to standard output + -- followed by N1 and S1. If N2 /= No_Name then N2 is printed after S1. S2 + -- is printed last. Both N1 and N2 are printed in quotation marks. The two + -- forms differ only in taking Name_Id or File_name_Type arguments. ------------------------- -- Program termination -- @@ -279,10 +279,11 @@ package Makeutl is For_Lang : Name_Id; For_Builder : Boolean; Has_Global_Compilation_Switches : Boolean) return Boolean; - -- For_Builder is true if we have a builder switch - -- This function should return True in case of success (the switch is - -- valid), False otherwise. The error message will be displayed by + -- For_Builder is true if we have a builder switch. This function + -- should return True in case of success (the switch is valid), + -- False otherwise. The error message will be displayed by -- Compute_Builder_Switches itself. + -- -- Has_Global_Compilation_Switches is True if the attribute -- Global_Compilation_Switches is defined in the project. @@ -291,10 +292,10 @@ package Makeutl is Root_Environment : in out Prj.Tree.Environment; Main_Project : Project_Id; Only_For_Lang : Name_Id := No_Name); - -- Compute the builder switches and global compilation switches. - -- Every time a switch is found in the project, it is passed to Add_Switch. - -- You can provide a value for Only_For_Lang so that we only look for - -- this language when parsing the global compilation switches. + -- Compute the builder switches and global compilation switches. Every time + -- a switch is found in the project, it is passed to Add_Switch. You can + -- provide a value for Only_For_Lang so that we only look for this language + -- when parsing the global compilation switches. ----------------------- -- Project_Tree data -- diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 877ac4d0f38..524de4ce99b 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -530,7 +530,10 @@ package body Sem_Ch9 is -- Quantified expression restricted - elsif Kind = N_Quantified_Expression then + elsif Kind = N_Quantified_Expression + or else Nkind (Original_Node (N)) = + N_Quantified_Expression + then if Lock_Free_Given then Error_Msg_N ("quantified expression not allowed", N); @@ -552,7 +555,7 @@ package body Sem_Ch9 is Id : constant Entity_Id := Entity (N); Comp_Decl : Node_Id; Comp_Id : Entity_Id := Empty; - Comp_Size : Int; + Comp_Size : Int := 0; Comp_Type : Entity_Id; begin @@ -579,6 +582,10 @@ package body Sem_Ch9 is Layout_Type (Comp_Type); + -- Note that Known_Esize is used and not + -- Known_Static_Esize in order to capture the + -- errors properly at the instantiation point. + if Known_Esize (Comp_Type) then Comp_Size := UI_To_Int (Esize (Comp_Type)); @@ -587,7 +594,7 @@ package body Sem_Ch9 is -- (Value_Size) since it may have been set by an -- explicit representation clause. - else + elsif Known_RM_Size (Comp_Type) then Comp_Size := UI_To_Int (RM_Size (Comp_Type)); end if;