From d11338a73fd25805a92dd4b46c2f6f77996dda80 Mon Sep 17 00:00:00 2001 From: Trevor Jennings Date: Thu, 30 May 2019 11:25:41 +0100 Subject: [PATCH 1/3] Ignore pragma Import with convention Intrinsic When a subprogram is imported with the convention Intrinsic, the subprogram is built into the compiler and does not signify a multi-language program. --- gnat2goto/driver/tree_walk.adb | 36 ++++++++++++++++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) diff --git a/gnat2goto/driver/tree_walk.adb b/gnat2goto/driver/tree_walk.adb index 66ef00665..9a0d1117a 100644 --- a/gnat2goto/driver/tree_walk.adb +++ b/gnat2goto/driver/tree_walk.adb @@ -4901,8 +4901,40 @@ package body Tree_Walk is -- be called from Ada, or a foreign-language variable to be -- accessed from Ada. This would (probably) require gnat2goto to -- understand the foreign code, which we do not at the moment. - Put_Line (Standard_Error, - "Warning: Multi-language analysis unsupported."); + -- However, if the calling convention is specified as "Intrinsic" + -- then the subprogram is built into the compiler and gnat2goto + -- can safely ignore the pragma. + declare + -- If the pragma is specified with positional parameter + -- association, then the calling convetion is the first + -- parameter. Check to see if it is Intrinsic. + Next_Ass : Node_Id := First (Pragma_Argument_Associations (N)); + Is_Intrinsic : Boolean := Present (Next_Ass) and then + Nkind (Expression (Next_Ass)) = N_Identifier and then + Get_Name_String (Chars (Expression (Next_Ass))) = "intrinsic"; + begin + -- If the first parameter is not Intrinsic, check named + -- parameters for calling convention + while not Is_Intrinsic and Present (Next_Ass) loop + if Chars (Next_Ass) /= No_Name and then + Get_Name_String (Chars (Next_Ass)) = "convention" + then + -- The named parameter is Convention, check to see if it + -- is Intrinsic + Is_Intrinsic := + Get_Name_String (Chars (Expression (Next_Ass))) = + "intrinsic"; + end if; + -- Get the next parameter association + Next_Ass := Next (Next_Ass); + end loop; + + if not Is_Intrinsic then + Put_Line (Standard_Error, + "Warning: Multi-language analysis unsupported."); + end if; + end; + when Name_Elaborate => -- Specifies that the body of the named library unit is elaborated -- before the current library_item. We will support packages. From 61b2f4cef9ef544648f389e7e73c5a3d080cd297 Mon Sep 17 00:00:00 2001 From: Trevor Jennings Date: Thu, 30 May 2019 11:40:38 +0100 Subject: [PATCH 2/3] Add test for handling pragma Import with convention Intrinsic --- testsuite/gnat2goto/tests/intrinsic/test.out | 6 ++++++ testsuite/gnat2goto/tests/intrinsic/test.py | 4 ++++ .../gnat2goto/tests/intrinsic/use_import.adb | 17 +++++++++++++++++ 3 files changed, 27 insertions(+) create mode 100644 testsuite/gnat2goto/tests/intrinsic/test.out create mode 100644 testsuite/gnat2goto/tests/intrinsic/test.py create mode 100644 testsuite/gnat2goto/tests/intrinsic/use_import.adb diff --git a/testsuite/gnat2goto/tests/intrinsic/test.out b/testsuite/gnat2goto/tests/intrinsic/test.out new file mode 100644 index 000000000..19c69e408 --- /dev/null +++ b/testsuite/gnat2goto/tests/intrinsic/test.out @@ -0,0 +1,6 @@ +Standard_Error from gnat2goto use_import: +Warning: Multi-language analysis unsupported. +Warning: Multi-language analysis unsupported. + +[overflow.1] file use_import.adb line 16 arithmetic overflow on signed unary minus in -use_import__i: SUCCESS +VERIFICATION SUCCESSFUL diff --git a/testsuite/gnat2goto/tests/intrinsic/test.py b/testsuite/gnat2goto/tests/intrinsic/test.py new file mode 100644 index 000000000..9f3fe4da7 --- /dev/null +++ b/testsuite/gnat2goto/tests/intrinsic/test.py @@ -0,0 +1,4 @@ +from test_support import * + +prove("--signed-overflow-check") + diff --git a/testsuite/gnat2goto/tests/intrinsic/use_import.adb b/testsuite/gnat2goto/tests/intrinsic/use_import.adb new file mode 100644 index 000000000..4d693f585 --- /dev/null +++ b/testsuite/gnat2goto/tests/intrinsic/use_import.adb @@ -0,0 +1,17 @@ +procedure Use_Import is + procedure P (X : Integer); + pragma Import (C, P); + + procedure Q (X : Integer); + pragma Import (Convention => C, Entity => Q); + + function "-" (X : Integer) return Integer; + pragma Import (Convention => Intrinsic, Entity => "-"); + + function "+" (Left, Right : Integer) return Integer; + pragma Import (Intrinsic, "+"); + + I : Integer := 1; +begin + I := -I; +end Use_Import; From 1d5e2650741c9d5c3953cbb3b0b7e95350100152 Mon Sep 17 00:00:00 2001 From: Trevor Jennings Date: Tue, 4 Jun 2019 16:10:48 +0100 Subject: [PATCH 3/3] Correct typo --- gnat2goto/driver/tree_walk.adb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnat2goto/driver/tree_walk.adb b/gnat2goto/driver/tree_walk.adb index 9a0d1117a..85e343027 100644 --- a/gnat2goto/driver/tree_walk.adb +++ b/gnat2goto/driver/tree_walk.adb @@ -4906,7 +4906,7 @@ package body Tree_Walk is -- can safely ignore the pragma. declare -- If the pragma is specified with positional parameter - -- association, then the calling convetion is the first + -- association, then the calling convention is the first -- parameter. Check to see if it is Intrinsic. Next_Ass : Node_Id := First (Pragma_Argument_Associations (N)); Is_Intrinsic : Boolean := Present (Next_Ass) and then