diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 27 | ||||
| -rw-r--r-- | gcc/ada/ali-util.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/ali-util.ads | 9 | ||||
| -rw-r--r-- | gcc/ada/bcheck.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/exp_ch13.adb | 44 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 37 | ||||
| -rw-r--r-- | gcc/ada/fe.h | 6 | ||||
| -rw-r--r-- | gcc/ada/gnatbind.adb | 102 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 9 |
9 files changed, 178 insertions, 91 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8353e50..b8f882d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,30 @@ +2013-04-24 Eric Botcazou <ebotcazou@adacore.com> + + * fe.h (Machine_Overflows_On_Target): New macro and declaration. + (Signed_Zeros_On_Target): Likewise. + +2013-04-24 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_ch6.adb: Add with and use clause for Sem_Prag. + (Freeze_Subprogram): Analyze all delayed aspects for a null + procedure so that they are available when analyzing the + internally-generated _Postconditions routine. + * exp_ch13.adb: Remove with and use clause for Sem_Prag. + (Expand_N_Freeze_Entity): Move the code that analyzes delayed + aspects of null procedures to exp_ch6.Freeze_Subprogram. + * sem_prag.adb (Analyze_Abstract_State): Update the check on + volatile requirements. + +2013-04-24 Bob Duff <duff@adacore.com> + + * ali-util.ads (Source_Record): New component Stamp_File + to record from whence the Stamp came. + * ali-util.adb (Set_Source_Table): Set Stamp_File component. + * bcheck.adb (Check_Consistency): Print additional information in + Verbose_Mode. + * gnatbind.adb (Gnatbind): Print additional information in + Verbose_Mode. + 2013-04-24 Robert Dewar <dewar@adacore.com> * exp_ch13.adb, sem_prag.adb: Update comments. diff --git a/gcc/ada/ali-util.adb b/gcc/ada/ali-util.adb index d8b12ad..514be3c 100644 --- a/gcc/ada/ali-util.adb +++ b/gcc/ada/ali-util.adb @@ -35,6 +35,8 @@ with Snames; use Snames; with Stringt; with Styleg; +with System.OS_Lib; use System.OS_Lib; + package body ALI.Util is -- Empty procedures needed to instantiate Scng. Error procedures are @@ -359,6 +361,7 @@ package body ALI.Util is if Stamp (Stamp'First) /= ' ' then Source.Table (S).Stamp := Stamp; Source.Table (S).Source_Found := True; + Source.Table (S).Stamp_File := F; -- If we could not find the file, then the stamp is set -- from the dependency table entry (to be possibly reset @@ -367,6 +370,7 @@ package body ALI.Util is else Source.Table (S).Stamp := Sdep.Table (D).Stamp; Source.Table (S).Source_Found := False; + Source.Table (S).Stamp_File := ALIs.Table (A).Afile; -- In All_Sources mode, flag error of file not found @@ -380,8 +384,9 @@ package body ALI.Util is -- is off, so simply initialize the stamp from the Sdep entry else - Source.Table (S).Source_Found := False; Source.Table (S).Stamp := Sdep.Table (D).Stamp; + Source.Table (S).Source_Found := False; + Source.Table (S).Stamp_File := ALIs.Table (A).Afile; end if; -- Here if this is not the first time for this source file, @@ -407,13 +412,19 @@ package body ALI.Util is -- source file even if Check_Source_Files is false, since -- if we find it, then we can use it to resolve which of the -- two timestamps in the ALI files is likely to be correct. + -- We only look in the current directory, because when + -- Check_Source_Files is false, other search directories are + -- likely to be incorrect. - if not Check_Source_Files then + if not Check_Source_Files + and then Is_Regular_File (Get_Name_String (F)) + then Stamp := Source_File_Stamp (F); if Stamp (Stamp'First) /= ' ' then Source.Table (S).Stamp := Stamp; Source.Table (S).Source_Found := True; + Source.Table (S).Stamp_File := F; end if; end if; @@ -432,6 +443,7 @@ package body ALI.Util is else if Sdep.Table (D).Stamp > Source.Table (S).Stamp then Source.Table (S).Stamp := Sdep.Table (D).Stamp; + Source.Table (S).Stamp_File := ALIs.Table (A).Afile; end if; end if; end if; diff --git a/gcc/ada/ali-util.ads b/gcc/ada/ali-util.ads index 707fec7..251f3e7 100644 --- a/gcc/ada/ali-util.ads +++ b/gcc/ada/ali-util.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -57,6 +57,13 @@ package ALI.Util is -- located and the Stamp value was set from the actual source file. -- It is always false if Check_Source_Files is not set. + Stamp_File : File_Name_Type; + -- File that Stamp came from. If Source_Found is True, then Stamp is the + -- timestamp of the source file, and this is the name of the source + -- file. If Source_Found is False, then Stamp comes from a dependency + -- line in an ALI file, this is the name of that ALI file. Used only in + -- verbose mode, for messages. + All_Timestamps_Match : Boolean; -- This flag is set only if all files referencing this source file -- have a matching time stamp, and also, if Source_Found is True, diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index 7c81df9..fc2b9b6 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -218,16 +218,27 @@ package body Bcheck is end if; if (not Tolerate_Consistency_Errors) and Verbose_Mode then - Error_Msg_File_1 := Sdep.Table (D).Sfile; + Error_Msg_File_1 := Source.Table (Src).Stamp_File; + + if Source.Table (Src).Source_Found then + Error_Msg_File_1 := + Osint.Full_Source_Name (Error_Msg_File_1); + else + Error_Msg_File_1 := + Osint.Full_Lib_File_Name (Error_Msg_File_1); + end if; + Error_Msg - ("{ time stamp " & String (Source.Table (Src).Stamp)); + ("time stamp from { " & String (Source.Table (Src).Stamp)); Error_Msg_File_1 := Sdep.Table (D).Sfile; - -- Something wrong here, should be different file ??? - Error_Msg (" conflicts with { timestamp " & String (Sdep.Table (D).Stamp)); + + Error_Msg_File_1 := + Osint.Full_Lib_File_Name (ALIs.Table (A).Afile); + Error_Msg (" from {"); end if; -- Exit from the loop through Sdep entries once we find one diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb index 24e5e39..364401d 100644 --- a/gcc/ada/exp_ch13.adb +++ b/gcc/ada/exp_ch13.adb @@ -43,7 +43,6 @@ with Sem_Aux; use Sem_Aux; with Sem_Ch7; use Sem_Ch7; with Sem_Ch8; use Sem_Ch8; with Sem_Eval; use Sem_Eval; -with Sem_Prag; use Sem_Prag; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; with Snames; use Snames; @@ -553,48 +552,9 @@ package body Exp_Ch13 is Force_Validity_Checks := Save_Force; end; - else - -- If the action is the generated body of a null subprogram, - -- analyze the expressions in its delayed aspects, because we - -- may not have reached the end of the declarative list when - -- delayed aspects are normally analyzed. This ensures that - -- dispatching calls are properly rewritten when the inner - -- postcondition procedure is analyzed. - - if Is_Subprogram (E) - and then Nkind (Parent (E)) = N_Procedure_Specification - and then Null_Present (Parent (E)) - then - declare - Prag : Node_Id; - - begin - -- Comment this loop ??? - - Prag := Pre_Post_Conditions (Contract (E)); - while Present (Prag) loop - Analyze_PPC_In_Decl_Part (Prag, E); - Prag := Next_Pragma (Prag); - end loop; - - -- Why don't we do the same for Contract_Test_Cases ??? - - -- Comment this loop? - - Prag := Classifications (Contract (E)); - while Present (Prag) loop - if Pragma_Name (Prag) = Name_Depends then - Analyze_Depends_In_Decl_Part (Prag); - else - pragma Assert (Pragma_Name (Prag) = Name_Global); - Analyze_Global_In_Decl_Part (Prag); - end if; - - Prag := Next_Pragma (Prag); - end loop; - end; - end if; + -- All other freezing actions + else Analyze (Decl, Suppress => All_Checks); end if; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index dc43046..c06a224 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -67,6 +67,7 @@ with Sem_Disp; use Sem_Disp; with Sem_Dist; use Sem_Dist; with Sem_Eval; use Sem_Eval; with Sem_Mech; use Sem_Mech; +with Sem_Prag; use Sem_Prag; with Sem_Res; use Sem_Res; with Sem_SCIL; use Sem_SCIL; with Sem_Util; use Sem_Util; @@ -8293,6 +8294,42 @@ package body Exp_Ch6 is Set_Returns_By_Ref (Subp); end if; end; + + -- Wnen freezing a null procedure, analyze its delayed aspects now + -- because we may not have reached the end of the declarative list when + -- delayed aspects are normally analyzed. This ensures that dispatching + -- calls are properly rewritten when the generated _Postcondition + -- procedure is analyzed in the null procedure body. + + if Nkind (Parent (Subp)) = N_Procedure_Specification + and then Null_Present (Parent (Subp)) + then + declare + Prag : Node_Id; + + begin + -- Analyze all pre- and post-conditions + + Prag := Pre_Post_Conditions (Contract (Subp)); + while Present (Prag) loop + Analyze_PPC_In_Decl_Part (Prag, Subp); + Prag := Next_Pragma (Prag); + end loop; + + -- Analyze classification aspects Depends and Global + + Prag := Classifications (Contract (Subp)); + while Present (Prag) loop + if Pragma_Name (Prag) = Name_Depends then + Analyze_Depends_In_Decl_Part (Prag); + else + Analyze_Global_In_Decl_Part (Prag); + end if; + + Prag := Next_Pragma (Prag); + end loop; + end; + end if; end Freeze_Subprogram; ----------------------- diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index 552a8bf..1c5aac4 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2012, Free Software Foundation, Inc. * + * Copyright (C) 1992-2013, 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- * @@ -263,10 +263,14 @@ extern void Set_Has_No_Elaboration_Code (Node_Id, Boolean); /* targparm: */ #define Backend_Overflow_Checks_On_Target targparm__backend_overflow_checks_on_target +#define Machine_Overflows_On_Target targparm__machine_overflows_on_target +#define Signed_Zeros_On_Target targparm__signed_zeros_on_target #define Stack_Check_Probes_On_Target targparm__stack_check_probes_on_target #define Stack_Check_Limits_On_Target targparm__stack_check_limits_on_target extern Boolean Backend_Overflow_Checks_On_Target; +extern Boolean Machine_Overflows_On_Target; +extern Boolean Signed_Zeros_On_Target; extern Boolean Stack_Check_Probes_On_Target; extern Boolean Stack_Check_Limits_On_Target; diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index 63e7c14..30f6141 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -73,7 +73,6 @@ procedure Gnatbind is -- Standard library Text : Text_Buffer_Ptr; - Next_Arg : Positive; Output_File_Name_Seen : Boolean := False; Output_File_Name : String_Ptr := new String'(""); @@ -104,6 +103,15 @@ procedure Gnatbind is -- All the one character arguments are still handled by Switch. This -- routine handles -aO -aI and -I-. The lower bound of Argv must be 1. + generic + with procedure Action (Argv : String); + procedure Generic_Scan_Bind_Args; + -- Iterate through the args calling Action on each one, taking care of + -- response files. + + procedure Write_Arg (S : String); + -- Passed to Generic_Scan_Bind_Args to print args + function Is_Cross_Compiler return Boolean; -- Returns True iff this is a cross-compiler @@ -480,12 +488,64 @@ procedure Gnatbind is end if; end Scan_Bind_Arg; + ---------------------------- + -- Generic_Scan_Bind_Args -- + ---------------------------- + + procedure Generic_Scan_Bind_Args is + Next_Arg : Positive := 1; + begin + -- Use low level argument routines to avoid dragging in the secondary + -- stack + + while Next_Arg < Arg_Count loop + declare + Next_Argv : String (1 .. Len_Arg (Next_Arg)); + begin + Fill_Arg (Next_Argv'Address, Next_Arg); + + if Next_Argv'Length > 0 then + if Next_Argv (1) = '@' then + if Next_Argv'Length > 1 then + declare + Arguments : constant Argument_List := + Response_File.Arguments_From + (Response_File_Name => + Next_Argv (2 .. Next_Argv'Last), + Recursive => True, + Ignore_Non_Existing_Files => True); + begin + for J in Arguments'Range loop + Action (Arguments (J).all); + end loop; + end; + end if; + + else + Action (Next_Argv); + end if; + end if; + end; + + Next_Arg := Next_Arg + 1; + end loop; + end Generic_Scan_Bind_Args; + + procedure Write_Arg (S : String) is + begin + Write_Str (" " & S); + end Write_Arg; + + procedure Scan_Bind_Args is new Generic_Scan_Bind_Args (Scan_Bind_Arg); + procedure Put_Bind_Args is new Generic_Scan_Bind_Args (Write_Arg); + procedure Check_Version_And_Help is new Check_Version_And_Help_G (Bindusg.Display); -- Start of processing for Gnatbind begin + -- Set default for Shared_Libgnat option declare @@ -510,40 +570,16 @@ begin Check_Version_And_Help ("GNATBIND", "1995"); - -- Use low level argument routines to avoid dragging in the secondary stack + -- We need to Scan_Bind_Args first, to set Verbose_Mode, so we know whether + -- to Put_Bind_Args. - Next_Arg := 1; - Scan_Args : while Next_Arg < Arg_Count loop - declare - Next_Argv : String (1 .. Len_Arg (Next_Arg)); - begin - Fill_Arg (Next_Argv'Address, Next_Arg); - - if Next_Argv'Length > 0 then - if Next_Argv (1) = '@' then - if Next_Argv'Length > 1 then - declare - Arguments : constant Argument_List := - Response_File.Arguments_From - (Response_File_Name => - Next_Argv (2 .. Next_Argv'Last), - Recursive => True, - Ignore_Non_Existing_Files => True); - begin - for J in Arguments'Range loop - Scan_Bind_Arg (Arguments (J).all); - end loop; - end; - end if; + Scan_Bind_Args; - else - Scan_Bind_Arg (Next_Argv); - end if; - end if; - end; - - Next_Arg := Next_Arg + 1; - end loop Scan_Args; + if Verbose_Mode then + Write_Str (Command_Name); + Put_Bind_Args; + Write_Eol; + end if; if Use_Pragma_Linker_Constructor then if Bind_Main_Program then diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 80b316b..69b19c5 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -8353,14 +8353,7 @@ package body Sem_Prag is -- Volatile requires exactly one Input or Output - -- Isn't this just Input_Seen = Output_Seen ??? - - if Volatile_Seen - and then - ((Input_Seen and Output_Seen) -- both - or else - (not Input_Seen and not Output_Seen)) -- none - then + if Volatile_Seen and then Input_Seen = Output_Seen then Error_Msg_N ("property Volatile requires exactly one Input or " & "Output", State); |