gcc/ada/restrict.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             R E S T R I C T                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2006, 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,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, 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 ------------------------------------------------------------------------------
  26
  27 with Atree;    use Atree;
  28 with Casing;   use Casing;
  29 with Errout;   use Errout;
  30 with Fname;    use Fname;
  31 with Fname.UF; use Fname.UF;
  32 with Lib;      use Lib;
  33 with Namet;    use Namet;
  34 with Opt;      use Opt;
  35 with Sinfo;    use Sinfo;
  36 with Sinput;   use Sinput;
  37 with Snames;   use Snames;
  38 with Uname;    use Uname;
  39
  40 package body Restrict is
  41
  42    Restricted_Profile_Result : Boolean := False;
  43    --  This switch memoizes the result of Restricted_Profile function
  44    --  calls for improved efficiency. Its setting is valid only if
  45    --  Restricted_Profile_Cached is True. Note that if this switch
  46    --  is ever set True, it need never be turned off again.
  47
  48    Restricted_Profile_Cached : Boolean := False;
  49    --  This flag is set to True if the Restricted_Profile_Result
  50    --  contains the correct cached result of Restricted_Profile calls.
  51
  52    -----------------------
  53    -- Local Subprograms --
  54    -----------------------
  55
  56    procedure Restriction_Msg (Msg : String; R : String; N : Node_Id);
  57    --  Output error message at node N with given text, replacing the
  58    --  '%' in the message with the name of the restriction given as R,
  59    --  cased according to the current identifier casing. We do not use
  60    --  the normal insertion mechanism, since this requires an entry
  61    --  in the Names table, and this table will be locked if we are
  62    --  generating a message from gigi.
  63
  64    function Same_Unit (U1, U2 : Node_Id) return Boolean;
  65    --  Returns True iff U1 and U2 represent the same library unit. Used for
  66    --  handling of No_Dependence => Unit restriction case.
  67
  68    function Suppress_Restriction_Message (N : Node_Id) return Boolean;
  69    --  N is the node for a possible restriction violation message, but
  70    --  the message is to be suppressed if this is an internal file and
  71    --  this file is not the main unit.
  72
  73    -------------------
  74    -- Abort_Allowed --
  75    -------------------
  76
  77    function Abort_Allowed return Boolean is
  78    begin
  79       if Restrictions.Set (No_Abort_Statements)
  80         and then Restrictions.Set (Max_Asynchronous_Select_Nesting)
  81         and then Restrictions.Value (Max_Asynchronous_Select_Nesting) = 0
  82       then
  83          return False;
  84       else
  85          return True;
  86       end if;
  87    end Abort_Allowed;
  88
  89    ------------------------------------
  90    -- Check_Elaboration_Code_Allowed --
  91    ------------------------------------
  92
  93    procedure Check_Elaboration_Code_Allowed (N : Node_Id) is
  94    begin
  95       --  Avoid calling Namet.Unlock/Lock except when there is an error.
  96       --  Even in the error case it is a bit dubious, either gigi needs
  97       --  the table locked or it does not! ???
  98
  99       if Restrictions.Set (No_Elaboration_Code)
 100         and then not Suppress_Restriction_Message (N)
 101       then
 102          Namet.Unlock;
 103          Check_Restriction (Restriction_Id'(No_Elaboration_Code), N);
 104          Namet.Lock;
 105       end if;
 106    end Check_Elaboration_Code_Allowed;
 107
 108    ----------------------------------
 109    -- Check_No_Implicit_Heap_Alloc --
 110    ----------------------------------
 111
 112    procedure Check_No_Implicit_Heap_Alloc (N : Node_Id) is
 113    begin
 114       Check_Restriction (Restriction_Id'(No_Implicit_Heap_Allocations), N);
 115    end Check_No_Implicit_Heap_Alloc;
 116
 117    ---------------------------
 118    -- Check_Restricted_Unit --
 119    ---------------------------
 120
 121    procedure Check_Restricted_Unit (U : Unit_Name_Type; N : Node_Id) is
 122    begin
 123       if Suppress_Restriction_Message (N) then
 124          return;
 125
 126       elsif Is_Spec_Name (U) then
 127          declare
 128             Fnam : constant File_Name_Type :=
 129                      Get_File_Name (U, Subunit => False);
 130
 131          begin
 132             if not Is_Predefined_File_Name (Fnam) then
 133                return;
 134
 135             --  Predefined spec, needs checking against list
 136
 137             else
 138                --  Pad name to 8 characters with blanks
 139
 140                Get_Name_String (Fnam);
 141                Name_Len := Name_Len - 4;
 142
 143                while Name_Len < 8 loop
 144                   Name_Len := Name_Len + 1;
 145                   Name_Buffer (Name_Len) := ' ';
 146                end loop;
 147
 148                for J in Unit_Array'Range loop
 149                   if Name_Len = 8
 150                     and then Name_Buffer (1 .. 8) = Unit_Array (J).Filenm
 151                   then
 152                      Check_Restriction (Unit_Array (J).Res_Id, N);
 153                   end if;
 154                end loop;
 155             end if;
 156          end;
 157       end if;
 158    end Check_Restricted_Unit;
 159
 160    -----------------------
 161    -- Check_Restriction --
 162    -----------------------
 163
 164    procedure Check_Restriction
 165      (R : Restriction_Id;
 166       N : Node_Id;
 167       V : Uint := Uint_Minus_1)
 168    is
 169       Rimage : constant String := Restriction_Id'Image (R);
 170
 171       VV : Integer;
 172       --  V converted to integer form. If V is greater than Integer'Last,
 173       --  it is reset to minus 1 (unknown value).
 174
 175       procedure Update_Restrictions (Info : in out Restrictions_Info);
 176       --  Update violation information in Info.Violated and Info.Count
 177
 178       -------------------------
 179       -- Update_Restrictions --
 180       -------------------------
 181
 182       procedure Update_Restrictions (Info : in out Restrictions_Info) is
 183       begin
 184          --  If not violated, set as violated now
 185
 186          if not Info.Violated (R) then
 187             Info.Violated (R) := True;
 188
 189             if R in All_Parameter_Restrictions then
 190                if VV < 0 then
 191                   Info.Unknown (R) := True;
 192                   Info.Count (R) := 1;
 193                else
 194                   Info.Count (R) := VV;
 195                end if;
 196             end if;
 197
 198          --  Otherwise if violated already and a parameter restriction,
 199          --  update count by maximizing or summing depending on restriction.
 200
 201          elsif R in All_Parameter_Restrictions then
 202
 203             --  If new value is unknown, result is unknown
 204
 205             if VV < 0 then
 206                Info.Unknown (R) := True;
 207
 208             --  If checked by maximization, do maximization
 209
 210             elsif R in Checked_Max_Parameter_Restrictions then
 211                Info.Count (R) := Integer'Max (Info.Count (R), VV);
 212
 213             --  If checked by adding, do add, checking for overflow
 214
 215             elsif R in Checked_Add_Parameter_Restrictions then
 216                declare
 217                   pragma Unsuppress (Overflow_Check);
 218                begin
 219                   Info.Count (R) := Info.Count (R) + VV;
 220                exception
 221                   when Constraint_Error =>
 222                      Info.Count (R) := Integer'Last;
 223                      Info.Unknown (R) := True;
 224                end;
 225
 226             --  Should not be able to come here, known counts should only
 227             --  occur for restrictions that are Checked_max or Checked_Sum.
 228
 229             else
 230                raise Program_Error;
 231             end if;
 232          end if;
 233       end Update_Restrictions;
 234
 235    --  Start of processing for Check_Restriction
 236
 237    begin
 238       if UI_Is_In_Int_Range (V) then
 239          VV := Integer (UI_To_Int (V));
 240       else
 241          VV := -1;
 242       end if;
 243
 244       --  Count can only be specified in the checked val parameter case
 245
 246       pragma Assert (VV < 0 or else R in Checked_Val_Parameter_Restrictions);
 247
 248       --  Nothing to do if value of zero specified for parameter restriction
 249
 250       if VV = 0 then
 251          return;
 252       end if;
 253
 254       --  Update current restrictions
 255
 256       Update_Restrictions (Restrictions);
 257
 258       --  If in main extended unit, update main restrictions as well
 259
 260       if Current_Sem_Unit = Main_Unit
 261         or else In_Extended_Main_Source_Unit (N)
 262       then
 263          Update_Restrictions (Main_Restrictions);
 264       end if;
 265
 266       --  Nothing to do if restriction message suppressed
 267
 268       if Suppress_Restriction_Message (N) then
 269          null;
 270
 271       --  If restriction not set, nothing to do
 272
 273       elsif not Restrictions.Set (R) then
 274          null;
 275
 276       --  Here if restriction set, check for violation (either this is a
 277       --  Boolean restriction, or a parameter restriction with a value of
 278       --  zero and an unknown count, or a parameter restriction with a
 279       --  known value that exceeds the restriction count).
 280
 281       elsif R in All_Boolean_Restrictions
 282         or else (Restrictions.Unknown (R)
 283                    and then Restrictions.Value (R) = 0)
 284         or else Restrictions.Count (R) > Restrictions.Value (R)
 285       then
 286          Error_Msg_Sloc := Restrictions_Loc (R);
 287
 288          --  If we have a location for the Restrictions pragma, output it
 289
 290          if Error_Msg_Sloc > No_Location
 291            or else Error_Msg_Sloc = System_Location
 292          then
 293             if Restriction_Warnings (R) then
 294                Restriction_Msg ("|violation of restriction %#?", Rimage, N);
 295             else
 296                Restriction_Msg ("|violation of restriction %#", Rimage, N);
 297             end if;
 298
 299          --  Otherwise we have the case of an implicit restriction
 300          --  (e.g. a restriction implicitly set by another pragma)
 301
 302          else
 303             Restriction_Msg
 304               ("|violation of implicit restriction %", Rimage, N);
 305          end if;
 306       end if;
 307    end Check_Restriction;
 308
 309    -------------------------------------
 310    -- Check_Restriction_No_Dependence --
 311    -------------------------------------
 312
 313    procedure Check_Restriction_No_Dependence (U : Node_Id; Err : Node_Id) is
 314       DU : Node_Id;
 315
 316    begin
 317       for J in No_Dependence.First .. No_Dependence.Last loop
 318          DU := No_Dependence.Table (J).Unit;
 319
 320          if Same_Unit (U, DU) then
 321             Error_Msg_Sloc := Sloc (DU);
 322             Error_Msg_Node_1 := DU;
 323
 324             if No_Dependence.Table (J).Warn then
 325                Error_Msg
 326                  ("?violation of restriction `No_Dependence '='> &`#",
 327                   Sloc (Err));
 328             else
 329                Error_Msg
 330                  ("|violation of restriction `No_Dependence '='> &`#",
 331                   Sloc (Err));
 332             end if;
 333
 334             return;
 335          end if;
 336       end loop;
 337    end Check_Restriction_No_Dependence;
 338
 339    ----------------------------------------
 340    -- Cunit_Boolean_Restrictions_Restore --
 341    ----------------------------------------
 342
 343    procedure Cunit_Boolean_Restrictions_Restore
 344      (R : Save_Cunit_Boolean_Restrictions)
 345    is
 346    begin
 347       for J in Cunit_Boolean_Restrictions loop
 348          Restrictions.Set (J) := R (J);
 349       end loop;
 350    end Cunit_Boolean_Restrictions_Restore;
 351
 352    -------------------------------------
 353    -- Cunit_Boolean_Restrictions_Save --
 354    -------------------------------------
 355
 356    function Cunit_Boolean_Restrictions_Save
 357      return Save_Cunit_Boolean_Restrictions
 358    is
 359       R : Save_Cunit_Boolean_Restrictions;
 360
 361    begin
 362       for J in Cunit_Boolean_Restrictions loop
 363          R (J) := Restrictions.Set (J);
 364          Restrictions.Set (J) := False;
 365       end loop;
 366
 367       return R;
 368    end Cunit_Boolean_Restrictions_Save;
 369
 370    ------------------------
 371    -- Get_Restriction_Id --
 372    ------------------------
 373
 374    function Get_Restriction_Id
 375      (N : Name_Id) return Restriction_Id
 376    is
 377    begin
 378       Get_Name_String (N);
 379       Set_Casing (All_Upper_Case);
 380
 381       for J in All_Restrictions loop
 382          declare
 383             S : constant String := Restriction_Id'Image (J);
 384          begin
 385             if S = Name_Buffer (1 .. Name_Len) then
 386                return J;
 387             end if;
 388          end;
 389       end loop;
 390
 391       return Not_A_Restriction_Id;
 392    end Get_Restriction_Id;
 393
 394    -------------------------------
 395    -- No_Exception_Handlers_Set --
 396    -------------------------------
 397
 398    function No_Exception_Handlers_Set return Boolean is
 399    begin
 400       return Restrictions.Set (No_Exception_Handlers);
 401    end No_Exception_Handlers_Set;
 402
 403    ----------------------------------
 404    -- Process_Restriction_Synonyms --
 405    ----------------------------------
 406
 407    --  Note: body of this function must be coordinated with list of
 408    --  renaming declarations in System.Rident.
 409
 410    function Process_Restriction_Synonyms (N : Node_Id) return Name_Id
 411    is
 412       Old_Name : constant Name_Id := Chars (N);
 413       New_Name : Name_Id;
 414
 415    begin
 416       case Old_Name is
 417          when Name_Boolean_Entry_Barriers =>
 418             New_Name := Name_Simple_Barriers;
 419
 420          when Name_Max_Entry_Queue_Depth =>
 421             New_Name := Name_Max_Entry_Queue_Length;
 422
 423          when Name_No_Dynamic_Interrupts =>
 424             New_Name := Name_No_Dynamic_Attachment;
 425
 426          when Name_No_Requeue =>
 427             New_Name := Name_No_Requeue_Statements;
 428
 429          when Name_No_Task_Attributes =>
 430             New_Name := Name_No_Task_Attributes_Package;
 431
 432          when others =>
 433             return Old_Name;
 434       end case;
 435
 436       if Warn_On_Obsolescent_Feature then
 437          Error_Msg_Name_1 := Old_Name;
 438          Error_Msg_N ("restriction identifier % is obsolescent?", N);
 439          Error_Msg_Name_1 := New_Name;
 440          Error_Msg_N ("|use restriction identifier % instead", N);
 441       end if;
 442
 443       return New_Name;
 444    end Process_Restriction_Synonyms;
 445
 446    ------------------------
 447    -- Restricted_Profile --
 448    ------------------------
 449
 450    function Restricted_Profile return Boolean is
 451    begin
 452       if Restricted_Profile_Cached then
 453          return Restricted_Profile_Result;
 454
 455       else
 456          Restricted_Profile_Result := True;
 457          Restricted_Profile_Cached := True;
 458
 459          declare
 460             R : Restriction_Flags  renames Profile_Info (Restricted).Set;
 461             V : Restriction_Values renames Profile_Info (Restricted).Value;
 462          begin
 463             for J in R'Range loop
 464                if R (J)
 465                  and then (Restrictions.Set (J) = False
 466                              or else Restriction_Warnings (J)
 467                              or else
 468                                (J in All_Parameter_Restrictions
 469                                   and then Restrictions.Value (J) > V (J)))
 470                then
 471                   Restricted_Profile_Result := False;
 472                   exit;
 473                end if;
 474             end loop;
 475
 476             return Restricted_Profile_Result;
 477          end;
 478       end if;
 479    end Restricted_Profile;
 480
 481    ------------------------
 482    -- Restriction_Active --
 483    ------------------------
 484
 485    function Restriction_Active (R : All_Restrictions) return Boolean is
 486    begin
 487       return Restrictions.Set (R) and then not Restriction_Warnings (R);
 488    end Restriction_Active;
 489
 490    ---------------------
 491    -- Restriction_Msg --
 492    ---------------------
 493
 494    procedure Restriction_Msg (Msg : String; R : String; N : Node_Id) is
 495       B : String (1 .. Msg'Length + 2 * R'Length + 1);
 496       P : Natural := 1;
 497
 498    begin
 499       Name_Buffer (1 .. R'Last) := R;
 500       Name_Len := R'Length;
 501       Set_Casing (Identifier_Casing (Get_Source_File_Index (Sloc (N))));
 502
 503       P := 0;
 504       for J in Msg'Range loop
 505          if Msg (J) = '%' then
 506             P := P + 1;
 507             B (P) := '`';
 508
 509             --  Put characters of image in message, quoting upper case letters
 510
 511             for J in 1 .. Name_Len loop
 512                if Name_Buffer (J) in 'A' .. 'Z' then
 513                   P := P + 1;
 514                   B (P) := ''';
 515                end if;
 516
 517                P := P + 1;
 518                B (P) := Name_Buffer (J);
 519             end loop;
 520
 521             P := P + 1;
 522             B (P) := '`';
 523
 524          else
 525             P := P + 1;
 526             B (P) := Msg (J);
 527          end if;
 528       end loop;
 529
 530       Error_Msg_N (B (1 .. P), N);
 531    end Restriction_Msg;
 532
 533    ---------------
 534    -- Same_Unit --
 535    ---------------
 536
 537    function Same_Unit (U1, U2 : Node_Id) return Boolean is
 538    begin
 539       if Nkind (U1) = N_Identifier then
 540          return Nkind (U2) = N_Identifier and then Chars (U1) = Chars (U2);
 541
 542       elsif Nkind (U2) = N_Identifier then
 543          return False;
 544
 545       elsif (Nkind (U1) = N_Selected_Component
 546              or else Nkind (U1) = N_Expanded_Name)
 547         and then
 548           (Nkind (U2) = N_Selected_Component
 549            or else Nkind (U2) = N_Expanded_Name)
 550       then
 551          return Same_Unit (Prefix (U1), Prefix (U2))
 552            and then Same_Unit (Selector_Name (U1), Selector_Name (U2));
 553       else
 554          return False;
 555       end if;
 556    end Same_Unit;
 557
 558    ------------------------------
 559    -- Set_Profile_Restrictions --
 560    ------------------------------
 561
 562    procedure Set_Profile_Restrictions
 563      (P    : Profile_Name;
 564       N    : Node_Id;
 565       Warn : Boolean)
 566    is
 567       R : Restriction_Flags  renames Profile_Info (P).Set;
 568       V : Restriction_Values renames Profile_Info (P).Value;
 569
 570    begin
 571       for J in R'Range loop
 572          if R (J) then
 573             declare
 574                Already_Restricted : constant Boolean := Restriction_Active (J);
 575
 576             begin
 577                --  Set the restriction
 578
 579                if J in All_Boolean_Restrictions then
 580                   Set_Restriction (J, N);
 581                else
 582                   Set_Restriction (J, N, V (J));
 583                end if;
 584
 585                --  Set warning flag, except that we do not set the warning
 586                --  flag if the restriction was already active and this is
 587                --  the warning case. That avoids a warning overriding a real
 588                --  restriction, which should never happen.
 589
 590                if not (Warn and Already_Restricted) then
 591                   Restriction_Warnings (J) := Warn;
 592                end if;
 593             end;
 594          end if;
 595       end loop;
 596    end Set_Profile_Restrictions;
 597
 598    ---------------------
 599    -- Set_Restriction --
 600    ---------------------
 601
 602    --  Case of Boolean restriction
 603
 604    procedure Set_Restriction
 605      (R : All_Boolean_Restrictions;
 606       N : Node_Id)
 607    is
 608    begin
 609       Restrictions.Set (R) := True;
 610
 611       if Restricted_Profile_Cached and Restricted_Profile_Result then
 612          null;
 613       else
 614          Restricted_Profile_Cached := False;
 615       end if;
 616
 617       --  Set location, but preserve location of system
 618       --  restriction for nice error msg with run time name
 619
 620       if Restrictions_Loc (R) /= System_Location then
 621          Restrictions_Loc (R) := Sloc (N);
 622       end if;
 623
 624       --  Record the restriction if we are in the main unit, or in the extended
 625       --  main unit. The reason that we test separately for Main_Unit is that
 626       --  gnat.adc is processed with Current_Sem_Unit = Main_Unit, but nodes in
 627       --  gnat.adc do not appear to be in the extended main source unit (they
 628       --  probably should do ???)
 629
 630       if Current_Sem_Unit = Main_Unit
 631         or else In_Extended_Main_Source_Unit (N)
 632       then
 633          if not Restriction_Warnings (R) then
 634             Main_Restrictions.Set (R) := True;
 635          end if;
 636       end if;
 637    end Set_Restriction;
 638
 639    --  Case of parameter restriction
 640
 641    procedure Set_Restriction
 642      (R : All_Parameter_Restrictions;
 643       N : Node_Id;
 644       V : Integer)
 645    is
 646    begin
 647       if Restricted_Profile_Cached and Restricted_Profile_Result then
 648          null;
 649       else
 650          Restricted_Profile_Cached := False;
 651       end if;
 652
 653       if Restrictions.Set (R) then
 654          if V < Restrictions.Value (R) then
 655             Restrictions.Value (R) := V;
 656             Restrictions_Loc (R) := Sloc (N);
 657          end if;
 658
 659       else
 660          Restrictions.Set (R) := True;
 661          Restrictions.Value (R) := V;
 662          Restrictions_Loc (R) := Sloc (N);
 663       end if;
 664
 665       --  Record the restriction if we are in the main unit,
 666       --  or in the extended main unit. The reason that we
 667       --  test separately for Main_Unit is that gnat.adc is
 668       --  processed with Current_Sem_Unit = Main_Unit, but
 669       --  nodes in gnat.adc do not appear to be the extended
 670       --  main source unit (they probably should do ???)
 671
 672       if Current_Sem_Unit = Main_Unit
 673         or else In_Extended_Main_Source_Unit (N)
 674       then
 675          if Main_Restrictions.Set (R) then
 676             if V < Main_Restrictions.Value (R) then
 677                Main_Restrictions.Value (R) := V;
 678             end if;
 679
 680          elsif not Restriction_Warnings (R) then
 681             Main_Restrictions.Set (R) := True;
 682             Main_Restrictions.Value (R) := V;
 683          end if;
 684       end if;
 685    end Set_Restriction;
 686
 687    -----------------------------------
 688    -- Set_Restriction_No_Dependence --
 689    -----------------------------------
 690
 691    procedure Set_Restriction_No_Dependence
 692      (Unit : Node_Id;
 693       Warn : Boolean)
 694    is
 695    begin
 696       --  Loop to check for duplicate entry
 697
 698       for J in No_Dependence.First .. No_Dependence.Last loop
 699
 700          --  Case of entry already in table
 701
 702          if Same_Unit (Unit, No_Dependence.Table (J).Unit) then
 703
 704             --  Error has precedence over warning
 705
 706             if not Warn then
 707                No_Dependence.Table (J).Warn := False;
 708             end if;
 709
 710             return;
 711          end if;
 712       end loop;
 713
 714       --  Entry is not currently in table
 715
 716       No_Dependence.Append ((Unit, Warn));
 717    end Set_Restriction_No_Dependence;
 718
 719    ----------------------------------
 720    -- Suppress_Restriction_Message --
 721    ----------------------------------
 722
 723    function Suppress_Restriction_Message (N : Node_Id) return Boolean is
 724    begin
 725       --  We only output messages for the extended main source unit
 726
 727       if In_Extended_Main_Source_Unit (N) then
 728          return False;
 729
 730       --  If loaded by rtsfind, then suppress message
 731
 732       elsif Sloc (N) <= No_Location then
 733          return True;
 734
 735       --  Otherwise suppress message if internal file
 736
 737       else
 738          return Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (N)));
 739       end if;
 740    end Suppress_Restriction_Message;
 741
 742    ---------------------
 743    -- Tasking_Allowed --
 744    ---------------------
 745
 746    function Tasking_Allowed return Boolean is
 747    begin
 748       return not Restrictions.Set (No_Tasking)
 749         and then (not Restrictions.Set (Max_Tasks)
 750                     or else Restrictions.Value (Max_Tasks) > 0);
 751    end Tasking_Allowed;
 752
 753 end Restrict;