Improve Is_Main_File

Make Is_Main_File recognize mains even if they are specified
in corresponding attribute without extentions.

Change-Id: I939d583760eb670e8fc25c1e19c54a248da6d1d8
TN: U412-040

src/gnatcoll-projects.adb

@@ -3927,9 +3927,39 @@ package body GNATCOLL.Projects is
       B_File : constant GNATCOLL.VFS.Filesystem_String := Base_Name (File);
       Files  :          VFS.File_Array_Access;
       Source : Boolean := False;
-   begin
-      Trace (Me, (+File) & " vs " & (+B_File));
 
+      function Check_Unit_Name (B_File : String; Unit : String) return Boolean;
+      --  Checks that given file may correspond to a "unit" name specified
+      --  in the Main attribute by checking all language body suffixes.
+
+      ---------------------
+      -- Check_Unit_Name --
+      ---------------------
+
+      function Check_Unit_Name (B_File : String; Unit : String) return Boolean
+      is
+         Langs : GNAT.Strings.String_List_Access :=
+           new String_List'(Project.Languages);
+      begin
+         for L of Langs.all loop
+            if Project.Has_Attribute (Impl_Suffix_Attribute, L.all) then
+               if Equal
+                 (B_File,
+                  Unit & Project.Attribute_Value
+                    (Impl_Suffix_Attribute, L.all),
+                  Case_Sensitive => Case_Sensitive)
+               then
+                  Free (Langs);
+                  return True;
+               end if;
+            end if;
+         end loop;
+
+         Free (Langs);
+         return False;
+      end Check_Unit_Name;
+
+   begin
       if GNATCOLL.VFS_Utils.Is_Absolute_Path (File) then
          --  Check that given file is a source of Project first.
          Files := Project.Source_Files (Recursive => False);
@@ -3949,6 +3979,7 @@ package body GNATCOLL.Projects is
       for V in Value'Range loop
          if Equal
            (Value (V).all, +B_File, Case_Sensitive => Case_Sensitive)
+             or else Check_Unit_Name (+B_File, Value (V).all)
          then
             Free (Value);
             return True;

testsuite/tests/projects/is_main_by_unit/main.ada2

@@ -0,0 +1,19 @@
+procedure Main is
+
+   Type Fred is tagged
+
+      record
+
+         Something : Boolean;
+
+      end record;
+
+   procedure Simon (This  : access Fred'Class);
+
+   procedure Simon (This  : access Fred'Class) is
+   begin
+      null;
+   end Simon;
+begin
+   null;
+end Main;

testsuite/tests/projects/is_main_by_unit/main2.c2

@@ -0,0 +1,6 @@
+#include <stdio.h>
+int main2() {
+   // printf() displays the string inside quotation
+   printf("Hello, World!");
+   return 0;
+}

testsuite/tests/projects/is_main_by_unit/r.gpr

@@ -0,0 +1,9 @@
+project r is
+   for Languages use ("Ada", "C");
+   for Main use ("main", "main2");
+
+   package Naming is
+      for Body_Suffix ("Ada") use ".ada2";
+      for Body_Suffix ("C") use ".c2";
+   end Naming;
+end r;

testsuite/tests/projects/is_main_by_unit/test.adb

@@ -0,0 +1,25 @@
+with GNATCOLL.Projects; use GNATCOLL.Projects;
+with GNATCOLL.Projects.Aux;
+with GNATCOLL.VFS;      use GNATCOLL.VFS;
+
+with Test_Assert;
+
+function Test return Integer is
+   PT : Project_Tree;
+   Env : Project_Environment_Access;
+begin
+
+   Initialize (Env);
+   PT.Load (GNATCOLL.VFS.Create ("r.gpr"), Env);
+
+   Test_Assert.Assert
+     (PT.Root_Project.Is_Main_File ("main.ada2"), "check Ada main");
+   Test_Assert.Assert
+     (PT.Root_Project.Is_Main_File ("main2.c2"), "check C main");
+
+   GNATCOLL.Projects.Aux.Delete_All_Temp_Files (PT.Root_Project);
+   Unload (PT);
+   Free (Env);
+   return Test_Assert.Report;
+
+end Test;

testsuite/tests/projects/is_main_by_unit/test.yaml

@@ -0,0 +1,8 @@
+description: >
+  Check that Is_Main_File correctly works when mains
+  are specified in the project file as unit names without
+  corresponding language specific suffix.
+data:
+    - "r.gpr"
+    - "main.ada2"
+    - "main2.c2"