OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [prj-pp.adb] - Blame information for rev 316

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                               P R J . P P                                --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 2001-2009, 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 3,  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 COPYING3.  If not, go to --
19
-- http://www.gnu.org/licenses for a complete copy of the license.          --
20
--                                                                          --
21
-- GNAT was originally developed  by the GNAT team at  New York University. --
22
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23
--                                                                          --
24
------------------------------------------------------------------------------
25
 
26
with Ada.Characters.Handling; use Ada.Characters.Handling;
27
 
28
with Output;   use Output;
29
with Snames;
30
 
31
package body Prj.PP is
32
 
33
   use Prj.Tree;
34
 
35
   Not_Tested : array (Project_Node_Kind) of Boolean := (others => True);
36
 
37
   Max_Line_Length : constant := 255;
38
   --  Maximum length of a line. This is chosen to be compatible with older
39
   --  versions of GNAT that had a strict limit on the maximum line length.
40
 
41
   Column : Natural := 0;
42
   --  Column number of the last character in the line. Used to avoid
43
   --  outputting lines longer than Max_Line_Length.
44
 
45
   First_With_In_List : Boolean := True;
46
   --  Indicate that the next with clause is first in a list such as
47
   --    with "A", "B";
48
   --  First_With_In_List will be True for "A", but not for "B".
49
 
50
   procedure Indicate_Tested (Kind : Project_Node_Kind);
51
   --  Set the corresponding component of array Not_Tested to False.
52
   --  Only called by pragmas Debug.
53
 
54
   ---------------------
55
   -- Indicate_Tested --
56
   ---------------------
57
 
58
   procedure Indicate_Tested (Kind : Project_Node_Kind) is
59
   begin
60
      Not_Tested (Kind) := False;
61
   end Indicate_Tested;
62
 
63
   ------------------
64
   -- Pretty_Print --
65
   ------------------
66
 
67
   procedure Pretty_Print
68
     (Project                            : Prj.Tree.Project_Node_Id;
69
      In_Tree                            : Prj.Tree.Project_Node_Tree_Ref;
70
      Increment                          : Positive      := 3;
71
      Eliminate_Empty_Case_Constructions : Boolean       := False;
72
      Minimize_Empty_Lines               : Boolean       := False;
73
      W_Char                             : Write_Char_Ap := null;
74
      W_Eol                              : Write_Eol_Ap  := null;
75
      W_Str                              : Write_Str_Ap  := null;
76
      Backward_Compatibility             : Boolean;
77
      Id                                 : Prj.Project_Id := Prj.No_Project)
78
   is
79
      procedure Print (Node : Project_Node_Id; Indent : Natural);
80
      --  A recursive procedure that traverses a project file tree and outputs
81
      --  its source. Current_Prj is the project that we are printing. This
82
      --  is used when printing attributes, since in nested packages they
83
      --  need to use a fully qualified name.
84
 
85
      procedure Output_Attribute_Name (Name : Name_Id);
86
      --  Outputs an attribute name, taking into account the value of
87
      --  Backward_Compatibility.
88
 
89
      procedure Output_Name (Name : Name_Id; Capitalize : Boolean := True);
90
      --  Outputs a name
91
 
92
      procedure Start_Line (Indent : Natural);
93
      --  Outputs the indentation at the beginning of the line
94
 
95
      procedure Output_String (S : Name_Id);
96
      procedure Output_String (S : Path_Name_Type);
97
      --  Outputs a string using the default output procedures
98
 
99
      procedure Write_Empty_Line (Always : Boolean := False);
100
      --  Outputs an empty line, only if the previous line was not empty
101
      --  already and either Always is True or Minimize_Empty_Lines is False.
102
 
103
      procedure Write_Line (S : String);
104
      --  Outputs S followed by a new line
105
 
106
      procedure Write_String (S : String; Truncated : Boolean := False);
107
      --  Outputs S using Write_Str, starting a new line if line would
108
      --  become too long, when Truncated = False.
109
      --  When Truncated = True, only the part of the string that can fit on
110
      --  the line is output.
111
 
112
      procedure Write_End_Of_Line_Comment (Node : Project_Node_Id);
113
 
114
      Write_Char : Write_Char_Ap := Output.Write_Char'Access;
115
      Write_Eol  : Write_Eol_Ap  := Output.Write_Eol'Access;
116
      Write_Str  : Write_Str_Ap  := Output.Write_Str'Access;
117
      --  These three access to procedure values are used for the output
118
 
119
      Last_Line_Is_Empty : Boolean := False;
120
      --  Used to avoid two consecutive empty lines
121
 
122
      ---------------------------
123
      -- Output_Attribute_Name --
124
      ---------------------------
125
 
126
      procedure Output_Attribute_Name (Name : Name_Id) is
127
      begin
128
         if Backward_Compatibility then
129
            case Name is
130
               when Snames.Name_Spec =>
131
                  Output_Name (Snames.Name_Specification);
132
 
133
               when Snames.Name_Spec_Suffix =>
134
                  Output_Name (Snames.Name_Specification_Suffix);
135
 
136
               when Snames.Name_Body =>
137
                  Output_Name (Snames.Name_Implementation);
138
 
139
               when Snames.Name_Body_Suffix =>
140
                  Output_Name (Snames.Name_Implementation_Suffix);
141
 
142
               when others =>
143
                  Output_Name (Name);
144
            end case;
145
 
146
         else
147
            Output_Name (Name);
148
         end if;
149
      end Output_Attribute_Name;
150
 
151
      -----------------
152
      -- Output_Name --
153
      -----------------
154
 
155
      procedure Output_Name (Name : Name_Id; Capitalize : Boolean := True) is
156
         Capital : Boolean := Capitalize;
157
 
158
      begin
159
         Get_Name_String (Name);
160
 
161
         --  If line would become too long, create new line
162
 
163
         if Column + Name_Len > Max_Line_Length then
164
            Write_Eol.all;
165
            Column := 0;
166
         end if;
167
 
168
         for J in 1 .. Name_Len loop
169
            if Capital then
170
               Write_Char (To_Upper (Name_Buffer (J)));
171
            else
172
               Write_Char (Name_Buffer (J));
173
            end if;
174
 
175
            if Capitalize then
176
               Capital :=
177
                 Name_Buffer (J) = '_'
178
                 or else Is_Digit (Name_Buffer (J));
179
            end if;
180
         end loop;
181
 
182
         Column := Column + Name_Len;
183
      end Output_Name;
184
 
185
      -------------------
186
      -- Output_String --
187
      -------------------
188
 
189
      procedure Output_String (S : Name_Id) is
190
      begin
191
         Get_Name_String (S);
192
 
193
         --  If line could become too long, create new line.
194
         --  Note that the number of characters on the line could be
195
         --  twice the number of character in the string (if every
196
         --  character is a '"') plus two (the initial and final '"').
197
 
198
         if Column + Name_Len + Name_Len + 2 > Max_Line_Length then
199
            Write_Eol.all;
200
            Column := 0;
201
         end if;
202
 
203
         Write_Char ('"');
204
         Column := Column + 1;
205
         Get_Name_String (S);
206
 
207
         for J in 1 .. Name_Len loop
208
            if Name_Buffer (J) = '"' then
209
               Write_Char ('"');
210
               Write_Char ('"');
211
               Column := Column + 2;
212
            else
213
               Write_Char (Name_Buffer (J));
214
               Column := Column + 1;
215
            end if;
216
 
217
            --  If the string does not fit on one line, cut it in parts
218
            --  and concatenate.
219
 
220
            if J < Name_Len and then Column >= Max_Line_Length then
221
               Write_Str (""" &");
222
               Write_Eol.all;
223
               Write_Char ('"');
224
               Column := 1;
225
            end if;
226
         end loop;
227
 
228
         Write_Char ('"');
229
         Column := Column + 1;
230
      end Output_String;
231
 
232
      procedure Output_String (S : Path_Name_Type) is
233
      begin
234
         Output_String (Name_Id (S));
235
      end Output_String;
236
 
237
      ----------------
238
      -- Start_Line --
239
      ----------------
240
 
241
      procedure Start_Line (Indent : Natural) is
242
      begin
243
         if not Minimize_Empty_Lines then
244
            Write_Str ((1 .. Indent => ' '));
245
            Column := Column + Indent;
246
         end if;
247
      end Start_Line;
248
 
249
      ----------------------
250
      -- Write_Empty_Line --
251
      ----------------------
252
 
253
      procedure Write_Empty_Line (Always : Boolean := False) is
254
      begin
255
         if (Always or else not Minimize_Empty_Lines)
256
           and then not Last_Line_Is_Empty then
257
            Write_Eol.all;
258
            Column := 0;
259
            Last_Line_Is_Empty := True;
260
         end if;
261
      end Write_Empty_Line;
262
 
263
      -------------------------------
264
      -- Write_End_Of_Line_Comment --
265
      -------------------------------
266
 
267
      procedure Write_End_Of_Line_Comment (Node : Project_Node_Id) is
268
         Value : constant Name_Id := End_Of_Line_Comment (Node, In_Tree);
269
 
270
      begin
271
         if Value /= No_Name then
272
            Write_String (" --");
273
            Write_String (Get_Name_String (Value), Truncated => True);
274
         end if;
275
 
276
         Write_Line ("");
277
      end Write_End_Of_Line_Comment;
278
 
279
      ----------------
280
      -- Write_Line --
281
      ----------------
282
 
283
      procedure Write_Line (S : String) is
284
      begin
285
         Write_String (S);
286
         Last_Line_Is_Empty := False;
287
         Write_Eol.all;
288
         Column := 0;
289
      end Write_Line;
290
 
291
      ------------------
292
      -- Write_String --
293
      ------------------
294
 
295
      procedure Write_String (S : String; Truncated : Boolean := False) is
296
         Length : Natural := S'Length;
297
      begin
298
         --  If the string would not fit on the line,
299
         --  start a new line.
300
 
301
         if Column + Length > Max_Line_Length then
302
            if Truncated then
303
               Length := Max_Line_Length - Column;
304
 
305
            else
306
               Write_Eol.all;
307
               Column := 0;
308
            end if;
309
         end if;
310
 
311
         Write_Str (S (S'First .. S'First + Length - 1));
312
         Column := Column + Length;
313
      end Write_String;
314
 
315
      -----------
316
      -- Print --
317
      -----------
318
 
319
      procedure Print (Node   : Project_Node_Id; Indent : Natural) is
320
      begin
321
         if Present (Node) then
322
 
323
            case Kind_Of (Node, In_Tree) is
324
 
325
               when N_Project  =>
326
                  pragma Debug (Indicate_Tested (N_Project));
327
                  if Present (First_With_Clause_Of (Node, In_Tree)) then
328
 
329
                     --  with clause(s)
330
 
331
                     First_With_In_List := True;
332
                     Print (First_With_Clause_Of (Node, In_Tree), Indent);
333
                     Write_Empty_Line (Always => True);
334
                  end if;
335
 
336
                  Print (First_Comment_Before (Node, In_Tree), Indent);
337
                  Start_Line (Indent);
338
                  Write_String ("project ");
339
 
340
                  if Id /= Prj.No_Project then
341
                     Output_Name (Id.Display_Name);
342
                  else
343
                     Output_Name (Name_Of (Node, In_Tree));
344
                  end if;
345
 
346
                  --  Check if this project extends another project
347
 
348
                  if Extended_Project_Path_Of (Node, In_Tree) /= No_Path then
349
                     Write_String (" extends ");
350
 
351
                     if Is_Extending_All (Node, In_Tree) then
352
                        Write_String ("all ");
353
                     end if;
354
 
355
                     Output_String (Extended_Project_Path_Of (Node, In_Tree));
356
                  end if;
357
 
358
                  Write_String (" is");
359
                  Write_End_Of_Line_Comment (Node);
360
                  Print
361
                    (First_Comment_After (Node, In_Tree), Indent + Increment);
362
                  Write_Empty_Line (Always => True);
363
 
364
                  --  Output all of the declarations in the project
365
 
366
                  Print (Project_Declaration_Of (Node, In_Tree), Indent);
367
                  Print
368
                    (First_Comment_Before_End (Node, In_Tree),
369
                     Indent + Increment);
370
                  Start_Line (Indent);
371
                  Write_String ("end ");
372
 
373
                  if Id /= Prj.No_Project then
374
                     Output_Name (Id.Display_Name);
375
                  else
376
                     Output_Name (Name_Of (Node, In_Tree));
377
                  end if;
378
 
379
                  Write_Line (";");
380
                  Print (First_Comment_After_End (Node, In_Tree), Indent);
381
 
382
               when N_With_Clause =>
383
                  pragma Debug (Indicate_Tested (N_With_Clause));
384
 
385
                  --  The with clause will sometimes contain an invalid name
386
                  --  when we are importing a virtual project from an
387
                  --  extending all project. Do not output anything in this
388
                  --  case
389
 
390
                  if Name_Of (Node, In_Tree) /= No_Name
391
                    and then String_Value_Of (Node, In_Tree) /= No_Name
392
                  then
393
                     if First_With_In_List then
394
                        Print (First_Comment_Before (Node, In_Tree), Indent);
395
                        Start_Line (Indent);
396
 
397
                        if Non_Limited_Project_Node_Of (Node, In_Tree) =
398
                             Empty_Node
399
                        then
400
                           Write_String ("limited ");
401
                        end if;
402
 
403
                        Write_String ("with ");
404
                     end if;
405
 
406
                     Output_String (String_Value_Of (Node, In_Tree));
407
 
408
                     if Is_Not_Last_In_List (Node, In_Tree) then
409
                        Write_String (", ");
410
                        First_With_In_List := False;
411
 
412
                     else
413
                        Write_String (";");
414
                        Write_End_Of_Line_Comment (Node);
415
                        Print (First_Comment_After (Node, In_Tree), Indent);
416
                        First_With_In_List := True;
417
                     end if;
418
                  end if;
419
 
420
                  Print (Next_With_Clause_Of (Node, In_Tree), Indent);
421
 
422
               when N_Project_Declaration =>
423
                  pragma Debug (Indicate_Tested (N_Project_Declaration));
424
 
425
                  if
426
                    Present (First_Declarative_Item_Of (Node, In_Tree))
427
                  then
428
                     Print
429
                       (First_Declarative_Item_Of (Node, In_Tree),
430
                        Indent + Increment);
431
                     Write_Empty_Line (Always => True);
432
                  end if;
433
 
434
               when N_Declarative_Item =>
435
                  pragma Debug (Indicate_Tested (N_Declarative_Item));
436
                  Print (Current_Item_Node (Node, In_Tree), Indent);
437
                  Print (Next_Declarative_Item (Node, In_Tree), Indent);
438
 
439
               when N_Package_Declaration =>
440
                  pragma Debug (Indicate_Tested (N_Package_Declaration));
441
                  Write_Empty_Line (Always => True);
442
                  Print (First_Comment_Before (Node, In_Tree), Indent);
443
                  Start_Line (Indent);
444
                  Write_String ("package ");
445
                  Output_Name (Name_Of (Node, In_Tree));
446
 
447
                  if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
448
                       Empty_Node
449
                  then
450
                     Write_String (" renames ");
451
                     Output_Name
452
                       (Name_Of
453
                          (Project_Of_Renamed_Package_Of (Node, In_Tree),
454
                           In_Tree));
455
                     Write_String (".");
456
                     Output_Name (Name_Of (Node, In_Tree));
457
                     Write_String (";");
458
                     Write_End_Of_Line_Comment (Node);
459
                     Print (First_Comment_After_End (Node, In_Tree), Indent);
460
 
461
                  else
462
                     Write_String (" is");
463
                     Write_End_Of_Line_Comment (Node);
464
                     Print (First_Comment_After (Node, In_Tree),
465
                            Indent + Increment);
466
 
467
                     if First_Declarative_Item_Of (Node, In_Tree) /=
468
                          Empty_Node
469
                     then
470
                        Print
471
                          (First_Declarative_Item_Of (Node, In_Tree),
472
                           Indent + Increment);
473
                     end if;
474
 
475
                     Print (First_Comment_Before_End (Node, In_Tree),
476
                            Indent + Increment);
477
                     Start_Line (Indent);
478
                     Write_String ("end ");
479
                     Output_Name (Name_Of (Node, In_Tree));
480
                     Write_Line (";");
481
                     Print (First_Comment_After_End (Node, In_Tree), Indent);
482
                     Write_Empty_Line;
483
                  end if;
484
 
485
               when N_String_Type_Declaration =>
486
                  pragma Debug (Indicate_Tested (N_String_Type_Declaration));
487
                  Print (First_Comment_Before (Node, In_Tree), Indent);
488
                  Start_Line (Indent);
489
                  Write_String ("type ");
490
                  Output_Name (Name_Of (Node, In_Tree));
491
                  Write_Line (" is");
492
                  Start_Line (Indent + Increment);
493
                  Write_String ("(");
494
 
495
                  declare
496
                     String_Node : Project_Node_Id :=
497
                       First_Literal_String (Node, In_Tree);
498
 
499
                  begin
500
                     while Present (String_Node) loop
501
                        Output_String (String_Value_Of (String_Node, In_Tree));
502
                        String_Node :=
503
                          Next_Literal_String (String_Node, In_Tree);
504
 
505
                        if Present (String_Node) then
506
                           Write_String (", ");
507
                        end if;
508
                     end loop;
509
                  end;
510
 
511
                  Write_String (");");
512
                  Write_End_Of_Line_Comment (Node);
513
                  Print (First_Comment_After (Node, In_Tree), Indent);
514
 
515
               when N_Literal_String =>
516
                  pragma Debug (Indicate_Tested (N_Literal_String));
517
                  Output_String (String_Value_Of (Node, In_Tree));
518
 
519
                  if Source_Index_Of (Node, In_Tree) /= 0 then
520
                     Write_String (" at");
521
                     Write_String (Source_Index_Of (Node, In_Tree)'Img);
522
                  end if;
523
 
524
               when N_Attribute_Declaration =>
525
                  pragma Debug (Indicate_Tested (N_Attribute_Declaration));
526
                  Print (First_Comment_Before (Node, In_Tree), Indent);
527
                  Start_Line (Indent);
528
                  Write_String ("for ");
529
                  Output_Attribute_Name (Name_Of (Node, In_Tree));
530
 
531
                  if Associative_Array_Index_Of (Node, In_Tree) /= No_Name then
532
                     Write_String (" (");
533
                     Output_String
534
                       (Associative_Array_Index_Of (Node, In_Tree));
535
 
536
                     if Source_Index_Of (Node, In_Tree) /= 0 then
537
                        Write_String (" at");
538
                        Write_String (Source_Index_Of (Node, In_Tree)'Img);
539
                     end if;
540
 
541
                     Write_String (")");
542
                  end if;
543
 
544
                  Write_String (" use ");
545
 
546
                  if Present (Expression_Of (Node, In_Tree)) then
547
                     Print (Expression_Of (Node, In_Tree), Indent);
548
 
549
                  else
550
                     --  Full associative array declaration
551
 
552
                     if
553
                       Present (Associative_Project_Of (Node, In_Tree))
554
                     then
555
                        Output_Name
556
                          (Name_Of
557
                             (Associative_Project_Of (Node, In_Tree),
558
                              In_Tree));
559
 
560
                        if
561
                          Present (Associative_Package_Of (Node, In_Tree))
562
                        then
563
                           Write_String (".");
564
                           Output_Name
565
                             (Name_Of
566
                                (Associative_Package_Of (Node, In_Tree),
567
                                 In_Tree));
568
                        end if;
569
 
570
                     elsif
571
                       Present (Associative_Package_Of (Node, In_Tree))
572
                     then
573
                        Output_Name
574
                          (Name_Of
575
                             (Associative_Package_Of (Node, In_Tree),
576
                              In_Tree));
577
                     end if;
578
 
579
                     Write_String ("'");
580
                     Output_Attribute_Name (Name_Of (Node, In_Tree));
581
                  end if;
582
 
583
                  Write_String (";");
584
                  Write_End_Of_Line_Comment (Node);
585
                  Print (First_Comment_After (Node, In_Tree), Indent);
586
 
587
               when N_Typed_Variable_Declaration =>
588
                  pragma Debug
589
                    (Indicate_Tested (N_Typed_Variable_Declaration));
590
                  Print (First_Comment_Before (Node, In_Tree), Indent);
591
                  Start_Line (Indent);
592
                  Output_Name (Name_Of (Node, In_Tree));
593
                  Write_String (" : ");
594
                  Output_Name
595
                    (Name_Of (String_Type_Of (Node, In_Tree), In_Tree));
596
                  Write_String (" := ");
597
                  Print (Expression_Of (Node, In_Tree), Indent);
598
                  Write_String (";");
599
                  Write_End_Of_Line_Comment (Node);
600
                  Print (First_Comment_After (Node, In_Tree), Indent);
601
 
602
               when N_Variable_Declaration =>
603
                  pragma Debug (Indicate_Tested (N_Variable_Declaration));
604
                  Print (First_Comment_Before (Node, In_Tree), Indent);
605
                  Start_Line (Indent);
606
                  Output_Name (Name_Of (Node, In_Tree));
607
                  Write_String (" := ");
608
                  Print (Expression_Of (Node, In_Tree), Indent);
609
                  Write_String (";");
610
                  Write_End_Of_Line_Comment (Node);
611
                  Print (First_Comment_After (Node, In_Tree), Indent);
612
 
613
               when N_Expression =>
614
                  pragma Debug (Indicate_Tested (N_Expression));
615
                  declare
616
                     Term : Project_Node_Id := First_Term (Node, In_Tree);
617
 
618
                  begin
619
                     while Present (Term) loop
620
                        Print (Term, Indent);
621
                        Term := Next_Term (Term, In_Tree);
622
 
623
                        if Present (Term) then
624
                           Write_String (" & ");
625
                        end if;
626
                     end loop;
627
                  end;
628
 
629
               when N_Term =>
630
                  pragma Debug (Indicate_Tested (N_Term));
631
                  Print (Current_Term (Node, In_Tree), Indent);
632
 
633
               when N_Literal_String_List =>
634
                  pragma Debug (Indicate_Tested (N_Literal_String_List));
635
                  Write_String ("(");
636
 
637
                  declare
638
                     Expression : Project_Node_Id :=
639
                       First_Expression_In_List (Node, In_Tree);
640
 
641
                  begin
642
                     while Present (Expression) loop
643
                        Print (Expression, Indent);
644
                        Expression :=
645
                          Next_Expression_In_List (Expression, In_Tree);
646
 
647
                        if Present (Expression) then
648
                           Write_String (", ");
649
                        end if;
650
                     end loop;
651
                  end;
652
 
653
                  Write_String (")");
654
 
655
               when N_Variable_Reference =>
656
                  pragma Debug (Indicate_Tested (N_Variable_Reference));
657
                  if Present (Project_Node_Of (Node, In_Tree)) then
658
                     Output_Name
659
                       (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
660
                     Write_String (".");
661
                  end if;
662
 
663
                  if Present (Package_Node_Of (Node, In_Tree)) then
664
                     Output_Name
665
                       (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
666
                     Write_String (".");
667
                  end if;
668
 
669
                  Output_Name (Name_Of (Node, In_Tree));
670
 
671
               when N_External_Value =>
672
                  pragma Debug (Indicate_Tested (N_External_Value));
673
                  Write_String ("external (");
674
                  Print (External_Reference_Of (Node, In_Tree), Indent);
675
 
676
                  if Present (External_Default_Of (Node, In_Tree)) then
677
                     Write_String (", ");
678
                     Print (External_Default_Of (Node, In_Tree), Indent);
679
                  end if;
680
 
681
                  Write_String (")");
682
 
683
               when N_Attribute_Reference =>
684
                  pragma Debug (Indicate_Tested (N_Attribute_Reference));
685
 
686
                  if Present (Project_Node_Of (Node, In_Tree))
687
                    and then Project_Node_Of (Node, In_Tree) /= Project
688
                  then
689
                     Output_Name
690
                       (Name_Of (Project_Node_Of (Node, In_Tree), In_Tree));
691
 
692
                     if Present (Package_Node_Of (Node, In_Tree)) then
693
                        Write_String (".");
694
                        Output_Name
695
                          (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
696
                     end if;
697
 
698
                  elsif Present (Package_Node_Of (Node, In_Tree)) then
699
                     Output_Name
700
                       (Name_Of (Package_Node_Of (Node, In_Tree), In_Tree));
701
 
702
                  else
703
                     Write_String ("project");
704
                  end if;
705
 
706
                  Write_String ("'");
707
                  Output_Attribute_Name (Name_Of (Node, In_Tree));
708
 
709
                  declare
710
                     Index : constant Name_Id :=
711
                               Associative_Array_Index_Of (Node, In_Tree);
712
 
713
                  begin
714
                     if Index /= No_Name then
715
                        Write_String (" (");
716
                        Output_String (Index);
717
                        Write_String (")");
718
                     end if;
719
                  end;
720
 
721
               when N_Case_Construction =>
722
                  pragma Debug (Indicate_Tested (N_Case_Construction));
723
 
724
                  declare
725
                     Case_Item    : Project_Node_Id;
726
                     Is_Non_Empty : Boolean := False;
727
 
728
                  begin
729
                     Case_Item := First_Case_Item_Of (Node, In_Tree);
730
                     while Present (Case_Item) loop
731
                        if Present
732
                            (First_Declarative_Item_Of (Case_Item, In_Tree))
733
                           or else not Eliminate_Empty_Case_Constructions
734
                        then
735
                           Is_Non_Empty := True;
736
                           exit;
737
                        end if;
738
 
739
                        Case_Item := Next_Case_Item (Case_Item, In_Tree);
740
                     end loop;
741
 
742
                     if Is_Non_Empty then
743
                        Write_Empty_Line;
744
                        Print (First_Comment_Before (Node, In_Tree), Indent);
745
                        Start_Line (Indent);
746
                        Write_String ("case ");
747
                        Print
748
                          (Case_Variable_Reference_Of (Node, In_Tree),
749
                           Indent);
750
                        Write_String (" is");
751
                        Write_End_Of_Line_Comment (Node);
752
                        Print
753
                          (First_Comment_After (Node, In_Tree),
754
                           Indent + Increment);
755
 
756
                        declare
757
                           Case_Item : Project_Node_Id :=
758
                                         First_Case_Item_Of (Node, In_Tree);
759
                        begin
760
                           while Present (Case_Item) loop
761
                              pragma Assert
762
                                (Kind_Of (Case_Item, In_Tree) = N_Case_Item);
763
                              Print (Case_Item, Indent + Increment);
764
                              Case_Item :=
765
                                Next_Case_Item (Case_Item, In_Tree);
766
                           end loop;
767
                        end;
768
 
769
                        Print (First_Comment_Before_End (Node, In_Tree),
770
                               Indent + Increment);
771
                        Start_Line (Indent);
772
                        Write_Line ("end case;");
773
                        Print
774
                          (First_Comment_After_End (Node, In_Tree), Indent);
775
                     end if;
776
                  end;
777
 
778
               when N_Case_Item =>
779
                  pragma Debug (Indicate_Tested (N_Case_Item));
780
 
781
                  if Present (First_Declarative_Item_Of (Node, In_Tree))
782
                    or else not Eliminate_Empty_Case_Constructions
783
                  then
784
                     Write_Empty_Line;
785
                     Print (First_Comment_Before (Node, In_Tree), Indent);
786
                     Start_Line (Indent);
787
                     Write_String ("when ");
788
 
789
                     if No (First_Choice_Of (Node, In_Tree)) then
790
                        Write_String ("others");
791
 
792
                     else
793
                        declare
794
                           Label : Project_Node_Id :=
795
                                     First_Choice_Of (Node, In_Tree);
796
                        begin
797
                           while Present (Label) loop
798
                              Print (Label, Indent);
799
                              Label := Next_Literal_String (Label, In_Tree);
800
 
801
                              if Present (Label) then
802
                                 Write_String (" | ");
803
                              end if;
804
                           end loop;
805
                        end;
806
                     end if;
807
 
808
                     Write_String (" =>");
809
                     Write_End_Of_Line_Comment (Node);
810
                     Print
811
                       (First_Comment_After (Node, In_Tree),
812
                        Indent + Increment);
813
 
814
                     declare
815
                        First : constant Project_Node_Id :=
816
                                  First_Declarative_Item_Of (Node, In_Tree);
817
                     begin
818
                        if No (First) then
819
                           Write_Empty_Line;
820
                        else
821
                           Print (First, Indent + Increment);
822
                        end if;
823
                     end;
824
                  end if;
825
 
826
               when N_Comment_Zones =>
827
 
828
               --  Nothing to do, because it will not be processed directly
829
 
830
                  null;
831
 
832
               when N_Comment =>
833
                  pragma Debug (Indicate_Tested (N_Comment));
834
 
835
                  if Follows_Empty_Line (Node, In_Tree) then
836
                     Write_Empty_Line;
837
                  end if;
838
 
839
                  Start_Line (Indent);
840
                  Write_String ("--");
841
                  Write_String
842
                    (Get_Name_String (String_Value_Of (Node, In_Tree)),
843
                     Truncated => True);
844
                  Write_Line ("");
845
 
846
                  if Is_Followed_By_Empty_Line (Node, In_Tree) then
847
                     Write_Empty_Line;
848
                  end if;
849
 
850
                  Print (Next_Comment (Node, In_Tree), Indent);
851
            end case;
852
         end if;
853
      end Print;
854
 
855
   --  Start of processing for Pretty_Print
856
 
857
   begin
858
      if W_Char = null then
859
         Write_Char := Output.Write_Char'Access;
860
      else
861
         Write_Char := W_Char;
862
      end if;
863
 
864
      if W_Eol = null then
865
         Write_Eol := Output.Write_Eol'Access;
866
      else
867
         Write_Eol := W_Eol;
868
      end if;
869
 
870
      if W_Str = null then
871
         Write_Str := Output.Write_Str'Access;
872
      else
873
         Write_Str := W_Str;
874
      end if;
875
 
876
      Print (Project, 0);
877
 
878
      if W_Char = null or else W_Str = null then
879
         Output.Write_Eol;
880
      end if;
881
   end Pretty_Print;
882
 
883
   -----------------------
884
   -- Output_Statistics --
885
   -----------------------
886
 
887
   procedure Output_Statistics is
888
   begin
889
      Output.Write_Line ("Project_Node_Kinds not tested:");
890
 
891
      for Kind in Project_Node_Kind loop
892
         if Kind /= N_Comment_Zones and then Not_Tested (Kind) then
893
            Output.Write_Str ("   ");
894
            Output.Write_Line (Project_Node_Kind'Image (Kind));
895
         end if;
896
      end loop;
897
 
898
      Output.Write_Eol;
899
   end Output_Statistics;
900
 
901
end Prj.PP;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.