From 0bd75e44cd11925fe09d7e9048bc14d9e976a92a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 20 Jan 2014 13:53:22 +0000 Subject: [PATCH] sem_prag.adb (Process_Import_Or_Interface): In Relaxed_RM_Semantics, support old Ada 83 style of pragma Import. 2014-01-20 Arnaud Charlet * sem_prag.adb (Process_Import_Or_Interface): In Relaxed_RM_Semantics, support old Ada 83 style of pragma Import. (Analyze_Pragma): Ditto for pragma Export. * exp_prag.adb (Expand_Pragma_Import_Or_Interface): Handle old pragma Import style. From-SVN: r206810 --- gcc/ada/ChangeLog | 8 +++++ gcc/ada/exp_prag.adb | 13 +++++++- gcc/ada/sem_prag.adb | 75 ++++++++++++++++++++++++++++++++++++++------ 3 files changed, 85 insertions(+), 11 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d507793d0176..c3e5d630d169 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2014-01-20 Arnaud Charlet + + * sem_prag.adb (Process_Import_Or_Interface): In + Relaxed_RM_Semantics, support old Ada 83 style of pragma Import. + (Analyze_Pragma): Ditto for pragma Export. + * exp_prag.adb (Expand_Pragma_Import_Or_Interface): Handle old pragma + Import style. + 2014-01-20 Hristian Kirtchev * einfo.ads: E_Abstract_State is now part of the entities that diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 693aac9b35f1..a1bb03ca78d4 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -548,7 +548,18 @@ package body Exp_Prag is Init_Call : Node_Id; begin - Def_Id := Entity (Arg2 (N)); + -- In Relaxed_RM_Semantics, support old Ada 83 style: + -- pragma Import (Entity, "external name"); + + if Relaxed_RM_Semantics + and then List_Length (Pragma_Argument_Associations (N)) = 2 + and then Chars (Pragma_Identifier (N)) = Name_Import + and then Nkind (Arg2 (N)) = N_String_Literal + then + Def_Id := Entity (Arg1 (N)); + else + Def_Id := Entity (Arg2 (N)); + end if; -- Variable case diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 29240bc38105..b9773742d9c5 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -7107,9 +7107,31 @@ package body Sem_Prag is Hom_Id : Entity_Id; begin - Process_Convention (C, Def_Id); - Kill_Size_Check_Code (Def_Id); - Note_Possible_Modification (Get_Pragma_Arg (Arg2), Sure => False); + -- In Relaxed_RM_Semantics, support old Ada 83 style: + -- pragma Import (Entity, "external name"); + + if Relaxed_RM_Semantics + and then Arg_Count = 2 + and then Prag_Id = Pragma_Import + and then Nkind (Expression (Arg2)) = N_String_Literal + then + C := Convention_C; + Def_Id := Get_Pragma_Arg (Arg1); + Analyze (Def_Id); + + if not Is_Entity_Name (Def_Id) then + Error_Pragma_Arg ("entity name required", Arg1); + end if; + + Def_Id := Entity (Def_Id); + Kill_Size_Check_Code (Def_Id); + Note_Possible_Modification (Get_Pragma_Arg (Arg1), Sure => False); + + else + Process_Convention (C, Def_Id); + Kill_Size_Check_Code (Def_Id); + Note_Possible_Modification (Get_Pragma_Arg (Arg2), Sure => False); + end if; if Ekind_In (Def_Id, E_Variable, E_Constant) then @@ -8602,6 +8624,18 @@ package body Sem_Prag is -- or Export pragma), then the external names must match if Present (Interface_Name (Internal_Ent)) then + + -- Ignore mismatching names in CodePeer mode, to support some + -- old compilers which would export the same procedure under + -- different names, e.g: + -- procedure P; + -- pragma Export_Procedure (P, "a"); + -- pragma Export_Procedure (P, "b"); + + if CodePeer_Mode then + return; + end if; + Check_Matching_Internal_Names : declare S1 : constant String_Id := Strval (Old_Name); S2 : constant String_Id := Strval (New_Name); @@ -12225,15 +12259,36 @@ package body Sem_Prag is Check_At_Least_N_Arguments (2); Check_At_Most_N_Arguments (4); - Process_Convention (C, Def_Id); - if Ekind (Def_Id) /= E_Constant then - Note_Possible_Modification - (Get_Pragma_Arg (Arg2), Sure => False); - end if; + -- In Relaxed_RM_Semantics, support old Ada 83 style: + -- pragma Export (Entity, "external name"); - Process_Interface_Name (Def_Id, Arg3, Arg4); - Set_Exported (Def_Id, Arg2); + if Relaxed_RM_Semantics + and then Arg_Count = 2 + and then Nkind (Expression (Arg2)) = N_String_Literal + then + C := Convention_C; + Def_Id := Get_Pragma_Arg (Arg1); + Analyze (Def_Id); + + if not Is_Entity_Name (Def_Id) then + Error_Pragma_Arg ("entity name required", Arg1); + end if; + + Def_Id := Entity (Def_Id); + Set_Exported (Def_Id, Arg1); + + else + Process_Convention (C, Def_Id); + + if Ekind (Def_Id) /= E_Constant then + Note_Possible_Modification + (Get_Pragma_Arg (Arg2), Sure => False); + end if; + + Process_Interface_Name (Def_Id, Arg3, Arg4); + Set_Exported (Def_Id, Arg2); + end if; -- If the entity is a deferred constant, propagate the information -- to the full view, because gigi elaborates the full view only. -- 2.47.3