1-- This file is covered by the Internet Software Consortium (ISC) License 2-- Reference: ../../License.txt 3 4package body AdaBase.Statement.Base is 5 6 ------------------ 7 -- successful -- 8 ------------------ 9 overriding 10 function successful (Stmt : Base_Statement) return Boolean 11 is 12 begin 13 return Stmt.successful_execution; 14 end successful; 15 16 17 ---------------------- 18 -- data_discarded -- 19 ---------------------- 20 overriding 21 function data_discarded (Stmt : Base_Statement) return Boolean 22 is 23 begin 24 return Stmt.rows_leftover; 25 end data_discarded; 26 27 28 --------------------- 29 -- rows_affected -- 30 --------------------- 31 overriding 32 function rows_affected (Stmt : Base_Statement) return Affected_Rows 33 is 34 begin 35 if not Stmt.successful_execution then 36 raise PRIOR_EXECUTION_FAILED 37 with "Has query been executed yet?"; 38 end if; 39 if Stmt.result_present then 40 raise INVALID_FOR_RESULT_SET 41 with "Result set found; use rows_returned"; 42 else 43 return Stmt.impacted; 44 end if; 45 end rows_affected; 46 47 48 --------------------- 49 -- transform_sql -- 50 --------------------- 51 function transform_sql (Stmt : out Base_Statement; sql : String) 52 return String 53 is 54 procedure reserve_marker; 55 56 sql_mask : String := CT.redact_quotes (sql); 57 58 procedure reserve_marker 59 is 60 brec : bindrec; 61 begin 62 brec.v00 := False; 63 Stmt.realmccoy.Append (New_Item => brec); 64 end reserve_marker; 65 66 begin 67 Stmt.alpha_markers.Clear; 68 Stmt.realmccoy.Clear; 69 70 if CT.IsBlank (sql) then 71 return ""; 72 end if; 73 74 declare 75 -- This block does two things: 76 -- 1) finds "?" and increments the replacement index 77 -- 2) finds ":[A-Za-z0-9_]*", replaces with "?", increments the 78 -- replacement index, and pushes the string into alpha markers 79 -- Normally ? and : aren't mixed but we will support it. 80 procedure replace_alias; 81 procedure lock_and_advance (symbol : Character); 82 83 start : Natural := 0; 84 final : Natural := 0; 85 arrow : Positive := 1; 86 polaris : Natural := 0; 87 scanning : Boolean := False; 88 product : String (1 .. sql'Length) := (others => ' '); 89 90 adjacent_error : constant String := 91 "Bindings are not separated; they are touching: "; 92 93 procedure lock_and_advance (symbol : Character) is 94 begin 95 polaris := polaris + 1; 96 product (polaris) := symbol; 97 end lock_and_advance; 98 99 procedure replace_alias is 100 len : Natural := final - start; 101 alias : String (1 .. len) := sql_mask (start + 1 .. final); 102 begin 103 if Stmt.alpha_markers.Contains (Key => alias) then 104 raise ILLEGAL_BIND_SQL with "multiple instances of " & alias; 105 end if; 106 reserve_marker; 107 Stmt.alpha_markers.Insert (alias, Stmt.realmccoy.Last_Index); 108 scanning := False; 109 end replace_alias; 110 111 begin 112 loop 113 case sql_mask (arrow) is 114 when ASCII.Query => 115 if scanning then 116 raise ILLEGAL_BIND_SQL 117 with adjacent_error & sql_mask (start .. arrow); 118 end if; 119 reserve_marker; 120 lock_and_advance (ASCII.Query); 121 when ASCII.Colon => 122 if scanning then 123 raise ILLEGAL_BIND_SQL 124 with adjacent_error & sql_mask (start .. arrow); 125 end if; 126 scanning := True; 127 start := arrow; 128 when others => 129 if scanning then 130 case sql_mask (arrow) is 131 when 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '_' => 132 final := arrow; 133 when others => 134 replace_alias; 135 lock_and_advance (ASCII.Query); 136 lock_and_advance (sql (arrow)); 137 end case; 138 else 139 lock_and_advance (sql (arrow)); 140 end if; 141 end case; 142 if scanning and then arrow = sql_mask'Length then 143 replace_alias; 144 lock_and_advance (ASCII.Query); 145 end if; 146 exit when arrow = sql_mask'Length; 147 arrow := arrow + 1; 148 end loop; 149 return product (1 .. polaris); 150 end; 151 end transform_sql; 152 153 154 ---------------------------------- 155 -- convert string to textwide -- 156 ---------------------------------- 157 function convert (nv : String) return AR.Textwide is 158 begin 159 return SUW.To_Unbounded_Wide_String (ACC.To_Wide_String (nv)); 160 end convert; 161 162 163 ----------------------------------- 164 -- convert string to textsuper -- 165 ----------------------------------- 166 function convert (nv : String) return AR.Textsuper is 167 begin 168 return SWW.To_Unbounded_Wide_Wide_String (ACC.To_Wide_Wide_String (nv)); 169 end convert; 170 171 172 -------------------- 173 -- Same_Strings -- 174 -------------------- 175 function Same_Strings (S, T : String) return Boolean is 176 begin 177 return S = T; 178 end Same_Strings; 179 180 181 ------------------- 182 -- log_nominal -- 183 ------------------- 184 procedure log_nominal (statement : Base_Statement; 185 category : Log_Category; 186 message : String) 187 is 188 begin 189 logger_access.all.log_nominal 190 (driver => statement.dialect, 191 category => category, 192 message => CT.SUS (message)); 193 end log_nominal; 194 195 196 -------------------- 197 -- bind_proceed -- 198 -------------------- 199 function bind_proceed (Stmt : Base_Statement; index : Positive) 200 return Boolean is 201 begin 202 if not Stmt.successful_execution then 203 raise PRIOR_EXECUTION_FAILED 204 with "Use bind after 'execute' but before 'fetch_next'"; 205 end if; 206 if index > Stmt.crate.Last_Index then 207 raise BINDING_COLUMN_NOT_FOUND 208 with "Index" & index'Img & " is too high; only" & 209 Stmt.crate.Last_Index'Img & " columns exist."; 210 end if; 211 return True; 212 end bind_proceed; 213 214 215 ------------------ 216 -- bind_index -- 217 ------------------ 218 function bind_index (Stmt : Base_Statement; heading : String) 219 return Positive 220 is 221 use type Markers.Cursor; 222 cursor : Markers.Cursor; 223 begin 224 cursor := Stmt.headings_map.Find (Key => heading); 225 if cursor = Markers.No_Element then 226 raise BINDING_COLUMN_NOT_FOUND with 227 "There is no column named '" & heading & "'."; 228 end if; 229 return Markers.Element (Position => cursor); 230 end bind_index; 231 232 233 --------------------------------- 234 -- check_bound_column_access -- 235 --------------------------------- 236 procedure check_bound_column_access (absent : Boolean) is 237 begin 238 if absent then 239 raise ILLEGAL_BIND_SQL with 240 "Binding column with null access is illegal"; 241 end if; 242 end check_bound_column_access; 243 244 245 ------------------------------------------------------ 246 -- 23 bind functions (impossible to make generic) -- 247 ------------------------------------------------------ 248 procedure bind (Stmt : out Base_Statement; 249 index : Positive; 250 vaxx : AR.NByte0_Access) 251 is 252 use type AR.NByte0_Access; 253 absent : Boolean := (vaxx = null); 254 begin 255 check_bound_column_access (absent); 256 if Stmt.bind_proceed (index => index) then 257 Stmt.crate.Replace_Element 258 (index, (output_type => ft_nbyte0, a00 => vaxx, v00 => False, 259 bound => True, null_data => False)); 260 end if; 261 end bind; 262 263 procedure bind (Stmt : out Base_Statement; 264 index : Positive; 265 vaxx : AR.NByte1_Access) 266 is 267 use type AR.NByte1_Access; 268 absent : Boolean := (vaxx = null); 269 begin 270 check_bound_column_access (absent); 271 if Stmt.bind_proceed (index => index) then 272 Stmt.crate.Replace_Element 273 (index, (output_type => ft_nbyte1, a01 => vaxx, v01 => 0, 274 bound => True, null_data => False)); 275 end if; 276 end bind; 277 278 procedure bind (Stmt : out Base_Statement; 279 index : Positive; 280 vaxx : AR.NByte2_Access) 281 is 282 use type AR.NByte2_Access; 283 absent : Boolean := (vaxx = null); 284 begin 285 check_bound_column_access (absent); 286 if Stmt.bind_proceed (index => index) then 287 Stmt.crate.Replace_Element 288 (index, (output_type => ft_nbyte2, a02 => vaxx, v02 => 0, 289 bound => True, null_data => False)); 290 end if; 291 end bind; 292 293 procedure bind (Stmt : out Base_Statement; 294 index : Positive; 295 vaxx : AR.NByte3_Access) 296 is 297 use type AR.NByte3_Access; 298 absent : Boolean := (vaxx = null); 299 begin 300 check_bound_column_access (absent); 301 if Stmt.bind_proceed (index => index) then 302 Stmt.crate.Replace_Element 303 (index, (output_type => ft_nbyte3, a03 => vaxx, v03 => 0, 304 bound => True, null_data => False)); 305 end if; 306 end bind; 307 308 procedure bind (Stmt : out Base_Statement; 309 index : Positive; 310 vaxx : AR.NByte4_Access) 311 is 312 use type AR.NByte4_Access; 313 absent : Boolean := (vaxx = null); 314 begin 315 check_bound_column_access (absent); 316 if Stmt.bind_proceed (index => index) then 317 Stmt.crate.Replace_Element 318 (index, (output_type => ft_nbyte4, a04 => vaxx, v04 => 0, 319 bound => True, null_data => False)); 320 end if; 321 end bind; 322 323 procedure bind (Stmt : out Base_Statement; 324 index : Positive; 325 vaxx : AR.NByte8_Access) 326 is 327 use type AR.NByte8_Access; 328 absent : Boolean := (vaxx = null); 329 begin 330 check_bound_column_access (absent); 331 if Stmt.bind_proceed (index => index) then 332 Stmt.crate.Replace_Element 333 (index, (output_type => ft_nbyte8, a05 => vaxx, v05 => 0, 334 bound => True, null_data => False)); 335 end if; 336 end bind; 337 338 procedure bind (Stmt : out Base_Statement; 339 index : Positive; 340 vaxx : AR.Byte1_Access) 341 is 342 use type AR.Byte1_Access; 343 absent : Boolean := (vaxx = null); 344 begin 345 check_bound_column_access (absent); 346 if Stmt.bind_proceed (index => index) then 347 Stmt.crate.Replace_Element 348 (index, (output_type => ft_byte1, a06 => vaxx, v06 => 0, 349 bound => True, null_data => False)); 350 end if; 351 end bind; 352 353 procedure bind (Stmt : out Base_Statement; 354 index : Positive; 355 vaxx : AR.Byte2_Access) 356 is 357 use type AR.Byte2_Access; 358 absent : Boolean := (vaxx = null); 359 begin 360 check_bound_column_access (absent); 361 if Stmt.bind_proceed (index => index) then 362 Stmt.crate.Replace_Element 363 (index, (output_type => ft_byte2, a07 => vaxx, v07 => 0, 364 bound => True, null_data => False)); 365 end if; 366 end bind; 367 368 procedure bind (Stmt : out Base_Statement; 369 index : Positive; 370 vaxx : AR.Byte3_Access) 371 is 372 use type AR.Byte3_Access; 373 absent : Boolean := (vaxx = null); 374 begin 375 check_bound_column_access (absent); 376 if Stmt.bind_proceed (index => index) then 377 Stmt.crate.Replace_Element 378 (index, (output_type => ft_byte3, a08 => vaxx, v08 => 0, 379 bound => True, null_data => False)); 380 end if; 381 end bind; 382 383 procedure bind (Stmt : out Base_Statement; 384 index : Positive; 385 vaxx : AR.Byte4_Access) 386 is 387 use type AR.Byte4_Access; 388 absent : Boolean := (vaxx = null); 389 begin 390 check_bound_column_access (absent); 391 if Stmt.bind_proceed (index => index) then 392 Stmt.crate.Replace_Element 393 (index, (output_type => ft_byte4, a09 => vaxx, v09 => 0, 394 bound => True, null_data => False)); 395 end if; 396 end bind; 397 398 procedure bind (Stmt : out Base_Statement; 399 index : Positive; 400 vaxx : AR.Byte8_Access) 401 is 402 use type AR.Byte8_Access; 403 absent : Boolean := (vaxx = null); 404 begin 405 check_bound_column_access (absent); 406 if Stmt.bind_proceed (index => index) then 407 Stmt.crate.Replace_Element 408 (index, (output_type => ft_byte8, a10 => vaxx, v10 => 0, 409 bound => True, null_data => False)); 410 end if; 411 end bind; 412 413 procedure bind (Stmt : out Base_Statement; 414 index : Positive; 415 vaxx : AR.Real9_Access) 416 is 417 use type AR.Real9_Access; 418 absent : Boolean := (vaxx = null); 419 begin 420 check_bound_column_access (absent); 421 if Stmt.bind_proceed (index => index) then 422 Stmt.crate.Replace_Element 423 (index, (output_type => ft_real9, a11 => vaxx, v11 => 0.0, 424 bound => True, null_data => False)); 425 end if; 426 end bind; 427 428 procedure bind (Stmt : out Base_Statement; 429 index : Positive; 430 vaxx : AR.Real18_Access) 431 is 432 use type AR.Real18_Access; 433 absent : Boolean := (vaxx = null); 434 begin 435 check_bound_column_access (absent); 436 if Stmt.bind_proceed (index => index) then 437 Stmt.crate.Replace_Element 438 (index, (output_type => ft_real18, a12 => vaxx, v12 => 0.0, 439 bound => True, null_data => False)); 440 end if; 441 end bind; 442 443 procedure bind (Stmt : out Base_Statement; 444 index : Positive; 445 vaxx : AR.Str1_Access) 446 is 447 use type AR.Str1_Access; 448 absent : Boolean := (vaxx = null); 449 begin 450 check_bound_column_access (absent); 451 if Stmt.bind_proceed (index => index) then 452 Stmt.crate.Replace_Element 453 (index, (output_type => ft_textual, a13 => vaxx, v13 => CT.blank, 454 bound => True, null_data => False)); 455 end if; 456 end bind; 457 458 procedure bind (Stmt : out Base_Statement; 459 index : Positive; 460 vaxx : AR.Str2_Access) 461 is 462 use type AR.Str2_Access; 463 absent : Boolean := (vaxx = null); 464 begin 465 check_bound_column_access (absent); 466 if Stmt.bind_proceed (index => index) then 467 Stmt.crate.Replace_Element 468 (index, (output_type => ft_widetext, a14 => vaxx, bound => True, 469 v14 => AR.Blank_WString, null_data => False)); 470 end if; 471 end bind; 472 473 procedure bind (Stmt : out Base_Statement; 474 index : Positive; 475 vaxx : AR.Str4_Access) 476 is 477 use type AR.Str4_Access; 478 absent : Boolean := (vaxx = null); 479 begin 480 check_bound_column_access (absent); 481 if Stmt.bind_proceed (index => index) then 482 Stmt.crate.Replace_Element 483 (index, (output_type => ft_supertext, a15 => vaxx, bound => True, 484 v15 => AR.Blank_WWString, null_data => False)); 485 end if; 486 end bind; 487 488 procedure bind (Stmt : out Base_Statement; 489 index : Positive; 490 vaxx : AR.Time_Access) 491 is 492 use type AR.Time_Access; 493 absent : Boolean := (vaxx = null); 494 begin 495 check_bound_column_access (absent); 496 if Stmt.bind_proceed (index => index) then 497 Stmt.crate.Replace_Element 498 (index, (output_type => ft_timestamp, a16 => vaxx, 499 v16 => CAL.Clock, bound => True, null_data => False)); 500 end if; 501 end bind; 502 503 procedure bind (Stmt : out Base_Statement; 504 index : Positive; 505 vaxx : AR.Chain_Access) 506 is 507 use type AR.Chain_Access; 508 absent : Boolean := (vaxx = null); 509 begin 510 check_bound_column_access (absent); 511 if Stmt.bind_proceed (index => index) then 512 Stmt.crate.Replace_Element 513 (index, (output_type => ft_chain, a17 => vaxx, 514 v17 => CT.blank, bound => True, null_data => False)); 515 end if; 516 end bind; 517 518 procedure bind (Stmt : out Base_Statement; 519 index : Positive; 520 vaxx : AR.Enum_Access) 521 is 522 use type AR.Enum_Access; 523 absent : Boolean := (vaxx = null); 524 begin 525 check_bound_column_access (absent); 526 if Stmt.bind_proceed (index => index) then 527 Stmt.crate.Replace_Element 528 (index, (output_type => ft_enumtype, a18 => vaxx, bound => True, 529 v18 => AR.PARAM_IS_ENUM, null_data => False)); 530 end if; 531 end bind; 532 533 procedure bind (Stmt : out Base_Statement; 534 index : Positive; 535 vaxx : AR.Settype_Access) 536 is 537 use type AR.Settype_Access; 538 absent : Boolean := (vaxx = null); 539 begin 540 check_bound_column_access (absent); 541 if Stmt.bind_proceed (index => index) then 542 Stmt.crate.Replace_Element 543 (index, (output_type => ft_settype, a19 => vaxx, 544 v19 => CT.blank, bound => True, null_data => False)); 545 end if; 546 end bind; 547 548 procedure bind (Stmt : out Base_Statement; 549 index : Positive; 550 vaxx : AR.Bits_Access) 551 is 552 use type AR.Bits_Access; 553 absent : Boolean := (vaxx = null); 554 begin 555 check_bound_column_access (absent); 556 if Stmt.bind_proceed (index => index) then 557 Stmt.crate.Replace_Element 558 (index, (output_type => ft_bits, a20 => vaxx, 559 v20 => CT.blank, bound => True, null_data => False)); 560 end if; 561 end bind; 562 563 procedure bind (Stmt : out Base_Statement; 564 index : Positive; 565 vaxx : AR.S_UTF8_Access) 566 is 567 use type AR.S_UTF8_Access; 568 absent : Boolean := (vaxx = null); 569 begin 570 check_bound_column_access (absent); 571 if Stmt.bind_proceed (index => index) then 572 Stmt.crate.Replace_Element 573 (index, (output_type => ft_utf8, a21 => vaxx, 574 v21 => CT.blank, bound => True, null_data => False)); 575 end if; 576 end bind; 577 578 procedure bind (Stmt : out Base_Statement; 579 index : Positive; 580 vaxx : AR.Geometry_Access) 581 is 582 use type AR.Geometry_Access; 583 absent : Boolean := (vaxx = null); 584 begin 585 check_bound_column_access (absent); 586 if Stmt.bind_proceed (index => index) then 587 Stmt.crate.Replace_Element 588 (index, (output_type => ft_geometry, a22 => vaxx, 589 v22 => CT.blank, bound => True, null_data => False)); 590 end if; 591 end bind; 592 593 594 ------------------------------------------------------------------ 595 -- bind via headings (believe me, generics are not possible) -- 596 ------------------------------------------------------------------ 597 procedure bind (Stmt : out Base_Statement; 598 heading : String; 599 vaxx : AR.NByte0_Access) is 600 begin 601 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 602 end bind; 603 604 procedure bind (Stmt : out Base_Statement; 605 heading : String; 606 vaxx : AR.NByte1_Access) is 607 begin 608 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 609 end bind; 610 611 procedure bind (Stmt : out Base_Statement; 612 heading : String; 613 vaxx : AR.NByte2_Access) is 614 begin 615 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 616 end bind; 617 618 procedure bind (Stmt : out Base_Statement; 619 heading : String; 620 vaxx : AR.NByte3_Access) is 621 begin 622 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 623 end bind; 624 625 procedure bind (Stmt : out Base_Statement; 626 heading : String; 627 vaxx : AR.NByte4_Access) is 628 begin 629 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 630 end bind; 631 632 procedure bind (Stmt : out Base_Statement; 633 heading : String; 634 vaxx : AR.NByte8_Access) is 635 begin 636 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 637 end bind; 638 639 procedure bind (Stmt : out Base_Statement; 640 heading : String; 641 vaxx : AR.Byte1_Access) is 642 begin 643 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 644 end bind; 645 646 procedure bind (Stmt : out Base_Statement; 647 heading : String; 648 vaxx : AR.Byte2_Access) is 649 begin 650 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 651 end bind; 652 653 procedure bind (Stmt : out Base_Statement; 654 heading : String; 655 vaxx : AR.Byte3_Access) is 656 begin 657 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 658 end bind; 659 660 procedure bind (Stmt : out Base_Statement; 661 heading : String; 662 vaxx : AR.Byte4_Access) is 663 begin 664 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 665 end bind; 666 667 procedure bind (Stmt : out Base_Statement; 668 heading : String; 669 vaxx : AR.Byte8_Access) is 670 begin 671 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 672 end bind; 673 674 procedure bind (Stmt : out Base_Statement; 675 heading : String; 676 vaxx : AR.Real9_Access) is 677 begin 678 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 679 end bind; 680 681 procedure bind (Stmt : out Base_Statement; 682 heading : String; 683 vaxx : AR.Real18_Access) is 684 begin 685 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 686 end bind; 687 688 procedure bind (Stmt : out Base_Statement; 689 heading : String; 690 vaxx : AR.Str1_Access) is 691 begin 692 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 693 end bind; 694 695 procedure bind (Stmt : out Base_Statement; 696 heading : String; 697 vaxx : AR.Str2_Access) is 698 begin 699 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 700 end bind; 701 702 procedure bind (Stmt : out Base_Statement; 703 heading : String; 704 vaxx : AR.Str4_Access) is 705 begin 706 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 707 end bind; 708 709 procedure bind (Stmt : out Base_Statement; 710 heading : String; 711 vaxx : AR.Time_Access) is 712 begin 713 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 714 end bind; 715 716 procedure bind (Stmt : out Base_Statement; 717 heading : String; 718 vaxx : AR.Chain_Access) is 719 begin 720 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 721 end bind; 722 723 procedure bind (Stmt : out Base_Statement; 724 heading : String; 725 vaxx : AR.Enum_Access) is 726 begin 727 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 728 end bind; 729 730 procedure bind (Stmt : out Base_Statement; 731 heading : String; 732 vaxx : AR.Settype_Access) is 733 begin 734 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 735 end bind; 736 737 procedure bind (Stmt : out Base_Statement; 738 heading : String; 739 vaxx : AR.Bits_Access) is 740 begin 741 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 742 end bind; 743 744 procedure bind (Stmt : out Base_Statement; 745 heading : String; 746 vaxx : AR.S_UTF8_Access) is 747 begin 748 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 749 end bind; 750 751 procedure bind (Stmt : out Base_Statement; 752 heading : String; 753 vaxx : AR.Geometry_Access) is 754 begin 755 Stmt.bind (vaxx => vaxx, index => Stmt.bind_index (heading)); 756 end bind; 757 758 759 -------------------- 760 -- assign_index -- 761 -------------------- 762 function assign_index (Stmt : Base_Statement; moniker : String) 763 return Positive 764 is 765 use type Markers.Cursor; 766 cursor : Markers.Cursor; 767 begin 768 cursor := Stmt.alpha_markers.Find (Key => moniker); 769 if cursor = Markers.No_Element then 770 raise MARKER_NOT_FOUND with 771 "There is no marker known as '" & moniker & "'."; 772 end if; 773 return Markers.Element (Position => cursor); 774 end assign_index; 775 776 777 ------------------------------------------------------------------ 778 -- assign via moniker (Access, 23) -- 779 ------------------------------------------------------------------ 780 procedure assign (Stmt : out Base_Statement; 781 moniker : String; 782 vaxx : AR.NByte0_Access) is 783 begin 784 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 785 end assign; 786 787 procedure assign (Stmt : out Base_Statement; 788 moniker : String; 789 vaxx : AR.NByte1_Access) is 790 begin 791 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 792 end assign; 793 794 procedure assign (Stmt : out Base_Statement; 795 moniker : String; 796 vaxx : AR.NByte2_Access) is 797 begin 798 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 799 end assign; 800 801 procedure assign (Stmt : out Base_Statement; 802 moniker : String; 803 vaxx : AR.NByte3_Access) is 804 begin 805 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 806 end assign; 807 808 procedure assign (Stmt : out Base_Statement; 809 moniker : String; 810 vaxx : AR.NByte4_Access) is 811 begin 812 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 813 end assign; 814 815 procedure assign (Stmt : out Base_Statement; 816 moniker : String; 817 vaxx : AR.NByte8_Access) is 818 begin 819 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 820 end assign; 821 822 procedure assign (Stmt : out Base_Statement; 823 moniker : String; 824 vaxx : AR.Byte1_Access) is 825 begin 826 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 827 end assign; 828 829 procedure assign (Stmt : out Base_Statement; 830 moniker : String; 831 vaxx : AR.Byte2_Access) is 832 begin 833 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 834 end assign; 835 836 procedure assign (Stmt : out Base_Statement; 837 moniker : String; 838 vaxx : AR.Byte3_Access) is 839 begin 840 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 841 end assign; 842 843 procedure assign (Stmt : out Base_Statement; 844 moniker : String; 845 vaxx : AR.Byte4_Access) is 846 begin 847 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 848 end assign; 849 850 procedure assign (Stmt : out Base_Statement; 851 moniker : String; 852 vaxx : AR.Byte8_Access) is 853 begin 854 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 855 end assign; 856 857 procedure assign (Stmt : out Base_Statement; 858 moniker : String; 859 vaxx : AR.Real9_Access) is 860 begin 861 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 862 end assign; 863 864 procedure assign (Stmt : out Base_Statement; 865 moniker : String; 866 vaxx : AR.Real18_Access) is 867 begin 868 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 869 end assign; 870 871 procedure assign (Stmt : out Base_Statement; 872 moniker : String; 873 vaxx : AR.Str1_Access) is 874 begin 875 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 876 end assign; 877 878 procedure assign (Stmt : out Base_Statement; 879 moniker : String; 880 vaxx : AR.Str2_Access) is 881 begin 882 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 883 end assign; 884 885 procedure assign (Stmt : out Base_Statement; 886 moniker : String; 887 vaxx : AR.Str4_Access) is 888 begin 889 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 890 end assign; 891 892 procedure assign (Stmt : out Base_Statement; 893 moniker : String; 894 vaxx : AR.Time_Access) is 895 begin 896 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 897 end assign; 898 899 procedure assign (Stmt : out Base_Statement; 900 moniker : String; 901 vaxx : AR.Chain_Access) is 902 begin 903 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 904 end assign; 905 906 procedure assign (Stmt : out Base_Statement; 907 moniker : String; 908 vaxx : AR.Enum_Access) is 909 begin 910 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 911 end assign; 912 913 procedure assign (Stmt : out Base_Statement; 914 moniker : String; 915 vaxx : AR.Settype_Access) is 916 begin 917 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 918 end assign; 919 920 procedure assign (Stmt : out Base_Statement; 921 moniker : String; 922 vaxx : AR.Bits_Access) is 923 begin 924 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 925 end assign; 926 927 928 procedure assign (Stmt : out Base_Statement; 929 moniker : String; 930 vaxx : AR.S_UTF8_Access) is 931 begin 932 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 933 end assign; 934 935 procedure assign (Stmt : out Base_Statement; 936 moniker : String; 937 vaxx : AR.Geometry_Access) is 938 begin 939 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 940 end assign; 941 942 943 ------------------------------------------------------------------ 944 -- assign via moniker (Value, 23) -- 945 ------------------------------------------------------------------ 946 procedure assign (Stmt : out Base_Statement; 947 moniker : String; 948 vaxx : AR.NByte0) is 949 begin 950 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 951 end assign; 952 953 procedure assign (Stmt : out Base_Statement; 954 moniker : String; 955 vaxx : AR.NByte1) is 956 begin 957 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 958 end assign; 959 960 procedure assign (Stmt : out Base_Statement; 961 moniker : String; 962 vaxx : AR.NByte2) is 963 begin 964 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 965 end assign; 966 967 procedure assign (Stmt : out Base_Statement; 968 moniker : String; 969 vaxx : AR.NByte3) is 970 begin 971 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 972 end assign; 973 974 procedure assign (Stmt : out Base_Statement; 975 moniker : String; 976 vaxx : AR.NByte4) is 977 begin 978 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 979 end assign; 980 981 procedure assign (Stmt : out Base_Statement; 982 moniker : String; 983 vaxx : AR.NByte8) is 984 begin 985 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 986 end assign; 987 988 procedure assign (Stmt : out Base_Statement; 989 moniker : String; 990 vaxx : AR.Byte1) is 991 begin 992 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 993 end assign; 994 995 procedure assign (Stmt : out Base_Statement; 996 moniker : String; 997 vaxx : AR.Byte2) is 998 begin 999 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1000 end assign; 1001 1002 procedure assign (Stmt : out Base_Statement; 1003 moniker : String; 1004 vaxx : AR.Byte3) is 1005 begin 1006 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1007 end assign; 1008 1009 procedure assign (Stmt : out Base_Statement; 1010 moniker : String; 1011 vaxx : AR.Byte4) is 1012 begin 1013 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1014 end assign; 1015 1016 procedure assign (Stmt : out Base_Statement; 1017 moniker : String; 1018 vaxx : AR.Byte8) is 1019 begin 1020 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1021 end assign; 1022 1023 procedure assign (Stmt : out Base_Statement; 1024 moniker : String; 1025 vaxx : AR.Real9) is 1026 begin 1027 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1028 end assign; 1029 1030 procedure assign (Stmt : out Base_Statement; 1031 moniker : String; 1032 vaxx : AR.Real18) is 1033 begin 1034 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1035 end assign; 1036 1037 procedure assign (Stmt : out Base_Statement; 1038 moniker : String; 1039 vaxx : AR.Textual) is 1040 begin 1041 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1042 end assign; 1043 1044 procedure assign (Stmt : out Base_Statement; 1045 moniker : String; 1046 vaxx : AR.Textwide) is 1047 begin 1048 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1049 end assign; 1050 1051 procedure assign (Stmt : out Base_Statement; 1052 moniker : String; 1053 vaxx : AR.Textsuper) is 1054 begin 1055 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1056 end assign; 1057 1058 procedure assign (Stmt : out Base_Statement; 1059 moniker : String; 1060 vaxx : CAL.Time) is 1061 begin 1062 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1063 end assign; 1064 1065 procedure assign (Stmt : out Base_Statement; 1066 moniker : String; 1067 vaxx : AR.Chain) is 1068 begin 1069 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1070 end assign; 1071 1072 procedure assign (Stmt : out Base_Statement; 1073 moniker : String; 1074 vaxx : AR.Enumtype) is 1075 begin 1076 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1077 end assign; 1078 1079 procedure assign (Stmt : out Base_Statement; 1080 moniker : String; 1081 vaxx : AR.Settype) is 1082 begin 1083 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1084 end assign; 1085 1086 procedure assign (Stmt : out Base_Statement; 1087 moniker : String; 1088 vaxx : AR.Bits) is 1089 begin 1090 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1091 end assign; 1092 1093 procedure assign (Stmt : out Base_Statement; 1094 moniker : String; 1095 vaxx : AR.Text_UTF8) is 1096 begin 1097 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1098 end assign; 1099 1100 procedure assign (Stmt : out Base_Statement; 1101 moniker : String; 1102 vaxx : Spatial_Data.Geometry) is 1103 begin 1104 Stmt.assign (vaxx => vaxx, index => Stmt.assign_index (moniker)); 1105 end assign; 1106 1107 1108 ------------------------------------------------------ 1109 -- 23 + 23 = 46 assign functions -- 1110 ------------------------------------------------------ 1111 procedure assign (Stmt : out Base_Statement; 1112 index : Positive; 1113 vaxx : AR.NByte0_Access) 1114 is 1115 use type AR.NByte0_Access; 1116 absent : Boolean := (vaxx = null); 1117 begin 1118 Stmt.realmccoy.Replace_Element 1119 (index, (output_type => ft_nbyte0, a00 => vaxx, v00 => False, 1120 bound => True, null_data => absent)); 1121 end assign; 1122 1123 procedure assign (Stmt : out Base_Statement; 1124 index : Positive; 1125 vaxx : AR.NByte0) is 1126 begin 1127 Stmt.realmccoy.Replace_Element 1128 (index, (output_type => ft_nbyte0, a00 => null, v00 => vaxx, 1129 bound => True, null_data => False)); 1130 end assign; 1131 1132 procedure assign (Stmt : out Base_Statement; 1133 index : Positive; 1134 vaxx : AR.NByte1_Access) 1135 is 1136 use type AR.NByte1_Access; 1137 absent : Boolean := (vaxx = null); 1138 begin 1139 Stmt.realmccoy.Replace_Element 1140 (index, (output_type => ft_nbyte1, a01 => vaxx, v01 => 0, 1141 bound => True, null_data => absent)); 1142 end assign; 1143 1144 procedure assign (Stmt : out Base_Statement; 1145 index : Positive; 1146 vaxx : AR.NByte1) is 1147 begin 1148 Stmt.realmccoy.Replace_Element 1149 (index, (output_type => ft_nbyte1, a01 => null, v01 => vaxx, 1150 bound => True, null_data => False)); 1151 end assign; 1152 1153 procedure assign (Stmt : out Base_Statement; 1154 index : Positive; 1155 vaxx : AR.NByte2_Access) 1156 is 1157 use type AR.NByte2_Access; 1158 absent : Boolean := (vaxx = null); 1159 begin 1160 Stmt.realmccoy.Replace_Element 1161 (index, (output_type => ft_nbyte2, a02 => vaxx, v02 => 0, 1162 bound => True, null_data => absent)); 1163 end assign; 1164 1165 procedure assign (Stmt : out Base_Statement; 1166 index : Positive; 1167 vaxx : AR.NByte2) is 1168 begin 1169 Stmt.realmccoy.Replace_Element 1170 (index, (output_type => ft_nbyte2, a02 => null, v02 => vaxx, 1171 bound => True, null_data => False)); 1172 end assign; 1173 1174 procedure assign (Stmt : out Base_Statement; 1175 index : Positive; 1176 vaxx : AR.NByte3_Access) 1177 is 1178 use type AR.NByte3_Access; 1179 absent : Boolean := (vaxx = null); 1180 begin 1181 Stmt.realmccoy.Replace_Element 1182 (index, (output_type => ft_nbyte3, a03 => vaxx, v03 => 0, 1183 bound => True, null_data => absent)); 1184 end assign; 1185 1186 procedure assign (Stmt : out Base_Statement; 1187 index : Positive; 1188 vaxx : AR.NByte3) is 1189 begin 1190 Stmt.realmccoy.Replace_Element 1191 (index, (output_type => ft_nbyte3, a03 => null, v03 => vaxx, 1192 bound => True, null_data => False)); 1193 end assign; 1194 1195 procedure assign (Stmt : out Base_Statement; 1196 index : Positive; 1197 vaxx : AR.NByte4_Access) 1198 is 1199 use type AR.NByte4_Access; 1200 absent : Boolean := (vaxx = null); 1201 begin 1202 Stmt.realmccoy.Replace_Element 1203 (index, (output_type => ft_nbyte4, a04 => vaxx, v04 => 0, 1204 bound => True, null_data => absent)); 1205 end assign; 1206 1207 procedure assign (Stmt : out Base_Statement; 1208 index : Positive; 1209 vaxx : AR.NByte4) is 1210 begin 1211 Stmt.realmccoy.Replace_Element 1212 (index, (output_type => ft_nbyte4, a04 => null, v04 => vaxx, 1213 bound => True, null_data => False)); 1214 end assign; 1215 1216 procedure assign (Stmt : out Base_Statement; 1217 index : Positive; 1218 vaxx : AR.NByte8_Access) 1219 is 1220 use type AR.NByte8_Access; 1221 absent : Boolean := (vaxx = null); 1222 begin 1223 Stmt.realmccoy.Replace_Element 1224 (index, (output_type => ft_nbyte8, a05 => vaxx, v05 => 0, 1225 bound => True, null_data => absent)); 1226 end assign; 1227 1228 procedure assign (Stmt : out Base_Statement; 1229 index : Positive; 1230 vaxx : AR.NByte8) is 1231 begin 1232 Stmt.realmccoy.Replace_Element 1233 (index, (output_type => ft_nbyte8, a05 => null, v05 => vaxx, 1234 bound => True, null_data => False)); 1235 end assign; 1236 1237 procedure assign (Stmt : out Base_Statement; 1238 index : Positive; 1239 vaxx : AR.Byte1_Access) 1240 is 1241 use type AR.Byte1_Access; 1242 absent : Boolean := (vaxx = null); 1243 begin 1244 Stmt.realmccoy.Replace_Element 1245 (index, (output_type => ft_byte1, a06 => vaxx, v06 => 0, 1246 bound => True, null_data => absent)); 1247 end assign; 1248 1249 procedure assign (Stmt : out Base_Statement; 1250 index : Positive; 1251 vaxx : AR.Byte1) is 1252 begin 1253 Stmt.realmccoy.Replace_Element 1254 (index, (output_type => ft_byte1, a06 => null, v06 => vaxx, 1255 bound => True, null_data => False)); 1256 end assign; 1257 1258 procedure assign (Stmt : out Base_Statement; 1259 index : Positive; 1260 vaxx : AR.Byte2_Access) 1261 is 1262 use type AR.Byte2_Access; 1263 absent : Boolean := (vaxx = null); 1264 begin 1265 Stmt.realmccoy.Replace_Element 1266 (index, (output_type => ft_byte2, a07 => vaxx, v07 => 0, 1267 bound => True, null_data => absent)); 1268 end assign; 1269 1270 procedure assign (Stmt : out Base_Statement; 1271 index : Positive; 1272 vaxx : AR.Byte2) is 1273 begin 1274 Stmt.realmccoy.Replace_Element 1275 (index, (output_type => ft_byte2, a07 => null, v07 => vaxx, 1276 bound => True, null_data => False)); 1277 end assign; 1278 1279 procedure assign (Stmt : out Base_Statement; 1280 index : Positive; 1281 vaxx : AR.Byte3_Access) 1282 is 1283 use type AR.Byte3_Access; 1284 absent : Boolean := (vaxx = null); 1285 begin 1286 Stmt.realmccoy.Replace_Element 1287 (index, (output_type => ft_byte3, a08 => vaxx, v08 => 0, 1288 bound => True, null_data => absent)); 1289 end assign; 1290 1291 procedure assign (Stmt : out Base_Statement; 1292 index : Positive; 1293 vaxx : AR.Byte3) is 1294 begin 1295 Stmt.realmccoy.Replace_Element 1296 (index, (output_type => ft_byte3, a08 => null, v08 => vaxx, 1297 bound => True, null_data => False)); 1298 end assign; 1299 1300 procedure assign (Stmt : out Base_Statement; 1301 index : Positive; 1302 vaxx : AR.Byte4_Access) 1303 is 1304 use type AR.Byte4_Access; 1305 absent : Boolean := (vaxx = null); 1306 begin 1307 Stmt.realmccoy.Replace_Element 1308 (index, (output_type => ft_byte4, a09 => vaxx, v09 => 0, 1309 bound => True, null_data => absent)); 1310 end assign; 1311 1312 procedure assign (Stmt : out Base_Statement; 1313 index : Positive; 1314 vaxx : AR.Byte4) is 1315 begin 1316 Stmt.realmccoy.Replace_Element 1317 (index, (output_type => ft_byte4, a09 => null, v09 => vaxx, 1318 bound => True, null_data => False)); 1319 end assign; 1320 1321 procedure assign (Stmt : out Base_Statement; 1322 index : Positive; 1323 vaxx : AR.Byte8_Access) 1324 is 1325 use type AR.Byte8_Access; 1326 absent : Boolean := (vaxx = null); 1327 begin 1328 Stmt.realmccoy.Replace_Element 1329 (index, (output_type => ft_byte8, a10 => vaxx, v10 => 0, 1330 bound => True, null_data => absent)); 1331 end assign; 1332 1333 procedure assign (Stmt : out Base_Statement; 1334 index : Positive; 1335 vaxx : AR.Byte8) is 1336 begin 1337 Stmt.realmccoy.Replace_Element 1338 (index, (output_type => ft_byte8, a10 => null, v10 => vaxx, 1339 bound => True, null_data => False)); 1340 end assign; 1341 1342 procedure assign (Stmt : out Base_Statement; 1343 index : Positive; 1344 vaxx : AR.Real9_Access) 1345 is 1346 use type AR.Real9_Access; 1347 absent : Boolean := (vaxx = null); 1348 begin 1349 Stmt.realmccoy.Replace_Element 1350 (index, (output_type => ft_real9, a11 => vaxx, v11 => 0.0, 1351 bound => True, null_data => absent)); 1352 end assign; 1353 1354 procedure assign (Stmt : out Base_Statement; 1355 index : Positive; 1356 vaxx : AR.Real9) is 1357 begin 1358 Stmt.realmccoy.Replace_Element 1359 (index, (output_type => ft_real9, a11 => null, v11 => vaxx, 1360 bound => True, null_data => False)); 1361 end assign; 1362 1363 procedure assign (Stmt : out Base_Statement; 1364 index : Positive; 1365 vaxx : AR.Real18_Access) 1366 is 1367 use type AR.Real18_Access; 1368 absent : Boolean := (vaxx = null); 1369 begin 1370 Stmt.realmccoy.Replace_Element 1371 (index, (output_type => ft_real18, a12 => vaxx, v12 => 0.0, 1372 bound => True, null_data => absent)); 1373 end assign; 1374 1375 procedure assign (Stmt : out Base_Statement; 1376 index : Positive; 1377 vaxx : AR.Real18) is 1378 begin 1379 Stmt.realmccoy.Replace_Element 1380 (index, (output_type => ft_real18, a12 => null, v12 => vaxx, 1381 bound => True, null_data => False)); 1382 end assign; 1383 1384 procedure assign (Stmt : out Base_Statement; 1385 index : Positive; 1386 vaxx : AR.Str1_Access) 1387 is 1388 use type AR.Str1_Access; 1389 absent : Boolean := (vaxx = null); 1390 begin 1391 Stmt.realmccoy.Replace_Element 1392 (index, (output_type => ft_textual, a13 => vaxx, v13 => CT.blank, 1393 bound => True, null_data => absent)); 1394 end assign; 1395 1396 procedure assign (Stmt : out Base_Statement; 1397 index : Positive; 1398 vaxx : AR.Textual) is 1399 begin 1400 Stmt.realmccoy.Replace_Element 1401 (index, (output_type => ft_textual, a13 => null, v13 => vaxx, 1402 bound => True, null_data => False)); 1403 end assign; 1404 1405 procedure assign (Stmt : out Base_Statement; 1406 index : Positive; 1407 vaxx : AR.Str2_Access) 1408 is 1409 use type AR.Str2_Access; 1410 absent : Boolean := (vaxx = null); 1411 begin 1412 Stmt.realmccoy.Replace_Element 1413 (index, (output_type => ft_widetext, a14 => vaxx, 1414 v14 => AR.Blank_WString, bound => True, null_data => absent)); 1415 end assign; 1416 1417 procedure assign (Stmt : out Base_Statement; 1418 index : Positive; 1419 vaxx : AR.Textwide) is 1420 begin 1421 Stmt.realmccoy.Replace_Element 1422 (index, (output_type => ft_widetext, a14 => null, v14 => vaxx, 1423 bound => True, null_data => False)); 1424 end assign; 1425 1426 procedure assign (Stmt : out Base_Statement; 1427 index : Positive; 1428 vaxx : AR.Str4_Access) 1429 is 1430 use type AR.Str4_Access; 1431 absent : Boolean := (vaxx = null); 1432 begin 1433 Stmt.realmccoy.Replace_Element 1434 (index, (output_type => ft_supertext, a15 => vaxx, bound => True, 1435 v15 => AR.Blank_WWString, null_data => absent)); 1436 end assign; 1437 1438 procedure assign (Stmt : out Base_Statement; 1439 index : Positive; 1440 vaxx : AR.Textsuper) is 1441 begin 1442 Stmt.realmccoy.Replace_Element 1443 (index, (output_type => ft_supertext, a15 => null, v15 => vaxx, 1444 bound => True, null_data => False)); 1445 end assign; 1446 1447 procedure assign (Stmt : out Base_Statement; 1448 index : Positive; 1449 vaxx : AR.Time_Access) 1450 is 1451 use type AR.Time_Access; 1452 absent : Boolean := (vaxx = null); 1453 begin 1454 Stmt.realmccoy.Replace_Element 1455 (index, (output_type => ft_timestamp, a16 => vaxx, 1456 v16 => CAL.Clock, bound => True, null_data => absent)); 1457 end assign; 1458 1459 procedure assign (Stmt : out Base_Statement; 1460 index : Positive; 1461 vaxx : CAL.Time) is 1462 begin 1463 Stmt.realmccoy.Replace_Element 1464 (index, (output_type => ft_timestamp, a16 => null, v16 => vaxx, 1465 bound => True, null_data => False)); 1466 end assign; 1467 1468 procedure assign (Stmt : out Base_Statement; 1469 index : Positive; 1470 vaxx : AR.Chain_Access) 1471 is 1472 use type AR.Chain_Access; 1473 absent : Boolean := (vaxx = null); 1474 begin 1475 Stmt.realmccoy.Replace_Element 1476 (index, (output_type => ft_chain, a17 => vaxx, 1477 v17 => CT.blank, bound => True, null_data => absent)); 1478 end assign; 1479 1480 procedure assign (Stmt : out Base_Statement; 1481 index : Positive; 1482 vaxx : AR.Chain) 1483 is 1484 payload : constant String := ARC.convert (vaxx); 1485 begin 1486 Stmt.realmccoy.Replace_Element 1487 (index, (output_type => ft_chain, a17 => null, 1488 v17 => CT.SUS (payload), bound => True, null_data => False)); 1489 end assign; 1490 1491 procedure assign (Stmt : out Base_Statement; 1492 index : Positive; 1493 vaxx : AR.Enum_Access) 1494 is 1495 use type AR.Enum_Access; 1496 absent : Boolean := (vaxx = null); 1497 begin 1498 Stmt.realmccoy.Replace_Element 1499 (index, (output_type => ft_enumtype, a18 => vaxx, 1500 v18 => AR.PARAM_IS_ENUM, bound => True, null_data => absent)); 1501 end assign; 1502 1503 procedure assign (Stmt : out Base_Statement; 1504 index : Positive; 1505 vaxx : AR.Enumtype) is 1506 begin 1507 Stmt.realmccoy.Replace_Element 1508 (index, (output_type => ft_enumtype, a18 => null, v18 => vaxx, 1509 bound => True, null_data => False)); 1510 end assign; 1511 1512 procedure assign (Stmt : out Base_Statement; 1513 index : Positive; 1514 vaxx : AR.Settype_Access) 1515 is 1516 use type AR.Settype_Access; 1517 absent : Boolean := (vaxx = null); 1518 begin 1519 Stmt.realmccoy.Replace_Element 1520 (index, (output_type => ft_settype, a19 => vaxx, 1521 v19 => CT.blank, bound => True, null_data => absent)); 1522 end assign; 1523 1524 procedure assign (Stmt : out Base_Statement; 1525 index : Positive; 1526 vaxx : AR.Settype) 1527 is 1528 payload : AR.Textual := CT.blank; 1529 begin 1530 for x in vaxx'Range loop 1531 if x /= vaxx'First then 1532 CT.SU.Append (payload, ","); 1533 end if; 1534 CT.SU.Append (payload, vaxx (x).enumeration); 1535 end loop; 1536 Stmt.realmccoy.Replace_Element 1537 (index, (output_type => ft_settype, a19 => null, 1538 v19 => payload, bound => True, null_data => False)); 1539 end assign; 1540 1541 procedure assign (Stmt : out Base_Statement; 1542 index : Positive; 1543 vaxx : AR.Bits_Access) 1544 is 1545 use type AR.Bits_Access; 1546 absent : Boolean := (vaxx = null); 1547 begin 1548 Stmt.realmccoy.Replace_Element 1549 (index, (output_type => ft_bits, a20 => vaxx, 1550 v20 => CT.blank, bound => True, null_data => absent)); 1551 end assign; 1552 1553 procedure assign (Stmt : out Base_Statement; 1554 index : Positive; 1555 vaxx : AR.Bits) 1556 is 1557 payload : constant String := ARC.convert (vaxx); 1558 begin 1559 Stmt.realmccoy.Replace_Element 1560 (index, (output_type => ft_bits, a20 => null, 1561 v20 => CT.SUS (payload), bound => True, null_data => False)); 1562 end assign; 1563 1564 procedure assign (Stmt : out Base_Statement; 1565 index : Positive; 1566 vaxx : AR.S_UTF8_Access) 1567 is 1568 use type AR.S_UTF8_Access; 1569 absent : Boolean := (vaxx = null); 1570 begin 1571 Stmt.realmccoy.Replace_Element 1572 (index, (output_type => ft_utf8, a21 => vaxx, 1573 v21 => CT.blank, bound => True, null_data => absent)); 1574 end assign; 1575 1576 procedure assign (Stmt : out Base_Statement; 1577 index : Positive; 1578 vaxx : AR.Text_UTF8) 1579 is 1580 begin 1581 Stmt.realmccoy.Replace_Element 1582 (index, (output_type => ft_utf8, a21 => null, 1583 v21 => CT.SUS (vaxx), bound => True, null_data => False)); 1584 end assign; 1585 1586 procedure assign (Stmt : out Base_Statement; 1587 index : Positive; 1588 vaxx : AR.Geometry_Access) 1589 is 1590 use type AR.Geometry_Access; 1591 absent : Boolean := (vaxx = null); 1592 begin 1593 Stmt.realmccoy.Replace_Element 1594 (index, (output_type => ft_geometry, a22 => vaxx, 1595 v22 => CT.blank, bound => True, null_data => absent)); 1596 end assign; 1597 1598 procedure assign (Stmt : out Base_Statement; 1599 index : Positive; 1600 vaxx : Spatial_Data.Geometry) 1601 is 1602 shape : String := Spatial_Data.Well_Known_Text (vaxx); 1603 begin 1604 Stmt.realmccoy.Replace_Element 1605 (index, (output_type => ft_geometry, a22 => null, 1606 v22 => CT.SUS (shape), bound => True, null_data => False)); 1607 end assign; 1608 1609 1610 ------------------ 1611 -- iterate #1 -- 1612 ------------------ 1613 overriding 1614 procedure iterate (Stmt : out Base_Statement; 1615 process : not null access procedure) is 1616 begin 1617 loop 1618 exit when not fetch_bound (Stmt => Base_Statement'Class (Stmt)); 1619 process.all; 1620 end loop; 1621 end iterate; 1622 1623 1624 ------------------ 1625 -- iterate #2 -- 1626 ------------------ 1627 overriding 1628 procedure iterate (Stmt : out Base_Statement; 1629 process : not null access procedure (row : ARS.Datarow)) 1630 is 1631 begin 1632 loop 1633 declare 1634 local_row : ARS.Datarow := 1635 fetch_next (Stmt => Base_Statement'Class (Stmt)); 1636 begin 1637 exit when local_row.data_exhausted; 1638 process.all (row => local_row); 1639 end; 1640 end loop; 1641 end iterate; 1642 1643 1644 ------------------- 1645 -- auto_assign -- 1646 ------------------- 1647 procedure auto_assign (Stmt : out Base_Statement; index : Positive; 1648 value : String) 1649 is 1650 zone : bindrec renames Stmt.realmccoy.Element (index); 1651 ST : AR.Textual; 1652 STW : AR.Textwide; 1653 STS : AR.Textsuper; 1654 hold : ARF.Variant; 1655 begin 1656 case zone.output_type is 1657 when ft_widetext => 1658 ST := CT.SUS (value); 1659 STW := SUW.To_Unbounded_Wide_String (ARC.convert (ST)); 1660 when ft_supertext => 1661 ST := CT.SUS (value); 1662 STS := SWW.To_Unbounded_Wide_Wide_String (ARC.convert (ST)); 1663 when ft_timestamp | ft_settype | ft_chain => 1664 null; 1665 when others => 1666 ST := CT.SUS (value); 1667 end case; 1668 case zone.output_type is 1669 when ft_nbyte0 => hold := (ft_nbyte0, ARC.convert (ST)); 1670 when ft_nbyte1 => hold := (ft_nbyte1, ARC.convert (ST)); 1671 when ft_nbyte2 => hold := (ft_nbyte2, ARC.convert (ST)); 1672 when ft_nbyte3 => hold := (ft_nbyte3, ARC.convert (ST)); 1673 when ft_nbyte4 => hold := (ft_nbyte4, ARC.convert (ST)); 1674 when ft_nbyte8 => hold := (ft_nbyte8, ARC.convert (ST)); 1675 when ft_byte1 => hold := (ft_byte1, ARC.convert (ST)); 1676 when ft_byte2 => hold := (ft_byte2, ARC.convert (ST)); 1677 when ft_byte3 => hold := (ft_byte3, ARC.convert (ST)); 1678 when ft_byte4 => hold := (ft_byte4, ARC.convert (ST)); 1679 when ft_byte8 => hold := (ft_byte8, ARC.convert (ST)); 1680 when ft_real9 => hold := (ft_real9, ARC.convert (ST)); 1681 when ft_real18 => hold := (ft_real18, ARC.convert (ST)); 1682 when ft_textual => hold := (ft_textual, ST); 1683 when ft_widetext => hold := (ft_widetext, STW); 1684 when ft_supertext => hold := (ft_supertext, STS); 1685 when ft_timestamp => hold := (ft_timestamp, (ARC.convert (value))); 1686 when ft_chain => null; 1687 when ft_enumtype => hold := (ft_enumtype, (ARC.convert (ST))); 1688 when ft_settype => null; 1689 when ft_bits => null; 1690 when ft_utf8 => hold := (ft_utf8, ST); 1691 when ft_geometry => hold := (ft_geometry, ST); -- ST=WKB 1692 end case; 1693 case zone.output_type is 1694 when ft_nbyte0 => Stmt.assign (index, hold.v00); 1695 when ft_nbyte1 => Stmt.assign (index, hold.v01); 1696 when ft_nbyte2 => Stmt.assign (index, hold.v02); 1697 when ft_nbyte3 => Stmt.assign (index, hold.v03); 1698 when ft_nbyte4 => Stmt.assign (index, hold.v04); 1699 when ft_nbyte8 => Stmt.assign (index, hold.v05); 1700 when ft_byte1 => Stmt.assign (index, hold.v06); 1701 when ft_byte2 => Stmt.assign (index, hold.v07); 1702 when ft_byte3 => Stmt.assign (index, hold.v08); 1703 when ft_byte4 => Stmt.assign (index, hold.v09); 1704 when ft_byte8 => Stmt.assign (index, hold.v10); 1705 when ft_real9 => Stmt.assign (index, hold.v11); 1706 when ft_real18 => Stmt.assign (index, hold.v12); 1707 when ft_textual => Stmt.assign (index, hold.v13); 1708 when ft_widetext => Stmt.assign (index, hold.v14); 1709 when ft_supertext => Stmt.assign (index, hold.v15); 1710 when ft_timestamp => Stmt.assign (index, hold.v16); 1711 when ft_enumtype => Stmt.assign (index, hold.v18); 1712 when ft_utf8 => Stmt.assign (index, hold.v21); 1713 when ft_geometry => Stmt.assign (index, hold.v22); 1714 when ft_chain => 1715 declare 1716 my_chain : AR.Chain := ARC.convert (value); 1717 begin 1718 Stmt.assign (index, my_chain); 1719 end; 1720 when ft_settype => 1721 declare 1722 set : AR.Settype := ARC.convert (value); 1723 begin 1724 Stmt.assign (index, set); 1725 end; 1726 when ft_bits => 1727 declare 1728 bitchain : AR.Bits := ARC.convert (value); 1729 begin 1730 Stmt.assign (index, bitchain); 1731 end; 1732 end case; 1733 end auto_assign; 1734 1735 1736 ------------------ 1737 -- set_as_null -- 1738 ------------------- 1739 procedure set_as_null (param : bindrec) 1740 is 1741 data_type : field_types := param.output_type; 1742 begin 1743 case data_type is 1744 when ft_nbyte0 => param.a00.all := AR.PARAM_IS_BOOLEAN; 1745 when ft_nbyte1 => param.a01.all := AR.PARAM_IS_NBYTE_1; 1746 when ft_nbyte2 => param.a02.all := AR.PARAM_IS_NBYTE_2; 1747 when ft_nbyte3 => param.a03.all := AR.PARAM_IS_NBYTE_3; 1748 when ft_nbyte4 => param.a04.all := AR.PARAM_IS_NBYTE_4; 1749 when ft_nbyte8 => param.a05.all := AR.PARAM_IS_NBYTE_8; 1750 when ft_byte1 => param.a06.all := AR.PARAM_IS_BYTE_1; 1751 when ft_byte2 => param.a07.all := AR.PARAM_IS_BYTE_2; 1752 when ft_byte3 => param.a08.all := AR.PARAM_IS_BYTE_3; 1753 when ft_byte4 => param.a09.all := AR.PARAM_IS_BYTE_4; 1754 when ft_byte8 => param.a10.all := AR.PARAM_IS_BYTE_8; 1755 when ft_real9 => param.a11.all := AR.PARAM_IS_REAL_9; 1756 when ft_real18 => param.a12.all := AR.PARAM_IS_REAL_18; 1757 when ft_textual => param.a13.all := AR.PARAM_IS_TEXTUAL; 1758 when ft_widetext => param.a14.all := AR.PARAM_IS_TEXTWIDE; 1759 when ft_supertext => param.a15.all := AR.PARAM_IS_TEXTSUPER; 1760 when ft_timestamp => param.a16.all := AR.PARAM_IS_TIMESTAMP; 1761 when ft_enumtype => param.a18.all := AR.PARAM_IS_ENUM; 1762 when ft_chain => param.a17.all := 1763 ARC.convert ("", param.a17.all'Length); 1764 when ft_settype => param.a19.all := 1765 ARC.convert ("", param.a19.all'Length); 1766 when ft_bits => param.a20.all := 1767 ARC.convert ("", param.a20.all'Length); 1768 when ft_utf8 => param.a21.all := AR.PARAM_IS_TEXT_UTF8; 1769 when ft_geometry => param.a22.all := GEO.initialize_as_point 1770 (GEO.Origin_Point); 1771 end case; 1772 end set_as_null; 1773 1774 1775end AdaBase.Statement.Base; 1776