From 51dcceecdf58128ea13fede4507327a3f8595804 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 4 Aug 2014 14:51:00 +0200 Subject: [PATCH] [multiple changes] 2014-08-04 Hristian Kirtchev * sem_prag.adb (Analyze_Pragma): Ensure that an internally generated spec for a stand alone body is recognized as a proper context for pragma SPARK_Mode. 2014-08-04 Robert Dewar * erroutc.adb (Delete_Msg): Do not decrement Warnings_Treated_As_Errors. 2014-08-04 Arnaud Charlet * adabkend.adb (Scan_Back_End_Switches): Ignore extra -o when -gnatO has already been specified, for compatibility with gcc driver. (Scan_Compiler_Args): Do not call Set_Output_Object_File_Name in codepeer mode. * g-expect.ads: Fix typo. 2014-08-04 Thomas Quinot * exp_ch4.adb (Insert_Dereference_Action): the actual Size must account for the bounds template if the designated type is an unconstrained array. From-SVN: r213579 --- gcc/ada/ChangeLog | 25 +++++++++++++++++++++++++ gcc/ada/adabkend.adb | 20 +++++++++++++++----- gcc/ada/erroutc.adb | 7 +++---- gcc/ada/exp_ch4.adb | 43 ++++++++++++++++++++++++++++--------------- gcc/ada/g-expect.ads | 2 +- gcc/ada/sem_prag.adb | 14 ++++++++------ 6 files changed, 80 insertions(+), 31 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e2a583777de..02b59b2bc4c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,28 @@ +2014-08-04 Hristian Kirtchev + + * sem_prag.adb (Analyze_Pragma): Ensure that an + internally generated spec for a stand alone body is recognized + as a proper context for pragma SPARK_Mode. + +2014-08-04 Robert Dewar + + * erroutc.adb (Delete_Msg): Do not decrement Warnings_Treated_As_Errors. + +2014-08-04 Arnaud Charlet + + * adabkend.adb (Scan_Back_End_Switches): Ignore extra -o + when -gnatO has already been specified, for compatibility + with gcc driver. + (Scan_Compiler_Args): Do not call Set_Output_Object_File_Name in + codepeer mode. + * g-expect.ads: Fix typo. + +2014-08-04 Thomas Quinot + + * exp_ch4.adb (Insert_Dereference_Action): the actual Size + must account for the bounds template if the designated type is + an unconstrained array. + 2014-08-04 Hristian Kirtchev * a-cfhama.adb, a-cfhase.adb, a-cforma.adb, a-cforse.adb Add diff --git a/gcc/ada/adabkend.adb b/gcc/ada/adabkend.adb index 1e1a2d9b2c9..1a420009100 100644 --- a/gcc/ada/adabkend.adb +++ b/gcc/ada/adabkend.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2013, AdaCore -- +-- Copyright (C) 2001-2014, 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- -- @@ -108,7 +108,16 @@ package body Adabkend is elsif Switch_Chars (First .. Last) = "o" then if First = Last then - Opt.Output_File_Name_Present := True; + if Opt.Output_File_Name_Present then + + -- Ignore extra -o when -gnatO has already been specified + + Next_Arg := Next_Arg + 1; + + else + Opt.Output_File_Name_Present := True; + end if; + return; else Fail ("invalid switch: " & Switch_Chars); @@ -237,10 +246,11 @@ package body Adabkend is -- In GNATprove_Mode, such an object file is never written, and -- the call to Set_Output_Object_File_Name may fail (e.g. when - -- the object file name does not have the expected suffix). So - -- we skip that call when GNATprove_Mode is set. + -- the object file name does not have the expected suffix). + -- So we skip that call when GNATprove_Mode is set. Same for + -- CodePeer_Mode. - elsif GNATprove_Mode then + elsif GNATprove_Mode or CodePeer_Mode then Output_File_Name_Seen := True; else diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index c347364c1b9..11eef8a9593 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -141,10 +141,9 @@ package body Erroutc is if Errors.Table (D).Warn or else Errors.Table (D).Style then Warnings_Detected := Warnings_Detected - 1; - if Errors.Table (D).Warn_Err then - Warnings_Treated_As_Errors := - Warnings_Treated_As_Errors - 1; - end if; + -- Note: we do not need to decrement Warnings_Treated_As_Errors + -- because this only gets incremented if we actually output the + -- message, which we won't do if we are deleting it here! else Total_Errors_Detected := Total_Errors_Detected - 1; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 0f4261fb7b9..dfa22bd70ae 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -11569,11 +11569,12 @@ package body Exp_Ch4 is Pool : constant Entity_Id := Associated_Storage_Pool (Typ); Pnod : constant Node_Id := Parent (N); - Addr : Entity_Id; - Alig : Entity_Id; - Deref : Node_Id; - Size : Entity_Id; - Stmt : Node_Id; + Addr : Entity_Id; + Alig : Entity_Id; + Deref : Node_Id; + Size : Entity_Id; + Size_Bits : Node_Id; + Stmt : Node_Id; -- Start of processing for Insert_Dereference_Action @@ -11624,23 +11625,36 @@ package body Exp_Ch4 is Prefix => Duplicate_Subexpr_Move_Checks (N)); Set_Has_Dereference_Action (Deref); - Size := Make_Temporary (Loc, 'S'); + Size_Bits := + Make_Attribute_Reference (Loc, + Prefix => Deref, + Attribute_Name => Name_Size); + -- Special case of an unconstrained array: need to add descriptor size + + if Is_Array_Type (Desig) + and then not Is_Constrained (First_Subtype (Desig)) + then + Size_Bits := + Make_Op_Add (Loc, + Left_Opnd => + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (First_Subtype (Desig), Loc), + Attribute_Name => Name_Descriptor_Size), + Right_Opnd => Size_Bits); + end if; + + Size := Make_Temporary (Loc, 'S'); Insert_Action (N, Make_Object_Declaration (Loc, Defining_Identifier => Size, - Object_Definition => New_Occurrence_Of (RTE (RE_Storage_Count), Loc), - Expression => Make_Op_Divide (Loc, - Left_Opnd => - Make_Attribute_Reference (Loc, - Prefix => Deref, - Attribute_Name => Name_Size), - Right_Opnd => - Make_Integer_Literal (Loc, System_Storage_Unit)))); + Left_Opnd => Size_Bits, + Right_Opnd => Make_Integer_Literal (Loc, System_Storage_Unit)))); -- Calculate the alignment of the dereferenced object. Generate: -- Alig : constant Storage_Count := .all'Alignment; @@ -11651,7 +11665,6 @@ package body Exp_Ch4 is Set_Has_Dereference_Action (Deref); Alig := Make_Temporary (Loc, 'A'); - Insert_Action (N, Make_Object_Declaration (Loc, Defining_Identifier => Alig, diff --git a/gcc/ada/g-expect.ads b/gcc/ada/g-expect.ads index 8c4ab48b5c6..0dc634110ee 100644 --- a/gcc/ada/g-expect.ads +++ b/gcc/ada/g-expect.ads @@ -178,7 +178,7 @@ package GNAT.Expect is -- till Expect matches), but this is slower. -- -- If Err_To_Out is True, then the standard error of the spawned process is - -- connected to the standard output. This is the only way to get the Except + -- connected to the standard output. This is the only way to get the Expect -- subprograms to also match on output on standard error. -- -- Invalid_Process is raised if the process could not be spawned. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 8ef209d2d02..dc084f9e13e 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -19304,12 +19304,9 @@ package body Sem_Prag is raise Pragma_Exit; end if; - -- Skip internally generated code - - elsif not Comes_From_Source (Stmt) then - null; - - -- The pragma applies to a [generic] subprogram declaration + -- The pragma applies to a [generic] subprogram declaration. + -- Note that this case covers an internally generated spec + -- for a stand alone body. -- [generic] -- procedure Proc ...; @@ -19329,6 +19326,11 @@ package body Sem_Prag is Set_SPARK_Pragma_Inherited (Spec_Id, False); return; + -- Skip internally generated code + + elsif not Comes_From_Source (Stmt) then + null; + -- Otherwise the pragma does not apply to a legal construct -- or it does not appear at the top of a declarative or a -- statement list. Issue an error and stop the analysis. -- 2.30.2