| blob | e8b5c89eb82d633f28ed34ff46c75259d4db495a |
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- B L D --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2002-2004 Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
21 -- --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 -- --
25 ------------------------------------------------------------------------------
27 -- This package is still a work in progress.
64 -- Set to False by command line switch -R
67 -- To avoid displaying the Copyright line several times
70 -- To avoid displaying the usage several times
75 -- After procedure Expression has been called, this global variable
76 -- indicates if the expression is a static string or not.
77 -- If it is a static string, then Expression_Value (1 .. Expression_Last)
78 -- is the static value of the expression.
83 -- The following variables indicates if the suffixes and the languages
84 -- are statically specified and, if they are, their values.
107 -- Used when post-processing Compiler'Switches to indicate the language
108 -- of a source.
110 -- The following variables are used to controlled what attributes
111 -- Default_Switches and Switches are allowed in expressions.
118 -- Other attribute references are only allowed in attribute declarations
119 -- of the same package and of the same name.
121 -- Other_Attribute is True only during attribute declarations other than
122 -- Switches or Default_Switches.
134 -- Names that are not in Snames
148 -- This hash table contains all processed projects.
149 -- It is used to avoid processing the same project file several times.
158 -- This hash table is used to store all the external references.
159 -- For each project file, the tree is first traversed and all
160 -- external references are put in variables. Each of these variables
161 -- are identified by a number, so that the can be referred to
162 -- later during the second traversal of the tree.
171 -- This table stores all the variables declared in a package.
172 -- It is used to distinguish project level and package level
173 -- variables identified by simple names.
174 -- This table is reset for each package.
183 -- This table stores all the indexs of associative array attribute
184 -- Compiler'Switches specified in a project file. It is reset for
185 -- each project file. At the end of processing of a project file
186 -- this table is traversed to output targets for those files
187 -- that may be C or C++ source files.
190 -- For each external reference, this variable in incremented by 1,
191 -- and a Makefile variable <PROJECT>__EXTERNAL__<Last_External> is
192 -- declared. See procedure Process_Externals.
195 -- For each case construction, this variable is incremented by 1,
196 -- and a Makefile variable <PROJECT>__CASE__<Last_Case_Construction> is
197 -- declared. See procedure Process_Declarative_Items.
200 -- Prefix to be added to the name of reserved variables (see below) when
201 -- used in external references.
203 -- A number of environment variables, whose names are used in the
204 -- Makefiles are saved at the beginning of the main Makefile.
205 -- Each reference to any such environment variable is replaced
206 -- in the Makefiles with the name of the saved variable.
240 Ada_Mains_String 'Access,
242 Ada_Spec_String 'Access,
244 Ar_Ext_String 'Access,
246 Cc_String 'Access,
248 Cflags_String 'Access,
250 Cxx_Ext_String 'Access,
253 Exec_String 'Access,
255 Fldflags_String 'Access,
257 Languages_String 'Access,
259 Libs_String 'Access,
261 Obj_Ext_String 'Access,
263 Project_File_String 'Access,
267 -- The name of the main project file, given as argument.
270 -- The result of the parsing of the main project file.
274 -- Add a string to variable Expression_Value
277 -- Display name of the tool and the copyright
280 -- Return True if Left and Right are the same string, without considering
281 -- the case.
283 procedure Expression
289 -- Process an expression.
290 -- If In_Case is True, all expressions are not static.
293 -- Add a line terminator in the Makefile
296 -- Process the project tree, result of the parsing.
298 procedure Process_Case_Construction
305 -- Process a case construction.
306 -- The Makefile declations may be suppressed if no declarative
307 -- items in the case items are to be put in the Makefile.
309 procedure Process_Declarative_Items
314 -- Process the declarative items for a project, a package
315 -- or a case item.
316 -- If In_Case is True, all expressions are not static
319 -- Look for all external references in one project file, populate the
320 -- table Externals, and output the necessary declarations, if any.
323 -- Add a string to the Makefile.
324 -- When With_Substitution is True, if the string is one of the reserved
325 -- variables, replace it with the name of the corresponding saved
326 -- variable.
329 -- Add a string to the Makefile.
332 -- Add the image of a number to the Makefile, without leading space
334 procedure Put_Attribute
339 -- Put the full name of an attribute in the Makefile
342 -- Add a directory separator to the Makefile
344 procedure Put_Include_Project
348 -- Output an include directive for a project
351 -- Add a string and a line terminator to the Makefile
354 -- Put a name in lower case in the Makefile
357 -- Put a name in mixed case in the Makefile
360 -- Put a name in upper case in the Makefile
363 -- Put a name in upper case in the Makefile.
364 -- If "C++" change it to "CXX".
366 procedure Put_Variable
370 -- Put the full name of a variable in the Makefile
373 -- Process a project file and the project files it depends on iteratively
374 -- without processing twice the same project file.
377 -- Indicate that all suffixes and languages have the default values
380 -- From a source file name, returns the source kind of the file
382 function Suffix_Of
387 -- Returns the current suffix, if it is statically known, or ""
388 -- if it is not statically known. Used on C_Suffix, Cxx_Suffix,
389 -- Ada_Body_Suffix and Ada_Spec_Suffix.
392 -- Display the usage of gnatbuild
394 -----------------------------
395 -- Add_To_Expression_Value --
396 -----------------------------
399 begin
400 -- Check that the buffer is large enough.
401 -- If it is not, double it until it is large enough.
404 declare
408 begin
422 begin
427 -----------------------
428 -- Display_Copyright --
429 -----------------------
432 begin
438 Write_Eol;
439 Write_Eol;
443 ------------------
444 -- Equal_String --
445 ------------------
448 begin
451 declare
455 begin
461 ----------------
462 -- Expression --
463 ----------------
465 procedure Expression
471 is
473 -- The term in the expression list
476 -- The current term node id
478 begin
494 -- If we are in a string list, we precede this literal string
495 -- with a space; it does not matter if the output list
496 -- has a leading space.
497 -- Otherwise we just output the literal string:
498 -- if it is not the first term of the expression, it will
499 -- concatenate with was previously output.
505 -- If in a static string expression, add to expression value
509 then
522 -- For string list, we repetedly call Expression with each
523 -- element of the list.
525 declare
529 begin
532 -- If String_Node is nil, it is an empty list,
533 -- set Expression_Kind if it is still Undecided
539 else
540 Expression
546 loop
547 -- Add the other element of the literal string list
548 -- one after the other
550 String_Node :=
557 Expression
567 -- A variable or attribute reference is never static
571 -- A variable or an attribute is identified by:
572 -- - its project name,
573 -- - its package name, if any,
574 -- - its name, and
575 -- - its index (if an associative array attribute).
577 declare
587 begin
596 -- If we are in a string list, we precede this variable or
597 -- attribute reference with a space; it does not matter if
598 -- the output list has a leading space.
607 Put_Variable
612 else
613 -- Attribute reference.
615 -- If it is a Default_Switches attribute, check if it
616 -- is allowed in this expression (same package and same
617 -- language).
621 or else not Equal_String
623 Associative_Array_Index_Of
625 then
626 -- This Default_Switches attribute is not allowed
627 -- here; report an error and continue.
628 -- The Makefiles created will be deleted at the
629 -- end.
632 Error_Msg
638 -- If it is a Switches attribute, check if it is allowed
639 -- in this expression (same package and same source
640 -- kind).
646 /= Switches_Language
647 then
648 -- This Switches attribute is not allowed here;
649 -- report an error and continue. The Makefiles
650 -- created will be deleted at the end.
653 Error_Msg
659 else
660 -- Other attribute references are only allowed in
661 -- the declaration of an atribute of the same
662 -- package and of the same name.
664 if not Other_Attribute
667 then
670 Error_Msg
674 else
677 Error_Msg
684 Put_Attribute
695 -- An external reference is never static
699 -- As the external references have already been processed,
700 -- we just output the name of the variable that corresponds
701 -- to this external reference node.
711 -- Should never happen
713 pragma Assert
723 --------------
724 -- Gpr2make --
725 --------------
728 begin
729 -- First, get the switches, if any
731 loop
736 -- -h: Help
739 Usage;
741 -- -q: Quiet
746 -- -v: Verbose
750 Display_Copyright;
752 -- -R: no Recursivity
762 -- Now, get the project file (maximum one)
764 loop
765 declare
767 begin
773 else
775 end if;
776 end;
777 end loop;
779 -- If no project file specified, display the usage and exit
781 if Main_Project_File_Name = null then
782 Usage;
783 return;
784 end if;
786 -- Do the necessary initializations
788 Csets.Initialize;
789 Namet.Initialize;
791 Snames.Initialize;
793 Prj.Initialize;
795 -- Parse the project file(s)
797 Prj.Part.Parse (Project_Tree, Main_Project_File_Name.all, False);
799 -- If parsing was successful, process the project tree
801 if Project_Tree /= Empty_Node then
803 -- Create some Name_Ids that are not in Snames
805 Name_Len := 3;
806 Name_Buffer (1 .. Name_Len) := "ide";
807 Name_Ide := Name_Find;
809 Name_Len := 16;
810 Name_Buffer (1 .. Name_Len) := "compiler_command";
811 Name_Compiler_Command := Name_Find;
813 Name_Len := 13;
814 Name_Buffer (1 .. Name_Len) := "main_language";
815 Name_Main_Language := Name_Find;
817 Name_Len := 3;
818 Name_Buffer (1 .. Name_Len) := "c++";
819 Name_C_Plus_Plus := Name_Find;
821 Process (Project_Tree);
823 if Compilation_Errors then
824 if not Verbose_Mode then
825 Write_Eol;
826 end if;
828 Prj.Err.Finalize;
829 Write_Eol;
830 IO.Delete_All;
831 Fail ("no Makefile created");
832 end if;
833 end if;
834 end Gpr2make;
836 --------------
837 -- New_Line --
838 --------------
840 procedure New_Line is
841 begin
842 IO.New_Line;
843 end New_Line;
845 -------------
846 -- Process --
847 -------------
849 procedure Process (Project : Project_Node_Id) is
850 begin
851 Processed_Projects.Reset;
852 Recursive_Process (Project);
853 end Process;
855 -------------------------------
856 -- Process_Case_Construction --
857 -------------------------------
859 procedure Process_Case_Construction
860 (Current_Project : Project_Node_Id;
861 Current_Pkg : Name_Id;
862 Case_Project : Project_Node_Id;
863 Case_Pkg : Name_Id;
864 Name : Name_Id;
865 Node : Project_Node_Id)
866 is
867 Case_Project_Name : constant Name_Id := Name_Of (Case_Project);
868 Before : IO.Position;
869 Start : IO.Position;
870 After : IO.Position;
872 procedure Put_Case_Construction;
873 -- Output the variable $<PROJECT>__CASE__#, specific to
874 -- this case construction. It contains the number of the
875 -- branch to follow.
877 procedure Recursive_Process
878 (Case_Item : Project_Node_Id;
879 Branch_Number : Positive);
880 -- A recursive procedure. Calls itself for each branch, increasing
881 -- Branch_Number by 1 each time.
883 procedure Put_Variable_Name;
884 -- Output the case variable
886 ---------------------------
887 -- Put_Case_Construction --
888 ---------------------------
890 procedure Put_Case_Construction is
891 begin
892 Put_U_Name (Case_Project_Name);
893 Put (".case.");
894 Put (Last_Case_Construction);
895 end Put_Case_Construction;
897 -----------------------
898 -- Recursive_Process --
899 -----------------------
901 procedure Recursive_Process
902 (Case_Item : Project_Node_Id;
903 Branch_Number : Positive)
904 is
905 Choice_String : Project_Node_Id := First_Choice_Of (Case_Item);
907 Before : IO.Position;
908 Start : IO.Position;
909 After : IO.Position;
911 No_Lines : Boolean := False;
913 begin
914 -- Nothing to do if Case_Item is empty.
915 -- That should happen only if the case construvtion is totally empty.
916 -- case Var is
917 -- end case;
919 if Case_Item /= Empty_Node then
920 -- Remember where we are, to be able to come back here if this
921 -- case item is empty.
923 IO.Mark (Before);
925 if Choice_String = Empty_Node then
926 -- when others =>
928 -- Output a comment "# when others => ..."
930 Put_Line ("# when others => ...");
932 -- Remember where we are, to detect if there is anything
933 -- put in the Makefile for this branch.
935 IO.Mark (Start);
937 -- Process the declarative items of this branch
939 Process_Declarative_Items
940 (Project => Current_Project,
941 Pkg => Current_Pkg,
942 In_Case => True,
943 Item => First_Declarative_Item_Of (Case_Item));
945 -- Where are we now?
946 IO.Mark (After);
948 -- If we are at the same place, the branch is totally empty:
949 -- suppress it completely.
951 if Start = After then
952 IO.Release (Before);
953 end if;
954 else
955 -- Case Item with one or several case labels
957 -- Output a comment
958 -- # case <label> => ...
959 -- or
960 -- # case <first_Label> | ... =>
961 -- depending on the number of case labels.
963 Put ("# when """);
964 Put (String_Value_Of (Choice_String));
965 Put ("""");
967 if Next_Literal_String (Choice_String) /= Empty_Node then
968 Put (" | ...");
969 end if;
971 Put (" => ...");
972 New_Line;
974 -- Check if the case variable is equal to the first case label
975 Put ("ifeq ($(");
976 Put_Variable_Name;
977 Put ("),");
978 Put (String_Value_Of (Choice_String));
979 Put (")");
980 New_Line;
982 if Next_Literal_String (Choice_String) /= Empty_Node then
983 -- Several choice strings. We need to use an auxiliary
984 -- variable <PROJECT.case.# to detect if we should follow
985 -- this branch.
987 loop
988 Put_Case_Construction;
989 Put (":=");
990 Put (Branch_Number);
991 New_Line;
993 Put_Line ("endif");
995 Choice_String := Next_Literal_String (Choice_String);
997 exit when Choice_String = Empty_Node;
999 Put ("ifeq ($(");
1000 Put_Variable_Name;
1001 Put ("),");
1002 Put (String_Value_Of (Choice_String));
1003 Put (")");
1004 New_Line;
1005 end loop;
1007 -- Now, we test the auxiliary variable
1009 Put ("ifeq ($(");
1010 Put_Case_Construction;
1011 Put ("),");
1012 Put (Branch_Number);
1013 Put (")");
1014 New_Line;
1015 end if;
1017 -- Remember where we are before calling
1018 -- Process_Declarative_Items.
1020 IO.Mark (Start);
1022 Process_Declarative_Items
1023 (Project => Current_Project,
1024 Pkg => Current_Pkg,
1025 In_Case => True,
1026 Item => First_Declarative_Item_Of (Case_Item));
1028 -- Check where we are now, to detect if some lines have been
1029 -- added to the Makefile.
1031 IO.Mark (After);
1033 No_Lines := Start = After;
1035 -- If no lines have been added, then suppress completely this
1036 -- branch.
1038 if No_Lines then
1039 IO.Release (Before);
1040 end if;
1042 -- If there is a next branch, process it
1044 if Next_Case_Item (Case_Item) /= Empty_Node then
1045 -- If this branch has not been suppressed, we need an "else"
1047 if not No_Lines then
1048 -- Mark the position of the "else"
1050 IO.Mark (Before);
1052 Put_Line ("else");
1054 -- Mark the position before the next branch
1056 IO.Mark (Start);
1057 end if;
1059 Recursive_Process
1060 (Case_Item => Next_Case_Item (Case_Item),
1061 Branch_Number => Branch_Number + 1);
1063 if not No_Lines then
1064 -- Where are we?
1065 IO.Mark (After);
1067 -- If we are at the same place, suppress the useless
1068 -- "else".
1070 if After = Start then
1071 IO.Release (Before);
1072 end if;
1073 end if;
1074 end if;
1076 -- If the branch has not been suppressed, we need an "endif"
1078 if not No_Lines then
1079 Put_Line ("endif");
1080 end if;
1081 end if;
1082 end if;
1083 end Recursive_Process;
1085 -----------------------
1086 -- Put_Variable_Name --
1087 -----------------------
1089 procedure Put_Variable_Name is
1090 begin
1091 Put_Variable (Case_Project, Case_Pkg, Name);
1092 end Put_Variable_Name;
1094 -- Start of procedure Process_Case_Construction
1096 begin
1097 Last_Case_Construction := Last_Case_Construction + 1;
1099 -- Remember where we are in case we suppress completely the case
1100 -- construction.
1102 IO.Mark (Before);
1104 New_Line;
1106 -- Output a comment line for this case construction
1108 Put ("# case ");
1109 Put_M_Name (Case_Project_Name);
1111 if Case_Pkg /= No_Name then
1112 Put (".");
1113 Put_M_Name (Case_Pkg);
1114 end if;
1116 Put (".");
1117 Put_M_Name (Name);
1118 Put (" is ...");
1119 New_Line;
1121 -- Remember where we are, to detect if all branches have been suppressed
1123 IO.Mark (Start);
1125 -- Start at the first case item
1127 Recursive_Process
1128 (Case_Item => First_Case_Item_Of (Node),
1129 Branch_Number => 1);
1131 -- Where are we?
1133 IO.Mark (After);
1135 -- If we are at the same position, it means that all branches have been
1136 -- suppressed: then we suppress completely the case construction.
1138 if Start = After then
1139 IO.Release (Before);
1141 else
1142 -- If the case construction is not completely suppressed, we issue
1143 -- a comment indicating the end of the case construction.
1145 Put_Line ("# end case;");
1147 New_Line;
1148 end if;
1149 end Process_Case_Construction;
1151 -------------------------------
1152 -- Process_Declarative_Items --
1153 -------------------------------
1155 procedure Process_Declarative_Items
1156 (Project : Project_Node_Id;
1157 Pkg : Name_Id;
1158 In_Case : Boolean;
1159 Item : Project_Node_Id)
1160 is
1161 Current_Declarative_Item : Project_Node_Id := Item;
1162 Current_Item : Project_Node_Id := Empty_Node;
1164 Project_Name : constant String :=
1165 To_Upper (Get_Name_String (Name_Of (Project)));
1166 Item_Name : Name_Id := No_Name;
1168 begin
1169 -- For each declarative item
1171 while Current_Declarative_Item /= Empty_Node loop
1172 -- Get its data
1174 Current_Item := Current_Item_Node (Current_Declarative_Item);
1176 -- And set Current_Declarative_Item to the next declarative item
1177 -- ready for the next iteration
1179 Current_Declarative_Item := Next_Declarative_Item
1180 (Current_Declarative_Item);
1182 -- By default, indicate that we are not declaring attribute
1183 -- Default_Switches or Switches.
1185 Other_Attribute := False;
1187 -- Write_Line (Project_Node_Kind'Image (Kind_Of (Current_Item)));
1189 case Kind_Of (Current_Item) is
1191 when N_Package_Declaration =>
1192 Item_Name := Name_Of (Current_Item);
1194 declare
1195 Real_Project : constant Project_Node_Id :=
1196 Project_Of_Renamed_Package_Of
1197 (Current_Item);
1199 Before_Package : IO.Position;
1200 Start_Of_Package : IO.Position;
1201 End_Of_Package : IO.Position;
1203 Decl_Item : Project_Node_Id;
1205 begin
1206 -- If it is a renaming package, we go to the original
1207 -- package. This is guaranteed to work, otherwise the
1208 -- parsing of the project file tree would have already
1209 -- failed.
1211 if Real_Project /= Empty_Node then
1212 Decl_Item :=
1213 First_Declarative_Item_Of
1214 (Project_Declaration_Of (Real_Project));
1216 -- Traverse the declarative items of the project,
1217 -- until we find the renamed package.
1219 while Decl_Item /= Empty_Node loop
1220 Current_Item := Current_Item_Node (Decl_Item);
1221 exit when Kind_Of (Current_Item)
1222 = N_Package_Declaration
1223 and then Name_Of (Current_Item) = Item_Name;
1224 Decl_Item := Next_Declarative_Item (Decl_Item);
1225 end loop;
1226 end if;
1228 -- Remember where we are, in case we want to completely
1229 -- suppress this package.
1231 IO.Mark (Before_Package);
1233 New_Line;
1235 -- Output comment line for this package
1237 Put ("# package ");
1238 Put_M_Name (Item_Name);
1239 Put (" is ...");
1240 New_Line;
1242 -- Record where we are before calling
1243 -- Process_Declarative_Items.
1245 IO.Mark (Start_Of_Package);
1247 -- And process the declarative items of this package
1249 Process_Declarative_Items
1250 (Project => Project,
1251 Pkg => Item_Name,
1252 In_Case => False,
1253 Item => First_Declarative_Item_Of (Current_Item));
1255 -- Reset the local variables once we have finished with
1256 -- this package.
1258 Variable_Names.Init;
1260 -- Where are we?
1261 IO.Mark (End_Of_Package);
1263 -- If we are at the same place, suppress completely the
1264 -- package.
1266 if End_Of_Package = Start_Of_Package then
1267 IO.Release (Before_Package);
1269 else
1271 -- otherwise, utput comment line for end of package
1273 Put ("# end ");
1274 Put_M_Name (Item_Name);
1275 Put (";");
1276 New_Line;
1278 New_Line;
1279 end if;
1280 end;
1282 when N_Variable_Declaration | N_Typed_Variable_Declaration =>
1283 Item_Name := Name_Of (Current_Item);
1285 -- Output comment line for this variable
1287 Put ("# ");
1288 Put_M_Name (Item_Name);
1289 Put (" := ...");
1290 New_Line;
1292 -- If we are inside a package, the variable is a local
1293 -- variable, not a project level variable.
1294 -- So we check if its name is included in the Variables
1295 -- table; if it is not already, we put it in the table.
1297 if Pkg /= No_Name then
1298 declare
1299 Found : Boolean := False;
1301 begin
1302 for
1303 Index in Variable_Names.First .. Variable_Names.Last
1304 loop
1305 if Variable_Names.Table (Index) = Item_Name then
1306 Found := True;
1307 exit;
1308 end if;
1309 end loop;
1311 if not Found then
1312 Variable_Names.Increment_Last;
1313 Variable_Names.Table (Variable_Names.Last) :=
1314 Item_Name;
1315 end if;
1316 end;
1317 end if;
1319 -- Output the line <variable_Name>:=<expression>
1321 Put_Variable (Project, Pkg, Item_Name);
1323 Put (":=");
1325 Expression
1326 (Project => Project,
1327 First_Term => Tree.First_Term (Expression_Of (Current_Item)),
1328 Kind => Expression_Kind_Of (Current_Item),
1329 In_Case => In_Case);
1331 New_Line;
1333 when N_Attribute_Declaration =>
1334 Item_Name := Name_Of (Current_Item);
1336 declare
1337 Index : constant Name_Id :=
1338 Associative_Array_Index_Of (Current_Item);
1340 Pos_Comment : IO.Position;
1341 Put_Declaration : Boolean := True;
1343 begin
1344 -- If it is a Default_Switches attribute register the
1345 -- project, the package and the language to indicate
1346 -- what Default_Switches attribute references are allowed
1347 -- in expressions.
1349 if Item_Name = Snames.Name_Default_Switches then
1350 Default_Switches_Package := Pkg;
1351 Default_Switches_Language := Index;
1353 -- If it is a Switches attribute register the project,
1354 -- the package and the source kind to indicate what
1355 -- Switches attribute references are allowed in expressions.
1357 elsif Item_Name = Snames.Name_Switches then
1358 Switches_Package := Pkg;
1359 Switches_Language := Source_Kind_Of (Index);
1361 else
1362 -- Set Other_Attribute to True to indicate that we are
1363 -- in the declaration of an attribute other than
1364 -- Switches or Default_Switches.
1366 Other_Attribute := True;
1367 Other_Attribute_Package := Pkg;
1368 Other_Attribute_Name := Item_Name;
1369 end if;
1371 -- Record where we are to be able to suppress the
1372 -- declaration.
1374 IO.Mark (Pos_Comment);
1376 -- Output comment line for this attribute
1378 Put ("# for ");
1379 Put_M_Name (Item_Name);
1381 if Index /= No_Name then
1382 Put (" (""");
1383 Put (Index);
1384 Put (""")");
1385 end if;
1387 Put (" use ...");
1388 New_Line;
1390 -- Output the line <attribute_name>:=<expression>
1392 Put_Attribute (Project, Pkg, Item_Name, Index);
1393 Put (":=");
1394 Expression
1395 (Project => Project,
1396 First_Term =>
1397 Tree.First_Term (Expression_Of (Current_Item)),
1398 Kind => Expression_Kind_Of (Current_Item),
1399 In_Case => In_Case,
1400 Reset => True);
1401 New_Line;
1403 -- Remove any Default_Switches attribute declaration for
1404 -- languages other than C or C++.
1406 if Item_Name = Snames.Name_Default_Switches then
1407 Get_Name_String (Index);
1408 To_Lower (Name_Buffer (1 .. Name_Len));
1409 Put_Declaration :=
1410 Name_Buffer (1 .. Name_Len) = "c" or else
1411 Name_Buffer (1 .. Name_Len) = "c++";
1413 -- Remove any Switches attribute declaration for source
1414 -- kinds other than C, C++ or unknown.
1416 elsif Item_Name = Snames.Name_Switches then
1417 Put_Declaration :=
1418 Switches_Language = Unknown
1419 or else Switches_Language = C
1420 or else Switches_Language = Cxx;
1422 end if;
1424 -- Attributes in packages other than Naming, Compiler or
1425 -- IDE are of no interest; suppress their declarations.
1427 Put_Declaration := Put_Declaration and
1428 (Pkg = No_Name
1429 or else Pkg = Snames.Name_Naming
1430 or else Pkg = Snames.Name_Compiler
1431 or else Pkg = Name_Ide
1432 or else Pkg = Snames.Name_Linker);
1434 if Put_Declaration then
1435 -- Some attributes are converted into reserved variables
1437 if Pkg = No_Name then
1439 -- Project level attribute
1441 if Item_Name = Snames.Name_Languages then
1443 -- for Languages use ...
1445 -- Attribute Languages is converted to variable
1446 -- LANGUAGES. The actual string is put in lower
1447 -- case.
1449 Put ("LANGUAGES:=");
1451 -- If the expression is static (expected to be so
1452 -- most of the cases), then just give to LANGUAGES
1453 -- the lower case value of the expression.
1455 if Expression_Kind = Static_String then
1456 Put (To_Lower (Expression_Value
1457 (1 .. Expression_Last)));
1459 else
1460 -- Otherwise, call to_lower on the value
1461 -- of the attribute.
1463 Put ("$(shell gprcmd to_lower $(");
1464 Put_Attribute
1465 (Project, No_Name, Item_Name, No_Name);
1466 Put ("))");
1467 end if;
1469 New_Line;
1471 -- Record value of Languages if expression is
1472 -- static and if Languages_Static is True.
1474 if Expression_Kind /= Static_String then
1475 Languages_Static := False;
1477 elsif Languages_Static then
1478 To_Lower
1479 (Expression_Value (1 .. Expression_Last));
1481 if Languages_Last = 0 then
1482 if Languages'Last < Expression_Last + 2 then
1483 Free (Languages);
1484 Languages :=
1485 new String (1 .. Expression_Last + 2);
1486 end if;
1489 Languages (2 .. Expression_Last + 1) :=
1490 Expression_Value (1 .. Expression_Last);
1491 Languages_Last := Expression_Last + 2;
1494 else
1495 Languages_Static :=
1496 Languages (2 .. Languages_Last - 1) =
1497 Expression_Value (1 .. Expression_Last);
1498 end if;
1499 end if;
1501 elsif Item_Name = Snames.Name_Source_Dirs then
1503 -- for Source_Dirs use ...
1505 -- String list attribute Source_Dirs is converted
1506 -- to variable <PROJECT>.src_dirs, each element
1507 -- being an absolute directory name.
1509 Put (Project_Name &
1510 ".src_dirs:=$(foreach name,$(");
1511 Put_Attribute (Project, Pkg, Item_Name, No_Name);
1512 Put ("),$(shell gprcmd extend $(");
1513 Put (Project_Name);
1516 elsif Item_Name = Snames.Name_Source_Files then
1518 -- for Source_Files use ...
1520 -- String list Source_Files is converted to
1521 -- variable <PROJECT>.src_files
1523 Put (Project_Name);
1524 Put (".src_files:=$(");
1525 Put_Attribute (Project, Pkg, Item_Name, No_Name);
1526 Put (")");
1527 New_Line;
1529 if In_Case then
1530 if Source_Files_Declaration = False then
1531 Source_Files_Declaration := May_Be;
1532 end if;
1534 if Source_Files_Declaration /= True then
1536 -- Variable src_files.specified is set to
1537 -- TRUE. It will be tested to decide if there
1538 -- is a need to look for source files either
1539 -- in the source directories or in a source
1540 -- list file.
1542 Put_Line ("src_files.specified:=TRUE");
1543 end if;
1545 else
1546 Source_Files_Declaration := True;
1547 end if;
1549 elsif Item_Name = Snames.Name_Source_List_File then
1551 -- for Source_List_File use ...
1553 -- Single string Source_List_File is converted to
1554 -- variable src.list_file. It will be used
1555 -- later, if necessary, to get the source
1556 -- file names from the specified file.
1557 -- The file name is converted to an absolute path
1558 -- name if necessary.
1560 Put ("src.list_file:=" &
1561 "$(strip $(shell gprcmd to_absolute $(");
1562 Put (Project_Name);
1564 Put_Attribute (Project, Pkg, Item_Name, No_Name);
1567 if In_Case then
1568 if Source_List_File_Declaration = False then
1569 Source_List_File_Declaration := May_Be;
1570 end if;
1572 if Source_Files_Declaration /= True
1573 and then Source_List_File_Declaration /= True
1574 then
1575 -- Variable src_list_file.specified is set to
1576 -- TRUE. It will be tested later, if
1577 -- necessary, to read the source list file.
1579 Put_Line ("src_list_file.specified:=TRUE");
1580 end if;
1582 else
1583 Source_List_File_Declaration := True;
1584 end if;
1586 elsif Item_Name = Snames.Name_Object_Dir then
1588 -- for Object_Dir use ...
1590 -- Single string attribute Object_Dir is converted
1591 -- to variable <PROJECT>.obj_dir. The directory is
1592 -- converted to an absolute path name,
1593 -- if necessary.
1595 Put (Project_Name);
1596 Put (".obj_dir:=" &
1597 "$(strip $(shell gprcmd to_absolute $(");
1598 Put (Project_Name);
1600 Put_Attribute (Project, Pkg, Item_Name, No_Name);
1603 elsif Item_Name = Snames.Name_Exec_Dir then
1605 -- for Exec_Dir use ...
1607 -- Single string attribute Exec_Dir is converted
1608 -- to variable EXEC_DIR. The directory is
1609 -- converted to an absolute path name,
1610 -- if necessary.
1612 Put ("EXEC_DIR:=" &
1613 "$(strip $(shell gprcmd to_absolute $(");
1614 Put (Project_Name);
1616 Put_Attribute (Project, Pkg, Item_Name, No_Name);
1619 elsif Item_Name = Snames.Name_Main then
1621 -- for Mains use ...
1623 -- String list attribute Main is converted to
1624 -- variable ADA_MAINS.
1626 Put ("ADA_MAINS:=$(");
1627 Put_Attribute (Project, Pkg, Item_Name, No_Name);
1628 Put (")");
1629 New_Line;
1631 elsif Item_Name = Name_Main_Language then
1633 -- for Main_Language use ...
1635 Put ("MAIN:=");
1637 -- If the expression is static (expected to be so
1638 -- most of the cases), then just give to MAIN
1639 -- the lower case value of the expression.
1641 if Expression_Kind = Static_String then
1642 Put (To_Lower (Expression_Value
1643 (1 .. Expression_Last)));
1645 else
1646 -- Otherwise, call to_lower on the value
1647 -- of the attribute.
1649 Put ("$(shell gprcmd to_lower $(");
1650 Put_Attribute
1651 (Project, No_Name, Item_Name, No_Name);
1652 Put ("))");
1653 end if;
1655 New_Line;
1657 else
1658 -- Other attribute are of no interest; suppress
1659 -- their declarations.
1661 Put_Declaration := False;
1662 end if;
1664 elsif Pkg = Snames.Name_Compiler then
1665 -- Attribute of package Compiler
1667 if Item_Name = Snames.Name_Switches then
1669 -- for Switches (<file_name>) use ...
1671 -- As the C and C++ extension may not be known
1672 -- statically, at the end of the processing of this
1673 -- project file, a test will done to decide if the
1674 -- file name (the index) has a C or C++ extension.
1675 -- The index is recorded in the table Switches,
1676 -- making sure that it appears only once.
1678 declare
1679 Found : Boolean := False;
1680 begin
1681 for J in Switches.First .. Switches.Last loop
1682 if Switches.Table (J) = Index then
1683 Found := True;
1684 exit;
1685 end if;
1686 end loop;
1688 if not Found then
1689 Switches.Increment_Last;
1690 Switches.Table (Switches.Last) := Index;
1691 end if;
1692 end;
1694 elsif Item_Name = Snames.Name_Default_Switches then
1695 Get_Name_String (Index);
1696 To_Lower (Name_Buffer (1 .. Name_Len));
1698 if Name_Buffer (1 .. Name_Len) = "c" then
1699 Put ("CFLAGS:=$(");
1700 Put_Attribute (Project, Pkg, Item_Name, Index);
1701 Put (")");
1702 New_Line;
1704 elsif Name_Buffer (1 .. Name_Len) = "c++" then
1705 Put ("CXXFLAGS:=$(");
1706 Put_Attribute (Project, Pkg, Item_Name, Index);
1707 Put (")");
1708 New_Line;
1709 end if;
1710 else
1711 -- Other attribute are of no interest; suppress
1712 -- their declarations.
1714 Put_Declaration := False;
1715 end if;
1717 elsif Pkg = Name_Ide then
1719 -- Attributes of package IDE
1721 if Item_Name = Name_Compiler_Command then
1723 -- for Compiler_Command (<language>) use ...
1725 declare
1726 Index_Name : Name_Id := No_Name;
1728 begin
1729 Get_Name_String (Index);
1730 To_Lower (Name_Buffer (1 .. Name_Len));
1731 Index_Name := Name_Find;
1733 -- Only "Ada", "C" and "C++" are of interest
1735 if Index_Name = Snames.Name_Ada then
1737 -- For "Ada", we set the variable $GNATMAKE
1739 Put ("GNATMAKE:=$(");
1740 Put_Attribute
1741 (Project, Pkg, Item_Name, Index);
1742 Put (")");
1743 New_Line;
1745 elsif Index_Name = Snames.Name_C then
1747 -- For "C", we set the variable $CC
1749 Put ("CC:=$(");
1750 Put_Attribute
1751 (Project, Pkg, Item_Name, Index);
1752 Put (")");
1753 New_Line;
1755 elsif Index_Name = Name_C_Plus_Plus then
1757 -- For "C++", we set the variable $CXX
1759 Put ("CXX:=$(");
1760 Put_Attribute
1761 (Project, Pkg, Item_Name, Index);
1762 Put (")");
1763 New_Line;
1764 end if;
1765 end;
1766 else
1767 -- Other attribute are of no interest; suppress
1768 -- their declarations.
1770 Put_Declaration := False;
1771 end if;
1773 elsif Pkg = Snames.Name_Naming then
1774 -- Attributes of package Naming
1776 if Item_Name = Snames.Name_Body_Suffix then
1778 -- for Body_Suffix (<language>) use ...
1780 declare
1781 Index_Name : Name_Id := No_Name;
1783 begin
1784 Get_Name_String (Index);
1785 To_Lower (Name_Buffer (1 .. Name_Len));
1786 Index_Name := Name_Find;
1788 -- Languages "C", "C++" & "Ada" are of interest
1790 if Index_Name = Snames.Name_C then
1792 -- For "C", we set the variable C_EXT
1794 Put ("C_EXT:=$(");
1795 Put_Attribute
1796 (Project, Pkg, Item_Name, Index);
1797 Put (")");
1798 New_Line;
1800 if Expression_Kind /= Static_String then
1801 C_Suffix_Static := False;
1803 elsif C_Suffix_Static then
1804 if C_Suffix_Last = 0 then
1805 if C_Suffix'Last < Expression_Last then
1806 Free (C_Suffix);
1807 C_Suffix := new String'
1808 (Expression_Value
1811 else
1813 Expression_Value
1819 else
1820 C_Suffix_Static :=
1821 Expression_Value
1829 -- For "C++", we set the variable CXX_EXT
1832 Put_Attribute
1835 New_Line;
1842 if
1844 then
1847 (Expression_Value
1848 (1 .. Expression_Last));
1850 else
1851 Cxx_Suffix (1 .. Expression_Last) :=
1852 Expression_Value
1853 (1 .. Expression_Last);
1854 end if;
1856 Cxx_Suffix_Last := Expression_Last;
1858 else
1859 Cxx_Suffix_Static :=
1860 Expression_Value
1861 (1 .. Expression_Last) =
1862 Cxx_Suffix (1 .. Cxx_Suffix_Last);
1863 end if;
1864 end if;
1866 elsif Index_Name = Snames.Name_Ada then
1868 -- For "Ada", we set the variable ADA_BODY
1870 Put ("ADA_BODY:=$(");
1871 Put_Attribute
1872 (Project, Pkg, Item_Name, Index);
1873 Put (")");
1874 New_Line;
1876 if Expression_Kind /= Static_String then
1877 Ada_Body_Suffix_Static := False;
1879 elsif Ada_Body_Suffix_Static then
1880 if Ada_Body_Suffix_Last = 0 then
1881 if
1882 Ada_Body_Suffix'Last < Expression_Last
1883 then
1884 Free (Ada_Body_Suffix);
1885 Ada_Body_Suffix := new String'
1886 (Expression_Value
1889 else
1890 Ada_Body_Suffix
1892 Expression_Value
1898 else
1899 Ada_Body_Suffix_Static :=
1900 Expression_Value
1902 Ada_Body_Suffix
1911 -- for Spec_Suffix (<language>) use ...
1913 declare
1916 begin
1921 -- Only "Ada" is of interest
1925 -- For "Ada", we set the variable ADA_SPEC
1928 Put_Attribute
1931 New_Line;
1938 if
1940 then
1943 (Expression_Value
1944 (1 .. Expression_Last));
1946 else
1947 Ada_Spec_Suffix
1948 (1 .. Expression_Last) :=
1949 Expression_Value
1950 (1 .. Expression_Last);
1951 end if;
1953 Ada_Spec_Suffix_Last := Expression_Last;
1955 else
1956 Ada_Spec_Suffix_Static :=
1957 Expression_Value
1958 (1 .. Expression_Last) =
1959 Ada_Spec_Suffix
1960 (1 .. Ada_Spec_Suffix_Last);
1961 end if;
1962 end if;
1963 end if;
1964 end;
1966 else
1967 -- Other attribute are of no interest; suppress
1968 -- their declarations.
1970 Put_Declaration := False;
1971 end if;
1973 elsif Pkg = Snames.Name_Linker then
1974 if Item_Name = Snames.Name_Linker_Options then
1976 -- Only add linker options if this is not the
1977 -- root project.
1979 Put ("ifeq ($(");
1980 Put (Project_Name);
1981 Put (".root),False)");
1982 New_Line;
1984 -- Add linker options to FLDFLAGS in reverse order
1986 Put (" FLDFLAGS:=$(shell gprcmd linkopts $(");
1987 Put (Project_Name);
1988 Put (".base_dir) $(");
1989 Put_Attribute
1990 (Project, Pkg, Item_Name, No_Name);
1991 Put (")) $(FLDFLAGS)");
1992 New_Line;
1994 Put ("endif");
1995 New_Line;
1997 -- Other attributes are of no interest. Suppress
1998 -- their declarations.
2000 else
2001 Put_Declaration := False;
2002 end if;
2003 end if;
2004 end if;
2006 -- Suppress the attribute declaration if not needed
2008 if not Put_Declaration then
2009 IO.Release (Pos_Comment);
2010 end if;
2011 end;
2013 when N_Case_Construction =>
2015 -- case <typed_string_variable> is ...
2017 declare
2018 Case_Project : Project_Node_Id := Project;
2019 Case_Pkg : Name_Id := No_Name;
2020 Variable_Node : constant Project_Node_Id :=
2021 Case_Variable_Reference_Of (Current_Item);
2022 Variable_Name : constant Name_Id := Name_Of (Variable_Node);
2024 begin
2025 if Project_Node_Of (Variable_Node) /= Empty_Node then
2026 Case_Project := Project_Node_Of (Variable_Node);
2027 end if;
2029 if Package_Node_Of (Variable_Node) /= Empty_Node then
2030 Case_Pkg := Name_Of (Package_Node_Of (Variable_Node));
2031 end if;
2033 -- If we are in a package, and no package is specified
2034 -- for the case variable, we look into the table
2035 -- Variables_Names to decide if it is a variable local
2036 -- to the package or a project level variable.
2038 if Pkg /= No_Name
2039 and then Case_Pkg = No_Name
2040 and then Case_Project = Project
2041 then
2042 for
2043 Index in Variable_Names.First .. Variable_Names.Last
2044 loop
2045 if Variable_Names.Table (Index) = Variable_Name then
2046 Case_Pkg := Pkg;
2047 exit;
2048 end if;
2049 end loop;
2050 end if;
2052 -- The real work is done in Process_Case_Construction.
2054 Process_Case_Construction
2055 (Current_Project => Project,
2056 Current_Pkg => Pkg,
2057 Case_Project => Case_Project,
2058 Case_Pkg => Case_Pkg,
2059 Name => Variable_Name,
2060 Node => Current_Item);
2061 end;
2063 when others =>
2064 null;
2066 end case;
2067 end loop;
2068 end Process_Declarative_Items;
2070 -----------------------
2071 -- Process_Externals --
2072 -----------------------
2073 procedure Process_Externals (Project : Project_Node_Id) is
2074 Project_Name : constant Name_Id := Name_Of (Project);
2076 No_External_Yet : Boolean := True;
2078 procedure Expression (First_Term : Project_Node_Id);
2079 -- Look for external reference in the term of an expression.
2080 -- If one is found, build the Makefile external reference variable.
2082 procedure Process_Declarative_Items (Item : Project_Node_Id);
2083 -- Traverse the declarative items of a project file to find all
2084 -- external references.
2086 ----------------
2087 -- Expression --
2088 ----------------
2090 procedure Expression (First_Term : Project_Node_Id) is
2091 Term : Project_Node_Id := First_Term;
2092 -- The term in the expression list
2094 Current_Term : Project_Node_Id := Empty_Node;
2095 -- The current term node id
2097 Default : Project_Node_Id;
2099 begin
2100 -- Check each term of the expression
2102 while Term /= Empty_Node loop
2103 Current_Term := Tree.Current_Term (Term);
2105 if Kind_Of (Current_Term) = N_External_Value then
2107 -- If it is the first external reference of this project file,
2108 -- output a comment
2110 if No_External_Yet then
2111 No_External_Yet := False;
2112 New_Line;
2114 Put_Line ("# external references");
2116 New_Line;
2117 end if;
2119 -- Increase Last_External and record the node of the external
2120 -- reference in table Externals, so that the external reference
2121 -- variable can be identified later.
2123 Last_External := Last_External + 1;
2124 Externals.Set (Current_Term, Last_External);
2126 Default := External_Default_Of (Current_Term);
2128 Get_Name_String
2129 (String_Value_Of (External_Reference_Of (Current_Term)));
2131 declare
2132 External_Name : constant String :=
2133 Name_Buffer (1 .. Name_Len);
2135 begin
2136 -- Output a comment for this external reference
2138 Put ("# external (""");
2139 Put (External_Name);
2141 if Default /= Empty_Node then
2142 Put (""", """);
2143 Put (String_Value_Of (Default));
2144 end if;
2146 Put (""")");
2147 New_Line;
2149 -- If there is no default, output one line:
2151 -- <PROJECT>__EXTERNAL__#:=$(<external name>)
2153 if Default = Empty_Node then
2154 Put_U_Name (Project_Name);
2155 Put (".external.");
2156 Put (Last_External);
2157 Put (":=$(");
2158 Put (External_Name, With_Substitution => True);
2159 Put (")");
2160 New_Line;
2162 else
2163 -- When there is a default, output the following lines:
2165 -- ifeq ($(<external_name),)
2166 -- <PROJECT>__EXTERNAL__#:=<default>
2167 -- else
2168 -- <PROJECT>__EXTERNAL__#:=$(<external_name>)
2169 -- endif
2171 Put ("ifeq ($(");
2172 Put (External_Name, With_Substitution => True);
2173 Put ("),)");
2174 New_Line;
2176 Put (" ");
2177 Put_U_Name (Project_Name);
2178 Put (".external.");
2179 Put (Last_External);
2180 Put (":=");
2181 Put (String_Value_Of (Default));
2182 New_Line;
2184 Put_Line ("else");
2186 Put (" ");
2187 Put_U_Name (Project_Name);
2188 Put (".external.");
2189 Put (Last_External);
2190 Put (":=$(");
2191 Put (External_Name, With_Substitution => True);
2192 Put (")");
2193 New_Line;
2195 Put_Line ("endif");
2196 end if;
2197 end;
2198 end if;
2200 Term := Next_Term (Term);
2201 end loop;
2202 end Expression;
2204 -------------------------------
2205 -- Process_Declarative_Items --
2206 -------------------------------
2208 procedure Process_Declarative_Items (Item : Project_Node_Id) is
2209 Current_Declarative_Item : Project_Node_Id := Item;
2210 Current_Item : Project_Node_Id := Empty_Node;
2212 begin
2213 -- For each declarative item
2215 while Current_Declarative_Item /= Empty_Node loop
2216 Current_Item := Current_Item_Node (Current_Declarative_Item);
2218 -- Set Current_Declarative_Item to the next declarative item
2219 -- ready for the next iteration
2221 Current_Declarative_Item := Next_Declarative_Item
2222 (Current_Declarative_Item);
2224 -- Write_Line (Project_Node_Kind'Image (Kind_Of (Current_Item)));
2226 case Kind_Of (Current_Item) is
2228 when N_Package_Declaration =>
2230 -- Recursive call the declarative items of a package
2232 if
2233 Project_Of_Renamed_Package_Of (Current_Item) = Empty_Node
2234 then
2235 Process_Declarative_Items
2236 (First_Declarative_Item_Of (Current_Item));
2237 end if;
2239 when N_Attribute_Declaration |
2240 N_Typed_Variable_Declaration |
2241 N_Variable_Declaration =>
2243 -- Process the expression to look for external references
2245 Expression
2246 (First_Term => Tree.First_Term
2247 (Expression_Of (Current_Item)));
2249 when N_Case_Construction =>
2251 -- Recursive calls to process the declarative items of
2252 -- each case item.
2254 declare
2255 Case_Item : Project_Node_Id :=
2256 First_Case_Item_Of (Current_Item);
2258 begin
2259 while Case_Item /= Empty_Node loop
2260 Process_Declarative_Items
2261 (First_Declarative_Item_Of (Case_Item));
2262 Case_Item := Next_Case_Item (Case_Item);
2263 end loop;
2264 end;
2266 when others =>
2267 null;
2268 end case;
2269 end loop;
2270 end Process_Declarative_Items;
2272 -- Start of procedure Process_Externals
2274 begin
2275 Process_Declarative_Items
2276 (First_Declarative_Item_Of (Project_Declaration_Of (Project)));
2278 if not No_External_Yet then
2279 Put_Line ("# end of external references");
2280 New_Line;
2281 end if;
2282 end Process_Externals;
2284 ---------
2285 -- Put --
2286 ---------
2288 procedure Put (S : String; With_Substitution : Boolean := False) is
2289 begin
2290 IO.Put (S);
2292 -- If With_Substitution is True, check if S is one of the reserved
2293 -- variables. If it is, append to it the Saved_Suffix.
2295 if With_Substitution then
2296 for J in Reserved_Variables'Range loop
2297 if S = Reserved_Variables (J).all then
2298 IO.Put (Saved_Suffix);
2299 exit;
2300 end if;
2301 end loop;
2302 end if;
2303 end Put;
2305 procedure Put (P : Positive) is
2306 Image : constant String := P'Img;
2308 begin
2309 Put (Image (Image'First + 1 .. Image'Last));
2310 end Put;
2312 procedure Put (S : Name_Id) is
2313 begin
2314 Get_Name_String (S);
2315 Put (Name_Buffer (1 .. Name_Len));
2316 end Put;
2318 -------------------
2319 -- Put_Attribute --
2320 -------------------
2322 procedure Put_Attribute
2323 (Project : Project_Node_Id;
2324 Pkg : Name_Id;
2325 Name : Name_Id;
2326 Index : Name_Id)
2327 is
2328 begin
2329 Put_U_Name (Name_Of (Project));
2331 if Pkg /= No_Name then
2332 Put (".");
2333 Put_L_Name (Pkg);
2334 end if;
2336 Put (".");
2337 Put_L_Name (Name);
2339 if Index /= No_Name then
2340 Put (".");
2342 -- For attribute Switches, we don't want to change the file name
2344 if Name = Snames.Name_Switches then
2345 Get_Name_String (Index);
2346 Put (Name_Buffer (1 .. Name_Len));
2348 else
2349 Special_Put_U_Name (Index);
2350 end if;
2351 end if;
2352 end Put_Attribute;
2354 -----------------------------
2355 -- Put_Directory_Separator --
2356 -----------------------------
2358 procedure Put_Directory_Separator is
2359 begin
2360 Put (S => (1 => Directory_Separator));
2361 end Put_Directory_Separator;
2363 -------------------------
2364 -- Put_Include_Project --
2365 -------------------------
2367 procedure Put_Include_Project
2368 (Included_Project_Path : Name_Id;
2369 Included_Project : Project_Node_Id;
2370 Including_Project_Name : String)
2371 is
2372 begin
2373 -- If path is null, there is nothing to do.
2374 -- This happens when there is no project being extended.
2376 if Included_Project_Path /= No_Name then
2377 Get_Name_String (Included_Project_Path);
2379 declare
2380 Included_Project_Name : constant String :=
2381 Get_Name_String (Name_Of (Included_Project));
2382 Included_Directory_Path : constant String :=
2383 Dir_Name (Name_Buffer (1 .. Name_Len));
2384 Last : Natural := Included_Directory_Path'Last;
2386 begin
2387 -- Remove possible directory separator at end of the directory
2389 if Last >= Included_Directory_Path'First
2390 and then (Included_Directory_Path (Last) = Directory_Separator
2391 or else
2393 then
2394 Last := Last - 1;
2395 end if;
2397 Put ("BASE_DIR=");
2399 -- If it is a relative path, precede the directory with
2400 -- $(<PROJECT>.base_dir)/
2402 if not Is_Absolute_Path (Included_Directory_Path) then
2403 Put ("$(");
2404 Put (Including_Project_Name);
2405 Put (".base_dir)/");
2406 end if;
2408 Put (Included_Directory_Path
2409 (Included_Directory_Path'First .. Last));
2410 New_Line;
2412 -- Include the Makefile
2414 Put ("include $(BASE_DIR)");
2415 Put_Directory_Separator;
2416 Put ("Makefile.");
2417 Put (To_Lower (Included_Project_Name));
2418 New_Line;
2420 New_Line;
2421 end;
2422 end if;
2423 end Put_Include_Project;
2425 --------------
2426 -- Put_Line --
2427 --------------
2429 procedure Put_Line (S : String) is
2430 begin
2431 IO.Put (S);
2432 IO.New_Line;
2433 end Put_Line;
2435 ----------------
2436 -- Put_L_Name --
2437 ----------------
2439 procedure Put_L_Name (N : Name_Id) is
2440 begin
2441 Put (To_Lower (Get_Name_String (N)));
2442 end Put_L_Name;
2444 ----------------
2445 -- Put_M_Name --
2446 ----------------
2448 procedure Put_M_Name (N : Name_Id) is
2449 Name : String := Get_Name_String (N);
2451 begin
2452 To_Mixed (Name);
2453 Put (Name);
2454 end Put_M_Name;
2456 ----------------
2457 -- Put_U_Name --
2458 ----------------
2460 procedure Put_U_Name (N : Name_Id) is
2461 begin
2462 Put (To_Upper (Get_Name_String (N)));
2463 end Put_U_Name;
2465 ------------------
2466 -- Put_Variable --
2467 ------------------
2469 procedure Put_Variable
2470 (Project : Project_Node_Id;
2471 Pkg : Name_Id;
2472 Name : Name_Id)
2473 is
2474 begin
2475 Put_U_Name (Name_Of (Project));
2477 if Pkg /= No_Name then
2478 Put (".");
2479 Put_L_Name (Pkg);
2480 end if;
2482 Put (".");
2483 Put_U_Name (Name);
2484 end Put_Variable;
2486 -----------------------
2487 -- Recursive_Process --
2488 -----------------------
2490 procedure Recursive_Process (Project : Project_Node_Id) is
2491 With_Clause : Project_Node_Id;
2492 Last_Case : Natural := Last_Case_Construction;
2493 There_Are_Cases : Boolean := False;
2494 May_Be_C_Sources : Boolean := False;
2495 May_Be_Cxx_Sources : Boolean := False;
2496 Post_Processing : Boolean := False;
2497 Src_Files_Init : IO.Position;
2498 Src_List_File_Init : IO.Position;
2499 begin
2500 -- Nothing to do if Project is nil.
2502 if Project /= Empty_Node then
2503 declare
2504 Declaration_Node : constant Project_Node_Id :=
2505 Project_Declaration_Of (Project);
2506 -- Used to get the project being extended, if any, and the
2507 -- declarative items of the project to be processed.
2509 Name : constant Name_Id := Name_Of (Project);
2510 -- Name of the project being processed
2512 Directory : constant Name_Id := Directory_Of (Project);
2513 -- Directory of the project being processed. Used as default
2514 -- for the object directory and the source directories.
2516 Lname : constant String := To_Lower (Get_Name_String (Name));
2517 -- <project>: name of the project in lower case
2519 Uname : constant String := To_Upper (Lname);
2520 -- <PROJECT>: name of the project in upper case
2522 begin
2523 -- Nothing to do if project file has already been processed
2525 if Processed_Projects.Get (Name) = Empty_Node then
2527 -- Put project name in table Processed_Projects to avoid
2528 -- processing the project several times.
2530 Processed_Projects.Set (Name, Project);
2532 -- Process all the projects imported, if any
2534 if Process_All_Project_Files then
2535 With_Clause := First_With_Clause_Of (Project);
2537 while With_Clause /= Empty_Node loop
2538 Recursive_Process (Project_Node_Of (With_Clause));
2539 With_Clause := Next_With_Clause_Of (With_Clause);
2540 end loop;
2542 -- Process the project being extended, if any.
2543 -- If there is no project being extended,
2544 -- Process_Declarative_Items will be called with Empty_Node
2545 -- and nothing will happen.
2547 Recursive_Process (Extended_Project_Of (Declaration_Node));
2548 end if;
2550 Source_Files_Declaration := False;
2551 Source_List_File_Declaration := False;
2553 -- Build in Name_Buffer the path name of the Makefile
2555 -- Start with the directory of the project file
2557 Get_Name_String (Directory);
2559 -- Add a directory separator, if needed
2561 if Name_Buffer (Name_Len) /= Directory_Separator then
2562 Name_Len := Name_Len + 1;
2563 Name_Buffer (Name_Len) := Directory_Separator;
2564 end if;
2566 -- Add the filename of the Makefile: "Makefile.<project>"
2568 Name_Buffer (Name_Len + 1 .. Name_Len + 9) := "Makefile.";
2569 Name_Len := Name_Len + 9;
2571 Name_Buffer (Name_Len + 1 .. Name_Len + Lname'Length) :=
2572 Lname;
2573 Name_Len := Name_Len + Lname'Length;
2575 IO.Create (Name_Buffer (1 .. Name_Len));
2577 -- Display the Makefile being created, but only if not in
2578 -- quiet output.
2580 if not Opt.Quiet_Output then
2581 Write_Str ("creating """);
2582 Write_Str (IO.Name_Of_File);
2583 Write_Line ("""");
2584 end if;
2586 -- And create the Makefile
2588 New_Line;
2590 -- Outut a comment with the path name of the Makefile
2591 Put ("# ");
2592 Put_Line (IO.Name_Of_File);
2594 New_Line;
2596 -- The Makefile is a big ifeq to avoid multiple inclusion
2597 -- ifeq ($(<PROJECT>.project),)
2598 -- <PROJECT>.project:=True
2599 -- ...
2600 -- endif
2602 Put ("ifeq ($(");
2603 Put (Uname);
2604 Put (".project),)");
2605 New_Line;
2607 Put (Uname);
2608 Put (".project=True");
2609 New_Line;
2611 New_Line;
2613 -- If it is the main Makefile (BASE_DIR is empty)
2615 Put_Line ("ifeq ($(BASE_DIR),)");
2617 -- Set <PROJECT>.root to True
2619 Put (" ");
2620 Put (Uname);
2621 Put (".root=True");
2622 New_Line;
2624 Put (" ");
2625 Put (Uname);
2626 Put (".base_dir:=$(shell gprcmd pwd)");
2627 New_Line;
2629 -- Include some utility functions and saved all reserved
2630 -- env. vars. by including Makefile.prolog.
2632 New_Line;
2634 -- First, if MAKE_ROOT is not defined, try to get GNAT prefix
2636 Put (" ifeq ($(");
2637 Put (MAKE_ROOT);
2638 Put ("),)");
2639 New_Line;
2641 Put (" MAKE_ROOT=$(shell gprcmd prefix)");
2642 New_Line;
2644 Put (" endif");
2645 New_Line;
2647 New_Line;
2649 -- If MAKE_ROOT is still not defined, then fail
2651 Put (" ifeq ($(");
2652 Put (MAKE_ROOT);
2653 Put ("),)");
2654 New_Line;
2656 Put (" $(error ");
2657 Put (MAKE_ROOT);
2658 Put (" variable is undefined, ");
2659 Put ("Makefile.prolog cannot be loaded)");
2660 New_Line;
2662 Put_Line (" else");
2664 Put (" include $(");
2665 Put (MAKE_ROOT);
2666 Put (")");
2667 Put_Directory_Separator;
2668 Put ("share");
2669 Put_Directory_Separator;
2670 Put ("gnat");
2671 Put_Directory_Separator;
2672 Put ("Makefile.prolog");
2673 New_Line;
2675 Put_Line (" endif");
2677 -- Initialize some defaults
2679 Put (" OBJ_EXT:=");
2680 Put (Get_Object_Suffix.all);
2681 New_Line;
2683 Put_Line ("else");
2685 -- When not the main Makefile, set <PROJECT>.root to False
2687 Put (" ");
2688 Put (Uname);
2689 Put (".root=False");
2690 New_Line;
2692 Put (" ");
2693 Put (Uname);
2694 Put (".base_dir:=$(BASE_DIR)");
2695 New_Line;
2697 Put_Line ("endif");
2698 New_Line;
2700 -- For each imported project, if any, set BASE_DIR to the
2701 -- directory of the imported project, and add an include
2702 -- directive for the Makefile of the imported project.
2704 With_Clause := First_With_Clause_Of (Project);
2706 while With_Clause /= Empty_Node loop
2707 Put_Include_Project
2708 (String_Value_Of (With_Clause),
2709 Project_Node_Of (With_Clause),
2710 Uname);
2711 With_Clause := Next_With_Clause_Of (With_Clause);
2712 end loop;
2714 -- Do the same if there is a project being extended.
2715 -- If there is no project being extended, Put_Include_Project
2716 -- will return immediately.
2718 Put_Include_Project
2719 (Extended_Project_Path_Of (Project),
2720 Extended_Project_Of (Declaration_Node),
2721 Uname);
2723 -- Set defaults to some variables
2725 -- CFLAGS and CXXFLAGS are set by default to nothing.
2726 -- Their initial values have been saved, If they are not set
2727 -- by this project file, then they will be reset to their
2728 -- initial values. This is to avoid "inheritance" of these
2729 -- flags from an imported project file.
2731 Put_Line ("CFLAGS:=");
2732 Put_Line ("CXXFLAGS:=");
2734 IO.Mark (Src_Files_Init);
2735 Put_Line ("src_files.specified:=FALSE");
2737 IO.Mark (Src_List_File_Init);
2738 Put_Line ("src_list_file.specified:=FALSE");
2740 -- Default language is Ada, but variable LANGUAGES may have
2741 -- been changed by an imported Makefile. So, we set it
2742 -- to "ada"; if attribute Languages is defined in the project
2743 -- file, it will be redefined.
2745 Put_Line ("LANGUAGES:=ada");
2747 -- <PROJECT>.src_dirs is set by default to the project
2748 -- directory.
2750 Put (Uname);
2751 Put (".src_dirs:=$(");
2752 Put (Uname);
2753 Put (".base_dir)");
2754 New_Line;
2756 -- <PROJECT>.obj_dir is set by default to the project
2757 -- directory.
2759 Put (Uname);
2760 Put (".obj_dir:=$(");
2761 Put (Uname);
2762 Put (".base_dir)");
2763 New_Line;
2765 -- PROJECT_FILE:=<project>
2767 Put ("PROJECT_FILE:=");
2768 Put (Lname);
2769 New_Line;
2771 -- Output a comment indicating the name of the project being
2772 -- processed.
2774 Put ("# project ");
2775 Put_M_Name (Name);
2776 New_Line;
2778 -- Process the external references of this project file
2780 Process_Externals (Project);
2782 New_Line;
2784 -- Reset the compiler switches, the suffixes and the languages
2786 Switches.Init;
2787 Reset_Suffixes_And_Languages;
2789 -- Record the current value of Last_Case_Construction to
2790 -- detect if there are case constructions in this project file.
2792 Last_Case := Last_Case_Construction;
2794 -- Process the declarative items of this project file
2796 Process_Declarative_Items
2797 (Project => Project,
2798 Pkg => No_Name,
2799 In_Case => False,
2800 Item => First_Declarative_Item_Of (Declaration_Node));
2802 -- Set There_Are_Case to True if there are case constructions
2803 -- in this project file.
2805 There_Are_Cases := Last_Case /= Last_Case_Construction;
2807 -- If the suffixes and the languages have not been specified,
2808 -- give them the default values.
2810 if C_Suffix_Static and then C_Suffix_Last = 0 then
2811 C_Suffix_Last := 2;
2812 C_Suffix (1 .. 2) := ".c";
2813 end if;
2815 if Cxx_Suffix_Static and then Cxx_Suffix_Last = 0 then
2816 Cxx_Suffix_Last := 3;
2817 Cxx_Suffix (1 .. 3) := ".cc";
2818 end if;
2820 if Ada_Body_Suffix_Static and then Ada_Body_Suffix_Last = 0 then
2821 Ada_Body_Suffix_Last := 4;
2822 Ada_Body_Suffix (1 .. 4) := ".adb";
2823 end if;
2825 if Ada_Spec_Suffix_Static and then Ada_Spec_Suffix_Last = 0 then
2826 Ada_Spec_Suffix_Last := 4;
2827 Ada_Spec_Suffix (1 .. 4) := ".ads";
2828 end if;
2830 if Languages_Static and then Languages_Last = 0 then
2831 Languages_Last := 5;
2832 Languages (1 .. 5) := " ada ";
2833 end if;
2835 -- There may be C sources if the languages are not known
2836 -- statically or if the languages include "C".
2838 May_Be_C_Sources := (not Languages_Static)
2839 or else Index
2840 (Source => Languages (1 .. Languages_Last),
2841 Pattern => " c ") /= 0;
2843 -- There may be C++ sources if the languages are not known
2844 -- statically or if the languages include "C++".
2846 May_Be_Cxx_Sources := (not Languages_Static)
2847 or else Index
2848 (Source => Languages (1 .. Languages_Last),
2849 Pattern => " c++ ") /= 0;
2851 New_Line;
2853 -- If there are attribute Switches specified in package
2854 -- Compiler of this project, post-process them.
2856 if Switches.Last >= Switches.First then
2858 -- Output a comment indicating this post-processing
2860 for Index in Switches.First .. Switches.Last loop
2861 Get_Name_String (Switches.Table (Index));
2863 declare
2864 File : constant String :=
2865 Name_Buffer (1 .. Name_Len);
2866 Source_Kind : Source_Kind_Type := Unknown;
2868 begin
2869 -- First, attempt to determine the language
2871 if Ada_Body_Suffix_Static then
2872 if File'Length > Ada_Body_Suffix_Last
2873 and then
2874 File (File'Last - Ada_Body_Suffix_Last + 1 ..
2875 File'Last) =
2876 Ada_Body_Suffix
2877 (1 .. Ada_Body_Suffix_Last)
2878 then
2879 Source_Kind := Ada_Body;
2880 end if;
2881 end if;
2883 if Source_Kind = Unknown
2884 and then Ada_Spec_Suffix_Static
2885 then
2886 if File'Length > Ada_Spec_Suffix_Last
2887 and then
2888 File (File'Last - Ada_Spec_Suffix_Last + 1 ..
2889 File'Last) =
2890 Ada_Spec_Suffix
2891 (1 .. Ada_Spec_Suffix_Last)
2892 then
2893 Source_Kind := Ada_Spec;
2894 end if;
2895 end if;
2897 if Source_Kind = Unknown
2898 and then C_Suffix_Static
2899 then
2900 if File'Length > C_Suffix_Last
2901 and then
2902 File (File'Last - C_Suffix_Last + 1
2903 .. File'Last) =
2904 C_Suffix (1 .. C_Suffix_Last)
2905 then
2906 Source_Kind := C;
2907 end if;
2908 end if;
2910 if Source_Kind = Unknown
2911 and then Cxx_Suffix_Static
2912 then
2913 if File'Length > Cxx_Suffix_Last
2914 and then
2915 File (File'Last - Cxx_Suffix_Last + 1
2916 .. File'Last) =
2917 Cxx_Suffix (1 .. Cxx_Suffix_Last)
2918 then
2919 Source_Kind := Cxx;
2920 end if;
2921 end if;
2923 -- If we still don't know the language, and all
2924 -- suffixes are static, then it cannot any of the
2925 -- processed languages.
2927 if Source_Kind = Unknown
2928 and then Ada_Body_Suffix_Static
2929 and then Ada_Spec_Suffix_Static
2930 and then C_Suffix_Static
2931 and then Cxx_Suffix_Static
2932 then
2933 Source_Kind := None;
2934 end if;
2936 -- If it can be "C" or "C++", post-process
2938 if (Source_Kind = Unknown and
2939 (May_Be_C_Sources or May_Be_Cxx_Sources))
2940 or else (May_Be_C_Sources and Source_Kind = C)
2941 or else (May_Be_Cxx_Sources and Source_Kind = Cxx)
2942 then
2943 if not Post_Processing then
2944 Post_Processing := True;
2945 Put_Line
2946 ("# post-processing of Compiler'Switches");
2947 end if;
2949 New_Line;
2951 -- Output a comment:
2952 -- # for Switches (<file>) use ...
2954 Put ("# for Switches (""");
2955 Put (File);
2956 Put (""") use ...");
2957 New_Line;
2959 if There_Are_Cases then
2961 -- Check that effectively there was Switches
2962 -- specified for this file: the attribute
2963 -- declaration may be in a case branch which was
2964 -- not followed.
2966 Put ("ifneq ($(");
2967 Put (Uname);
2968 Put (".compiler.switches.");
2969 Put (File);
2970 Put ("),)");
2971 New_Line;
2972 end if;
2974 if May_Be_C_Sources
2975 and then
2976 (Source_Kind = Unknown or else Source_Kind = C)
2977 then
2978 -- If it is definitely a C file, no need to test
2980 if Source_Kind = C then
2981 Put (File (1 .. File'Last - C_Suffix_Last));
2982 Put (Get_Object_Suffix.all);
2983 Put (": ");
2984 Put (File);
2985 New_Line;
2987 else
2988 -- May be a C file: test to know
2990 Put ("ifeq ($(filter %$(C_EXT),");
2991 Put (File);
2992 Put ("),");
2993 Put (File);
2994 Put (")");
2995 New_Line;
2997 -- If it is, output a rule for the object
2999 Put ("$(subst $(C_EXT),$(OBJ_EXT),");
3000 Put (File);
3001 Put ("): ");
3002 Put (File);
3003 New_Line;
3004 end if;
3006 Put (ASCII.HT & "@echo $(CC) -c $(");
3007 Put (Uname);
3008 Put (".compiler.switches.");
3009 Put (File);
3010 Put (") $< -o $(OBJ_DIR)/$@");
3011 New_Line;
3013 -- If FAKE_COMPILE is defined, do not issue
3014 -- the compile command.
3016 Put_Line ("ifndef FAKE_COMPILE");
3018 Put (ASCII.HT & "@$(CC) -c $(");
3019 Put (Uname);
3020 Put (".compiler.switches.");
3021 Put (File);
3022 Put (") $(C_INCLUDES) $(DEP_CFLAGS) " &
3023 "$< -o $(OBJ_DIR)/$@");
3024 New_Line;
3026 Put_Line (ASCII.HT & "@$(post-compile)");
3028 Put_Line ("endif");
3030 if Source_Kind = Unknown then
3031 Put_Line ("endif");
3032 end if;
3033 end if;
3035 -- Now, test if it is a C++ file
3037 if May_Be_Cxx_Sources
3038 and then
3039 (Source_Kind = Unknown
3040 or else
3041 Source_Kind = Cxx)
3042 then
3043 -- No need to test if definitely a C++ file
3045 if Source_Kind = Cxx then
3046 Put (File (1 .. File'Last - Cxx_Suffix_Last));
3047 Put (Get_Object_Suffix.all);
3048 Put (": ");
3049 Put (File);
3050 New_Line;
3052 else
3053 -- May be a C++ file: test to know
3055 Put ("ifeq ($(filter %$(CXX_EXT),");
3056 Put (File);
3057 Put ("),");
3058 Put (File);
3059 Put (")");
3060 New_Line;
3062 -- If it is, output a rule for the object
3064 Put ("$(subst $(CXX_EXT),$(OBJ_EXT),");
3065 Put (File);
3066 Put ("): $(");
3067 Put (Uname);
3068 Put (".absolute.");
3069 Put (File);
3070 Put (")");
3071 New_Line;
3072 end if;
3074 Put (ASCII.HT & "@echo $(CXX) -c $(");
3075 Put (Uname);
3076 Put (".compiler.switches.");
3077 Put (File);
3078 Put (") $< -o $(OBJ_DIR)/$@");
3079 New_Line;
3081 -- If FAKE_COMPILE is defined, do not issue
3082 -- the compile command
3084 Put_Line ("ifndef FAKE_COMPILE");
3086 Put (ASCII.HT & "@$(CXX) -c $(");
3087 Put (Uname);
3088 Put (".compiler.switches.");
3089 Put (File);
3090 Put (") $(C_INCLUDES) $(DEP_CFLAGS) " &
3091 "$< -o $(OBJ_DIR)/$@");
3092 New_Line;
3094 Put_Line (ASCII.HT & "@$(post-compile)");
3096 Put_Line ("endif");
3098 if Source_Kind = Unknown then
3099 Put_Line ("endif");
3100 end if;
3102 end if;
3104 if There_Are_Cases then
3105 Put_Line ("endif");
3106 end if;
3108 New_Line;
3109 end if;
3110 end;
3111 end loop;
3113 -- Output a comment indication end of post-processing
3114 -- of Switches, if we have done some post-processing
3116 if Post_Processing then
3117 Put_Line
3118 ("# end of post-processing of Compiler'Switches");
3120 New_Line;
3121 end if;
3122 end if;
3124 -- Add source dirs of this project file to variable SRC_DIRS.
3125 -- Put them in front, and remove duplicates.
3127 Put ("SRC_DIRS:=$(");
3128 Put (Uname);
3129 Put (".src_dirs) $(filter-out $(");
3130 Put (Uname);
3131 Put (".src_dirs),$(SRC_DIRS))");
3132 New_Line;
3134 -- Set OBJ_DIR to the object directory
3136 Put ("OBJ_DIR:=$(");
3137 Put (Uname);
3138 Put (".obj_dir)");
3139 New_Line;
3141 New_Line;
3143 if Source_Files_Declaration = True then
3145 -- It is guaranteed that Source_Files has been specified.
3146 -- We then suppress the two lines that initialize
3147 -- the variables src_files.specified and
3148 -- src_list_file.specified. Nothing else to do.
3150 IO.Suppress (Src_Files_Init);
3151 IO.Suppress (Src_List_File_Init);
3153 else
3154 if Source_Files_Declaration = May_Be then
3156 -- Need to test if attribute Source_Files was specified
3158 Put_Line ("# get the source files, if necessary");
3159 Put_Line ("ifeq ($(src_files.specified),FALSE)");
3161 else
3162 Put_Line ("# get the source files");
3164 -- We may suppress initialization of src_files.specified
3166 IO.Suppress (Src_Files_Init);
3167 end if;
3169 if Source_List_File_Declaration /= May_Be then
3170 IO.Suppress (Src_List_File_Init);
3171 end if;
3173 case Source_List_File_Declaration is
3175 -- Source_List_File was specified
3177 when True =>
3178 if Source_Files_Declaration = May_Be then
3179 Put (" ");
3180 end if;
3182 Put (Uname);
3183 Put (".src_files:= $(shell gprcmd cat " &
3184 "$(src.list_file))");
3185 New_Line;
3187 -- Source_File_List was NOT specified
3189 when False =>
3190 if Source_Files_Declaration = May_Be then
3191 Put (" ");
3192 end if;
3194 Put (Uname);
3195 Put (".src_files:= $(foreach name,$(");
3196 Put (Uname);
3197 Put (".src_dirs),$(notdir $(wildcard $(name)/*)))");
3198 New_Line;
3200 when May_Be =>
3201 if Source_Files_Declaration = May_Be then
3202 Put (" ");
3203 end if;
3205 Put_Line ("ifeq ($(src_list_file.specified),TRUE)");
3207 -- Get the source files from the file
3209 if Source_Files_Declaration = May_Be then
3210 Put (" ");
3211 end if;
3213 Put (" ");
3214 Put (Uname);
3215 Put (".src_files:= $(shell gprcmd cat " &
3216 "$(SRC__$LIST_FILE))");
3217 New_Line;
3219 if Source_Files_Declaration = May_Be then
3220 Put (" ");
3221 end if;
3223 Put_Line ("else");
3225 -- Otherwise get source from the source directories
3227 if Source_Files_Declaration = May_Be then
3228 Put (" ");
3229 end if;
3231 Put (" ");
3232 Put (Uname);
3233 Put (".src_files:= $(foreach name,$(");
3234 Put (Uname);
3235 Put (".src_dirs),$(notdir $(wildcard $(name)/*)))");
3236 New_Line;
3238 if Source_Files_Declaration = May_Be then
3239 Put (" ");
3240 end if;
3242 Put_Line ("endif");
3243 end case;
3245 if Source_Files_Declaration = May_Be then
3246 Put_Line ("endif");
3247 end if;
3249 New_Line;
3250 end if;
3252 if not Languages_Static then
3254 -- If Languages include "c", get the C sources
3256 Put_Line
3257 ("# get the C source files, if C is one of the languages");
3259 Put_Line ("ifeq ($(filter c,$(LANGUAGES)),c)");
3261 Put (" C_SRCS:=$(filter %$(C_EXT),$(");
3262 Put (Uname);
3263 Put (".src_files))");
3264 New_Line;
3265 Put_Line (" C_SRCS_DEFINED:=True");
3267 -- Otherwise set C_SRCS to empty
3269 Put_Line ("else");
3270 Put_Line (" C_SRCS=");
3271 Put_Line ("endif");
3272 New_Line;
3274 -- If Languages include "C++", get the C++ sources
3276 Put_Line
3277 ("# get the C++ source files, " &
3278 "if C++ is one of the languages");
3280 Put_Line ("ifeq ($(filter c++,$(LANGUAGES)),c++)");
3282 Put (" CXX_SRCS:=$(filter %$(CXX_EXT),$(");
3283 Put (Uname);
3284 Put (".src_files))");
3285 New_Line;
3286 Put_Line (" CXX_SRCS_DEFINED:=True");
3288 -- Otherwise set CXX_SRCS to empty
3290 Put_Line ("else");
3291 Put_Line (" CXX_SRCS=");
3292 Put_Line ("endif");
3293 New_Line;
3295 else
3296 if Ada.Strings.Fixed.Index
3297 (Languages (1 .. Languages_Last), " c ") /= 0
3298 then
3299 Put_Line ("# get the C sources");
3300 Put ("C_SRCS:=$(filter %$(C_EXT),$(");
3301 Put (Uname);
3302 Put (".src_files))");
3303 New_Line;
3304 Put_Line ("C_SRCS_DEFINED:=True");
3306 else
3307 Put_Line ("# no C sources");
3309 Put_Line ("C_SRCS=");
3310 end if;
3312 New_Line;
3314 if Ada.Strings.Fixed.Index
3315 (Languages (1 .. Languages_Last), " c++ ") /= 0
3316 then
3317 Put_Line ("# get the C++ sources");
3318 Put ("CXX_SRCS:=$(filter %$(CXX_EXT),$(");
3319 Put (Uname);
3320 Put (".src_files))");
3321 New_Line;
3322 Put_Line ("CXX_SRCS_DEFINED:=True");
3324 else
3325 Put_Line ("# no C++ sources");
3327 Put_Line ("CXX_SRCS=");
3328 end if;
3330 New_Line;
3331 end if;
3333 declare
3334 C_Present : constant Boolean :=
3335 (not Languages_Static) or else
3336 Ada.Strings.Fixed.Index
3337 (Languages (1 .. Languages_Last), " c ")
3338 /= 0;
3340 Cxx_Present : constant Boolean :=
3341 (not Languages_Static) or else
3342 Ada.Strings.Fixed.Index
3343 (Languages (1 .. Languages_Last), " c++ ")
3344 /= 0;
3346 begin
3347 if C_Present or Cxx_Present then
3349 -- If there are C or C++ sources,
3350 -- add a library name to variable LIBS.
3352 Put ("# if there are ");
3354 if C_Present then
3355 if Cxx_Present then
3356 Put ("C or C++");
3358 else
3359 Put ("C");
3360 end if;
3362 else
3363 Put ("C++");
3364 end if;
3366 Put (" sources, add the library");
3367 New_Line;
3369 Put ("ifneq ($(strip");
3371 if C_Present then
3372 Put (" $(C_SRCS)");
3373 end if;
3375 if Cxx_Present then
3376 Put (" $(CXX_SRCS)");
3377 end if;
3379 Put ("),)");
3380 New_Line;
3382 Put (" LIBS:=$(");
3383 Put (Uname);
3384 Put (".obj_dir)/lib");
3385 Put (Lname);
3386 Put ("$(AR_EXT) $(LIBS)");
3387 New_Line;
3389 Put_Line ("endif");
3391 New_Line;
3393 end if;
3394 end;
3396 -- If CFLAGS/CXXFLAGS have not been set, set them back to
3397 -- their initial values.
3399 Put_Line ("ifeq ($(CFLAGS),)");
3400 Put_Line (" CFLAGS:=$(CFLAGS.saved)");
3401 Put_Line ("endif");
3402 New_Line;
3404 Put_Line ("ifeq ($(CXXFLAGS),)");
3405 Put_Line (" CXXFLAGS:=$(CXXFLAGS.saved)");
3406 Put_Line ("endif");
3407 New_Line;
3409 -- If this is the main Makefile, include Makefile.Generic
3411 Put ("ifeq ($(");
3412 Put (Uname);
3413 Put_Line (".root),True)");
3415 -- Include Makefile.generic
3417 Put (" include $(");
3418 Put (MAKE_ROOT);
3419 Put (")");
3420 Put_Directory_Separator;
3421 Put ("share");
3422 Put_Directory_Separator;
3423 Put ("gnat");
3424 Put_Directory_Separator;
3425 Put ("Makefile.generic");
3426 New_Line;
3428 -- If it is not the main Makefile, add the project to
3429 -- variable DEPS_PROJECTS.
3431 Put_Line ("else");
3433 Put (" DEPS_PROJECTS:=$(strip $(DEPS_PROJECTS) $(");
3434 Put (Uname);
3435 Put (".base_dir)/");
3436 Put (Lname);
3437 Put (")");
3438 New_Line;
3440 Put_Line ("endif");
3441 New_Line;
3443 Put_Line ("endif");
3444 New_Line;
3446 -- Close the Makefile, so that another Makefile can be created
3447 -- with the same File_Type variable.
3449 IO.Close;
3450 end if;
3451 end;
3452 end if;
3453 end Recursive_Process;
3455 ----------------------------------
3456 -- Reset_Suffixes_And_Languages --
3457 ----------------------------------
3459 procedure Reset_Suffixes_And_Languages is
3460 begin
3461 -- Last = 0 indicates that this is the default, which is static,
3462 -- of course.
3464 C_Suffix_Last := 0;
3465 C_Suffix_Static := True;
3466 Cxx_Suffix_Last := 0;
3467 Cxx_Suffix_Static := True;
3468 Ada_Body_Suffix_Last := 0;
3469 Ada_Body_Suffix_Static := True;
3470 Ada_Spec_Suffix_Last := 0;
3471 Ada_Spec_Suffix_Static := True;
3472 Languages_Last := 0;
3473 Languages_Static := True;
3474 end Reset_Suffixes_And_Languages;
3476 --------------------
3477 -- Source_Kind_Of --
3478 --------------------
3480 function Source_Kind_Of (File_Name : Name_Id) return Source_Kind_Type is
3481 Source_C_Suffix : constant String :=
3482 Suffix_Of (C_Suffix_Static, C_Suffix, C_Suffix_Last, ".c");
3484 Source_Cxx_Suffix : constant String :=
3485 Suffix_Of (Cxx_Suffix_Static, Cxx_Suffix, Cxx_Suffix_Last, ".cc");
3487 Body_Ada_Suffix : constant String :=
3488 Suffix_Of
3489 (Ada_Body_Suffix_Static,
3490 Ada_Body_Suffix,
3491 Ada_Body_Suffix_Last,
3492 ".adb");
3494 Spec_Ada_Suffix : constant String :=
3495 Suffix_Of
3496 (Ada_Spec_Suffix_Static,
3497 Ada_Spec_Suffix,
3498 Ada_Spec_Suffix_Last,
3499 ".ads");
3501 begin
3502 -- Get the name of the file
3504 Get_Name_String (File_Name);
3506 -- If the C suffix is static, check if it is a C file
3508 if Source_C_Suffix /= ""
3509 and then Name_Len > Source_C_Suffix'Length
3510 and then Name_Buffer (Name_Len - Source_C_Suffix'Length + 1
3511 .. Name_Len) = Source_C_Suffix
3512 then
3513 return C;
3515 -- If the C++ suffix is static, check if it is a C++ file
3517 elsif Source_Cxx_Suffix /= ""
3518 and then Name_Len > Source_Cxx_Suffix'Length
3519 and then Name_Buffer (Name_Len - Source_Cxx_Suffix'Length + 1
3520 .. Name_Len) = Source_Cxx_Suffix
3521 then
3522 return Cxx;
3524 -- If the Ada body suffix is static, check if it is an Ada body
3526 elsif Body_Ada_Suffix /= ""
3527 and then Name_Len > Body_Ada_Suffix'Length
3528 and then Name_Buffer (Name_Len - Body_Ada_Suffix'Length + 1
3529 .. Name_Len) = Body_Ada_Suffix
3530 then
3531 return Ada_Body;
3533 -- If the Ada spec suffix is static, check if it is an Ada spec
3535 elsif Spec_Ada_Suffix /= ""
3536 and then Name_Len > Spec_Ada_Suffix'Length
3537 and then Name_Buffer (Name_Len - Spec_Ada_Suffix'Length + 1
3538 .. Name_Len) = Spec_Ada_Suffix
3539 then
3540 return Ada_Body;
3542 -- If the C or C++ suffix is not static, then return Unknown
3544 elsif Source_C_Suffix = "" or else Source_Cxx_Suffix = "" then
3545 return Unknown;
3547 -- Otherwise return None
3549 else
3550 return None;
3551 end if;
3552 end Source_Kind_Of;
3554 ------------------------
3555 -- Special_Put_U_Name --
3556 ------------------------
3558 procedure Special_Put_U_Name (S : Name_Id) is
3559 begin
3560 Get_Name_String (S);
3561 To_Upper (Name_Buffer (1 .. Name_Len));
3563 -- If string is "C++", change it to "CXX"
3565 if Name_Buffer (1 .. Name_Len) = "C++" then
3566 Put ("CXX");
3567 else
3568 Put (Name_Buffer (1 .. Name_Len));
3569 end if;
3570 end Special_Put_U_Name;
3572 ---------------
3573 -- Suffix_Of --
3574 ---------------
3576 function Suffix_Of
3577 (Static : Boolean;
3578 Value : String_Access;
3579 Last : Natural;
3580 Default : String) return String
3581 is
3582 begin
3583 if Static then
3585 -- If the suffix is static, Last = 0 indicates that it is the default
3586 -- suffix: return the default.
3588 if Last = 0 then
3589 return Default;
3591 -- Otherwise, return the current suffix
3593 else
3594 return Value (1 .. Last);
3595 end if;
3597 -- If the suffix is not static, return ""
3599 else
3600 return "";
3601 end if;
3602 end Suffix_Of;
3604 -----------
3605 -- Usage --
3606 -----------
3608 procedure Usage is
3609 begin
3610 if not Usage_Displayed then
3611 Usage_Displayed := True;
3612 Display_Copyright;
3613 Write_Line ("Usage: gpr2make switches project-file");
3614 Write_Eol;
3615 Write_Line (" -h Display this usage");
3616 Write_Line (" -q Quiet output");
3617 Write_Line (" -v Verbose mode");
3618 Write_Line (" -R not Recursive: only one project file");
3619 Write_Eol;
3620 end if;
3621 end Usage;
3622 end Bld;