From 5b75bf576f92ac16409fd7d3f1fd3f64c02bca11 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 11 Apr 2013 11:49:40 +0200 Subject: [PATCH] [multiple changes] 2013-04-11 Robert Dewar * sem_prag.adb, sem_attr.adb, gnat1drv.adb, prj-makr.adb, opt.ads, sem_ch13.adb: Minor reformatting. * debug.adb: Minor comment fix (remove junk .I doc). 2013-04-11 Thomas Quinot * rtsfind.ads, exp_dist.adb, exp_dist.ads (Rtsfind.PCS_Version, case PolyORB): Bump to 6. (Exp_Dist.PolyORB_Support): Replace TC_Build with Build_Complex_TC. From-SVN: r197752 --- gcc/ada/ChangeLog | 13 +++++++++++++ gcc/ada/debug.adb | 4 ---- gcc/ada/exp_dist.adb | 27 ++++++++++++++------------- gcc/ada/exp_dist.ads | 4 ++-- gcc/ada/gnat1drv.adb | 6 +++++- gcc/ada/opt.ads | 7 ++++++- gcc/ada/prj-makr.adb | 23 +++++++++++++---------- gcc/ada/rtsfind.ads | 40 +++++++++++++++++++++------------------- gcc/ada/sem_attr.adb | 2 ++ gcc/ada/sem_ch13.adb | 4 ++++ gcc/ada/sem_prag.adb | 4 +++- 11 files changed, 83 insertions(+), 51 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 07f04f0c930..ed18e974b83 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2013-04-11 Robert Dewar + + * sem_prag.adb, sem_attr.adb, gnat1drv.adb, prj-makr.adb, + opt.ads, sem_ch13.adb: Minor reformatting. + * debug.adb: Minor comment fix (remove junk .I doc). + +2013-04-11 Thomas Quinot + + * rtsfind.ads, exp_dist.adb, exp_dist.ads (Rtsfind.PCS_Version, case + PolyORB): Bump to 6. + (Exp_Dist.PolyORB_Support): Replace TC_Build with + Build_Complex_TC. + 2013-04-11 Arnaud Charlet * debug.adb, sem_prag.adb, par-ch2.adb, sem_attr.adb, gnat1drv.adb, diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 6d0a53f9bc5..ae66737c4be 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -609,10 +609,6 @@ package body Debug is -- will only generate Why code for package Standard. Any given input -- file will be ignored. - -- d.I Generate SCIL mode. Generate intermediate code for the sake of - -- of static analysis tools, and ensure additional tree consistency - -- between different compilations of specs. - -- d.J Disable parallel SCIL generation. Normally SCIL file generation is -- done in parallel to speed processing. This switch disables this -- behavior. diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index e0e7250a3b7..6d499c45dce 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -6630,9 +6630,10 @@ package body Exp_Dist is Make_Simple_Return_Statement (Loc, Expression => Make_Function_Call (Loc, - Name => New_Occurrence_Of (RTE (RE_TC_Build), Loc), + Name => + New_Occurrence_Of (RTE (RE_Build_Complex_TC), Loc), Parameter_Associations => New_List ( - New_Occurrence_Of (RTE (RE_TC_Object), Loc), + New_Occurrence_Of (RTE (RE_Tk_Objref), Loc), Make_Aggregate (Loc, Expressions => New_List ( @@ -10207,11 +10208,11 @@ package body Exp_Dist is function Make_Constructed_TypeCode (Kind : Entity_Id; Parameters : List_Id) return Node_Id; - -- Call TC_Build with the given kind and parameters + -- Call Build_Complex_TC with the given kind and parameters procedure Return_Constructed_TypeCode (Kind : Entity_Id); - -- Make a return statement that calls TC_Build with the given - -- typecode kind, and the constructed parameters list. + -- Make a return statement that calls Build_Complex_TC with the + -- given typecode kind, and the constructed parameters list. procedure Return_Alias_TypeCode (Base_TypeCode : Node_Id); -- Return a typecode that is a TC_Alias for the given typecode @@ -10285,7 +10286,7 @@ package body Exp_Dist is procedure Return_Alias_TypeCode (Base_TypeCode : Node_Id) is begin Add_TypeCode_Parameter (Base_TypeCode, Parameters); - Return_Constructed_TypeCode (RTE (RE_TC_Alias)); + Return_Constructed_TypeCode (RTE (RE_Tk_Alias)); end Return_Alias_TypeCode; ------------------------------- @@ -10299,7 +10300,7 @@ package body Exp_Dist is Constructed_TC : constant Node_Id := Make_Function_Call (Loc, Name => - New_Occurrence_Of (RTE (RE_TC_Build), Loc), + New_Occurrence_Of (RTE (RE_Build_Complex_TC), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Kind, Loc), Make_Aggregate (Loc, @@ -10420,7 +10421,7 @@ package body Exp_Dist is Add_TypeCode_Parameter (Make_Constructed_TypeCode - (RTE (RE_TC_Struct), Struct_TC_Params), + (RTE (RE_Tk_Struct), Struct_TC_Params), Union_TC_Params); Add_String_Parameter (Name_Str, Union_TC_Params); @@ -10439,7 +10440,7 @@ package body Exp_Dist is Add_TypeCode_Parameter (Make_Constructed_TypeCode - (RTE (RE_TC_Union), Union_TC_Params), + (RTE (RE_Tk_Union), Union_TC_Params), Params); Add_String_Parameter (Name_Str, Params); @@ -10687,7 +10688,7 @@ package body Exp_Dist is TC_Append_Record_Traversal (Parameters, Component_List (Rdef), Empty, Dummy_Counter); - Return_Constructed_TypeCode (RTE (RE_TC_Struct)); + Return_Constructed_TypeCode (RTE (RE_Tk_Struct)); end; end if; @@ -10705,7 +10706,7 @@ package body Exp_Dist is for J in 1 .. Ndim loop if Constrained then Inner_TypeCode := Make_Constructed_TypeCode - (RTE (RE_TC_Array), New_List ( + (RTE (RE_Tk_Array), New_List ( Build_To_Any_Call (Loc, OK_Convert_To (RTE (RE_Unsigned_32), Make_Attribute_Reference (Loc, @@ -10731,7 +10732,7 @@ package body Exp_Dist is Next_Index (Indx); Inner_TypeCode := Make_Constructed_TypeCode - (RTE (RE_TC_Sequence), New_List ( + (RTE (RE_Tk_Sequence), New_List ( Build_To_Any_Call (Loc, OK_Convert_To (RTE (RE_Unsigned_32), Make_Integer_Literal (Loc, 0)), @@ -10747,7 +10748,7 @@ package body Exp_Dist is Start_String; Store_String_Char ('V'); Add_String_Parameter (End_String, Parameters); - Return_Constructed_TypeCode (RTE (RE_TC_Struct)); + Return_Constructed_TypeCode (RTE (RE_Tk_Struct)); end if; end; diff --git a/gcc/ada/exp_dist.ads b/gcc/ada/exp_dist.ads index a0bb6c113db..53f59f4757f 100644 --- a/gcc/ada/exp_dist.ads +++ b/gcc/ada/exp_dist.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- @@ -35,7 +35,7 @@ package Exp_Dist is PCS_Version_Number : constant array (PCS_Names) of Int := (Name_No_DSA => 1, Name_GARLIC_DSA => 1, - Name_PolyORB_DSA => 5); + Name_PolyORB_DSA => 6); -- PCS interface version. This is used to check for consistency between the -- compiler used to generate distribution stubs and the PCS implementation. -- It must be incremented whenever a change is made to the generated code diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 2680b4f7b8d..7a59c52efb3 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -275,7 +275,11 @@ procedure Gnat1drv is Force_ALI_Tree_File := True; Try_Semantics := True; - -- Make the Ada front-end more liberal to support other Ada compilers + -- Make the Ada front-end more liberal so that the compiler will + -- allow illegal code that is allowed by other compilers. CodePeer + -- is in the business of finding problems, not enforcing rules! + -- This is useful when using CodePeer mode with other compilers. + Relaxed_RM_Semantics := True; end if; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index e48eb00e474..ee1c73f87e1 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1191,7 +1191,12 @@ package Opt is Relaxed_RM_Semantics : Boolean := False; -- GNAT -- Set to True to ignore some Ada semantic error to help parse legacy - -- Ada code for use in e.g. static analysis (such as CodePeer). + -- Ada code for use in e.g. static analysis (such as CodePeer). This + -- deals with cases where other compilers allow illegal constructs. Tools + -- such as CodePeer are interested in analyzing code rather than enforcing + -- legality rules, so as long as these illegal constructs end up with code + -- that can be handled by the tool in question, there is no reason to + -- reject the code that is considered correct by the other compiler. Replace_In_Comments : Boolean := False; -- GNATPREP diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index 56ca6a69c0a..3b869641f6a 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -1048,31 +1048,34 @@ package body Prj.Makr is Project_File_Extension; Output_Name_Last := Output_Name_Last + Project_File_Extension'Length; - -- Back up project file if it already exists + -- Back up project file if it already exists (not needed in VMS since + -- versioning of files takes care of this requirement on VMS). if not Hostparm.OpenVMS and then not Opt.No_Backup - and then - Is_Regular_File (Path_Name (1 .. Path_Last)) + and then Is_Regular_File (Path_Name (1 .. Path_Last)) then declare - Discard : Boolean; + Discard : Boolean; Saved_Path : constant String := - Path_Name (1 .. Path_Last) & ".saved_"; - Nmb : Natural := 0; + Path_Name (1 .. Path_Last) & ".saved_"; + Nmb : Natural; + begin + Nmb := 0; loop declare Img : constant String := Nmb'Img; + begin if not Is_Regular_File - (Saved_Path & Img (2 .. Img'Last)) + (Saved_Path & Img (2 .. Img'Last)) then Copy_File - (Name => Path_Name (1 .. Path_Last), + (Name => Path_Name (1 .. Path_Last), Pathname => Saved_Path & Img (2 .. Img'Last), - Mode => Overwrite, - Success => Discard); + Mode => Overwrite, + Success => Discard); exit; end if; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 2bfbaa82a36..f218cdc7a2b 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- @@ -1307,6 +1307,9 @@ package Rtsfind is RE_Release_Buffer, -- System.Partition_Interface RE_BS_To_Any, -- System.Partition_Interface RE_Any_To_BS, -- System.Partition_Interface + RE_Build_Complex_TC, -- System.Partition_Interface + RE_Get_TC, -- System.Partition_Interface + RE_Set_TC, -- System.Partition_Interface RE_FA_A, -- System.Partition_Interface RE_FA_B, -- System.Partition_Interface @@ -1350,10 +1353,6 @@ package Rtsfind is RE_TA_Std_String, -- System.Partition_Interface RE_TA_TC, -- System.Partition_Interface - RE_TC_Alias, -- System.Partition_Interface - RE_TC_Build, -- System.Partition_Interface - RE_Get_TC, -- System.Partition_Interface - RE_Set_TC, -- System.Partition_Interface RE_TC_A, -- System.Partition_Interface RE_TC_B, -- System.Partition_Interface RE_TC_C, -- System.Partition_Interface @@ -1373,12 +1372,14 @@ package Rtsfind is RE_TC_Opaque, -- System.Partition_Interface RE_TC_WC, -- System.Partition_Interface RE_TC_WWC, -- System.Partition_Interface - RE_TC_Array, -- System.Partition_Interface - RE_TC_Sequence, -- System.Partition_Interface RE_TC_String, -- System.Partition_Interface - RE_TC_Struct, -- System.Partition_Interface - RE_TC_Union, -- System.Partition_Interface - RE_TC_Object, -- System.Partition_Interface + + RE_Tk_Alias, -- System.Partition_Interface + RE_Tk_Array, -- System.Partition_Interface + RE_Tk_Sequence, -- System.Partition_Interface + RE_Tk_Struct, -- System.Partition_Interface + RE_Tk_Objref, -- System.Partition_Interface + RE_Tk_Union, -- System.Partition_Interface RE_IS_Is1, -- System.Scalar_Values RE_IS_Is2, -- System.Scalar_Values @@ -2550,6 +2551,9 @@ package Rtsfind is RE_Release_Buffer => System_Partition_Interface, RE_BS_To_Any => System_Partition_Interface, RE_Any_To_BS => System_Partition_Interface, + RE_Build_Complex_TC => System_Partition_Interface, + RE_Get_TC => System_Partition_Interface, + RE_Set_TC => System_Partition_Interface, RE_FA_A => System_Partition_Interface, RE_FA_B => System_Partition_Interface, @@ -2593,10 +2597,6 @@ package Rtsfind is RE_TA_Std_String => System_Partition_Interface, RE_TA_TC => System_Partition_Interface, - RE_TC_Alias => System_Partition_Interface, - RE_TC_Build => System_Partition_Interface, - RE_Get_TC => System_Partition_Interface, - RE_Set_TC => System_Partition_Interface, RE_TC_A => System_Partition_Interface, RE_TC_B => System_Partition_Interface, RE_TC_C => System_Partition_Interface, @@ -2616,12 +2616,14 @@ package Rtsfind is RE_TC_Opaque => System_Partition_Interface, RE_TC_WC => System_Partition_Interface, RE_TC_WWC => System_Partition_Interface, - RE_TC_Array => System_Partition_Interface, - RE_TC_Sequence => System_Partition_Interface, RE_TC_String => System_Partition_Interface, - RE_TC_Struct => System_Partition_Interface, - RE_TC_Union => System_Partition_Interface, - RE_TC_Object => System_Partition_Interface, + + RE_Tk_Alias => System_Partition_Interface, + RE_Tk_Array => System_Partition_Interface, + RE_Tk_Sequence => System_Partition_Interface, + RE_Tk_Struct => System_Partition_Interface, + RE_Tk_Objref => System_Partition_Interface, + RE_Tk_Union => System_Partition_Interface, RE_Global_Pool_Object => System_Pool_Global, diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index ef9e4b95247..c20167a9527 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -5016,6 +5016,8 @@ package body Sem_Attr is then null; + -- Some other compilers allow dubious use of X'???'Size + elsif Relaxed_RM_Semantics and then Nkind (P) = N_Attribute_Reference then diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 3b635744090..5d87d3d1e32 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -9002,6 +9002,10 @@ package body Sem_Ch13 is procedure Too_Late is begin + -- Other compilers seem more relaxed about rep items appearing too + -- late. Since analysis tools typically don't care about rep items + -- anyway, no reason to be too strict about this. + if not Relaxed_RM_Semantics then Error_Msg_N ("|representation item appears too late!", N); end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 4980bfd02c2..8381837a050 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -1915,7 +1915,9 @@ package body Sem_Prag is -- is itself a library-level declaration is done elsewhere. -- Note: we omit this check in Relaxed_RM_Semantics mode to properly - -- handle code prior to AI-0033. + -- handle code prior to AI-0033. Analysis tools typically are not + -- interested in this pragma in any case, so no need to worry too + -- much about its placement. if Inside_A_Generic then if Ekind (Scope (Current_Scope)) = E_Generic_Package -- 2.30.2